-- | 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.Code.Imperative.DrasilState (GenState, DrasilState(..))
import Language.Drasil.CodeSpec (CodeSpec(..))
import Language.Drasil.Printers (SingleLine(OneLine), 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 :: forall c. CodeIdea c => c -> GenState Doc
getTermDoc c
c = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let db :: ChunkDB
db = CodeSpec -> ChunkDB
sysinfodb forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ChunkDB -> Stage -> SingleLine -> Sentence -> Doc
sentenceDoc ChunkDB
db Stage
Implementation SingleLine
OneLine forall a b. (a -> b) -> a -> b
$ forall n. NounPhrase n => n -> Sentence
phraseNP forall a b. (a -> b) -> a -> b
$ forall c. CodeIdea c => c -> CodeChunk
codeChunk c
c forall s a. s -> Getting a s a -> a
^. 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 :: forall c. CodeIdea c => c -> GenState Doc
getDefnDoc c
c = do
  DrasilState
g <- forall s (m :: * -> *). MonadState s m => m s
get
  let db :: ChunkDB
db = CodeSpec -> ChunkDB
sysinfodb forall a b. (a -> b) -> a -> b
$ DrasilState -> CodeSpec
codeSpec DrasilState
g
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (Doc -> Doc -> Doc
(<+>) Doc
colon forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChunkDB -> Stage -> SingleLine -> Sentence -> Doc
sentenceDoc ChunkDB
db Stage
Implementation SingleLine
OneLine forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (forall s a. s -> Getting a s a -> a
^. forall c. Definition c => Lens' c Sentence
defn) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (forall c. CodeIdea c => c -> CodeChunk
codeChunk c
c forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid) forall a b. (a -> b) -> a -> b
$ ChunkDB -> ConceptMap
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 :: forall c. CodeIdea c => c -> Doc
getUnitsDoc c
c = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (Doc -> Doc
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleLine -> USymb -> Doc
unitDoc SingleLine
OneLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall u. HasUnitSymbol u => u -> USymb
usymb)
  (forall u. MayHaveUnit u => u -> Maybe UnitDefn
getUnit forall a b. (a -> b) -> a -> b
$ 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 :: forall c. CodeIdea c => c -> GenState String
getComment c
l = do
  Doc
t <- forall c. CodeIdea c => c -> GenState Doc
getTermDoc c
l
  Doc
d <- forall c. CodeIdea c => c -> GenState Doc
getDefnDoc c
l
  let u :: Doc
u = forall c. CodeIdea c => c -> Doc
getUnitsDoc c
l
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Doc -> String
render forall a b. (a -> b) -> a -> b
$ (Doc
t forall a. Semigroup a => a -> a -> a
<> Doc
d) Doc -> Doc -> Doc
<+> Doc
u