Merge pull request #12 from cryogenian/master

added takeTok, when and get to Token module

docs/Module.md

@@ -2,6 +2,8 @@
 
 ## Module Text.Parsing.Parser
 
+
+
 #### `ParseError`
 
 ``` purescript
@@ -161,6 +163,8 @@ fail :: forall m s a. (Monad m) => String -> ParserT s m a
 
 ## Module Text.Parsing.Parser.Combinators
 
+
+
 #### `(<?>)`
 
 ``` purescript
@@ -339,6 +343,8 @@ many1Till :: forall s a m e. (Monad m) => ParserT s m a -> ParserT s m e -> Pars
 
 ## Module Text.Parsing.Parser.Expr
 
+
+
 #### `Assoc`
 
 ``` purescript
@@ -432,6 +438,8 @@ buildExprParser :: forall m s a. (Monad m) => OperatorTable m s a -> ParserT s m
 
 ## Module Text.Parsing.Parser.String
 
+
+
 #### `eof`
 
 ``` purescript
@@ -491,6 +499,29 @@ noneOf :: forall s m a. (Monad m) => [String] -> ParserT String m String
 
 ## Module Text.Parsing.Parser.Token
 
+
+
+#### `token`
+
+``` purescript
+token :: forall m a. (Monad m) => ParserT [a] m a
+```
+
+
+#### `when`
+
+``` purescript
+when :: forall m a. (Monad m) => (a -> Boolean) -> ParserT [a] m a
+```
+
+
+#### `match`
+
+``` purescript
+match :: forall a m. (Monad m, Eq a) => a -> ParserT [a] m a
+```
+
+
 #### `LanguageDef`
 
 ``` purescript

examples/Test.purs

@@ -16,6 +16,7 @@ import Text.Parsing.Parser
 import Text.Parsing.Parser.Combinators
 import Text.Parsing.Parser.Expr
 import Text.Parsing.Parser.String
+import Text.Parsing.Parser.Token
 
 parens :: forall m a. (Monad m) => ParserT String m a -> ParserT String m a
 parens = between (string "(") (string ")")
@@ -58,6 +59,23 @@ manySatisfyTest = do
     string "?"
     return r
 
+data TestToken = A | B
+
+instance showTestTokens :: Show TestToken where
+  show A = "A"
+  show B = "B"
+
+instance testTokensEq :: Eq TestToken where
+  (==) A A = true
+  (==) B B = true
+  (==) _ _ = false
+  (/=) a b = not $ a == b
+
+isA :: TestToken -> Boolean
+isA A = true
+isA _ = false
+
+
 main = do
   parseTest nested "(((a)))"
   parseTest (many (string "a")) "aaa"
@@ -72,3 +90,22 @@ main = do
   parseTest opTest "a+b+c"
   parseTest exprTest "1*2+3/4-5"
   parseTest manySatisfyTest "ab?"
+
+  print "should be A"
+  parseTest token [A, B]
+  print "should be B"
+  parseTest token [B, A]
+
+  print "should be A"
+  parseTest (when isA) [A, B]
+  print "should fail"
+  parseTest (when isA) [B, B]
+
+  print "should be A"
+  parseTest (match A) [A]
+  print "should be B"
+  parseTest (match B) [B]
+  print "should be A"
+  parseTest (match A) [A, B]
+  print "should fail"
+  parseTest (match B) [A, B]

src/Text/Parsing/Parser/Token.purs

@@ -1,14 +1,33 @@
 module Text.Parsing.Parser.Token where
 
 import Data.String
+import Data.Either
 
-import Control.Monad.State.Class
+import Control.Monad.State.Class hiding (get)
+import Control.Monad.Error
 import Control.Monad.Error.Class
+import Control.MonadPlus
 
 import Text.Parsing.Parser
 import Text.Parsing.Parser.String
 import Text.Parsing.Parser.Combinators
 
+token :: forall m a. (Monad m) => ParserT [a] m a
+token = ParserT $ \s ->
+  return $ case s of
+    x:xs -> { consumed: true, input: xs, result: Right x }
+    _ -> { consumed: false, input: s, result: Left (strMsg "expected token, met EOF") }
+
+when :: forall m a. (Monad m) => (a -> Boolean) -> ParserT [a] m a
+when f = try $ do
+  a <- token
+  guard $ f a
+  return a
+
+match :: forall a m. (Monad m, Eq a) => a -> ParserT [a] m a
+match token = when ((==) token)
+
+
 type LanguageDef s m = {
     commentStart    :: String,
     commentEnd      :: String,