{-# LANGUAGE GADTs #-}

-- | The Drasil Modelling Expression language
module Language.Drasil.ModelExpr.Lang where

import Prelude hiding (sqrt)

import Language.Drasil.Expr.Lang (Completeness)
import Language.Drasil.Literal.Lang (Literal(..))
import Language.Drasil.Space (Space, DomainDesc, RealInterval)
import Language.Drasil.UID (UID)
import Language.Drasil.Literal.Class (LiteralC(..))

-- Binary functions

-- | Arithmetic operators (fractional, power, and subtraction).
data ArithBinOp = Frac | Pow | Subt
  deriving ArithBinOp -> ArithBinOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArithBinOp -> ArithBinOp -> Bool
$c/= :: ArithBinOp -> ArithBinOp -> Bool
== :: ArithBinOp -> ArithBinOp -> Bool
$c== :: ArithBinOp -> ArithBinOp -> Bool
Eq

-- | Equality operators (equal or not equal).
data EqBinOp = Eq | NEq
  deriving EqBinOp -> EqBinOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EqBinOp -> EqBinOp -> Bool
$c/= :: EqBinOp -> EqBinOp -> Bool
== :: EqBinOp -> EqBinOp -> Bool
$c== :: EqBinOp -> EqBinOp -> Bool
Eq

-- | Conditional and Biconditional operators (Expressions can imply
-- one another, or exist if and only if another expression exists).
data BoolBinOp = Impl | Iff
  deriving BoolBinOp -> BoolBinOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BoolBinOp -> BoolBinOp -> Bool
$c/= :: BoolBinOp -> BoolBinOp -> Bool
== :: BoolBinOp -> BoolBinOp -> Bool
$c== :: BoolBinOp -> BoolBinOp -> Bool
Eq

-- | Index operator.
data LABinOp = Index
  deriving LABinOp -> LABinOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LABinOp -> LABinOp -> Bool
$c/= :: LABinOp -> LABinOp -> Bool
== :: LABinOp -> LABinOp -> Bool
$c== :: LABinOp -> LABinOp -> Bool
Eq

-- | Ordered binary operators (less than, greater than, less than or equal to, greater than or equal to).
data OrdBinOp = Lt | Gt | LEq | GEq
  deriving OrdBinOp -> OrdBinOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrdBinOp -> OrdBinOp -> Bool
$c/= :: OrdBinOp -> OrdBinOp -> Bool
== :: OrdBinOp -> OrdBinOp -> Bool
$c== :: OrdBinOp -> OrdBinOp -> Bool
Eq

-- | @Vector x Vector -> Vector@ binary operations (cross product, vector addition, subtraction).
data VVVBinOp = Cross | VAdd | VSub
  deriving VVVBinOp -> VVVBinOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VVVBinOp -> VVVBinOp -> Bool
$c/= :: VVVBinOp -> VVVBinOp -> Bool
== :: VVVBinOp -> VVVBinOp -> Bool
$c== :: VVVBinOp -> VVVBinOp -> Bool
Eq

-- | @Vector x Vector -> Number@ binary operations (dot product).
data VVNBinOp = Dot
  deriving VVNBinOp -> VVNBinOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VVNBinOp -> VVNBinOp -> Bool
$c/= :: VVNBinOp -> VVNBinOp -> Bool
== :: VVNBinOp -> VVNBinOp -> Bool
$c== :: VVNBinOp -> VVNBinOp -> Bool
Eq

-- | @Number x Vector -> Vector@ binary operations (scaling).
data NVVBinOp = Scale
  deriving NVVBinOp -> NVVBinOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NVVBinOp -> NVVBinOp -> Bool
$c/= :: NVVBinOp -> NVVBinOp -> Bool
== :: NVVBinOp -> NVVBinOp -> Bool
$c== :: NVVBinOp -> NVVBinOp -> Bool
Eq

-- | Associative operators (adding and multiplication). Also specifies whether it is for integers or for real numbers.
data AssocArithOper = AddI | AddRe | MulI | MulRe
  deriving AssocArithOper -> AssocArithOper -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssocArithOper -> AssocArithOper -> Bool
$c/= :: AssocArithOper -> AssocArithOper -> Bool
== :: AssocArithOper -> AssocArithOper -> Bool
$c== :: AssocArithOper -> AssocArithOper -> Bool
Eq

-- | Associative boolean operators (and, or).
data AssocBoolOper = And | Or | Equivalence
  deriving (AssocBoolOper -> AssocBoolOper -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssocBoolOper -> AssocBoolOper -> Bool
$c/= :: AssocBoolOper -> AssocBoolOper -> Bool
== :: AssocBoolOper -> AssocBoolOper -> Bool
$c== :: AssocBoolOper -> AssocBoolOper -> Bool
Eq, Int -> AssocBoolOper -> ShowS
[AssocBoolOper] -> ShowS
AssocBoolOper -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssocBoolOper] -> ShowS
$cshowList :: [AssocBoolOper] -> ShowS
show :: AssocBoolOper -> String
$cshow :: AssocBoolOper -> String
showsPrec :: Int -> AssocBoolOper -> ShowS
$cshowsPrec :: Int -> AssocBoolOper -> ShowS
Show)

-- | Unary functions (abs, log, ln, sin, etc.).
data UFunc = Abs | Log | Ln | Sin | Cos | Tan | Sec | Csc | Cot | Arcsin
  | Arccos | Arctan | Exp | Sqrt | Neg
  deriving UFunc -> UFunc -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UFunc -> UFunc -> Bool
$c/= :: UFunc -> UFunc -> Bool
== :: UFunc -> UFunc -> Bool
$c== :: UFunc -> UFunc -> Bool
Eq

-- | @Bool -> Bool@ operators.
data UFuncB = Not
  deriving UFuncB -> UFuncB -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UFuncB -> UFuncB -> Bool
$c/= :: UFuncB -> UFuncB -> Bool
== :: UFuncB -> UFuncB -> Bool
$c== :: UFuncB -> UFuncB -> Bool
Eq

-- | @Vector -> Vector@ operators.
data UFuncVV = NegV
  deriving UFuncVV -> UFuncVV -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UFuncVV -> UFuncVV -> Bool
$c/= :: UFuncVV -> UFuncVV -> Bool
== :: UFuncVV -> UFuncVV -> Bool
$c== :: UFuncVV -> UFuncVV -> Bool
Eq

-- | @Vector -> Number@ operators.
data UFuncVN = Norm | Dim
  deriving UFuncVN -> UFuncVN -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UFuncVN -> UFuncVN -> Bool
$c/= :: UFuncVN -> UFuncVN -> Bool
== :: UFuncVN -> UFuncVN -> Bool
$c== :: UFuncVN -> UFuncVN -> Bool
Eq

-- | Statements involving 2 arguments.
data StatBinOp = Defines
  deriving StatBinOp -> StatBinOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StatBinOp -> StatBinOp -> Bool
$c/= :: StatBinOp -> StatBinOp -> Bool
== :: StatBinOp -> StatBinOp -> Bool
$c== :: StatBinOp -> StatBinOp -> Bool
Eq

-- | @Value -> Space -> Bool@ operators.
data SpaceBinOp = IsIn
  deriving SpaceBinOp -> SpaceBinOp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpaceBinOp -> SpaceBinOp -> Bool
$c/= :: SpaceBinOp -> SpaceBinOp -> Bool
== :: SpaceBinOp -> SpaceBinOp -> Bool
$c== :: SpaceBinOp -> SpaceBinOp -> Bool
Eq

-- | Determines the type of the derivative (either a partial derivative or a total derivative).
data DerivType = Part | Total
  deriving DerivType -> DerivType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DerivType -> DerivType -> Bool
