-- monadic parsing
-- https://bitbucket.org/piyush-kurur/functional-programming/raw/a2b004847c92f88aa6ae3073f4d230b3a770cad8/notes/live.org
-- Graham Hutton book (2e)

import Control.Applicative
import Data.Char

-- | Result of parsing
data Result a = OK a String  -- ^ Parsed data
              | Error String -- ^ error message

-- | Parser capable of parsing a value of type `a`
newtype Parser a = Parser {runParser :: String -> Result a}

instance Functor Result where
  -- fmap :: (a -> b) -> Result a -> Result b
  fmap f (OK a s) = OK (f a) s
  fmap _ (Error msg) = Error msg
  --fmap _ obj = obj

instance Applicative Result where
  -- pure :: a -> Result a
  pure x = OK x ""

  -- (<*>) :: Result (a -> b) -> Result a -> Result b
  (OK fa2b rem) <*> a = fa2b <$> a
  (Error msg) <*> _ = Error msg

instance Functor Parser where
  -- fmap :: (a -> b) -> Parser a -> Parser b
  fmap f (Parser pa) = Parser pb
   where
    pb inp = f <$> pa inp

instance Applicative Parser where
  -- pure :: a -> Parser a
  -- insert a value `x` of type `a` to the parsed part
  pure x = Parser (\inp -> OK x inp)

  -- (<*>) :: Parser (a -> b) -> Parser a -> Parser b
  (Parser pa2b) <*> (Parser pa) = Parser pb
   where
    -- `pb inp` should be of type `Result b`
    pb inp = case pa2b inp of
              -- fa2b :: a -> b
              -- rem :: String
              -- 
              -- attempt to parse rem as a, which is then
              -- passed to fa2b to make it b
              -- `pa rem` is of type `Result a`
              -- `fa2b <$> pa rem` is of type `Result b`
              OK fa2b rem -> fa2b <$> (pa rem)
              Error msg -> Error msg

instance Monad Parser where
  -- Context sensitive parsing as ppk said
  -- (>>=) :: Parser a -> (a -> Parser b) -> (Parser b)
  (Parser pa) >>= fa2pb = Parser pb
   where
    -- fa2b :: a -> Parser b
    pb inp = case pa inp of
               -- `fa2pb a` is of type `Parser b`
               -- `runParser $ fa2pb a` is of type `String -> Result b`
               OK a rem -> (runParser $ fa2pb a) rem
               Error msg -> Error msg

instance Alternative Parser where
  -- empty :: Parser a
  empty = Parser (\inp -> Error "empty!")

  -- (<|>) :: Parser a -> Parser a -> Parser a
  -- Try parsing with first parser, if that fails
  -- try parsing with the next parser.
  (Parser px) <|> (Parser py) = Parser pz
   where
    pz inp = case px inp of
               OK xval rem -> OK xval rem
               Error _ ->
                 case py inp of
                   OK yval rem -> OK yval rem
                   Error msg -> Error msg

{-
satisfy :: Char -> String -> Result a
-- `x` is `Char`
satisfy ch (x:rem) = if ch==x then OK x rem
                     else Error "err"

helloP = Parser
-}






  
-- parse :: Parser a -> String -> [(a, String)]
-- -- p :: String -> [(a, String)]
-- parse (Parser p) inp = p inp
-- 
-- item :: Parser Char
-- item = Parser (\inp -> case inp of
--                          []     -> []
--                          (x:xs) -> [(x, xs)])
-- -- λ> parse item "hello"
-- -- [('h',"ello")]
-- 
-- instance Functor Parser where
--   -- fmap :: (a -> b) -> Parser a -> Parser b
--   fmap f pp = Parser (\inp ->
--                         case parse pp inp of
--                           []       -> []
--                           [(x,xs)] -> [(f x,xs)])