{-# LANGUAGE TemplateHaskell #-}
-- | For adding a relation (expression) to a concept.
module Language.Drasil.Chunk.Relation (
  -- * Chunk Type
  RelationConcept,
  -- * Constructors
  makeRC, addRelToCC) where

import Control.Lens (makeLenses, (^.), view, set)

import Language.Drasil.Chunk.Concept (ConceptChunk, dccWDS, cw)
import Language.Drasil.Classes (Express(..), Concept,
  ConceptDomain(..), Definition(..), Idea(..), NamedIdea(..))
import Language.Drasil.ModelExpr.Lang (ModelExpr)
import Language.Drasil.NounPhrase.Core (NP)
import Language.Drasil.Sentence (Sentence)
import Language.Drasil.UID (HasUID(..), mkUid)

-- | For a concept ('ConceptChunk') that also has a 'Relation' ('ModelExpr') attached.
--
-- Ex. We can describe a pendulum arm and then apply an associated equation so that we know its behaviour.
data RelationConcept = RC { RelationConcept -> ConceptChunk
_conc :: ConceptChunk
                          , RelationConcept -> ModelExpr
_rel  :: ModelExpr
                          }
makeLenses ''RelationConcept

-- | Finds the 'UID' of the 'ConceptChunk' used to make the 'RelationConcept'.
instance HasUID        RelationConcept where uid :: Lens' RelationConcept UID
uid = Lens' RelationConcept ConceptChunk
conc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. HasUID c => Lens' c UID
uid
-- | Equal if 'UID's are equal.
instance Eq            RelationConcept where RelationConcept
a == :: RelationConcept -> RelationConcept -> Bool
== RelationConcept
b = (RelationConcept
a forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid) forall a. Eq a => a -> a -> Bool
== (RelationConcept
b forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid)
-- | Finds the term ('NP') of the 'ConceptChunk' used to make the 'RelationConcept'.
instance NamedIdea     RelationConcept where term :: Lens' RelationConcept NP
term = Lens' RelationConcept ConceptChunk
conc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. NamedIdea c => Lens' c NP
term
-- | Finds the idea contained in the 'ConceptChunk' used to make the 'RelationConcept'.
instance Idea          RelationConcept where getA :: RelationConcept -> Maybe String
getA = forall c. Idea c => c -> Maybe String
getA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' RelationConcept ConceptChunk
conc
-- | Finds the definition contained in the 'ConceptChunk' used to make the 'RelationConcept'.
instance Definition    RelationConcept where defn :: Lens' RelationConcept Sentence
defn = Lens' RelationConcept ConceptChunk
conc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Definition c => Lens' c Sentence
defn
-- | Finds the domain of the 'ConceptChunk' used to make the 'RelationConcept'.
instance ConceptDomain RelationConcept where cdom :: RelationConcept -> [UID]
cdom = forall c. ConceptDomain c => c -> [UID]
cdom forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' RelationConcept ConceptChunk
conc
-- | Convert the 'RelationConcept' into the model expression language.
instance Express       RelationConcept where express :: RelationConcept -> ModelExpr
express = (forall s a. s -> Getting a s a -> a
^. Lens' RelationConcept ModelExpr
rel)

-- | Create a 'RelationConcept' from a given 'UID', term ('NP'), definition ('Sentence'), and 'Relation'.
makeRC :: Express e => String -> NP -> Sentence -> e -> RelationConcept
makeRC :: forall e.
Express e =>
String -> NP -> Sentence -> e -> RelationConcept
makeRC String
rID NP
rTerm Sentence
rDefn = ConceptChunk -> ModelExpr -> RelationConcept
RC (String -> NP -> Sentence -> ConceptChunk
dccWDS String
rID NP
rTerm Sentence
rDefn) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Express c => c -> ModelExpr
express

-- FIXME: Doesn't check UIDs. See TODOs in NamedIdea.hs
-- | Create a new 'RelationConcept' from an old 'Concept'. Takes a 'Concept', new 'UID' and relation.
addRelToCC :: (Express e, Concept c) => c -> String -> e -> RelationConcept
addRelToCC :: forall e c.
(Express e, Concept c) =>
c -> String -> e -> RelationConcept
addRelToCC c
c String
rID = ConceptChunk -> ModelExpr -> RelationConcept
RC (forall s t a b. ASetter s t a b -> b -> s -> t
set forall c. HasUID c => Lens' c UID
uid (String -> UID
mkUid String
rID) (forall c. Concept c => c -> ConceptChunk
cw c
c)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Express c => c -> ModelExpr
express