{-# LANGUAGE GADTs #-}

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

import Prelude hiding (sqrt)

import Drasil.Database (UID)

import Language.Drasil.Expr.Lang
  (Completeness, ArithBinOp, EqBinOp, LABinOp, OrdBinOp,
   VVVBinOp, VVNBinOp, NVVBinOp, ESSBinOp, ESBBinOp, AssocArithOper,
   AssocConcatOper,
   UFunc, UFuncB, UFuncVV, UFuncVN)
import Language.Drasil.Literal.Lang (Literal(..))
import Language.Drasil.Space (Space, DomainDesc, RealInterval)
import Language.Drasil.Literal.Class (LiteralC(..))

-- Binary functions

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

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

-- | @Value -> Space -> Bool@ operators.
data SpaceBinOp = IsIn
  deriving SpaceBinOp -> SpaceBinOp -> Bool
(SpaceBinOp -> SpaceBinOp -> Bool)
-> (SpaceBinOp -> SpaceBinOp -> Bool) -> Eq SpaceBinOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpaceBinOp -> SpaceBinOp -> Bool
== :: SpaceBinOp -> SpaceBinOp -> Bool
$c/= :: SpaceBinOp -> SpaceBinOp -> Bool
/= :: 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
(DerivType -> DerivType -> Bool)
-> (DerivType -> DerivType -> Bool) -> Eq DerivType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DerivType -> DerivType -> Bool
== :: DerivType -> DerivType -> Bool
$c/= :: DerivType -> DerivType -> Bool
/= :: 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

  AssocC   :: AssocConcatOper -> [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
  -- | Represents a set of expressions
  Set       :: Space -> [ModelExpr] -> ModelExpr
  -- | used to refernce the (name + type = variable )
  Variable :: String -> 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 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
  -- | Set operator for Element + Set -> Set
  ESSBinaryOp :: ESSBinOp -> ModelExpr -> ModelExpr -> ModelExpr
  -- | Set operator for Element + Set -> Bool
  ESBBinaryOp :: ESBBinOp -> 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 Literal -> Literal -> Bool
forall a. Eq a => a -> a -> Bool
== Literal
r
  AssocA AssocArithOper
o1 [ModelExpr]
l1        == AssocA AssocArithOper
o2 [ModelExpr]
l2        =  AssocArithOper
o1 AssocArithOper -> AssocArithOper -> Bool
forall a. Eq a => a -> a -> Bool
== AssocArithOper
o2 Bool -> Bool -> Bool
&& [ModelExpr]
l1 [ModelExpr] -> [ModelExpr] -> Bool
forall a. Eq a => a -> a -> Bool
== [ModelExpr]
l2
  AssocB AssocBoolOper
o1 [ModelExpr]
l1        == AssocB AssocBoolOper
o2 [ModelExpr]
l2        =  AssocBoolOper
o1 AssocBoolOper -> AssocBoolOper -> Bool
forall a. Eq a => a -> a -> Bool
== AssocBoolOper
o2 Bool -> Bool -> Bool
&& [ModelExpr]
l1 [ModelExpr] -> [ModelExpr] -> Bool
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 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
d Bool -> Bool -> Bool
&& DerivType
t1 DerivType -> DerivType -> Bool
forall a. Eq a => a -> a -> Bool
== DerivType
t2 Bool -> Bool -> Bool
&& ModelExpr
b ModelExpr -> ModelExpr -> Bool
forall a. Eq a => a -> a -> Bool
== ModelExpr
e Bool -> Bool -> Bool
&& UID
c UID -> UID -> Bool
forall a. Eq a => a -> a -> Bool
== UID
f
  C UID
a                 == C UID
b                 =   UID
a UID -> UID -> Bool
forall a. Eq a => a -> a -> Bool
== UID
b
  FCall UID
a [ModelExpr]
b           == FCall UID
c [ModelExpr]
d           =   UID
a UID -> UID -> Bool
forall a. Eq a => a -> a -> Bool
== UID
c Bool -> Bool -> Bool
&& [ModelExpr]
b [ModelExpr] -> [ModelExpr] -> Bool
forall a. Eq a => a -> a -> Bool
== [ModelExpr]
d
  Case Completeness
a [(ModelExpr, ModelExpr)]
b            == Case Completeness
c [(ModelExpr, ModelExpr)]
d            =   Completeness
a Completeness -> Completeness -> Bool
forall a. Eq a => a -> a -> Bool
== Completeness
c Bool -> Bool -> Bool
&& [(ModelExpr, ModelExpr)]
b [(ModelExpr, ModelExpr)] -> [(ModelExpr, ModelExpr)] -> Bool
forall a. Eq a => a -> a -> Bool
== [(ModelExpr, ModelExpr)]
d
  UnaryOp UFunc
a ModelExpr
b         == UnaryOp UFunc
c ModelExpr
d         =   UFunc
a UFunc -> UFunc -> Bool
forall a. Eq a => a -> a -> Bool
== UFunc
c Bool -> Bool -> Bool
&& ModelExpr
b ModelExpr -> ModelExpr -> Bool
forall a. Eq a => a -> a -> Bool
== ModelExpr
d
  UnaryOpB UFuncB
a ModelExpr
b        == UnaryOpB UFuncB
c ModelExpr
d        =   UFuncB
a UFuncB -> UFuncB -> Bool
forall a. Eq a => a -> a -> Bool
== UFuncB
c Bool -> Bool -> Bool
&& ModelExpr
b ModelExpr -> ModelExpr -> Bool
forall a. Eq a => a -> a -> Bool
== ModelExpr
d
  UnaryOpVV UFuncVV
a ModelExpr
b       == UnaryOpVV UFuncVV
c ModelExpr
d       =   UFuncVV
a UFuncVV -> UFuncVV -> Bool
forall a. Eq a => a -> a -> Bool
== UFuncVV
c Bool -> Bool -> Bool
&& ModelExpr
b ModelExpr -> ModelExpr -> Bool
forall a. Eq a => a -> a -> Bool
== ModelExpr
d
  UnaryOpVN UFuncVN
a ModelExpr
b       == UnaryOpVN UFuncVN
c ModelExpr
d       =   UFuncVN
a UFuncVN -> UFuncVN -> Bool
forall a. Eq a => a -> a -> Bool
== UFuncVN
c Bool -> Bool -> Bool
&& ModelExpr
b ModelExpr -> ModelExpr -> Bool
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 ArithBinOp -> ArithBinOp -> Bool
forall a. Eq a => a -> a -> Bool
== ArithBinOp
p Bool -> Bool -> Bool
&& ModelExpr
a ModelExpr -> ModelExpr -> Bool
forall a. Eq a => a -> a -> Bool
== ModelExpr
c Bool -> Bool -> Bool
&& ModelExpr
b ModelExpr -> ModelExpr -> Bool
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 EqBinOp -> EqBinOp -> Bool
forall a. Eq a => a -> a -> Bool
== EqBinOp
p Bool -> Bool -> Bool
&& ModelExpr
a ModelExpr -> ModelExpr -> Bool
forall a. Eq a => a -> a -> Bool
== ModelExpr
c Bool -> Bool -> Bool
&& ModelExpr
b ModelExpr -> ModelExpr -> Bool
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 OrdBinOp -> OrdBinOp -> Bool
forall a. Eq a => a -> a -> Bool
== OrdBinOp
p Bool -> Bool -> Bool
&& ModelExpr
a ModelExpr -> ModelExpr -> Bool
forall a. Eq a => a -> a -> Bool
== ModelExpr
c Bool -> Bool -> Bool
&& ModelExpr
b ModelExpr -> ModelExpr -> Bool
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 SpaceBinOp -> SpaceBinOp -> Bool
forall a. Eq a => a -> a -> Bool
== SpaceBinOp
p Bool -> Bool -> Bool
&& ModelExpr
a ModelExpr -> ModelExpr -> Bool
forall a. Eq a => a -> a -> Bool
== ModelExpr
c Bool -> Bool -> Bool
&& ModelExpr
b ModelExpr -> ModelExpr -> Bool
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 StatBinOp -> StatBinOp -> Bool
forall a. Eq a => a -> a -> Bool
== StatBinOp
p Bool -> Bool -> Bool
&& ModelExpr
a ModelExpr -> ModelExpr -> Bool
forall a. Eq a => a -> a -> Bool
== ModelExpr
c Bool -> Bool -> Bool
&& ModelExpr
b ModelExpr -> ModelExpr -> Bool
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 LABinOp -> LABinOp -> Bool
forall a. Eq a => a -> a -> Bool
== LABinOp
p Bool -> Bool -> Bool
&& ModelExpr
a ModelExpr -> ModelExpr -> Bool
forall a. Eq a => a -> a -> Bool
== ModelExpr
c Bool -> Bool -> Bool
&& ModelExpr
b ModelExpr -> ModelExpr -> Bool
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 VVVBinOp -> VVVBinOp -> Bool
forall a. Eq a => a -> a -> Bool
== VVVBinOp
p Bool -> Bool -> Bool
&& ModelExpr
a ModelExpr -> ModelExpr -> Bool
forall a. Eq a => a -> a -> Bool
== ModelExpr
c Bool -> Bool -> Bool
&& ModelExpr
b ModelExpr -> ModelExpr -> Bool
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 VVNBinOp -> VVNBinOp -> Bool
forall a. Eq a => a -> a -> Bool
== VVNBinOp
p Bool -> Bool -> Bool
&& ModelExpr
a ModelExpr -> ModelExpr -> Bool
forall a. Eq a => a -> a -> Bool
== ModelExpr
c Bool -> Bool -> Bool
&& ModelExpr
b ModelExpr -> ModelExpr -> Bool
forall a. Eq a => a -> a -> Bool
== ModelExpr
d
  ESSBinaryOp ESSBinOp
o ModelExpr
a ModelExpr
b   == ESSBinaryOp ESSBinOp
p ModelExpr
c ModelExpr
d   =   ESSBinOp
o ESSBinOp -> ESSBinOp -> Bool
forall a. Eq a => a -> a -> Bool
== ESSBinOp
p Bool -> Bool -> Bool
&& ModelExpr
a ModelExpr -> ModelExpr -> Bool
forall a. Eq a => a -> a -> Bool
== ModelExpr
c Bool -> Bool -> Bool
&& ModelExpr
b ModelExpr -> ModelExpr -> Bool
forall a. Eq a => a -> a -> Bool
== ModelExpr
d
  ESBBinaryOp ESBBinOp
o ModelExpr
a ModelExpr
b   == ESBBinaryOp ESBBinOp
p ModelExpr
c ModelExpr
d   =   ESBBinOp
o ESBBinOp -> ESBBinOp -> Bool
forall a. Eq a => a -> a -> Bool
== ESBBinOp
p Bool -> Bool -> Bool
&& ModelExpr
a ModelExpr -> ModelExpr -> Bool
forall a. Eq a => a -> a -> Bool
== ModelExpr
c Bool -> Bool -> Bool
&& ModelExpr
b ModelExpr -> ModelExpr -> Bool
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 (Literal -> ModelExpr)
-> (Integer -> Literal) -> Integer -> ModelExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
forall r. LiteralC r => Integer -> r
int
  str :: String -> ModelExpr
str = Literal -> ModelExpr
Lit (Literal -> ModelExpr)
-> (String -> Literal) -> String -> ModelExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Literal
forall r. LiteralC r => String -> r
str
  dbl :: Double -> ModelExpr
dbl = Literal -> ModelExpr
Lit (Literal -> ModelExpr)
-> (Double -> Literal) -> Double -> ModelExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Literal
forall r. LiteralC r => Double -> r
dbl
  exactDbl :: Integer -> ModelExpr
exactDbl = Literal -> ModelExpr
Lit (Literal -> ModelExpr)
-> (Integer -> Literal) -> Integer -> ModelExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Literal
forall r. LiteralC r => Integer -> r
exactDbl
  perc :: Integer -> Integer -> ModelExpr
perc Integer
l Integer
r = Literal -> ModelExpr
Lit (Literal -> ModelExpr) -> Literal -> ModelExpr
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Literal
forall r. LiteralC r => Integer -> Integer -> r
perc Integer
l Integer
r