{-# LANGUAGE TemplateHaskell #-}
-- | Defines chunks that add quantities to an idea. Similar to 'DefinedQuantityDict'.
module Language.Drasil.Chunk.Quantity (
  -- * Chunk Type
  QuantityDict,
  -- * Constructors
  codeVC, implVar, implVar', implVarUID, implVarUID', 
  mkQuant, mkQuant', qw, vc, vc'', vcSt, vcUnit) where

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

import Language.Drasil.Classes (NamedIdea(term), Idea(getA),
  Quantity, Express(..))
import Language.Drasil.Chunk.NamedIdea (IdeaDict, nw, mkIdea, nc, ncUID, mkIdeaUID)
import Language.Drasil.Chunk.UnitDefn(UnitDefn, MayHaveUnit(getUnit))
import Language.Drasil.Expr.Class (sy)
import Language.Drasil.NounPhrase.Core (NP)
import Language.Drasil.Space (Space, HasSpace(..))
import Language.Drasil.Stages (Stage(..))
import Language.Drasil.Symbol
import Language.Drasil.UID (UID, HasUID(..))

-- | QuantityDict is a combination of an 'IdeaDict' with a quantity.
-- Contains an 'IdeaDict', 'Space', a function from 
-- 'Stage' -> 'Symbol', and 'Maybe' a 'UnitDefn'.
--
-- Ex. A pendulum arm does not necessarily have to be defined as a concept before
-- we assign a space (Real numbers), a symbol (l), or units (cm, m, etc.).
data QuantityDict = QD { QuantityDict -> IdeaDict
_id' :: IdeaDict
                       , QuantityDict -> Space
_typ' :: Space
                       , QuantityDict -> Stage -> Symbol
_symb' :: Stage -> Symbol
                       , QuantityDict -> Maybe UnitDefn
_unit' :: Maybe UnitDefn
                       }
makeLenses ''QuantityDict

-- | Finds the 'UID' of the 'IdeaDict' used to make the 'QuantityDict'.
instance HasUID        QuantityDict where uid :: (UID -> f UID) -> QuantityDict -> f QuantityDict
uid = (IdeaDict -> f IdeaDict) -> QuantityDict -> f QuantityDict
Lens' QuantityDict IdeaDict
id' ((IdeaDict -> f IdeaDict) -> QuantityDict -> f QuantityDict)
-> ((UID -> f UID) -> IdeaDict -> f IdeaDict)
-> (UID -> f UID)
-> QuantityDict
-> f QuantityDict
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UID -> f UID) -> IdeaDict -> f IdeaDict
forall c. HasUID c => Lens' c UID
uid
-- | Finds the term ('NP') of the 'IdeaDict' used to make the 'QuantityDict'.
instance NamedIdea     QuantityDict where term :: (NP -> f NP) -> QuantityDict -> f QuantityDict
term = (IdeaDict -> f IdeaDict) -> QuantityDict -> f QuantityDict
Lens' QuantityDict IdeaDict
id' ((IdeaDict -> f IdeaDict) -> QuantityDict -> f QuantityDict)
-> ((NP -> f NP) -> IdeaDict -> f IdeaDict)
-> (NP -> f NP)
-> QuantityDict
-> f QuantityDict
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NP -> f NP) -> IdeaDict -> f IdeaDict
forall c. NamedIdea c => Lens' c NP
term
-- | Finds the idea contained in the 'IdeaDict' used to make the 'QuantityDict'.
instance Idea          QuantityDict where getA :: QuantityDict -> Maybe String
getA  qd :: QuantityDict
qd = IdeaDict -> Maybe String
forall c. Idea c => c -> Maybe String
getA (QuantityDict
qd QuantityDict -> Getting IdeaDict QuantityDict IdeaDict -> IdeaDict
forall s a. s -> Getting a s a -> a
^. Getting IdeaDict QuantityDict IdeaDict
Lens' QuantityDict IdeaDict
id')
-- | Finds the 'Space' of the 'QuantityDict'.
instance HasSpace      QuantityDict where typ :: (Space -> f Space) -> QuantityDict -> f QuantityDict
typ = (Space -> f Space) -> QuantityDict -> f QuantityDict
Lens' QuantityDict Space
typ'
-- | Finds the 'Stage' dependent 'Symbol' of the 'QuantityDict'.
instance HasSymbol     QuantityDict where symbol :: QuantityDict -> Stage -> Symbol
symbol = Getting (Stage -> Symbol) QuantityDict (Stage -> Symbol)
-> QuantityDict -> Stage -> Symbol
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Stage -> Symbol) QuantityDict (Stage -> Symbol)
Lens' QuantityDict (Stage -> Symbol)
symb'
-- | 'QuantityDict's have a 'Quantity'. 
instance Quantity      QuantityDict where
-- | Equal if 'UID's are equal.
instance Eq            QuantityDict where a :: QuantityDict
a == :: QuantityDict -> QuantityDict -> Bool
== b :: QuantityDict
b = (QuantityDict
a QuantityDict -> Getting UID QuantityDict UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID QuantityDict UID
forall c. HasUID c => Lens' c UID
uid) UID -> UID -> Bool
forall a. Eq a => a -> a -> Bool
== (QuantityDict
b QuantityDict -> Getting UID QuantityDict UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID QuantityDict UID
forall c. HasUID c => Lens' c UID
uid)
-- | Finds the units of the 'QuantityDict'.
instance MayHaveUnit   QuantityDict where getUnit :: QuantityDict -> Maybe UnitDefn
getUnit = Getting (Maybe UnitDefn) QuantityDict (Maybe UnitDefn)
-> QuantityDict -> Maybe UnitDefn
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe UnitDefn) QuantityDict (Maybe UnitDefn)
Lens' QuantityDict (Maybe UnitDefn)
unit'
-- | Convert the symbol of the 'QuantityDict' to a 'ModelExpr'.
instance Express       QuantityDict where express :: QuantityDict -> ModelExpr
express = QuantityDict -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy

-- | Smart constructor for a 'QuantityDict' from another 'Quantity' with units.
qw :: (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw :: q -> QuantityDict
qw q :: q
q = IdeaDict
-> Space -> (Stage -> Symbol) -> Maybe UnitDefn -> QuantityDict
QD (q -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw q
q) (q
q q -> Getting Space q Space -> Space
forall s a. s -> Getting a s a -> a
^. Getting Space q Space
forall c. HasSpace c => Lens' c Space
typ) (q -> Stage -> Symbol
forall c. HasSymbol c => c -> Stage -> Symbol
symbol q
q) (q -> Maybe UnitDefn
forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit q
q)

-- | Make a 'QuantityDict' from a 'UID', 'NP', 'Symbol', 'Space', 
-- 'Maybe' 'UnitDefn', and an abbreviation ('Maybe' 'String').
mkQuant :: String -> NP -> Symbol -> Space -> Maybe UnitDefn -> Maybe String -> 
  QuantityDict
mkQuant :: String
-> NP
-> Symbol
-> Space
-> Maybe UnitDefn
-> Maybe String
-> QuantityDict
mkQuant i :: String
i t :: NP
t s :: Symbol
s sp :: Space
sp u :: Maybe UnitDefn
u ab :: Maybe String
ab = IdeaDict
-> Space -> (Stage -> Symbol) -> Maybe UnitDefn -> QuantityDict
QD (String -> NP -> Maybe String -> IdeaDict
mkIdea String
i NP
t Maybe String
ab) Space
sp (Symbol -> Stage -> Symbol
forall a b. a -> b -> a
const Symbol
s) Maybe UnitDefn
u

-- | Similar to 'mkQuant', but the abbreviation is moved to 
-- the third argument ('Maybe' 'String'), and the 'Symbol' is now dependent on 'Stage'.
mkQuant' :: String -> NP -> Maybe String -> Space -> (Stage -> Symbol) -> 
  Maybe UnitDefn -> QuantityDict
mkQuant' :: String
-> NP
-> Maybe String
-> Space
-> (Stage -> Symbol)
-> Maybe UnitDefn
-> QuantityDict
mkQuant' i :: String
i t :: NP
t ab :: Maybe String
ab = IdeaDict
-> Space -> (Stage -> Symbol) -> Maybe UnitDefn -> QuantityDict
QD (String -> NP -> Maybe String -> IdeaDict
mkIdea String
i NP
t Maybe String
ab)

-- | Makes a variable that is implementation-only.
implVar :: String -> NP -> Space -> Symbol -> QuantityDict
implVar :: String -> NP -> Space -> Symbol -> QuantityDict
implVar i :: String
i des :: NP
des sp :: Space
sp sym :: Symbol
sym = String -> NP -> (Stage -> Symbol) -> Space -> QuantityDict
vcSt String
i NP
des Stage -> Symbol
f Space
sp
  where
    f :: Stage -> Symbol
    f :: Stage -> Symbol
f Implementation = Symbol
sym
    f Equational = Symbol
Empty

-- | Similar to 'implVar' but allows specification of abbreviation and unit.
implVar' :: String -> NP -> Maybe String -> Space -> Symbol -> 
  Maybe UnitDefn -> QuantityDict
implVar' :: String
-> NP
-> Maybe String
-> Space
-> Symbol
-> Maybe UnitDefn
-> QuantityDict
implVar' s :: String
s np :: NP
np a :: Maybe String
a t :: Space
t sym :: Symbol
sym = String
-> NP
-> Maybe String
-> Space
-> (Stage -> Symbol)
-> Maybe UnitDefn
-> QuantityDict
mkQuant' String
s NP
np Maybe String
a Space
t Stage -> Symbol
f
  where f :: Stage -> Symbol
        f :: Stage -> Symbol
f Implementation = Symbol
sym
        f Equational = Symbol
Empty

-- | Similar to 'implVar' but takes in a 'UID' rather than a 'String'.
implVarUID :: UID -> NP -> Space -> Symbol -> QuantityDict
implVarUID :: UID -> NP -> Space -> Symbol -> QuantityDict
implVarUID i :: UID
i des :: NP
des sp :: Space
sp sym :: Symbol
sym = IdeaDict
-> Space -> (Stage -> Symbol) -> Maybe UnitDefn -> QuantityDict
QD (NamedChunk -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw (NamedChunk -> IdeaDict) -> NamedChunk -> IdeaDict
forall a b. (a -> b) -> a -> b
$ UID -> NP -> NamedChunk
ncUID UID
i NP
des) Space
sp Stage -> Symbol
f Maybe UnitDefn
forall a. Maybe a
Nothing
  where
    f :: Stage -> Symbol
    f :: Stage -> Symbol
f Implementation = Symbol
sym
    f Equational = Symbol
Empty

-- | Similar to 'implVar'' but takes in a 'UID' rather than a 'String'.
implVarUID' :: UID -> NP -> Maybe String -> Space -> Symbol -> 
  Maybe UnitDefn -> QuantityDict
implVarUID' :: UID
-> NP
-> Maybe String
-> Space
-> Symbol
-> Maybe UnitDefn
-> QuantityDict
implVarUID' s :: UID
s np :: NP
np a :: Maybe String
a t :: Space
t sym :: Symbol
sym = IdeaDict
-> Space -> (Stage -> Symbol) -> Maybe UnitDefn -> QuantityDict
QD (UID -> NP -> Maybe String -> IdeaDict
mkIdeaUID UID
s NP
np Maybe String
a) Space
t Stage -> Symbol
f
  where f :: Stage -> Symbol
        f :: Stage -> Symbol
f Implementation = Symbol
sym
        f Equational = Symbol
Empty

-- | Creates a 'QuantityDict' from a 'UID', term ('NP'), 'Symbol', and 'Space'.
vc :: String -> NP -> Symbol -> Space -> QuantityDict
vc :: String -> NP -> Symbol -> Space -> QuantityDict
vc i :: String
i des :: NP
des sym :: Symbol
sym space :: Space
space = IdeaDict
-> Space -> (Stage -> Symbol) -> Maybe UnitDefn -> QuantityDict
QD (NamedChunk -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw (NamedChunk -> IdeaDict) -> NamedChunk -> IdeaDict
forall a b. (a -> b) -> a -> b
$ String -> NP -> NamedChunk
nc String
i NP
des) Space
space (Symbol -> Stage -> Symbol
forall a b. a -> b -> a
const Symbol
sym) Maybe UnitDefn
forall a. Maybe a
Nothing

-- | Creates a 'QuantityDict' from a 'UID', term ('NP'), 'Symbol', 'Space', and unit ('UnitDefn').
vcUnit :: String -> NP -> Symbol -> Space -> UnitDefn -> QuantityDict
vcUnit :: String -> NP -> Symbol -> Space -> UnitDefn -> QuantityDict
vcUnit i :: String
i des :: NP
des sym :: Symbol
sym space :: Space
space u :: UnitDefn
u = IdeaDict
-> Space -> (Stage -> Symbol) -> Maybe UnitDefn -> QuantityDict
QD (NamedChunk -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw (NamedChunk -> IdeaDict) -> NamedChunk -> IdeaDict
forall a b. (a -> b) -> a -> b
$ String -> NP -> NamedChunk
nc String
i NP
des) Space
space (Symbol -> Stage -> Symbol
forall a b. a -> b -> a
const Symbol
sym) (UnitDefn -> Maybe UnitDefn
forall a. a -> Maybe a
Just UnitDefn
u)

-- | Similar to 'vc', but creates a 'QuantityDict' from something that knows about 'Stage's.
vcSt :: String -> NP -> (Stage -> Symbol) -> Space -> QuantityDict
vcSt :: String -> NP -> (Stage -> Symbol) -> Space -> QuantityDict
vcSt i :: String
i des :: NP
des sym :: Stage -> Symbol
sym space :: Space
space = IdeaDict
-> Space -> (Stage -> Symbol) -> Maybe UnitDefn -> QuantityDict
QD (NamedChunk -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw (NamedChunk -> IdeaDict) -> NamedChunk -> IdeaDict
forall a b. (a -> b) -> a -> b
$ String -> NP -> NamedChunk
nc String
i NP
des) Space
space Stage -> Symbol
sym Maybe UnitDefn
forall a. Maybe a
Nothing

-- | Makes a 'QuantityDict' from an 'Idea', 'Symbol', and 'Space'.
-- 'Symbol' is implementation-only.
codeVC :: Idea c => c -> Symbol -> Space -> QuantityDict
codeVC :: c -> Symbol -> Space -> QuantityDict
codeVC n :: c
n s :: Symbol
s t :: Space
t = IdeaDict
-> Space -> (Stage -> Symbol) -> Maybe UnitDefn -> QuantityDict
QD (c -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw c
n) Space
t Stage -> Symbol
f Maybe UnitDefn
forall a. Maybe a
Nothing
  where
    -- TODO: This seems a bit odd. If the symbol of a "codeVC" is always "Empty" in the
    -- Equational stage, why does it give anything (e.g., 'Empty')? The same problem
    -- occurs above. Should this be reworked to never allow this 'invalid' state?
    f :: Stage -> Symbol
    f :: Stage -> Symbol
f Implementation = Symbol
s
    f Equational = Symbol
Empty

-- | Creates a 'QuantityDict' from an 'Idea', 'Symbol', and 'Space'.
vc'' :: Idea c => c -> Symbol -> Space -> QuantityDict
vc'' :: c -> Symbol -> Space -> QuantityDict
vc'' n :: c
n sym :: Symbol
sym space :: Space
space = IdeaDict
-> Space -> (Stage -> Symbol) -> Maybe UnitDefn -> QuantityDict
QD (c -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw c
n) Space
space (Symbol -> Stage -> Symbol
forall a b. a -> b -> a
const Symbol
sym) Maybe UnitDefn
forall a. Maybe a
Nothing