Parser.hs

module MyParser where

import Text.Read (readMaybe)

newtype Parser a = Parser { runParser :: String ->  Either String (a, String) }

parseChar :: Char -> Parser Char
parseChar char =
  Parser $ \input ->
    case input of
      []      -> Left $ "End of input found, expected to find: " <> (show char)
      c :  rest  ->
        if c == char then Right (c, rest)
        else Left $ "Expected: " <> (show char) <> ", found: " <> (show c) <> ", input: " <> input

-- fmap
mapP:: (a -> b) -> Parser a -> Parser b
mapP f p1 =
  Parser $ \input ->
    let result1 = runParser p1 input
    in case result1 of
        Left error -> Left error
        Right (result1, input2) -> Right (f(result1), input2)


andThen :: Parser a -> Parser b -> Parser (a, b)
andThen p1 p2 =
  Parser $ \input1 ->
    case runParser p1 input1 of
      Left error -> Left error
      Right (result1, input2) ->
        case runParser p2 input2 of
          Left error -> Left error
          Right (result2, input3) -> Right ((result1, result2), input3)


orElse :: Parser a -> Parser a -> Parser a
orElse p1 p2 =
  Parser $ \input ->
    case runParser p1 input of
      Left error -> runParser p2 input
      Right result1 -> Right result1

data NonEmpty a = NonEmpty a [a]

choose :: NonEmpty (Parser a) -> Parser a
choose (NonEmpty h xs) = foldl (\p1 p2 -> p1 `orElse` p2) h xs

anyOf :: NonEmpty Char -> Parser Char
anyOf (NonEmpty h xs) =
  let parsersX = NonEmpty (parseChar h) (parseChar <$> xs)
  in choose parsersX


parseLowercase :: Parser Char
parseLowercase = anyOf (NonEmpty 'a' ['b' .. 'z'])

parseDigit :: Parser Char
parseDigit = anyOf (NonEmpty '0' ['1' .. '9'])

-- pure
returnP :: a -> Parser a
returnP value = Parser (\input -> Right (value, input))


-- <*>
-- explain this long form
applyP :: Parser (a -> b) -> Parser a -> Parser b
applyP pf pa =
  let p1 = pf `andThen` pa
  in mapP (\(f, a) -> f a) p1


-- explain this long form
liftA2 :: (a -> b -> c) -> Parser a -> Parser b -> Parser c
liftA2 f pA pB = returnP f `applyP` pA `applyP` pB


-- explain this long form
sequenceP :: [Parser a] -> Parser [a]
sequenceP [] = returnP []
sequenceP (h : t) = liftA2 (:) h (sequenceP t)


stringP :: String -> Parser String
stringP str =
  let charParsers = parseChar <$> str -- [Char]
  in sequenceP charParsers

boolP :: Parser Bool
boolP =
  let boolStrP = stringP "true" `orElse` stringP "false"

      toBool :: String -> Bool
      toBool "true" =  True
      toBool _ =  False

  in mapP toBool boolStrP

many :: Parser a -> Parser [a]
many pa =
  let defaultP = returnP []
  in liftA2 (:) pa (many pa) `orElse` defaultP

many1 :: Parser a -> Parser [a]
many1 pa = liftA2 (:) pa (many pa)

bindP :: Parser a -> (a -> Parser b) -> Parser b
bindP pa f =
  Parser $ \input ->
    case runParser pa input of
      Left error -> Left error
      Right (result1, remainder1) -> runParser (f result1) remainder1

failP :: String -> Parser a
failP errorMessage = Parser (\_ -> Left errorMessage)


digitToIntP :: Parser Int
digitToIntP =
  let digitStrP = many1 parseDigit

      maybeStringToIntP :: Maybe Int -> Parser Int
      maybeStringToIntP (Just number) = returnP number
      maybeStringToIntP Nothing = failP "Invalid number"

  in digitStrP `bindP` (maybeStringToIntP . readMaybe)