{-# LANGUAGE TemplateHaskell #-}
-- | Contains types that define quantities from concepts. Similar to 'QuantityDict'.
module Language.Drasil.Chunk.DefinedQuantity (
  -- * Chunk Type
  DefinedQuantityDict,
  -- * Constructors
  dqd, dqdNoUnit, dqd',
  dqdQd, dqdWr, tempdqdWr') where

import Language.Drasil.Symbol (HasSymbol(symbol), Symbol)
import Language.Drasil.Classes (NamedIdea(term), Idea(getA), Concept, Express(..),
  Definition(defn), ConceptDomain(cdom), IsUnit, Quantity)
import Language.Drasil.Chunk.Concept (ConceptChunk, cw)
import Language.Drasil.Expr.Class (sy)
import Language.Drasil.Chunk.UnitDefn (UnitDefn, unitWrapper,
  MayHaveUnit(getUnit))
import Language.Drasil.Space (Space, HasSpace(..))
import Language.Drasil.Stages (Stage)
import Language.Drasil.UID (HasUID(uid))

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

-- | DefinedQuantityDict is the combination of a 'Concept' and a 'Quantity'.
-- Contains a 'ConceptChunk', a 'Symbol' dependent on 'Stage', a 'Space', and maybe a 'UnitDefn'.
-- Used when we want to assign a quantity to a concept. Includes the space, symbol, and units for that quantity.
--
-- Ex. A pendulum arm can be defined as a concept with a symbol (l), space (Real numbers), and units (cm, m, etc.).
data DefinedQuantityDict = DQD { DefinedQuantityDict -> ConceptChunk
_con :: ConceptChunk
                               , DefinedQuantityDict -> Stage -> Symbol
_symb :: Stage -> Symbol
                               , DefinedQuantityDict -> Space
_spa :: Space
                               , DefinedQuantityDict -> Maybe UnitDefn
_unit' :: Maybe UnitDefn
                               }

makeLenses ''DefinedQuantityDict

-- | Finds the 'UID' of the 'ConceptChunk' used to make the 'DefinedQuantityDict'.
instance HasUID        DefinedQuantityDict where uid :: Lens' DefinedQuantityDict UID
uid = Lens' DefinedQuantityDict ConceptChunk
con forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. HasUID c => Lens' c UID
uid
-- | Equal if 'UID's are equal.
instance Eq            DefinedQuantityDict where DefinedQuantityDict
a == :: DefinedQuantityDict -> DefinedQuantityDict -> Bool
== DefinedQuantityDict
b = (DefinedQuantityDict
a forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid) forall a. Eq a => a -> a -> Bool
== (DefinedQuantityDict
b forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid)
-- | Finds the term ('NP') of the 'ConceptChunk' used to make the 'DefinedQuantityDict'.
instance NamedIdea     DefinedQuantityDict where term :: Lens' DefinedQuantityDict NP
term = Lens' DefinedQuantityDict ConceptChunk
con forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. NamedIdea c => Lens' c NP
term
-- | Finds the idea contained in the 'ConceptChunk' used to make the 'DefinedQuantityDict'.
instance Idea          DefinedQuantityDict where getA :: DefinedQuantityDict -> Maybe String
getA = forall c. Idea c => c -> Maybe String
getA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' DefinedQuantityDict ConceptChunk
con
-- | Finds the definition contained in the 'ConceptChunk' used to make the 'DefinedQuantityDict'.
instance Definition    DefinedQuantityDict where defn :: Lens' DefinedQuantityDict Sentence
defn = Lens' DefinedQuantityDict ConceptChunk
con forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Definition c => Lens' c Sentence
defn
-- | Finds the domain of the 'ConceptChunk' used to make the 'DefinedQuantityDict'.
instance ConceptDomain DefinedQuantityDict where cdom :: DefinedQuantityDict -> [UID]
cdom = forall c. ConceptDomain c => c -> [UID]
cdom forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' DefinedQuantityDict ConceptChunk
con
-- | Finds the 'Space' of the 'DefinedQuantityDict'.
instance HasSpace      DefinedQuantityDict where typ :: Getter DefinedQuantityDict Space
typ = Lens' DefinedQuantityDict Space
spa
-- | Finds the 'Stage' -> 'Symbol' of the 'DefinedQuantityDict'.
instance HasSymbol     DefinedQuantityDict where symbol :: DefinedQuantityDict -> Stage -> Symbol
symbol = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' DefinedQuantityDict (Stage -> Symbol)
symb
-- | 'DefinedQuantityDict's have a 'Quantity'. 
instance Quantity      DefinedQuantityDict where
-- | Finds the units of the 'DefinedQuantityDict'.
instance MayHaveUnit   DefinedQuantityDict where getUnit :: DefinedQuantityDict -> Maybe UnitDefn
getUnit = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' DefinedQuantityDict (Maybe UnitDefn)
unit'
-- | Convert the symbol of the 'DefinedQuantityDict' to a 'ModelExpr'.
instance Express       DefinedQuantityDict where express :: DefinedQuantityDict -> ModelExpr
express = forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy

-- | Smart constructor that creates a DefinedQuantityDict with a 'ConceptChunk', a 'Symbol' independent of 'Stage', a 'Space', and a unit.
dqd :: (IsUnit u) => ConceptChunk -> Symbol -> Space -> u -> DefinedQuantityDict
dqd :: forall u.
IsUnit u =>
ConceptChunk -> Symbol -> Space -> u -> DefinedQuantityDict
dqd ConceptChunk
c Symbol
s Space
sp = ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
DQD ConceptChunk
c (forall a b. a -> b -> a
const Symbol
s) Space
sp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall u. IsUnit u => u -> UnitDefn
unitWrapper

-- | Similar to 'dqd', but without any units.
dqdNoUnit :: ConceptChunk -> Symbol -> Space -> DefinedQuantityDict
dqdNoUnit :: ConceptChunk -> Symbol -> Space -> DefinedQuantityDict
dqdNoUnit ConceptChunk
c Symbol
s Space
sp = ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
DQD ConceptChunk
c (forall a b. a -> b -> a
const Symbol
s) Space
sp forall a. Maybe a
Nothing

-- | Similar to 'dqd', but the 'Symbol' is now dependent on the 'Stage'.
dqd' :: ConceptChunk -> (Stage -> Symbol) -> Space -> Maybe UnitDefn -> DefinedQuantityDict
dqd' :: ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' = ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
DQD

-- | When the input already has all the necessary information. A 'projection' operator from some a type with instances of listed classes to a 'DefinedQuantityDict'.
dqdWr :: (Quantity c, Concept c, MayHaveUnit c) => c -> DefinedQuantityDict
dqdWr :: forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
dqdWr c
c = ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
DQD (forall c. Concept c => c -> ConceptChunk
cw c
c) (forall c. HasSymbol c => c -> Stage -> Symbol
symbol c
c) (c
c forall s a. s -> Getting a s a -> a
^. forall c. HasSpace c => Getter c Space
typ) (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit c
c)

-- | Temporary projection constructor, not to be used outside @drasil-lang@.
tempdqdWr' :: (Quantity c, Concept c, MayHaveUnit c) => c -> DefinedQuantityDict
tempdqdWr' :: forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
tempdqdWr' c
c = ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
DQD (forall c. Concept c => c -> ConceptChunk
cw c
c) (forall c. HasSymbol c => c -> Stage -> Symbol
symbol c
c) (c
c forall s a. s -> Getting a s a -> a
^. forall c. HasSpace c => Getter c Space
typ) (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit c
c)

-- | When we want to merge a quantity and a concept. This is suspicious.
dqdQd :: (Quantity c, MayHaveUnit c) => c -> ConceptChunk -> DefinedQuantityDict
dqdQd :: forall c.
(Quantity c, MayHaveUnit c) =>
c -> ConceptChunk -> DefinedQuantityDict
dqdQd c
c ConceptChunk
cc = ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
DQD ConceptChunk
cc (forall c. HasSymbol c => c -> Stage -> Symbol
symbol c
c) (c
c forall s a. s -> Getting a s a -> a
^. forall c. HasSpace c => Getter c Space
typ) (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit c
c)