{-# LANGUAGE RankNTypes, FlexibleInstances, GADTs #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}
{-# LANGUAGE MultiParamTypeClasses #-}

-- | Contains chunks related to adding an expression to a quantitative concept. 
module Language.Drasil.Chunk.Eq (
  -- * Types
  QDefinition,
  -- * Constructors
  fromEqn, fromEqn', fromEqnSt,
  fromEqnSt', fromEqnSt'', mkQDefSt, mkQuantDef, mkQuantDef', ec,
  mkFuncDef, mkFuncDef', mkFuncDefByQ
) where

import Control.Lens ((^.), view, lens, Lens', to)
import Language.Drasil.Chunk.UnitDefn (unitWrapper, MayHaveUnit(getUnit), UnitDefn)

import Language.Drasil.Symbol (HasSymbol(symbol), Symbol)
import Language.Drasil.Classes (NamedIdea(term), Idea(getA),
  IsUnit, DefiningExpr(defnExpr), Definition(defn), Quantity,
  ConceptDomain(cdom), Express(express))
import Language.Drasil.Chunk.DefinedQuantity (DefinedQuantityDict, dqd, dqd')
import Language.Drasil.Chunk.Concept (cc')
import Language.Drasil.Chunk.NamedIdea (ncUID, mkIdea, nw)
import Language.Drasil.Chunk.Quantity (DefinesQuantity(defLhs), qw)

import Language.Drasil.Expr.Lang (Expr)
import qualified Language.Drasil.Expr.Lang as E (Expr(C))
import Language.Drasil.Expr.Class (ExprC(apply, sy, ($=)))
import Language.Drasil.ModelExpr.Class (ModelExprC(defines))
import qualified Language.Drasil.ModelExpr.Lang as M (ModelExpr(C))
import Language.Drasil.NounPhrase.Core (NP)
import Language.Drasil.Space (Space(..), HasSpace(..))
import Language.Drasil.Sentence (Sentence(EmptyS))
import Language.Drasil.Stages (Stage)
import Language.Drasil.UID (UID, HasUID(..))
import Language.Drasil.WellTyped (RequiresChecking(..))

data QDefinition e where
  QD :: DefinedQuantityDict -> [UID] -> e -> QDefinition e

qdQua :: Lens' (QDefinition e) DefinedQuantityDict
qdQua :: forall e. Lens' (QDefinition e) DefinedQuantityDict
qdQua = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(QD DefinedQuantityDict
qua [UID]
_ e
_) -> DefinedQuantityDict
qua) (\(QD DefinedQuantityDict
_ [UID]
ins e
e) DefinedQuantityDict
qua' -> forall e. DefinedQuantityDict -> [UID] -> e -> QDefinition e
QD DefinedQuantityDict
qua' [UID]
ins e
e)

qdInputs :: Lens' (QDefinition e) [UID]
qdInputs :: forall e. Lens' (QDefinition e) [UID]
qdInputs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(QD DefinedQuantityDict
_ [UID]
ins e
_) -> [UID]
ins) (\(QD DefinedQuantityDict
qua [UID]
_ e
e) [UID]
ins' -> forall e. DefinedQuantityDict -> [UID] -> e -> QDefinition e
QD DefinedQuantityDict
qua [UID]
ins' e
e)

qdExpr :: Lens' (QDefinition e) e
qdExpr :: forall e. Lens' (QDefinition e) e
qdExpr = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(QD DefinedQuantityDict
_ [UID]
_ e
e) -> e
e) (\(QD DefinedQuantityDict
qua [UID]
ins e
_) e
e' -> forall e. DefinedQuantityDict -> [UID] -> e -> QDefinition e
QD DefinedQuantityDict
qua [UID]
ins e
e')

instance HasUID          (QDefinition e) where uid :: Lens' (QDefinition e) UID
uid = forall e. Lens' (QDefinition e) DefinedQuantityDict
qdQua forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. HasUID c => Lens' c UID
uid
instance NamedIdea       (QDefinition e) where term :: Lens' (QDefinition e) NP
term = forall e. Lens' (QDefinition e) DefinedQuantityDict
qdQua forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. NamedIdea c => Lens' c NP
term
instance Idea            (QDefinition e) where getA :: QDefinition e -> Maybe String
getA = forall c. Idea c => c -> Maybe String
getA forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting a s a -> a
^. forall e. Lens' (QDefinition e) DefinedQuantityDict
qdQua)
instance DefinesQuantity (QDefinition e) where defLhs :: Getter (QDefinition e) QuantityDict
defLhs = forall e. Lens' (QDefinition e) DefinedQuantityDict
qdQua forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw
instance HasSpace        (QDefinition e) where typ :: Getter (QDefinition e) Space
typ = forall e. Lens' (QDefinition e) DefinedQuantityDict
qdQua forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. HasSpace c => Getter c Space
typ
instance HasSymbol       (QDefinition e) where symbol :: QDefinition e -> Stage -> Symbol
symbol = forall c. HasSymbol c => c -> Stage -> Symbol
symbol forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall s a. s -> Getting a s a -> a
^. forall e. Lens' (QDefinition e) DefinedQuantityDict
qdQua)
instance Definition      (QDefinition e) where defn :: Lens' (QDefinition e) Sentence
defn = forall e. Lens' (QDefinition e) DefinedQuantityDict
qdQua forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Definition c => Lens' c Sentence
defn
instance Quantity        (QDefinition e) where
instance Eq              (QDefinition e) where QDefinition e
a == :: QDefinition e -> QDefinition e -> Bool
== QDefinition e
b = QDefinition e
a forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid forall a. Eq a => a -> a -> Bool
== QDefinition e
b forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid
instance MayHaveUnit     (QDefinition e) where getUnit :: QDefinition e -> Maybe UnitDefn
getUnit = forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall e. Lens' (QDefinition e) DefinedQuantityDict
qdQua
instance DefiningExpr     QDefinition    where defnExpr :: forall e. Lens' (QDefinition e) e
defnExpr = forall e. Lens' (QDefinition e) e
qdExpr
instance Express e => Express (QDefinition e) where
  express :: QDefinition e -> ModelExpr
express QDefinition e
q = ModelExpr -> ModelExpr
f forall a b. (a -> b) -> a -> b
$ forall c. Express c => c -> ModelExpr
express forall a b. (a -> b) -> a -> b
$ QDefinition e
q forall s a. s -> Getting a s a -> a
^. forall (c :: * -> *) e. DefiningExpr c => Lens' (c e) e
defnExpr
    where
      f :: ModelExpr -> ModelExpr
f = case QDefinition e
q forall s a. s -> Getting a s a -> a
^. forall e. Lens' (QDefinition e) [UID]
qdInputs of
        [] -> forall r. ModelExprC r => r -> r -> r
defines (forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy QDefinition e
q)
        [UID]
is -> forall r. ModelExprC r => r -> r -> r
defines forall a b. (a -> b) -> a -> b
$ forall r f. (ExprC r, HasUID f, HasSymbol f) => f -> [r] -> r
apply QDefinition e
q (forall a b. (a -> b) -> [a] -> [b]
map UID -> ModelExpr
M.C [UID]
is)
        -- FIXME: The fact that we have to manually use `C` here is because our
        -- UID references don't carry enough information. This feels hacky at
        -- the moment, and should eventually be fixed.
instance ConceptDomain (QDefinition e) where cdom :: QDefinition e -> [UID]
cdom = forall c. ConceptDomain c => c -> [UID]
cdom forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall e. Lens' (QDefinition e) DefinedQuantityDict
qdQua

instance RequiresChecking (QDefinition Expr) Expr Space where
  -- FIXME: Here, we are type-checking QDefinitions by building it as a relation
  -- and running the relation through the type-checker. We do this because the
  -- "normal" way does not work for Functions because it leaves function input
  -- parameters left unchecked. It's probably preferred to be doing type
  -- checking at time of chunk creation rather than here, really.
  requiredChecks :: QDefinition Expr -> [(Expr, Space)]
requiredChecks (QD DefinedQuantityDict
q [UID]
is Expr
e) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall r f. (ExprC r, HasUID f, HasSymbol f) => f -> [r] -> r
apply DefinedQuantityDict
q (forall a b. (a -> b) -> [a] -> [b]
map UID -> Expr
E.C [UID]
is) forall r. ExprC r => r -> r -> r
$= Expr
e, Space
Boolean)