$c/= :: DerivType -> DerivType -> Bool
== :: DerivType -> DerivType -> Bool
$c== :: DerivType -> DerivType -> Bool
Eq

-- | Expression language where all terms are supposed to have a meaning, but
--   that meaning may not be that of a definite value. For example,
--   specification expressions, especially with quantifiers, belong here.
data ModelExpr where
  -- | Brings a literal into the expression language.
  Lit       :: Literal -> ModelExpr

  -- | Introduce Space values into the expression language.
  Spc       :: Space -> ModelExpr

  -- | Takes an associative arithmetic operator with a list of expressions.
  AssocA    :: AssocArithOper -> [ModelExpr] -> ModelExpr
  -- | Takes an associative boolean operator with a list of expressions.
  AssocB    :: AssocBoolOper  -> [ModelExpr] -> ModelExpr
  -- | Derivative syntax is:
  --   Type ('Part'ial or 'Total') -> principal part of change -> with respect to
  --   For example: Deriv Part y x1 would be (dy/dx1).
  Deriv     :: Integer -> DerivType -> ModelExpr -> UID -> ModelExpr
  -- | C stands for "Chunk", for referring to a chunk in an expression.
  --   Implicitly assumes that the chunk has a symbol.
  C         :: UID -> ModelExpr
  -- | Function applications.
  FCall     :: UID -> [ModelExpr] -> ModelExpr
  -- | For multi-case expressions, each pair represents one case.
  Case      :: Completeness -> [(ModelExpr, ModelExpr)] -> ModelExpr
  -- | Represents a matrix of expressions.
  Matrix    :: [[ModelExpr]] -> ModelExpr
  
  -- | Unary operation for most functions (eg. sin, cos, log, etc.).
  UnaryOp       :: UFunc -> ModelExpr -> ModelExpr
  -- | Unary operation for @Bool -> Bool@ operations.
  UnaryOpB      :: UFuncB -> ModelExpr -> ModelExpr
  -- | Unary operation for @Vector -> Vector@ operations.
  UnaryOpVV     :: UFuncVV -> ModelExpr -> ModelExpr
  -- | Unary operation for @Vector -> Number@ operations.
  UnaryOpVN     :: UFuncVN -> ModelExpr -> ModelExpr

  -- | Binary operator for arithmetic between expressions (fractional, power, and subtraction).
  ArithBinaryOp :: ArithBinOp -> ModelExpr -> ModelExpr -> ModelExpr
  -- | Binary operator for boolean operators (implies, iff).
  BoolBinaryOp  :: BoolBinOp -> ModelExpr -> ModelExpr -> ModelExpr
  -- | Binary operator for equality between expressions.
  EqBinaryOp    :: EqBinOp -> ModelExpr -> ModelExpr -> ModelExpr
  -- | Binary operator for indexing two expressions.
  LABinaryOp    :: LABinOp -> ModelExpr -> ModelExpr -> ModelExpr
  -- | Binary operator for ordering expressions (less than, greater than, etc.).
  OrdBinaryOp   :: OrdBinOp -> ModelExpr -> ModelExpr -> ModelExpr
  -- | Space-related binary operations.
  SpaceBinaryOp :: SpaceBinOp -> ModelExpr -> ModelExpr -> ModelExpr
  -- | Statement-related binary operations.
  StatBinaryOp  :: StatBinOp -> ModelExpr -> ModelExpr -> ModelExpr
  -- | Binary operator for @Vector x Vector -> Vector@ operations (cross product).
  VVVBinaryOp   :: VVVBinOp -> ModelExpr -> ModelExpr -> ModelExpr
  -- | Binary operator for @Vector x Vector -> Number@ operations (dot product).
  VVNBinaryOp   :: VVNBinOp -> ModelExpr -> ModelExpr -> ModelExpr
  -- | Binary operator for @Number x Vector -> Vector@ operations (scaling).
  NVVBinaryOp   :: NVVBinOp -> ModelExpr -> ModelExpr -> ModelExpr

  -- | Operators are generalized arithmetic operators over a 'DomainDesc'
  --   of an 'Expr'.  Could be called BigOp.
  --   ex: Summation is represented via 'Add' over a discrete domain.
  Operator :: AssocArithOper -> DomainDesc t ModelExpr ModelExpr -> ModelExpr -> ModelExpr
  -- | A different kind of 'IsIn'. A 'UID' is an element of an interval.
  RealI    :: UID -> RealInterval ModelExpr ModelExpr -> ModelExpr
  
  -- | Universal quantification
  ForAll   :: UID -> Space -> ModelExpr -> ModelExpr

