Add Alt, Plus, MonadPlus, update Alternative

Author: garyb

bower.json

@@ -18,10 +18,10 @@
     "package.json"
   ],
   "dependencies": {
-    "purescript-transformers": "*",
+    "purescript-transformers": "~0.1.0",
     "purescript-either": "*",
-    "purescript-maybe": "*",
-    "purescript-arrays": "*",
+    "purescript-maybe": "~0.2.0",
+    "purescript-arrays": "~0.2.0",
     "purescript-strings": "*",
     "purescript-foldable-traversable": "*"
   }

docs/Module.md

@@ -15,6 +15,8 @@
 
 ### Type Class Instances
 
+    instance altParserT :: (Monad m) => Alt (ParserT s m)
+
     instance alternativeParserT :: (Monad m) => Alternative (ParserT s m)
 
     instance applicativeParserT :: (Monad m) => Applicative (ParserT s m)
@@ -33,6 +35,8 @@
 
     instance monadTransParserT :: MonadTrans (ParserT s)
 
+    instance plusParserT :: (Monad m) => Plus (ParserT s m)
+
 
 ### Values
 

examples/Test.purs

@@ -1,12 +1,14 @@
 module Main where
 
-import Prelude
 import Data.Array
 import Data.Either
 import Data.Maybe
+
 import Control.Monad.Eff
 import Control.Monad.Identity
+
 import Debug.Trace
+
 import Text.Parsing.Parser
 import Text.Parsing.Parser.Combinators
 import Text.Parsing.Parser.Expr
@@ -16,7 +18,7 @@ parens :: forall m a. (Monad m) => ParserT String m a -> ParserT String m a
 parens = between (string "(") (string ")")
 
 nested :: forall m. (Functor m, Monad m) => ParserT String m Number
-nested = fix $ \p -> (do 
+nested = fix $ \p -> (do
   string "a"
   return 0) <|> ((+) 1) <$> parens p
 
@@ -30,23 +32,23 @@ opTest = chainl char (do string "+"
                          return (++)) ""
 
 digit :: Parser String Number
-digit = (string "0" >>= \_ -> return 0) 
-        <|> (string "1" >>= \_ -> return 1) 
-        <|> (string "2" >>= \_ -> return 2) 
-        <|> (string "3" >>= \_ -> return 3) 
-        <|> (string "4" >>= \_ -> return 4) 
-        <|> (string "5" >>= \_ -> return 5) 
-        <|> (string "6" >>= \_ -> return 6) 
-        <|> (string "7" >>= \_ -> return 7) 
-        <|> (string "8" >>= \_ -> return 8) 
-        <|> (string "9" >>= \_ -> return 9) 
+digit = (string "0" >>= \_ -> return 0)
+        <|> (string "1" >>= \_ -> return 1)
+        <|> (string "2" >>= \_ -> return 2)
+        <|> (string "3" >>= \_ -> return 3)
+        <|> (string "4" >>= \_ -> return 4)
+        <|> (string "5" >>= \_ -> return 5)
+        <|> (string "6" >>= \_ -> return 6)
+        <|> (string "7" >>= \_ -> return 7)
+        <|> (string "8" >>= \_ -> return 8)
+        <|> (string "9" >>= \_ -> return 9)
 
 exprTest :: Parser String Number
 exprTest = buildExprParser [[Infix (string "/" >>= \_ -> return (/)) AssocRight]
                            ,[Infix (string "*" >>= \_ -> return (*)) AssocRight]
                            ,[Infix (string "-" >>= \_ -> return (-)) AssocRight]
                            ,[Infix (string "+" >>= \_ -> return (+)) AssocRight]] digit
-              
+
 main = do
   parseTest nested "(((a)))"
   parseTest (many (string "a")) "aaa"
@@ -57,6 +59,6 @@ main = do
   parseTest (do
     as <- string "a" `endBy1` string ","
     eof
-    return as) "a,a,a,"  
+    return as) "a,a,a,"
   parseTest opTest "a+b+c"
   parseTest exprTest "1*2+3/4-5"

src/Text/Parsing/Parser.purs

@@ -1,15 +1,15 @@
 module Text.Parsing.Parser where
 
-import Prelude
-
 import Data.Either
 import Data.Maybe
 import Data.Monoid
 import Data.Tuple
 
+import Control.Alt
+import Control.Alternative
+import Control.Plus
 import Control.Monad
 import Control.Monad.Identity
-
 import Control.Monad.Trans
 import Control.Monad.State.Class
 import Control.Monad.State.Trans
@@ -41,23 +41,27 @@ runParser :: forall s a. s -> Parser s a -> Either ParseError a
 runParser s = runIdentity <<< runParserT s
 
 instance functorParserT :: (Functor m) => Functor (ParserT s m) where
-  (<$>) f p = ParserT $ \s -> f' <$> unParserT p s 
+  (<$>) f p = ParserT $ \s -> f' <$> unParserT p s
     where
     f' o = { input: o.input, result: f <$> o.result, consumed: o.consumed }
 
 instance applyParserT :: (Monad m) => Apply (ParserT s m) where
   (<*>) = ap
