{-# 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 :: (UID -> f UID) -> RelationConcept -> f RelationConcept
uid = (ConceptChunk -> f ConceptChunk)
-> RelationConcept -> f RelationConcept
Lens' RelationConcept ConceptChunk
conc ((ConceptChunk -> f ConceptChunk)
 -> RelationConcept -> f RelationConcept)
-> ((UID -> f UID) -> ConceptChunk -> f ConceptChunk)
-> (UID -> f UID)
-> RelationConcept
-> f RelationConcept
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UID -> f UID) -> ConceptChunk -> f ConceptChunk
forall c. HasUID c => Lens' c UID
uid
-- | Equal if 'UID's are equal.
instance Eq            RelationConcept where a :: RelationConcept
a == :: RelationConcept -> RelationConcept -> Bool
== b :: RelationConcept
b = (RelationConcept
a RelationConcept -> Getting UID RelationConcept UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID RelationConcept UID
forall c. HasUID c => Lens' c UID
uid) UID -> UID -> Bool
forall a. Eq a => a -> a -> Bool
== (RelationConcept
b RelationConcept -> Getting UID RelationConcept UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID RelationConcept UID
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 :: (NP -> f NP) -> RelationConcept -> f RelationConcept
term = (ConceptChunk -> f ConceptChunk)
-> RelationConcept -> f RelationConcept
Lens' RelationConcept ConceptChunk
conc ((ConceptChunk -> f ConceptChunk)
 -> RelationConcept -> f RelationConcept)
-> ((NP -> f NP) -> ConceptChunk -> f ConceptChunk)
-> (NP -> f NP)
-> RelationConcept
-> f RelationConcept
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NP -> f NP) -> ConceptChunk -> f ConceptChunk
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 = ConceptChunk -> Maybe String
forall c. Idea c => c -> Maybe String
getA (ConceptChunk -> Maybe String)
-> (RelationConcept -> ConceptChunk)
-> RelationConcept
-> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ConceptChunk RelationConcept ConceptChunk
-> RelationConcept -> ConceptChunk
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ConceptChunk RelationConcept ConceptChunk
Lens' RelationConcept ConceptChunk
conc
-- | Finds the definition contained in the 'ConceptChunk' used to make the 'RelationConcept'.
instance Definition    RelationConcept where defn :: (Sentence -> f Sentence) -> RelationConcept -> f RelationConcept
defn = (ConceptChunk -> f ConceptChunk)
-> RelationConcept -> f RelationConcept
Lens' RelationConcept ConceptChunk
conc ((ConceptChunk -> f ConceptChunk)
 -> RelationConcept -> f RelationConcept)
-> ((Sentence -> f Sentence) -> ConceptChunk -> f ConceptChunk)
-> (Sentence -> f Sentence)
-> RelationConcept
-> f RelationConcept
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sentence -> f Sentence) -> ConceptChunk -> f ConceptChunk
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 = ConceptChunk -> [UID]
forall c. ConceptDomain c => c -> [UID]
cdom (ConceptChunk -> [UID])
-> (RelationConcept -> ConceptChunk) -> RelationConcept -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ConceptChunk RelationConcept ConceptChunk
-> RelationConcept -> ConceptChunk
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ConceptChunk RelationConcept ConceptChunk
Lens' RelationConcept ConceptChunk
conc
-- | Convert the 'RelationConcept' into the model expression language.
instance Express       RelationConcept where express :: RelationConcept -> ModelExpr
express = (RelationConcept
-> Getting ModelExpr RelationConcept ModelExpr -> ModelExpr
forall s a. s -> Getting a s a -> a
^. Getting ModelExpr RelationConcept ModelExpr
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 :: String -> NP -> Sentence -> e -> RelationConcept
makeRC rID :: String
rID rTerm :: NP
rTerm rDefn :: Sentence
rDefn = ConceptChunk -> ModelExpr -> RelationConcept
RC (String -> NP -> Sentence -> ConceptChunk
dccWDS String
rID NP
rTerm Sentence
rDefn) (ModelExpr -> RelationConcept)
-> (e -> ModelExpr) -> e -> RelationConcept
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ModelExpr
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 :: c -> String -> e -> RelationConcept
addRelToCC c :: c
c rID :: String
rID = ConceptChunk -> ModelExpr -> RelationConcept
RC (ASetter ConceptChunk ConceptChunk UID UID
-> UID -> ConceptChunk -> ConceptChunk
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter ConceptChunk ConceptChunk UID UID
forall c. HasUID c => Lens' c UID
uid (String -> UID
mkUid String
rID) (c -> ConceptChunk
forall c. Concept c => c -> ConceptChunk
cw c
c)) (ModelExpr -> RelationConcept)
-> (e -> ModelExpr) -> e -> RelationConcept
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ModelExpr
forall c. Express c => c -> ModelExpr
express