{-# OPTIONS -fglasgow-exts #-}

module Language.CalDims.State 
	( MyParser
	, Arg (..)
	, Args
	, Scope
	, State (..)
	, StateEntry (..)
	, isBasicUnit
	, isUnit
	, isDerivedUnit
	, isFunction
	, isBuiltin
	, lu
	, start) where

import qualified Data.Map as Map
import qualified Data.List as List
import Data.Maybe

import Language.CalDims.Types
import Language.CalDims.Expr ()


start :: State
start = State 
	{ getScope = Map.fromList [ (Name "pi", Builtin [] $ Evaled (toRational ((pi)::Double), noDims))
                                  , (Name "e", Builtin [] $ Evaled (toRational ((exp 1):: Double), noDims))
                                  , (Name "exp", bUni Expot noDims)
                                  , (Name "log", bUni Log noDims)
                                  , (Name "cos", bUni Cos noDims)
                                  , (Name "tan", bUni Tan noDims)
                                  , (Name "asin", bUni Asin noDims)
                                  , (Name "acos", bUni Acos noDims)
                                  , (Name "atan", bUni Atan noDims)
                                  , (Name "sinh", bUni Sinh noDims)
                                  , (Name "cosh", bUni Cosh noDims)
                                  , (Name "tanh", bUni Tanh noDims)
                                  , (Name "asinh", bUni Asinh noDims)
                                  , (Name "acosh", bUni Acosh noDims)
                                  , (Name "atanh", bUni Atanh noDims)
                                  , (Name "sin", bUni Sin noDims)]
	, getArgs = []
	, getArgValues = []}

bUni :: UniOp -> Dims -> StateEntry
bUni o d = let arg = Arg "x" 0 d in Builtin [arg] $ Uni o (ArgRef arg)

instance Pretty (Name, StateEntry) where
	pretty (name, Function args expr) = pretty name ++ prettyArgs args ++ " = " ++ pretty expr
	pretty (name, Builtin args _) = pretty name ++ prettyArgs args ++ " = [[builtin]]"
	pretty (name, Dimension expr) = pretty name ++ " := " ++ pretty expr
	pretty (name, BasicDimension) = "\\u " ++ pretty name

prettyArgs :: Args -> String
prettyArgs [] = ""
prettyArgs args = " (" ++ foldl1 (\a b -> a ++ ", " ++ b) (map (\ (Arg n _ d) -> n ++ " : " ++ pretty d) args) ++ ")"

isBasicUnit, isUnit, isDerivedUnit, isFunction, isBuiltin :: State -> Name -> Bool
isBasicUnit state name
	| Just BasicDimension <- lu name state = True
        | otherwise = False

isFunction state name
	| Just (Function _ _) <- lu name state = True
        | otherwise = False

isBuiltin state name
	| Just (Builtin _ _) <- lu name state = True
        | otherwise = False

isDerivedUnit state name
        | Just (Dimension _) <- lu name state = True
        | otherwise = False

isUnit state name = isDerivedUnit state name || isBasicUnit state name

lu :: Name -> State -> Maybe StateEntry
lu name state = Map.lookup name (getScope state)