{-# LANGUAGE GADTs #-}
module Language.Drasil.CodeExpr.Convert (
    expr, realInterval, constraint,
    CanGenCode(..)
) where

import Language.Drasil.Space (RealInterval(..), DiscreteDomainDesc, DomainDesc(BoundedDD))
import Language.Drasil.Constraint (Constraint(..), ConstraintE)
import qualified Language.Drasil.Expr.Lang as E
import qualified Language.Drasil.Expr.Development as LD
import qualified Language.Drasil.Literal.Development as LL

import Language.Drasil.CodeExpr.Lang

import Data.Bifunctor (Bifunctor(bimap))

class CanGenCode e where
    toCodeExpr :: e -> CodeExpr

instance CanGenCode LL.Literal where
    toCodeExpr :: Literal -> CodeExpr
toCodeExpr = Literal -> CodeExpr
Lit

instance CanGenCode LD.Expr where
    toCodeExpr :: Expr -> CodeExpr
toCodeExpr = Expr -> CodeExpr
expr

-- | Render an algebraic expression into our code expression language.
expr :: LD.Expr -> CodeExpr
expr :: Expr -> CodeExpr
expr (LD.Lit Literal
l)                = Literal -> CodeExpr
Lit Literal
l
expr (LD.AssocA AssocArithOper
ao [Expr]
es)         = AssocArithOper -> [CodeExpr] -> CodeExpr
AssocA (AssocArithOper -> AssocArithOper
assocArithOp AssocArithOper
ao) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Expr -> CodeExpr
expr [Expr]
es
expr (LD.AssocB AssocBoolOper
bo [Expr]
es)         = AssocBoolOper -> [CodeExpr] -> CodeExpr
AssocB (AssocBoolOper -> AssocBoolOper
assocBoolOp AssocBoolOper
bo) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Expr -> CodeExpr
expr [Expr]
es
expr (LD.C UID
u)                  = UID -> CodeExpr
C UID
u
expr (LD.FCall UID
u [Expr]
es)           = UID -> [CodeExpr] -> [(UID, CodeExpr)] -> CodeExpr
FCall UID
u (forall a b. (a -> b) -> [a] -> [b]
map Expr -> CodeExpr
expr [Expr]
es) []
expr (LD.Case Completeness
c [(Expr, Expr)]
es)            = Completeness -> [(CodeExpr, CodeExpr)] -> CodeExpr
Case Completeness
c forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Expr -> CodeExpr
expr Expr -> CodeExpr
expr) [(Expr, Expr)]
es
expr (LD.Matrix [[Expr]]
es)            = [[CodeExpr]] -> CodeExpr
Matrix forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map Expr -> CodeExpr
expr) [[Expr]]
es
expr (LD.UnaryOp UFunc
uo Expr
e)         = UFunc -> CodeExpr -> CodeExpr
UnaryOp (UFunc -> UFunc
uFunc UFunc
uo) (Expr -> CodeExpr
expr Expr
e)
expr (LD.UnaryOpB UFuncB
uo Expr
e)        = UFuncB -> CodeExpr -> CodeExpr
UnaryOpB (UFuncB -> UFuncB
uFuncB UFuncB
uo) (Expr -> CodeExpr
expr Expr
e)
expr (LD.UnaryOpVV UFuncVV
uo Expr
e)       = UFuncVV -> CodeExpr -> CodeExpr
UnaryOpVV (UFuncVV -> UFuncVV
uFuncVV UFuncVV
uo) (Expr -> CodeExpr
expr Expr
e)
expr (LD.UnaryOpVN UFuncVN
uo Expr
e)       = UFuncVN -> CodeExpr -> CodeExpr
UnaryOpVN (UFuncVN -> UFuncVN
uFuncVN UFuncVN
uo) (Expr -> CodeExpr
expr Expr
e)
expr (LD.ArithBinaryOp ArithBinOp
bo Expr
l Expr
r) = ArithBinOp -> CodeExpr -> CodeExpr -> CodeExpr
ArithBinaryOp (ArithBinOp -> ArithBinOp
arithBinOp ArithBinOp
bo) (Expr -> CodeExpr
expr Expr
l) (Expr -> CodeExpr
expr Expr
r)
expr (LD.BoolBinaryOp BoolBinOp
bo Expr
l Expr
r)  = BoolBinOp -> CodeExpr -> CodeExpr -> CodeExpr
BoolBinaryOp (BoolBinOp -> BoolBinOp
boolBinOp BoolBinOp
bo) (Expr -> CodeExpr
expr Expr
l) (Expr -> CodeExpr
expr Expr
r)
expr (LD.EqBinaryOp EqBinOp
bo Expr
l Expr
r)    = EqBinOp -> CodeExpr -> CodeExpr -> CodeExpr
EqBinaryOp (EqBinOp -> EqBinOp
eqBinOp EqBinOp
bo) (Expr -> CodeExpr
expr Expr
l) (Expr -> CodeExpr
expr Expr
r)
expr (LD.LABinaryOp LABinOp
bo Expr
l Expr
r)    = LABinOp -> CodeExpr -> CodeExpr -> CodeExpr
LABinaryOp (LABinOp -> LABinOp
laBinOp LABinOp
bo) (Expr -> CodeExpr
expr Expr
l) (Expr -> CodeExpr
expr Expr
r)
expr (LD.OrdBinaryOp OrdBinOp
bo Expr
l Expr
r)   = OrdBinOp -> CodeExpr -> CodeExpr -> CodeExpr
OrdBinaryOp (OrdBinOp -> OrdBinOp
ordBinOp OrdBinOp
bo) (Expr -> CodeExpr
expr Expr
l) (Expr -> CodeExpr
expr Expr
r)
expr (LD.VVVBinaryOp VVVBinOp
bo Expr
l Expr
r)   = VVVBinOp -> CodeExpr -> CodeExpr -> CodeExpr
VVVBinaryOp (VVVBinOp -> VVVBinOp
vvvBinOp VVVBinOp
bo) (Expr -> CodeExpr
expr Expr
l) (Expr -> CodeExpr
expr Expr
r)
expr (LD.VVNBinaryOp VVNBinOp
bo Expr
l Expr
r)   = VVNBinOp -> CodeExpr -> CodeExpr -> CodeExpr
VVNBinaryOp (VVNBinOp -> VVNBinOp
vvnBinOp VVNBinOp
bo) (Expr -> CodeExpr
expr Expr
l) (Expr -> CodeExpr
expr Expr
r)
expr (LD.NVVBinaryOp NVVBinOp
bo Expr
l Expr
r)   = NVVBinOp -> CodeExpr -> CodeExpr -> CodeExpr
NVVBinaryOp (NVVBinOp -> NVVBinOp
nvvBinOp NVVBinOp
bo) (Expr -> CodeExpr
expr Expr
l) (Expr -> CodeExpr
expr Expr
r)
expr (LD.Operator AssocArithOper
aao DiscreteDomainDesc Expr Expr
dd Expr
e)    = AssocArithOper
-> DiscreteDomainDesc CodeExpr CodeExpr -> CodeExpr -> CodeExpr
Operator (AssocArithOper -> AssocArithOper
assocArithOp AssocArithOper
aao) (DiscreteDomainDesc Expr Expr
-> DiscreteDomainDesc CodeExpr CodeExpr
renderDomainDesc DiscreteDomainDesc Expr Expr
dd) (Expr -> CodeExpr
expr Expr
e)
expr (LD.RealI UID
u RealInterval Expr Expr
ri)           = UID -> RealInterval CodeExpr CodeExpr -> CodeExpr
RealI UID
u (RealInterval Expr Expr -> RealInterval CodeExpr CodeExpr
realInterval RealInterval Expr Expr
ri)

