{-# LANGUAGE PostfixOperators #-}
-- | Defines functions used to create the Traceability Matrices and Graphs section.
module Drasil.Sections.TraceabilityMandGs (
  -- * Main Functions
  generateTraceTable, traceMatAssumpAssump, traceMatAssumpOther,
  traceMatRefinement, traceMatOtherReq, traceMatStandard,
  -- * Helpers
  tvAssumps, tvDataDefns, tvGenDefns, tvTheoryModels,
  tvInsModels, tvGoals, tvReqs, tvChanges
  ) where

import Drasil.DocumentLanguage.Core (TraceConfig(TraceConfig))
import Drasil.DocumentLanguage.TraceabilityMatrix (generateTraceTableView,
  traceMReferrers, traceView, traceViewCC, TraceViewCat)

import Data.Drasil.Concepts.Documentation (assumption, assumpDom, chgProbDom,
  goalStmt, goalStmtDom, requirement, reqDom, item, section_, likelyChg,
  unlikelyChg)
import qualified Data.Drasil.TheoryConcepts as Doc (genDefn, dataDefn, inModel, thModel)
import Database.Drasil
import SysInfo.Drasil
import Language.Drasil
import Language.Drasil.Chunk.Concept.NamedCombinators as NC
import Language.Drasil.Sentence.Combinators as S
import Data.Foldable (foldl')

-- | Makes a Traceability Table/Matrix that contains Items of Different Sections.
generateTraceTable :: SystemInformation -> LabelledContent
generateTraceTable :: SystemInformation -> LabelledContent
generateTraceTable = UID
-> Sentence
-> [TraceViewCat]
-> [TraceViewCat]
-> SystemInformation
-> LabelledContent
generateTraceTableView (String -> UID
mkUid String
"Tracey")
  (IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize' IdeaDict
item Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"of Different" Sentence -> Sentence -> Sentence
+:+ IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize' IdeaDict
section_) [TraceViewCat
tvEverything] [TraceViewCat
tvEverything]

-- | Traceability viewing everything. Takes a 'UID' and a 'ChunkDB'. Returns a list of 'UID's.
tvEverything :: TraceViewCat
tvEverything :: TraceViewCat
tvEverything = (ChunkDB -> [UID] -> [UID]) -> TraceViewCat
forall a b c. (a -> b -> c) -> b -> a -> c
flip (([UID] -> [UID]) -> ChunkDB -> [UID] -> [UID]
forall a b. a -> b -> a
const [UID] -> [UID]
forall a. a -> a
id)

-- | Traceability viewing assumptions. Takes a 'UID' and a 'ChunkDB'. Returns a list of 'UID's.
tvAssumps :: TraceViewCat
tvAssumps :: TraceViewCat
tvAssumps = ConceptChunk -> TraceViewCat
forall c. Concept c => c -> TraceViewCat
traceViewCC ConceptChunk
assumpDom

-- | Traceability viewing data definitions. Takes a 'UID' and a 'ChunkDB'. Returns a list of 'UID's.
tvDataDefns :: TraceViewCat
tvDataDefns :: TraceViewCat
tvDataDefns = Getting (UMap DataDefinition) ChunkDB (UMap DataDefinition)
-> TraceViewCat
forall a.
HasUID a =>
Getting (UMap a) ChunkDB (UMap a) -> TraceViewCat
traceView Getting (UMap DataDefinition) ChunkDB (UMap DataDefinition)
Lens' ChunkDB (UMap DataDefinition)
dataDefnTable

-- | Traceability viewing general definitions. Takes a 'UID' and a 'ChunkDB'. Returns a list of 'UID's.
tvGenDefns :: TraceViewCat
tvGenDefns :: TraceViewCat
tvGenDefns = Getting (UMap GenDefn) ChunkDB (UMap GenDefn) -> TraceViewCat
forall a.
HasUID a =>
Getting (UMap a) ChunkDB (UMap a) -> TraceViewCat
traceView Getting (UMap GenDefn) ChunkDB (UMap GenDefn)
Lens' ChunkDB (UMap GenDefn)
gendefTable

-- | Traceability viewing theory models. Takes a 'UID' and a 'ChunkDB'. Returns a list of 'UID's.
tvTheoryModels :: TraceViewCat
tvTheoryModels :: TraceViewCat
tvTheoryModels = Getting (UMap TheoryModel) ChunkDB (UMap TheoryModel)
-> TraceViewCat
forall a.
HasUID a =>
Getting (UMap a) ChunkDB (UMap a) -> TraceViewCat
traceView Getting (UMap TheoryModel) ChunkDB (UMap TheoryModel)
Lens' ChunkDB (UMap TheoryModel)
theoryModelTable

-- | Traceability viewing instance models. Takes a 'UID' and a 'ChunkDB'. Returns a list of 'UID's.
tvInsModels :: TraceViewCat
tvInsModels :: TraceViewCat
tvInsModels = Getting (UMap InstanceModel) ChunkDB (UMap InstanceModel)
-> TraceViewCat
forall a.
HasUID a =>
Getting (UMap a) ChunkDB (UMap a) -> TraceViewCat
traceView Getting (UMap InstanceModel) ChunkDB (UMap InstanceModel)
Lens' ChunkDB (UMap InstanceModel)
insmodelTable

-- | Traceability viewing goals. Takes a 'UID' and a 'ChunkDB'. Returns a list of 'UID's.
tvGoals :: TraceViewCat
tvGoals :: TraceViewCat
tvGoals = ConceptChunk -> TraceViewCat
forall c. Concept c => c -> TraceViewCat
traceViewCC ConceptChunk
goalStmtDom

-- | Traceability viewing requirements. Takes a 'UID' and a 'ChunkDB'. Returns a list of 'UID's.
tvReqs :: TraceViewCat
tvReqs :: TraceViewCat
tvReqs = ConceptChunk -> TraceViewCat
forall c. Concept c => c -> TraceViewCat
traceViewCC ConceptChunk
reqDom

-- | Traceability viewing changes. Takes a 'UID' and a 'ChunkDB'. Returns a list of 'UID's.
tvChanges :: TraceViewCat
tvChanges :: TraceViewCat
tvChanges = ConceptChunk -> TraceViewCat
forall c. Concept c => c -> TraceViewCat
traceViewCC ConceptChunk
chgProbDom

-- | Assumptions on the assumptions of a traceability matrix.
traceMatAssumpAssump :: TraceConfig
traceMatAssumpAssump :: TraceConfig
traceMatAssumpAssump = UID
-> [Sentence]
-> Sentence
-> [TraceViewCat]
-> [TraceViewCat]
-> TraceConfig
TraceConfig (String -> UID
mkUid String
"TraceMatAvsA") [CI -> Sentence
forall n. NamedIdea n => n -> Sentence
plural CI
assumption 
  Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"on each other"] (CI -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize' CI
assumption Sentence -> Sentence -> Sentence
+:+
  String -> Sentence
S String
"and Other" Sentence -> Sentence -> Sentence
+:+ CI -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize' CI
assumption ) [TraceViewCat
tvAssumps] [TraceViewCat
tvAssumps]

-- | Other assumptions of the traceability matrix
traceMatAssumpOther :: TraceConfig
traceMatAssumpOther :: TraceConfig
traceMatAssumpOther = UID
-> [Sentence]
-> Sentence
-> [TraceViewCat]
-> [TraceViewCat]
-> TraceConfig
TraceConfig (String -> UID
mkUid String
"TraceMatAvsAll") [CI -> Sentence
forall n. NamedIdea n => n -> Sentence
plural CI
Doc.dataDefn,
  CI -> Sentence
forall n. NamedIdea n => n -> Sentence
plural CI
Doc.thModel, CI -> Sentence
forall n. NamedIdea n => n -> Sentence
plural CI
Doc.genDefn, CI -> Sentence
forall n. NamedIdea n => n -> Sentence
plural CI
Doc.inModel, CI -> Sentence
forall n. NamedIdea n => n -> Sentence
plural CI
requirement,
  CI -> Sentence
forall n. NamedIdea n => n -> Sentence
plural CI
likelyChg, NP -> Sentence
forall n. NounPhrase n => n -> Sentence
pluralNP (CI
unlikelyChg CI -> CI -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`NC.onThePP` CI
assumption)]
  (CI -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize' CI
assumption Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"and Other" Sentence -> Sentence -> Sentence
+:+ IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize' IdeaDict
item) [TraceViewCat
tvAssumps]
  [TraceViewCat
tvDataDefns, TraceViewCat
tvTheoryModels, TraceViewCat
tvGenDefns, TraceViewCat
tvInsModels, TraceViewCat
tvReqs, TraceViewCat
tvChanges]

-- | Refinement of the traceability matrix.
traceMatRefinement :: TraceConfig
traceMatRefinement :: TraceConfig
traceMatRefinement = UID
-> [Sentence]
-> Sentence
-> [TraceViewCat]
-> [TraceViewCat]
-> TraceConfig
TraceConfig (String -> UID
mkUid String
"TraceMatRefvsRef") [CI -> Sentence
forall n. NamedIdea n => n -> Sentence
plural CI
Doc.dataDefn,
  CI -> Sentence
forall n. NamedIdea n => n -> Sentence
plural CI
Doc.thModel, CI -> Sentence
forall n. NamedIdea n => n -> Sentence
plural CI
Doc.genDefn, CI -> Sentence
forall n. NamedIdea n => n -> Sentence
plural CI
Doc.inModel Sentence -> Sentence -> Sentence
+:+
  String -> Sentence
S String
"on each other"] (IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize' IdeaDict
item Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"and Other" Sentence -> Sentence -> Sentence
+:+ IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize' IdeaDict
section_)
  [TraceViewCat
tvDataDefns, TraceViewCat
tvTheoryModels, TraceViewCat
tvGenDefns, TraceViewCat
tvInsModels]
  [TraceViewCat
tvDataDefns, TraceViewCat
tvTheoryModels, TraceViewCat
tvGenDefns, TraceViewCat
tvInsModels]

-- | Records other requirements. Converts the 'SystemInformation' into a 'TraceConfig'.
traceMatOtherReq :: SystemInformation -> TraceConfig
traceMatOtherReq :: SystemInformation -> TraceConfig
traceMatOtherReq SystemInformation
si = UID
-> [Sentence]
-> Sentence
-> [TraceViewCat]
-> [TraceViewCat]
-> TraceConfig
TraceConfig (String -> UID
mkUid String
"TraceMatAllvsR") [CI -> Sentence
forall n. NamedIdea n => n -> Sentence
plural CI
requirement
  Sentence -> Sentence -> Sentence
`S.and_` NP -> Sentence
forall n. NounPhrase n => n -> Sentence
pluralNP (CI
goalStmt CI -> CI -> NP
forall c d. (NamedIdea c, NamedIdea d) => c -> d -> NP
`NC.onThePP` CI
Doc.dataDefn), CI -> Sentence
forall n. NamedIdea n => n -> Sentence
plural CI
Doc.thModel, 
  CI -> Sentence
forall n. NamedIdea n => n -> Sentence
plural CI
Doc.genDefn, CI -> Sentence
forall n. NamedIdea n => n -> Sentence
plural CI
Doc.inModel] ((CI -> Sentence) -> Sentence
x CI -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize' Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"and Other" Sentence -> Sentence -> Sentence
+:+ 
  IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
titleize' IdeaDict
item) [TraceViewCat
tvDataDefns, TraceViewCat
tvTheoryModels, TraceViewCat
tvGenDefns, TraceViewCat
tvInsModels, TraceViewCat
tvReqs] 
  [TraceViewCat
tvGoals, TraceViewCat
tvReqs] where
    x :: (CI -> Sentence) -> Sentence
x CI -> Sentence
g = (Sentence -> (TraceViewCat, CI) -> Sentence)
-> Sentence -> [(TraceViewCat, CI)] -> Sentence
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Sentence
a (TraceViewCat
f,CI
t) -> Sentence
a Sentence -> Sentence -> Sentence
`sC'` case ([UID] -> [UID]) -> ChunkDB -> [UID]
traceMReferrers (TraceViewCat -> ChunkDB -> [UID] -> [UID]
forall a b c. (a -> b -> c) -> b -> a -> c
flip TraceViewCat
f (ChunkDB -> [UID] -> [UID]) -> ChunkDB -> [UID] -> [UID]
forall a b. (a -> b) -> a -> b
$ SystemInformation -> ChunkDB
_sysinfodb SystemInformation
si) (ChunkDB -> [UID]) -> ChunkDB -> [UID]
forall a b. (a -> b) -> a -> b
$
      SystemInformation -> ChunkDB
_sysinfodb SystemInformation
si of
      [] -> Sentence
forall a. Monoid a => a
mempty
      [UID]
_ -> CI -> Sentence
g CI
t) Sentence
forall a. Monoid a => a
mempty [(TraceViewCat
tvReqs, CI
requirement), (TraceViewCat
tvGoals, CI
goalStmt)]
    sC' :: Sentence -> Sentence -> Sentence
sC' Sentence
EmptyS Sentence
b = Sentence
b
    sC' Sentence
a Sentence
EmptyS = Sentence
a
    sC' Sentence
a Sentence
b = Sentence -> Sentence -> Sentence
sC Sentence
a Sentence
b

-- | Helpers to check if given argument has more than one peice of information


-- | Contains traceability matrix assumptions, other assumptions, refinement, and other requirements.
traceMatStandard :: SystemInformation -> [TraceConfig]
traceMatStandard :: SystemInformation -> [TraceConfig]
traceMatStandard SystemInformation
s = ((SystemInformation -> TraceConfig) -> TraceConfig)
-> [SystemInformation -> TraceConfig] -> [TraceConfig]
forall a b. (a -> b) -> [a] -> [b]
map ((SystemInformation -> TraceConfig)
-> SystemInformation -> TraceConfig
forall a b. (a -> b) -> a -> b
$ SystemInformation
s) [TraceConfig -> SystemInformation -> TraceConfig
forall a b. a -> b -> a
const TraceConfig
traceMatAssumpAssump, TraceConfig -> SystemInformation -> TraceConfig
forall a b. a -> b -> a
const TraceConfig
traceMatAssumpOther, TraceConfig -> SystemInformation -> TraceConfig
forall a b. a -> b -> a
const TraceConfig
traceMatRefinement,
  SystemInformation -> TraceConfig
traceMatOtherReq]