{-# LANGUAGE PostfixOperators #-}
-- | Defines functions to create traceability matrices in SRS documents.
module Drasil.DocumentLanguage.TraceabilityMatrix where

import Language.Drasil
import Database.Drasil hiding (cdb)
import SysInfo.Drasil hiding (purpose)
import qualified Language.Drasil.Sentence.Combinators as S

import Data.Drasil.Concepts.Documentation (purpose, component, dependency,
  item, reference, traceyMatrix)

import Drasil.DocumentLanguage.Definitions (helpToRefField)

import Data.Containers.ListUtils (nubOrd)

import Control.Lens ((^.), Getting)

import qualified Data.Map as Map

-- * Types

-- | Helper type that takes two sets of 'UID's and a 'ChunkDB'.
type TraceViewCat = [UID] -> ChunkDB -> [UID]

-- * Main Functions

-- | Generalized traceability matrix introduction: appends references to the traceability matrices in 'Sentence' form
-- and wraps in 'Contents'. Usually references the four tables generally found in this section (in order of being mentioned).
traceMIntro :: [LabelledContent] -> [Sentence] -> Contents
traceMIntro :: [LabelledContent] -> [Sentence] -> Contents
traceMIntro [LabelledContent]
refs [Sentence]
trailings = UnlabelledContent -> Contents
UlC (UnlabelledContent -> Contents) -> UnlabelledContent -> Contents
forall a b. (a -> b) -> a -> b
$ RawContent -> UnlabelledContent
ulcc (RawContent -> UnlabelledContent)
-> RawContent -> UnlabelledContent
forall a b. (a -> b) -> a -> b
$ Sentence -> RawContent
Paragraph (Sentence -> RawContent) -> Sentence -> RawContent
forall a b. (a -> b) -> a -> b
$ [Sentence] -> Sentence
foldlSent [IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
purpose
        Sentence -> Sentence -> Sentence
`S.the_ofTheC` IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
plural IdeaDict
traceyMatrix, String -> Sentence
S String
"is to provide easy", IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
plural IdeaDict
reference, 
        String -> Sentence
S String
"on what has to be additionally modified if a certain",
        IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
component, String -> Sentence
S String
"is changed. Every time a", IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
component, 
        String -> Sentence
S String
"is changed, the", IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
plural IdeaDict
item, String -> Sentence
S String
"in the column of that", 
        IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
component, String -> Sentence
S String
"that are marked with an", Sentence -> Sentence
Quote (String -> Sentence
S String
"X"), 
        String -> Sentence
S String
"should be modified as well"] Sentence -> Sentence -> Sentence
+:+ [Sentence] -> Sentence
foldlSent_ ((LabelledContent -> Sentence -> Sentence)
-> [LabelledContent] -> [Sentence] -> [Sentence]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith LabelledContent -> Sentence -> Sentence
forall a.
(Referable a, HasShortName a) =>
a -> Sentence -> Sentence
tableShows [LabelledContent]
refs [Sentence]
trailings)

-- | Generates a traceability table. Takes a 'UID' for the table, a description ('Sentence'), columns ('TraceViewCat'), rows ('TraceViewCat'), and 'SystemInformation'.
generateTraceTableView :: UID -> Sentence -> [TraceViewCat] -> [TraceViewCat] -> SystemInformation -> LabelledContent
generateTraceTableView :: UID
-> Sentence
-> [TraceViewCat]
-> [TraceViewCat]
-> SystemInformation
-> LabelledContent
generateTraceTableView UID
u Sentence
desc [TraceViewCat]
cols [TraceViewCat]
rows SystemInformation
c = Reference -> RawContent -> LabelledContent
llcc (UID -> Reference
makeTabRef' UID
u) (RawContent -> LabelledContent) -> RawContent -> LabelledContent
forall a b. (a -> b) -> a -> b
$ [Sentence] -> [[Sentence]] -> Sentence -> Bool -> RawContent
Table 
  (Sentence
EmptyS Sentence -> [Sentence] -> [Sentence]
forall a. a -> [a] -> [a]
: ([UID] -> [UID]) -> SystemInformation -> [Sentence]
traceMColHeader [UID] -> [UID]
colf SystemInformation
c) 
  ([Sentence] -> [[UID]] -> [UID] -> [[Sentence]]
forall a. Eq a => [Sentence] -> [[a]] -> [a] -> [[Sentence]]
makeTMatrix (([UID] -> [UID]) -> SystemInformation -> [Sentence]
traceMRowHeader [UID] -> [UID]
rowf SystemInformation
c) (([UID] -> [UID]) -> ([UID] -> [UID]) -> ChunkDB -> [[UID]]
traceMColumns [UID] -> [UID]
colf [UID] -> [UID]
rowf ChunkDB
cdb) ([UID] -> [[Sentence]]) -> [UID] -> [[Sentence]]
forall a b. (a -> b) -> a -> b
$ ([UID] -> [UID]) -> ChunkDB -> [UID]
traceMReferees [UID] -> [UID]
colf ChunkDB
cdb)
  (IdeaDict -> Sentence -> Sentence
forall c. NamedIdea c => c -> Sentence -> Sentence
showingCxnBw IdeaDict
traceyMatrix Sentence
desc) Bool
True
    where
    cdb :: ChunkDB
cdb = SystemInformation -> ChunkDB
_sysinfodb SystemInformation
c
    colf :: [UID] -> [UID]
colf = [TraceViewCat] -> ChunkDB -> [UID] -> [UID]
layoutUIDs [TraceViewCat]
cols ChunkDB
cdb
    rowf :: [UID] -> [UID]
rowf = [TraceViewCat] -> ChunkDB -> [UID] -> [UID]
layoutUIDs [TraceViewCat]
rows ChunkDB
cdb

-- * Helper Functions

-- | Helper that finds the traceability matrix references (things being referenced).
traceMReferees :: ([UID] -> [UID]) -> ChunkDB -> [UID]
traceMReferees :: ([UID] -> [UID]) -> ChunkDB -> [UID]
traceMReferees [UID] -> [UID]
f = [UID] -> [UID]
f ([UID] -> [UID]) -> (ChunkDB -> [UID]) -> ChunkDB -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UID] -> [UID]
forall a. Ord a => [a] -> [a]
nubOrd ([UID] -> [UID]) -> (ChunkDB -> [UID]) -> ChunkDB -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map UID [UID] -> [UID]
forall k a. Map k a -> [k]
Map.keys (Map UID [UID] -> [UID])
-> (ChunkDB -> Map UID [UID]) -> ChunkDB -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChunkDB
-> Getting (Map UID [UID]) ChunkDB (Map UID [UID]) -> Map UID [UID]
forall s a. s -> Getting a s a -> a
^. Getting (Map UID [UID]) ChunkDB (Map UID [UID])
Lens' ChunkDB (Map UID [UID])
refbyTable)

