-- | Contains functions for generating code comments that describe a chunk.
module Language.Drasil.Code.Imperative.Comments (
  getComment
) where

import Language.Drasil
import Database.Drasil (defTable)
import Language.Drasil.Chunk.Code (CodeIdea(..))
import Language.Drasil.Code.Imperative.DrasilState (GenState, DrasilState(..))
import Language.Drasil.CodeSpec (CodeSpec(..))
import Language.Drasil.Printers (Linearity(Linear), sentenceDoc, unitDoc)

import qualified Data.Map as Map (lookup)
import Control.Monad.State (get)
import Control.Lens ((^.))
import Text.PrettyPrint.HughesPJ (Doc, (<+>), colon, empty, parens, render)

-- | Gets a plain renderering of the term for a chunk.
getTermDoc :: (CodeIdea c) => c -> GenState Doc
getTermDoc :: c -> GenState Doc
getTermDoc c :: c
c = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let db :: ChunkDB
db = CodeSpec -> ChunkDB
sysinfodb (CodeSpec -> ChunkDB) -> CodeSpec -> ChunkDB
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
  Doc -> GenState Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> GenState Doc) -> Doc -> GenState Doc
forall a b. (a -> b) -> a -> b
$ ChunkDB -> Stage -> Linearity -> Sentence -> Doc
sentenceDoc ChunkDB
db Stage
Implementation Linearity
Linear (Sentence -> Doc) -> Sentence -> Doc
forall a b. (a -> b) -> a -> b
$ NP -> Sentence
forall n. NounPhrase n => n -> Sentence
phraseNP (NP -> Sentence) -> NP -> Sentence
forall a b. (a -> b) -> a -> b
$ c -> CodeChunk
forall c. CodeIdea c => c -> CodeChunk
codeChunk c
c CodeChunk -> Getting NP CodeChunk NP -> NP
forall s a. s -> Getting a s a -> a
^. Getting NP CodeChunk NP
forall c. NamedIdea c => Lens' c NP
term

-- | Gets a plain rendering of the definition of a chunk, preceded by a colon 
-- as it is intended to follow the term for the chunk. Returns empty if the 
-- chunk has no definition.
getDefnDoc :: (CodeIdea c) => c -> GenState Doc
getDefnDoc :: c -> GenState Doc
getDefnDoc c :: c
c = do
  DrasilState
g <- StateT DrasilState Identity DrasilState
forall s (m :: * -> *). MonadState s m => m s
get
  let db :: ChunkDB
db = CodeSpec -> ChunkDB
sysinfodb (CodeSpec -> ChunkDB) -> CodeSpec -> ChunkDB
forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
  Doc -> GenState Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> GenState Doc) -> Doc -> GenState Doc
forall a b. (a -> b) -> a -> b
$ Doc
-> ((ConceptChunk, Int) -> Doc) -> Maybe (ConceptChunk, Int) -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (Doc -> Doc -> Doc
(<+>) Doc
colon (Doc -> Doc)
-> ((ConceptChunk, Int) -> Doc) -> (ConceptChunk, Int) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChunkDB -> Stage -> Linearity -> Sentence -> Doc
sentenceDoc ChunkDB
db Stage
Implementation Linearity
Linear (Sentence -> Doc)
-> ((ConceptChunk, Int) -> Sentence) -> (ConceptChunk, Int) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 
    (ConceptChunk -> Getting Sentence ConceptChunk Sentence -> Sentence
forall s a. s -> Getting a s a -> a
^. Getting Sentence ConceptChunk Sentence
forall c. Definition c => Lens' c Sentence
defn) (ConceptChunk -> Sentence)
-> ((ConceptChunk, Int) -> ConceptChunk)
-> (ConceptChunk, Int)
-> Sentence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ConceptChunk, Int) -> ConceptChunk
forall a b. (a, b) -> a
fst) (UID -> Map UID (ConceptChunk, Int) -> Maybe (ConceptChunk, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (c -> CodeChunk
forall c. CodeIdea c => c -> CodeChunk
codeChunk c
c CodeChunk -> Getting UID CodeChunk UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID CodeChunk UID
forall c. HasUID c => Lens' c UID
uid) (Map UID (ConceptChunk, Int) -> Maybe (ConceptChunk, Int))
-> Map UID (ConceptChunk, Int) -> Maybe (ConceptChunk, Int)
forall a b. (a -> b) -> a -> b
$ ChunkDB -> Map UID (ConceptChunk, Int)
defTable ChunkDB
db)

-- | Gets a plain rendering of the unit of a chunk in parentheses, 
-- or empty if it has no unit.
getUnitsDoc :: (CodeIdea c) => c -> Doc
getUnitsDoc :: c -> Doc
getUnitsDoc c :: c
c = Doc -> (UnitDefn -> Doc) -> Maybe UnitDefn -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (Doc -> Doc
parens (Doc -> Doc) -> (UnitDefn -> Doc) -> UnitDefn -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Linearity -> USymb -> Doc
unitDoc Linearity
Linear (USymb -> Doc) -> (UnitDefn -> USymb) -> UnitDefn -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitDefn -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb) 
  (CodeChunk -> Maybe UnitDefn
forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit (CodeChunk -> Maybe UnitDefn) -> CodeChunk -> Maybe UnitDefn
forall a b. (a -> b) -> a -> b
$ c -> CodeChunk
forall c. CodeIdea c => c -> CodeChunk
codeChunk c
c)

-- | Generates a comment string for a chunk, including the term, 
-- definition (if applicable), and unit (if applicable).
getComment :: (CodeIdea c) => c -> GenState String
getComment :: c -> GenState String
getComment l :: c
l = do
  Doc
t <- c -> GenState Doc
forall c. CodeIdea c => c -> GenState Doc
getTermDoc c
l
  Doc
d <- c -> GenState Doc
forall c. CodeIdea c => c -> GenState Doc
getDefnDoc c
l
  let u :: Doc
u = c -> Doc
forall c. CodeIdea c => c -> Doc
getUnitsDoc c
l
  String -> GenState String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> GenState String) -> String -> GenState String
forall a b. (a -> b) -> a -> b
$ Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ (Doc
t Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
d) Doc -> Doc -> Doc
<+> Doc
u