{-# LANGUAGE TemplateHaskell #-}
module Language.Drasil.Chunk.Unital (
UnitalChunk(..),
makeUCWDS , uc , uc' , ucStaged, ucs , ucs', ucsWS, ucuc, ucw) where
import Control.Lens (makeLenses, view, (^.))
import Language.Drasil.Chunk.Concept (dcc, dccWDS,cw)
import Language.Drasil.Chunk.DefinedQuantity (DefinedQuantityDict, dqd, dqd', tempdqdWr')
import Language.Drasil.Chunk.Unitary (Unitary(..))
import Language.Drasil.Symbol
import Language.Drasil.Classes (NamedIdea(term), Idea(getA), Express(express),
Definition(defn), ConceptDomain(cdom), Concept, IsUnit, Quantity)
import Language.Drasil.Chunk.UnitDefn (MayHaveUnit(getUnit), TempHasUnit(findUnit), UnitDefn, unitWrapper)
import Language.Drasil.Expr.Class (sy)
import Language.Drasil.NounPhrase.Core (NP)
import Language.Drasil.Space (Space(..), HasSpace(..))
import Language.Drasil.Sentence (Sentence)
import Language.Drasil.Stages (Stage)
import Language.Drasil.UID (HasUID(..))
data UnitalChunk = UC { UnitalChunk -> DefinedQuantityDict
_defq' :: DefinedQuantityDict
, UnitalChunk -> UnitDefn
_uni :: UnitDefn
}
makeLenses ''UnitalChunk
instance HasUID UnitalChunk where uid :: (UID -> f UID) -> UnitalChunk -> f UnitalChunk
uid = (DefinedQuantityDict -> f DefinedQuantityDict)
-> UnitalChunk -> f UnitalChunk
Lens' UnitalChunk DefinedQuantityDict
defq' ((DefinedQuantityDict -> f DefinedQuantityDict)
-> UnitalChunk -> f UnitalChunk)
-> ((UID -> f UID) -> DefinedQuantityDict -> f DefinedQuantityDict)
-> (UID -> f UID)
-> UnitalChunk
-> f UnitalChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UID -> f UID) -> DefinedQuantityDict -> f DefinedQuantityDict
forall c. HasUID c => Lens' c UID
uid
instance NamedIdea UnitalChunk where term :: (NP -> f NP) -> UnitalChunk -> f UnitalChunk
term = (DefinedQuantityDict -> f DefinedQuantityDict)
-> UnitalChunk -> f UnitalChunk
Lens' UnitalChunk DefinedQuantityDict
defq' ((DefinedQuantityDict -> f DefinedQuantityDict)
-> UnitalChunk -> f UnitalChunk)
-> ((NP -> f NP) -> DefinedQuantityDict -> f DefinedQuantityDict)
-> (NP -> f NP)
-> UnitalChunk
-> f UnitalChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NP -> f NP) -> DefinedQuantityDict -> f DefinedQuantityDict
forall c. NamedIdea c => Lens' c NP
term
instance Idea UnitalChunk where getA :: UnitalChunk -> Maybe String
getA (UC qc :: DefinedQuantityDict
qc _) = DefinedQuantityDict -> Maybe String
forall c. Idea c => c -> Maybe String
getA DefinedQuantityDict
qc
instance Definition UnitalChunk where defn :: (Sentence -> f Sentence) -> UnitalChunk -> f UnitalChunk
defn = (DefinedQuantityDict -> f DefinedQuantityDict)
-> UnitalChunk -> f UnitalChunk
Lens' UnitalChunk DefinedQuantityDict
defq' ((DefinedQuantityDict -> f DefinedQuantityDict)
-> UnitalChunk -> f UnitalChunk)
-> ((Sentence -> f Sentence)
-> DefinedQuantityDict -> f DefinedQuantityDict)
-> (Sentence -> f Sentence)
-> UnitalChunk
-> f UnitalChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sentence -> f Sentence)
-> DefinedQuantityDict -> f DefinedQuantityDict
forall c. Definition c => Lens' c Sentence
defn
instance ConceptDomain UnitalChunk where cdom :: UnitalChunk -> [UID]
cdom = DefinedQuantityDict -> [UID]
forall c. ConceptDomain c => c -> [UID]
cdom (DefinedQuantityDict -> [UID])
-> (UnitalChunk -> DefinedQuantityDict) -> UnitalChunk -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting DefinedQuantityDict UnitalChunk DefinedQuantityDict
-> UnitalChunk -> DefinedQuantityDict
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting DefinedQuantityDict UnitalChunk DefinedQuantityDict
Lens' UnitalChunk DefinedQuantityDict
defq'
instance HasSpace UnitalChunk where typ :: (Space -> f Space) -> UnitalChunk -> f UnitalChunk
typ = (DefinedQuantityDict -> f DefinedQuantityDict)
-> UnitalChunk -> f UnitalChunk
Lens' UnitalChunk DefinedQuantityDict
defq' ((DefinedQuantityDict -> f DefinedQuantityDict)
-> UnitalChunk -> f UnitalChunk)
-> ((Space -> f Space)
-> DefinedQuantityDict -> f DefinedQuantityDict)
-> (Space -> f Space)
-> UnitalChunk
-> f UnitalChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Space -> f Space) -> DefinedQuantityDict -> f DefinedQuantityDict
forall c. HasSpace c => Lens' c Space
typ
instance HasSymbol UnitalChunk where symbol :: UnitalChunk -> Stage -> Symbol
symbol c :: UnitalChunk
c = DefinedQuantityDict -> Stage -> Symbol
forall c. HasSymbol c => c -> Stage -> Symbol
symbol (UnitalChunk
cUnitalChunk
-> Getting DefinedQuantityDict UnitalChunk DefinedQuantityDict
-> DefinedQuantityDict
forall s a. s -> Getting a s a -> a
^.Getting DefinedQuantityDict UnitalChunk DefinedQuantityDict
Lens' UnitalChunk DefinedQuantityDict
defq')
instance Quantity UnitalChunk where
instance Unitary UnitalChunk where unit :: UnitalChunk -> UnitDefn
unit = Getting UnitDefn UnitalChunk UnitDefn -> UnitalChunk -> UnitDefn
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UnitDefn UnitalChunk UnitDefn
Lens' UnitalChunk UnitDefn
uni
instance MayHaveUnit UnitalChunk where getUnit :: UnitalChunk -> Maybe UnitDefn
getUnit = UnitDefn -> Maybe UnitDefn
forall a. a -> Maybe a
Just (UnitDefn -> Maybe UnitDefn)
-> (UnitalChunk -> UnitDefn) -> UnitalChunk -> Maybe UnitDefn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting UnitDefn UnitalChunk UnitDefn -> UnitalChunk -> UnitDefn
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UnitDefn UnitalChunk UnitDefn
Lens' UnitalChunk UnitDefn
uni
instance TempHasUnit UnitalChunk where findUnit :: UnitalChunk -> UnitDefn
findUnit = Getting UnitDefn UnitalChunk UnitDefn -> UnitalChunk -> UnitDefn
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UnitDefn UnitalChunk UnitDefn
Lens' UnitalChunk UnitDefn
uni
instance Eq UnitalChunk where c1 :: UnitalChunk
c1 == :: UnitalChunk -> UnitalChunk -> Bool
== c2 :: UnitalChunk
c2 = (UnitalChunk
c1 UnitalChunk -> Getting UID UnitalChunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID UnitalChunk UID
forall c. HasUID c => Lens' c UID
uid) UID -> UID -> Bool
forall a. Eq a => a -> a -> Bool
== (UnitalChunk
c2 UnitalChunk -> Getting UID UnitalChunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID UnitalChunk UID
forall c. HasUID c => Lens' c UID
uid)
instance Express UnitalChunk where express :: UnitalChunk -> ModelExpr
express = UnitalChunk -> ModelExpr
forall r c. (ExprC r, HasUID c, HasSymbol c) => c -> r
sy
uc :: (Concept c, IsUnit u) => c -> Symbol -> u -> UnitalChunk
uc :: c -> Symbol -> u -> UnitalChunk
uc a :: c
a b :: Symbol
b = c -> Symbol -> Space -> u -> UnitalChunk
forall c u.
(Concept c, IsUnit u) =>
c -> Symbol -> Space -> u -> UnitalChunk
ucs' c
a Symbol
b Space
Real
ucs' :: (Concept c, IsUnit u) => c -> Symbol -> Space -> u -> UnitalChunk
ucs' :: c -> Symbol -> Space -> u -> UnitalChunk
ucs' a :: c
a sym :: Symbol
sym space :: Space
space c :: u
c = DefinedQuantityDict -> UnitDefn -> UnitalChunk
UC (ConceptChunk -> Symbol -> Space -> UnitDefn -> DefinedQuantityDict
forall u.
IsUnit u =>
ConceptChunk -> Symbol -> Space -> u -> DefinedQuantityDict
dqd (c -> ConceptChunk
forall c. Concept c => c -> ConceptChunk
cw c
a) Symbol
sym Space
space UnitDefn
un) UnitDefn
un
where un :: UnitDefn
un = u -> UnitDefn
forall u. IsUnit u => u -> UnitDefn
unitWrapper u
c
uc' :: (IsUnit u) => String -> NP -> String -> Symbol -> u -> UnitalChunk
uc' :: String -> NP -> String -> Symbol -> u -> UnitalChunk
uc' i :: String
i t :: NP
t d :: String
d s :: Symbol
s u :: u
u = DefinedQuantityDict -> UnitDefn -> UnitalChunk
UC (ConceptChunk -> Symbol -> Space -> UnitDefn -> DefinedQuantityDict
forall u.
IsUnit u =>
ConceptChunk -> Symbol -> Space -> u -> DefinedQuantityDict
dqd (String -> NP -> String -> ConceptChunk
dcc String
i NP
t String
d) Symbol
s Space
Real UnitDefn
un) UnitDefn
un
where un :: UnitDefn
un = u -> UnitDefn
forall u. IsUnit u => u -> UnitDefn
unitWrapper u
u
ucStaged :: (IsUnit u) => String -> NP -> String -> (Stage -> Symbol) -> u ->
UnitalChunk
ucStaged :: String -> NP -> String -> (Stage -> Symbol) -> u -> UnitalChunk
ucStaged i :: String
i t :: NP
t d :: String
d s :: Stage -> Symbol
s u :: u
u = DefinedQuantityDict -> UnitDefn -> UnitalChunk
UC (ConceptChunk
-> (Stage -> Symbol)
-> Space
-> Maybe UnitDefn
-> DefinedQuantityDict
dqd' (String -> NP -> String -> ConceptChunk
dcc String
i NP
t String
d) Stage -> Symbol
s Space
Real (UnitDefn -> Maybe UnitDefn
forall a. a -> Maybe a
Just UnitDefn
un)) UnitDefn
un
where un :: UnitDefn
un = u -> UnitDefn
forall u. IsUnit u => u -> UnitDefn
unitWrapper u
u
ucs :: (IsUnit u) => String -> NP ->
String -> Symbol -> Space -> u -> UnitalChunk
ucs :: String -> NP -> String -> Symbol -> Space -> u -> UnitalChunk
ucs nam :: String
nam trm :: NP
trm desc :: String
desc sym :: Symbol
sym space :: Space
space un :: u
un = DefinedQuantityDict -> UnitDefn -> UnitalChunk
UC (ConceptChunk -> Symbol -> Space -> UnitDefn -> DefinedQuantityDict
forall u.
IsUnit u =>
ConceptChunk -> Symbol -> Space -> u -> DefinedQuantityDict
dqd (String -> NP -> String -> ConceptChunk
dcc String
nam NP
trm String
desc) Symbol
sym Space
space UnitDefn
uu) UnitDefn
uu
where uu :: UnitDefn
uu = u -> UnitDefn
forall u. IsUnit u => u -> UnitDefn
unitWrapper u
un
ucsWS :: (IsUnit u) => String -> NP ->
Sentence -> Symbol -> Space -> u -> UnitalChunk
ucsWS :: String -> NP -> Sentence -> Symbol -> Space -> u -> UnitalChunk
ucsWS nam :: String
nam trm :: NP
trm desc :: Sentence
desc sym :: Symbol
sym space :: Space
space un :: u
un = DefinedQuantityDict -> UnitDefn -> UnitalChunk
UC (ConceptChunk -> Symbol -> Space -> UnitDefn -> DefinedQuantityDict
forall u.
IsUnit u =>
ConceptChunk -> Symbol -> Space -> u -> DefinedQuantityDict
dqd (String -> NP -> Sentence -> ConceptChunk
dccWDS String
nam NP
trm Sentence
desc) Symbol
sym Space
space UnitDefn
uu) UnitDefn
uu
where uu :: UnitDefn
uu = u -> UnitDefn
forall u. IsUnit u => u -> UnitDefn
unitWrapper u
un
makeUCWDS :: (IsUnit u) => String -> NP -> Sentence -> Symbol ->
u -> UnitalChunk
makeUCWDS :: String -> NP -> Sentence -> Symbol -> u -> UnitalChunk
makeUCWDS nam :: String
nam trm :: NP
trm desc :: Sentence
desc sym :: Symbol
sym un :: u
un = DefinedQuantityDict -> UnitDefn -> UnitalChunk
UC (ConceptChunk -> Symbol -> Space -> UnitDefn -> DefinedQuantityDict
forall u.
IsUnit u =>
ConceptChunk -> Symbol -> Space -> u -> DefinedQuantityDict
dqd (String -> NP -> Sentence -> ConceptChunk
dccWDS String
nam NP
trm Sentence
desc) Symbol
sym Space
Real UnitDefn
uu) UnitDefn
uu
where uu :: UnitDefn
uu = u -> UnitDefn
forall u. IsUnit u => u -> UnitDefn
unitWrapper u
un
ucuc :: (Quantity c, Concept c, MayHaveUnit c) => c -> UnitDefn -> UnitalChunk
ucuc :: c -> UnitDefn -> UnitalChunk
ucuc c :: c
c = DefinedQuantityDict -> UnitDefn -> UnitalChunk
UC (c -> DefinedQuantityDict
forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> DefinedQuantityDict
tempdqdWr' c
c)
ucw :: (Unitary c, Concept c, MayHaveUnit c) => c -> UnitalChunk
ucw :: c -> UnitalChunk
ucw c :: c
c = c -> UnitDefn -> UnitalChunk
forall c.
(Quantity c, Concept c, MayHaveUnit c) =>
c -> UnitDefn -> UnitalChunk
ucuc c
c (c -> UnitDefn
forall c. Unitary c => c -> UnitDefn
unit c
c)