-- | Defines functions used in the Requirements section.
module Drasil.Sections.Requirements (
  -- * Requirements
  reqF, reqInputsRef,
  -- * Functional Requirements
  fReqF,
  -- ** Input Requirements
  fullReqs, fullTables, inReq, inTable,
  mkInputPropsTable, mkQRTuple, mkQRTupleRef, mkValsSourceTable,
  -- * Non-functional Requirements
  nfReqF, mkMaintainableNFR
  ) where

import Language.Drasil
import Language.Drasil.Chunk.Concept.NamedCombinators
import qualified Language.Drasil.Sentence.Combinators as S
import Drasil.Sections.ReferenceMaterial(emptySectSentPlu)
import Theory.Drasil (HasOutput(output))

import Data.Drasil.Concepts.Documentation (description, funcReqDom, nonFuncReqDom,
  functionalRequirement, input_, nonfunctionalRequirement, {-output_,-} section_,
  software, symbol_, value, reqInput)
import Data.Drasil.Concepts.Math (unit_)

import qualified Drasil.DocLang.SRS as SRS
import Drasil.DocumentLanguage.Units (toSentence)
import Data.List (nub)

import Control.Lens ((^.))
import Data.Bifunctor (bimap)

-- | Wrapper for 'reqIntro'.
reqF :: [Section] -> Section
reqF :: [Section] -> Section
reqF = [Contents] -> [Section] -> Section
SRS.require [Contents
reqIntro]

-- | Prepends a 'ConceptInstance' referencing an input-value table to a list of other 'ConceptInstance's.
-- For listing input requirements.
fullReqs :: (Quantity i, MayHaveUnit i) => [i] -> Sentence -> [ConceptInstance] -> [ConceptInstance]
fullReqs :: forall i.
(Quantity i, MayHaveUnit i) =>
[i] -> Sentence -> [ConceptInstance] -> [ConceptInstance]
fullReqs [] Sentence
_ [ConceptInstance]
_ = []
fullReqs [i]
i Sentence
d [ConceptInstance]
r = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ Sentence -> ConceptInstance
inReq (forall r.
(HasShortName r, Referable r) =>
r -> Sentence -> Sentence
inReqDesc (forall i. (Quantity i, MayHaveUnit i) => [i] -> LabelledContent
inTable [i]
i) Sentence
d) forall a. a -> [a] -> [a]
: [ConceptInstance]
r-- ++ [outReq (outReqDesc outTable)]

-- | Prepends given LabelledContent to an input-value table.
fullTables :: (Quantity i, MayHaveUnit i) => [i] -> [LabelledContent] -> [LabelledContent]
fullTables :: forall i.
(Quantity i, MayHaveUnit i) =>
[i] -> [LabelledContent] -> [LabelledContent]
fullTables [] [LabelledContent]
_ = []
fullTables [i]
i [LabelledContent]
t = forall i. (Quantity i, MayHaveUnit i) => [i] -> LabelledContent
inTable [i]
i forall a. a -> [a] -> [a]
: [LabelledContent]
t

