{-# 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,
  -- * Synonyms
  ConstQDef, SimpleQDef, ModelQDef
) where

import Control.Lens ((^.), view, lens, Lens', to)
import Drasil.Database (UID, HasUID(..), HasChunkRefs(..), IsChunk, mkUid)
import qualified Data.Set as Set

import Language.Drasil.Chunk.UnitDefn (MayHaveUnit(getUnit), UnitDefn)
import Language.Drasil.Symbol (HasSymbol(symbol), Symbol)
import Language.Drasil.Classes (NamedIdea(term), Idea(getA),
  DefiningExpr(defnExpr), Definition(defn), Quantity,
  ConceptDomain(cdom), Express(express), Concept)
import Language.Drasil.Chunk.DefinedQuantity (DefinedQuantityDict, DefinesQuantity(defLhs),
  dqdWr, quant, quantNoUnit, quant', quantNoUnit', quantAU)
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.Literal.Lang (Literal)
import Language.Drasil.ModelExpr.Class (ModelExprC(defines))
import qualified Language.Drasil.ModelExpr.Lang as M (ModelExpr(C))
import Language.Drasil.NaturalLanguage.English.NounPhrase.Core (NP)
import Language.Drasil.Space (Space(..), HasSpace(..))
import Language.Drasil.Sentence (Sentence(EmptyS))
import Language.Drasil.Stages (Stage)
import Language.Drasil.WellTyped (RequiresChecking(..))

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

qdQua :: Lens' (QDefinition e) DefinedQuantityDict
qdQua :: forall e (f :: * -> *).
Functor f =>
(DefinedQuantityDict -> f DefinedQuantityDict)
-> QDefinition e -> f (QDefinition e)
qdQua = (QDefinition e -> DefinedQuantityDict)
-> (QDefinition e -> DefinedQuantityDict -> QDefinition e)
-> Lens
     (QDefinition e)
     (QDefinition e)
     DefinedQuantityDict
     DefinedQuantityDict
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' -> DefinedQuantityDict -> [UID] -> e -> QDefinition e
forall e. DefinedQuantityDict -> [UID] -> e -> QDefinition e
QD DefinedQuantityDict
qua' [UID]
ins e
e)

qdInputs :: Lens' (QDefinition e) [UID]
qdInputs :: forall e (f :: * -> *).
Functor f =>
([UID] -> f [UID]) -> QDefinition e -> f (QDefinition e)
qdInputs = (QDefinition e -> [UID])
-> (QDefinition e -> [UID] -> QDefinition e)
-> Lens (QDefinition e) (QDefinition e) [UID] [UID]
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' -> DefinedQuantityDict -> [UID] -> e -> QDefinition e
forall e. DefinedQuantityDict -> [UID] -> e -> QDefinition e
QD DefinedQuantityDict
qua [UID]
ins' e
e)

qdExpr :: Lens' (QDefinition e) e
qdExpr :: forall e (f :: * -> *).
Functor f =>
(e -> f e) -> QDefinition e -> f (QDefinition e)
qdExpr = (QDefinition e -> e)
-> (QDefinition e -> e -> QDefinition e)
-> Lens (QDefinition e) (QDefinition e) e e
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' -> DefinedQuantityDict -> [UID] -> e -> QDefinition e
forall e. DefinedQuantityDict -> [UID] -> e -> QDefinition e
QD DefinedQuantityDict
qua [UID]
ins e
e')

instance HasChunkRefs (QDefinition e) where
  chunkRefs :: QDefinition e -> Set UID
chunkRefs QDefinition e
q = [Set UID] -> Set UID
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions
    [ DefinedQuantityDict -> Set UID
forall a. HasChunkRefs a => a -> Set UID
chunkRefs (QDefinition e
q QDefinition e
-> Getting DefinedQuantityDict (QDefinition e) DefinedQuantityDict
-> DefinedQuantityDict
forall s a. s -> Getting a s a -> a
^. Getting DefinedQuantityDict (QDefinition e) DefinedQuantityDict
forall e (f :: * -> *).
Functor f =>
(DefinedQuantityDict -> f DefinedQuantityDict)
-> QDefinition e -> f (QDefinition e)
qdQua)
    , [UID] -> Set UID
forall a. Ord a => [a] -> Set a
Set.fromList (QDefinition e
q QDefinition e -> Getting [UID] (QDefinition e) [UID] -> [UID]
forall s a. s -> Getting a s a -> a
^. Getting [UID] (QDefinition e) [UID]
forall e (f :: * -> *).
Functor f =>
([UID] -> f [UID]) -> QDefinition e -> f (QDefinition e)
qdInputs)
    ]
  {-# INLINABLE chunkRefs #-}

instance HasUID          (QDefinition e) where uid :: Getter (QDefinition e) UID
uid = (DefinedQuantityDict -> f DefinedQuantityDict)
-> QDefinition e -> f (QDefinition e)
forall e (f :: * -> *).
Functor f =>
(DefinedQuantityDict -> f DefinedQuantityDict)
-> QDefinition e -> f (QDefinition e)
qdQua ((DefinedQuantityDict -> f DefinedQuantityDict)
 -> QDefinition e -> f (QDefinition e))
-> ((UID -> f UID) -> DefinedQuantityDict -> f DefinedQuantityDict)
-> (UID -> f UID)
-> QDefinition e
-> f (QDefinition e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UID -> f UID) -> DefinedQuantityDict -> f DefinedQuantityDict
forall c. HasUID c => Getter c UID
Getter DefinedQuantityDict UID
uid
instance NamedIdea       (QDefinition e) where term :: Lens' (QDefinition e) NP
term = (DefinedQuantityDict -> f DefinedQuantityDict)
-> QDefinition e -> f (QDefinition e)
forall e (f :: * -> *).
Functor f =>
(DefinedQuantityDict -> f DefinedQuantityDict)
-> QDefinition e -> f (QDefinition e)
qdQua ((DefinedQuantityDict -> f DefinedQuantityDict)
 -> QDefinition e -> f (QDefinition e))
-> ((NP -> f NP) -> DefinedQuantityDict -> f DefinedQuantityDict)
-> (NP -> f NP)
-> QDefinition e
-> f (QDefinition e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NP -> f NP) -> DefinedQuantityDict -> f DefinedQuantityDict
forall c. NamedIdea c => Lens' c NP
Lens' DefinedQuantityDict NP
term
instance Idea            (QDefinition e) where getA :: QDefinition e -> Maybe String
getA = DefinedQuantityDict -> Maybe String
forall c. Idea c => c -> Maybe String
getA (DefinedQuantityDict -> Maybe String)
-> (QDefinition e -> DefinedQuantityDict)
-> QDefinition e
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QDefinition e
-> Getting DefinedQuantityDict (QDefinition e) DefinedQuantityDict
-> DefinedQuantityDict
forall s a. s -> Getting a s a -> a
^. Getting DefinedQuantityDict (QDefinition e) DefinedQuantityDict
forall e (f :: * -> *).
Functor f =>
(DefinedQuantityDict -> f DefinedQuantityDict)
-> QDefinition e -> f (QDefinition e)
qdQua)
instance DefinesQuantity (QDefinition e) where defLhs :: Getter (QDefinition e) DefinedQuantityDict
defLhs = (DefinedQuantityDict -> f DefinedQuantityDict)
-> QDefinition e -> f (QDefinition e)
forall e (f :: * -> *).
Functor f =>
(DefinedQuantityDict -> f DefinedQuantityDict)
-> QDefinition e -> f (QDefinition e)
qdQua ((DefinedQuantityDict -> f DefinedQuantityDict)
 -> QDefinition e -> f (QDefinition e))
-> ((DefinedQuantityDict -> f DefinedQuantityDict)
    -> DefinedQuantityDict -> f DefinedQuantityDict)
-> (DefinedQuantityDict -> f DefinedQuantityDict)
-> QDefinition e
-> f (QDefinition e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DefinedQuantityDict -> DefinedQuantityDict)
-> (DefinedQuantityDict -> f DefinedQuantityDict)
-> DefinedQuantityDict
-> f DefinedQuantityDict
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to DefinedQuantityDict -> DefinedQuantityDict
forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr
instance HasSpace        (QDefinition e) where typ :: Getter (QDefinition e) Space
typ = (DefinedQuantityDict -> f DefinedQuantityDict)
-> QDefinition e -> f (QDefinition e)
forall e (f :: * -> *).
Functor f =>
(DefinedQuantityDict -> f DefinedQuantityDict)
-> QDefinition e -> f (QDefinition e)
qdQua ((DefinedQuantityDict -> f DefinedQuantityDict)
 -> QDefinition e -> f (QDefinition e))
-> ((Space -> f Space)
    -> DefinedQuantityDict -> f DefinedQuantityDict)
-> (Space -> f Space)
-> QDefinition e
-> f (QDefinition e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Space -> f Space) -> DefinedQuantityDict -> f DefinedQuantityDict
forall c. HasSpace c => Getter c Space
Getter DefinedQuantityDict Space
typ
instance HasSymbol       (QDefinition e) where symbol :: QDefinition e -> Stage -> Symbol
symbol = DefinedQuantityDict -> Stage -> Symbol
forall c. HasSymbol c => c -> Stage -> Symbol
symbol (DefinedQuantityDict -> Stage -> Symbol)
-> (QDefinition e -> DefinedQuantityDict)
-> QDefinition e
-> Stage
-> Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (QDefinition e
-> Getting DefinedQuantityDict (QDefinition e) DefinedQuantityDict
-> DefinedQuantityDict
forall s a. s -> Getting a s a -> a
^. Getting DefinedQuantityDict (QDefinition e) DefinedQuantityDict
forall e (f :: * -> *).
Functor f =>
(DefinedQuantityDict -> f DefinedQuantityDict)
-> QDefinition e -> f (QDefinition e)
qdQua)
instance Definition      (QDefinition e) where defn :: Lens' (QDefinition e) Sentence
defn = (DefinedQuantityDict -> f DefinedQuantityDict)
-> QDefinition e -> f (QDefinition e)
forall e (f :: * -> *).
Functor f =>
(DefinedQuantityDict -> f DefinedQuantityDict)
-> QDefinition e -> f (QDefinition e)
qdQua ((DefinedQuantityDict -> f DefinedQuantityDict)
 -> QDefinition e -> f (QDefinition e))
-> ((Sentence -> f Sentence)
    -> DefinedQuantityDict -> f DefinedQuantityDict)
-> (Sentence -> f Sentence)
-> QDefinition e
-> f (QDefinition e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sentence -> f Sentence)
-> DefinedQuantityDict -> f DefinedQuantityDict
forall c. Definition c => Lens' c Sentence
Lens' DefinedQuantityDict 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 QDefinition e -> Getting UID (QDefinition e) UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID (QDefinition e) UID
forall c. HasUID c => Getter c UID
Getter (QDefinition e) UID
uid UID -> UID -> Bool
forall a. Eq a => a -> a -> Bool
== QDefinition e
b QDefinition e -> Getting UID (QDefinition e) UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID (QDefinition e) UID
forall c. HasUID c => Getter c UID
Getter (QDefinition e) UID
uid
instance MayHaveUnit     (QDefinition e) where getUnit :: QDefinition e -> Maybe UnitDefn
getUnit = DefinedQuantityDict -> Maybe UnitDefn
forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit (DefinedQuantityDict -> Maybe UnitDefn)
-> (QDefinition e -> DefinedQuantityDict)
-> QDefinition e
-> Maybe UnitDefn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting DefinedQuantityDict (QDefinition e) DefinedQuantityDict
-> QDefinition e -> DefinedQuantityDict
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting DefinedQuantityDict (QDefinition e) DefinedQuantityDict
forall e (f :: * -> *).
Functor f =>
(DefinedQuantityDict -> f DefinedQuantityDict)
-> QDefinition e -> f (QDefinition e)
qdQua
instance DefiningExpr     QDefinition    where defnExpr :: forall e (f :: * -> *).
Functor f =>
(e -> f e) -> QDefinition e -> f (QDefinition e)
defnExpr = (e -> f e) -> QDefinition e -> f (QDefinition e)
forall e (f :: * -> *).
Functor f =>
(e -> f e) -> QDefinition e -> f (QDefinition e)
qdExpr
instance Express e => Express (QDefinition e) where
  express :: QDefinition e -> ModelExpr
express QDefinition e
q = ModelExpr -> ModelExpr
f (ModelExpr -> ModelExpr) -> ModelExpr -> ModelExpr
forall a b. (a -> b) -> a -> b
$ e -> ModelExpr
forall c. Express c => c -> ModelExpr
express (e -> ModelExpr) -> e -> ModelExpr
forall a b. (a -> b) -> a -> b
$ QDefinition e
q QDefinition e -> Getting e (QDefinition e) e -> e
forall s a. s -> Getting a s a -> a
^. Getting e (QDefinition e) e
forall e (f :: * -> *).
Functor f =>
(e -> f e) -> QDefinition e -> f (QDefinition e)
forall (c :: * -> *) e. DefiningExpr c => Lens' (c e) e
defnExpr
    where
      f :: ModelExpr -> ModelExpr
f = case QDefinition e
q QDefinition e -> Getting [UID] (QDefinition e) [UID] -> [UID]
forall s a. s -> Getting a s a -> a
^. Getting [UID] (QDefinition e) [UID]
forall e (f :: * -> *).
Functor f =>
([UID] -> f [UID]) -> QDefinition e -> f (QDefinition e)
qdInputs of
        [] -> ModelExpr -> ModelExpr -> ModelExpr
forall r. ModelExprC r => r -> r -> r
defines (QDefinition e -> ModelExpr
forall c. (IsChunk c, HasSymbol c) => c -> ModelExpr
forall r c. (ExprC r, IsChunk c, HasSymbol c) => c -> r
sy QDefinition e
q)
        [UID]
is -> ModelExpr -> ModelExpr -> ModelExpr
forall r. ModelExprC r => r -> r -> r
defines (ModelExpr -> ModelExpr -> ModelExpr)
-> ModelExpr -> ModelExpr -> ModelExpr
forall a b. (a -> b) -> a -> b
$ QDefinition e -> [ModelExpr] -> ModelExpr
forall f. (IsChunk f, HasSymbol f) => f -> [ModelExpr] -> ModelExpr
forall r f. (ExprC r, IsChunk f, HasSymbol f) => f -> [r] -> r
apply QDefinition e
q ((UID -> ModelExpr) -> [UID] -> [ModelExpr]
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 = DefinedQuantityDict -> [UID]
forall c. ConceptDomain c => c -> [UID]
cdom (DefinedQuantityDict -> [UID])
-> (QDefinition e -> DefinedQuantityDict) -> QDefinition e -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting DefinedQuantityDict (QDefinition e) DefinedQuantityDict
-> QDefinition e -> DefinedQuantityDict
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting DefinedQuantityDict (QDefinition e) DefinedQuantityDict
forall e (f :: * -> *).
Functor f =>
(DefinedQuantityDict -> f DefinedQuantityDict)
-> QDefinition e -> f (QDefinition e)
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) = (Expr, Space) -> [(Expr, Space)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DefinedQuantityDict -> [Expr] -> Expr
forall f. (IsChunk f, HasSymbol f) => f -> [Expr] -> Expr
forall r f. (ExprC r, IsChunk f, HasSymbol f) => f -> [r] -> r
apply DefinedQuantityDict
q ((UID -> Expr) -> [UID] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map UID -> Expr
E.C [UID]
is) Expr -> Expr -> Expr
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 :: String -> NP -> Sentence -> Symbol -> Space -> UnitDefn -> e -> QDefinition e
fromEqn :: forall e.
String
-> NP
-> Sentence
-> Symbol
-> Space
-> UnitDefn
-> e
-> QDefinition e
fromEqn String
nm NP
desc Sentence
def Symbol
symb Space
sp UnitDefn
un =
  DefinedQuantityDict -> [UID] -> e -> QDefinition e
forall e. DefinedQuantityDict -> [UID] -> e -> QDefinition e
QD (UID
-> NP
-> Sentence
-> Symbol
-> Space
-> UnitDefn
-> DefinedQuantityDict
quant (String -> UID
mkUid String
nm) NP
desc Sentence
def Symbol
symb Space
sp UnitDefn
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 =
  DefinedQuantityDict -> [UID] -> e -> QDefinition e
forall e. DefinedQuantityDict -> [UID] -> e -> QDefinition e
QD (UID -> NP -> Sentence -> Symbol -> Space -> DefinedQuantityDict
quantNoUnit (String -> UID
mkUid String
nm) NP
desc Sentence
def Symbol
symb Space
sp) []

-- | Same as 'fromEqn', but symbol depends on stage.
fromEqnSt :: UID -> NP -> Sentence -> (Stage -> Symbol) ->
  Space -> UnitDefn -> e -> QDefinition e
fromEqnSt :: forall e.
UID
-> NP
-> Sentence
-> (Stage -> Symbol)
-> Space
-> UnitDefn
-> e
-> QDefinition e
fromEqnSt UID
nm NP
desc Sentence
def Stage -> Symbol
symb Space
sp UnitDefn
un =
  DefinedQuantityDict -> [UID] -> e -> QDefinition e
forall e. DefinedQuantityDict -> [UID] -> e -> QDefinition e
QD (UID
-> NP
-> Sentence
-> (Stage -> Symbol)
-> Space
-> UnitDefn
-> DefinedQuantityDict
quant' UID
nm NP
desc Sentence
def Stage -> Symbol
symb Space
sp UnitDefn
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 =
  DefinedQuantityDict -> [UID] -> e -> QDefinition e
forall e. DefinedQuantityDict -> [UID] -> e -> QDefinition e
QD (UID
-> NP
-> Sentence
-> (Stage -> Symbol)
-> Space
-> DefinedQuantityDict
quantNoUnit' UID
nm NP
desc Sentence
def Stage -> Symbol
symb Space
sp) []

-- | 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 =
  DefinedQuantityDict -> [UID] -> e -> QDefinition e
forall e. DefinedQuantityDict -> [UID] -> e -> QDefinition e
QD (UID
-> NP
-> Sentence
-> (Stage -> Symbol)
-> Space
-> DefinedQuantityDict
quantNoUnit' (String -> UID
mkUid String
nm) NP
desc Sentence
def Stage -> Symbol
symb Space
sp) []

-- | 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 = UID
-> NP
-> Sentence
-> (Stage -> Symbol)
-> Space
-> UnitDefn
-> e
-> QDefinition e
forall e.
UID
-> NP
-> Sentence
-> (Stage -> Symbol)
-> Space
-> UnitDefn
-> 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 = UID
-> NP
-> Sentence
-> (Stage -> Symbol)
-> Space
-> e
-> QDefinition 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, Concept c) => c -> e -> QDefinition e
mkQuantDef :: forall c e.
(Quantity c, MayHaveUnit c, Concept c) =>
c -> e -> QDefinition e
mkQuantDef c
c = UID
-> NP
-> Sentence
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> e
-> QDefinition e
forall e.
UID
-> NP
-> Sentence
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> e
-> QDefinition e
mkQDefSt (c
c c -> Getting UID c UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID c UID
forall c. HasUID c => Getter c UID
Getter c UID
uid) (c
c c -> Getting NP c NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP c NP
forall c. NamedIdea c => Lens' c NP
Lens' c NP
term) (c
c c -> Getting Sentence c Sentence -> Sentence
forall s a. s -> Getting a s a -> a
^. Getting Sentence c Sentence
forall c. Definition c => Lens' c Sentence
Lens' c Sentence
defn) (c -> Stage -> Symbol
forall c. HasSymbol c => c -> Stage -> Symbol
symbol c
c) (c
c c -> Getting Space c Space -> Space
forall s a. s -> Getting a s a -> a
^. Getting Space c Space
forall c. HasSpace c => Getter c Space
Getter c Space
typ) (c -> Maybe UnitDefn
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 = UID
-> NP
-> Sentence
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> e
-> QDefinition e
forall e.
UID
-> NP
-> Sentence
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> e
-> QDefinition e
mkQDefSt (c
c c -> Getting UID c UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID c UID
forall c. HasUID c => Getter c UID
Getter c UID
uid) NP
t Sentence
EmptyS (c -> Stage -> Symbol
forall c. HasSymbol c => c -> Stage -> Symbol
symbol c
c) (c
c c -> Getting Space c Space -> Space
forall s a. s -> Getting a s a -> a
^. Getting Space c Space
forall c. HasSpace c => Getter c Space
Getter c Space
typ) (c -> Maybe UnitDefn
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 = DefinedQuantityDict -> [UID] -> e -> QDefinition e
forall e. DefinedQuantityDict -> [UID] -> e -> QDefinition e
QD
  (UID
-> NP
-> Sentence
-> Maybe String
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
quantAU (c
c c -> Getting UID c UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID c UID
forall c. HasUID c => Getter c UID
Getter c UID
uid) (c
c c -> Getting NP c NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP c NP
forall c. NamedIdea c => Lens' c NP
Lens' c NP
term) Sentence
EmptyS Maybe String
forall a. Maybe a
Nothing (c -> Stage -> Symbol
forall c. HasSymbol c => c -> Stage -> Symbol
symbol c
c) (c
c c -> Getting Space c Space -> Space
forall s a. s -> Getting a s a -> a
^. Getting Space c Space
forall c. HasSpace c => Getter c Space
Getter c Space
typ) (c -> Maybe UnitDefn
forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit c
c))
  []

{-# DEPRECATED ec "`ec` is an unsafe chunk constructor that encourages `UID` double-use." #-}

-- | Factored version of 'QDefinition' functions.
mkFuncDef0 :: (IsChunk f, HasSymbol f, HasSpace f,
               IsChunk i, HasSymbol i, HasSpace i) =>
  f -> NP -> Sentence -> Maybe UnitDefn -> [i] -> e -> QDefinition e
mkFuncDef0 :: forall f i e.
(IsChunk f, HasSymbol f, HasSpace f, IsChunk 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 = DefinedQuantityDict -> [UID] -> e -> QDefinition e
forall e. DefinedQuantityDict -> [UID] -> e -> QDefinition e
QD
  (UID
-> NP
-> Sentence
-> Maybe String
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
quantAU (f
f f -> Getting UID f UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID f UID
forall c. HasUID c => Getter c UID
Getter f UID
uid) NP
n Sentence
s Maybe String
forall a. Maybe a
Nothing (f -> Stage -> Symbol
forall c. HasSymbol c => c -> Stage -> Symbol
symbol f
f) (f
f f -> Getting Space f Space -> Space
forall s a. s -> Getting a s a -> a
^. Getting Space f Space
forall c. HasSpace c => Getter c Space
Getter f Space
typ) Maybe UnitDefn
u)
  ((i -> UID) -> [i] -> [UID]
forall a b. (a -> b) -> [a] -> [b]
map (i -> Getting UID i UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID i UID
forall c. HasUID c => Getter c UID
Getter i UID
uid) [i]
is)

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

-- | Create a 'QDefinition' function with a symbol, name, term, list of inputs,
-- and a defining Expr
mkFuncDef' :: (IsChunk f, HasSymbol f, HasSpace f,
               IsChunk i, HasSymbol i, HasSpace i) =>
  f -> NP -> Sentence -> [i] -> e -> QDefinition e
mkFuncDef' :: forall f i e.
(IsChunk f, HasSymbol f, HasSpace f, IsChunk i, HasSymbol i,
 HasSpace i) =>
f -> NP -> Sentence -> [i] -> e -> QDefinition e
mkFuncDef' f
f NP
n Sentence
s = f -> NP -> Sentence -> Maybe UnitDefn -> [i] -> e -> QDefinition e
forall f i e.
(IsChunk f, HasSymbol f, HasSpace f, IsChunk i, HasSymbol i,
 HasSpace i) =>
f -> NP -> Sentence -> Maybe UnitDefn -> [i] -> e -> QDefinition e
mkFuncDef0 f
f NP
n Sentence
s Maybe UnitDefn
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 c -> Maybe UnitDefn
forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit c
f of
  Just UnitDefn
u  -> c -> NP -> Sentence -> UnitDefn -> [i] -> e -> QDefinition e
forall f i e.
(IsChunk f, HasSymbol f, HasSpace f, IsChunk i, HasSymbol i,
 HasSpace i) =>
f -> NP -> Sentence -> UnitDefn -> [i] -> e -> QDefinition e
mkFuncDef  c
f (c
f c -> Getting NP c NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP c NP
forall c. NamedIdea c => Lens' c NP
Lens' c NP
term) Sentence
EmptyS UnitDefn
u
  Maybe UnitDefn
Nothing -> c -> NP -> Sentence -> [i] -> e -> QDefinition e
forall f i e.
(IsChunk f, HasSymbol f, HasSpace f, IsChunk i, HasSymbol i,
 HasSpace i) =>
f -> NP -> Sentence -> [i] -> e -> QDefinition e
mkFuncDef' c
f (c
f c -> Getting NP c NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP c NP
forall c. NamedIdea c => Lens' c NP
Lens' c NP
term) Sentence
EmptyS

-- Useful Synonyms
-- | Commonly used type for QDefinitions containing Literals.
type ConstQDef  = QDefinition Literal
-- | Commonly used type for QDefinitions containing Exprs.
type SimpleQDef = QDefinition Expr
-- | Commonly used type for QDefinitions containing ModelExprs.
type ModelQDef  = QDefinition M.ModelExpr