{-# LANGUAGE GADTs #-}
module Drasil.Code.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 Drasil.Code.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
ao ([CodeExpr] -> CodeExpr) -> [CodeExpr] -> CodeExpr
forall a b. (a -> b) -> a -> b
$ (Expr -> CodeExpr) -> [Expr] -> [CodeExpr]
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
bo ([CodeExpr] -> CodeExpr) -> [CodeExpr] -> CodeExpr
forall a b. (a -> b) -> a -> b
$ (Expr -> CodeExpr) -> [Expr] -> [CodeExpr]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> CodeExpr
expr [Expr]
es
expr (LD.AssocC AssocConcatOper
bo [Expr]
es)         = AssocConcatOper -> [CodeExpr] -> CodeExpr
AssocC AssocConcatOper
bo ([CodeExpr] -> CodeExpr) -> [CodeExpr] -> CodeExpr
forall a b. (a -> b) -> a -> b
$ (Expr -> CodeExpr) -> [Expr] -> [CodeExpr]
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 ((Expr -> CodeExpr) -> [Expr] -> [CodeExpr]
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 ([(CodeExpr, CodeExpr)] -> CodeExpr)
-> [(CodeExpr, CodeExpr)] -> CodeExpr
forall a b. (a -> b) -> a -> b
$ ((Expr, Expr) -> (CodeExpr, CodeExpr))
-> [(Expr, Expr)] -> [(CodeExpr, CodeExpr)]
forall a b. (a -> b) -> [a] -> [b]
map ((Expr -> CodeExpr)
-> (Expr -> CodeExpr) -> (Expr, Expr) -> (CodeExpr, CodeExpr)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
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 ([[CodeExpr]] -> CodeExpr) -> [[CodeExpr]] -> CodeExpr
forall a b. (a -> b) -> a -> b
$ ([Expr] -> [CodeExpr]) -> [[Expr]] -> [[CodeExpr]]
forall a b. (a -> b) -> [a] -> [b]
map ((Expr -> CodeExpr) -> [Expr] -> [CodeExpr]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> CodeExpr
expr) [[Expr]]
es
expr (LD.Set Space
e [Expr]
es)             = Space -> [CodeExpr] -> CodeExpr
Set Space
e ([CodeExpr] -> CodeExpr) -> [CodeExpr] -> CodeExpr
forall a b. (a -> b) -> a -> b
$ (Expr -> CodeExpr) -> [Expr] -> [CodeExpr]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> CodeExpr
expr [Expr]
es
expr (E.Variable String
s Expr
e)          = String -> CodeExpr -> CodeExpr
Variable String
s (CodeExpr -> CodeExpr) -> CodeExpr -> CodeExpr
forall a b. (a -> b) -> a -> b
$ Expr -> CodeExpr
expr Expr
e
expr (LD.UnaryOp UFunc
uo Expr
e)         = UFunc -> CodeExpr -> CodeExpr
UnaryOp UFunc
uo (Expr -> CodeExpr
expr Expr
e)
expr (LD.UnaryOpB UFuncB
uo Expr
e)        = UFuncB -> CodeExpr -> CodeExpr
UnaryOpB UFuncB
uo (Expr -> CodeExpr
expr Expr
e)
expr (LD.UnaryOpVV UFuncVV
uo Expr
e)       = UFuncVV -> CodeExpr -> CodeExpr
UnaryOpVV UFuncVV
uo (Expr -> CodeExpr
expr Expr
e)
expr (LD.UnaryOpVN UFuncVN
uo Expr
e)       = UFuncVN -> CodeExpr -> CodeExpr
UnaryOpVN UFuncVN
uo (Expr -> CodeExpr
expr Expr
e)
expr (LD.ArithBinaryOp ArithBinOp
bo Expr
l Expr
r) = ArithBinOp -> CodeExpr -> CodeExpr -> CodeExpr
ArithBinaryOp ArithBinOp
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
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
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
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
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
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
bo (Expr -> CodeExpr
expr Expr
l) (Expr -> CodeExpr
expr Expr
r)
expr (LD.ESSBinaryOp ESSBinOp
bo Expr
l Expr
r)   = ESSBinOp -> CodeExpr -> CodeExpr -> CodeExpr
ESSBinaryOp ESSBinOp
bo (Expr -> CodeExpr
expr Expr
l) (Expr -> CodeExpr
expr Expr
r)
expr (LD.ESBBinaryOp ESBBinOp
bo Expr
l Expr
r)   = ESBBinOp -> CodeExpr -> CodeExpr -> CodeExpr
ESBBinaryOp ESBBinOp
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
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)) = (Inclusive, CodeExpr)
-> (Inclusive, CodeExpr) -> RealInterval CodeExpr CodeExpr
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))               = (Inclusive, CodeExpr) -> RealInterval CodeExpr CodeExpr
forall a b. (Inclusive, a) -> RealInterval a b
UpTo (Inclusive
i, Expr -> CodeExpr
expr Expr
e)
realInterval (UpFrom (Inclusive
i, Expr
e))             = (Inclusive, CodeExpr) -> RealInterval CodeExpr CodeExpr
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) = ConstraintReason
-> RealInterval CodeExpr CodeExpr -> Constraint CodeExpr
forall a. ConstraintReason -> RealInterval a a -> Constraint a
Range ConstraintReason
r (RealInterval Expr Expr -> RealInterval CodeExpr CodeExpr
realInterval RealInterval Expr Expr
ri)
constraint (Elem ConstraintReason
r Expr
ri) = ConstraintReason -> CodeExpr -> Constraint CodeExpr
forall a. ConstraintReason -> a -> Constraint a
Elem ConstraintReason
r (Expr -> CodeExpr
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) = Symbol
-> RTopology
-> CodeExpr
-> CodeExpr
-> DiscreteDomainDesc CodeExpr CodeExpr
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)