module MyParser where

import Data.Char
      
data Parser a = P {
  parse :: String -> Maybe (String, a)
}

value :: a -> Parser a
value a = P (\s -> Just (s, a))

failed :: Parser a
failed = P (\_ -> Nothing)

character :: Parser Char
character = P (\s -> case s of [] -> Nothing
                               (c:r) -> Just (r, c))

(|||) :: Parser a -> Parser a -> Parser a
P p1 ||| P p2 = P (\s -> case p1 s of v@(Just _) -> v
                                      Nothing -> p2 s)

mapParser :: Parser a -> (a -> b) -> Parser b
mapParser (P p) f = P (\s -> case p s of Just (r, c) -> Just (r, f c)
                                         Nothing -> Nothing)

bindParser :: Parser a -> (a -> Parser b) -> Parser b
bindParser (P p) f = P (\s -> case p s of Just (r, c) -> parse (f c) r
                                          Nothing -> Nothing)

(>>>) :: Parser a -> Parser b -> Parser b
p >>> q = bindParser p (\_ -> q)

sequenceParser :: [Parser a] -> Parser [a]
sequenceParser [] = value []
sequenceParser (h:t) = bindParser h (\a -> mapParser (sequenceParser t) (\as -> a : as))

thisMany :: Int -> Parser a -> Parser [a]
thisMany n p = sequenceParser (replicate n p)

list :: Parser a -> Parser [a]
list k = many1 k ||| value []

many1 :: Parser a -> Parser [a]
many1 k = bindParser k (\k' -> mapParser (list k) (\kk' -> k' : kk'))

satisfy :: (Char -> Bool) -> Parser Char
satisfy p = bindParser character (\c -> if p c then value c else failed)

is :: Char -> Parser Char
is c = satisfy (== c)

digit :: Parser Char
digit = satisfy isDigit

natural :: Parser Int
natural = mapParser (list digit) read

space :: Parser Char
space = satisfy isSpace

spaces :: Parser String
spaces = many1 space

lower :: Parser Char
lower = satisfy isLower

upper :: Parser Char
upper = satisfy isUpper

alpha :: Parser Char
alpha = satisfy isAlpha

alphanum :: Parser Char
alphanum = satisfy isAlphaNum

data Person = Person {
  age :: Int,
  firstName :: String,
  surname :: String,
  gender :: Char,
  phone :: String
} deriving Show

ageParser :: Parser Int
ageParser = natural

firstNameParser :: Parser String
firstNameParser = bindParser upper (\c -> mapParser (list lower) (\cs -> c : cs))

surnameParser :: Parser String
surnameParser = bindParser upper (\c -> bindParser (thisMany 5 lower) (\cs -> mapParser (list lower) (\t -> c : cs ++ t)))

genderParser :: Parser Char
genderParser = is 'm' ||| is 'f'

phoneBodyParser :: Parser String
phoneBodyParser = list (digit ||| is '.' ||| is '-')

phoneParser :: Parser String
phoneParser = bindParser digit (\d -> bindParser phoneBodyParser (\z -> mapParser (is '#') (\_ -> d : z)))

personParser1 :: Parser Person
personParser1 = bindParser ageParser (\age ->
                spaces >>>
                bindParser firstNameParser (\firstName ->
                spaces >>>
                bindParser surnameParser (\surname ->
                spaces >>>
                bindParser genderParser (\gender ->
                spaces >>>
                bindParser phoneParser (\phone ->
                value (Person age firstName surname gender phone))))))

instance Monad Parser where
  (>>=) = bindParser
  return = value

personParser2 :: Parser Person
personParser2 = do age <- ageParser
                   spaces
                   firstName <- firstNameParser
                   spaces
                   surname <- surnameParser
                   spaces
                   gender <- genderParser
                   spaces
                   phone <- phoneParser
                   return (Person age firstName surname gender phone)