{-# LANGUAGE TemplateHaskell #-}
-- | Defines chunks to add units to a quantity. Similar to 'UnitalChunk'.
module Language.Drasil.Chunk.Unitary (
  -- * Chunk Types
  Unitary(..), UnitaryChunk,
  -- * Constructors
  mkUnitary, unitary, unitary', unit_symb) where

import Language.Drasil.Symbol
import Language.Drasil.Classes (NamedIdea(term), Idea(getA),
  IsUnit, usymb, Quantity)
import Language.Drasil.Chunk.Quantity (QuantityDict, mkQuant, mkQuant', qw)
import Language.Drasil.UnitLang (USymb)
import Language.Drasil.Chunk.UnitDefn (MayHaveUnit(getUnit), UnitDefn, unitWrapper)
import Language.Drasil.Space (Space, HasSpace(..))
import Language.Drasil.Stages (Stage)
import Language.Drasil.NounPhrase.Core (NP)
import Language.Drasil.UID (HasUID(..))

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

-- | A Unitary is a 'Quantity' that __must__ have a unit.
class (Quantity c) => Unitary c where
  unit :: c -> UnitDefn

-- | UnitaryChunks are for ideas with quantities that must have units. Contains a 'QuantityDict' and a 'UnitDefn'.
--
-- Ex. A pendulum arm is an idea associated with a symbol (l) and units (cm, m, etc.).
data UnitaryChunk = UC { UnitaryChunk -> QuantityDict
_quant :: QuantityDict
                       , UnitaryChunk -> UnitDefn
_un :: UnitDefn
                       }
makeLenses ''UnitaryChunk

-- | Finds 'UID' of the 'QuantityDict' used to make the 'UnitaryChunk'.
instance HasUID        UnitaryChunk where uid :: Lens' UnitaryChunk UID
uid = Lens' UnitaryChunk QuantityDict
quant forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. HasUID c => Lens' c UID
uid
-- | Finds term ('NP') of the 'QuantityDict' used to make the 'UnitaryChunk'.
instance NamedIdea     UnitaryChunk where term :: Lens' UnitaryChunk NP
term = Lens' UnitaryChunk QuantityDict
quant forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. NamedIdea c => Lens' c NP
term
-- | Finds the idea contained in the 'QuantityDict' used to make the 'UnitaryChunk'.
instance Idea          UnitaryChunk where getA :: UnitaryChunk -> Maybe String
getA UnitaryChunk
uc = forall c. Idea c => c -> Maybe String
getA forall a b. (a -> b) -> a -> b
$ UnitaryChunk
uc forall s a. s -> Getting a s a -> a
^. Lens' UnitaryChunk QuantityDict
quant
-- | Finds the 'Space' of the 'QuantityDict' used to make the 'UnitaryChunk'.
instance HasSpace      UnitaryChunk where typ :: Getter UnitaryChunk Space
typ = Lens' UnitaryChunk QuantityDict
quant forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. HasSpace c => Getter c Space
typ
-- | Finds the 'Symbol' of the 'QuantityDict' used to make the 'UnitaryChunk'.
instance HasSymbol     UnitaryChunk where symbol :: UnitaryChunk -> Stage -> Symbol
symbol UnitaryChunk
u = forall c. HasSymbol c => c -> Stage -> Symbol
symbol (UnitaryChunk
uforall s a. s -> Getting a s a -> a
^.Lens' UnitaryChunk QuantityDict
quant)
-- | 'UnitaryChunk's have a 'Quantity'.
instance Quantity      UnitaryChunk where
-- | Finds the unit definition of a 'UnitaryChunk'.
instance Unitary       UnitaryChunk where unit :: UnitaryChunk -> UnitDefn
unit UnitaryChunk
x = UnitaryChunk
x forall s a. s -> Getting a s a -> a
^. Lens' UnitaryChunk UnitDefn
un
-- | Finds the units of the 'QuantityDict' used to make the 'UnitaryChunk'.
instance MayHaveUnit   UnitaryChunk where getUnit :: UnitaryChunk -> Maybe UnitDefn
getUnit UnitaryChunk
u = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ UnitaryChunk
u forall s a. s -> Getting a s a -> a
^. Lens' UnitaryChunk UnitDefn
un

-- | Builds the 'QuantityDict' part from the 'UID', term ('NP'), 'Symbol', and 'Space'.
-- Assumes there's no abbreviation.
unitary :: (IsUnit u) => String -> NP -> Symbol -> u -> Space -> UnitaryChunk
unitary :: forall u.
IsUnit u =>
String -> NP -> Symbol -> u -> Space -> UnitaryChunk
unitary String
i NP
t Symbol
s u
u Space
space = QuantityDict -> UnitDefn -> UnitaryChunk
UC (String
-> NP
-> Symbol
-> Space
-> Maybe UnitDefn
-> Maybe String
-> QuantityDict
mkQuant String
i NP
t Symbol
s Space
space (forall a. a -> Maybe a
Just UnitDefn
uu) forall a. Maybe a
Nothing) UnitDefn
uu -- Unit doesn't have a unitDefn, so [] is passed in
  where uu :: UnitDefn
uu = forall u. IsUnit u => u -> UnitDefn
unitWrapper u
u

-- | Same as 'unitary' but with a 'Symbol' that changes based on the 'Stage'.
unitary' :: (IsUnit u) => String -> NP -> (Stage -> Symbol) -> u -> Space -> UnitaryChunk
unitary' :: forall u.
IsUnit u =>
String -> NP -> (Stage -> Symbol) -> u -> Space -> UnitaryChunk
unitary' String
i NP
t Stage -> Symbol
s u
u Space
space = QuantityDict -> UnitDefn -> UnitaryChunk
UC (String
-> NP
-> Maybe String
-> Space
-> (Stage -> Symbol)
-> Maybe UnitDefn
-> QuantityDict
mkQuant' String
i NP
t forall a. Maybe a
Nothing Space
space Stage -> Symbol
s (forall a. a -> Maybe a
Just UnitDefn
uu)) UnitDefn
uu -- Unit doesn't have a unitDefn, so [] is passed in
  where uu :: UnitDefn
uu = forall u. IsUnit u => u -> UnitDefn
unitWrapper u
u

-- | Makes a 'UnitaryChunk' from a quantity with a unit.
mkUnitary :: (Unitary u, MayHaveUnit u) => u -> UnitaryChunk
mkUnitary :: forall u. (Unitary u, MayHaveUnit u) => u -> UnitaryChunk
mkUnitary u
u = QuantityDict -> UnitDefn -> UnitaryChunk
UC (forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw u
u) (forall c. Unitary c => c -> UnitDefn
unit u
u)

-- | Helper for getting the unit's 'Symbol' from a chunk, 
-- as opposed to the symbols of the chunk itself.
unit_symb :: (Unitary c) => c -> USymb
unit_symb :: forall c. Unitary c => c -> USymb
unit_symb c
c = forall u. HasUnitSymbol u => u -> USymb
usymb forall a b. (a -> b) -> a -> b
$ forall c. Unitary c => c -> UnitDefn
unit c
c