{-# Language TemplateHaskell #-}
-- | For adding an uncertainty value to quantities with constraints.
module Language.Drasil.Chunk.UncertainQuantity (
  -- * Chunk Types
  UncertQ,
  -- * Constructors
  uq, uqc,
  uqcND) where
 
import Language.Drasil.Chunk.DefinedQuantity (dqdWr)
import Language.Drasil.Chunk.Constrained (ConstrConcept(..), cuc')
import Language.Drasil.Symbol
import Language.Drasil.Classes (NamedIdea(term), Idea(getA), Express(express),
  Definition(defn), ConceptDomain(cdom), Concept, Quantity,
  IsUnit, Constrained(constraints), HasReasVal(reasVal))
import Language.Drasil.Constraint (ConstraintE)
import Language.Drasil.Chunk.UnitDefn (MayHaveUnit(getUnit))
import Language.Drasil.Expr.Lang (Expr)
import Language.Drasil.Expr.Class (sy)
import Language.Drasil.NounPhrase.Core (NP)
import Language.Drasil.Space (Space, HasSpace(..))
import Language.Drasil.Uncertainty
import Drasil.Database.UID (HasUID(..))

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

-- | UncertQs are conceptual symbolic quantities with constraints and an 'Uncertainty'.
-- Contains a 'ConstrConcept' and an 'Uncertainty'.
--
-- Ex. Measuring the length of a pendulum arm may be recorded with an uncertainty value.
data UncertQ = UQ { UncertQ -> ConstrConcept
_coco :: ConstrConcept , UncertQ -> Uncertainty
_unc'' :: Uncertainty }
makeLenses ''UncertQ
  
-- | Equal if 'UID's are equal.
instance Eq             UncertQ where UncertQ
a == :: UncertQ -> UncertQ -> Bool
== UncertQ
b = (UncertQ
a UncertQ -> Getting UID UncertQ UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID UncertQ UID
forall c. HasUID c => Getter c UID
Getter UncertQ UID
uid) UID -> UID -> Bool
forall a. Eq a => a -> a -> Bool
== (UncertQ
b UncertQ -> Getting UID UncertQ UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID UncertQ UID
forall c. HasUID c => Getter c UID
Getter UncertQ UID
uid)
-- | Finds 'UID' of the 'ConstrConcept' used to make the 'UncertQ'.
instance HasUID         UncertQ where uid :: Getter UncertQ UID
uid = (ConstrConcept -> f ConstrConcept) -> UncertQ -> f UncertQ
Lens' UncertQ ConstrConcept
coco ((ConstrConcept -> f ConstrConcept) -> UncertQ -> f UncertQ)
-> ((UID -> f UID) -> ConstrConcept -> f ConstrConcept)
-> (UID -> f UID)
-> UncertQ
-> f UncertQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UID -> f UID) -> ConstrConcept -> f ConstrConcept
forall c. HasUID c => Getter c UID
Getter ConstrConcept UID
uid
-- | Finds term ('NP') of the 'ConstrConcept' used to make the 'UncertQ'.
instance NamedIdea      UncertQ where term :: Lens' UncertQ NP
term = (ConstrConcept -> f ConstrConcept) -> UncertQ -> f UncertQ
Lens' UncertQ ConstrConcept
coco ((ConstrConcept -> f ConstrConcept) -> UncertQ -> f UncertQ)
-> ((NP -> f NP) -> ConstrConcept -> f ConstrConcept)
-> (NP -> f NP)
-> UncertQ
-> f UncertQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NP -> f NP) -> ConstrConcept -> f ConstrConcept
forall c. NamedIdea c => Lens' c NP
Lens' ConstrConcept NP
term
-- | Finds the idea contained in the 'ConstrConcept' used to make the 'UncertQ'.
instance Idea           UncertQ where getA :: UncertQ -> Maybe String
getA (UQ ConstrConcept
q Uncertainty
_) = ConstrConcept -> Maybe String
forall c. Idea c => c -> Maybe String
getA ConstrConcept
q
-- | Finds the 'Space' of the 'ConstrConcept' used to make the 'UncertQ'.
instance HasSpace       UncertQ where typ :: Getter UncertQ Space
typ = (ConstrConcept -> f ConstrConcept) -> UncertQ -> f UncertQ
Lens' UncertQ ConstrConcept
coco ((ConstrConcept -> f ConstrConcept) -> UncertQ -> f UncertQ)
-> ((Space -> f Space) -> ConstrConcept -> f ConstrConcept)
-> (Space -> f Space)
-> UncertQ
-> f UncertQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Space -> f Space) -> ConstrConcept -> f ConstrConcept
forall c. HasSpace c => Getter c Space
Getter ConstrConcept Space
typ
-- | Finds the 'Symbol' of the 'ConstrConcept' used to make the 'UncertQ'.
instance HasSymbol      UncertQ where symbol :: UncertQ -> Stage -> Symbol
symbol UncertQ
c = ConstrConcept -> Stage -> Symbol
forall c. HasSymbol c => c -> Stage -> Symbol
symbol (UncertQ
cUncertQ
-> Getting ConstrConcept UncertQ ConstrConcept -> ConstrConcept
forall s a. s -> Getting a s a -> a
^.Getting ConstrConcept UncertQ ConstrConcept
Lens' UncertQ ConstrConcept
coco)
-- | 'UncertQ's have a 'Quantity'.
instance Quantity       UncertQ where 
-- | Finds the uncertainty of an 'UncertQ'.
instance HasUncertainty UncertQ where unc :: Lens' UncertQ Uncertainty
unc = (Uncertainty -> f Uncertainty) -> UncertQ -> f UncertQ
Lens' UncertQ Uncertainty
unc''
-- | Finds the 'Constraint's of a 'ConstrConcept' used to make the 'UncertQ'.
instance Constrained    UncertQ where constraints :: Lens' UncertQ [ConstraintE]
constraints = (ConstrConcept -> f ConstrConcept) -> UncertQ -> f UncertQ
Lens' UncertQ ConstrConcept
coco ((ConstrConcept -> f ConstrConcept) -> UncertQ -> f UncertQ)
-> (([ConstraintE] -> f [ConstraintE])
    -> ConstrConcept -> f ConstrConcept)
