module ParserCon
-- | The following functions are exported:
  ( module Control.Applicative -- ^ This exports the operators (<*, *>, <*>, <|>,...)
    --   and combintors `empty' and `many'
  , module Control.Monad
  , Parser(..)       -- ^ the parser newtype 
  , RawParser
  , rawParser
  , lit          -- ^ versions of old combinators that work with the newtype
  , satisfy
  , try
  , parse        -- ^ return (Just result) on success
  , parseAll     -- ^ returns the `list of successes' (just applies the underlying RawParser)
  , parseLongest -- ^ returns the longest possible parse (as ParseResult value)
  ) where

import Control.Applicative
import Control.Monad
import Data.Function
import Data.List
import Data.Maybe
import Data.Char

-- ^ Execution of a parser
parse :: Parser t r -> [t] -> Maybe r
parse p ts = case  parseLongest p ts of
               Match x -> Just x
               _ -> Nothing

data ParseResult t r = Match r | Partial (r, [t]) | Fail
  deriving (Show, Eq)

parseLongest :: Parser t r -> [t] -> ParseResult t r
parseLongest p ts =  maybe (tryPartial allResults) Match $  tryMatch allResults -- maybe :: ParseResult t r 
   where allResults = parseAll p ts -- :: [(result, [token])], rs, xs :: [(result, [token])]
         tryMatch rs = fmap fst $ listToMaybe $ dropWhile (not . null . snd) rs -- :: r
         tryPartial [] = Fail
         tryPartial xs = Partial $ minimumBy (compare `on` (length . snd)) xs

-- on :: (b -> b -> c) -> (a -> b) -> a -> a -> c 
-- minimumBy :: (a -> a -> Ordering) -> [a] -> a
-- maybe :: b -> (a -> b) -> Maybe a -> b
-- listToMaybe :: [a] -> Maybe a

parseAll :: Parser t r -> [t] -> [(r, [t])]
parseAll p = rawParser p

-- ^ RawParser, Called "Parser" in the course
type RawParser token result = [token] -> [(result, [token])]
     

-- ^ Modifications and instances, analogous to Parser' in the course
newtype Parser token result = P (RawParser token result)

pempty :: RawParser t r
pempty ts = []

-- succeed recognizes the empty word
psucceed :: r -> RawParser t r
psucceed r ts = [(r, ts)]

psatisfy :: (t -> Bool) -> RawParser t t
psatisfy p [] = []
psatisfy p (t:ts) | p t       = [(t, ts)]
                  | otherwise = []


msatisfy :: (t -> Maybe a) -> RawParser t a
msatisfy f [] = []
msatisfy f (t:ts) = case f t of
                      Nothing -> []
                      Just a  -> psucceed a ts

plit :: Eq t => t -> RawParser t t
plit t = psatisfy (== t)

palt :: RawParser t r -> RawParser t r -> RawParser t r
palt p1 p2 = \ts -> p1 ts ++ p2 ts 

pseq :: RawParser t (s -> r) -> RawParser t s -> RawParser t r
pseq p1 p2 ts = [ (f s, ts'') | (f, ts') <- p1 ts, (s, ts'') <- p2 ts' ]

pmap :: (s -> r) -> RawParser t s -> RawParser t r
pmap f p ts = [ (f s, ts') | (s, ts') <- p ts]



rawParser :: Parser t r -> RawParser t r
rawParser (P p) = p


instance Functor (Parser t) where
  fmap f = P . pmap f . rawParser


instance Applicative (Parser t) where
  pure v = P $ psucceed v
  (P p1) <*> (P p2) = P (p1 `pseq` p2)

instance Alternative (Parser t) where
  empty = P pempty
  P p1 <|> P p2 = P (p1 `palt` p2)

instance Monad (Parser t) where
  return = pure 
  (>>=) (P p) f = P $ \ts ->
    concatMap (\(r, rest) -> rawParser (f r) rest) $ p ts

instance MonadPlus (Parser t) where
  mzero = empty
  mplus = (<|>)

lit x = P $ plit x 
satisfy p = P $ psatisfy p
try p = P $ msatisfy p
succeed r = P $ psucceed r


----Applicative instance----
----use parseAll to parse pmany and pmany1

pmany :: Parser t r -> Parser t [r]
pmany p = pure [] <|> (pure (:) <*> p <*> pmany p) 
    

----functor instance-----
pmany' :: Parser t r -> Parser t [r]
pmany' p = ((fmap (:) p) <*> pmany' p) <|> pure []

----Applicative instance----
pmany1 :: Parser t r -> Parser t [r] 
pmany1 p = (pure (:) <*> p) <*> pmany p

----function instance----
pmany1' :: Parser t r -> Parser t [r]
pmany1' p = (fmap (:) p) <*> pmany p


----use parseLongest to parse pPaliAB parser

pPaliAB = (pmany1 (lit 'a')) <|>
          (pmany1 (lit 'b')) <|>
          (do 
             lit 'a' 
             ab <- pPaliAB
             lit 'a' 
             return ("a" ++ ab ++ "a"))
         <|> 
            (do 
             lit 'b' 
             ab <- pPaliAB
             lit 'b' 
             return ("b" ++ ab ++ "b"))


pPali :: (Eq r) => Parser t r -> Parser t [r]
pPali p = pmany1 p



pTwice :: Eq t => Parser t [t] -> Parser t [t]
pTwice p = p >> p



pIntersperse :: Parser t r -> Parser t w -> Parser t [r] 
pIntersperse pThing pSep = (body <|> return [])
                                where
                                   body = fmap (:) pThing <*> pmany p
                                   p = pSep *> pThing

pInt :: Parser Char Integer
pInt = fmap read (pmany1 (satisfy isDigit))

--- use parseAll to parse pIntList
pIntList :: Parser Char [Integer]
pIntList =
    lit '[' *> pIntersperse pInt (lit ',') <* lit ']'