{-# 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 :: (UID -> f UID) -> UnitaryChunk -> f UnitaryChunk
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 => Lens' c UID
uid
instance NamedIdea UnitaryChunk where term :: (NP -> f NP) -> UnitaryChunk -> f UnitaryChunk
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
term
instance Idea UnitaryChunk where getA :: UnitaryChunk -> Maybe String
getA uc :: 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 :: (Space -> f Space) -> UnitaryChunk -> f UnitaryChunk
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 => Lens' c Space
typ
instance HasSymbol UnitaryChunk where symbol :: UnitaryChunk -> Stage -> Symbol
symbol u :: 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 x :: 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 u :: 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 :: String -> NP -> Symbol -> u -> Space -> UnitaryChunk
unitary i :: String
i t :: NP
t s :: Symbol
s u :: u
u space :: 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' :: String -> NP -> (Stage -> Symbol) -> u -> Space -> UnitaryChunk
unitary' i :: String
i t :: NP
t s :: Stage -> Symbol
s u :: u
u space :: 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 :: u -> UnitaryChunk
mkUnitary u :: 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 :: c -> USymb
unit_symb c :: 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