so whats pretty cool is that I can traverse arbitrary data structures as well:
data Tree a = Tree (Tree a) a (Tree a) | Bottom deriving Show left a = do make $ \ st -> do case(st) of (Bottom) -> eos (Tree left val right) -> case (a < val) of True -> return $ (val, left) False -> noMatch right a = do make $ \ st -> do case(st) of (Bottom) -> eos (Tree left val right) -> case (a > val) of True -> return $ (val, right) False -> noMatch eqT a = do make $ \ st -> do case(st) of (Bottom) -> eos (Tree _ val _) -> case (a == val) of True -> return $ (val, st) False -> noMatch search a = manyTill (left a <|> right a) (eqT a) > run (search 5) $ Tree (Tree Bottom 1 Bottom) 3 (Tree Bottom 5 Bottom) Right (([3],5),Tree Bottom 5 Bottom) On Wed, Sep 30, 2009 at 8:04 PM, Anatoly Yakovenko <aeyakove...@gmail.com> wrote: > i got annoyed with Parsec and wrote a much more boring parser which > allows me to parse anything with any kind of matching i want. Its > basically a combination of State and Error monads. > > So i can use a grep like parser that matches via a regular expression > over a list of lines > > grep re = do > vv::B.ByteString <- any > let (_,_,_,rv) = (vv =~ > re)::(B.ByteString,B.ByteString,B.ByteString,[B.ByteString]) > case (rv) of > [] -> throwError "no match" > _ -> return $ rv > >> run (grep $ C.pack "(hello)") $ [C.pack "hello world"] > Right (["hello"],[]) > > or use the same library to scan over a string by combining regular expressions > > regex re = do > make $ \ st -> do > case (B.null st) of > True -> throwError "eos" > _ -> do > let (_,_,after,rv) = (st =~ > re)::(B.ByteString,B.ByteString,B.ByteString,[B.ByteString]) > case (rv) of > [] -> throwError "no match" > _ -> return $ (rv,after) > > > >> run (do aa <- regex $ C.pack "(hello)"; bb <- regex $ C.pack " (world)"; >> return (aa,bb) ) $ C.pack "hello world" > Right ((["hello"],["world"]),"") > > or simply match integers in a list, or anything that is of type Eq > >> run (many1 $ eq 1) [1,1,1,2,3,4] > Right ([1,1,1],[2,3,4]) > > i can define lt > > lt cc = do > vv <- any > case (vv < cc) of > True -> return $ vv > _ -> throwError "no match" > > and do > >> run (many1 $ lt 5 <|> eq 5) [1..10] > Right ([1,2,3,4,5],[6,7,8,9,10]) > > here is the implementation > > module Parser( ParserM --type alias for the parser ParserM a b is > over "stream" a and returns b > , make --makes a parser from a matching function of > type :: stream -> m (match_data,stream) > --for example any is implemented via: > --any :: ParserM [a] a > --any = make $ \ ll -> > -- case (ll) of > -- (hh:tt) -> return $ (hh,tt) > -- _ -> throwError "eos > --matches and returns an element from a > list, which makes any of type :: ParserM [a] a > , any --matches any element from [a] type stream > , eq --matches an equal element from [Eq] stream, > trivialy implemented in terms of any > --eq :: Eq a => a -> ParserM [a] a > --eq cc = do > -- vv <- any > -- case (vv == cc) of > -- True -> return $ vv > -- _ -> throwError "no match > , (<|>) --or operator, tries the left one then the right one > , manyTill --collects the results of parser 1 until > parser 2 succeeds > , many1 --collects the results of the parser, must > succeed at least once > , many --collects the results of a parser > , run --runs the parser > ) where > > import Control.Monad.State.Lazy > import Control.Monad.Error > import Test.QuickCheck > import Control.Monad.Identity > import Prelude hiding (any) > > type ParserM a c = StateT a (ErrorT [Char] Identity) c > > make pp = do > st <- get > (rv,nst) <- pp $ st > put $ nst > return $ rv > > aa <|> bb = aa `catchError` \ _ -> bb > > manyTill :: ParserM a c -> ParserM a d -> ParserM a ([c],d) > manyTill pp ee = do > do dd <- ee > return $ ([],dd) > `catchError` \ _ -> do > cc <- pp > (ccs,dd) <- manyTill pp ee > return $ (cc:ccs,dd) > > many1 pp = do > rv <- pp > rest <- many1 pp `catchError` \ _ -> return $ [] > return $ rv : rest > > many pp = do many1 pp > <|> return [] > > > any :: ParserM [a] a > any = make $ \ ll -> > case (ll) of > (hh:tt) -> return $ (hh,tt) > _ -> throwError "eos" > > eq :: Eq a => a -> ParserM [a] a > eq cc = do > vv <- any > case (vv == cc) of > True -> return $ vv > _ -> throwError "no match" > > lt cc = do > vv <- any > case (vv < cc) of > True -> return $ vv > _ -> throwError "no match" > > run pp dd = runIdentity $ runErrorT $ runStateT pp dd > run' = flip run > > > prop_MatchA = (Right ('a',"bc")) == (run' "abc" $ eq 'a') > prop_MatchEOS = (Left "eos") == (run' "" $ eq 'a') > prop_MatchNoMatch = (Left "no match") == (run' ("bcd") $ eq 'a') > > prop_MatchABC =(Right ('c',""))== (run' "abc" $ do eq 'a' > eq 'b' > eq 'c') > > prop_MatchA_C = (run' "abc" $ do eq 'a' > eq 'd' <|> eq 'b' <|> any > eq 'c') == (Right ('c',"")) > > prop_Or = (run' "abc" $ do { eq 'a' > ; do { eq 'b' > ; eq 'd' > } > <|> do { eq 'b' > ; eq 'c' > } > }) == (Right ('c',"")) > > prop_UntilC = (Right (("",'c'),"")) == (run' ("c") $ manyTill any $ eq 'c') > > prop_Until1 ls = > let rv = run' (ls ++ [1]) $ manyTill any $ eq 1 > in case (rv) of > Right ((ls,1),rest) -> (elem 1 ls) == False > _ -> False > > prop_all1 ls = > let rv = run' ([1,1,1] ++ ls) $ many1 $ eq 1 > in case (rv) of > Right (_,(1:_)) -> False > Right ((1:1:1:_),_) -> True > _ -> False > _______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe