{-# 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 :: Lens' QuantityDict UID
uid = Lens' QuantityDict IdeaDict
id' forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: Lens' QuantityDict NP
term = Lens' QuantityDict IdeaDict
id' forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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  QuantityDict
qd = forall c. Idea c => c -> Maybe String
getA (QuantityDict
qd forall s a. s -> Getting a s a -> a
^. Lens' QuantityDict IdeaDict
id')
-- | Finds the 'Space' of the 'QuantityDict'.
instance HasSpace      QuantityDict where typ :: Getter QuantityDict Space
typ = Lens' QuantityDict Space
typ'
-- | Finds the 'Stage' dependent 'Symbol' of the 'QuantityDict'.
instance HasSymbol     QuantityDict where symbol :: QuantityDict -> Stage -> Symbol
symbol = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view 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 forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid) forall a. Eq a => a -> a -> Bool
== (QuantityDict
b forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid)
-- | Finds the units of the 'QuantityDict'.
instance MayHaveUnit   QuantityDict where getUnit :: QuantityDict -> Maybe UnitDefn
getUnit = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' QuantityDict (Maybe UnitDefn)
unit'
-- | Convert the symbol of the 'QuantityDict' to a 'ModelExpr'.
instance Express       QuantityDict where express :: QuantityDict -> ModelExpr
express = 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 (forall c. Idea c => c -> IdeaDict
nw q
q) (q
q forall s a. s -> Getting a s a -> a
^. forall c. HasSpace c => Getter c Space
typ) (forall c. HasSymbol c => c -> Stage -> Symbol
symbol q
q) (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 (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 (forall c. Idea c => c -> IdeaDict
nw forall a b. (a -> b) -> a -> b
$ UID -> NP -> IdeaDict
ncUID UID
i NP
des) Space
sp Stage -> Symbol
f 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 (forall c. Idea c => c -> IdeaDict
nw forall a b. (a -> b) -> a -> b
$ String -> NP -> IdeaDict
nc String
i NP
des) Space
space (forall a b. a -> b -> a
const Symbol
sym) 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 (forall c. Idea c => c -> IdeaDict
nw forall a b. (a -> b) -> a -> b
$ String -> NP -> IdeaDict
nc String
i NP
des) Space
space (forall a b. a -> b -> a
const Symbol
sym) (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 (forall c. Idea c => c -> IdeaDict
nw forall a b. (a -> b) -> a -> b
$ String -> NP -> IdeaDict
nc String
i NP
des) Space
space Stage -> Symbol
sym 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 (forall c. Idea c => c -> IdeaDict
nw c
n) Space
t Stage -> Symbol
f 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 (forall c. Idea c => c -> IdeaDict
nw c
n) Space
space (forall a b. a -> b -> a
const Symbol
sym) forall a. Maybe a
Nothing