-- | Create a 'QDefinition' with a 'UID' (as a 'String'), term ('NP'), definition ('Sentence'), 'Symbol',
-- 'Space', unit, and defining expression.
fromEqn :: IsUnit u => String -> NP -> Sentence -> Symbol -> Space -> u -> e -> QDefinition e
fromEqn :: forall u e.
IsUnit u =>
String
-> NP -> Sentence -> Symbol -> Space -> u -> e -> QDefinition e
fromEqn String
nm NP
desc Sentence
def Symbol
symb Space
sp u
un =
  forall e. DefinedQuantityDict -> [UID] -> e -> QDefinition e
QD (forall u.
IsUnit u =>
ConceptChunk -> Symbol -> Space -> u -> DefinedQuantityDict
dqd (forall c. Idea c => c -> Sentence -> ConceptChunk
cc' (String -> NP -> Maybe String -> IdeaDict
mkIdea String
nm NP
desc forall a. Maybe a
Nothing) Sentence
def) Symbol
symb Space
sp u
un) []

-- | Same as 'fromEqn', but has no units.
fromEqn' :: String -> NP -> Sentence -> Symbol -> Space -> e -> QDefinition e
fromEqn' :: forall e.
String -> NP -> Sentence -> Symbol -> Space -> e -> QDefinition e
fromEqn' String
nm NP
desc Sentence
def Symbol
symb Space
sp =
  forall e. DefinedQuantityDict -> [UID] -> e -> QDefinition e
