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

import Control.Lens (Getter, (^.), 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

class DefinesQuantity d where
  defLhs :: Getter d QuantityDict

-- | Finds the 'UID' of the 'IdeaDict' used to make the 'QuantityDict'.
instance HasUID        QuantityDict where uid :: Getter QuantityDict UID
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 => Getter c UID
Getter IdeaDict UID
uid
-- | Finds the term ('NP') of the 'IdeaDict' used to make the 'QuantityDict'.
instance NamedIdea     QuantityDict where term :: Lens' QuantityDict NP
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
Lens' IdeaDict NP
term
-- | Finds the idea contained in the 'IdeaDict' used to make the 'QuantityDict'.
instance Idea          QuantityDict where getA :: QuantityDict -> Maybe String
getA  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 :: Getter QuantityDict Space
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 QuantityDict
a == :: QuantityDict -> QuantityDict -> Bool
== 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 => Getter c UID
Getter QuantityDict 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 => Getter c UID
Getter QuantityDict 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 c. (HasUID c, HasSymbol c) => c -> 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 :: forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw 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 => Getter c Space
Getter q 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 String
i NP
t Symbol
s Space
sp Maybe UnitDefn
u 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' String
i NP
t 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 String
i NP
des Space
sp 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 Stage
Implementation = Symbol
sym
    f Stage
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' String
s NP
np Maybe String
a Space
t 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 Stage
Implementation = Symbol
sym
        f Stage
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 UID
i NP
des Space
sp Symbol
sym = IdeaDict
-> Space -> (Stage -> Symbol) -> Maybe UnitDefn -> QuantityDict
QD (IdeaDict -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw (IdeaDict -> IdeaDict) -> IdeaDict -> IdeaDict
forall a b. (a -> b) -> a -> b
$ UID -> NP -> IdeaDict
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 Stage
Implementation = Symbol
sym
    f Stage
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' UID
s NP
np Maybe String
a Space
t 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 Stage
Implementation = Symbol
sym
        f Stage
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 String
i NP
des Symbol
sym Space
space = IdeaDict
-> Space -> (Stage -> Symbol) -> Maybe UnitDefn -> QuantityDict
QD (IdeaDict -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw (IdeaDict -> IdeaDict) -> IdeaDict -> IdeaDict
forall a b. (a -> b) -> a -> b
$ String -> NP -> IdeaDict
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 String
i NP
des Symbol
sym Space
space UnitDefn
u = IdeaDict
-> Space -> (Stage -> Symbol) -> Maybe UnitDefn -> QuantityDict
QD (IdeaDict -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw (IdeaDict -> IdeaDict) -> IdeaDict -> IdeaDict
forall a b. (a -> b) -> a -> b
$ String -> NP -> IdeaDict
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 String
i NP
des Stage -> Symbol
sym Space
space = IdeaDict
-> Space -> (Stage -> Symbol) -> Maybe UnitDefn -> QuantityDict
QD (IdeaDict -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw (IdeaDict -> IdeaDict) -> IdeaDict -> IdeaDict
forall a b. (a -> b) -> a -> b
$ String -> NP -> IdeaDict
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 :: forall c. Idea c => c -> Symbol -> Space -> QuantityDict
codeVC c
n Symbol
s 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 Stage
Implementation = Symbol
s
    f Stage
Equational = Symbol
Empty

-- | Creates a 'QuantityDict' from an 'Idea', 'Symbol', and 'Space'.
vc'' :: Idea c => c -> Symbol -> Space -> QuantityDict
vc'' :: forall c. Idea c => c -> Symbol -> Space -> QuantityDict
vc'' c
n Symbol
sym 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