11module Text.Parsing.Parser where
22
3- import Prelude
4-
53import Data.Either
64import Data.Maybe
75import Data.Monoid
86import Data.Tuple
97
8+ import Control.Alt
9+ import Control.Alternative
10+ import Control.Lazy
1011import Control.Monad
1112import Control.Monad.Identity
12-
1313import Control.Monad.Trans
1414import Control.Monad.State.Class
1515import Control.Monad.State.Trans
1616import Control.Monad.Error
1717import Control.Monad.Error.Class
1818import Control.Monad.Error.Trans
19+ import Control.MonadPlus
20+ import Control.Plus
1921
2022data ParseError = ParseError
2123 { message :: String
@@ -25,7 +27,7 @@ instance errorParseError :: Error ParseError where
2527 noMsg = ParseError { message: " " }
2628 strMsg msg = ParseError { message: msg }
2729
28- data ParserT s m a = ParserT (s -> m { input :: s , result :: Either ParseError a , consumed :: Boolean } )
30+ newtype ParserT s m a = ParserT (s -> m { input :: s , result :: Either ParseError a , consumed :: Boolean } )
2931
3032unParserT :: forall m s a . ParserT s m a -> s -> m { input :: s , result :: Either ParseError a , consumed :: Boolean }
3133unParserT (ParserT p) = p
@@ -41,23 +43,27 @@ runParser :: forall s a. s -> Parser s a -> Either ParseError a
4143runParser s = runIdentity <<< runParserT s
4244
4345instance functorParserT :: (Functor m ) => Functor (ParserT s m ) where
44- (<$>) f p = ParserT $ \s -> f' <$> unParserT p s
46+ (<$>) f p = ParserT $ \s -> f' <$> unParserT p s
4547 where
4648 f' o = { input: o.input, result: f <$> o.result, consumed: o.consumed }
4749
4850instance applyParserT :: (Monad m ) => Apply (ParserT s m ) where
4951 (<*>) = ap
50-
52+
5153instance applicativeParserT :: (Monad m ) => Applicative (ParserT s m ) where
5254 pure a = ParserT $ \s -> pure { input: s, result: Right a, consumed: false }
53-
54- instance alternativeParserT :: (Monad m ) => Alternative (ParserT s m ) where
55- empty = fail " No alternative"
55+
56+ instance altParserT :: (Monad m ) => Alt (ParserT s m ) where
5657 (<|>) p1 p2 = ParserT $ \s -> unParserT p1 s >>= \o ->
5758 case o.result of
5859 Left _ | not o.consumed -> unParserT p2 s
5960 _ -> return o
6061
62+ instance plusParserT :: (Monad m ) => Plus (ParserT s m ) where
63+ empty = fail " No alternative"
64+
65+ instance alternativeParserT :: (Monad m ) => Alternative (ParserT s m )
66+
6167instance bindParserT :: (Monad m ) => Bind (ParserT s m ) where
6268 (>>=) p f = ParserT $ \s -> unParserT p s >>= \o ->
6369 case o.result of
@@ -68,16 +74,21 @@ instance bindParserT :: (Monad m) => Bind (ParserT s m) where
6874
6975instance monadParserT :: (Monad m ) => Monad (ParserT s m )
7076
77+ instance monadPlusParserT :: (Monad m ) => MonadPlus (ParserT s m )
78+
7179instance monadTransParserT :: MonadTrans (ParserT s ) where
7280 lift m = ParserT $ \s -> (\a -> { input: s, consumed: false , result: Right a }) <$> m
7381
7482instance monadStateParserT :: (Monad m ) => MonadState s (ParserT s m ) where
75- state f = ParserT $ \s ->
83+ state f = ParserT $ \s ->
7684 return $ case f s of
7785 Tuple a s' -> { input: s', consumed: false , result: Right a }
7886
79- consume :: forall s m . (Monad m ) => ParserT s m { }
80- consume = ParserT $ \s -> return { consumed: true , input: s, result: Right {} }
87+ instance lazy1ParserT :: Lazy1 (ParserT s m ) where
88+ defer1 f = ParserT $ \s -> unParserT (f unit) s
89+
90+ consume :: forall s m . (Monad m ) => ParserT s m Unit
91+ consume = ParserT $ \s -> return { consumed: true , input: s, result: Right unit }
8192
8293fail :: forall m s a . (Monad m ) => String -> ParserT s m a
8394fail message = ParserT $ \s -> return { input: s, consumed: false , result: Left (ParseError { message: message }) }
0 commit comments