-- | Creates a generalized input-value table for the Requirements section.
inTable :: (Quantity i, MayHaveUnit i) => [i] -> LabelledContent
inTable :: forall i. (Quantity i, MayHaveUnit i) => [i] -> LabelledContent
inTable [i]
i = forall i r.
(Quantity i, MayHaveUnit i, HasShortName r, Referable r) =>
[i] -> r -> LabelledContent
mkInputPropsTable [i]
i (Sentence -> ConceptInstance
inReq Sentence
EmptyS) -- passes empty Sentence to make stub of inReq
--outTable    = mkValsSourceTable o "ReqOutputs" (S "Required" +:+ titleize' output_ `follows` (outReq EmptyS))
                                                -- passes empty Sentence to make stub of outReq

-- | Creates a Sentence from a Referable and possible description. Output is of the form
-- "Inputs the values from @reference@, which define @description@". If no description is given,
-- there will be nothing after the word "@reference@".
inReqDesc :: (HasShortName r, Referable r) => r -> Sentence -> Sentence 
inReqDesc :: forall r.
(HasShortName r, Referable r) =>
r -> Sentence -> Sentence
inReqDesc  r
t Sentence
desc = [Sentence] -> Sentence
foldlSent [forall n. NamedIdea n => n -> Sentence
atStart IdeaDict
input_,  String -> Sentence
S String
"the", forall n. NamedIdea n => n -> Sentence
plural IdeaDict
value, String -> Sentence
S String
"from", Sentence
end]
  where end :: Sentence
end = case Sentence
desc of Sentence
EmptyS -> forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS r
t
                           Sentence
sent   -> forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS r
t Sentence -> Sentence -> Sentence
`sC` String -> Sentence
S String
"which define" Sentence -> Sentence -> Sentence
+:+ Sentence
sent
--outReqDesc t = foldlSent [atStart output_, S "the", plural value, S "from", refS t]

-- | Creates a 'ConceptInstance' of input values.
inReq :: Sentence -> ConceptInstance
inReq :: Sentence -> ConceptInstance
inReq  Sentence
s = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
"inputValues"  Sentence
s String
"Input-Values"  ConceptChunk
funcReqDom
--outReq s = cic "inputValues" s "Output-Values" funcReqDom

-- | Adds a generalized introduction for a Non-Fucntional Requirements section. Takes in the contents of that section.
fReqF :: [Contents] -> Section
fReqF :: [Contents] -> Section
fReqF [Contents]
listOfFReqs = [Contents] -> [Section] -> Section
SRS.funcReq ([Contents] -> Contents
fReqIntro [Contents]
listOfFReqs forall a. a -> [a] -> [a]
: [Contents]
listOfFReqs) []

-- | Adds a generalized introduction for a Non-Fucntional Requirements section. Takes in the contents of that section.
nfReqF :: [Contents] -> Section
nfReqF :: [Contents] -> Section
nfReqF [Contents]
nfrs = [Contents] -> [Section] -> Section
SRS.nonfuncReq ([Contents] -> Contents
nfReqIntro [Contents]
nfrs forall a. a -> [a] -> [a]
: [Contents]
nfrs) []

-- | General 'Sentence' for use in the Requirements section introduction.
reqIntroStart :: Sentence
reqIntroStart :: Sentence
reqIntroStart = [Sentence] -> Sentence
foldlSent_ [String -> Sentence
S String
"This", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
section_, String -> Sentence
S String
"provides"]

-- | General 'Sentence' for use in the Functional Requirements subsection introduction.
frReqIntroBody :: Sentence
frReqIntroBody :: Sentence
frReqIntroBody = [Sentence] -> Sentence
foldlSent_ [forall n. NounPhrase n => n -> Sentence
pluralNP (forall t. NamedIdea t => t -> NP
the IdeaDict
functionalRequirement) Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"the tasks and behaviours that the", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
software, String -> Sentence
S String
"is expected to complete"]

-- | General 'Sentence' for use in the Non-Functional Requirements subsection introduction.
nfrReqIntroBody :: Sentence
nfrReqIntroBody :: Sentence
nfrReqIntroBody = [Sentence] -> Sentence
foldlSent_ [forall n. NounPhrase n => n -> Sentence
pluralNP (forall t. NamedIdea t => t -> NP
the IdeaDict
nonfunctionalRequirement) Sentence -> Sentence -> Sentence
`sC`
  String -> Sentence
S String
"the qualities that the", forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
software, String -> Sentence
S String
"is expected to exhibit"]

-- | Generalized Requirements section introduction.
reqIntro :: Contents
reqIntro :: Contents
reqIntro = Sentence -> Contents
mkParagraph forall a b. (a -> b) -> a -> b
$ Sentence
reqIntroStart Sentence -> Sentence -> Sentence
+:+. (Sentence
frReqIntroBody Sentence -> Sentence -> Sentence
`sC` Sentence
EmptyS Sentence -> Sentence -> Sentence
`S.and_` Sentence
nfrReqIntroBody)

-- | Generalized Functional Requirements subsection introduction.
fReqIntro :: [Contents] -> Contents
fReqIntro :: [Contents] -> Contents
fReqIntro [] = Sentence -> Contents
mkParagraph forall a b. (a -> b) -> a -> b
$ forall n. NamedIdea n => [n] -> Sentence
emptySectSentPlu [IdeaDict
functionalRequirement]
fReqIntro [Contents]
_  = Sentence -> Contents
mkParagraph forall a b. (a -> b) -> a -> b
$ Sentence
reqIntroStart Sentence -> Sentence -> Sentence
+:+. Sentence
frReqIntroBody

-- | Generalized Non-Functional Requirements subsection introduction.
nfReqIntro :: [Contents] -> Contents
nfReqIntro :: [Contents] -> Contents
nfReqIntro [] = Sentence -> Contents
mkParagraph forall a b. (a -> b) -> a -> b
$ forall n. NamedIdea n => [n] -> Sentence
emptySectSentPlu [IdeaDict
nonfunctionalRequirement]
nfReqIntro [Contents]
_  = Sentence -> Contents
mkParagraph forall a b. (a -> b) -> a -> b
$ Sentence
reqIntroStart Sentence -> Sentence -> Sentence
+:+. Sentence
nfrReqIntroBody

-- | Common Non-Functional Requirement for Maintainability.
-- Takes in a Reference Address ('String'), a percent value ('Integer'), 
-- and a label ('String').
mkMaintainableNFR :: String -> Integer -> String -> ConceptInstance
mkMaintainableNFR :: String -> Integer -> String -> ConceptInstance
mkMaintainableNFR String
refAddress Integer
percent String
lbl = forall c.
Concept c =>
String -> Sentence -> String -> c -> ConceptInstance
cic String
refAddress ([Sentence] -> Sentence
foldlSent [
  String -> Sentence
S String
"If a likely change is made" Sentence -> Sentence -> Sentence
`S.toThe` 
  String -> Sentence
S String
"finished software, it will take at most", forall a. Show a => a -> Sentence
addPercent Integer
percent Sentence -> Sentence -> Sentence
`S.ofThe`
  String -> Sentence
S String
"original development time,",
  String -> Sentence
S String
"assuming the same development resources are available"
  ]) String
lbl ConceptChunk
nonFuncReqDom

-- | Creates an Input Data Table for use in the Functional Requirments section. Takes a list of wrapped variables and something that is 'Referable'.
mkInputPropsTable :: (Quantity i, MayHaveUnit i, HasShortName r, Referable r) => 
                          [i] -> r -> LabelledContent
mkInputPropsTable :: forall i r.
(Quantity i, MayHaveUnit i, HasShortName r, Referable r) =>
[i] -> r -> LabelledContent
mkInputPropsTable []        r
_   = Reference -> RawContent -> LabelledContent
llcc Reference
reqInputsRef forall a b. (a -> b) -> a -> b
$ Sentence -> RawContent
Paragraph Sentence
EmptyS
mkInputPropsTable [i]
reqInputs r
req = Reference -> RawContent -> LabelledContent
llcc Reference
reqInputsRef forall a b. (a -> b) -> a -> b
$ 
  [Sentence] -> [[Sentence]] -> Sentence -> Bool -> RawContent
Table [forall n. NamedIdea n => n -> Sentence
atStart IdeaDict
symbol_, forall n. NamedIdea n => n -> Sentence
atStart IdeaDict
description, forall n. NamedIdea n => n -> Sentence
atStart' ConceptChunk
unit_]
  (forall a b. [a -> b] -> [a] -> [[b]]
mkTable [forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch, forall n. NamedIdea n => n -> Sentence
atStart, forall u. MayHaveUnit u => u -> Sentence
toSentence] forall a b. (a -> b) -> a -> b
$ forall a. HasSymbol a => [a] -> [a]
sortBySymbol [i]
reqInputs)
  (forall n. NamedIdea n => n -> Sentence
titleize' IdeaDict
reqInput forall r.
(Referable r, HasShortName r) =>
Sentence -> r -> Sentence
`follows` r
req) Bool
True

-- | Reference for the Required Inputs table.
reqInputsRef :: Reference
reqInputsRef :: Reference
reqInputsRef = UID -> Reference
makeTabRef' (IdeaDict
reqInput forall s a. s -> Getting a s a -> a
^. forall c. HasUID c => Lens' c UID
uid)