-> ([ConstraintE] -> f [ConstraintE])
-> UncertQ
-> f UncertQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ConstraintE] -> f [ConstraintE])
-> ConstrConcept -> f ConstrConcept
forall c. Constrained c => Lens' c [ConstraintE]
Lens' ConstrConcept [ConstraintE]
constraints
-- | Finds a reasonable value for the 'ConstrConcept' used to make the 'UncertQ'.
instance HasReasVal     UncertQ where reasVal :: Lens' UncertQ (Maybe Expr)
reasVal = (ConstrConcept -> f ConstrConcept) -> UncertQ -> f UncertQ
Lens' UncertQ ConstrConcept
coco ((ConstrConcept -> f ConstrConcept) -> UncertQ -> f UncertQ)
-> ((Maybe Expr -> f (Maybe Expr))
    -> ConstrConcept -> f ConstrConcept)
-> (Maybe Expr -> f (Maybe Expr))
-> UncertQ
-> f UncertQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Expr -> f (Maybe Expr)) -> ConstrConcept -> f ConstrConcept
forall c. HasReasVal c => Lens' c (Maybe Expr)
Lens' ConstrConcept (Maybe Expr)
reasVal
-- | Finds definition of the 'ConstrConcept' used to make the 'UncertQ'.
instance Definition     UncertQ where defn :: Lens' UncertQ Sentence
defn = (ConstrConcept -> f ConstrConcept) -> UncertQ -> f UncertQ
Lens' UncertQ ConstrConcept
coco ((ConstrConcept -> f ConstrConcept) -> UncertQ -> f UncertQ)
-> ((Sentence -> f Sentence) -> ConstrConcept -> f ConstrConcept)
-> (Sentence -> f Sentence)
-> UncertQ
-> f UncertQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sentence -> f Sentence) -> ConstrConcept -> f ConstrConcept
forall c. Definition c => Lens' c Sentence
Lens' ConstrConcept Sentence
defn
-- | Finds the domain contained in the 'ConstrConcept' used to make the 'UncertQ'.
instance ConceptDomain  UncertQ where cdom :: UncertQ -> [UID]
cdom = ConstrConcept -> [UID]
forall c. ConceptDomain c => c -> [UID]
cdom (ConstrConcept -> [UID])
-> (UncertQ -> ConstrConcept) -> UncertQ -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ConstrConcept UncertQ ConstrConcept
-> UncertQ -> ConstrConcept
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ConstrConcept UncertQ ConstrConcept
Lens' UncertQ ConstrConcept
coco
-- | Finds the units of the 'ConstrConcept' used to make the 'UncertQ'.
instance MayHaveUnit    UncertQ where getUnit :: UncertQ -> Maybe UnitDefn
getUnit = ConstrConcept -> Maybe UnitDefn
forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit (ConstrConcept -> Maybe UnitDefn)
-> (UncertQ -> ConstrConcept) -> UncertQ -> Maybe UnitDefn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ConstrConcept UncertQ ConstrConcept
-> UncertQ -> ConstrConcept
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ConstrConcept UncertQ ConstrConcept
Lens' UncertQ ConstrConcept
coco
-- | Convert the symbol of the 'UncertQ' to a 'ModelExpr'.
instance Express        UncertQ where express :: UncertQ -> ModelExpr
express = UncertQ -> ModelExpr
forall c. (HasUID c, HasSymbol c) => c -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy

{-- Constructors --}
-- | Smart constructor that requires a 'Quantity', a percentage, and a typical value with an 'Uncertainty'.
uq :: (Quantity c, Constrained c, Concept c, HasReasVal c, MayHaveUnit c) =>
  c -> Uncertainty -> UncertQ
uq :: forall c.
(Quantity c, Constrained c, Concept c, HasReasVal c,
 MayHaveUnit c) =>
c -> Uncertainty -> UncertQ
uq c
q = ConstrConcept -> Uncertainty -> UncertQ
UQ (DefinedQuantityDict -> [ConstraintE] -> Maybe Expr -> ConstrConcept
ConstrConcept (c -> DefinedQuantityDict
forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr c
q) (c
q 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
q c -> Getting (Maybe Expr) c (Maybe Expr) -> Maybe Expr
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Expr) c (Maybe Expr)
forall c. HasReasVal c => Lens' c (Maybe Expr)
Lens' c (Maybe Expr)
reasVal))

--FIXME: this is kind of crazy and probably shouldn't be used!
-- | Uncertainty quantity ('uq') but with a constraint.
uqc :: (IsUnit u) => String -> NP -> String -> Symbol -> u -> Space
                -> [ConstraintE] -> Expr -> Uncertainty -> UncertQ
uqc :: forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqc String
nam NP
trm String
desc Symbol
sym u
un Space
space [ConstraintE]
cs Expr
val = ConstrConcept -> Uncertainty -> UncertQ
forall c.
(Quantity c, Constrained c, Concept c, HasReasVal c,
 MayHaveUnit c) =>
c -> Uncertainty -> UncertQ
uq (String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> ConstrConcept
forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> ConstrConcept
cuc' String
nam NP
trm String
desc Symbol
sym u
un Space
space [ConstraintE]
cs Expr
val)

-- | Uncertainty quantity constraint ('uqc') without a description.
uqcND :: (IsUnit u) => String -> NP -> Symbol -> u -> Space -> [ConstraintE]
                  -> Expr -> Uncertainty -> UncertQ
uqcND :: forall u.
IsUnit u =>
String
-> NP
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqcND String
nam NP
trm Symbol
sym u
un Space
space [ConstraintE]
cs Expr
val = ConstrConcept -> Uncertainty -> UncertQ
forall c.
(Quantity c, Constrained c, Concept c, HasReasVal c,
 MayHaveUnit c) =>
c -> Uncertainty -> UncertQ
uq (String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> ConstrConcept
forall u.
IsUnit u =>
String
-> NP
-> String
-> Symbol
-> u
-> Space
-> [ConstraintE]
-> Expr
-> ConstrConcept
cuc' String
nam NP
trm String
"" Symbol
sym u
un Space
space [ConstraintE]
cs Expr
val)