module MiniWhile where

import Data.Char
import Data.List
import Data.Maybe
import ParserCon

-- ^ Lexing
-- Use this lexer to tokenize the input before parsing
-- define tokens 
newtype Parser' token result = P' (RawParser token result)

data Token = TSep -- ';'
           | TAsgn -- ':='
           | TNum Integer
           | TId Id
--           | TKeyW String
           | TOp Char
           | TComp String
           | Tlp -- '('
           | Trp -- ')'
     deriving (Eq, Show)
          

lexer :: String -> Maybe [Token]
lexer = parse $ many1 (skipSpace *> p_tok) <* skipSpace -- parse :: Parser Char [token] -> [Char] -> Maybe [token]

skipSpace = many (satisfy isSpace) -- many :: f a -> f [a], satisfy :: (Char -> Bool) -> Parser Char Char


---- parse the string to all the kinds of tokens

p_tok :: Parser Char Token
p_tok =  
  t_alnum
  <|> t_sep
  <|> t_asgn
  <|> t_num
  <|> t_lp <|> t_rp
--  <|> t_keyw "while" <|> t_keyw "do" <|> t_keyw "done" <|> t_keyw "if" 
--  <|> t_keyw "then" <|> t_keyw "else" <|> t_keyw "fi" <|> t_keyw "not"
  <|> t_Op '+' <|> t_Op '*' <|> t_Op '-' <|> t_Op '/'
  <|> t_Comp ">" <|>  t_Comp "<=" <|> t_Comp "==" <|> t_Comp "!="

t_num = TNum . read <$> many1 (satisfy isDigit) -- fmap :: (String -> Token) -> Parser Char [Char] -> Parser Char Token
t_sep = TSep <$ lit ';' -- <$ :: a -> f b -> f a -- ::Parser Char Token
t_asgn = TAsgn <$ string ":=" -- Token -> Parser Char [Char] -> Parser Char Token, t_asgn ":=" [( TAsgn,"")]
t_alnum = fmap mkToken $ (:) <$> satisfy isAlpha <*> many (satisfy isAlphaNum)
  where mkToken i        = TId i

t_lp = Tlp <$ lit '('
t_rp = Trp <$ lit ')'

--pwhile = While <$> parserExp <* lit TDo <*> (many1 pStmt) <* lit $ TDone


t_Op :: Char -> Parser Char Token         
t_Op c = TOp <$> lit c  -- :: Char -> Token -> (Parser Char Char) -> (Parser Char Token
  
--plit :: Eq t => t -> RawParser t t
--plit t = psatisfy (== t)
-- lit x = P $ plit x  :: Char -> Parser Char Char

t_Comp :: String -> Parser Char Token
t_Comp s = TComp <$> string s

-- many :: f a -> f [a]


-- ^ Utilities
string :: Eq a => [a] -> Parser a [a]
string xs = foldr (liftA2 (:)) (pure []) $  map lit xs -- liftA2 :: (a -> b -> c) -> f a -> f b -> f c
                                                       -- foldr :: (a -> b -> b) -> b -> t a -> b
                                                       -- map :: (a -> b) -> (t -> Parser a a) -> 
                                                       -- string :: Eq a => [a] -> Parser a [a] 
many1 :: Parser r t -> Parser r [t]                                                       
many1 p = (:) <$> p <*> many p -- :: a -> [a] -> [a] -> Parser t r -> Parser t [r] -> Parser t [r]



-- ^ Parsing program to results

data Program = Program [Stmt]
  deriving (Show, Eq)

data Stmt = Asgn Aexp Exp | While Exp [Stmt]
  deriving (Show, Eq)

data Exp = IfTE Exp Exp Exp
         | ComExp Aexp ComOp Aexp
         | Not Exp
         | AExp Aexp
  deriving (Show, Eq)

data Aexp = Num Integer
         | Var Id
         | OpA Aexp Op Aexp
  deriving (Show, Eq)

type Id = String

data Op = Plus | Minus | Multi | Div
  deriving (Show, Eq)

data ComOp = LE | Gr | Equal | UnE
  deriving (Show, Eq)

--parse in ParserCon.hs
--parse :: Parser t r -> [t] -> Maybe r
--parse p ts = case  parseLongest p ts of
--               Match x -> Just x
--               _ -> Nothing


parseString :: String -> Maybe Program
parseString s = do
  l <- lexer s
  parse parser l

parseString' :: String -> Maybe Program
parseString' s = do
  l <- lexer s
  parse parser' l

---- lexer :: String -> Maybe [Token]

parser :: Parser Token Program
parser = do 
           stmt  <- parserStm
           stmts <- many (parserTsep *> parserStm)
           return (Program (stmt:stmts))

-- many :: f a -> f [a], f: applicative
-- (*>) :: f a -> f b -> f b
-- (<*) :: f a -> f b -> f a

parser' = Program <$> (pure (:) <*> parserStm <*> many (parserTsep *> parserStm))

parserTsep :: Parser Token ()
parserTsep = P $ \ts -> case ts of 
                          TSep:ts' -> [((), ts')]
                          _        -> []
