Add parsing sequence for lists of natural numbers

Author: evturn

13-monadic-parsing/13.07-handling-space.hs

@@ -0,0 +1,124 @@
+import           Control.Applicative
+import           Data.Char
+
+newtype Parser a = P (String -> [(a, String)])
+
+parse :: Parser a -> String -> [(a, String)]
+parse (P p) inp = p inp
+
+item :: Parser Char
+item = P $ \inp ->
+  case inp of
+    []     -> []
+    (x:xs) -> [(x, xs)]
+
+instance Functor Parser where
+  fmap f p = P $ \inp ->
+    case parse p inp of
+      []         -> []
+      [(v, out)] -> [(f v, out)]
+
+instance Applicative Parser where
+  pure v = P $ \inp -> [(v, inp)]
+
+  pf <*> px = P $ \inp ->
+    case parse pf inp of
+      []         -> []
+      [(f, out)] -> parse (fmap f px) out
+
+instance Monad Parser where
+  p >>= f = P $ \inp ->
+    case parse p inp of
+      []         -> []
+      [(v, out)] -> parse (f v) out
+
+instance Alternative Parser where
+  empty = P $ \inp -> []
+
+  p <|> q = P $ \inp ->
+    case parse p inp of
+      []         -> parse q inp
+      [(v, out)] -> [(v, out)]
+
+sat :: (Char -> Bool) -> Parser Char
+sat p = do
+  x <- item
+  if p x
+  then return x
+  else empty
+
+digit :: Parser Char
+digit = sat isDigit
+
+lower :: Parser Char
+lower = sat isLower
+
+upper :: Parser Char
+upper = sat isUpper
+
+letter :: Parser Char
+letter = sat isAlpha
+
+alphanum :: Parser Char
+alphanum = sat isAlphaNum
+
+char :: Char -> Parser Char
+char x = sat (== x)
+
+string :: String -> Parser String
+string [] = return []
+string (x:xs) = do
+  char x
+  string xs
+  return (x:xs)
+
+ident :: Parser String
+ident = do
+  x <- lower
+  xs <- many alphanum
+  return (x:xs)
+
+nat :: Parser Int
+nat = do
+  xs <- some digit
+  return (read xs)
+
+space :: Parser ()
+space = do
+  many (sat isSpace)
+  return ()
+
+int :: Parser Int
+int = do
+  char '-'
+  n <- nat
+  return (-n) <|> nat
+
+token :: Parser a -> Parser a
+token p = do
+  space
+  v <- p
+  space
+  return v
+
+identifier :: Parser String
+identifier = token ident
+
+natural :: Parser Int
+natural = token nat
+
+integer :: Parser Int
+integer = token int
+
+symbol :: String -> Parser String
+symbol xs = token (string xs)
+
+nats :: Parser [Int]
+nats = do
+  symbol "["
+  n <- natural
+  ns <- many $ do
+    symbol ","
+    natural
+  symbol "]"
+  return (n:ns)