import System.Environment

main :: IO()
main = 
  do
    args <- getArgs
    case (args) of
        [arg1]      -> compileIO arg1 "out.s"
        [arg1,arg2] -> compileIO arg1 arg2
        _           -> putStrLn ("Expected two arguments, but "++ show (length args) ++ " were given.")

compileIO :: String -> String -> IO()
compileIO inF outF = 
  do
    cCode <- readFile inF
    let out = do
               cTokens <- parse cTokenize cCode
               parse cParser cTokens 
    case out of
       Valid a -> putStrLn a --writeFile outF a
       Error s -> putStrLn s
        


data Parser c a = Parser ([c] -> Error (a,[c]))
data Error a =  Valid a | Error String
  deriving Show

instance Monad Error where
  Valid a   >>= f = f a
  Error s   >>= f = Error s

  --Valid f <*> Valid a = Valid (f a)
  --Error s <*> _       = Error s
  --_       <*> Error s = Error s

  --return = Valid

instance Functor Error where
  fmap f (Error s) = Error s
  fmap f (Valid a) = Valid (f a)

instance Applicative Error where
  pure = Valid
  

instance Functor (Parser c) where
  fmap :: (a->b) -> Parser c a -> Parser c b
  fmap f (Parser g) = Parser h
    where 
      h s = g s >>= (\(parsed,rest) -> pure (f parsed, rest))
--        do
--          (parsed,rest) <- g s
--          pure (f parsed,rest)

showE (Error _) = "E"
showE (Valid _) = "V"

pToFunc :: Parser c s -> [c] -> Error (s,[c])
pToFunc (Parser f) = f

instance Applicative (Parser c) where
  pure x = Parser (\s ->  Valid (x,s))
  (<*>) f g = Parser h
    where
      h s=
        do
          (func,rest) <- pToFunc f s
          (out,rest2) <- pToFunc g rest
          pure (func out,rest2)

(<|>) :: Parser c a -> Parser c a -> Parser c a
f <|> g = Parser h
  where 
    h s = case (pToFunc f s,pToFunc g s) of
            (x@(Valid _),_) -> x
            (Error _,y)    -> y

parse :: Parser c a -> [c] -> Error a
parse f s = fmap fst (pToFunc f s)

wordSep = [' ','\n','\r','(',')','{','}',';']

word :: String -> a -> Parser Char a
word s a = Parser f
  where
    f t = case valid t of
            True  -> Valid (a, drop (length s) t)
            False -> Error ("Expected "++s)
    valid t = s== take (length s) t &&  (droppedValid $ drop (length s) t)
    droppedValid (x:_) = x `elem` wordSep
    droppedValid []    = True

symbol :: (Show s,Eq s) =>s -> a -> Parser s a
symbol c a = Parser f
  where
    f [] = Error "No symbol"
    f (s:ss) = if s==c then Valid (a,ss) else Error ("Expected "++show c)

many :: Parser c a -> Parser c [a]

many g = ((:) <$> g <*> many g) <|> pure []

many1 :: Parser c a -> Parser c [a]
many1 g = (:) <$> g <*>  many g 

data Expression = ENumber Int | ENegate Expression | EComplement Expression | ENot Expression
  deriving Show

exprToProg (ENumber     n)    = "\tmovl\t$"++(show n)++", %eax\n"
exprToProg (ENegate     expr) = exprToProg expr++"\tneg\t%eax\n"
exprToProg (EComplement expr) = exprToProg expr++"\tnot\t%eax\n"
exprToProg (ENot expr) = exprToProg expr++"\tcmpl\t$0, %eax\n\tmovl\t$0, %eax\n\tsete\t%al\n"
pExpression :: Parser Token Expression
pExpression  = Parser getNumFromToken <|> ((\a b -> a b) <$> (symbol Negate ENegate<|>symbol Complement EComplement<|>symbol Not ENot) <*> pExpression)
  where
    getNumFromToken ((Number n):r) = Valid (ENumber n,r)
    getNumFromToken _ = Error "Expected a number"

cParser :: Parser Token String
cParser = (\_ _ _ _ _ _ expr _ _-> generateProgram expr) <$>
          symbol Integer Integer <*> symbol Main Main <*> symbol LeftBracket LeftBracket
          <*> symbol RightBracket RightBracket <*> symbol LeftCurlyBracket LeftCurlyBracket
          <*> symbol Return Return <*> pExpression
          <*> symbol Semicolon Semicolon <*> symbol RightCurlyBracket RightCurlyBracket
  where
    generateProgram  expr= "\t.text\n\t.globl\tmain\nmain:\n"++exprToProg expr++"\tret"


data Token = Integer | Main | LeftBracket | RightBracket | LeftCurlyBracket |
             RightCurlyBracket | Return | Semicolon | Number Int | Negate |
             Not | Complement
  deriving (Show, Eq)

wordDictionary = [("int",Integer),("main",Main),("return", Return),(";",Semicolon)]

symbolDictionary = [('(',LeftBracket),(')',RightBracket),('{',LeftCurlyBracket),('}',RightCurlyBracket),(';',Semicolon),('-',Negate),('!',Not),('~',Complement)]

pNumber = Number . digitsToNum <$> many1 digit

digit :: Parser Char Int
digit = Parser digitf

digitf:: String -> Error (Int, String)
digitf [] = Error "A digit was expected"
digitf (d:ds) = if d >='0' && d<='9' then Valid (read [d],ds) else Error (d:" is not a digit")

digitsToNum :: [Int] -> Int
digitsToNum = foldl (\b a -> a+10*b) 0

pToken = (foldl1 (<|>) (map (\(w,t) -> word w t)  wordDictionary)) <|> (foldl1 (<|>) (map (\(s,t) -> symbol s t)  symbolDictionary)) <|> pNumber

pSpaces = many pSpace

pSpace = symbol ' ' ' ' <|> symbol '\n' '\n' <|> symbol '\r' '\r' <|> symbol '\t' '\t'

cTokenize :: Parser Char [Token]
cTokenize = (\a b -> b) <$> pSpaces <*> (many ((\a b -> a) <$> pToken <*> pSpaces))