-- Author: Danila Fedorin
import Data.List

-- Definitions
type Var = String
type Macro = String

data PenMode = Up | Down

data Expr = Variable Var
          | Number Int
          | Sum Expr Expr

data Cmd = Pen PenMode
         | Move Expr Expr
         | Define Macro [Var] Prog
         | Call Macro [Expr]

type Prog = [Cmd]

-- HW Code
-- define line(x1, y1, x2, y2) {
--     pen up; move (x1, y1);
--     pen down; move(x2, y2);
-- }
lineMacro = Define "line" [ "x1", "y1", "x2", "y2" ]
    [ Pen Up
    , Move (Variable "x1") (Variable "y1")
    , Pen Down
    , Move (Variable "x2") (Variable "y2")
    ]

-- define nix(x, y, w, h) {
--     call line(x, y, x + w, y + h);
--     call line(x + w, y, x, y + h);
-- }
nixMacro = Define "nix" [ "x", "y", "w", "h" ]
    [ Call "line"
        [ Variable "x"
        , Variable "y"
        , Sum (Variable "x") (Variable "w")
        , Sum (Variable "y") (Variable "h")
        ]
    , Call "line"
        [ Sum (Variable "x") (Variable "w")
        , Variable "y"
        , Variable "x"
        , Sum (Variable "y") (Variable "h")
        ]
    ]

steps :: Int -> Prog
steps n = base ++ stepList
    where
        base = [ Pen Up, Move (Number 0) (Number 0), Pen Down ]
        stepList = [1..n] >>= (\i -> [ Move (Number (i -1)) (Number i), Move (Number i) (Number i) ])

prettyPrintExpr :: Expr -> String
prettyPrintExpr (Variable v) = v
prettyPrintExpr (Number i) = show i
prettyPrintExpr (Sum l r) = prettyPrintExpr l ++ "+" ++ prettyPrintExpr r

prettyPrintPenMode :: PenMode -> String
prettyPrintPenMode Up = "up"
prettyPrintPenMode Down = "down"

prettyPrintCmd :: Cmd -> [String]
prettyPrintCmd (Pen m) = [ "pen " ++ prettyPrintPenMode m ++ ";" ]
prettyPrintCmd (Move l r) = [ "move(" ++ prettyPrintExpr l ++ ", " ++ prettyPrintExpr r ++ ");" ]
prettyPrintCmd (Define m vs cmds) = ("define " ++ m ++ "(" ++ intercalate ", " vs ++ ") {") : map ("    " ++) (cmds >>= prettyPrintCmd) ++ [ "}" ]
prettyPrintCmd (Call n xs) = [ "call " ++ n ++ "(" ++ intercalate ", " (map prettyPrintExpr xs) ++ ");" ]

pretty :: Prog -> String
pretty prog = intercalate "\n" $ (prog >>= prettyPrintCmd) ++ [ "" ]

macros :: Prog -> [Macro]
macros xs = xs >>= macrosC
    where
        macrosC (Define n vs cs) = n:(cs >>= macrosC)
        macrosC _ = []

sortWith :: Ord b => (a -> b) -> [a] -> [a]
sortWith f = sortBy (\l r -> compare (f l) (f r))

optE :: Expr -> Expr
optE expr = mergeAll $ sortWith exprOrdinal $ listTerms expr
    where
        listTerms (Sum l r) = listTerms l ++ listTerms r
        listTerms e = [ e ]
        exprOrdinal (Number _) = 2
        exprOrdinal _ = 1
        mergeTwo (Number i1) (Number i2) = Number (i1 + i2)
        mergeTwo l r = Sum l r
        mergeAll [x] = x
        mergeAll xs = foldr1 mergeTwo xs

optP :: Prog -> Prog
optP = map optC
    where
        optC (Move e1 e2) = Move (optE e1) (optE e2)
        optC (Call n exs) = Call n (map optE exs)
        optC c = c