Merge pull request #1 from purescript-contrib/alternative

Add Alt, Plus, MonadPlus, update Alternative

Author: garyb

bower.json

@@ -15,13 +15,14 @@
     "package.json"
   ],
   "dependencies": {
-    "purescript-arrays"               : "*",
-    "purescript-maybe"                : "*",
-    "purescript-strings"              : "*",
+    "purescript-control": "~0.2.0",
+    "purescript-arrays": "~0.2.0",
+    "purescript-maybe": "~0.2.0",
+    "purescript-strings": "*",
     "purescript-foldable-traversable" : "*"
   },
   "devDependencies": {
-    "purescript-math"                 : "*",
-    "purescript-quickcheck"           : "*"
+    "purescript-math": "*",
+    "purescript-quickcheck": "*"
   }
 }

src/Text/Parsing/StringParser.purs

@@ -1,12 +1,17 @@
 module Text.Parsing.StringParser where
-  
+
 import Data.Either (Either(..))
 
+import Control.Alt
+import Control.Alternative
+import Control.MonadPlus
+import Control.Plus
+
 type Pos = Number
 
--- 
+--
 -- Strings are represented as a string with an index from the
--- start of the string. 
+-- start of the string.
 --
 -- { str: s, pos: n } is interpreted as the substring of s
 -- starting at index n.
@@ -25,7 +30,7 @@ instance showParseError :: Show ParseError where
   show (ParseError msg) = msg
 
 --
--- A parser is represented as a function which takes a pair of 
+-- A parser is represented as a function which takes a pair of
 -- continuations for failure and success.
 --
 data Parser a = Parser (forall r. PosString -> (Pos -> ParseError -> r) -> (a -> PosString -> r) -> r)