-  
+
 instance applicativeParserT :: (Monad m) => Applicative (ParserT s m) where
   pure a = ParserT $ \s -> pure { input: s, result: Right a, consumed: false }
-  
-instance alternativeParserT :: (Monad m) => Alternative (ParserT s m) where
-  empty = fail "No alternative"
+
+instance altParserT :: (Monad m) => Alt (ParserT s m) where
   (<|>) p1 p2 = ParserT $ \s -> unParserT p1 s >>= \o ->
     case o.result of
       Left _ | not o.consumed -> unParserT p2 s
       _ -> return o
 
+instance plusParserT :: (Monad m) => Plus (ParserT s m) where
+  empty = fail "No alternative"
+
+instance alternativeParserT :: (Monad m) => Alternative (ParserT s m)
+
 instance bindParserT :: (Monad m) => Bind (ParserT s m) where
   (>>=) p f = ParserT $ \s -> unParserT p s >>= \o ->
     case o.result of
@@ -72,7 +76,7 @@ instance monadTransParserT :: MonadTrans (ParserT s) where
   lift m = ParserT $ \s -> (\a -> { input: s, consumed: false, result: Right a }) <$> m
 
 instance monadStateParserT :: (Monad m) => MonadState s (ParserT s m) where
-  state f = ParserT $ \s -> 
+  state f = ParserT $ \s ->
     return $ case f s of
       Tuple a s' -> { input: s', consumed: false, result: Right a }
 

src/Text/Parsing/Parser/Combinators.purs

@@ -1,14 +1,12 @@
 module Text.Parsing.Parser.Combinators where
 
-import Prelude
-
 import Data.Maybe
 import Data.Array
 import Data.Tuple
 import Data.Either
 
+import Control.Alt
 import Control.Monad
-
 import Control.Monad.Error.Trans
 import Control.Monad.Error.Class
 import Control.Monad.State.Trans
@@ -39,7 +37,7 @@ between :: forall m s a open close. (Monad m) => ParserT s m open -> ParserT s m
 between open close p = do
   open
   a <- p
-  close 
+  close
   return a
 
 option :: forall m s a. (Monad m) => a -> ParserT s m a -> ParserT s m a
@@ -54,7 +52,7 @@ optionMaybe p = option Nothing (Just <$> p)
 
 try :: forall m s a. (Functor m) => ParserT s m a -> ParserT s m a
 try p = ParserT $ \s -> try' s <$> unParserT p s
-  where 
+  where
   try' s o@{ result = Left _ } = { input: s, result: o.result, consumed: false }
   try' _ o = o
 
@@ -80,7 +78,7 @@ sepEndBy1 p sep = do
       return (a : as)) <|> return [a]
 
 endBy1 :: forall m s a sep. (Monad m) => ParserT s m a -> ParserT s m sep -> ParserT s m [a]
-endBy1 p sep = many1 $ do 
+endBy1 p sep = many1 $ do
   a <- p
   sep
   return a

src/Text/Parsing/Parser/Expr.purs

@@ -1,10 +1,10 @@
 module Text.Parsing.Parser.Expr where
 
-import Prelude
-
 import Data.Either
 import Data.Foldable
 
+import Control.Alt
+
 import Text.Parsing.Parser
 import Text.Parsing.Parser.Combinators
 

src/Text/Parsing/Parser/String.purs

@@ -1,34 +1,32 @@
 module Text.Parsing.Parser.String where
 
-import Prelude
-
 import Data.String
 import Data.Either
+import Data.Foldable
+import Data.Monoid
 
+import Control.Alt
 import Control.Monad.Error
 import Control.Monad.Error.Class
 import Control.Monad.State.Class
 
-import Data.Foldable
-import Data.Monoid
-
 import Text.Parsing.Parser
 import Text.Parsing.Parser.Combinators
 
 eof :: forall m. (Monad m) => ParserT String m {}
-eof = ParserT $ \s -> 
+eof = ParserT $ \s ->
   return $ case s of
     "" -> { consumed: false, input: s, result: Right {} }
     _ -> { consumed: false, input: s, result: Left (strMsg "Expected EOF") }
 
 string :: forall m. (Monad m) => String -> ParserT String m String
-string s = ParserT $ \s'  -> 
+string s = ParserT $ \s'  ->
   return $ case indexOf s s' of
     0 -> { consumed: true, input: drop (length s) s', result: Right s }
     _ -> { consumed: false, input: s', result: Left (strMsg ("Expected " ++ show s)) }
 
 char :: forall m. (Monad m) => ParserT String m String
-char = ParserT $ \s' -> 
+char = ParserT $ \s' ->
   return $ case s' of
     "" -> { consumed: false, input: s', result: Left (strMsg "Unexpected EOF") }
     _ -> { consumed: true, input: drop 1 s', result: Right (charAt 0 s') }

src/Text/Parsing/Parser/Token.purs

@@ -1,7 +1,5 @@
 module Text.Parsing.Parser.Token where
 
-import Prelude
-
 import Data.String
 
 import Control.Monad.State.Class