-- | Convert 'RealInterval' 'Expr' 'Expr's into 'RealInterval' 'CodeExpr' 'CodeExpr's.
realInterval :: RealInterval E.Expr E.Expr -> RealInterval CodeExpr CodeExpr
realInterval :: RealInterval Expr Expr -> RealInterval CodeExpr CodeExpr
realInterval (Bounded (Inclusive
il, Expr
el) (Inclusive
ir, Expr
er)) = forall a b. (Inclusive, a) -> (Inclusive, b) -> RealInterval a b
Bounded (Inclusive
il, Expr -> CodeExpr
expr Expr
el) (Inclusive
ir, Expr -> CodeExpr
expr Expr
er)
realInterval (UpTo (Inclusive
i, Expr
e))               = forall a b. (Inclusive, a) -> RealInterval a b
UpTo (Inclusive
i, Expr -> CodeExpr
expr Expr
e)
realInterval (UpFrom (Inclusive
i, Expr
e))             = forall b a. (Inclusive, b) -> RealInterval a b
UpFrom (Inclusive
i, Expr -> CodeExpr
expr Expr
e)

-- | Convert constrained expressions ('ConstraintE') into 'Constraint''CodeExpr's.
constraint :: ConstraintE -> Constraint CodeExpr
constraint :: ConstraintE -> Constraint CodeExpr
constraint (Range ConstraintReason
r RealInterval Expr Expr
ri) = forall a. ConstraintReason -> RealInterval a a -> Constraint a
Range ConstraintReason
r (RealInterval Expr Expr -> RealInterval CodeExpr CodeExpr
realInterval RealInterval Expr Expr
ri)

-- | Convert 'DomainDesc Expr Expr' into 'DomainDesc CodeExpr CodeExpr's.
renderDomainDesc :: DiscreteDomainDesc E.Expr E.Expr -> DiscreteDomainDesc CodeExpr CodeExpr
renderDomainDesc :: DiscreteDomainDesc Expr Expr
-> DiscreteDomainDesc CodeExpr CodeExpr
renderDomainDesc (BoundedDD Symbol
s RTopology
t Expr
l Expr
r) = forall a b.
Symbol -> RTopology -> a -> b -> DomainDesc 'Discrete a b
BoundedDD Symbol
s RTopology
t (Expr -> CodeExpr
expr Expr
l) (Expr -> CodeExpr
expr Expr
r)