-- | Helper that finds the traceability matrix references (things that are referring to other things).
traceMReferrers :: ([UID] -> [UID]) -> ChunkDB -> [UID]
traceMReferrers :: ([UID] -> [UID]) -> ChunkDB -> [UID]
traceMReferrers [UID] -> [UID]
f = [UID] -> [UID]
f ([UID] -> [UID]) -> (ChunkDB -> [UID]) -> ChunkDB -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UID] -> [UID]
forall a. Ord a => [a] -> [a]
nubOrd ([UID] -> [UID]) -> (ChunkDB -> [UID]) -> ChunkDB -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[UID]] -> [UID]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[UID]] -> [UID]) -> (ChunkDB -> [[UID]]) -> ChunkDB -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map UID [UID] -> [[UID]]
forall k a. Map k a -> [a]
Map.elems (Map UID [UID] -> [[UID]])
-> (ChunkDB -> Map UID [UID]) -> ChunkDB -> [[UID]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChunkDB
-> Getting (Map UID [UID]) ChunkDB (Map UID [UID]) -> Map UID [UID]
forall s a. s -> Getting a s a -> a
^. Getting (Map UID [UID]) ChunkDB (Map UID [UID])
Lens' ChunkDB (Map UID [UID])
refbyTable)

-- | Helper that finds the header of a traceability matrix.
traceMHeader :: (ChunkDB -> [UID]) -> SystemInformation -> [Sentence]
traceMHeader :: (ChunkDB -> [UID]) -> SystemInformation -> [Sentence]
traceMHeader ChunkDB -> [UID]
f SystemInformation
c = (UID -> Sentence) -> [UID] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map (UID -> SystemInformation -> Sentence
`helpToRefField` SystemInformation
c) ([UID] -> [Sentence]) -> [UID] -> [Sentence]
forall a b. (a -> b) -> a -> b
$ ChunkDB -> [UID]
f (ChunkDB -> [UID]) -> ChunkDB -> [UID]
forall a b. (a -> b) -> a -> b
$ SystemInformation -> ChunkDB
_sysinfodb SystemInformation
c

