{-# Language TemplateHaskell #-}
-- | Contains the common idea type and respective constructors.
module Language.Drasil.Chunk.CommonIdea (
  -- * Common Idea datatype
  CI, 
  -- * Constructors
  commonIdea, commonIdeaWithDict,
  -- * Functions
  getAcc, prependAbrv) where

import Language.Drasil.Chunk.NamedIdea (IdeaDict, nc)
import Language.Drasil.Classes (NamedIdea(term), Idea(getA),
 CommonIdea(abrv), ConceptDomain(cdom))
import Language.Drasil.Misc (repUnd)
import Language.Drasil.NounPhrase.Core (NP)
import Language.Drasil.Sentence (Sentence(S))
import Language.Drasil.UID (UID, HasUID(uid))

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

-- | The common idea (with 'NounPhrase') data type. It must have a 'UID',
-- 'NounPhrase' for its term, an abbreviation ('String'), and a domain (['UID']).
-- It is similar to 'IdeaDict' and 'IdeaDict' in the sense that these are for things worth naming,
-- but this type also carries an abbreviation and related domains of knowledge.
--
-- Ex. The term "Operating System" has the abbreviation "OS" and comes from the domain of computer science.
data CI = CI { CI -> IdeaDict
_nc' :: IdeaDict, CI -> String
_ab :: String, CI -> [UID]
cdom' :: [UID]}
makeLenses ''CI

-- | Finds 'UID' of the 'IdeaDict' used to make the 'CI'.
instance HasUID        CI where uid :: Lens' CI UID
uid  = Lens' CI IdeaDict
nc' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. HasUID c => Lens' c UID
uid
-- | Finds term ('NP') of the 'IdeaDict' used to make the 'CI'.
instance NamedIdea     CI where term :: Lens' CI NP
term = Lens' CI IdeaDict
nc' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. NamedIdea c => Lens' c NP
term
-- | Finds the idea of a 'CI' (abbreviation).
instance Idea          CI where getA :: CI -> Maybe String
getA = forall a. a -> Maybe a
Just 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' CI String
ab
-- | Finds the idea of a 'CI' (abbreviation).
instance CommonIdea    CI where abrv :: CI -> String
abrv = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' CI String
ab
-- | Finds the domain of a 'CI'.
instance ConceptDomain CI where cdom :: CI -> [UID]
cdom = CI -> [UID]
cdom'
  
-- | The commonIdea smart constructor requires a chunk id ('String'), a
-- term ('NP'), an abbreviation ('String'), and a domain (['UID']).
commonIdea :: String -> NP -> String -> [UID] -> CI
commonIdea :: String -> NP -> String -> [UID] -> CI
commonIdea String
s NP
np = IdeaDict -> String -> [UID] -> CI
CI (String -> NP -> IdeaDict
nc String
s NP
np)

-- | Similar to 'commonIdea', but takes a list of 'IdeaDict' (often a domain).
commonIdeaWithDict :: String -> NP -> String -> [IdeaDict] -> CI
commonIdeaWithDict :: String -> NP -> String -> [IdeaDict] -> CI
commonIdeaWithDict String
x NP
y String
z = String -> NP -> String -> [UID] -> CI
commonIdea String
x NP
y String
z forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall s a. s -> Getting a s a -> a
^.forall c. HasUID c => Lens' c UID
uid)

-- | Get abbreviation in 'Sentence' form from a 'CI'.
getAcc :: CI -> Sentence
getAcc :: CI -> Sentence
getAcc = String -> Sentence
S forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. CommonIdea c => c -> String
abrv

-- | Prepends the abbreviation from a 'CommonIdea' to a 'String'.
prependAbrv :: CommonIdea c => c -> String -> String
prependAbrv :: forall c. CommonIdea c => c -> String -> String
prependAbrv c
c String
s = forall c. CommonIdea c => c -> String
abrv c
c forall a. [a] -> [a] -> [a]
++ (Char
':' forall a. a -> [a] -> [a]
: String -> String
repUnd String
s)