{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}

module SCAD where

import           Data.List
import           Data.Makefile
import           Data.Maybe                               ( isNothing )
import qualified Data.Text                     as Text
import           Debug.Trace
import           Filesystem.Path
import           Filesystem.Path.CurrentOS
import           GHC.IO.Exception
import           Language.OpenSCAD
import           Linear.Quaternion
import           Linear.V3
import           Numeric.Units.Dimensional.Prelude hiding ( Angle
                                                          , Length
                                                          )
import qualified Prelude as P
import           Shared
import           System.Directory
import           System.IO
import           System.Process


class SCADExpr a where
    toSCADExpr :: a -> Expr

instance SCADExpr String where
  toSCADExpr s = EString s

instance SCADExpr Double where
  toSCADExpr x = ENum x

instance SCADExpr Length where
  toSCADExpr x = ENum (x /~ mm)

instance SCADExpr Angle where
  toSCADExpr x = ENum (x /~ degree)

instance SCADExpr a => SCADExpr (V3 a) where
  toSCADExpr (V3 x y z) = EVec [toSCADExpr x, toSCADExpr y, toSCADExpr z]

instance SCADExpr a => SCADExpr [V3 a] where
  toSCADExpr a = EVec (toSCADExpr <$> a)

toArg :: SCADExpr a => String -> a -> Argument Expr
toArg key val = NamedArgument (Ident key) (toSCADExpr val)

mod :: String -> [Argument Expr] -> Object
mod name args = Module (Ident name) args Nothing

rotate :: Axis -> Angle -> Object -> Object
rotate ax an ch =
  Module (Ident "rotate") [toArg "v" ax, toArg "a" an] (Just ch)

qrotate :: Quaternion Double -> Object -> Object
qrotate (Quaternion s (V3 x y z)) ch = if an == 0 *~ radian then ch
	else Module (Ident "rotate") [toArg "v" ax, toArg "a" an] (Just ch)
    where
        v = P.sqrt( (x  P.* x) P.+ (y P.* y) P.+ (z P.* z ))
        ax = V3 (x P./ v) (y P./ v) (z P./ v)
        an = (2 P.* (P.atan2 v s)) *~ radian

union :: [Object] -> Object
union objs = Objects objs

translate :: SCADExpr a => a -> Object -> Object
translate arg ch =
  Module (Ident "translate") [Argument (toSCADExpr arg)] (Just ch)

trasnlate_x x = translate (V3 x (0 *~ mm) (0 *~ mm))
translate_y y = translate (V3 (0 *~ mm) y (0 *~ mm))
translate_z z = translate (V3 (0 *~ mm) (0 *~ mm) z)

