{-# Language TemplateHaskell #-}
-- | For adding an uncertainty value to quantities with constraints.
module Language.Drasil.Chunk.UncertainQuantity (
  -- * Chunk Types
  UncertQ,
  -- * Constructors
  uq, uqc,
  uqcND,
  -- * Direct constructor (preserves ConstrConcept fields)
  uqDirect) where

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

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

import Language.Drasil.Chunk.DefinedQuantity (DefinedQuantityDict, dqdWr)
import Language.Drasil.Chunk.Constrained (ConstrConcept(..), cuc')
import Language.Drasil.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.Space (Space, HasSpace(..))
import Language.Drasil.Uncertainty
import Language.Drasil.ReasonableValue (ReasonableValue)

-- | UncertQs are conceptual symbolic quantities with constraints and an 'Uncertainty'.
-- Contains the same information as a 'ConstrConcept' with an added 'Uncertainty'.
--
-- Ex. Measuring the length of a pendulum arm may be recorded with an uncertainty value.
data UncertQ = UQ { UncertQ -> UID
_uu         :: UID
                  , UncertQ -> DefinedQuantityDict
_defq       :: DefinedQuantityDict
                  , UncertQ -> [ConstraintE]
_constr'    :: [ConstraintE]
                  , UncertQ -> Maybe ReasonableValue
_reasV'     :: Maybe ReasonableValue
                  , UncertQ -> Uncertainty
_unc''      :: Uncertainty
                  }
makeLenses ''UncertQ

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

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

{-- Constructors --}
-- | Smart constructor that requires a 'Quantity', a percentage, and a reasonable 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 = UID
-> DefinedQuantityDict
-> [ConstraintE]
-> Maybe ReasonableValue
-> Uncertainty
-> UncertQ
UQ (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) (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 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)

--FIXME: this is kind of crazy and probably shouldn't be used!
-- | Uncertainty quantity ('uq') but with a constraint.
uqc :: String -> NP -> String -> Symbol -> UnitDefn -> Space
                -> [ConstraintE] -> Expr -> Uncertainty -> UncertQ
uqc :: String
-> NP
-> String
-> Symbol
-> UnitDefn
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqc String
nam NP
trm String
desc Symbol
sym UnitDefn
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
-> UnitDefn
-> Space
-> [ConstraintE]
-> Expr
-> ConstrConcept
cuc' String
nam NP
trm String
desc Symbol
sym UnitDefn
un Space
space [ConstraintE]
cs Expr
val)

-- | Uncertainty quantity constraint ('uqc') without a description.
uqcND :: String -> NP -> Symbol -> UnitDefn -> Space -> [ConstraintE]
                  -> Expr -> Uncertainty -> UncertQ
uqcND :: String
-> NP
-> Symbol
-> UnitDefn
-> Space
-> [ConstraintE]
-> Expr
-> Uncertainty
-> UncertQ
uqcND String
nam NP
trm Symbol
sym UnitDefn
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
-> UnitDefn
-> Space
-> [ConstraintE]
-> Expr
-> ConstrConcept
cuc' String
nam NP
trm String
"" Symbol
sym UnitDefn
un Space
space [ConstraintE]
cs Expr
val)

-- | Directly wraps a 'ConstrConcept' with an 'Uncertainty', preserving all fields (including rationale).
uqDirect :: ConstrConcept -> Uncertainty -> UncertQ
uqDirect :: ConstrConcept -> Uncertainty -> UncertQ
uqDirect ConstrConcept
c = UID
-> DefinedQuantityDict
-> [ConstraintE]
-> Maybe ReasonableValue
-> Uncertainty
-> UncertQ
UQ (ConstrConcept
c 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) (ConstrConcept -> DefinedQuantityDict
forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr ConstrConcept
c) (ConstrConcept
c ConstrConcept
-> Getting [ConstraintE] ConstrConcept [ConstraintE]
-> [ConstraintE]
forall s a. s -> Getting a s a -> a
^. Getting [ConstraintE] ConstrConcept [ConstraintE]
forall c. Constrained c => Lens' c [ConstraintE]
Lens' ConstrConcept [ConstraintE]
constraints) (ConstrConcept
c ConstrConcept
-> Getting
     (Maybe ReasonableValue) ConstrConcept (Maybe ReasonableValue)
-> Maybe ReasonableValue
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe ReasonableValue) ConstrConcept (Maybe ReasonableValue)
forall c. HasReasVal c => Lens' c (Maybe ReasonableValue)
Lens' ConstrConcept (Maybe ReasonableValue)
reasVal)