-- | Helper that finds the headers of the traceability matrix columns.
traceMColHeader :: ([UID] -> [UID]) -> SystemInformation -> [Sentence]
traceMColHeader :: ([UID] -> [UID]) -> SystemInformation -> [Sentence]
traceMColHeader [UID] -> [UID]
f = (ChunkDB -> [UID]) -> SystemInformation -> [Sentence]
traceMHeader (([UID] -> [UID]) -> ChunkDB -> [UID]
traceMReferees [UID] -> [UID]
f)

-- | Helper that finds the headers of the traceability matrix rows.
traceMRowHeader :: ([UID] -> [UID]) -> SystemInformation -> [Sentence]
traceMRowHeader :: ([UID] -> [UID]) -> SystemInformation -> [Sentence]
traceMRowHeader [UID] -> [UID]
f = (ChunkDB -> [UID]) -> SystemInformation -> [Sentence]
traceMHeader (([UID] -> [UID]) -> ChunkDB -> [UID]
traceMReferrers [UID] -> [UID]
f)

-- | Helper that makes the columns of a traceability matrix.
traceMColumns :: ([UID] -> [UID]) -> ([UID] -> [UID]) -> ChunkDB -> [[UID]]
traceMColumns :: ([UID] -> [UID]) -> ([UID] -> [UID]) -> ChunkDB -> [[UID]]
traceMColumns [UID] -> [UID]
fc [UID] -> [UID]
fr ChunkDB
c = (UID -> [UID]) -> [UID] -> [[UID]]
forall a b. (a -> b) -> [a] -> [b]
map ((\[UID]
u -> (UID -> Bool) -> [UID] -> [UID]
forall a. (a -> Bool) -> [a] -> [a]
filter (UID -> [UID] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [UID]
u) ([UID] -> [UID]) -> [UID] -> [UID]
forall a b. (a -> b) -> a -> b
$ [UID] -> [UID]
fc [UID]
u) ([UID] -> [UID]) -> (UID -> [UID]) -> UID -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UID -> Map UID [UID] -> [UID]) -> Map UID [UID] -> UID -> [UID]
forall a b c. (a -> b -> c) -> b -> a -> c
flip UID -> Map UID [UID] -> [UID]
traceLookup (ChunkDB
c ChunkDB
-> Getting (Map UID [UID]) ChunkDB (Map UID [UID]) -> Map UID [UID]
forall s a. s -> Getting a s a -> a
^. Getting (Map UID [UID]) ChunkDB (Map UID [UID])
Lens' ChunkDB (Map UID [UID])
traceTable)) ([UID] -> [[UID]]) -> [UID] -> [[UID]]
forall a b. (a -> b) -> a -> b
$ ([UID] -> [UID]) -> ChunkDB -> [UID]
traceMReferrers [UID] -> [UID]
fr ChunkDB
c

-- | Helper that makes references of the form "@reference@ shows the dependencies of @something@".
tableShows :: (Referable a, HasShortName a) => a -> Sentence -> Sentence
tableShows :: forall a.
(Referable a, HasShortName a) =>
a -> Sentence -> Sentence
tableShows a
r Sentence
end = a -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS a
r Sentence -> Sentence -> Sentence
+:+ String -> Sentence
S String
"shows the" Sentence -> Sentence -> Sentence
+:+ IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
plural IdeaDict
dependency Sentence -> Sentence -> Sentence
`S.ofThe` (Sentence
end !.)

-- | Helper that finds the layout 'UID's of a traceability matrix.
layoutUIDs :: [TraceViewCat] -> ChunkDB -> [UID] -> [UID]
layoutUIDs :: [TraceViewCat] -> ChunkDB -> [UID] -> [UID]
layoutUIDs [TraceViewCat]
a ChunkDB
c [UID]
e = (TraceViewCat -> [UID]) -> [TraceViewCat] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((UID -> Bool) -> [UID] -> [UID]
forall a. (a -> Bool) -> [a] -> [a]
filter (UID -> [UID] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Map UID [UID] -> [UID]
forall k a. Map k a -> [k]
Map.keys (Map UID [UID] -> [UID]) -> Map UID [UID] -> [UID]
forall a b. (a -> b) -> a -> b
$ ChunkDB
c ChunkDB
-> Getting (Map UID [UID]) ChunkDB (Map UID [UID]) -> Map UID [UID]
forall s a. s -> Getting a s a -> a
^. Getting (Map UID [UID]) ChunkDB (Map UID [UID])
Lens' ChunkDB (Map UID [UID])
traceTable)) ([UID] -> [UID])
-> (TraceViewCat -> [UID]) -> TraceViewCat -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\ TraceViewCat
x -> TraceViewCat
x [UID]
e ChunkDB
c)) [TraceViewCat]
a