generateSCAD :: [TopLevel] -> [String]
generateSCAD = concatMap generate
 where
  prefix_children = map ("   " ++)

  expr_to_string :: Expr -> String
  expr_to_string (EVar (Ident name)) = name
  expr_to_string (EIndex base i) =
    expr_to_string base ++ "[" ++ expr_to_string i ++ "]"
  expr_to_string (ENum val) = show val
  expr_to_string (EVec v) = "[" ++ intercalate "," (expr_to_string <$> v) ++ "]"
  expr_to_string (ERange (Range from to opt_step)) = case opt_step of
    Just step ->
      "["
        ++ expr_to_string from
        ++ ":"
        ++ expr_to_string step
        ++ ":"
        ++ expr_to_string to
        ++ "]"
    Nothing -> "[" ++ expr_to_string from ++ ":" ++ expr_to_string to ++ "]"
  expr_to_string (EString s) = s
  expr_to_string (EBool   b) = if b then "true" else "false"
  expr_to_string (EFunc (Ident name) args) =
    name ++ "(" ++ (intercalate "," $ arg_to_string <$> args) ++ ")"
  expr_to_string (ENegate expr) = "!" ++ expr_to_string expr
  expr_to_string (EPlus  lh rh) = expr_to_string lh ++ "+" ++ expr_to_string rh
  expr_to_string (EMinus lh rh) = expr_to_string lh ++ "-" ++ expr_to_string rh
  expr_to_string (EDiv   lh rh) = expr_to_string lh ++ "/" ++ expr_to_string rh
  expr_to_string (EMod   lh rh) = expr_to_string lh ++ "%" ++ expr_to_string rh
  expr_to_string (EEquals lh rh) =
    expr_to_string lh ++ "==" ++ expr_to_string rh
  expr_to_string (ENotEquals lh rh) =
    expr_to_string lh ++ "!=" ++ expr_to_string rh
  expr_to_string (EGT lh rh ) = expr_to_string lh ++ ">" ++ expr_to_string rh
  expr_to_string (EGE lh rh ) = expr_to_string lh ++ ">=" ++ expr_to_string rh
  expr_to_string (ELT lh rh ) = expr_to_string lh ++ "<" ++ expr_to_string rh
  expr_to_string (ELE lh rh ) = expr_to_string lh ++ "<=" ++ expr_to_string rh
  expr_to_string (ENot e    ) = "!" ++ expr_to_string e
  expr_to_string (EOr  lh rh) = expr_to_string lh ++ "||" ++ expr_to_string rh
  expr_to_string (EAnd lh rh) = expr_to_string lh ++ "&&" ++ expr_to_string rh
  expr_to_string (ETernary cond lh rh) =
    expr_to_string cond ++ "?" ++ expr_to_string lh ++ ":" ++ expr_to_string rh
  expr_to_string (EParen e) = "(" ++ expr_to_string e ++ ")"

  arg_to_string :: Argument Expr -> String
  arg_to_string (Argument a) = expr_to_string a
  arg_to_string (NamedArgument (Ident name) a) =
    name ++ "=" ++ expr_to_string a

  marg_to_string :: (Ident, Maybe Expr) -> String
  marg_to_string (Ident name, mb_expr) = case mb_expr of
    Just e  -> name ++ "=" ++ expr_to_string e
    Nothing -> name

  ident_to_string :: Ident -> String
  ident_to_string (Ident name) = name

  generate :: TopLevel -> [String]
  generate (TopLevelScope    s) = generate_obj s
  generate (UseDirective     u) = ["use <" ++ u ++ ">;"]
  generate (IncludeDirective i) = ["include <" ++ i ++ ">;"]


  generate_obj :: Object -> [String]
  generate_obj (ModuleDef (Ident name) args body) =
    [ "module "
      ++ name
      ++ "("
      ++ (intercalate "," $ marg_to_string <$> args)
      ++ ")"
      ]
      ++ concatMap generate_obj body
  generate_obj (VarDef (Ident name) expr) =
    [name ++ " = " ++ expr_to_string expr ++ ";"]
  generate_obj (FuncDef (Ident name) args body) =
    [ "function "
        ++ name
        ++ "("
        ++ (intercalate "," $ ident_to_string <$> args)
        ++ ") = "
        ++ expr_to_string body
        ++ ";"
    ]
  generate_obj (Module (Ident name) args mb_child) =
    [ name
      ++ "("
      ++ intercalate "," (arg_to_string <$> args)
      ++ ")"
      ++ (if isNothing mb_child then ";" else "")
      ]
      ++ maybe [] generate_obj mb_child
  generate_obj (ForLoop (Ident name) expr child) =
    ["for(" ++ name ++ "=" ++ expr_to_string expr ++ ")"] ++ generate_obj child
  generate_obj (Objects objs) =
    ["{"]
      ++ (prefix_children $ concatMap generate_obj objs)
      ++ ["}"]
  generate_obj (If e child mb_else_child) =
    ["if(" ++ expr_to_string e ++ ")"]
      ++ generate_obj child
      ++ case mb_else_child of
           Just ch -> ["else"] ++ generate_obj ch
           Nothing -> []
  generate_obj (BackgroundMod child) = ["%"] ++ generate_obj child
  generate_obj (DebugMod      child) = ["#"] ++ generate_obj child
  generate_obj (RootMod       child) = ["!"] ++ generate_obj child
  generate_obj (DisableMod    child) = ["*"] ++ generate_obj child

stlRenderCommands :: Filename -> Filename -> [Command]
stlRenderCommands scad_source stl_file =
  [ Command $ Text.pack ("mkdir -p `dirname " ++ stl_file ++ "`")
  , Command $ Text.pack ("openscad -o " ++ stl_file ++ " " ++ scad_source)
  , Command $ Text.pack
    ("admesh --write-binary-stl=" ++ stl_file ++ " --no-check " ++ stl_file)
  ]

renderSCAD :: Filename -> [TopLevel] -> IO ()
renderSCAD file d = do
  createDirectoryIfMissing True $ encodeString $ directory $ decodeString file
  withFile file WriteMode $ \handle -> mapM_ (hPutStrLn handle) (generateSCAD d)