arithBinOp :: LD.ArithBinOp -> ArithBinOp
arithBinOp :: ArithBinOp -> ArithBinOp
arithBinOp ArithBinOp
LD.Frac = ArithBinOp
Frac
arithBinOp ArithBinOp
LD.Pow = ArithBinOp
Pow
arithBinOp ArithBinOp
LD.Subt = ArithBinOp
Subt

eqBinOp :: LD.EqBinOp -> EqBinOp
eqBinOp :: EqBinOp -> EqBinOp
eqBinOp EqBinOp
LD.Eq = EqBinOp
Eq
eqBinOp EqBinOp
LD.NEq = EqBinOp
NEq

boolBinOp :: LD.BoolBinOp -> BoolBinOp
boolBinOp :: BoolBinOp -> BoolBinOp
boolBinOp BoolBinOp
LD.Impl = BoolBinOp
Impl
boolBinOp BoolBinOp
LD.Iff = BoolBinOp
Iff

laBinOp :: LD.LABinOp -> LABinOp
laBinOp :: LABinOp -> LABinOp
laBinOp LABinOp
LD.Index = LABinOp
Index

ordBinOp :: LD.OrdBinOp -> OrdBinOp
ordBinOp :: OrdBinOp -> OrdBinOp
ordBinOp OrdBinOp
LD.Lt  = OrdBinOp
Lt
ordBinOp OrdBinOp
LD.Gt  = OrdBinOp
Gt
ordBinOp OrdBinOp
LD.LEq = OrdBinOp
LEq
ordBinOp OrdBinOp
LD.GEq = OrdBinOp
GEq

vvvBinOp :: LD.VVVBinOp -> VVVBinOp
vvvBinOp :: VVVBinOp -> VVVBinOp
vvvBinOp VVVBinOp
LD.Cross = VVVBinOp
Cross
vvvBinOp VVVBinOp
LD.VAdd = VVVBinOp
VAdd
vvvBinOp VVVBinOp
LD.VSub = VVVBinOp
VSub

vvnBinOp :: LD.VVNBinOp -> VVNBinOp
vvnBinOp :: VVNBinOp -> VVNBinOp
vvnBinOp VVNBinOp
LD.Dot = VVNBinOp
Dot

nvvBinOp :: LD.NVVBinOp -> NVVBinOp
nvvBinOp :: NVVBinOp -> NVVBinOp
nvvBinOp NVVBinOp
LD.Scale = NVVBinOp
Scale

assocArithOp :: LD.AssocArithOper -> AssocArithOper
assocArithOp :: AssocArithOper -> AssocArithOper
assocArithOp AssocArithOper
LD.AddI = AssocArithOper
AddI -- TODO: These L.'s should be exported through L.D.Development
assocArithOp AssocArithOper
LD.AddRe = AssocArithOper
AddRe
assocArithOp AssocArithOper
LD.MulI = AssocArithOper
MulI
assocArithOp AssocArithOper
LD.MulRe = AssocArithOper
MulRe

assocBoolOp :: LD.AssocBoolOper -> AssocBoolOper
assocBoolOp :: AssocBoolOper -> AssocBoolOper
assocBoolOp AssocBoolOper
LD.And = AssocBoolOper
And -- TODO: These L.'s should be exported through L.D.Development
assocBoolOp AssocBoolOper
LD.Or = AssocBoolOper
Or

uFunc :: LD.UFunc -> UFunc
uFunc :: UFunc -> UFunc
uFunc UFunc
LD.Abs = UFunc
Abs -- TODO: These L.'s should be exported through L.D.Development
uFunc UFunc
LD.Log = UFunc
Log
uFunc UFunc
LD.Ln = UFunc
Ln
uFunc UFunc
LD.Sin = UFunc
Sin
uFunc UFunc
LD.Cos = UFunc
Cos
uFunc UFunc
LD.Tan = UFunc
Tan
uFunc UFunc
LD.Sec = UFunc
Sec
uFunc UFunc
LD.Csc = UFunc
Csc
uFunc UFunc
LD.Cot = UFunc
Cot
uFunc UFunc
LD.Arcsin = UFunc
Arcsin
uFunc UFunc
LD.Arccos = UFunc
Arccos
uFunc UFunc
LD.Arctan = UFunc
Arctan
uFunc UFunc
LD.Exp = UFunc
Exp
uFunc UFunc
LD.Sqrt = UFunc
Sqrt
uFunc UFunc
LD.Neg = UFunc
Neg

uFuncB :: LD.UFuncB -> UFuncB
uFuncB :: UFuncB -> UFuncB
uFuncB UFuncB
LD.Not = UFuncB
Not

uFuncVV :: LD.UFuncVV -> UFuncVV
uFuncVV :: UFuncVV -> UFuncVV
uFuncVV UFuncVV
LD.NegV = UFuncVV
NegV

uFuncVN :: LD.UFuncVN -> UFuncVN
uFuncVN :: UFuncVN -> UFuncVN
uFuncVN UFuncVN
LD.Norm = UFuncVN
Norm
uFuncVN UFuncVN
LD.Dim = UFuncVN
Dim