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

import Language.Drasil.Chunk.NamedIdea (IdeaDict, NamedChunk, 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 'NamedChunk' 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 -> NamedChunk
_nc' :: NamedChunk, CI -> String
_ab :: String, CI -> [UID]
cdom' :: [UID]}
makeLenses ''CI

-- | Finds 'UID' of the 'NamedChunk' used to make the 'CI'.
instance HasUID        CI where uid :: (UID -> f UID) -> CI -> f CI
uid  = (NamedChunk -> f NamedChunk) -> CI -> f CI
Lens' CI NamedChunk
nc' ((NamedChunk -> f NamedChunk) -> CI -> f CI)
-> ((UID -> f UID) -> NamedChunk -> f NamedChunk)
-> (UID -> f UID)
-> CI
-> f CI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UID -> f UID) -> NamedChunk -> f NamedChunk
forall c. HasUID c => Lens' c UID
uid
-- | Finds term ('NP') of the 'NamedChunk' used to make the 'CI'.
instance NamedIdea     CI where term :: (NP -> f NP) -> CI -> f CI
term = (NamedChunk -> f NamedChunk) -> CI -> f CI
Lens' CI NamedChunk
nc' ((NamedChunk -> f NamedChunk) -> CI -> f CI)
-> ((NP -> f NP) -> NamedChunk -> f NamedChunk)
-> (NP -> f NP)
-> CI
-> f CI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NP -> f NP) -> NamedChunk -> f NamedChunk
forall c. NamedIdea c => Lens' c NP
term
-- | Finds the idea of a 'CI' (abbreviation).
instance Idea          CI where getA :: CI -> Maybe String
getA = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> (CI -> String) -> CI -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting String CI String -> CI -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String CI String
Lens' CI String
ab
-- | Finds the idea of a 'CI' (abbreviation).
instance CommonIdea    CI where abrv :: CI -> String
abrv = Getting String CI String -> CI -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String CI String
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 s :: String
s np :: NP
np = NamedChunk -> String -> [UID] -> CI
CI (String -> NP -> NamedChunk
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 x :: String
x y :: NP
y z :: String
z = String -> NP -> String -> [UID] -> CI
commonIdea String
x NP
y String
z ([UID] -> CI) -> ([IdeaDict] -> [UID]) -> [IdeaDict] -> CI
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IdeaDict -> UID) -> [IdeaDict] -> [UID]
forall a b. (a -> b) -> [a] -> [b]
map (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)

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

-- | Get abbreviation in 'String' form from a 'CI'.
getAccStr :: CI -> String
getAccStr :: CI -> String
getAccStr = CI -> String
forall c. CommonIdea c => c -> String
abrv

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