-- Main15min.hs
--
-- The 15 minute compiler.
--
-- compilation:
--      ghc --make Main15min.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

-- 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 = parseProgram ts

-- Function for "program" non-terminal.
-- program	::=	stmts  EOF
parseProgram :: [Token] -> String
parseProgram (TokenTRIANGLE:ts) = 
    let (stmts,ts1) = parseStmts (TokenTRIANGLE:ts)
        ts2         = match ts1 TokenEOF
    in stmts
parseProgram (TokenCIRCLE:ts) = 
    let (stmts,ts1) = parseStmts (TokenCIRCLE:ts)
        ts2         = match ts1 TokenEOF
    in stmts
parseProgram ts = error ("Parse error in parseProgram at " ++ (show ts))


-- stmts   ::= stmt stmts  |   epsilon
parseStmts :: [Token] -> (String,[Token])
parseStmts (TokenTRIANGLE:ts) =
    let (stmt,ts1)  = parseStmt (TokenTRIANGLE:ts)
        (stmts,ts2) = parseStmts ts1
    in (stmt ++ stmts, ts2)
parseStmts (TokenCIRCLE:ts) =
    let (stmt,ts1)  = parseStmt (TokenCIRCLE:ts)
        (stmts,ts2) = parseStmts ts1
    in (stmt ++ stmts, ts2)
-- Note: not consuming EOF here.
parseStmts (TokenEOF:ts) = ("",(TokenEOF:ts))
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] -> (String,[Token])
parseStmt (TokenTRIANGLE:ts)
    = ("256 0 moveto 125 125 lineto 0 512 lineto fill\n",ts)
parseStmt (TokenCIRCLE:(TokenNUM n1):(TokenNUM n2):(TokenNUM n3):ts)
    = ((show n1)++" "++(show n2)++" "++(show n3)++" 0 360 arc fill\n",ts)
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))