{-# LANGUAGE TemplateHaskell, Rank2Types, ScopedTypeVariables #-}
module Theory.Drasil.GenDefn (
GenDefn,
gd, gdNoRefs,
getEqModQdsFromGd) where
import Language.Drasil
import Data.Drasil.TheoryConcepts (genDefn)
import Theory.Drasil.ModelKinds (ModelKind, getEqModQds)
import Control.Lens ((^.), view, makeLenses)
data GenDefn = GD { GenDefn -> ModelKind ModelExpr
_mk :: ModelKind ModelExpr
, GenDefn -> Maybe UnitDefn
gdUnit :: Maybe UnitDefn
, GenDefn -> Maybe Derivation
_deri :: Maybe Derivation
, GenDefn -> [DecRef]
_rf :: [DecRef]
, GenDefn -> ShortName
_sn :: ShortName
, GenDefn -> String
_ra :: String
, GenDefn -> [Sentence]
_notes :: [Sentence]
}
makeLenses ''GenDefn
instance HasUID GenDefn where uid :: Getter GenDefn UID
uid = (ModelKind ModelExpr -> f (ModelKind ModelExpr))
-> GenDefn -> f GenDefn
Lens' GenDefn (ModelKind ModelExpr)
mk ((ModelKind ModelExpr -> f (ModelKind ModelExpr))
-> GenDefn -> f GenDefn)
-> ((UID -> f UID)
-> ModelKind ModelExpr -> f (ModelKind ModelExpr))
-> (UID -> f UID)
-> GenDefn
-> f GenDefn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UID -> f UID) -> ModelKind ModelExpr -> f (ModelKind ModelExpr)
forall c. HasUID c => Getter c UID
Getter (ModelKind ModelExpr) UID
uid
instance NamedIdea GenDefn where term :: Lens' GenDefn NP
term = (ModelKind ModelExpr -> f (ModelKind ModelExpr))
-> GenDefn -> f GenDefn
Lens' GenDefn (ModelKind ModelExpr)
mk ((ModelKind ModelExpr -> f (ModelKind ModelExpr))
-> GenDefn -> f GenDefn)
-> ((NP -> f NP) -> ModelKind ModelExpr -> f (ModelKind ModelExpr))
-> (NP -> f NP)
-> GenDefn
-> f GenDefn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NP -> f NP) -> ModelKind ModelExpr -> f (ModelKind ModelExpr)
forall c. NamedIdea c => Lens' c NP
Lens' (ModelKind ModelExpr) NP
term
instance Idea GenDefn where getA :: GenDefn -> Maybe String
getA = ModelKind ModelExpr -> Maybe String
forall c. Idea c => c -> Maybe String
getA (ModelKind ModelExpr -> Maybe String)
-> (GenDefn -> ModelKind ModelExpr) -> GenDefn -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenDefn
-> Getting (ModelKind ModelExpr) GenDefn (ModelKind ModelExpr)
-> ModelKind ModelExpr
forall s a. s -> Getting a s a -> a
^. Getting (ModelKind ModelExpr) GenDefn (ModelKind ModelExpr)
Lens' GenDefn (ModelKind ModelExpr)
mk)
instance Definition GenDefn where defn :: Lens' GenDefn Sentence
defn = (ModelKind ModelExpr -> f (ModelKind ModelExpr))
-> GenDefn -> f GenDefn
Lens' GenDefn (ModelKind ModelExpr)
mk ((ModelKind ModelExpr -> f (ModelKind ModelExpr))
-> GenDefn -> f GenDefn)
-> ((Sentence -> f Sentence)
-> ModelKind ModelExpr -> f (ModelKind ModelExpr))
-> (Sentence -> f Sentence)
-> GenDefn
-> f GenDefn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sentence -> f Sentence)
-> ModelKind ModelExpr -> f (ModelKind ModelExpr)
forall c. Definition c => Lens' c Sentence
Lens' (ModelKind ModelExpr) Sentence
defn
instance ConceptDomain GenDefn where cdom :: GenDefn -> [UID]
cdom = ModelKind ModelExpr -> [UID]
forall c. ConceptDomain c => c -> [UID]
cdom (ModelKind ModelExpr -> [UID])
-> (GenDefn -> ModelKind ModelExpr) -> GenDefn -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenDefn
-> Getting (ModelKind ModelExpr) GenDefn (ModelKind ModelExpr)
-> ModelKind ModelExpr
forall s a. s -> Getting a s a -> a
^. Getting (ModelKind ModelExpr) GenDefn (ModelKind ModelExpr)
Lens' GenDefn (ModelKind ModelExpr)
mk)
instance Express GenDefn where express :: GenDefn -> ModelExpr
express = ModelKind ModelExpr -> ModelExpr
forall c. Express c => c -> ModelExpr
express (ModelKind ModelExpr -> ModelExpr)
-> (GenDefn -> ModelKind ModelExpr) -> GenDefn -> ModelExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenDefn
-> Getting (ModelKind ModelExpr) GenDefn (ModelKind ModelExpr)
-> ModelKind ModelExpr
forall s a. s -> Getting a s a -> a
^. Getting (ModelKind ModelExpr) GenDefn (ModelKind ModelExpr)
Lens' GenDefn (ModelKind ModelExpr)
mk)
instance MayHaveDerivation GenDefn where derivations :: Lens' GenDefn (Maybe Derivation)
derivations = (Maybe Derivation -> f (Maybe Derivation)) -> GenDefn -> f GenDefn
Lens' GenDefn (Maybe Derivation)
deri
instance HasDecRef GenDefn where getDecRefs :: Lens' GenDefn [DecRef]
getDecRefs = ([DecRef] -> f [DecRef]) -> GenDefn -> f GenDefn
Lens' GenDefn [DecRef]
rf
instance HasShortName GenDefn where shortname :: GenDefn -> ShortName
shortname = Getting ShortName GenDefn ShortName -> GenDefn -> ShortName
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ShortName GenDefn ShortName
Lens' GenDefn ShortName
sn
instance HasRefAddress GenDefn where getRefAdd :: GenDefn -> LblType
getRefAdd GenDefn
l = IRefProg -> String -> LblType
RP (String -> IRefProg
prepend (String -> IRefProg) -> String -> IRefProg
forall a b. (a -> b) -> a -> b
$ GenDefn -> String
forall c. CommonIdea c => c -> String
abrv GenDefn
l) (Getting String GenDefn String -> GenDefn -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String GenDefn String
Lens' GenDefn String
ra GenDefn
l)
instance HasAdditionalNotes GenDefn where getNotes :: Lens' GenDefn [Sentence]
getNotes = ([Sentence] -> f [Sentence]) -> GenDefn -> f GenDefn
Lens' GenDefn [Sentence]
notes
instance MayHaveUnit GenDefn where getUnit :: GenDefn -> Maybe UnitDefn
getUnit = GenDefn -> Maybe UnitDefn
gdUnit
instance CommonIdea GenDefn where abrv :: GenDefn -> String
abrv GenDefn
_ = CI -> String
forall c. CommonIdea c => c -> String
abrv CI
genDefn
instance Referable GenDefn where
refAdd :: GenDefn -> String
refAdd = Getting String GenDefn String -> GenDefn -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String GenDefn String
Lens' GenDefn String
ra
renderRef :: GenDefn -> LblType
renderRef GenDefn
l = IRefProg -> String -> LblType
RP (String -> IRefProg
prepend (String -> IRefProg) -> String -> IRefProg
forall a b. (a -> b) -> a -> b
$ GenDefn -> String
forall c. CommonIdea c => c -> String
abrv GenDefn
l) (GenDefn -> String
forall s. Referable s => s -> String
refAdd GenDefn
l)
gd :: IsUnit u => ModelKind ModelExpr -> Maybe u ->
Maybe Derivation -> [DecRef] -> String -> [Sentence] -> GenDefn
gd :: forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u
-> Maybe Derivation
-> [DecRef]
-> String
-> [Sentence]
-> GenDefn
gd ModelKind ModelExpr
mkind Maybe u
_ Maybe Derivation
_ [] String
_ = String -> [Sentence] -> GenDefn
forall a. HasCallStack => String -> a
error (String -> [Sentence] -> GenDefn)
-> String -> [Sentence] -> GenDefn
forall a b. (a -> b) -> a -> b
$ String
"Source field of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ModelKind ModelExpr -> String
forall a. HasUID a => a -> String
showUID ModelKind ModelExpr
mkind String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is empty"
gd ModelKind ModelExpr
mkind Maybe u
u Maybe Derivation
derivs [DecRef]
refs String
sn_ =
ModelKind ModelExpr
-> Maybe UnitDefn
-> Maybe Derivation
-> [DecRef]
-> ShortName
-> String
-> [Sentence]
-> GenDefn
GD ModelKind ModelExpr
mkind ((u -> UnitDefn) -> Maybe u -> Maybe UnitDefn
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap u -> UnitDefn
forall u. IsUnit u => u -> UnitDefn
unitWrapper Maybe u
u) Maybe Derivation
derivs [DecRef]
refs (Sentence -> ShortName
shortname' (Sentence -> ShortName) -> Sentence -> ShortName
forall a b. (a -> b) -> a -> b
$ String -> Sentence
S String
sn_) (CI -> String -> String
forall c. CommonIdea c => c -> String -> String
prependAbrv CI
genDefn String
sn_)
gdNoRefs :: IsUnit u => ModelKind ModelExpr -> Maybe u ->
Maybe Derivation -> String -> [Sentence] -> GenDefn
gdNoRefs :: forall u.
IsUnit u =>
ModelKind ModelExpr
-> Maybe u -> Maybe Derivation -> String -> [Sentence] -> GenDefn
gdNoRefs ModelKind ModelExpr
mkind Maybe u
u Maybe Derivation
derivs String
sn_ =
ModelKind ModelExpr
-> Maybe UnitDefn
-> Maybe Derivation
-> [DecRef]
-> ShortName
-> String
-> [Sentence]
-> GenDefn
GD ModelKind ModelExpr
mkind ((u -> UnitDefn) -> Maybe u -> Maybe UnitDefn
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap u -> UnitDefn
forall u. IsUnit u => u -> UnitDefn
unitWrapper Maybe u
u) Maybe Derivation
derivs [] (Sentence -> ShortName
shortname' (Sentence -> ShortName) -> Sentence -> ShortName
forall a b. (a -> b) -> a -> b
$ String -> Sentence
S String
sn_) (CI -> String -> String
forall c. CommonIdea c => c -> String -> String
prependAbrv CI
genDefn String
sn_)
getEqModQdsFromGd :: [GenDefn] -> [ModelQDef]
getEqModQdsFromGd :: [GenDefn] -> [ModelQDef]
getEqModQdsFromGd = [ModelKind ModelExpr] -> [ModelQDef]
forall e. [ModelKind e] -> [QDefinition e]
getEqModQds ([ModelKind ModelExpr] -> [ModelQDef])
-> ([GenDefn] -> [ModelKind ModelExpr]) -> [GenDefn] -> [ModelQDef]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenDefn -> ModelKind ModelExpr)
-> [GenDefn] -> [ModelKind ModelExpr]
forall a b. (a -> b) -> [a] -> [b]
map GenDefn -> ModelKind ModelExpr
_mk