QD (ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (forall c. Idea c => c -> Sentence -> ConceptChunk
cc' (String -> NP -> Maybe String -> IdeaDict
mkIdea String
nm NP
desc forall a. Maybe a
Nothing) Sentence
def) (forall a b. a -> b -> a
const Symbol
symb) Space
sp forall a. Maybe a
Nothing) []

-- | Same as 'fromEqn', but symbol depends on stage.
fromEqnSt :: IsUnit u => UID -> NP -> Sentence -> (Stage -> Symbol) ->
  Space -> u -> e -> QDefinition e
fromEqnSt :: forall u e.
IsUnit u =>
UID
-> NP
-> Sentence
-> (Stage -> Symbol)
-> Space
-> u
-> e
-> QDefinition e
fromEqnSt UID
nm NP
desc Sentence
def Stage -> Symbol
symb Space
sp u
un =
  forall e. DefinedQuantityDict -> [UID] -> e -> QDefinition e
QD (ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (forall c. Idea c => c -> Sentence -> ConceptChunk
cc' (forall c. Idea c => c -> IdeaDict
nw forall a b. (a -> b) -> a -> b
$ UID -> NP -> IdeaDict
ncUID UID
nm NP
desc) Sentence
def) Stage -> Symbol
symb Space
sp (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall u. IsUnit u => u -> UnitDefn
unitWrapper u
un)) []

-- | Same as 'fromEqn', but symbol depends on stage and has no units.
fromEqnSt' :: UID -> NP -> Sentence -> (Stage -> Symbol) -> Space -> e -> QDefinition e
fromEqnSt' :: forall e.
UID
-> NP
-> Sentence
-> (Stage -> Symbol)
-> Space
-> e
-> QDefinition e
fromEqnSt' UID
nm NP
desc Sentence
def Stage -> Symbol
symb Space
sp =
  forall e. DefinedQuantityDict -> [UID] -> e -> QDefinition e
QD (ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (forall c. Idea c => c -> Sentence -> ConceptChunk
cc' (forall c. Idea c => c -> IdeaDict
nw forall a b. (a -> b) -> a -> b
$ UID -> NP -> IdeaDict
ncUID UID
nm NP
desc) Sentence
def) Stage -> Symbol
symb Space
sp forall a. Maybe a
Nothing) []

-- | Same as 'fromEqnSt'', but takes a 'String' instead of a 'UID'.
fromEqnSt'' :: String -> NP -> Sentence -> (Stage -> Symbol) -> Space -> e ->
  QDefinition e
fromEqnSt'' :: forall e.
String
-> NP
-> Sentence
-> (Stage -> Symbol)
-> Space
-> e
-> QDefinition e
fromEqnSt'' String
nm NP
desc Sentence
def Stage -> Symbol
symb Space
sp =
  forall e. DefinedQuantityDict -> [UID] -> e -> QDefinition e
