-- Main15minMonad.hs
--
-- The 15 minute compiler abstracting token list threading with
-- monad..
--
-- compilation:
--      ghc --make Main15minMonad.hs -o comp15min
--
-- usage:
--      ./comp15min < infile
--      ./comp15min < infile > outfile.ps
--      gs outfile.ps &
--
{-|   Context Free Grammar

program	::=	
        stmts  EOF
	
stmts   ::=
        stmt stmts
    |   epsilon


stmt	::=
        TRIANGLE
    |   CIRCLE NUMBER NUMBER NUMBER


            Nullable    FIRST                       FOLLOW
            --------    -----                       ------
program      no         {EOF, CIRCLE, TRIANGLE}     {}

stmts        yes        {CIRCLE, TRIANGLE}          {EOF}

stmt         no         {CIRCLE, TRIANGLE}          {EOF, CIRCLE, TRIANGLE}

-}

module Main where

import Control.Monad.State

-- needed for Token datatype and lexer
import Lexer15min

-----------------------------------------------------------------
main = do
  file_as_str <- getContents
  let out = parser $ lexer file_as_str
  putStr out

-----------------------------------------------------------------
-- Function that performs parsing and does syntax-directed output.

parser :: [Token] -> String
parser ts = fst (runState (parseProgram ts) ts)

-- Function for "program" non-terminal.
-- program	::=	stmts  EOF
parseProgram :: [Token] -> State [Token] String
parseProgram (TokenTRIANGLE:ts) = do
    stmts <- parseStmts (TokenTRIANGLE:ts)
    put (match ts TokenEOF) 
    return stmts
parseProgram (TokenCIRCLE:ts) = do
    stmts <- parseStmts (TokenTRIANGLE:ts)
    put (match ts TokenEOF) 
    return stmts
parseProgram ts = error ("Parse error in parseProgram at " ++ (show ts))


-- stmts   ::= stmt stmts  |   epsilon
parseStmts :: [Token] -> State [Token] String
parseStmts (TokenTRIANGLE:ts) = do
    stmt  <- parseStmt (TokenTRIANGLE:ts)    
    ts1  <- get
    stmts <- parseStmts ts1
    return (stmt ++ stmts)

parseStmts (TokenCIRCLE:ts) = do
    stmt <- parseStmt (TokenCIRCLE:ts)
    ts1  <- get
    stmts <- parseStmts ts1
    return (stmt ++ stmts)

-- Note: not consuming EOF here.
parseStmts (TokenEOF:ts) = do return ""
parseStmts ts = error ("Parse error in parseStmts at " ++ (show ts))


-- stmt	::= TRIANGLE   |   CIRCLE NUMBER NUMBER NUMBER
-- Creating a triangle in Postscript:
-- 256 0 moveto 512 512 lineto 0 512 lineto closepath
-- https://www.cs.duke.edu/courses/spring02/cps006/assign/recursivegraph/postscript-help.htm
-- Need fill for triangle to fill by itself without a circle.

parseStmt :: [Token] -> State [Token] String
parseStmt (TokenTRIANGLE:ts) = do
    put ts
    return "256 0 moveto 125 125 lineto 0 512 lineto fill\n"
parseStmt (TokenCIRCLE:(TokenNUM n1):(TokenNUM n2):(TokenNUM n3):ts) = do
    put ts
    return ((show n1)++" "++(show n2)++" "++(show n3)++" 0 360 arc fill\n")
parseStmt ts = error ("Parse error in parseStmt at " ++ (show ts))


-- match expected token, otherwise throw exception
match :: [Token] -> Token -> [Token]
match (given:ts) expect = if given==expect then ts 
                          else error ("Parse error: expected " 
                                      ++ (show expect)
                                      ++ ", but found "
                                      ++ (show given))