import Control.Applicative -- for `Alternative' typeclass
import qualified Data.Char

data Result a
  = Ok a String
  | Err
  deriving Show
  
newtype Parser a = Parser {
  -- | Run parser on some input
  parse :: String -> Result a
}

instance Functor Result where
  -- f :: a -> b
  -- ra :: Result a
  fmap f ra = case ra of
    Ok a rem -> Ok (f a) rem
    Err -> Err

-- instance Alternative Result where
--   (<|>) r1 r2 = case r1 of
--     Ok _ _ -> r1
--     Err -> r2

instance Functor Parser where
  -- f :: a -> b
  -- pa :: Parser a
  fmap f pa = Parser $ \inp ->
    -- resa :: Result a
    let resa = parse pa inp in
    f <$> resa

instance Applicative Parser where
  -- pab :: Parser (a -> b)
  -- pa :: Parser a
  (<*>) pab pa = Parser $ \inp ->
    -- resf :: Result (a -> b)
    let resf = parse pab inp in
    case resf of
      -- f :: a -> b
      Ok f remf -> 
        let resa = parse pa remf in
        case resa of
          -- resa :: Result a
          Ok a rem -> Ok (f a) rem
          Err -> Err
      Err -> Err

  -- pure :: a -> Parser a
  pure a = Parser $ \inp -> Ok a inp

instance Monad Parser where
  -- pa :: Parser a
  -- f :: a -> Parser b
  (>>=) pa f = Parser $ \inp ->
    let resa = parse pa inp in
    case resa of
      -- resa :: Result a
      Ok a rem ->
        let res = f a in
        -- res :: Parser b
        parse res rem
      Err -> Err

instance Alternative Parser where
  -- empty is identity of (<|>)
  empty = Parser $ \inp -> Err

  (<|>) p1 p2 = Parser $ \inp ->
    -- p1 p2 :: Parser a 
    let res = parse p1 inp in
    case res of
      Ok _ _ -> res
      Err -> parse p2 inp

--------------------------------------------------

{- Helper functions -}

digitsToNat :: [Int] -> Int
digitsToNat = foldl (\res x -> res*10 + x) 0

satisfy :: (Char -> Bool) -> Parser Char
satisfy f = Parser $ \inp ->
  case inp of
    a:rem -> if f a then Ok a rem
             else Err
    _ -> Err

--------------------------------------------------

{- Primitive combinators -}
  
char :: Char -> Parser Char
char a = satisfy (==a)

digit :: Parser Char
digit = satisfy Data.Char.isDigit

nat :: Parser String
nat = some digit

spaces :: Parser String
spaces = many $ satisfy (==' ') 

string :: String -> Parser String
string str = traverse char str

choice :: [Parser a] -> Parser a
choice ps = case ps of
  [] -> empty
  p:ps -> p <|> (choice ps)

-- For left-associative operations
chainl :: Parser a -> Parser (a -> a -> a) -> Parser a
chainl p op = do {
    x <- p
  ; rest x
  }
 where
  rest x = do {
    f <- op
   ;  y <- p
   ; rest (f x y)
   } <|> return x

-- between :: Char -> Char -> Parser a
-- between open close = Parser $ \inp ->
--   case inp of
--     [] -> empty
--     c:cs ->
--       if c==open


--------------------------------------------------

{- Trying out -}

ca = char 'a'
eg = (many ca) <|> empty
-- λ> parse eg "a"
-- Ok "a" ""
-- λ> parse eg "aaaaaa"
-- Ok "aaaaaa" ""
-- λ> parse eg "baa"
-- Ok "" "baa"


-- λ> parse nat "123"
-- Ok 123 ""
-- λ> parse nat "123ab"
-- Ok 123 "ab"

-- λ> parse spaces "    a"
-- Ok "    " "a"

-- λ> parse (choice $ map char "abcd") "c"
-- Ok 'c' ""
-- λ> parse (many (choice $ map char "abcd")) "cabcdcdabdeh"
-- Ok "cabcdcdabd" "eh"

--------------------------------------------------

{-
 - Expression language example

E = n
  | E + E

After removing left recursion:

E = E + E | n

E  = n E'
E' = + E E' | ε
 -}


data Expr
  = Val Int
  | Add Expr Expr
  deriving Show

eval :: Expr -> Int
eval e = case e of
  Val n -> n
  Add e1 e2 -> (eval e1) + (eval e2)

-- parser for `Expr'

op = do
  spaces
  char '+'
  return Add

cnst = do
  spaces
  n <- nat
  return $ (Val . read) n

-- cnst = Val . read <$> nat

expr = chainl cnst op

-- E :: Parser Expr
-- E = do
--   n <- nat
  


-- pE =  



-- λ> parse valP "234"
-- Ok (Val 234) ""












--------------------------------------------------


{- Useful functions -}

-- λ> :t traverse
-- traverse
--   :: (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b)
-- λ> :t mapM
-- mapM :: (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b)


  

-- -- newtype Parser a = Parser {
-- --   -- | Run parser on some input
-- --   parse :: String -> (Maybe [a], String)
-- -- }

-- -- satisfy :: (Char -> Bool) -> Parser Char
-- -- satisfy f = Parser $ \inp ->
-- --   case inp of
-- --     [] -> (Nothing, [])
-- --     ch:str ->
-- --       if f ch then (Just [ch], str)
-- --       else (Nothing, inp)

-- -- char :: Char -> Parser Char
-- -- char a = satisfy (==a)

-- -- instance Functor Parser where
-- --   fmap fab (Parser fa) = Parser $ \inp -> do
-- --     -- res <- fa inp
-- --     -- return (fab <$> res)






-- -- import Control.Applicative -- for `Alternative' typeclass
-- -- import qualified Data.Char

-- newtype Parser a = Parser {
--   -- | Run parser on some input
--   parse :: String -> Maybe [(a, String)]
-- }

-- satisfy :: (Char -> Bool) -> Parser Char
-- satisfy f = Parser $ \inp ->
--   case inp of
--     [] -> Nothing
--     ch:str ->
--       if f ch then Just [(ch, str)]
--       else Nothing

-- char :: Char -> Parser Char
-- char a = satisfy (==a)

-- instance Functor Parser where
--   fmap fab (Parser fa) = Parser $ \inp ->
--     case (fa inp) of
--       Just ls -> Just $ map (\x -> (fab (fst x), snd x)) ls
--       Nothing -> Nothing

-- instance Applicative Parser where
--   <*> f (
  
-- instance Monad Parser where