-- Implement this

parserStm :: Parser Token Stmt
parserStm = parserWhile <|> parserAsgnS

parserStm' = parserWhile' <|> parserAsgnS'

parserWhile :: Parser Token Stmt
parserWhile = do 
                lit (TId "while")
                ex1 <- parserExp 
                lit (TId "do")
                stmts <- many parserStm <|> (pure (:) <*> parserStm <*> many1 (parserTsep *> parserStm)) 
                lit (TId "done") 
                return (While ex1 stmts)

parserWhile' = While <$> (lit (TId "while") *> parserExp') <* lit (TId "do") <*> (many parserStm <|> (pure (:) <*> parserStm <*> many1 (parserTsep *> parserStm)))
---- parse assignment statement

parserAsgnS :: Parser Token Stmt
parserAsgnS = do 
              v <- parserIdV
              lit TAsgn
              ex <- parserExp
              return (Asgn v ex)

----- parse id

parserIdV :: Parser Token Aexp
parserIdV = P $ \ts -> case ts of 
                            TId id:ts' -> [(Var id, ts')]
                            _            -> []

getId :: Token -> Maybe String
getId (TId id) = Just id
getId _        = Nothing

parserIdV' = Var <$> (try getId)

parserAsgnS' = Asgn <$> (Var <$> (try getId)) <*> parserExp'

----- parserKey not used

parserKey :: Parser Token Id
parserKey = P $ \ts -> case ts of 
                       TId s:ts' -> [(s, ts')]
                       _     -> []

---- := is not used in the result grammar, so this parser is not needed
parserAsgn :: Parser Token String
parserAsgn = P $ \ts -> case ts of 
                         TAsgn:ts' -> [(":=", ts')]
                         _     -> []

parserAsgn' = lit TAsgn
--------------------------------------

-------parse expressions--------
parserExp :: Parser Token Exp
parserExp = parserIf <|> parserNexp <|> parserCmp <|> (AExp <$> parserAexp)

