{-# LANGUAGE TemplateHaskell #-}
module Language.Drasil.Chunk.NamedIdea (
NamedChunk, IdeaDict,
NamedIdea(..), Idea(..),
nc, ncUID, nw, mkIdea, mkIdeaUID
) where
import Language.Drasil.UID (mkUid, UID, HasUID(..))
import Control.Lens ((^.), makeLenses)
import Language.Drasil.NounPhrase.Core ( NP )
import Control.Lens.Lens (Lens')
class HasUID c => NamedIdea c where
term :: Lens' c NP
class NamedIdea c => Idea c where
getA :: c -> Maybe String
data NamedChunk = NC {
NamedChunk -> UID
_uu :: UID,
NamedChunk -> NP
_np :: NP
}
makeLenses ''NamedChunk
instance Eq NamedChunk where c1 :: NamedChunk
c1 == :: NamedChunk -> NamedChunk -> Bool
== c2 :: NamedChunk
c2 = (NamedChunk
c1 NamedChunk -> Getting UID NamedChunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID NamedChunk UID
forall c. HasUID c => Lens' c UID
uid) UID -> UID -> Bool
forall a. Eq a => a -> a -> Bool
== (NamedChunk
c2 NamedChunk -> Getting UID NamedChunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID NamedChunk UID
forall c. HasUID c => Lens' c UID
uid)
instance HasUID NamedChunk where uid :: (UID -> f UID) -> NamedChunk -> f NamedChunk
uid = (UID -> f UID) -> NamedChunk -> f NamedChunk
Lens' NamedChunk UID
uu
instance NamedIdea NamedChunk where term :: (NP -> f NP) -> NamedChunk -> f NamedChunk
term = (NP -> f NP) -> NamedChunk -> f NamedChunk
Lens' NamedChunk NP
np
instance Idea NamedChunk where getA :: NamedChunk -> Maybe String
getA _ = Maybe String
forall a. Maybe a
Nothing
nc :: String -> NP -> NamedChunk
nc :: String -> NP -> NamedChunk
nc s :: String
s = UID -> NP -> NamedChunk
NC (String -> UID
mkUid String
s)
ncUID :: UID -> NP -> NamedChunk
ncUID :: UID -> NP -> NamedChunk
ncUID = UID -> NP -> NamedChunk
NC
data IdeaDict = IdeaDict {
IdeaDict -> NamedChunk
_nc' :: NamedChunk,
IdeaDict -> Maybe String
mabbr :: Maybe String
}
makeLenses ''IdeaDict
instance Eq IdeaDict where a :: IdeaDict
a == :: IdeaDict -> IdeaDict -> Bool
== b :: IdeaDict
b = IdeaDict
a IdeaDict -> Getting UID IdeaDict UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID IdeaDict UID
forall c. HasUID c => Lens' c UID
uid UID -> UID -> Bool
forall a. Eq a => a -> a -> Bool
== IdeaDict
b IdeaDict -> Getting UID IdeaDict UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID IdeaDict UID
forall c. HasUID c => Lens' c UID
uid
instance HasUID IdeaDict where uid :: (UID -> f UID) -> IdeaDict -> f IdeaDict
uid = (NamedChunk -> f NamedChunk) -> IdeaDict -> f IdeaDict
Lens' IdeaDict NamedChunk
nc' ((NamedChunk -> f NamedChunk) -> IdeaDict -> f IdeaDict)
-> ((UID -> f UID) -> NamedChunk -> f NamedChunk)
-> (UID -> f UID)
-> IdeaDict
-> f IdeaDict
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UID -> f UID) -> NamedChunk -> f NamedChunk
forall c. HasUID c => Lens' c UID
uid
instance NamedIdea IdeaDict where term :: (NP -> f NP) -> IdeaDict -> f IdeaDict
term = (NamedChunk -> f NamedChunk) -> IdeaDict -> f IdeaDict
Lens' IdeaDict NamedChunk
nc' ((NamedChunk -> f NamedChunk) -> IdeaDict -> f IdeaDict)
-> ((NP -> f NP) -> NamedChunk -> f NamedChunk)
-> (NP -> f NP)
-> IdeaDict
-> f IdeaDict
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NP -> f NP) -> NamedChunk -> f NamedChunk
forall c. NamedIdea c => Lens' c NP
term
instance Idea IdeaDict where getA :: IdeaDict -> Maybe String
getA = IdeaDict -> Maybe String
mabbr
mkIdea :: String -> NP -> Maybe String -> IdeaDict
mkIdea :: String -> NP -> Maybe String -> IdeaDict
mkIdea s :: String
s np' :: NP
np' = NamedChunk -> Maybe String -> IdeaDict
IdeaDict (String -> NP -> NamedChunk
nc String
s NP
np')
mkIdeaUID :: UID -> NP -> Maybe String -> IdeaDict
mkIdeaUID :: UID -> NP -> Maybe String -> IdeaDict
mkIdeaUID s :: UID
s np' :: NP
np' = NamedChunk -> Maybe String -> IdeaDict
IdeaDict (UID -> NP -> NamedChunk
ncUID UID
s NP
np')
nw :: Idea c => c -> IdeaDict
nw :: c -> IdeaDict
nw c :: c
c = NamedChunk -> Maybe String -> IdeaDict
IdeaDict (UID -> NP -> NamedChunk
NC (c
c c -> Getting UID c UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID c UID
forall c. HasUID c => Lens' c UID
uid) (c
c c -> Getting NP c NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP c NP
forall c. NamedIdea c => Lens' c NP
term)) (c -> Maybe String
forall c. Idea c => c -> Maybe String
getA c
c)