{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
module Language.Drasil.ModelExpr.Class where

import Prelude hiding (sqrt, log, sin, cos, tan, exp)

import Control.Lens ((^.))

import Language.Drasil.UID (HasUID(..))
import Language.Drasil.ModelExpr.Lang (ModelExpr(..), DerivType(..),
  SpaceBinOp(..), StatBinOp(..), AssocBoolOper(..), AssocArithOper(..))
import Language.Drasil.Space (DomainDesc(..), RTopology(..), Space)
import Language.Drasil.Symbol (Symbol, HasSymbol)

  
-- | Helper for creating new smart constructors for Associative Binary
--   operations that require at least 1 expression.
assocCreate :: AssocBoolOper -> [ModelExpr] -> ModelExpr
assocCreate :: AssocBoolOper -> [ModelExpr] -> ModelExpr
assocCreate AssocBoolOper
abo [] = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Need at least 1 expression to create " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show AssocBoolOper
abo
assocCreate AssocBoolOper
_ [ModelExpr
x]  = ModelExpr
x
assocCreate AssocBoolOper
b [ModelExpr]
des  = AssocBoolOper -> [ModelExpr] -> ModelExpr
AssocB AssocBoolOper
b forall a b. (a -> b) -> a -> b
$ AssocBoolOper -> [ModelExpr] -> [ModelExpr]
assocSanitize AssocBoolOper
b [ModelExpr]
des
  
-- | Helper for associative operations, removes embedded variants of the same kind
assocSanitize :: AssocBoolOper -> [ModelExpr] -> [ModelExpr]
assocSanitize :: AssocBoolOper -> [ModelExpr] -> [ModelExpr]
assocSanitize AssocBoolOper
_ [] = []
assocSanitize AssocBoolOper
b (it :: ModelExpr
it@(AssocB AssocBoolOper
c [ModelExpr]
des):[ModelExpr]
r)
  | AssocBoolOper
b forall a. Eq a => a -> a -> Bool
== AssocBoolOper
c    = AssocBoolOper -> [ModelExpr] -> [ModelExpr]
assocSanitize AssocBoolOper
b [ModelExpr]
des forall a. [a] -> [a] -> [a]
++ AssocBoolOper -> [ModelExpr] -> [ModelExpr]
assocSanitize AssocBoolOper
b [ModelExpr]
r
  | Bool
otherwise = ModelExpr
it forall a. a -> [a] -> [a]
: AssocBoolOper -> [ModelExpr] -> [ModelExpr]
assocSanitize AssocBoolOper
b [ModelExpr]
r
assocSanitize AssocBoolOper
b (ModelExpr
de:[ModelExpr]
des) = ModelExpr
de forall a. a -> [a] -> [a]
: AssocBoolOper -> [ModelExpr] -> [ModelExpr]
assocSanitize AssocBoolOper
b [ModelExpr]
des

class ModelExprC r where
  -- This also wants a symbol constraint.
  -- | Gets the derivative of an 'ModelExpr' with respect to a 'Symbol'.
  deriv, pderiv :: (HasUID c, HasSymbol c) => r -> c -> r
  
  -- | Gets the nthderivative of an 'ModelExpr' with respect to a 'Symbol'.
  nthderiv, nthpderiv :: (HasUID c, HasSymbol c) => Integer -> r -> c -> r

  -- | One expression is "defined" by another.
  defines :: r -> r -> r
  
  -- | Space literals.
  space :: Space -> r

  -- | Check if a value belongs to a Space.
  isIn :: r -> Space -> r
  
  -- | Binary associative "Equivalence".
  equiv :: [r] -> r
  
  -- | Smart constructor for the summation, product, and integral functions over all Real numbers.
  intAll, sumAll, prodAll :: Symbol -> r -> r

instance ModelExprC ModelExpr where
  deriv :: forall c. (HasUID c, HasSymbol c) => ModelExpr -> c -> ModelExpr
deriv ModelExpr
e c
c  = Integer -> DerivType -> ModelExpr -> UID -> ModelExpr
Deriv Integer
1 DerivType
Total ModelExpr
e (c
c forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid)
  pderiv :: forall c. (HasUID c, HasSymbol c) => ModelExpr -> c -> ModelExpr
pderiv ModelExpr
e c
c = Integer -> DerivType -> ModelExpr -> UID -> ModelExpr
Deriv Integer
1 DerivType
Part  ModelExpr
e (c
c forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid)
  nthderiv :: forall c.
(HasUID c, HasSymbol c) =>
Integer -> ModelExpr -> c -> ModelExpr
nthderiv Integer
n ModelExpr
e c
c
    | Integer
n forall a. Ord a => a -> a -> Bool
> Integer
0     = Integer -> DerivType -> ModelExpr -> UID -> ModelExpr
Deriv Integer
n DerivType
Total ModelExpr
e (c
c forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid)
    | Integer
n forall a. Eq a => a -> a -> Bool
== Integer
0    = Integer -> DerivType -> ModelExpr -> UID -> ModelExpr
Deriv Integer
0 DerivType
Total ModelExpr
e (c
c forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid)
    | Bool
otherwise = forall a. HasCallStack => [Char] -> a
error [Char]
"non-positive argument to derivative"

  nthpderiv :: forall c.
(HasUID c, HasSymbol c) =>
Integer -> ModelExpr -> c -> ModelExpr
nthpderiv Integer
n ModelExpr
e c
c
    | Integer
n forall a. Ord a => a -> a -> Bool
> Integer
0     = Integer -> DerivType -> ModelExpr -> UID -> ModelExpr
Deriv Integer
n DerivType
Part ModelExpr
e (c
c forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid)
    | Integer
n forall a. Eq a => a -> a -> Bool
== Integer
0    = Integer -> DerivType -> ModelExpr -> UID -> ModelExpr
Deriv Integer
0 DerivType
Total ModelExpr
e (c
c forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid)
    | Bool
otherwise = forall a. HasCallStack => [Char] -> a
error [Char]
"non-positive argument to derivative"

  defines :: ModelExpr -> ModelExpr -> ModelExpr
defines = StatBinOp -> ModelExpr -> ModelExpr -> ModelExpr
StatBinaryOp StatBinOp
Defines

  space :: Space -> ModelExpr
space = Space -> ModelExpr
Spc

  isIn :: ModelExpr -> Space -> ModelExpr
isIn ModelExpr
a Space
s = SpaceBinOp -> ModelExpr -> ModelExpr -> ModelExpr
SpaceBinaryOp SpaceBinOp
IsIn ModelExpr
a (Space -> ModelExpr
Spc Space
s)

  equiv :: [ModelExpr] -> ModelExpr
equiv [ModelExpr]
des
    | forall (t :: * -> *) a. Foldable t => t a -> Int
length [ModelExpr]
des forall a. Ord a => a -> a -> Bool
>= Int
2 = AssocBoolOper -> [ModelExpr] -> ModelExpr
assocCreate AssocBoolOper
Equivalence [ModelExpr]
des
    | Bool
otherwise       = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Need at least 2 expressions to create " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show AssocBoolOper
Equivalence
 
  -- TODO: All of the below only allow for Reals! Will be easier to fix while we add typing.
  -- | Integrate over some expression (∫).
  intAll :: Symbol -> ModelExpr -> ModelExpr
intAll Symbol
v = forall (t :: RTopology).
AssocArithOper
-> DomainDesc t ModelExpr ModelExpr -> ModelExpr -> ModelExpr
Operator AssocArithOper
AddRe (forall a b. Symbol -> RTopology -> DomainDesc 'Continuous a b
AllDD Symbol
v RTopology
Continuous)
  -- | Sum over some expression (∑).
  sumAll :: Symbol -> ModelExpr -> ModelExpr
sumAll Symbol
v = forall (t :: RTopology).
AssocArithOper
-> DomainDesc t ModelExpr ModelExpr -> ModelExpr -> ModelExpr
Operator AssocArithOper
AddRe (forall a b. Symbol -> RTopology -> DomainDesc 'Continuous a b
AllDD Symbol
v RTopology
Discrete)
  -- | Product over some expression (∏).
  prodAll :: Symbol -> ModelExpr -> ModelExpr
prodAll Symbol
v = forall (t :: RTopology).
AssocArithOper
-> DomainDesc t ModelExpr ModelExpr -> ModelExpr -> ModelExpr
Operator AssocArithOper
MulRe (forall a b. Symbol -> RTopology -> DomainDesc 'Continuous a b
AllDD Symbol
v RTopology
Discrete)