-- | Defines helper functions used to make the general system description section.
module Drasil.Sections.GeneralSystDesc where

import Language.Drasil
import Language.Drasil.Sentence.Combinators
import Drasil.Sections.ReferenceMaterial (emptySectSentPlu)
import Drasil.Document.Contents (foldlSP)

import Data.Drasil.Concepts.Documentation (interface, system, environment,
  userCharacteristic, systemConstraint, information, section_, sysCont)
import qualified Drasil.DocLang.SRS as SRS (sysCon, sysCont, userChar)

-- | Default General System Description introduction.
genSysIntro :: Contents
genSysIntro :: Contents
genSysIntro = [Sentence] -> Contents
foldlSP [String -> Sentence
S String
"This", IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
section_, String -> Sentence
S String
"provides general",
  IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
information, String -> Sentence
S String
"about the" Sentence -> Sentence -> Sentence
+:+. IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
system, String -> Sentence
S String
"It identifies the",
  IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
plural IdeaDict
interface, String -> Sentence
S String
"between the", IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
system Sentence -> Sentence -> Sentence
`andIts` IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
environment Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"describes the", IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
plural IdeaDict
userCharacteristic Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"and lists the", IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
plural IdeaDict
systemConstraint]

-- | User Characeristics section constructor. Does not contain any subsections.
usrCharsF :: [Contents] -> Section
usrCharsF :: [Contents] -> Section
usrCharsF [] = [Contents] -> [Section] -> Section
SRS.userChar [Sentence -> Contents
mkParagraph (Sentence -> Contents) -> Sentence -> Contents
forall a b. (a -> b) -> a -> b
$ [IdeaDict] -> Sentence
forall n. NamedIdea n => [n] -> Sentence
emptySectSentPlu [IdeaDict
userCharacteristic]] []
usrCharsF [Contents]
intro = [Contents] -> [Section] -> Section
SRS.userChar [Contents]
intro []

-- | System Constraints section constructor.
-- Generalized if no constraints, but if there are, they can be passed through.
systCon :: [Contents] -> [Section] -> Section
systCon :: [Contents] -> [Section] -> Section
systCon [] [Section]
subSec  = [Contents] -> [Section] -> Section
SRS.sysCon [Sentence -> Contents
mkParagraph (Sentence -> Contents) -> Sentence -> Contents
forall a b. (a -> b) -> a -> b
$ [IdeaDict] -> Sentence
forall n. NamedIdea n => [n] -> Sentence
emptySectSentPlu [IdeaDict
systemConstraint]] [Section]
subSec
systCon [Contents]
a [Section]
subSec = [Contents] -> [Section] -> Section
SRS.sysCon [Contents]
a [Section]
subSec

-- | System Context section constructor. Does not contain any subsections.
sysContxt :: [Contents] -> Section
sysContxt :: [Contents] -> Section
sysContxt [] = [Contents] -> [Section] -> Section
SRS.sysCont [Sentence -> Contents
mkParagraph (Sentence -> Contents) -> Sentence -> Contents
forall a b. (a -> b) -> a -> b
$ [IdeaDict] -> Sentence
forall n. NamedIdea n => [n] -> Sentence
emptySectSentPlu [IdeaDict
sysCont]] []
sysContxt [Contents]
cs = [Contents] -> [Section] -> Section
SRS.sysCont [Contents]
cs []