QD (ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (forall c. Idea c => c -> Sentence -> ConceptChunk
cc' (String -> NP -> Maybe String -> IdeaDict
mkIdea String
nm NP
desc forall a. Maybe a
Nothing) Sentence
def) Stage -> Symbol
symb Space
sp forall a. Maybe a
Nothing) []

-- | Wrapper for fromEqnSt and fromEqnSt'
mkQDefSt :: UID -> NP -> Sentence -> (Stage -> Symbol) -> Space ->
  Maybe UnitDefn -> e -> QDefinition e
mkQDefSt :: forall e.
UID
-> NP
-> Sentence
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> e
-> QDefinition e
mkQDefSt UID
u NP
n Sentence
s Stage -> Symbol
symb Space
sp (Just UnitDefn
ud) e
e = forall u e.
IsUnit u =>
UID
-> NP
-> Sentence
-> (Stage -> Symbol)
-> Space
-> u
-> e
-> QDefinition e
fromEqnSt UID
u NP
n Sentence
s Stage -> Symbol
symb Space
sp UnitDefn
ud e
e
mkQDefSt UID
u NP
n Sentence
s Stage -> Symbol
symb Space
sp Maybe UnitDefn
Nothing   e
e = forall e.
UID
-> NP
-> Sentence
-> (Stage -> Symbol)
-> Space
-> e
-> QDefinition e
fromEqnSt' UID
u NP
n Sentence
s Stage -> Symbol
symb Space
sp e
e

-- | Used to help make 'QDefinition's when 'UID', term, and 'Symbol' come from the same source.
mkQuantDef :: (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef :: forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
mkQuantDef c
c = forall e.
UID
-> NP
-> Sentence
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> e
-> QDefinition e
mkQDefSt (c
c forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid) (c
c forall s a. s -> Getting a s a -> a
^. forall c. NamedIdea c => Lens' c NP
term) Sentence
EmptyS (forall c. HasSymbol c => c -> Stage -> Symbol
symbol c
c) (c
c forall s a. s -> Getting a s a -> a
^. forall c. HasSpace c => Getter c Space
typ) (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit c
c)

-- FIXME: See #2788.
-- | Used to help make 'QDefinition's when 'UID' and 'Symbol' come from the same source, with the term separate.
mkQuantDef' :: (Quantity c, MayHaveUnit c) => c -> NP -> e -> QDefinition e
mkQuantDef' :: forall c e.
(Quantity c, MayHaveUnit c) =>
c -> NP -> e -> QDefinition e
mkQuantDef' c
c NP
t = forall e.
UID
-> NP
-> Sentence
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> e
-> QDefinition e
mkQDefSt (c
c forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid) NP
t Sentence
EmptyS (forall c. HasSymbol c => c -> Stage -> Symbol
symbol c
c) (c
c forall s a. s -> Getting a s a -> a
^. forall c. HasSpace c => Getter c Space
typ) (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit c
c)

-- HACK - makes the definition EmptyS !!! FIXME
-- | Smart constructor for QDefinitions. Requires a quantity and its defining 
-- equation. 
ec :: (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
ec :: forall c e. (Quantity c, MayHaveUnit c) => c -> e -> QDefinition e
ec c
c = forall e. DefinedQuantityDict -> [UID] -> e -> QDefinition e
QD (ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (forall c. Idea c => c -> Sentence -> ConceptChunk
cc' (forall c. Idea c => c -> IdeaDict
nw c
c) Sentence
EmptyS) (forall c. HasSymbol c => c -> Stage -> Symbol
symbol c
c) (c
c forall s a. s -> Getting a s a -> a
^. forall c. HasSpace c => Getter c Space
typ) (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit c
c)) []

-- | Factored version of 'QDefinition' functions.
mkFuncDef0 :: (HasUID f, HasSymbol f, HasSpace f,
               HasUID i, HasSymbol i, HasSpace i) =>
  f -> NP -> Sentence -> Maybe UnitDefn -> [i] -> e -> QDefinition e
mkFuncDef0 :: forall f i e.
(HasUID f, HasSymbol f, HasSpace f, HasUID i, HasSymbol i,
 HasSpace i) =>
f -> NP -> Sentence -> Maybe UnitDefn -> [i] -> e -> QDefinition e
mkFuncDef0 f
f NP
n Sentence
s Maybe UnitDefn
u [i]
is = forall e. DefinedQuantityDict -> [UID] -> e -> QDefinition e
QD
  (ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (forall c. Idea c => c -> Sentence -> ConceptChunk
cc' (forall c. Idea c => c -> IdeaDict
nw (UID -> NP -> IdeaDict
ncUID (f
f forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid) NP
n)) Sentence
s) (forall c. HasSymbol c => c -> Stage -> Symbol
symbol f
f)
    (f
f forall s a. s -> Getting a s a -> a
^. forall c. HasSpace c => Getter c Space
typ) Maybe UnitDefn
u) (forall a b. (a -> b) -> [a] -> [b]
map (forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid) [i]
is)
    -- (mkFunction (map (^. typ) is) (f ^. typ)) u) (map (^. uid) is)

-- | Create a 'QDefinition' function with a symbol, name, term, list of inputs,
-- resultant units, and a defining Expr
mkFuncDef :: (HasUID f, HasSymbol f, HasSpace f,
              HasUID i, HasSymbol i, HasSpace i,
              IsUnit u) =>
  f -> NP -> Sentence -> u -> [i] -> e -> QDefinition e
mkFuncDef :: forall f i u e.
(HasUID f, HasSymbol f, HasSpace f, HasUID i, HasSymbol i,
 HasSpace i, IsUnit u) =>
f -> NP -> Sentence -> u -> [i] -> e -> QDefinition e
mkFuncDef f
f NP
n Sentence
s u
u = forall f i e.
(HasUID f, HasSymbol f, HasSpace f, HasUID i, HasSymbol i,
 HasSpace i) =>
f -> NP -> Sentence -> Maybe UnitDefn -> [i] -> e -> QDefinition e
mkFuncDef0 f
f NP
n Sentence
s (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall u. IsUnit u => u -> UnitDefn
unitWrapper u
u)

-- | Create a 'QDefinition' function with a symbol, name, term, list of inputs,
-- and a defining Expr
mkFuncDef' :: (HasUID f, HasSymbol f, HasSpace f,
               HasUID i, HasSymbol i, HasSpace i) =>
  f -> NP -> Sentence -> [i] -> e -> QDefinition e
mkFuncDef' :: forall f i e.
(HasUID f, HasSymbol f, HasSpace f, HasUID i, HasSymbol i,
 HasSpace i) =>
f -> NP -> Sentence -> [i] -> e -> QDefinition e
mkFuncDef' f
f NP
n Sentence
s = forall f i e.
(HasUID f, HasSymbol f, HasSpace f, HasUID i, HasSymbol i,
 HasSpace i) =>
f -> NP -> Sentence -> Maybe UnitDefn -> [i] -> e -> QDefinition e
mkFuncDef0 f
f NP
n Sentence
s forall a. Maybe a
Nothing

-- | Create a 'QDefinition' functions using a symbol, list of inputs, and a
-- defining Expr
mkFuncDefByQ :: (Quantity c, MayHaveUnit c, HasSpace c,
                 Quantity i, HasSpace i) =>
  c -> [i] -> e -> QDefinition e
mkFuncDefByQ :: forall c i e.
(Quantity c, MayHaveUnit c, HasSpace c, Quantity i, HasSpace i) =>
c -> [i] -> e -> QDefinition e
mkFuncDefByQ c
f = case forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit c
f of
  Just UnitDefn
u  -> forall f i u e.
(HasUID f, HasSymbol f, HasSpace f, HasUID i, HasSymbol i,
 HasSpace i, IsUnit u) =>
f -> NP -> Sentence -> u -> [i] -> e -> QDefinition e
mkFuncDef  c
f (c
f forall s a. s -> Getting a s a -> a
^. forall c. NamedIdea c => Lens' c NP
term) Sentence
EmptyS UnitDefn
u
  Maybe UnitDefn
Nothing -> forall f i e.
(HasUID f, HasSymbol f, HasSpace f, HasUID i, HasSymbol i,
 HasSpace i) =>
f -> NP -> Sentence -> [i] -> e -> QDefinition e
mkFuncDef' c
f (c
f forall s a. s -> Getting a s a -> a
^. forall c. NamedIdea c => Lens' c NP
term) Sentence
EmptyS