{-# LANGUAGE TemplateHaskell #-}
module Language.Drasil.Chunk.Unitary (
Unitary(..), UnitaryChunk,
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)
class (Quantity c) => Unitary c where
unit :: c -> UnitDefn
data UnitaryChunk = UC { UnitaryChunk -> QuantityDict
_quant :: QuantityDict
, UnitaryChunk -> UnitDefn
_un :: UnitDefn
}
makeLenses ''UnitaryChunk
instance HasUID UnitaryChunk where uid :: Getter UnitaryChunk UID
uid = (QuantityDict -> f QuantityDict) -> UnitaryChunk -> f UnitaryChunk
Lens' UnitaryChunk QuantityDict
quant ((QuantityDict -> f QuantityDict)
-> UnitaryChunk -> f UnitaryChunk)
-> ((UID -> f UID) -> QuantityDict -> f QuantityDict)
-> (UID -> f UID)
-> UnitaryChunk
-> f UnitaryChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UID -> f UID) -> QuantityDict -> f QuantityDict
forall c. HasUID c => Getter c UID
Getter QuantityDict UID
uid
instance NamedIdea UnitaryChunk where term :: Lens' UnitaryChunk NP
term = (QuantityDict -> f QuantityDict) -> UnitaryChunk -> f UnitaryChunk
Lens' UnitaryChunk QuantityDict
quant ((QuantityDict -> f QuantityDict)
-> UnitaryChunk -> f UnitaryChunk)
-> ((NP -> f NP) -> QuantityDict -> f QuantityDict)
-> (NP -> f NP)
-> UnitaryChunk
-> f UnitaryChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NP -> f NP) -> QuantityDict -> f QuantityDict
forall c. NamedIdea c => Lens' c NP
Lens' QuantityDict NP
term
instance Idea UnitaryChunk where getA :: UnitaryChunk -> Maybe String
getA UnitaryChunk
uc = QuantityDict -> Maybe String
forall c. Idea c => c -> Maybe String
getA (QuantityDict -> Maybe String) -> QuantityDict -> Maybe String
forall a b. (a -> b) -> a -> b
$ UnitaryChunk
uc UnitaryChunk
-> Getting QuantityDict UnitaryChunk QuantityDict -> QuantityDict
forall s a. s -> Getting a s a -> a
^. Getting QuantityDict UnitaryChunk QuantityDict
Lens' UnitaryChunk QuantityDict
quant
instance HasSpace UnitaryChunk where typ :: Getter UnitaryChunk Space
typ = (QuantityDict -> f QuantityDict) -> UnitaryChunk -> f UnitaryChunk
Lens' UnitaryChunk QuantityDict
quant ((QuantityDict -> f QuantityDict)
-> UnitaryChunk -> f UnitaryChunk)
-> ((Space -> f Space) -> QuantityDict -> f QuantityDict)
-> (Space -> f Space)
-> UnitaryChunk
-> f UnitaryChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Space -> f Space) -> QuantityDict -> f QuantityDict
forall c. HasSpace c => Getter c Space
Getter QuantityDict Space
typ
instance HasSymbol UnitaryChunk where symbol :: UnitaryChunk -> Stage -> Symbol
symbol UnitaryChunk
u = QuantityDict -> Stage -> Symbol
forall c. HasSymbol c => c -> Stage -> Symbol
symbol (UnitaryChunk
uUnitaryChunk
-> Getting QuantityDict UnitaryChunk QuantityDict -> QuantityDict
forall s a. s -> Getting a s a -> a
^.Getting QuantityDict UnitaryChunk QuantityDict
Lens' UnitaryChunk QuantityDict
quant)
instance Quantity UnitaryChunk where
instance Unitary UnitaryChunk where unit :: UnitaryChunk -> UnitDefn
unit UnitaryChunk
x = UnitaryChunk
x UnitaryChunk -> Getting UnitDefn UnitaryChunk UnitDefn -> UnitDefn
forall s a. s -> Getting a s a -> a
^. Getting UnitDefn UnitaryChunk UnitDefn
Lens' UnitaryChunk UnitDefn
un
instance MayHaveUnit UnitaryChunk where getUnit :: UnitaryChunk -> Maybe UnitDefn
getUnit UnitaryChunk
u = UnitDefn -> Maybe UnitDefn
forall a. a -> Maybe a
Just (UnitDefn -> Maybe UnitDefn) -> UnitDefn -> Maybe UnitDefn
forall a b. (a -> b) -> a -> b
$ UnitaryChunk
u UnitaryChunk -> Getting UnitDefn UnitaryChunk UnitDefn -> UnitDefn
forall s a. s -> Getting a s a -> a
^. Getting UnitDefn UnitaryChunk UnitDefn
Lens' UnitaryChunk UnitDefn
un
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 (UnitDefn -> Maybe UnitDefn
forall a. a -> Maybe a
Just UnitDefn
uu) Maybe String
forall a. Maybe a
Nothing) UnitDefn
uu
where uu :: UnitDefn
uu = u -> UnitDefn
forall u. IsUnit u => u -> UnitDefn
unitWrapper u
u
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 Maybe String
forall a. Maybe a
Nothing Space
space Stage -> Symbol
s (UnitDefn -> Maybe UnitDefn
forall a. a -> Maybe a
Just UnitDefn
uu)) UnitDefn
uu
where uu :: UnitDefn
uu = u -> UnitDefn
forall u. IsUnit u => u -> UnitDefn
unitWrapper u
u
mkUnitary :: (Unitary u, MayHaveUnit u) => u -> UnitaryChunk
mkUnitary :: forall u. (Unitary u, MayHaveUnit u) => u -> UnitaryChunk
mkUnitary u
u = QuantityDict -> UnitDefn -> UnitaryChunk
UC (u -> QuantityDict
forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw u
u) (u -> UnitDefn
forall c. Unitary c => c -> UnitDefn
unit u
u)
unit_symb :: (Unitary c) => c -> USymb
unit_symb :: forall c. Unitary c => c -> USymb
unit_symb c
c = UnitDefn -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb (UnitDefn -> USymb) -> UnitDefn -> USymb
forall a b. (a -> b) -> a -> b
$ c -> UnitDefn
forall c. Unitary c => c -> UnitDefn
unit c
c