{-# LANGUAGE PostfixOperators #-}
-- | Defines functions used in creating an introduction section.
module Drasil.Sections.Introduction (orgSec, introductionSection,
  purposeOfDoc, scopeOfRequirements, charIntRdrF, purpDoc) where

import Language.Drasil
import qualified Drasil.DocLang.SRS as SRS (intro, prpsOfDoc, scpOfReq,
  charOfIR, orgOfDoc, goalStmt, thModel, inModel, sysCon)
import Drasil.DocumentLanguage.Definitions(Verbosity(..))
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.Sentence.Combinators as S
import Drasil.Sections.ReferenceMaterial(emptySectSentPlu, emptySectSentSing)

import Data.Drasil.Concepts.Computation (algorithm)
import Data.Drasil.Concepts.Documentation as Doc (assumption, characteristic,
  decision, definition, desSpec, design, designDoc, document, documentation,
  environment, goal, goalStmt, implementation, intReader, model,
  organization, purpose, requirement, scope, section_, softwareDoc,
  softwareVAV, srs, theory, user, vavPlan, problem, problemIntro,
  information, systemConstraint, template)
import Data.Drasil.TheoryConcepts as Doc (inModel, thModel)
import Data.Drasil.Citations (parnasClements1986, smithEtAl2007,
  smithKoothoor2016, smithLai2005, koothoor2013)
import Data.Drasil.Software.Products


-----------------------
--     Constants     --
-----------------------

-- | 'Sentence' that explains the development process of a program.
developmentProcessParagraph :: Sentence
developmentProcessParagraph :: Sentence
developmentProcessParagraph = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"This", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
document, 
  String -> Sentence
S String
"will be used as a starting point for subsequent development", 
  String -> Sentence
S String
"phases, including writing the", forall n. NounPhrase n => n -> Sentence
phraseNP (CI
desSpec forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`andThe` IdeaDict
softwareVAV) Sentence -> Sentence -> Sentence
+:+.
  String -> Sentence
S String
"plan", forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the IdeaDict
designDoc), String -> Sentence
S String
"will show how the", 
  forall n. NamedIdea n => n -> Sentence
plural CI
requirement, String -> Sentence
S String
"are to be realized, including", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
decision, 
  String -> Sentence
S String
"on the numerical", forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
algorithm, String -> Sentence
S String
"and programming" Sentence -> Sentence -> Sentence
+:+. 
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
environment, String -> Sentence
S String
"The", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
vavPlan, 
  String -> Sentence
S String
"will show the steps that will be used to increase confidence in the",
  (forall n. NounPhrase n => n -> Sentence
phraseNP (IdeaDict
softwareDoc forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`andThe` IdeaDict
implementation) !.), String -> Sentence
S String
"Although",
  String -> Sentence
S String
"the", forall c. Idea c => c -> Sentence
short CI
srs, String -> Sentence
S String
"fits in a series of", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
document, 
  String -> Sentence
S String
"that follow the so-called waterfall", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
model Sentence -> Sentence -> Sentence
`sC` 
  String -> Sentence
S String
"the actual development process is not constrained", 
  String -> Sentence
S String
"in any way. Even when the waterfall model is not followed, as",
  String -> Sentence
S String
"Parnas and Clements point out", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS Citation
parnasClements1986 Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"the most logical way to present the", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
documentation,
  String -> Sentence
S String
"is still to", Sentence -> Sentence
Quote (String -> Sentence
S String
"fake"), String -> Sentence
S String
"a rational", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
design,
  String -> Sentence
S String
"process"]

-- | 'Sentence' containing the subsections of the Introduction.
introductionSubsections :: Sentence
introductionSubsections :: Sentence
introductionSubsections = SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List (forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Sentence -> Sentence -> Sentence
S.the_ofThe) 
  [(forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
scope, forall n. NamedIdea n => n -> Sentence
plural CI
requirement), 
  (forall n. NamedIdea n => n -> Sentence
plural IdeaDict
characteristic, forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
intReader),
  (forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
Doc.organization, forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
document)])

-------------------------
--                    --
-------------------------

-- | Constructor for the Introduction section. In order, the parameters are:
--
--     * problemIntroduction - 'Sentence' introducing the specific example problem.
--     * programDefinition  - 'Sentence' definition of the specific example.
--     * subSections        - List of subsections for this section.
introductionSection :: Sentence -> Sentence -> [Section] -> Section
introductionSection :: Sentence -> Sentence -> [Section] -> Section
introductionSection Sentence
EmptyS              Sentence
programDefinition = [Contents] -> [Section] -> Section
SRS.intro
  [Sentence -> Contents
mkParagraph forall a b. (a -> b) -> a -> b
$ forall n. NamedIdea n => [n] -> Sentence
emptySectSentSing [IdeaDict
problemIntro],
  Sentence -> Contents
overviewParagraph Sentence
programDefinition]
introductionSection Sentence
problemIntroduction Sentence
programDefinition = [Contents] -> [Section] -> Section
SRS.intro 
  [Sentence -> Contents
mkParagraph Sentence
problemIntroduction, Sentence -> Contents
overviewParagraph Sentence
programDefinition]


-- | Constructor for the overview paragraph for the Introduction.
-- Takes the definition of the specific example being generated ('Sentence').
overviewParagraph :: Sentence -> Contents
overviewParagraph :: Sentence -> Contents
overviewParagraph Sentence
programDefinition = [Sentence] -> Contents
foldlSP [String -> Sentence
S String
"The following", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
section_,
  String -> Sentence
S String
"provides an overview of the", forall c. Idea c => c -> Sentence
introduceAbb CI
srs, String -> Sentence
S String
"for" Sentence -> Sentence -> Sentence
+:+. 
  Sentence
programDefinition, String -> Sentence
S String
"This", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
section_, String -> Sentence
S String
"explains the", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
purpose,
  String -> Sentence
S String
"of this", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
document Sentence -> Sentence -> Sentence
`sC` Sentence
introductionSubsections]


-- | Constructor for Purpose of Document section that each example controls.
purpDocPara1 :: CI -> Sentence 
purpDocPara1 :: CI -> Sentence
purpDocPara1 CI
proName = [Sentence] -> Sentence
foldlSent [String -> Sentence
S String
"The primary purpose of this", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
document, String -> Sentence
S String
"is to",
  String -> Sentence
S String
"record the", forall n. NamedIdea n => n -> Sentence
plural CI
requirement, String -> Sentence
S String
"of" Sentence -> Sentence -> Sentence
+:+. CI -> Sentence
getAcc CI
proName, 
  forall n. NamedIdea n => n -> Sentence
atStart' IdeaDict
goal Sentence -> Sentence -> Sentence
`sC` forall n. NamedIdea n => n -> Sentence
plural CI
assumption Sentence -> Sentence -> Sentence
`sC` forall n. NamedIdea n => n -> Sentence
plural CI
thModel Sentence -> Sentence -> Sentence
`sC` 
  forall n. NamedIdea n => n -> Sentence
plural IdeaDict
definition Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"and other", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
model, String -> Sentence
S String
"derivation",
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
information, String -> Sentence
S String
"are specified" Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"allowing the reader to fully",
  String -> Sentence
S String
"understand" Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S String
"verify the", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
purpose Sentence -> Sentence -> Sentence
`S.and_` String -> Sentence
S String
"scientific",
  String -> Sentence
S String
"basis of" Sentence -> Sentence -> Sentence
+:+. forall c. Idea c => c -> Sentence
short CI
proName, String -> Sentence
S String
"With the exception of", 
  forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef ([Contents] -> [Section] -> Section
SRS.sysCon [] []) (forall n. NamedIdea n => n -> Sentence
plural IdeaDict
systemConstraint) Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"this",
  forall c. Idea c => c -> Sentence
short CI
Doc.srs, String -> Sentence
S String
"will remain abstract, describing what", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
problem,
  String -> Sentence
S String
"is being solved, but not how to solve it"] 

-- | Combines 'purpDocPara1' and 'developmentProcessParagraph'.
-- Verbosity controls if the 'developmentProcessParagraph' is added or not.
purpDoc :: CI -> Verbosity -> [Sentence]
purpDoc :: CI -> Verbosity -> [Sentence]
purpDoc CI
proName Verbosity
Verbose = [CI -> Sentence
purpDocPara1 CI
proName, Sentence
developmentProcessParagraph]
purpDoc CI
proName Verbosity
Succinct = [CI -> Sentence
purpDocPara1 CI
proName]

