{-# Language TemplateHaskell #-}
module Language.Drasil.Chunk.Concept.Core(
ConceptChunk(ConDict)
, ConceptInstance(ConInst)
, sDom)
where
import Language.Drasil.ShortName (HasShortName(..), ShortName)
import Language.Drasil.Classes (NamedIdea(term), Idea(getA),
Definition(defn), ConceptDomain(cdom))
import Language.Drasil.Chunk.NamedIdea (IdeaDict)
import Language.Drasil.Label.Type ((+::+), defer, name, raw,
LblType(..), Referable(..), HasRefAddress(..))
import Language.Drasil.Sentence (Sentence)
import Language.Drasil.UID (UID, HasUID(..))
import Control.Lens (makeLenses, (^.), view)
sDom :: [UID] -> UID
sDom :: [UID] -> UID
sDom [UID
d] = UID
d
sDom [UID]
d = [Char] -> UID
forall a. HasCallStack => [Char] -> a
error ([Char] -> UID) -> [Char] -> UID
forall a b. (a -> b) -> a -> b
$ [Char]
"Expected ConceptDomain to have a single domain, found " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
Int -> [Char]
forall a. Show a => a -> [Char]
show ([UID] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [UID]
d) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" instead."
data ConceptChunk = ConDict { ConceptChunk -> IdeaDict
_idea :: IdeaDict
, ConceptChunk -> Sentence
_defn' :: Sentence
, ConceptChunk -> [UID]
cdom' :: [UID]
}
makeLenses ''ConceptChunk
instance Eq ConceptChunk where ConceptChunk
c1 == :: ConceptChunk -> ConceptChunk -> Bool
== ConceptChunk
c2 = (ConceptChunk
c1 ConceptChunk -> Getting UID ConceptChunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID ConceptChunk UID
forall c. HasUID c => Getter c UID
Getter ConceptChunk UID
uid) UID -> UID -> Bool
forall a. Eq a => a -> a -> Bool
== (ConceptChunk
c2 ConceptChunk -> Getting UID ConceptChunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID ConceptChunk UID
forall c. HasUID c => Getter c UID
Getter ConceptChunk UID
uid)
instance HasUID ConceptChunk where uid :: Getter ConceptChunk UID
uid = (IdeaDict -> f IdeaDict) -> ConceptChunk -> f ConceptChunk
Lens' ConceptChunk IdeaDict
idea ((IdeaDict -> f IdeaDict) -> ConceptChunk -> f ConceptChunk)
-> ((UID -> f UID) -> IdeaDict -> f IdeaDict)
-> (UID -> f UID)
-> ConceptChunk
-> f ConceptChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UID -> f UID) -> IdeaDict -> f IdeaDict
forall c. HasUID c => Getter c UID
Getter IdeaDict UID
uid
instance NamedIdea ConceptChunk where term :: Lens' ConceptChunk NP
term = (IdeaDict -> f IdeaDict) -> ConceptChunk -> f ConceptChunk
Lens' ConceptChunk IdeaDict
idea ((IdeaDict -> f IdeaDict) -> ConceptChunk -> f ConceptChunk)
-> ((NP -> f NP) -> IdeaDict -> f IdeaDict)
-> (NP -> f NP)
-> ConceptChunk
-> f ConceptChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NP -> f NP) -> IdeaDict -> f IdeaDict
forall c. NamedIdea c => Lens' c NP
Lens' IdeaDict NP
term
instance Idea ConceptChunk where getA :: ConceptChunk -> Maybe [Char]
getA = IdeaDict -> Maybe [Char]
forall c. Idea c => c -> Maybe [Char]
getA (IdeaDict -> Maybe [Char])
-> (ConceptChunk -> IdeaDict) -> ConceptChunk -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting IdeaDict ConceptChunk IdeaDict -> ConceptChunk -> IdeaDict
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting IdeaDict ConceptChunk IdeaDict
Lens' ConceptChunk IdeaDict
idea
instance Definition ConceptChunk where defn :: Lens' ConceptChunk Sentence
defn = (Sentence -> f Sentence) -> ConceptChunk -> f ConceptChunk
Lens' ConceptChunk Sentence
defn'
instance ConceptDomain ConceptChunk where cdom :: ConceptChunk -> [UID]
cdom = ConceptChunk -> [UID]
cdom'
data ConceptInstance = ConInst { ConceptInstance -> ConceptChunk
_cc :: ConceptChunk , ConceptInstance -> [Char]
ra :: String, ConceptInstance -> ShortName
shnm :: ShortName}
makeLenses ''ConceptInstance
instance Eq ConceptInstance where ConceptInstance
c1 == :: ConceptInstance -> ConceptInstance -> Bool
== ConceptInstance
c2 = (ConceptInstance
c1 ConceptInstance -> Getting UID ConceptInstance UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID ConceptInstance UID
forall c. HasUID c => Getter c UID
Getter ConceptInstance UID
uid) UID -> UID -> Bool
forall a. Eq a => a -> a -> Bool
== (ConceptInstance
c2 ConceptInstance -> Getting UID ConceptInstance UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID ConceptInstance UID
forall c. HasUID c => Getter c UID
Getter ConceptInstance UID
uid)
instance HasUID ConceptInstance where uid :: Getter ConceptInstance UID
uid = (ConceptChunk -> f ConceptChunk)
-> ConceptInstance -> f ConceptInstance
Lens' ConceptInstance ConceptChunk
cc ((ConceptChunk -> f ConceptChunk)
-> ConceptInstance -> f ConceptInstance)
-> ((UID -> f UID) -> ConceptChunk -> f ConceptChunk)
-> (UID -> f UID)
-> ConceptInstance
-> f ConceptInstance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IdeaDict -> f IdeaDict) -> ConceptChunk -> f ConceptChunk
Lens' ConceptChunk IdeaDict
idea ((IdeaDict -> f IdeaDict) -> ConceptChunk -> f ConceptChunk)
-> ((UID -> f UID) -> IdeaDict -> f IdeaDict)
-> (UID -> f UID)
-> ConceptChunk
-> f ConceptChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UID -> f UID) -> IdeaDict -> f IdeaDict
forall c. HasUID c => Getter c UID
Getter IdeaDict UID
uid
instance NamedIdea ConceptInstance where term :: Lens' ConceptInstance NP
term = (ConceptChunk -> f ConceptChunk)
-> ConceptInstance -> f ConceptInstance
Lens' ConceptInstance ConceptChunk
cc ((ConceptChunk -> f ConceptChunk)
-> ConceptInstance -> f ConceptInstance)
-> ((NP -> f NP) -> ConceptChunk -> f ConceptChunk)
-> (NP -> f NP)
-> ConceptInstance
-> f ConceptInstance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IdeaDict -> f IdeaDict) -> ConceptChunk -> f ConceptChunk
Lens' ConceptChunk IdeaDict
idea ((IdeaDict -> f IdeaDict) -> ConceptChunk -> f ConceptChunk)
-> ((NP -> f NP) -> IdeaDict -> f IdeaDict)
-> (NP -> f NP)
-> ConceptChunk
-> f ConceptChunk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NP -> f NP) -> IdeaDict -> f IdeaDict
forall c. NamedIdea c => Lens' c NP
Lens' IdeaDict NP
term
instance Idea ConceptInstance where getA :: ConceptInstance -> Maybe [Char]
getA = IdeaDict -> Maybe [Char]
forall c. Idea c => c -> Maybe [Char]
getA (IdeaDict -> Maybe [Char])
-> (ConceptInstance -> IdeaDict) -> ConceptInstance -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting IdeaDict ConceptInstance IdeaDict
-> ConceptInstance -> IdeaDict
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((ConceptChunk -> Const IdeaDict ConceptChunk)
-> ConceptInstance -> Const IdeaDict ConceptInstance
Lens' ConceptInstance ConceptChunk
cc ((ConceptChunk -> Const IdeaDict ConceptChunk)
-> ConceptInstance -> Const IdeaDict ConceptInstance)
-> Getting IdeaDict ConceptChunk IdeaDict
-> Getting IdeaDict ConceptInstance IdeaDict
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting IdeaDict ConceptChunk IdeaDict
Lens' ConceptChunk IdeaDict
idea)
instance Definition ConceptInstance where defn :: Lens' ConceptInstance Sentence
defn = (ConceptChunk -> f ConceptChunk)
-> ConceptInstance -> f ConceptInstance
Lens' ConceptInstance ConceptChunk
cc ((ConceptChunk -> f ConceptChunk)
-> ConceptInstance -> f ConceptInstance)
-> ((Sentence -> f Sentence) -> ConceptChunk -> f ConceptChunk)
-> (Sentence -> f Sentence)
-> ConceptInstance
-> f ConceptInstance
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sentence -> f Sentence) -> ConceptChunk -> f ConceptChunk
Lens' ConceptChunk Sentence
defn'
instance ConceptDomain ConceptInstance where cdom :: ConceptInstance -> [UID]
cdom = ConceptChunk -> [UID]
cdom' (ConceptChunk -> [UID])
-> (ConceptInstance -> ConceptChunk) -> ConceptInstance -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ConceptChunk ConceptInstance ConceptChunk
-> ConceptInstance -> ConceptChunk
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ConceptChunk ConceptInstance ConceptChunk
Lens' ConceptInstance ConceptChunk
cc
instance HasShortName ConceptInstance where shortname :: ConceptInstance -> ShortName
shortname = ConceptInstance -> ShortName
shnm
instance HasRefAddress ConceptInstance where getRefAdd :: ConceptInstance -> LblType
getRefAdd ConceptInstance
l = IRefProg -> [Char] -> LblType
RP (UID -> IRefProg
defer ([UID] -> UID
sDom ([UID] -> UID) -> [UID] -> UID
forall a b. (a -> b) -> a -> b
$ ConceptInstance -> [UID]
forall c. ConceptDomain c => c -> [UID]
cdom ConceptInstance
l) IRefProg -> IRefProg -> IRefProg
+::+ [Char] -> IRefProg
raw [Char]
":" IRefProg -> IRefProg -> IRefProg
+::+ IRefProg
name) (ConceptInstance -> [Char]
ra ConceptInstance
l)
instance Referable ConceptInstance where
refAdd :: ConceptInstance -> [Char]
refAdd = ConceptInstance -> [Char]
ra
renderRef :: ConceptInstance -> LblType
renderRef = ConceptInstance -> LblType
forall b. HasRefAddress b => b -> LblType
getRefAdd