{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE InstanceSigs         #-}
{-# LANGUAGE TypeSynonymInstances #-}

module Data.SCAD where


import          Numeric.Units.Dimensional.Prelude hiding (Angle, Length)
import qualified Prelude 
import           Data.List
import           Data.Shared
import           GHC.IO.Exception
import           Linear.Quaternion
import           Linear.V3
import           System.IO
import           System.Process

type SCADName = String
type ArgName = String
type ArgVal = String

class SCADArg a where
    toSCADArg :: a -> ArgVal

instance SCADArg (V3 Length) where
    toSCADArg (V3 x y z) = toSCADArg $ V3 (x /~ mm) (y /~ mm) (z /~ mm)

instance SCADArg [V3 Length] where
    toSCADArg a = "[" ++ intercalate "," ( map toSCADArg a ) ++ "]"

instance {-# OVERLAPS #-}  Show a => SCADArg (V3 a) where
    toSCADArg (V3 x y z) = "[" ++ show x ++ "," ++ show y ++ "," ++ show z ++ "]"

instance {-# OVERLAPS #-} Show a => SCADArg [V3 a] where
    toSCADArg a = "[" ++ intercalate "," ( map toSCADArg a ) ++ "]"

data Arg = Arg { name :: ArgName, value :: ArgVal}

toArg :: SCADArg a => String -> a -> Arg
toArg key val = Arg key ( toSCADArg val )

data SCAD = Translate Position [SCAD] | Rotate (Quaternion Double)  [SCAD] | Module String [Arg] | ModuleDef String [ArgName] [SCAD] | Use Filename | Debug [SCAD];

vectorToString :: V3 Double -> String
vectorToString (V3 x y z) = "[" ++ show x ++ "," ++ show y ++ "," ++ show z ++ "]"

lengthVectorToString :: V3 Length -> String
lengthVectorToString (V3 x y z) = vectorToString $ V3 (x /~ mm) (y /~ mm) (z /~ mm)

quatToAngle :: Quaternion Double -> Angle
quatToAngle (Quaternion qw _ ) =  (2 *~ radian) * (Prelude.acos( qw ) *~ radian)

quatToAxis :: Quaternion Double -> V3 Double
quatToAxis (Quaternion qw (V3 qx qy qz)) = V3 (qx Prelude./ s) (qy Prelude./ s) (qz Prelude./ s)
    where
        s :: Double
        s = Prelude.sqrt(1 Prelude.- qw Prelude.* qw)

generateSCAD :: [SCAD] -> [String]
generateSCAD = concatMap generate
    where
        prefixChildren = map ( "   " ++ )
        strargs = intercalate "," . map (\(Arg name value) -> name ++ "=" ++ value)

        generate ::  SCAD -> [String]
        generate (Translate v child) = ["translate(" ++ lengthVectorToString v ++ "){\n" ] ++ concatMap generate child ++ ["}\n"]
        generate (Rotate q child) = ["rotate(a=" ++ show ( quatToAngle q ) ++ ", v=" ++ vectorToString ( quatToAxis q ) ++ "){\n" ] ++ concatMap generate child ++ ["}\n"]
        generate (Module name args) = [name ++ "(" ++ strargs args ++ ");"]
        generate (ModuleDef name arg_names lines) = ["module " ++ name ++ "(" ++ intercalate "," arg_names ++ "){"]
                                        ++  prefixChildren ( concatMap generate lines )
                                         ++ ["};"]
        generate (Use file) = ["use <" ++ file ++">;"]
        generate (Debug child) = ["#translate([0,0,0]){"] ++ concatMap generate child ++ ["}\n"]

renderSTL :: Filename -> Filename -> IO GHC.IO.Exception.ExitCode
renderSTL scad_source stl_file = do
        system ("openscad -o " ++ stl_file ++ " " ++ scad_source)
        system ("admesh --write-binary-stl=" ++ stl_file ++ " --no-check " ++ stl_file)

renderSCAD :: Filename -> [SCAD] -> IO ()
renderSCAD file d = withFile file WriteMode $ \handle -> mapM_ (hPutStrLn handle) (generateSCAD d)