@@ -41,35 +46,41 @@ runParser p s = unParser p { str: s, pos: 0 } (\_ err -> Left err) (\a _ -> Righ
 --
 
 instance functorParser :: Functor Parser where
-  (<$>) f p = Parser (\s fc sc -> 
+  (<$>) f p = Parser (\s fc sc ->
     unParser p s fc (\a s' -> sc (f a) s'))
 
 instance applyParser :: Apply Parser where
-  (<*>) f x = Parser (\s fc sc -> 
+  (<*>) f x = Parser (\s fc sc ->
     unParser f s fc (\f' s' ->
       unParser x s' fc (\x' s'' -> sc (f' x') s'')))
 
 instance applicativeParser :: Applicative Parser where
   pure a = Parser (\s _ sc -> sc a s)
 
+instance altParser :: Alt Parser where
+  (<|>) p1 p2 = Parser (\s fc sc ->
+    unParser p1 s (\pos msg ->
+      if s.pos == pos
+      then unParser p2 s fc sc
+      else fc pos msg)
+      sc)
+
+instance plusParser :: Plus Parser where
+  empty = fail "No alternative"
+
+instance alternativeParser :: Alternative Parser
+
 instance bindParser :: Bind Parser where
   (>>=) p f = Parser (\s fc sc ->
     unParser p s fc (\a s' ->
       unParser (f a) s' fc sc))
 
 instance monadParser :: Monad Parser
 
-instance alternativeParser :: Alternative Parser where
-  empty = fail "No alternative"
-  (<|>) p1 p2 = Parser (\s fc sc -> 
-    unParser p1 s (\pos msg -> 
-      if s.pos == pos 
-      then unParser p2 s fc sc 
-      else fc pos msg) 
-      sc)
+instance monadPlusParser :: MonadPlus Parser
 
 fail :: forall a. String -> Parser a
 fail msg = Parser (\{ pos = pos } fc _ -> fc pos (ParseError msg))
 
 try :: forall a. Parser a -> Parser a
-try p = Parser (\(s@{ pos = pos }) fc sc -> unParser p s (\_ -> fc pos) sc)
+try p = Parser (\(s@{ pos = pos }) fc sc -> unParser p s (\_ -> fc pos) sc)

src/Text/Parsing/StringParser/Combinators.purs

@@ -1,6 +1,9 @@
 module Text.Parsing.StringParser.Combinators where
 
 import Data.Maybe (Maybe(..))
+
+import Control.Alt
+
 import Text.Parsing.StringParser
 
 many :: forall a. Parser a -> Parser [a]
@@ -22,14 +25,14 @@ between :: forall a open close. Parser open -> Parser close -> Parser a -> Parse
 between open close p = do
   open
   a <- p
-  close 
+  close
   return a
 
 option :: forall a. a -> Parser a -> Parser a
 option a p = p <|> return a
 
-optional :: forall a. Parser a -> Parser {}
-optional p = (p >>= \_ -> return {}) <|> return {}
+optional :: forall a. Parser a -> Parser Unit
+optional p = (p >>= \_ -> return unit) <|> return unit
 
 optionMaybe :: forall a. Parser a -> Parser (Maybe a)
 optionMaybe p = option Nothing (Just <$> p)
@@ -56,7 +59,7 @@ sepEndBy1 p sep = do
       return (a : as)) <|> return [a]
 
 endBy1 :: forall a sep. Parser a -> Parser sep -> Parser [a]
-endBy1 p sep = many1 $ do 
+endBy1 p sep = many1 $ do
   a <- p
   sep
   return a

src/Text/Parsing/StringParser/Expr.purs

@@ -3,6 +3,8 @@ module Text.Parsing.StringParser.Expr where
 import Data.Either
 import Data.Foldable
 
+import Control.Alt
+
 import Text.Parsing.StringParser
 import Text.Parsing.StringParser.Combinators
 
@@ -22,27 +24,27 @@ type SplitAccum a = { rassoc :: [Parser (a -> a -> a)]
 
 buildExprParser :: forall a. OperatorTable a -> Parser a -> Parser a
 buildExprParser operators simpleExpr =
-  let 
+  let
     makeParser term ops =
-      let 
-        accum     = foldr splitOp { rassoc: [], lassoc: [], nassoc: [], prefix: [], postfix: [] } ops 
-
-        rassocOp  = choice accum.rassoc 
-        lassocOp  = choice accum.lassoc 
-        nassocOp  = choice accum.nassoc 
-        prefixOp  = choice accum.prefix <?> "" 
-        postfixOp = choice accum.postfix <?> "" 
-         
+      let
+        accum     = foldr splitOp { rassoc: [], lassoc: [], nassoc: [], prefix: [], postfix: [] } ops
+
+        rassocOp  = choice accum.rassoc
+        lassocOp  = choice accum.lassoc
+        nassocOp  = choice accum.nassoc
+        prefixOp  = choice accum.prefix <?> ""
+        postfixOp = choice accum.postfix <?> ""
+
         postfixP = postfixOp <|> return id
-        prefixP = prefixOp <|> return id 
+        prefixP = prefixOp <|> return id
       in do
         x <- termP prefixP term postfixP
         rassocP x rassocOp prefixP term postfixP
           <|> lassocP x lassocOp prefixP term postfixP
           <|> nassocP x nassocOp prefixP term postfixP
           <|> return x
           <?> "operator"
-          
+
     splitOp :: forall a. Operator a -> SplitAccum a -> SplitAccum a
     splitOp (Infix op AssocNone)  accum = accum { nassoc  = op: accum.nassoc }
     splitOp (Infix op AssocLeft)  accum = accum { lassoc  = op: accum.lassoc }
@@ -83,4 +85,4 @@ buildExprParser operators simpleExpr =
       post  <- postfixP
       return (post (pre x))
 
-  in foldl (makeParser) simpleExpr operators
+  in foldl (makeParser) simpleExpr operators

src/Text/Parsing/StringParser/String.purs

@@ -1,12 +1,12 @@
 module Text.Parsing.StringParser.String where
-  
+
 import Data.String (charAt, length, take, indexOf')
 import Text.Parsing.StringParser
 
-eof :: Parser {}
+eof :: Parser Unit
 eof = Parser (\s fc sc -> case s of
-  { str = str, pos = i } | i < length str -> fc i (ParseError "Expected EOF") 
-  _ -> sc {} s)
+  { str = str, pos = i } | i < length str -> fc i (ParseError "Expected EOF")
+  _ -> sc unit s)
 
 anyChar :: Parser String
 anyChar = Parser (\s fc sc -> case s of
@@ -16,4 +16,4 @@ anyChar = Parser (\s fc sc -> case s of
 string :: String -> Parser String
 string nt = Parser (\s fc sc -> case s of
   { str = str, pos = i } | indexOf' nt i str == i -> sc nt { str: str, pos: i + length nt }
-  { pos = i } -> fc i (ParseError $ "Expected '" ++ nt ++ "'."))
+  { pos = i } -> fc i (ParseError $ "Expected '" ++ nt ++ "'."))

tests/Tests.purs

@@ -6,9 +6,10 @@ import Data.Either
 
 import Debug.Trace
 
+import Control.Alt
 import Control.Monad.Eff
 
-import Text.Parsing.StringParser 
+import Text.Parsing.StringParser
 import Text.Parsing.StringParser.Combinators
 import Text.Parsing.StringParser.String
 import Text.Parsing.StringParser.Expr
@@ -19,38 +20,38 @@ parens :: forall a. Parser a -> Parser a
 parens = between (string "(") (string ")")
 
 nested :: Parser Number
-nested = fix $ \p -> (do 
+nested = fix $ \p -> (do
   string "a"
   return 0) <|> ((+) 1) <$> parens p
 
-parseTest :: forall a eff. (Show a) => Parser a -> String -> Eff (trace :: Trace | eff) {}
+parseTest :: forall a eff. (Show a) => Parser a -> String -> Eff (trace :: Trace | eff) Unit
 parseTest p input = case runParser p input of
   Left (ParseError err) -> print err
   Right result -> print result
 
 opTest :: Parser String
-opTest = chainl anyChar (do 
+opTest = chainl anyChar (do
   string "+"
   return (++)) ""
-  
+
 digit :: Parser 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 Number
 exprTest = buildExprParser [[Infix (string "/" >>= \_ -> return (/)) AssocRight]
                            ,[Infix (string "*" >>= \_ -> return (*)) AssocRight]
                            ,[Infix (string "-" >>= \_ -> return (-)) AssocRight]
                            ,[Infix (string "+" >>= \_ -> return (+)) AssocRight]] digit
-                           
+
 tryTest :: Parser String
 tryTest = try ((++) <$> string "aa" <*> string "bb") <|>
           (++) <$> string "aa" <*> string "cc"
@@ -65,7 +66,7 @@ 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"
   parseTest tryTest "aacc"