-- | The variable type is just a renamed 'String'.
type Variable = String

-- instance Num Expr where
--   (Int 0)        + b              = b
--   a              + (Int 0)        = a
--   (AssocA Add l) + (AssocA Add m) = AssocA Add (l ++ m)
--   (AssocA Add l) + b              = AssocA Add (l ++ [b])
--   a              + (AssocA Add l) = AssocA Add (a : l)
--   a              + b              = AssocA Add [a, b]

--   (AssocA Mul l) * (AssocA Mul m) = AssocA Mul (l ++ m)
--   (AssocA Mul l) * b              = AssocA Mul (l ++ [b])
--   a              * (AssocA Mul l) = AssocA Mul (a : l)
--   a              * b              = AssocA Mul [a, b]

--   a - b = ArithBinaryOp Subt a b
  
--   fromInteger = Int
--   abs         = UnaryOp Abs
--   negate      = UnaryOp Neg

--   -- this is a Num wart
--   signum _ = error "should not use signum in expressions"

-- | Expressions are equal if their constructors and contents are equal.
instance Eq ModelExpr where
  Lit Literal
l               == :: ModelExpr -> ModelExpr -> Bool
== Lit Literal
r               =   Literal
l forall a. Eq a => a -> a -> Bool
== Literal
r
  AssocA AssocArithOper
o1 [ModelExpr]
l1        == AssocA AssocArithOper
o2 [ModelExpr]
l2        =  AssocArithOper
o1 forall a. Eq a => a -> a -> Bool
== AssocArithOper
o2 Bool -> Bool -> Bool
&& [ModelExpr]
l1 forall a. Eq a => a -> a -> Bool
== [ModelExpr]
l2
  AssocB AssocBoolOper
o1 [ModelExpr]
l1        == AssocB AssocBoolOper
o2 [ModelExpr]
l2        =  AssocBoolOper
o1 forall a. Eq a => a -> a -> Bool
== AssocBoolOper
o2 Bool -> Bool -> Bool
&& [ModelExpr]
l1 forall a. Eq a => a -> a -> Bool
== [ModelExpr]
l2
  Deriv Integer
a DerivType
t1 ModelExpr
b UID
c      == Deriv Integer
d DerivType
t2 ModelExpr
e UID
f      =   Integer
a forall a. Eq a => a -> a -> Bool
== Integer
d Bool -> Bool -> Bool
&& DerivType
t1 forall a. Eq a => a -> a -> Bool
== DerivType
t2 Bool -> Bool -> Bool
&& ModelExpr
b forall a. Eq a => a -> a -> Bool
== ModelExpr
e Bool -> Bool -> Bool
&& UID
c forall a. Eq a => a -> a -> Bool
== UID
f
  C UID
a                 == C UID
b                 =   UID
a forall a. Eq a => a -> a -> Bool
== UID
b
  FCall UID
a [ModelExpr]
b           == FCall UID
c [ModelExpr]
d           =   UID
a forall a. Eq a => a -> a -> Bool
== UID
c Bool -> Bool -> Bool
&& [ModelExpr]
b forall a. Eq a => a -> a -> Bool
== [ModelExpr]
d
  Case Completeness
