{-# LANGUAGE ViewPatterns, ScopedTypeVariables #-}

module Graphics.Implicit.ExtOpenScad.Eval.Statement where

import Graphics.Implicit.Definitions
import Graphics.Implicit.ExtOpenScad.Definitions
import Graphics.Implicit.ExtOpenScad.Util.OVal
import Graphics.Implicit.ExtOpenScad.Util.ArgParser
import Graphics.Implicit.ExtOpenScad.Util.StateC
import Graphics.Implicit.ExtOpenScad.Eval.Expr
import Graphics.Implicit.ExtOpenScad.Parser.Statement (parseProgram)


import qualified Data.Maybe as Maybe
import qualified Data.List as List
import qualified Data.Map as Map
import           Data.Map (Map)
import qualified Control.Monad as Monad
import qualified Control.Monad.State as State
import           Control.Monad.State (State,StateT, get, put, modify, liftIO)
import qualified System.FilePath as FilePath


runStatementI :: StatementI -> StateC ()

runStatementI (StatementI lineN (pat := expr)) = do
	val <- evalExpr expr
	let posMatch = matchPat pat val
	case (getErrors val, posMatch) of
		(Just err,  _ ) -> errorC lineN err
		(_, Just match) -> modifyVarLookup $ Map.union match
		(_,   Nothing ) -> errorC lineN "pattern match failed in assignment"

runStatementI (StatementI lineN (Echo exprs)) = do
	let
		show2 (OString s) = s
		show2 x = show x
	vals <- mapM evalExpr exprs
	case getErrors (OList vals) of
		Nothing  -> liftIO $ putStrLn $ concat $ map show2 vals
		Just err -> errorC lineN err

runStatementI (StatementI lineN (For pat expr loopContent)) = do
	val <- evalExpr expr
	case (getErrors val, val) of
		(Just err, _)      -> errorC lineN err
		(_, OList vals) -> Monad.forM_ vals $ \v ->
			case matchPat pat v of
				Just match -> do
					modifyVarLookup $ Map.union match
					runSuite loopContent
				Nothing -> return ()
		_ -> return ()

runStatementI (StatementI lineN (If expr a b)) = do
	val <- evalExpr expr
	case (getErrors val, val) of
		(Just err,  _  )  -> errorC lineN ("In conditional expression of if statement: " ++ err)
		(_, OBool True )  -> runSuite a
		(_, OBool False)  -> runSuite b
		_                 -> return ()

runStatementI (StatementI lineN (NewModule name argTemplate suite)) = do
	argTemplate' <- Monad.forM argTemplate $ \(name, defexpr) -> do
		defval <- mapMaybeM evalExpr defexpr 
		return (name, defval)
	(varlookup, _, path, _, _) <- get
	runStatementI $ StatementI lineN $ (Name name :=) $ LitE $ OModule $ \vals -> do 
		newNameVals <- Monad.forM argTemplate' $ \(name, maybeDef) -> do
			val <- case maybeDef of
				Just def -> argument name `defaultTo` def
				Nothing  -> argument name
			return (name, val)
		let
			children = ONum $ fromIntegral $ length vals
			child = OModule $ \vals -> do
				n :: ℕ <- argument "n";
				return $ return $ return $ 
					if n <= length vals
						then vals !! n
						else OUndefined
			childBox = OFunc $ \n -> case fromOObj n :: Maybe ℕ of
				Just n  | n < length vals -> case vals !! n of
					-- _ -> toOObj $ getBox3 obj3
					-- _ -> toOObj $ getBox2 obj2
					_ -> OUndefined
				_ -> OUndefined
			newNameVals' = newNameVals ++ [("children", children),("child", child), ("childBox", childBox)]
			varlookup' = Map.union (Map.fromList newNameVals) varlookup
			suiteVals  = runSuiteCapture varlookup' path suite
		return suiteVals

runStatementI (StatementI lineN (ModuleCall name argsExpr suite)) = do
		maybeMod  <- lookupVar name
		(varlookup, _, path, _, _) <- get
		childVals <- fmap reverse $ liftIO $ runSuiteCapture varlookup path suite
		argsVal   <- Monad.forM argsExpr $ \(posName, expr) -> do
			val <- evalExpr expr
			return (posName, val)
		newVals <- case maybeMod of
			Just (OModule mod) -> liftIO ioNewVals  where
				argparser = mod childVals
				ioNewVals = case fst $ argMap argsVal argparser of
					Just iovals -> iovals
					Nothing     -> return []
			Just foo            -> do
					case getErrors foo of
						Just err -> errorC lineN err
						Nothing  -> errorC lineN $ "Object called not module!"
					return []
			Nothing -> do
				errorC lineN $ "Module " ++ name ++ " not in scope."
				return []
		pushVals newVals

runStatementI (StatementI lineN (Include name injectVals)) = do
	name' <- getRelPath name
	content <- liftIO $ readFile name'
	case parseProgram name content of
		Left e -> liftIO $ putStrLn $ "Error parsing " ++ name ++ ":" ++ show e
		Right sts -> withPathShiftedBy (FilePath.takeDirectory name) $ do
			vals <- getVals
			putVals []
			runSuite sts
			vals' <- getVals
			if injectVals then putVals (vals' ++ vals) else putVals vals



runSuite :: [StatementI] -> StateC ()
runSuite stmts = Monad.mapM_ runStatementI stmts

runSuiteCapture :: VarLookup -> FilePath -> [StatementI] -> IO [OVal]
runSuiteCapture varlookup path suite = do
	(res, state) <- State.runStateT 
		(runSuite suite >> getVals)
		(varlookup, [], path, (), () )
	return res