-- | Creates a table for use in the Functional Requirments section. Takes a list of tuples containing variables and sources, a label, and a caption. 
mkValsSourceTable :: (Quantity i, MayHaveUnit i) => 
                          [(i, Sentence)] -> String -> Sentence -> LabelledContent
mkValsSourceTable :: forall i.
(Quantity i, MayHaveUnit i) =>
[(i, Sentence)] -> String -> Sentence -> LabelledContent
mkValsSourceTable [(i, Sentence)]
vals String
labl Sentence
cap = Reference -> RawContent -> LabelledContent
llcc (String -> Reference
makeTabRef String
labl) forall a b. (a -> b) -> a -> b
$ 
  [Sentence] -> [[Sentence]] -> Sentence -> Bool -> RawContent
Table [forall n. NamedIdea n => n -> Sentence
atStart IdeaDict
symbol_, forall n. NamedIdea n => n -> Sentence
atStart IdeaDict
description, String -> Sentence
S String
"Source", forall n. NamedIdea n => n -> Sentence
atStart' ConceptChunk
unit_]
  (forall a b. [a -> b] -> [a] -> [[b]]
mkTable [forall c. (HasUID c, HasSymbol c) => c -> Sentence
ch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst, forall n. NamedIdea n => n -> Sentence
atStart forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst, forall a b. (a, b) -> b
snd, forall u. MayHaveUnit u => u -> Sentence
toSentence forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst] forall a b. (a -> b) -> a -> b
$ forall a b. HasSymbol a => [(a, b)] -> [(a, b)]
sortBySymbolTuple [(i, Sentence)]
vals) Sentence
cap Bool
True

mkQRTuple :: (HasOutput i, HasShortName i, Referable i) => [i] -> [(QuantityDict, Sentence)]
mkQRTuple :: forall i.
(HasOutput i, HasShortName i, Referable i) =>
[i] -> [(QuantityDict, Sentence)]
mkQRTuple = forall a b. (a -> b) -> [a] -> [b]
map (\i
c -> (i
c forall s a. s -> Getting a s a -> a
^. forall c. HasOutput c => Getter c QuantityDict
output, forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS i
c))

mkQRTupleRef :: (Quantity i, MayHaveUnit i, HasShortName r, Referable r) => [i] -> [r] -> [(QuantityDict, Sentence)]
mkQRTupleRef :: forall i r.
(Quantity i, MayHaveUnit i, HasShortName r, Referable r) =>
[i] -> [r] -> [(QuantityDict, Sentence)]
mkQRTupleRef = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b c. ((a, b) -> c) -> a -> b -> c
curry (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap forall q. (Quantity q, MayHaveUnit q) => q -> QuantityDict
qw forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS))