{-# 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 (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 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) QuantityDict
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))
-> ((QuantityDict -> f QuantityDict)
    -> DefinedQuantityDict -> f DefinedQuantityDict)
-> (QuantityDict -> f QuantityDict)
-> QDefinition e
-> f (QDefinition e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DefinedQuantityDict -> QuantityDict)
-> (QuantityDict -> f QuantityDict)
-> DefinedQuantityDict
-> f DefinedQuantityDict
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to DefinedQuantityDict -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw
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. (HasUID c, HasSymbol c) => c -> ModelExpr
forall r c. (ExprC r, HasUID 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. (HasUID f, HasSymbol f) => f -> [ModelExpr] -> ModelExpr
forall r f. (ExprC r, HasUID 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. (HasUID f, HasSymbol f) => f -> [Expr] -> Expr
forall r f. (ExprC r, HasUID 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 :: 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 =
  DefinedQuantityDict -> [UID] -> e -> QDefinition e
forall e. DefinedQuantityDict -> [UID] -> e -> QDefinition e
QD (ConceptChunk -> Symbol -> Space -> u -> DefinedQuantityDict
forall u.
IsUnit u =>
ConceptChunk -> Symbol -> Space -> u -> DefinedQuantityDict
dqd (IdeaDict -> Sentence -> ConceptChunk
forall c. Idea c => c -> Sentence -> ConceptChunk
cc' (String -> NP -> Maybe String -> IdeaDict
mkIdea String
nm NP
desc Maybe String
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 =
  DefinedQuantityDict -> [UID] -> e -> QDefinition e
forall e. DefinedQuantityDict -> [UID] -> e -> QDefinition e
QD (ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (IdeaDict -> Sentence -> ConceptChunk
forall c. Idea c => c -> Sentence -> ConceptChunk
cc' (String -> NP -> Maybe String -> IdeaDict
mkIdea String
nm NP
desc Maybe String
forall a. Maybe a
Nothing) Sentence
def) (Symbol -> Stage -> Symbol
forall a b. a -> b -> a
const Symbol
symb) Space
sp Maybe UnitDefn
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 =
  DefinedQuantityDict -> [UID] -> e -> QDefinition e
forall e. DefinedQuantityDict -> [UID] -> e -> QDefinition e
QD (ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (IdeaDict -> Sentence -> ConceptChunk
forall c. Idea c => c -> Sentence -> ConceptChunk
cc' (IdeaDict -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw (IdeaDict -> IdeaDict) -> IdeaDict -> IdeaDict
forall a b. (a -> b) -> a -> b
$ UID -> NP -> IdeaDict
ncUID UID
nm NP
desc) Sentence
def) Stage -> Symbol
symb Space
sp (UnitDefn -> Maybe UnitDefn
forall a. a -> Maybe a
Just (UnitDefn -> Maybe UnitDefn) -> UnitDefn -> Maybe UnitDefn
forall a b. (a -> b) -> a -> b
$ u -> UnitDefn
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 =
  DefinedQuantityDict -> [UID] -> e -> QDefinition e
forall e. DefinedQuantityDict -> [UID] -> e -> QDefinition e
QD (ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (IdeaDict -> Sentence -> ConceptChunk
forall c. Idea c => c -> Sentence -> ConceptChunk
cc' (IdeaDict -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw (IdeaDict -> IdeaDict) -> IdeaDict -> IdeaDict
forall a b. (a -> b) -> a -> b
$ UID -> NP -> IdeaDict
ncUID UID
nm NP
desc) Sentence
def) Stage -> Symbol
symb Space
sp Maybe UnitDefn
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 =
  DefinedQuantityDict -> [UID] -> e -> QDefinition e
forall e. DefinedQuantityDict -> [UID] -> e -> QDefinition e
QD (ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (IdeaDict -> Sentence -> ConceptChunk
forall c. Idea c => c -> Sentence -> ConceptChunk
cc' (String -> NP -> Maybe String -> IdeaDict
mkIdea String
nm NP
desc Maybe String
forall a. Maybe a
Nothing) Sentence
def) Stage -> Symbol
symb Space
sp Maybe UnitDefn
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 = UID
-> NP
-> Sentence
-> (Stage -> Symbol)
-> Space
-> UnitDefn
-> e
-> QDefinition 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 = 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) => c -> e -> QDefinition e
mkQuantDef :: forall c e. (Quantity c, MayHaveUnit 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) 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)

-- 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 (ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (IdeaDict -> Sentence -> ConceptChunk
forall c. Idea c => c -> Sentence -> ConceptChunk
cc' (c -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw c
c) 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)) []

-- | 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 = DefinedQuantityDict -> [UID] -> e -> QDefinition e
forall e. DefinedQuantityDict -> [UID] -> e -> QDefinition e
QD
  (ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (IdeaDict -> Sentence -> ConceptChunk
forall c. Idea c => c -> Sentence -> ConceptChunk
cc' (IdeaDict -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw (UID -> NP -> IdeaDict
ncUID (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) (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)
    -- (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 = f -> NP -> Sentence -> Maybe UnitDefn -> [i] -> e -> QDefinition e
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 (UnitDefn -> Maybe UnitDefn
forall a. a -> Maybe a
Just (UnitDefn -> Maybe UnitDefn) -> UnitDefn -> Maybe UnitDefn
forall a b. (a -> b) -> a -> b
$ u -> UnitDefn
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 = f -> NP -> Sentence -> Maybe UnitDefn -> [i] -> e -> QDefinition e
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
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 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 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.
(HasUID f, HasSymbol f, HasSpace f, HasUID 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