-- | Constructor for Purpose of Document subsection. Takes a list of 'Sentence's that:
--
--     * Given one element: explains the purpose of the specific example.
--     * Given two elements: explains the purpose of the specific example and the development process.
--     * Otherwise: Uses the default 'developmentProcessParagraph'.
purposeOfDoc :: [Sentence] -> Section
purposeOfDoc :: [Sentence] -> Section
purposeOfDoc [Sentence
purposeOfProgram] = [Contents] -> [Section] -> Section
SRS.prpsOfDoc [Sentence -> Contents
mkParagraph Sentence
purposeOfProgram] []
purposeOfDoc [Sentence
purposeOfProgram, Sentence
developmentProcess] = [Contents] -> [Section] -> Section
SRS.prpsOfDoc 
  [Sentence -> Contents
mkParagraph Sentence
purposeOfProgram, Sentence -> Contents
mkParagraph Sentence
developmentProcess] []
purposeOfDoc [Sentence]
_ = [Contents] -> [Section] -> Section
SRS.prpsOfDoc [Sentence -> Contents
mkParagraph Sentence
developmentProcessParagraph] []

-- | Constructor for the Scope of Requirements subsection.
-- Takes in the main requirement for the program.
scopeOfRequirements :: Sentence -> Section
scopeOfRequirements :: Sentence -> Section
scopeOfRequirements Sentence
EmptyS = [Contents] -> [Section] -> Section
SRS.scpOfReq [Sentence -> Contents
mkParagraph forall a b. (a -> b) -> a -> b
$ forall n. NamedIdea n => [n] -> Sentence
emptySectSentPlu [CI
requirement]] []
scopeOfRequirements Sentence
req = [Contents] -> [Section] -> Section
SRS.scpOfReq [[Sentence] -> Contents
foldlSP
  [forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
scope Sentence -> Sentence -> Sentence
`S.the_ofTheC` forall n. NamedIdea n => n -> Sentence
plural CI
requirement, String -> Sentence
S String
"includes", Sentence
req]] []

-- | Constructor for characteristics of the intended reader subsection.
-- Takes the program name ('Idea'), assumed knowledge ('Sentence's), topic-related subjects ('Sentence's),
-- knowledge assets ('Sentence's), and references ('Section').
charIntRdrF :: (Idea a) => a -> [Sentence] -> [Sentence] -> [Sentence] -> 
  Section -> Section
charIntRdrF :: forall a.
Idea a =>
a -> [Sentence] -> [Sentence] -> [Sentence] -> Section -> Section
charIntRdrF a
progName [Sentence]
assumed [Sentence]
topic [Sentence]
asset Section
r = 
  [Contents] -> [Section] -> Section
SRS.charOfIR (forall a.
Idea a =>
a
-> [Sentence] -> [Sentence] -> [Sentence] -> Section -> [Contents]
intReaderIntro a
progName [Sentence]
assumed [Sentence]
topic [Sentence]
asset Section
r) []

-- | Helper that creates a paragraph. Called by 'charIntRdrF'. The parameters (in order) should be:
--
--     * program name,
--     * subjects the reader is assumed to understand,
--     * topic-related subjects that the reader should understand,
--     * subjects that would be an asset if the reader understood them,
--     * reference to User Characteristics section.
intReaderIntro :: (Idea a) => a -> [Sentence] -> [Sentence] -> [Sentence] ->
  Section -> [Contents]
intReaderIntro :: forall a.
Idea a =>
a
-> [Sentence] -> [Sentence] -> [Sentence] -> Section -> [Contents]
intReaderIntro a
_ [] [] [] Section
_ = 
  [[Sentence] -> Contents
foldlSP [String -> Sentence
S String
"Reviewers of this", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
documentation,
  String -> Sentence
S String
"do not need any prerequisite knowledge"]]
intReaderIntro a
progName [Sentence]
assumed [Sentence]
topic [Sentence]
asset Section
sectionRef = 
  [[Sentence] -> Contents
foldlSP [String -> Sentence
S String
"Reviewers of this", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
documentation,
  String -> Sentence
S String
"should have an understanding of" Sentence -> Sentence -> Sentence
+:+.
  SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List ([Sentence]
assumed forall a. [a] -> [a] -> [a]
++ [Sentence]
topic), Sentence
assetSent,
  forall n. NounPhrase n => n -> Sentence
atStartNP' (forall t. NamedIdea t => t -> NP
the IdeaDict
user) Sentence -> Sentence -> Sentence
`S.of_` forall c. Idea c => c -> Sentence
short a
progName, String -> Sentence
S String
"can have a lower level" Sentence -> Sentence -> Sentence
`S.of_`
  String -> Sentence
S String
"expertise, as explained" Sentence -> Sentence -> Sentence
`S.in_` forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS Section
sectionRef]]
  where
    assetSent :: Sentence
