{-# Language TemplateHaskell #-}
-- | Add constraints and a reasonable value to chunks that are quantities.
module Language.Drasil.Chunk.Constrained (
  -- * Constrained Chunks
  -- ** From a Concept
  ConstrConcept(..),
  cnstrw', constrained', constrainedNRV', constrainedWithRationale, cuc', cuc'', cucNoUnit') where

import Control.Lens ((^.), makeLenses, view)

import Drasil.Database (HasUID(..), HasChunkRefs(..), UID, mkUid)

import Language.Drasil.Chunk.DefinedQuantity (DefinedQuantityDict, dqdWr, quant, quantAU, quantNoUnit)
import Language.Drasil.Symbol (HasSymbol(..), Symbol)
import Language.Drasil.Classes (NamedIdea(term), Idea(getA), Express(express),
  Definition(defn), Concept, Quantity,
  Constrained(constraints), HasReasVal(reasVal))
import Language.Drasil.Constraint (ConstraintE)
import Language.Drasil.Chunk.UnitDefn (MayHaveUnit(getUnit), UnitDefn)
import Language.Drasil.Expr.Lang (Expr(..))
import Language.Drasil.Expr.Class (sy)
import Language.Drasil.NaturalLanguage.English.NounPhrase.Core (NP)
import Language.Drasil.Sentence (Sentence(S))
import Language.Drasil.Space (Space, HasSpace(..))
import Language.Drasil.Stages (Stage)
import Language.Drasil.ReasonableValue (ReasonableValue, reasonableValue)

-- | ConstrConcepts are conceptual symbolic quantities ('DefinedQuantityDict')
-- with 'Constraint's and maybe a reasonable value.
--
-- Ex. Measuring the length of a pendulum arm could be a concept that has some reasonable value
-- (between 1 cm and 2 m) and the constraint that the length cannot be a negative value.
data ConstrConcept = ConstrConcept { ConstrConcept -> UID
_uu         :: UID
                                   , ConstrConcept -> DefinedQuantityDict
_defq       :: DefinedQuantityDict
                                   , ConstrConcept -> [ConstraintE]
_constr'    :: [ConstraintE]
                                   , ConstrConcept -> Maybe ReasonableValue
_reasV'     :: Maybe ReasonableValue
                                   }
makeLenses ''ConstrConcept

instance HasChunkRefs ConstrConcept where
  chunkRefs :: ConstrConcept -> Set UID
chunkRefs ConstrConcept
c = DefinedQuantityDict -> Set UID
forall a. HasChunkRefs a => a -> Set UID
chunkRefs (ConstrConcept
c ConstrConcept
-> Getting DefinedQuantityDict ConstrConcept DefinedQuantityDict
-> DefinedQuantityDict
forall s a. s -> Getting a s a -> a
^. Getting DefinedQuantityDict ConstrConcept DefinedQuantityDict
Lens' ConstrConcept DefinedQuantityDict
defq)
  {-# INLINABLE chunkRefs #-}

-- | Finds 'UID' of the 'DefinedQuantityDict' used to make the 'ConstrConcept'.
instance HasUID        ConstrConcept where uid :: Getter ConstrConcept UID
uid = (UID -> f UID) -> ConstrConcept -> f ConstrConcept
Lens' ConstrConcept UID
uu
-- | Finds term ('NP') of the 'DefinedQuantityDict' used to make the 'ConstrConcept'.
instance NamedIdea     ConstrConcept where term :: Lens' ConstrConcept NP
term = (DefinedQuantityDict -> f DefinedQuantityDict)
-> ConstrConcept -> f ConstrConcept
Lens' ConstrConcept DefinedQuantityDict
defq ((DefinedQuantityDict -> f DefinedQuantityDict)
 -> ConstrConcept -> f ConstrConcept)
-> ((NP -> f NP) -> DefinedQuantityDict -> f DefinedQuantityDict)
-> (NP -> f NP)
-> ConstrConcept
-> f ConstrConcept
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
-- | Finds the idea contained in the 'DefinedQuantityDict' used to make the 'ConstrConcept'.
instance Idea          ConstrConcept where getA :: ConstrConcept -> Maybe String
getA = DefinedQuantityDict -> Maybe String
forall c. Idea c => c -> Maybe String
getA (DefinedQuantityDict -> Maybe String)
-> (ConstrConcept -> DefinedQuantityDict)
-> ConstrConcept
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting DefinedQuantityDict ConstrConcept DefinedQuantityDict
-> ConstrConcept -> DefinedQuantityDict
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting DefinedQuantityDict ConstrConcept DefinedQuantityDict
Lens' ConstrConcept DefinedQuantityDict
defq
-- | Finds the 'Space' of the 'DefinedQuantityDict' used to make the 'ConstrConcept'.
instance HasSpace      ConstrConcept where typ :: Getter ConstrConcept Space
typ = (DefinedQuantityDict -> f DefinedQuantityDict)
-> ConstrConcept -> f ConstrConcept
Lens' ConstrConcept DefinedQuantityDict
defq ((DefinedQuantityDict -> f DefinedQuantityDict)
 -> ConstrConcept -> f ConstrConcept)
-> ((Space -> f Space)
    -> DefinedQuantityDict -> f DefinedQuantityDict)
-> (Space -> f Space)
-> ConstrConcept
-> f ConstrConcept
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
-- | Finds the 'Symbol' of the 'DefinedQuantityDict' used to make the 'ConstrConcept'.
instance HasSymbol     ConstrConcept where symbol :: ConstrConcept -> Stage -> Symbol
symbol ConstrConcept
c = DefinedQuantityDict -> Stage -> Symbol
forall c. HasSymbol c => c -> Stage -> Symbol
symbol (ConstrConcept
cConstrConcept
-> Getting DefinedQuantityDict ConstrConcept DefinedQuantityDict
-> DefinedQuantityDict
forall s a. s -> Getting a s a -> a
^.Getting DefinedQuantityDict ConstrConcept DefinedQuantityDict
Lens' ConstrConcept DefinedQuantityDict
defq)
-- | Finds definition of the 'DefinedQuantityDict' used to make the 'ConstrConcept'.
instance Definition    ConstrConcept where defn :: Lens' ConstrConcept Sentence
defn = (DefinedQuantityDict -> f DefinedQuantityDict)
-> ConstrConcept -> f ConstrConcept
Lens' ConstrConcept DefinedQuantityDict
defq ((DefinedQuantityDict -> f DefinedQuantityDict)
 -> ConstrConcept -> f ConstrConcept)
-> ((Sentence -> f Sentence)
    -> DefinedQuantityDict -> f DefinedQuantityDict)
-> (Sentence -> f Sentence)
-> ConstrConcept
-> f ConstrConcept
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
-- | Finds the 'Constraint's of a 'ConstrConcept'.
instance Constrained   ConstrConcept where constraints :: Lens' ConstrConcept [ConstraintE]
constraints  = ([ConstraintE] -> f [ConstraintE])
-> ConstrConcept -> f ConstrConcept
Lens' ConstrConcept [ConstraintE]
constr'
-- | Finds a reasonable value for the 'ConstrConcept'.
instance HasReasVal    ConstrConcept where reasVal :: Lens' ConstrConcept (Maybe ReasonableValue)
reasVal      = (Maybe ReasonableValue -> f (Maybe ReasonableValue))
-> ConstrConcept -> f ConstrConcept
Lens' ConstrConcept (Maybe ReasonableValue)
reasV'
-- | Equal if 'UID's are equal.
instance Eq            ConstrConcept where ConstrConcept
c1 == :: ConstrConcept -> ConstrConcept -> Bool
== ConstrConcept
c2 = (ConstrConcept
c1 ConstrConcept -> Getting UID ConstrConcept UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID ConstrConcept UID
forall c. HasUID c => Getter c UID
Getter ConstrConcept UID
uid) UID -> UID -> Bool
forall a. Eq a => a -> a -> Bool
== (ConstrConcept
c2 ConstrConcept -> Getting UID ConstrConcept UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID ConstrConcept UID
forall c. HasUID c => Getter c UID
Getter ConstrConcept UID
uid)
-- | Finds the units of the 'DefinedQuantityDict' used to make the 'ConstrConcept'.
instance MayHaveUnit   ConstrConcept where getUnit :: ConstrConcept -> Maybe UnitDefn
getUnit = DefinedQuantityDict -> Maybe UnitDefn
forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit (DefinedQuantityDict -> Maybe UnitDefn)
-> (ConstrConcept -> DefinedQuantityDict)
-> ConstrConcept
-> Maybe UnitDefn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting DefinedQuantityDict ConstrConcept DefinedQuantityDict
-> ConstrConcept -> DefinedQuantityDict
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting DefinedQuantityDict ConstrConcept DefinedQuantityDict
Lens' ConstrConcept DefinedQuantityDict
defq
-- | Convert the symbol of the 'ConstrConcept' to a 'ModelExpr'.
instance Express       ConstrConcept where express :: ConstrConcept -> ModelExpr
express = ConstrConcept -> ModelExpr
forall c. (IsChunk c, HasSymbol c) => c -> ModelExpr
forall r c. (ExprC r, IsChunk c, HasSymbol c) => c -> r
sy

-- | Creates a 'ConstrConcept' with a quantitative concept, a list of 'Constraint's and an 'Expr'.
constrained' :: (Concept c, MayHaveUnit c, Quantity c) =>
  c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' :: forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> ConstrConcept
constrained' c
q [ConstraintE]
cs Expr
rv = UID
-> DefinedQuantityDict
-> [ConstraintE]
-> Maybe ReasonableValue
-> ConstrConcept
ConstrConcept (c
q 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 -> DefinedQuantityDict
forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr c
q) [ConstraintE]
cs (Maybe ReasonableValue -> ConstrConcept)
-> Maybe ReasonableValue -> ConstrConcept
forall a b. (a -> b) -> a -> b
$ ReasonableValue -> Maybe ReasonableValue
forall a. a -> Maybe a
Just (ReasonableValue -> Maybe ReasonableValue)
-> ReasonableValue -> Maybe ReasonableValue
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe Sentence -> ReasonableValue
reasonableValue Expr
rv Maybe Sentence
forall a. Maybe a
Nothing

-- | Similar to 'constrained'', but defaults 'Maybe' 'Expr' to 'Nothing'.
constrainedNRV' :: (Concept c, MayHaveUnit c, Quantity c) =>
  c -> [ConstraintE] -> ConstrConcept
constrainedNRV' :: forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> ConstrConcept
constrainedNRV' c
q [ConstraintE]
cs = UID
-> DefinedQuantityDict
-> [ConstraintE]
-> Maybe ReasonableValue
-> ConstrConcept
ConstrConcept (c
q 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 -> DefinedQuantityDict
forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr c
q) [ConstraintE]
cs Maybe ReasonableValue
forall a. Maybe a
Nothing

-- | Similar to 'constrained'', but with a rationale 'Sentence' explaining the reasonable value.
constrainedWithRationale :: (Concept c, MayHaveUnit c, Quantity c) =>
  c -> [ConstraintE] -> Expr -> Sentence -> ConstrConcept
constrainedWithRationale :: forall c.
(Concept c, MayHaveUnit c, Quantity c) =>
c -> [ConstraintE] -> Expr -> Sentence -> ConstrConcept
constrainedWithRationale c
q [ConstraintE]
cs Expr
rv Sentence
r = UID
-> DefinedQuantityDict
-> [ConstraintE]
-> Maybe ReasonableValue
-> ConstrConcept
ConstrConcept (c
q 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 -> DefinedQuantityDict
forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr c
q) [ConstraintE]
cs (Maybe ReasonableValue -> ConstrConcept)
-> Maybe ReasonableValue -> ConstrConcept
forall a b. (a -> b) -> a -> b
$ ReasonableValue -> Maybe ReasonableValue
forall a. a -> Maybe a
Just (ReasonableValue -> Maybe ReasonableValue)
-> ReasonableValue -> Maybe ReasonableValue
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe Sentence -> ReasonableValue
reasonableValue Expr
rv (Sentence -> Maybe Sentence
forall a. a -> Maybe a
Just Sentence
r)

-- | Creates a constrained unitary chunk from a 'UID', term ('NP'), description ('String'), 'Symbol', unit, 'Space', 'Constraint's, and an 'Expr'.
cuc' :: String -> NP -> String -> Symbol -> UnitDefn
            -> Space -> [ConstraintE] -> Expr -> ConstrConcept
cuc' :: String
-> NP
-> String
-> Symbol
-> UnitDefn
-> Space
-> [ConstraintE]
-> Expr
-> ConstrConcept
cuc' String
nam NP
trm String
desc Symbol
sym UnitDefn
un Space
space [ConstraintE]
cs Expr
rv =
  UID
-> DefinedQuantityDict
-> [ConstraintE]
-> Maybe ReasonableValue
-> ConstrConcept
ConstrConcept UID
u (UID
-> NP
-> Sentence
-> Symbol
-> Space
-> UnitDefn
-> DefinedQuantityDict
quant UID
u NP
trm (String -> Sentence
S String
desc) Symbol
sym Space
space UnitDefn
un) [ConstraintE]
cs (Maybe ReasonableValue -> ConstrConcept)
-> Maybe ReasonableValue -> ConstrConcept
forall a b. (a -> b) -> a -> b
$ ReasonableValue -> Maybe ReasonableValue
forall a. a -> Maybe a
Just (ReasonableValue -> Maybe ReasonableValue)
-> ReasonableValue -> Maybe ReasonableValue
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe Sentence -> ReasonableValue
reasonableValue Expr
rv Maybe Sentence
forall a. Maybe a
Nothing
  where u :: UID
u = String -> UID
mkUid String
nam

-- | Similar to cuc', but does not include a unit.
cucNoUnit' :: String -> NP -> String -> Symbol
            -> Space -> [ConstraintE] -> Expr -> ConstrConcept
cucNoUnit' :: String
-> NP
-> String
-> Symbol
-> Space
-> [ConstraintE]
-> Expr
-> ConstrConcept
cucNoUnit' String
nam NP
trm String
desc Symbol
sym Space
space [ConstraintE]
cs Expr
rv =
  UID
-> DefinedQuantityDict
-> [ConstraintE]
-> Maybe ReasonableValue
-> ConstrConcept
ConstrConcept UID
u (UID -> NP -> Sentence -> Symbol -> Space -> DefinedQuantityDict
quantNoUnit UID
u NP
trm (String -> Sentence
S String
desc) Symbol
sym Space
space) [ConstraintE]
cs (Maybe ReasonableValue -> ConstrConcept)
-> Maybe ReasonableValue -> ConstrConcept
forall a b. (a -> b) -> a -> b
$ ReasonableValue -> Maybe ReasonableValue
forall a. a -> Maybe a
Just (ReasonableValue -> Maybe ReasonableValue)
-> ReasonableValue -> Maybe ReasonableValue
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe Sentence -> ReasonableValue
reasonableValue Expr
rv Maybe Sentence
forall a. Maybe a
Nothing
  where u :: UID
u = String -> UID
mkUid String
nam

-- | Similar to 'cuc'', but 'Symbol' is dependent on 'Stage'.
cuc'' :: String -> NP -> String -> (Stage -> Symbol) -> UnitDefn
            -> Space -> [ConstraintE] -> Expr -> ConstrConcept
cuc'' :: String
-> NP
-> String
-> (Stage -> Symbol)
-> UnitDefn
-> Space
-> [ConstraintE]
-> Expr
-> ConstrConcept
cuc'' String
nam NP
trm String
desc Stage -> Symbol
sym UnitDefn
un Space
space [ConstraintE]
cs Expr
rv =
  UID
-> DefinedQuantityDict
-> [ConstraintE]
-> Maybe ReasonableValue
-> ConstrConcept
ConstrConcept UID
u (UID
-> NP
-> Sentence
-> Maybe String
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
quantAU UID
u NP
trm (String -> Sentence
S String
desc) Maybe String
forall a. Maybe a
Nothing Stage -> Symbol
sym Space
space (UnitDefn -> Maybe UnitDefn
forall a. a -> Maybe a
Just UnitDefn
un)) [ConstraintE]
cs (Maybe ReasonableValue -> ConstrConcept)
-> Maybe ReasonableValue -> ConstrConcept
forall a b. (a -> b) -> a -> b
$ ReasonableValue -> Maybe ReasonableValue
forall a. a -> Maybe a
Just (ReasonableValue -> Maybe ReasonableValue)
-> ReasonableValue -> Maybe ReasonableValue
forall a b. (a -> b) -> a -> b
$ Expr -> Maybe Sentence -> ReasonableValue
reasonableValue Expr
rv Maybe Sentence
forall a. Maybe a
Nothing
  where u :: UID
u = String -> UID
mkUid String
nam

-- | Similar to 'cnstrw', but types must also have a 'Concept'.
cnstrw' :: (Quantity c, Concept c, Constrained c, HasReasVal c, MayHaveUnit c) => c -> ConstrConcept
cnstrw' :: forall c.
(Quantity c, Concept c, Constrained c, HasReasVal c,
 MayHaveUnit c) =>
c -> ConstrConcept
cnstrw' c
c = UID
-> DefinedQuantityDict
-> [ConstraintE]
-> Maybe ReasonableValue
-> ConstrConcept
ConstrConcept (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 -> DefinedQuantityDict
forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr c
c) (c
c c -> Getting [ConstraintE] c [ConstraintE] -> [ConstraintE]
forall s a. s -> Getting a s a -> a
^. Getting [ConstraintE] c [ConstraintE]
forall c. Constrained c => Lens' c [ConstraintE]
Lens' c [ConstraintE]
constraints) (c
c c
-> Getting (Maybe ReasonableValue) c (Maybe ReasonableValue)
-> Maybe ReasonableValue
forall s a. s -> Getting a s a -> a
^. Getting (Maybe ReasonableValue) c (Maybe ReasonableValue)
forall c. HasReasVal c => Lens' c (Maybe ReasonableValue)
Lens' c (Maybe ReasonableValue)
reasVal)