parserExp' = parserIf' <|> parserNexp' <|> parserCmp' <|> (AExp <$> parserAexp')         

parserIf :: Parser Token Exp
parserIf = do 
              lit (TId "if")
              ex1 <- parserExp
              lit (TId "then")
              ex2 <- parserExp
              lit (TId "else")
              ex3 <- parserExp
              lit (TId "fi")
              return (IfTE ex1 ex2 ex3)

parserIf' = IfTE <$> (lit (TId "if") *> parserExp <* lit (TId "then")) <*> (parserExp <* lit (TId "else")) <*> (parserExp <* lit (TId "fi"))

--parserIf = do
--             k1 <- parseId
--             case k1 of
--               "if" -> do 
--                         ex1 <- parseExp
--                         k2  <- parseId
--                         case k2 of
--                           "then" -> do
--                                        ex2 <- parseExp
--                                        k3  <- parseId
--                                        case k3 of
--                                          "else" -> do 
--                                                       ex3 <- parseExp
--                                                       k4  <- parseId
--                                                       case k4 of
--                                                         "fi" -> return (IfTE ex1 ex2 ex3)
--                                                          _   -> ?
--                                      _           -> ?
--               _         -> ?

parserNexp :: Parser Token Exp
parserNexp = do 
                lit (TId "not")
                ex <- parserExp
                return (Not ex)

-- parserNexp = do
--               k <- parseId
--               case k of 
--                "not" -> do
--                           ex <- parseExp
--                           return (Not ex)
--                _          -> ?

parserNexp' :: Parser Token Exp
parserNexp' = Not <$> (lit (TId "not") *> parserExp)
 
parserCmp :: Parser Token Exp
parserCmp = do 
             aex1 <- parserAexp
             cop  <- parserComOp 
             aex2 <- parserAexp
             return (ComExp aex1 cop aex2)
---what if cop is not a com - op 

parserCmp' = ComExp <$> parserAexp <*> parserComOp <*> parserAexp

parserComOp :: Parser Token ComOp
parserComOp = P $ \ts -> case ts of 
                          TComp ">":ts'  -> [(Gr, ts')]
                          TComp "<=":ts' -> [(LE, ts')]
                          TComp "==":ts' -> [(Equal, ts')]
                          TComp "!=":ts' -> [(UnE, ts')]
                          _              -> []

parserComOp' :: Parser Token ComOp
parserComOp' = (const Gr <$> lit (TComp ">")) <|> (const LE <$> lit (TComp "<=")) <|> (const Equal <$> lit (TComp "==")) <|> (const UnE <$> lit (TComp "!="))

---------parse aexpressions--------

parserAexp :: Parser Token Aexp
parserAexp =  parserNum <|> parserIdV <|> parserAop 

parserAexp' = parserNum' <|> parserIdV' <|> parserAop' 
                

parserNum :: Parser Token Aexp
parserNum = P $ \ts -> case ts of 
                        TNum i:ts' -> [(Num i, ts')]
                        _      -> []

getNum :: Token -> Maybe Integer
getNum (TNum i) = Just i
getNum _        = Nothing

parserNum' = Num <$> try getNum

-- try getNum :: Parser Token Integer 

parserAop :: Parser Token Aexp
parserAop = do 
               lit Tlp
               aex1 <- parserAexp
               op   <- parserOp
               aex2 <- parserAexp
               lit Trp
               return (OpA aex1 op aex2)

parserAop' = OpA <$> (lit Tlp *> parserAexp) <*> parserOp <*> (parserAexp <* lit Trp) 

parserOp :: Parser Token Op
parserOp = P $ \ts -> case ts of 
                        TOp '+':ts' -> [(Plus, ts')]
                        TOp '-':ts' -> [(Minus, ts')] 
                        TOp '*':ts' -> [(Multi, ts')] 
                        TOp '/':ts' -> [(Div, ts')] 
                        _           -> []

parserOp' = ((const Plus) <$> lit (TOp '+')) <|> ((const Minus) <$> lit (TOp '-')) <|> ((const Multi) <$> lit (TOp '*')) <|> ((const Minus) <$> lit (TOp '/'))  

--parserAop = do 
--             c1 <- parsePar 
--             case c1 of
--              '(' -> do
--                           aex1 <- parseAexp
--                           op   <- parseOp
--                           aex2 <- parseAexp
--                           c2 <- parsePar 
--                           case c2 of
--                             ')' -> return (OpA aex1 op aex2)
--                             _   -> ?
--              _        -> ?

----------'(' and ')' are not used in the grammar, so these functions are not necessary.

parserPar :: Parser Token Char
parserPar = P $ \ts -> case ts of 
                           Tlp:ts' -> [('(', ts')]
                           Trp:ts' -> [(')', ts')]
                           _   -> []

parserLP :: Parser Token Char
parserLP = do 
              lit Tlp
              return '('

parserRP :: Parser Token Char
parserRP = do
              lit Tlp
              return ')'

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