{-# LANGUAGE LambdaCase #-}
module Monpar where

import qualified Control.Applicative as Ap
import Control.Applicative ((<|>), Alternative, many, some)
import Data.Char (isDigit, digitToInt)
import Control.Monad ( MonadPlus(mzero), void ) 
import Text.Printf (printf)
newtype Parser a = Parser {runParser :: String -> [(a, String)]}

instance Functor Parser where
    fmap f p = Parser $ \inp -> [ (f x,xs) | (x,xs) <- runParser p inp ]

instance Applicative Parser where
    pure v = Parser $ \inp -> [(v,inp)]
    d <*> e = d >>= (<$> e)

instance Monad Parser where
    return = pure
    p >>= f = Parser $ \inp -> concat [runParser (f v) out | (v,out) <- runParser p inp]

instance Alternative Parser where
    empty = Parser $ const []
    p <|> q = Parser $ \inp -> runParser p inp ++ runParser q inp
    many p = do { x <- p; xs <- many p; return $ x:xs } <|> return []
    some p = do
        x <- p
        xs <- many p
        return $ x:xs

instance MonadPlus Parser

instance MonadFail Parser where
    fail _ = mzero

(<++) :: Parser a -> Parser a -> Parser a
p <++ q = Parser $ \inp -> let r1 = runParser p inp in
    if null r1 then runParser q inp else r1

get :: Parser Char 
get = Parser $ \case
    [] -> [] 
    x:xs -> [(x,xs)]


look :: Parser Char 
look = Parser $ \case
    [] -> []
    x:xs -> [(x,x:xs)]

sat :: (Char -> Bool) -> Parser Char 
sat p = do
    c <- get
    if p c then return c else mzero

char :: Char -> Parser Char
char c = sat (== c)

string :: String -> Parser String
string "" = return "" 
string (x:xs) = do
    char x
    string xs
    return (x:xs)

eof :: Parser () 
eof = Parser $ \inp -> [((), inp) | null inp]

option :: a -> Parser a -> Parser a
option x p = p <|> return x

word :: Parser String
word = neWord <|> return ""
    where 
        neWord = do
            x <- sat (\x -> x /= '\n' && x /= ' ')
            xs <- word
            return $ x:xs

manyTill :: Parser a -> Parser b -> Parser [a]
manyTill p q = (q >> return []) <++ do { x <- p; xs <- manyTill p q; return $ x:xs }