a [(ModelExpr, ModelExpr)]
b            == Case Completeness
c [(ModelExpr, ModelExpr)]
d            =   Completeness
a forall a. Eq a => a -> a -> Bool
== Completeness
c Bool -> Bool -> Bool
&& [(ModelExpr, ModelExpr)]
b forall a. Eq a => a -> a -> Bool
== [(ModelExpr, ModelExpr)]
d 
  UnaryOp UFunc
a ModelExpr
b         == UnaryOp UFunc
c ModelExpr
d         =   UFunc
a forall a. Eq a => a -> a -> Bool
== UFunc
c Bool -> Bool -> Bool
&& ModelExpr
b forall a. Eq a => a -> a -> Bool
== ModelExpr
d
  UnaryOpB UFuncB
a ModelExpr
b        == UnaryOpB UFuncB
c ModelExpr
d        =   UFuncB
a forall a. Eq a => a -> a -> Bool
== UFuncB
c Bool -> Bool -> Bool
&& ModelExpr
b forall a. Eq a => a -> a -> Bool
== ModelExpr
d
  UnaryOpVV UFuncVV
a ModelExpr
b       == UnaryOpVV UFuncVV
c ModelExpr
d       =   UFuncVV
a forall a. Eq a => a -> a -> Bool
== UFuncVV
c Bool -> Bool -> Bool
&& ModelExpr
b forall a. Eq a => a -> a -> Bool
== ModelExpr
d
  UnaryOpVN UFuncVN
a ModelExpr
b       == UnaryOpVN UFuncVN
c ModelExpr
d       =   UFuncVN
a forall a. Eq a => a -> a -> Bool
== UFuncVN
c Bool -> Bool -> Bool
&& ModelExpr
b forall a. Eq a => a -> a -> Bool
== ModelExpr
d
  ArithBinaryOp ArithBinOp
o ModelExpr
a ModelExpr
b == ArithBinaryOp ArithBinOp
p ModelExpr
c ModelExpr
d =   ArithBinOp
o forall a. Eq a => a -> a -> Bool
== ArithBinOp
p Bool -> Bool -> Bool
&& ModelExpr
a forall a. Eq a => a -> a -> Bool
== ModelExpr
c Bool -> Bool -> Bool
&& ModelExpr
b forall a. Eq a => a -> a -> Bool
== ModelExpr
d
  BoolBinaryOp BoolBinOp
o ModelExpr
a ModelExpr
b  == BoolBinaryOp BoolBinOp
p ModelExpr
c ModelExpr
d  =   BoolBinOp
o forall a. Eq a => a -> a -> Bool
== BoolBinOp
p Bool -> Bool -> Bool
&& ModelExpr
a forall a. Eq a => a -> a -> Bool
== ModelExpr
c Bool -> Bool -> Bool
&& ModelExpr
b forall a. Eq a => a -> a -> Bool
== ModelExpr
d
  EqBinaryOp EqBinOp
o ModelExpr
a ModelExpr
b    == EqBinaryOp EqBinOp
p ModelExpr
c ModelExpr
d    =   EqBinOp
o forall a. Eq a => a -> a -> Bool
== EqBinOp
p Bool -> Bool -> Bool
&& ModelExpr
a forall a. Eq a => a -> a -> Bool
== ModelExpr
c Bool -> Bool -> Bool
&& ModelExpr
b forall a. Eq a => a -> a -> Bool
== ModelExpr
d
  OrdBinaryOp OrdBinOp
o ModelExpr
a ModelExpr
b   == OrdBinaryOp OrdBinOp
p ModelExpr
c ModelExpr
d   =   OrdBinOp
o forall a. Eq a => a -> a -> Bool
== OrdBinOp
p Bool -> Bool -> Bool
&& ModelExpr
a forall a. Eq a => a -> a -> Bool
== ModelExpr
c Bool -> Bool -> Bool
&& ModelExpr
b forall a. Eq a => a -> a -> Bool
== ModelExpr
d
  SpaceBinaryOp SpaceBinOp
