-- | Contains functions to create the concept related chunk types found in "Language.Drasil.Chunk.Concept.Core".
module Language.Drasil.Chunk.Concept (
  -- * Concept Chunks
  -- ** From an idea ('IdeaDict')
  ConceptChunk, dcc, dccA, dccAWDS, dccWDS, cc, cc', ccs, cw,
  -- ** From a 'ConceptChunk'
  ConceptInstance, cic
  ) where

import Language.Drasil.Classes (Idea, Definition(defn), ConceptDomain(cdom), Concept)
import Language.Drasil.Chunk.Concept.Core (ConceptChunk(ConDict), ConceptInstance(ConInst))
import Language.Drasil.Sentence (Sentence(S))
import Language.Drasil.Chunk.NamedIdea(mkIdea,nw, nc)
import Language.Drasil.NounPhrase (NP, pn)
import Language.Drasil.ShortName (shortname')
import Drasil.Database.UID (HasUID(uid), nsUid)

import Control.Lens ((^.))

--FIXME: Temporary ConceptDomain tag hacking to not break everything. 

-- | Smart constructor for creating a concept chunks with an abbreviation
-- Takes a UID (String), a term (NounPhrase), a definition (String), and an abbreviation (Maybe String).
dccA :: String -> NP -> String -> Maybe String -> ConceptChunk
dccA :: String -> NP -> String -> Maybe String -> ConceptChunk
dccA String
i NP
ter String
des Maybe String
a = IdeaDict -> Sentence -> [UID] -> ConceptChunk
ConDict (String -> NP -> Maybe String -> IdeaDict
mkIdea String
i NP
ter Maybe String
a) (String -> Sentence
S String
des) []

dccAWDS :: String -> NP -> Sentence -> Maybe String -> ConceptChunk
dccAWDS :: String -> NP -> Sentence -> Maybe String -> ConceptChunk
dccAWDS String
i NP
t Sentence
d Maybe String
a = IdeaDict -> Sentence -> [UID] -> ConceptChunk
ConDict (String -> NP -> Maybe String -> IdeaDict
mkIdea String
i NP
t Maybe String
a) Sentence
d []

dcc :: String -> NP -> String -> ConceptChunk 
-- | Smart constructor for creating concept chunks given a 'UID', 
-- 'NounPhrase' ('NP') and definition (as a 'String').
dcc :: String -> NP -> String -> ConceptChunk
dcc String
i NP
ter String
des = String -> NP -> String -> Maybe String -> ConceptChunk
dccA String
i NP
ter String
des Maybe String
forall a. Maybe a
Nothing
-- ^ Concept domain tagging is not yet implemented in this constructor.

-- | Similar to 'dcc', except the definition takes a 'Sentence'.
dccWDS :: String -> NP -> Sentence -> ConceptChunk
dccWDS :: String -> NP -> Sentence -> ConceptChunk
dccWDS String
i NP
t Sentence
d = String -> NP -> Sentence -> Maybe String -> ConceptChunk
dccAWDS String
i NP
t Sentence
d Maybe String
forall a. Maybe a
Nothing

-- | Constructor for projecting an idea into a 'ConceptChunk'. Takes the definition of the 
-- 'ConceptChunk' as a 'String'. Does not allow concept domain tagging.
cc :: Idea c => c -> String -> ConceptChunk
cc :: forall c. Idea c => c -> String -> ConceptChunk
cc c
n String
d = IdeaDict -> Sentence -> [UID] -> ConceptChunk
ConDict (c -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw c
n) (String -> Sentence
S String
d) []

-- | Same as 'cc', except definition is a 'Sentence'.
cc' :: Idea c => c -> Sentence -> ConceptChunk
cc' :: forall c. Idea c => c -> Sentence -> ConceptChunk
cc' c
n Sentence
d = IdeaDict -> Sentence -> [UID] -> ConceptChunk
ConDict (c -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw c
n) Sentence
d []

-- | Similar to 'cc'', but allows explicit domain tagging.
ccs :: (Idea c, Concept d) => c -> Sentence -> [d] -> ConceptChunk --Explicit tagging
ccs :: forall c d.
(Idea c, Concept d) =>
c -> Sentence -> [d] -> ConceptChunk
ccs c
n Sentence
d [d]
l = IdeaDict -> Sentence -> [UID] -> ConceptChunk
ConDict (c -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw c
n) Sentence
d ([UID] -> ConceptChunk) -> [UID] -> ConceptChunk
forall a b. (a -> b) -> a -> b
$ (d -> UID) -> [d] -> [UID]
forall a b. (a -> b) -> [a] -> [b]
map (d -> Getting UID d UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID d UID
forall c. HasUID c => Getter c UID
Getter d UID
uid) [d]
l

-- | For projecting out to the 'ConceptChunk' data-type.
cw :: Concept c => c -> ConceptChunk
cw :: forall c. Concept c => c -> ConceptChunk
cw c
c = IdeaDict -> Sentence -> [UID] -> ConceptChunk
ConDict (c -> IdeaDict
forall c. Idea c => c -> IdeaDict
nw c
c) (c
c c -> Getting Sentence c Sentence -> Sentence
forall s a. s -> Getting a s a -> a
^. Getting Sentence c Sentence
forall c. Definition c => Lens' c Sentence
Lens' c Sentence
defn) (c -> [UID]
forall c. ConceptDomain c => c -> [UID]
cdom c
c)

-- | Constructor for a 'ConceptInstance'. Takes in the 
-- Reference Address ('String'), a definition ('Sentence'), 
-- a short name ('String'), and a domain (for explicit tagging).
cic :: Concept c => String -> Sentence -> String -> c -> ConceptInstance
cic :: forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
u Sentence
d String
sn c
dom = UID -> ConceptChunk -> String -> ShortName -> ConceptInstance
ConInst (String -> UID -> UID
nsUid String
"instance" (UID -> UID) -> UID -> UID
forall a b. (a -> b) -> a -> b
$ ConceptChunk
icc ConceptChunk -> Getting UID ConceptChunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID ConceptChunk UID
forall c. HasUID c => Getter c UID
Getter ConceptChunk UID
uid) ConceptChunk
icc String
u (ShortName -> ConceptInstance) -> ShortName -> ConceptInstance
forall a b. (a -> b) -> a -> b
$ Sentence -> ShortName
shortname' (String -> Sentence
S String
sn)
  where icc :: ConceptChunk
icc = IdeaDict -> Sentence -> [c] -> ConceptChunk
forall c d.
(Idea c, Concept d) =>
c -> Sentence -> [d] -> ConceptChunk
ccs (String -> NP -> IdeaDict
nc String
u (NP -> IdeaDict) -> NP -> IdeaDict
forall a b. (a -> b) -> a -> b
$ String -> NP
pn String
sn) Sentence
d [c
dom]