-- | Helper that filters a traceability matrix given a predicate and a 'ChunkDB' lens field.
traceViewFilt :: HasUID a => (a -> Bool) -> Getting (UMap a) ChunkDB (UMap a) -> TraceViewCat
traceViewFilt :: forall a.
HasUID a =>
(a -> Bool) -> Getting (UMap a) ChunkDB (UMap a) -> TraceViewCat
traceViewFilt a -> Bool
f Getting (UMap a) ChunkDB (UMap a)
table [UID]
_ = (a -> UID) -> [a] -> [UID]
forall a b. (a -> b) -> [a] -> [b]
map (a -> Getting UID a UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID a UID
forall c. HasUID c => Getter c UID
Getter a UID
uid) ([a] -> [UID]) -> (ChunkDB -> [a]) -> ChunkDB -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
f ([a] -> [a]) -> (ChunkDB -> [a]) -> ChunkDB -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UMap a -> [a]
forall a. UMap a -> [a]
asOrderedList (UMap a -> [a]) -> (ChunkDB -> UMap a) -> ChunkDB -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChunkDB -> Getting (UMap a) ChunkDB (UMap a) -> UMap a
forall s a. s -> Getting a s a -> a
^. Getting (UMap a) ChunkDB (UMap a)
table)

-- | Helper that is similar to 'traceViewFilt', but the filter is always 'True'.
traceView :: HasUID a => Getting (UMap a) ChunkDB (UMap a) -> TraceViewCat
traceView :: forall a.
HasUID a =>
Getting (UMap a) ChunkDB (UMap a) -> TraceViewCat
traceView = (a -> Bool) -> Getting (UMap a) ChunkDB (UMap a) -> TraceViewCat
forall a.
HasUID a =>
(a -> Bool) -> Getting (UMap a) ChunkDB (UMap a) -> TraceViewCat
traceViewFilt (Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True)

-- | Turns a 'Concept' into a 'TraceViewCat' via its domain.
traceViewCC :: Concept c => c -> TraceViewCat
traceViewCC :: forall c. Concept c => c -> TraceViewCat
traceViewCC c
dom [UID]
u ChunkDB
c = (ConceptInstance -> Bool)
-> Getting (UMap ConceptInstance) ChunkDB (UMap ConceptInstance)
-> TraceViewCat
forall a.
HasUID a =>
(a -> Bool) -> Getting (UMap a) ChunkDB (UMap a) -> TraceViewCat
traceViewFilt (UID -> UID -> Bool
isDomUnder (c
dom c -> Getting UID c UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID c UID
forall c. HasUID c => Getter c UID
Getter c UID
uid) (UID -> Bool)
-> (ConceptInstance -> UID) -> ConceptInstance -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [UID] -> UID
sDom ([UID] -> UID)
-> (ConceptInstance -> [UID]) -> ConceptInstance -> UID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConceptInstance -> [UID]
forall c. ConceptDomain c => c -> [UID]
cdom) Getting (UMap ConceptInstance) ChunkDB (UMap ConceptInstance)
Lens' ChunkDB (UMap ConceptInstance)
conceptinsTable [UID]
u ChunkDB
c
  where
    isDomUnder :: UID -> UID -> Bool
    isDomUnder :: UID -> UID -> Bool
isDomUnder UID
filtDom UID
curr
      | UID
filtDom UID -> UID -> Bool
forall a. Eq a => a -> a -> Bool
== UID
curr = Bool
True
      | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [UID] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([UID] -> Bool) -> [UID] -> Bool
forall a b. (a -> b) -> a -> b
$ UID -> [UID]
getDom UID
curr = UID -> UID -> Bool
isDomUnder UID
filtDom ([UID] -> UID
sDom ([UID] -> UID) -> [UID] -> UID
forall a b. (a -> b) -> a -> b
$ UID -> [UID]
getDom UID
curr)
      | Bool
otherwise = Bool
False
    getDom :: UID -> [UID]
    getDom :: UID -> [UID]
getDom UID
curr = ConceptChunk -> [UID]
forall c. ConceptDomain c => c -> [UID]
cdom (ConceptChunk -> [UID]) -> ConceptChunk -> [UID]
forall a b. (a -> b) -> a -> b
$ ChunkDB -> UID -> ConceptChunk
defResolve ChunkDB
c UID
curr