assetSent = case [Sentence]
asset of
      [] -> Sentence
EmptyS
      [Sentence]
_  -> String -> Sentence
S String
"It would be an asset to understand" Sentence -> Sentence -> Sentence
+:+. SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List [Sentence]
asset

-- | Constructor for the Organization of the Document section. Parameters should be
-- an introduction ('Sentence'), a resource for a bottom up approach ('NamedIdea'), reference to that resource ('Section'),
-- and any other relevant information ('Sentence').
orgSec :: NamedIdea c => c -> Section -> Sentence -> Section
orgSec :: forall c. NamedIdea c => c -> Section -> Sentence -> Section
orgSec c
b Section
s Sentence
t = [Contents] -> [Section] -> Section
SRS.orgOfDoc (forall c. NamedIdea c => c -> Section -> Sentence -> [Contents]
orgIntro c
b Section
s Sentence
t) []


-- | Helper function that creates the introduction for the Organization of the Document section. Parameters should be
-- an introduction ('Sentence'), a resource for a bottom up approach ('NamedIdea'), reference to that resource ('Section'),
-- and any other relevant information ('Sentence').
orgIntro :: NamedIdea c => c -> Section -> Sentence -> [Contents]
orgIntro :: forall c. NamedIdea c => c -> Section -> Sentence -> [Contents]
orgIntro c
bottom Section
bottomSec Sentence
trailingSentence = [[Sentence] -> Contents
foldlSP [
  Sentence
orgOfDocIntro, String -> Sentence
S String
"The presentation follows the standard pattern of presenting" Sentence -> Sentence -> Sentence
+:+.
  SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List (forall a b. (a -> b) -> [a] -> [b]
map forall n. NamedIdea n => n -> Sentence
plural [forall c. Idea c => c -> IdeaDict
nw IdeaDict
Doc.goal, forall c. Idea c => c -> IdeaDict
nw IdeaDict
theory, forall c. Idea c => c -> IdeaDict
nw IdeaDict
definition, forall c. Idea c => c -> IdeaDict
nw CI
assumption]),
  String -> Sentence
S String
"For readers that would like a more bottom up approach" Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"they can start reading the", forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence -> Sentence
namedRef Section
bottomSec (forall n. NamedIdea n => n -> Sentence
plural c
bottom)Sentence -> Sentence -> Sentence
`S.and_`
  String -> Sentence
S String
"trace back to find any additional information they require"],
  [Sentence] -> Contents
folder [forall c. NamedIdea c => [(c, Section)] -> Sentence
refineChain (forall a b. [a] -> [b] -> [(a, b)]
zip [CI
goalStmt, CI
thModel, CI
inModel]
         [[Contents] -> [Section] -> Section
SRS.goalStmt [] [], [Contents] -> [Section] -> Section
SRS.thModel [] [], [Contents] -> [Section] -> Section
SRS.inModel [] []]), Sentence
trailingSentence]]
  where
    folder :: [Sentence] -> Contents
folder = case Sentence
trailingSentence of
      Sentence
EmptyS -> [Sentence] -> Contents
foldlSP_
      Sentence
_      -> [Sentence] -> Contents
foldlSP

orgOfDocIntro :: Sentence
orgOfDocIntro :: Sentence
orgOfDocIntro = [Sentence] -> Sentence
foldlSent 
  [forall n. NounPhrase n => n -> Sentence
atStartNP (forall t. NamedIdea t => t -> NP
the IdeaDict
Doc.organization), String -> Sentence
S String
"of this", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
document, 
  String -> Sentence
S String
"follows the", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
template, String -> Sentence
S String
"for an", CI -> Sentence
getAcc CI
Doc.srs, String -> Sentence
S String
"for", 
  forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
sciCompS, String -> Sentence
S String
"proposed by", SepType -> FoldType -> [Sentence] -> Sentence
foldlList SepType
Comma FoldType
List forall a b. (a -> b) -> a -> b
$ 
    forall a b. (a -> b) -> [a] -> [b]
map forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS [Citation
koothoor2013, Citation
smithLai2005, Citation
smithEtAl2007 , Citation
smithKoothoor2016]]