Cool, I like how this parser can model the "Look, an Eagle" scenario. For reference:<br><a href="http://www.youtube.com/watch?v=pjh3e198pUQ">http://www.youtube.com/watch?v=pjh3e198pUQ</a><br><br>The parser can "change focus" (that is, change traversal strategy) in response to a successful parse. In the "Look, an Eagle" scenario, the bear is able to interpret and respond to its input serially and interactively, but when the bear's input stream is replaced by a new one, the man is able to capture the prize.<br>
<br>-Greg<br><br><br><div class="gmail_quote">On Thu, Oct 1, 2009 at 1:02 PM, Anatoly Yakovenko <span dir="ltr"><<a href="mailto:aeyakovenko@gmail.com">aeyakovenko@gmail.com</a>></span> wrote:<br><blockquote class="gmail_quote" style="border-left: 1px solid rgb(204, 204, 204); margin: 0pt 0pt 0pt 0.8ex; padding-left: 1ex;">
so whats pretty cool is that I can traverse arbitrary data structures as well:<br>
<br>
data Tree a = Tree (Tree a) a (Tree a) | Bottom<br>
deriving Show<br>
<br>
left a = do<br>
make $ \ st -> do<br>
case(st) of<br>
(Bottom) -> eos<br>
(Tree left val right) -><br>
case (a < val) of<br>
True -> return $ (val, left)<br>
False -> noMatch<br>
<br>
right a = do<br>
make $ \ st -> do<br>
case(st) of<br>
(Bottom) -> eos<br>
(Tree left val right) -><br>
case (a > val) of<br>
True -> return $ (val, right)<br>
False -> noMatch<br>
<br>
eqT a = do<br>
make $ \ st -> do<br>
case(st) of<br>
(Bottom) -> eos<br>
(Tree _ val _) -><br>
case (a == val) of<br>
True -> return $ (val, st)<br>
False -> noMatch<br>
<br>
search a = manyTill (left a <|> right a) (eqT a)<br>
<br>
> run (search 5) $ Tree (Tree Bottom 1 Bottom) 3 (Tree Bottom 5 Bottom)<br>
Right (([3],5),Tree Bottom 5 Bottom)<br>
<div><div></div><div class="h5"><br>
<br>
<br>
On Wed, Sep 30, 2009 at 8:04 PM, Anatoly Yakovenko<br>
<<a href="mailto:aeyakovenko@gmail.com">aeyakovenko@gmail.com</a>> wrote:<br>
> i got annoyed with Parsec and wrote a much more boring parser which<br>
> allows me to parse anything with any kind of matching i want. Its<br>
> basically a combination of State and Error monads.<br>
><br>
> So i can use a grep like parser that matches via a regular expression<br>
> over a list of lines<br>
><br>
> grep re = do<br>
> vv::B.ByteString <- any<br>
> let (_,_,_,rv) = (vv =~<br>
> re)::(B.ByteString,B.ByteString,B.ByteString,[B.ByteString])<br>
> case (rv) of<br>
> [] -> throwError "no match"<br>
> _ -> return $ rv<br>
><br>
>> run (grep $ C.pack "(hello)") $ [C.pack "hello world"]<br>
> Right (["hello"],[])<br>
><br>
> or use the same library to scan over a string by combining regular expressions<br>
><br>
> regex re = do<br>
> make $ \ st -> do<br>
> case (B.null st) of<br>
> True -> throwError "eos"<br>
> _ -> do<br>
> let (_,_,after,rv) = (st =~<br>
> re)::(B.ByteString,B.ByteString,B.ByteString,[B.ByteString])<br>
> case (rv) of<br>
> [] -> throwError "no match"<br>
> _ -> return $ (rv,after)<br>
><br>
><br>
><br>
>> run (do aa <- regex $ C.pack "(hello)"; bb <- regex $ C.pack " (world)"; return (aa,bb) ) $ C.pack "hello world"<br>
> Right ((["hello"],["world"]),"")<br>
><br>
> or simply match integers in a list, or anything that is of type Eq<br>
><br>
>> run (many1 $ eq 1) [1,1,1,2,3,4]<br>
> Right ([1,1,1],[2,3,4])<br>
><br>
> i can define lt<br>
><br>
> lt cc = do<br>
> vv <- any<br>
> case (vv < cc) of<br>
> True -> return $ vv<br>
> _ -> throwError "no match"<br>
><br>
> and do<br>
><br>
>> run (many1 $ lt 5 <|> eq 5) [1..10]<br>
> Right ([1,2,3,4,5],[6,7,8,9,10])<br>
><br>
> here is the implementation<br>
><br>
> module Parser( ParserM --type alias for the parser ParserM a b is<br>
> over "stream" a and returns b<br>
> , make --makes a parser from a matching function of<br>
> type :: stream -> m (match_data,stream)<br>
> --for example any is implemented via:<br>
> --any :: ParserM [a] a<br>
> --any = make $ \ ll -><br>
> -- case (ll) of<br>
> -- (hh:tt) -> return $ (hh,tt)<br>
> -- _ -> throwError "eos<br>
> --matches and returns an element from a<br>
> list, which makes any of type :: ParserM [a] a<br>
> , any --matches any element from [a] type stream<br>
> , eq --matches an equal element from [Eq] stream,<br>
> trivialy implemented in terms of any<br>
> --eq :: Eq a => a -> ParserM [a] a<br>
> --eq cc = do<br>
> -- vv <- any<br>
> -- case (vv == cc) of<br>
> -- True -> return $ vv<br>
> -- _ -> throwError "no match<br>
> , (<|>) --or operator, tries the left one then the right one<br>
> , manyTill --collects the results of parser 1 until<br>
> parser 2 succeeds<br>
> , many1 --collects the results of the parser, must<br>
> succeed at least once<br>
> , many --collects the results of a parser<br>
> , run --runs the parser<br>
> ) where<br>
><br>
> import Control.Monad.State.Lazy<br>
> import Control.Monad.Error<br>
> import Test.QuickCheck<br>
> import Control.Monad.Identity<br>
> import Prelude hiding (any)<br>
><br>
> type ParserM a c = StateT a (ErrorT [Char] Identity) c<br>
><br>
> make pp = do<br>
> st <- get<br>
> (rv,nst) <- pp $ st<br>
> put $ nst<br>
> return $ rv<br>
><br>
> aa <|> bb = aa `catchError` \ _ -> bb<br>
><br>
> manyTill :: ParserM a c -> ParserM a d -> ParserM a ([c],d)<br>
> manyTill pp ee = do<br>
> do dd <- ee<br>
> return $ ([],dd)<br>
> `catchError` \ _ -> do<br>
> cc <- pp<br>
> (ccs,dd) <- manyTill pp ee<br>
> return $ (cc:ccs,dd)<br>
><br>
> many1 pp = do<br>
> rv <- pp<br>
> rest <- many1 pp `catchError` \ _ -> return $ []<br>
> return $ rv : rest<br>
><br>
> many pp = do many1 pp<br>
> <|> return []<br>
><br>
><br>
> any :: ParserM [a] a<br>
> any = make $ \ ll -><br>
> case (ll) of<br>
> (hh:tt) -> return $ (hh,tt)<br>
> _ -> throwError "eos"<br>
><br>
> eq :: Eq a => a -> ParserM [a] a<br>
> eq cc = do<br>
> vv <- any<br>
> case (vv == cc) of<br>
> True -> return $ vv<br>
> _ -> throwError "no match"<br>
><br>
> lt cc = do<br>
> vv <- any<br>
> case (vv < cc) of<br>
> True -> return $ vv<br>
> _ -> throwError "no match"<br>
><br>
> run pp dd = runIdentity $ runErrorT $ runStateT pp dd<br>
> run' = flip run<br>
><br>
><br>
> prop_MatchA = (Right ('a',"bc")) == (run' "abc" $ eq 'a')<br>
> prop_MatchEOS = (Left "eos") == (run' "" $ eq 'a')<br>
> prop_MatchNoMatch = (Left "no match") == (run' ("bcd") $ eq 'a')<br>
><br>
> prop_MatchABC =(Right ('c',""))== (run' "abc" $ do eq 'a'<br>
> eq 'b'<br>
> eq 'c')<br>
><br>
> prop_MatchA_C = (run' "abc" $ do eq 'a'<br>
> eq 'd' <|> eq 'b' <|> any<br>
> eq 'c') == (Right ('c',""))<br>
><br>
> prop_Or = (run' "abc" $ do { eq 'a'<br>
> ; do { eq 'b'<br>
> ; eq 'd'<br>
> }<br>
> <|> do { eq 'b'<br>
> ; eq 'c'<br>
> }<br>
> }) == (Right ('c',""))<br>
><br>
> prop_UntilC = (Right (("",'c'),"")) == (run' ("c") $ manyTill any $ eq 'c')<br>
><br>
> prop_Until1 ls =<br>
> let rv = run' (ls ++ [1]) $ manyTill any $ eq 1<br>
> in case (rv) of<br>
> Right ((ls,1),rest) -> (elem 1 ls) == False<br>
> _ -> False<br>
><br>
> prop_all1 ls =<br>
> let rv = run' ([1,1,1] ++ ls) $ many1 $ eq 1<br>
> in case (rv) of<br>
> Right (_,(1:_)) -> False<br>
> Right ((1:1:1:_),_) -> True<br>
> _ -> False<br>
><br>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
<a href="mailto:Haskell-Cafe@haskell.org">Haskell-Cafe@haskell.org</a><br>
<a href="http://www.haskell.org/mailman/listinfo/haskell-cafe" target="_blank">http://www.haskell.org/mailman/listinfo/haskell-cafe</a><br>
</div></div></blockquote></div><br>