module HaskellWorks.Data.String.Parse where

import Control.Monad
import Control.Applicative

newtype Parser a = Parser { Parser a -> String -> [(a, String)]
parse :: String -> [(a, String)] }

runParser :: Parser a -> String -> a
runParser :: Parser a -> String -> a
runParser Parser a
m String
s =
  case Parser a -> String -> [(a, String)]
forall a. Parser a -> String -> [(a, String)]
parse Parser a
m String
s of
    [(a
res, [])] -> a
res
    [(a
_, String
_)]    -> String -> a
forall a. HasCallStack => String -> a
error String
"Parser did not consume entire stream."
    [(a, String)]
_           -> String -> a
forall a. HasCallStack => String -> a
error String
"Parser error."

item :: Parser Char
item :: Parser Char
item = (String -> [(Char, String)]) -> Parser Char
forall a. (String -> [(a, String)]) -> Parser a
Parser ((String -> [(Char, String)]) -> Parser Char)
-> (String -> [(Char, String)]) -> Parser Char
forall a b. (a -> b) -> a -> b
$ \String
s ->
  case String
s of
   []     -> []
   (Char
c:String
cs) -> [(Char
c,String
cs)]

bind :: Parser a -> (a -> Parser b) -> Parser b
bind :: Parser a -> (a -> Parser b) -> Parser b
bind Parser a
p a -> Parser b
f = (String -> [(b, String)]) -> Parser b
forall a. (String -> [(a, String)]) -> Parser a
Parser ((String -> [(b, String)]) -> Parser b)
-> (String -> [(b, String)]) -> Parser b
forall a b. (a -> b) -> a -> b
$ \String
s -> ((a, String) -> [(b, String)]) -> [(a, String)] -> [(b, String)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(a
a, String
s') -> Parser b -> String -> [(b, String)]
forall a. Parser a -> String -> [(a, String)]
parse (a -> Parser b
f a
a) String
s') ([(a, String)] -> [(b, String)]) -> [(a, String)] -> [(b, String)]
forall a b. (a -> b) -> a -> b
$ Parser a -> String -> [(a, String)]
forall a. Parser a -> String -> [(a, String)]
parse Parser a
p String
s

unit :: a -> Parser a
unit :: a -> Parser a
unit a
a = (String -> [(a, String)]) -> Parser a
forall a. (String -> [(a, String)]) -> Parser a
Parser (\String
s -> [(a
a,String
s)])

instance Functor Parser where
  fmap :: (a -> b) -> Parser a -> Parser b
fmap a -> b
f (Parser String -> [(a, String)]
cs) = (String -> [(b, String)]) -> Parser b
forall a. (String -> [(a, String)]) -> Parser a
Parser (\String
s -> [(a -> b
f a
a, String
b) | (a
a, String
b) <- String -> [(a, String)]
cs String
s])

instance Applicative Parser where
  pure :: a -> Parser a
pure = a -> Parser a
forall a. a -> Parser a
unit
  (Parser String -> [(a -> b, String)]
cs1) <*> :: Parser (a -> b) -> Parser a -> Parser b
<*> (Parser String -> [(a, String)]
cs2) = (String -> [(b, String)]) -> Parser b
forall a. (String -> [(a, String)]) -> Parser a
Parser (\String
s -> [(a -> b
f a
a, String
s2) | (a -> b
f, String
s1) <- String -> [(a -> b, String)]
cs1 String
s, (a
a, String
s2) <- String -> [(a, String)]
cs2 String
s1])

instance Monad Parser where
  >>= :: Parser a -> (a -> Parser b) -> Parser b
(>>=)  = Parser a -> (a -> Parser b) -> Parser b
forall a b. Parser a -> (a -> Parser b) -> Parser b
bind

instance MonadPlus Parser where
  mzero :: Parser a
mzero = Parser a
forall a. Parser a
failure
  mplus :: Parser a -> Parser a -> Parser a
mplus = Parser a -> Parser a -> Parser a
forall a. Parser a -> Parser a -> Parser a
combine

instance Alternative Parser where
  empty :: Parser a
empty = Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
  <|> :: Parser a -> Parser a -> Parser a
(<|>) = Parser a -> Parser a -> Parser a
forall a. Parser a -> Parser a -> Parser a
option

combine :: Parser a -> Parser a -> Parser a
combine :: Parser a -> Parser a -> Parser a
combine Parser a
p Parser a
q = (String -> [(a, String)]) -> Parser a
forall a. (String -> [(a, String)]) -> Parser a
Parser (\String
s -> Parser a -> String -> [(a, String)]
forall a. Parser a -> String -> [(a, String)]
parse Parser a
p String
s [(a, String)] -> [(a, String)] -> [(a, String)]
forall a. [a] -> [a] -> [a]
++ Parser a -> String -> [(a, String)]
forall a. Parser a -> String -> [(a, String)]
parse Parser a
q String
s)

failure :: Parser a
failure :: Parser a
failure = (String -> [(a, String)]) -> Parser a
forall a. (String -> [(a, String)]) -> Parser a
Parser ([(a, String)] -> String -> [(a, String)]
forall a b. a -> b -> a
const [])

option :: Parser a -> Parser a -> Parser a
option :: Parser a -> Parser a -> Parser a
option  Parser a
p Parser a
q = (String -> [(a, String)]) -> Parser a
forall a. (String -> [(a, String)]) -> Parser a
Parser ((String -> [(a, String)]) -> Parser a)
-> (String -> [(a, String)]) -> Parser a
forall a b. (a -> b) -> a -> b
$ \String
s ->
  case Parser a -> String -> [(a, String)]
forall a. Parser a -> String -> [(a, String)]
parse Parser a
p String
s of
    []     -> Parser a -> String -> [(a, String)]
forall a. Parser a -> String -> [(a, String)]
parse Parser a
q String
s
    [(a, String)]
res    -> [(a, String)]
res

char :: Char -> Parser Char
char :: Char -> Parser Char
char Char
c = do
  Char
d <- Parser Char
item
  if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
d then Char -> Parser Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c else Parser Char
forall a. Parser a
failure