Bunch of combinators and some string stuff.

joneshf · joneshf · commit a4ea4e76cae2 · 2014-08-06T02:25:35.000-07:00
diff --git a/docs/Module.md b/docs/Module.md
@@ -49,6 +49,11 @@
 
 ## Module Text.Parsing.Parser.Combinators
 
+### Type Class Instances
+
+    instance showParseError :: Show ParseError
+
+
 ### Values
 
     (<?>) :: forall m s a. (Monad m) => ParserT s m a -> String -> ParserT s m a
@@ -77,10 +82,16 @@
 
     fix2 :: forall m s a b. (Tuple (ParserT m s a) (ParserT m s b) -> Tuple (ParserT m s a) (ParserT m s b)) -> Tuple (ParserT m s a) (ParserT m s b)
 
+    lookAhead :: forall s a m. (Monad m) => ParserT s m a -> ParserT s m a
+
     many :: forall m s a. (Monad m) => ParserT s m a -> ParserT s m [a]
 
     many1 :: forall m s a. (Monad m) => ParserT s m a -> ParserT s m [a]
 
+    many1Till :: forall s a m e. (Monad m) => ParserT s m a -> ParserT s m e -> ParserT s m [a]
+
+    manyTill :: forall s a m e. (Monad m) => ParserT s m a -> ParserT s m e -> ParserT s m [a]
+
     option :: forall m s a. (Monad m) => a -> ParserT s m a -> ParserT s m a
 
     optionMaybe :: forall m s a. (Functor m, Monad m) => ParserT s m a -> ParserT s m (Maybe a)
@@ -95,6 +106,10 @@
 
     sepEndBy1 :: forall m s a sep. (Monad m) => ParserT s m a -> ParserT s m sep -> ParserT s m [a]
 
+    skipMany :: forall s a m. (Monad m) => ParserT s m a -> ParserT s m {  }
+
+    skipMany1 :: forall s a m. (Monad m) => ParserT s m a -> ParserT s m {  }
+
     try :: forall m s a. (Functor m) => ParserT s m a -> ParserT s m a
 
 
@@ -144,8 +159,14 @@
 
     eof :: forall m. (Monad m) => ParserT String m {  }
 
+    noneOf :: forall s m a. (Monad m) => [String] -> ParserT String m String
+
+    oneOf :: forall s m a. (Monad m) => [String] -> ParserT String m String
+
     satisfy :: forall m. (Monad m) => (String -> Boolean) -> ParserT String m String
 
+    skipSpaces :: forall m. (Monad m) => ParserT String m {  }
+
     string :: forall m. (Monad m) => String -> ParserT String m String
 
     whiteSpace :: forall m. (Monad m) => ParserT String m String
diff --git a/src/Text/Parsing/Parser.purs b/src/Text/Parsing/Parser.purs
@@ -41,16 +41,16 @@ 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"
   (<|>) p1 p2 = ParserT $ \s -> unParserT p1 s >>= \o ->
@@ -72,7 +72,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 }
 
diff --git a/src/Text/Parsing/Parser/Combinators.purs b/src/Text/Parsing/Parser/Combinators.purs
@@ -39,7 +39,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 +54,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 +80,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
@@ -122,3 +122,37 @@ choice []   = fail "Nothing to parse"
 choice [x]  = x
 choice (x:xs) = x <|> choice xs
 
+skipMany :: forall s a m. (Monad m) => ParserT s m a -> ParserT s m {}
+skipMany p = skipMany1 p <|> return {}
+
+skipMany1 :: forall s a m. (Monad m) => ParserT s m a -> ParserT s m {}
+skipMany1 p = do
+  x <- p
+  xs <- skipMany p
+  return {}
+
+lookAhead :: forall s a m. (Monad m) => ParserT s m a -> ParserT s m a
+lookAhead (ParserT p) = ParserT \s -> do
+  state <- p s
+  return state{input = s, consumed = false}
+
+instance showParseError :: Show ParseError where
+  show (ParseError msg) = msg.message
+
+manyTill :: forall s a m e. (Monad m) => ParserT s m a -> ParserT s m e -> ParserT s m [a]
+manyTill p end = scan
+  where
+    scan = (do
+              end
+              return [])
+       <|> (do
+              x <- p
+              xs <- scan
+              return (x:xs))
+
+many1Till :: forall s a m e. (Monad m) => ParserT s m a -> ParserT s m e -> ParserT s m [a]
+many1Till p end = do
+  x <- p
+  xs <- manyTill p end
+  return (x:xs)
+
diff --git a/src/Text/Parsing/Parser/String.purs b/src/Text/Parsing/Parser/String.purs
@@ -16,19 +16,19 @@ 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') }
@@ -44,3 +44,13 @@ whiteSpace = do
   list <- many $ string "\n" <|> string "\r" <|> string " " <|> string "\t"
   return $ foldMap id list
 
+skipSpaces :: forall m. (Monad m) => ParserT String m {}
+skipSpaces = do
+  whiteSpace
+  return {}
+
+oneOf :: forall s m a. (Monad m) => [String] -> ParserT String m String
+oneOf ss = satisfy (flip elem ss)
+
+noneOf :: forall s m a. (Monad m) => [String] -> ParserT String m String
+noneOf ss = satisfy (flip notElem ss)