o ModelExpr
a ModelExpr
b == SpaceBinaryOp SpaceBinOp
p ModelExpr
c ModelExpr
d =   SpaceBinOp
o forall a. Eq a => a -> a -> Bool
== SpaceBinOp
p Bool -> Bool -> Bool
&& ModelExpr
a forall a. Eq a => a -> a -> Bool
== ModelExpr
c Bool -> Bool -> Bool
&& ModelExpr
b forall a. Eq a => a -> a -> Bool
== ModelExpr
d
  StatBinaryOp StatBinOp
o ModelExpr
a ModelExpr
b  == StatBinaryOp StatBinOp
p ModelExpr
c ModelExpr
d  =   StatBinOp
o forall a. Eq a => a -> a -> Bool
== StatBinOp
p Bool -> Bool -> Bool
&& ModelExpr
a forall a. Eq a => a -> a -> Bool
== ModelExpr
c Bool -> Bool -> Bool
&& ModelExpr
b forall a. Eq a => a -> a -> Bool
== ModelExpr
d
  LABinaryOp LABinOp
o ModelExpr
a ModelExpr
b    == LABinaryOp LABinOp
p ModelExpr
c ModelExpr
d    =   LABinOp
o forall a. Eq a => a -> a -> Bool
== LABinOp
p Bool -> Bool -> Bool
&& ModelExpr
a forall a. Eq a => a -> a -> Bool
== ModelExpr
c Bool -> Bool -> Bool
&& ModelExpr
b forall a. Eq a => a -> a -> Bool
== ModelExpr
d
  VVVBinaryOp VVVBinOp
o ModelExpr
a ModelExpr
b   == VVVBinaryOp VVVBinOp
p ModelExpr
c ModelExpr
d   =   VVVBinOp
o forall a. Eq a => a -> a -> Bool
== VVVBinOp
p Bool -> Bool -> Bool
&& ModelExpr
a forall a. Eq a => a -> a -> Bool
== ModelExpr
c Bool -> Bool -> Bool
&& ModelExpr
b forall a. Eq a => a -> a -> Bool
== ModelExpr
d
  VVNBinaryOp VVNBinOp
o ModelExpr
a ModelExpr
b   == VVNBinaryOp VVNBinOp
p ModelExpr
c ModelExpr
d   =   VVNBinOp
o forall a. Eq a => a -> a -> Bool
== VVNBinOp
p Bool -> Bool -> Bool
&& ModelExpr
a forall a. Eq a => a -> a -> Bool
== ModelExpr
c Bool -> Bool -> Bool
&& ModelExpr
b forall a. Eq a => a -> a -> Bool
== ModelExpr
d
  ModelExpr
_                   == ModelExpr
_                   =   Bool
False
-- ^ TODO: This needs to add more equality checks

-- instance Fractional Expr where
--   a / b = ArithBinaryOp Frac a b
--   fromRational r = ArithBinaryOp Frac (fromInteger $ numerator   r)
--                                       (fromInteger $ denominator r)

instance LiteralC ModelExpr where
  int :: Integer -> ModelExpr
int = Literal -> ModelExpr
Lit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. LiteralC r => Integer -> r
int
  str :: String -> ModelExpr
str = Literal -> ModelExpr
Lit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. LiteralC r => String -> r
str
  dbl :: Double -> ModelExpr
dbl = Literal -> ModelExpr
Lit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. LiteralC r => Double -> r
dbl
  exactDbl :: Integer -> ModelExpr
exactDbl = Literal -> ModelExpr
Lit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. LiteralC r => Integer -> r
exactDbl
  perc :: Integer -> Integer -> ModelExpr
perc Integer
l Integer
r = Literal -> ModelExpr
Lit forall a b. (a -> b) -> a -> b
$ forall r. LiteralC r => Integer -> Integer -> r
perc Integer
l Integer
r