{-# LANGUAGE PostfixOperators, TupleSections #-}
-- | Defines functions to create traceability graphs in SRS documents.
module Drasil.DocumentLanguage.TraceabilityGraph where

import Language.Drasil
import Database.Drasil hiding (cdb)
import SysInfo.Drasil hiding (purpose)
import Control.Lens ((^.))
import qualified Data.Map as Map
import Drasil.DocumentLanguage.TraceabilityMatrix (TraceViewCat, traceMReferees, traceMReferrers,
  traceMColumns, layoutUIDs, traceMIntro)
import Drasil.Sections.TraceabilityMandGs (tvAssumps,
  tvDataDefns, tvGenDefns, tvTheoryModels, tvInsModels, tvGoals, tvReqs,
  tvChanges)
import qualified Drasil.DocLang.SRS as SRS
import Language.Drasil.Printers (GraphInfo(..), NodeFamily(..))
import Data.Maybe (fromMaybe)
import Data.Drasil.Concepts.Math (graph)
import Data.Drasil.Concepts.Documentation (traceyGraph, component, dependency, reference, purpose, traceyMatrix)
import qualified Language.Drasil.Sentence.Combinators as S
import Data.Char (toLower)
import Drasil.Sections.ReferenceMaterial (emptySectSentPlu)

-- * Main Functions

-- | Wrapper for 'traceMIntro' and 'traceGIntro'. Turns references ('LabelledContent's),
-- trailing notes ('Sentence's), and any other needed contents to create a Traceability 'Section'.
-- Traceability graphs generate as both a link and a figure for convenience.
traceMGF :: [LabelledContent] -> [Sentence] -> [Contents] -> String -> [Section] -> Section
traceMGF :: [LabelledContent]
-> [Sentence] -> [Contents] -> String -> [Section] -> Section
traceMGF [] [] [] String
_ = [Contents] -> [Section] -> Section
SRS.traceyMandG [Sentence -> Contents
mkParagraph (Sentence -> Contents) -> Sentence -> Contents
forall a b. (a -> b) -> a -> b
$ [IdeaDict] -> Sentence
forall n. NamedIdea n => [n] -> Sentence
emptySectSentPlu [IdeaDict
traceyMatrix, IdeaDict
traceyGraph]]
traceMGF [LabelledContent]
refs [Sentence]
trailing [Contents]
otherContents String
ex = [Contents] -> [Section] -> Section
SRS.traceyMandG ([LabelledContent] -> [Sentence] -> Contents
traceMIntro [LabelledContent]
refs [Sentence]
trailing Contents -> [Contents] -> [Contents]
forall a. a -> [a] -> [a]
: [Contents]
otherContents
  [Contents] -> [Contents] -> [Contents]
forall a. [a] -> [a] -> [a]
++ (UnlabelledContent -> Contents)
-> [UnlabelledContent] -> [Contents]
forall a b. (a -> b) -> [a] -> [b]
map UnlabelledContent -> Contents
UlC ([UID] -> [Sentence] -> [UnlabelledContent]
traceGIntro [UID]
traceGUIDs ([Sentence]
trailing [Sentence] -> [Sentence] -> [Sentence]
forall a. [a] -> [a] -> [a]
++ [Sentence
allvsallDesc])) [Contents] -> [Contents] -> [Contents]
forall a. [a] -> [a] -> [a]
++ String -> [Contents]
traceGCon String
ex)

-- | Generalized traceability graph introduction: appends references to the traceability graphs in 'Sentence' form
-- and wraps in 'Contents'. Usually references the five graphs as defined in 'GraphInfo'.
traceGIntro :: [UID] -> [Sentence] -> [UnlabelledContent]
traceGIntro :: [UID] -> [Sentence] -> [UnlabelledContent]
traceGIntro [UID]
refs [Sentence]
trailings = [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
traceyGraph,
        String -> Sentence
S String
"is also to provide easy", IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
plural IdeaDict
reference, String -> Sentence
S String
"on what has to be",
        String -> Sentence
S String
"additionally modified if a certain", IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
component Sentence -> Sentence -> Sentence
+:+. String -> Sentence
S String
"is changed",
        String -> Sentence
S String
"The arrows in the", ConceptChunk -> Sentence
forall n. NamedIdea n => n -> Sentence
plural ConceptChunk
graph, String -> Sentence
S String
"represent" Sentence -> Sentence -> Sentence
+:+. IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
plural IdeaDict
dependency,
        String -> Sentence
S String
"The", IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
component, String -> Sentence
S String
"at the tail of an arrow is depended on by the",
        IdeaDict -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase IdeaDict
component, String -> Sentence
S String
"at the head of that arrow. Therefore, if 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
component, String -> Sentence
S String
"that it points to should also be changed"] Sentence -> Sentence -> Sentence
+:+
        [Sentence] -> Sentence
foldlSent_ ((UID -> Sentence -> Sentence) -> [UID] -> [Sentence] -> [Sentence]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith UID -> Sentence -> Sentence
graphShows [UID]
refs [Sentence]
trailings)]

-- | Extracts traceability graph inforomation from filled-in 'SystemInformation'.
mkGraphInfo :: SystemInformation -> GraphInfo
mkGraphInfo :: SystemInformation -> GraphInfo
mkGraphInfo SystemInformation
si = GI {
    assumpNF :: NodeFamily
assumpNF = TraceViewCat -> SystemInformation -> String -> NodeFamily
mkGraphNodes TraceViewCat
tvAssumps SystemInformation
si String
"mistyrose"
    , ddNF :: NodeFamily
ddNF     = TraceViewCat -> SystemInformation -> String -> NodeFamily
mkGraphNodes TraceViewCat
tvDataDefns SystemInformation
si String
"paleturquoise1"
    , gdNF :: NodeFamily
gdNF     = TraceViewCat -> SystemInformation -> String -> NodeFamily
mkGraphNodes TraceViewCat
tvGenDefns SystemInformation
si String
"palegreen"
    , tmNF :: NodeFamily
tmNF     = TraceViewCat -> SystemInformation -> String -> NodeFamily
mkGraphNodes TraceViewCat
tvTheoryModels SystemInformation
si String
"pink"
    , imNF :: NodeFamily
imNF     = TraceViewCat -> SystemInformation -> String -> NodeFamily
mkGraphNodes TraceViewCat
tvInsModels SystemInformation
si String
"khaki1"
    , reqNF :: NodeFamily
reqNF    = TraceViewCat -> SystemInformation -> String -> NodeFamily
mkGraphNodes TraceViewCat
tvReqs SystemInformation
si String
"ivory"
    , gsNF :: NodeFamily
gsNF     = TraceViewCat -> SystemInformation -> String -> NodeFamily
mkGraphNodes TraceViewCat
tvGoals SystemInformation
si String
"darkgoldenrod1"
    , chgNF :: NodeFamily
chgNF    = TraceViewCat -> SystemInformation -> String -> NodeFamily
mkGraphNodes TraceViewCat
tvChanges SystemInformation
si String
"lavender"

    , edgesAvsA :: [(UID, [UID])]
edgesAvsA     = [TraceViewCat]
-> [TraceViewCat] -> SystemInformation -> [(UID, [UID])]
mkGraphEdges [TraceViewCat
tvAssumps] [TraceViewCat
tvAssumps] SystemInformation
si
    , edgesAvsAll :: [(UID, [UID])]
edgesAvsAll   = [TraceViewCat]
-> [TraceViewCat] -> SystemInformation -> [(UID, [UID])]
mkGraphEdges [TraceViewCat
tvAssumps] [TraceViewCat
tvDataDefns, TraceViewCat
tvTheoryModels, TraceViewCat
tvGenDefns, TraceViewCat
tvInsModels, TraceViewCat
tvReqs, TraceViewCat
tvChanges] SystemInformation
si
    , edgesRefvsRef :: [(UID, [UID])]
edgesRefvsRef = [TraceViewCat]
-> [TraceViewCat] -> SystemInformation -> [(UID, [UID])]
mkGraphEdges [TraceViewCat
tvDataDefns, TraceViewCat
tvTheoryModels, TraceViewCat
tvGenDefns, TraceViewCat
tvInsModels] [TraceViewCat
tvDataDefns, TraceViewCat
tvTheoryModels, TraceViewCat
tvGenDefns, TraceViewCat
tvInsModels] SystemInformation
si
    , edgesAllvsR :: [(UID, [UID])]
edgesAllvsR   = [TraceViewCat]
-> [TraceViewCat] -> SystemInformation -> [(UID, [UID])]
mkGraphEdges [TraceViewCat
tvDataDefns, TraceViewCat
tvTheoryModels,TraceViewCat
tvGenDefns, TraceViewCat
tvInsModels, TraceViewCat
tvReqs] [TraceViewCat
tvGoals, TraceViewCat
tvReqs] SystemInformation
si
    , edgesAllvsAll :: [(UID, [UID])]
edgesAllvsAll = [TraceViewCat]
-> [TraceViewCat] -> SystemInformation -> [(UID, [UID])]
mkGraphEdges [TraceViewCat
tvAssumps, TraceViewCat
tvDataDefns, TraceViewCat
tvTheoryModels, TraceViewCat
tvGenDefns, TraceViewCat
tvInsModels, TraceViewCat
tvReqs, TraceViewCat
tvGoals, TraceViewCat
tvChanges] [TraceViewCat
tvAssumps, TraceViewCat
tvDataDefns, TraceViewCat
tvTheoryModels, TraceViewCat
tvGenDefns, TraceViewCat
tvInsModels, TraceViewCat
tvReqs, TraceViewCat
tvGoals, TraceViewCat
tvChanges] SystemInformation
si
}

-- * Helper Functions

-- | Gets the node family of a graph based on the given section
-- and system information. Also applies a given colour to the node family.
mkGraphNodes :: TraceViewCat -> SystemInformation -> String -> NodeFamily
mkGraphNodes :: TraceViewCat -> SystemInformation -> String -> NodeFamily
mkGraphNodes TraceViewCat
entry SystemInformation
si String
col = NF {nodeUIDs :: [UID]
nodeUIDs = [UID]
nodeContents, nodeLabels :: [String]
nodeLabels = (UID -> String) -> [UID] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (SystemInformation -> UID -> String
checkUIDRefAdd SystemInformation
si) [UID]
nodeContents, nfLabel :: String
nfLabel = [UID] -> String
checkNodeContents [UID]
nodeContents, nfColour :: String
nfColour = String
col}
    where
        checkNodeContents :: [UID] -> String
        checkNodeContents :: [UID] -> String
checkNodeContents [] = String
""
        checkNodeContents (UID
x:[UID]
_) = SystemInformation -> UID -> String
checkUIDAbbrev SystemInformation
si UID
x
        nodeContents :: [UID]
nodeContents = ([UID] -> [UID]) -> ChunkDB -> [UID]
traceMReferees [UID] -> [UID]
entryF ChunkDB
cdb
        cdb :: ChunkDB
cdb = SystemInformation -> ChunkDB
_sysinfodb SystemInformation
si
        entryF :: [UID] -> [UID]
entryF = [TraceViewCat] -> ChunkDB -> [UID] -> [UID]
layoutUIDs [TraceViewCat
entry] ChunkDB
cdb

-- | Creates the graph edges based on the relation of the first list of sections to the second.
-- Also needs the system information. Return value is of the form (Section, [Dependencies]).
mkGraphEdges :: [TraceViewCat] -> [TraceViewCat] -> SystemInformation -> [(UID, [UID])]
mkGraphEdges :: [TraceViewCat]
-> [TraceViewCat] -> SystemInformation -> [(UID, [UID])]
mkGraphEdges [TraceViewCat]
cols [TraceViewCat]
rows SystemInformation
si = [UID] -> [[UID]] -> [UID] -> [(UID, [UID])]
makeTGraph (([UID] -> [UID]) -> SystemInformation -> [UID]
traceGRowHeader [UID] -> [UID]
rowf SystemInformation
si) (([UID] -> [UID]) -> ([UID] -> [UID]) -> ChunkDB -> [[UID]]
traceMColumns [UID] -> [UID]
colf [UID] -> [UID]
rowf ChunkDB
cdb) ([UID] -> [(UID, [UID])]) -> [UID] -> [(UID, [UID])]
forall a b. (a -> b) -> a -> b
$ ([UID] -> [UID]) -> ChunkDB -> [UID]
traceMReferees [UID] -> [UID]
colf ChunkDB
cdb
    where
        cdb :: ChunkDB
cdb = SystemInformation -> ChunkDB
_sysinfodb SystemInformation
si
        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 for making graph edges. Taken from Utils.Drasil's traceability matrix relation finder.
-- But, instead of marking "X" on two related ideas, it makes them an edge.
makeTGraph :: [UID] -> [[UID]] -> [UID] -> [(UID, [UID])]
makeTGraph :: [UID] -> [[UID]] -> [UID] -> [(UID, [UID])]
makeTGraph [UID]
rowName [[UID]]
rows [UID]
cols = [UID] -> [[UID]] -> [(UID, [UID])]
forall a b. [a] -> [b] -> [(a, b)]
zip [UID]
rowName [[UID] -> [UID] -> [UID]
forall {t :: * -> *} {a}. (Foldable t, Eq a) => t a -> [a] -> [a]
zipFTable' [UID]
x [UID]
cols | [UID]
x <- [[UID]]
rows]
  where
    zipFTable' :: t a -> [a] -> [a]
zipFTable' t a
content = (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> t a -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
content)

-- | Checker for uids by finding if the 'UID' is in one of the possible data sets contained in the 'SystemInformation' database.
checkUID :: UID -> SystemInformation -> UID
checkUID :: UID -> SystemInformation -> UID
checkUID UID
t SystemInformation
si
  | Just Int
_ <- UID -> Map UID (DataDefinition, Int) -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe Int
Map.lookupIndex UID
t (ChunkDB
s ChunkDB
-> Getting
     (Map UID (DataDefinition, Int))
     ChunkDB
     (Map UID (DataDefinition, Int))
-> Map UID (DataDefinition, Int)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map UID (DataDefinition, Int))
  ChunkDB
  (Map UID (DataDefinition, Int))
Lens' ChunkDB (Map UID (DataDefinition, Int))
dataDefnTable)        = UID
t
  | Just Int
_ <- UID -> Map UID (InstanceModel, Int) -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe Int
Map.lookupIndex UID
t (ChunkDB
s ChunkDB
-> Getting
     (Map UID (InstanceModel, Int))
     ChunkDB
     (Map UID (InstanceModel, Int))
-> Map UID (InstanceModel, Int)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map UID (InstanceModel, Int))
  ChunkDB
  (Map UID (InstanceModel, Int))
Lens' ChunkDB (Map UID (InstanceModel, Int))
insmodelTable)        = UID
t
  | Just Int
_ <- UID -> Map UID (GenDefn, Int) -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe Int
Map.lookupIndex UID
t (ChunkDB
s ChunkDB
-> Getting
     (Map UID (GenDefn, Int)) ChunkDB (Map UID (GenDefn, Int))
-> Map UID (GenDefn, Int)
forall s a. s -> Getting a s a -> a
^. Getting (Map UID (GenDefn, Int)) ChunkDB (Map UID (GenDefn, Int))
Lens' ChunkDB (Map UID (GenDefn, Int))
gendefTable)          = UID
t
  | Just Int
_ <- UID -> Map UID (TheoryModel, Int) -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe Int
Map.lookupIndex UID
t (ChunkDB
s ChunkDB
-> Getting
     (Map UID (TheoryModel, Int)) ChunkDB (Map UID (TheoryModel, Int))
-> Map UID (TheoryModel, Int)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map UID (TheoryModel, Int)) ChunkDB (Map UID (TheoryModel, Int))
Lens' ChunkDB (Map UID (TheoryModel, Int))
theoryModelTable)     = UID
t
  | Just Int
_ <- UID -> Map UID (ConceptInstance, Int) -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe Int
Map.lookupIndex UID
t (ChunkDB
s ChunkDB
-> Getting
     (Map UID (ConceptInstance, Int))
     ChunkDB
     (Map UID (ConceptInstance, Int))
-> Map UID (ConceptInstance, Int)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map UID (ConceptInstance, Int))
  ChunkDB
  (Map UID (ConceptInstance, Int))
Lens' ChunkDB (Map UID (ConceptInstance, Int))
conceptinsTable)      = UID
t
  | Just Int
_ <- UID -> Map UID (Section, Int) -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe Int
Map.lookupIndex UID
t (ChunkDB
s ChunkDB
-> Getting
     (Map UID (Section, Int)) ChunkDB (Map UID (Section, Int))
-> Map UID (Section, Int)
forall s a. s -> Getting a s a -> a
^. Getting (Map UID (Section, Int)) ChunkDB (Map UID (Section, Int))
Lens' ChunkDB (Map UID (Section, Int))
sectionTable)         = UID
t
  | Just Int
_ <- UID -> Map UID (LabelledContent, Int) -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe Int
Map.lookupIndex UID
t (ChunkDB
s ChunkDB
-> Getting
     (Map UID (LabelledContent, Int))
     ChunkDB
     (Map UID (LabelledContent, Int))
-> Map UID (LabelledContent, Int)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map UID (LabelledContent, Int))
  ChunkDB
  (Map UID (LabelledContent, Int))
Lens' ChunkDB (Map UID (LabelledContent, Int))
labelledcontentTable) = UID
t
  | UID
t UID -> [UID] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Citation -> UID) -> [Citation] -> [UID]
forall a b. (a -> b) -> [a] -> [b]
map  (Citation -> Getting UID Citation UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID Citation UID
forall c. HasUID c => Getter c UID
Getter Citation UID
uid) (SystemInformation -> [Citation]
citeDB SystemInformation
si) = String -> UID
mkUid String
""
  | Bool
otherwise = String -> UID
forall a. HasCallStack => String -> a
error (String -> UID) -> String -> UID
forall a b. (a -> b) -> a -> b
$ UID -> String
forall a. Show a => a -> String
show UID
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Caught."
  where s :: ChunkDB
s = SystemInformation -> ChunkDB
_sysinfodb SystemInformation
si

-- | Similar to 'checkUID' but prepends domain for labelling.
checkUIDAbbrev :: SystemInformation -> UID -> String
checkUIDAbbrev :: SystemInformation -> UID -> String
checkUIDAbbrev SystemInformation
si UID
t
  | Just (DataDefinition
x, Int
_) <- UID -> Map UID (DataDefinition, Int) -> Maybe (DataDefinition, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UID
t (ChunkDB
s ChunkDB
-> Getting
     (Map UID (DataDefinition, Int))
     ChunkDB
     (Map UID (DataDefinition, Int))
-> Map UID (DataDefinition, Int)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map UID (DataDefinition, Int))
  ChunkDB
  (Map UID (DataDefinition, Int))
Lens' ChunkDB (Map UID (DataDefinition, Int))
dataDefnTable)        = DataDefinition -> String
forall c. CommonIdea c => c -> String
abrv DataDefinition
x
  | Just (InstanceModel
x, Int
_) <- UID -> Map UID (InstanceModel, Int) -> Maybe (InstanceModel, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UID
t (ChunkDB
s ChunkDB
-> Getting
     (Map UID (InstanceModel, Int))
     ChunkDB
     (Map UID (InstanceModel, Int))
-> Map UID (InstanceModel, Int)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map UID (InstanceModel, Int))
  ChunkDB
  (Map UID (InstanceModel, Int))
Lens' ChunkDB (Map UID (InstanceModel, Int))
insmodelTable)        = InstanceModel -> String
forall c. CommonIdea c => c -> String
abrv InstanceModel
x
  | Just (GenDefn
x, Int
_) <- UID -> Map UID (GenDefn, Int) -> Maybe (GenDefn, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UID
t (ChunkDB
s ChunkDB
-> Getting
     (Map UID (GenDefn, Int)) ChunkDB (Map UID (GenDefn, Int))
-> Map UID (GenDefn, Int)
forall s a. s -> Getting a s a -> a
^. Getting (Map UID (GenDefn, Int)) ChunkDB (Map UID (GenDefn, Int))
Lens' ChunkDB (Map UID (GenDefn, Int))
gendefTable)          = GenDefn -> String
forall c. CommonIdea c => c -> String
abrv GenDefn
x
  | Just (TheoryModel
x, Int
_) <- UID -> Map UID (TheoryModel, Int) -> Maybe (TheoryModel, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UID
t (ChunkDB
s ChunkDB
-> Getting
     (Map UID (TheoryModel, Int)) ChunkDB (Map UID (TheoryModel, Int))
-> Map UID (TheoryModel, Int)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map UID (TheoryModel, Int)) ChunkDB (Map UID (TheoryModel, Int))
Lens' ChunkDB (Map UID (TheoryModel, Int))
theoryModelTable)     = TheoryModel -> String
forall c. CommonIdea c => c -> String
abrv TheoryModel
x
  | Just (ConceptInstance
x, Int
_) <- UID
-> Map UID (ConceptInstance, Int) -> Maybe (ConceptInstance, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UID
t (ChunkDB
s ChunkDB
-> Getting
     (Map UID (ConceptInstance, Int))
     ChunkDB
     (Map UID (ConceptInstance, Int))
-> Map UID (ConceptInstance, Int)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map UID (ConceptInstance, Int))
  ChunkDB
  (Map UID (ConceptInstance, Int))
Lens' ChunkDB (Map UID (ConceptInstance, Int))
conceptinsTable)      = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ ConceptChunk -> Maybe String
forall c. Idea c => c -> Maybe String
getA (ConceptChunk -> Maybe String) -> ConceptChunk -> Maybe String
forall a b. (a -> b) -> a -> b
$ ChunkDB -> UID -> ConceptChunk
defResolve ChunkDB
s (UID -> ConceptChunk) -> UID -> ConceptChunk
forall a b. (a -> b) -> a -> b
$ [UID] -> UID
sDom ([UID] -> UID) -> [UID] -> UID
forall a b. (a -> b) -> a -> b
$ ConceptInstance -> [UID]
forall c. ConceptDomain c => c -> [UID]
cdom ConceptInstance
x
  | Just (Section, Int)
_ <- UID -> Map UID (Section, Int) -> Maybe (Section, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UID
t (ChunkDB
s ChunkDB
-> Getting
     (Map UID (Section, Int)) ChunkDB (Map UID (Section, Int))
-> Map UID (Section, Int)
forall s a. s -> Getting a s a -> a
^. Getting (Map UID (Section, Int)) ChunkDB (Map UID (Section, Int))
Lens' ChunkDB (Map UID (Section, Int))
sectionTable)              = UID -> String
forall a. Show a => a -> String
show UID
t -- shouldn't really reach these cases
  | Just (LabelledContent, Int)
_ <- UID
-> Map UID (LabelledContent, Int) -> Maybe (LabelledContent, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UID
t (ChunkDB
s ChunkDB
-> Getting
     (Map UID (LabelledContent, Int))
     ChunkDB
     (Map UID (LabelledContent, Int))
-> Map UID (LabelledContent, Int)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map UID (LabelledContent, Int))
  ChunkDB
  (Map UID (LabelledContent, Int))
Lens' ChunkDB (Map UID (LabelledContent, Int))
labelledcontentTable)      = UID -> String
forall a. Show a => a -> String
show UID
t
  | UID
t UID -> [UID] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Citation -> UID) -> [Citation] -> [UID]
forall a b. (a -> b) -> [a] -> [b]
map  (Citation -> Getting UID Citation UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID Citation UID
forall c. HasUID c => Getter c UID
Getter Citation UID
uid) (SystemInformation -> [Citation]
citeDB SystemInformation
si) = String
""
  | Bool
otherwise = String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ UID -> String
forall a. Show a => a -> String
show UID
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Caught."
  where s :: ChunkDB
s = SystemInformation -> ChunkDB
_sysinfodb SystemInformation
si

-- | Similar to 'checkUID' but gets reference addresses for display.
checkUIDRefAdd :: SystemInformation -> UID -> String
checkUIDRefAdd :: SystemInformation -> UID -> String
checkUIDRefAdd SystemInformation
si UID
t
  | Just (DataDefinition
x, Int
_) <- UID -> Map UID (DataDefinition, Int) -> Maybe (DataDefinition, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UID
t (ChunkDB
s ChunkDB
-> Getting
     (Map UID (DataDefinition, Int))
     ChunkDB
     (Map UID (DataDefinition, Int))
-> Map UID (DataDefinition, Int)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map UID (DataDefinition, Int))
  ChunkDB
  (Map UID (DataDefinition, Int))
Lens' ChunkDB (Map UID (DataDefinition, Int))
dataDefnTable)        = LblType -> String
getAdd (LblType -> String) -> LblType -> String
forall a b. (a -> b) -> a -> b
$ DataDefinition -> LblType
forall b. HasRefAddress b => b -> LblType
getRefAdd DataDefinition
x
  | Just (InstanceModel
x, Int
_) <- UID -> Map UID (InstanceModel, Int) -> Maybe (InstanceModel, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UID
t (ChunkDB
s ChunkDB
-> Getting
     (Map UID (InstanceModel, Int))
     ChunkDB
     (Map UID (InstanceModel, Int))
-> Map UID (InstanceModel, Int)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map UID (InstanceModel, Int))
  ChunkDB
  (Map UID (InstanceModel, Int))
Lens' ChunkDB (Map UID (InstanceModel, Int))
insmodelTable)        = LblType -> String
getAdd (LblType -> String) -> LblType -> String
forall a b. (a -> b) -> a -> b
$ InstanceModel -> LblType
forall b. HasRefAddress b => b -> LblType
getRefAdd InstanceModel
x
  | Just (GenDefn
x, Int
_) <- UID -> Map UID (GenDefn, Int) -> Maybe (GenDefn, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UID
t (ChunkDB
s ChunkDB
-> Getting
     (Map UID (GenDefn, Int)) ChunkDB (Map UID (GenDefn, Int))
-> Map UID (GenDefn, Int)
forall s a. s -> Getting a s a -> a
^. Getting (Map UID (GenDefn, Int)) ChunkDB (Map UID (GenDefn, Int))
Lens' ChunkDB (Map UID (GenDefn, Int))
gendefTable)          = LblType -> String
getAdd (LblType -> String) -> LblType -> String
forall a b. (a -> b) -> a -> b
$ GenDefn -> LblType
forall b. HasRefAddress b => b -> LblType
getRefAdd GenDefn
x
  | Just (TheoryModel
x, Int
_) <- UID -> Map UID (TheoryModel, Int) -> Maybe (TheoryModel, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UID
t (ChunkDB
s ChunkDB
-> Getting
     (Map UID (TheoryModel, Int)) ChunkDB (Map UID (TheoryModel, Int))
-> Map UID (TheoryModel, Int)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map UID (TheoryModel, Int)) ChunkDB (Map UID (TheoryModel, Int))
Lens' ChunkDB (Map UID (TheoryModel, Int))
theoryModelTable)     = LblType -> String
getAdd (LblType -> String) -> LblType -> String
forall a b. (a -> b) -> a -> b
$ TheoryModel -> LblType
forall b. HasRefAddress b => b -> LblType
getRefAdd TheoryModel
x
  -- Concept instances can range from likely changes to non-functional requirements, so use domain abbreviations for labelling in addition to the reference address.
  | Just (ConceptInstance
x, Int
_) <- UID
-> Map UID (ConceptInstance, Int) -> Maybe (ConceptInstance, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UID
t (ChunkDB
s ChunkDB
-> Getting
     (Map UID (ConceptInstance, Int))
     ChunkDB
     (Map UID (ConceptInstance, Int))
-> Map UID (ConceptInstance, Int)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map UID (ConceptInstance, Int))
  ChunkDB
  (Map UID (ConceptInstance, Int))
Lens' ChunkDB (Map UID (ConceptInstance, Int))
conceptinsTable)      = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (ConceptChunk -> Maybe String
forall c. Idea c => c -> Maybe String
getA (ConceptChunk -> Maybe String) -> ConceptChunk -> Maybe String
forall a b. (a -> b) -> a -> b
$ ChunkDB -> UID -> ConceptChunk
defResolve ChunkDB
s (UID -> ConceptChunk) -> UID -> ConceptChunk
forall a b. (a -> b) -> a -> b
$ [UID] -> UID
sDom ([UID] -> UID) -> [UID] -> UID
forall a b. (a -> b) -> a -> b
$ ConceptInstance -> [UID]
forall c. ConceptDomain c => c -> [UID]
cdom ConceptInstance
x) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ LblType -> String
getAdd (ConceptInstance -> LblType
forall b. HasRefAddress b => b -> LblType
getRefAdd ConceptInstance
x)
  | Just (Section, Int)
_ <- UID -> Map UID (Section, Int) -> Maybe (Section, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UID
t (ChunkDB
s ChunkDB
-> Getting
     (Map UID (Section, Int)) ChunkDB (Map UID (Section, Int))
-> Map UID (Section, Int)
forall s a. s -> Getting a s a -> a
^. Getting (Map UID (Section, Int)) ChunkDB (Map UID (Section, Int))
Lens' ChunkDB (Map UID (Section, Int))
sectionTable)              = UID -> String
forall a. Show a => a -> String
show UID
t -- shouldn't really reach these cases
  | Just (LabelledContent, Int)
_ <- UID
-> Map UID (LabelledContent, Int) -> Maybe (LabelledContent, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup UID
t (ChunkDB
s ChunkDB
-> Getting
     (Map UID (LabelledContent, Int))
     ChunkDB
     (Map UID (LabelledContent, Int))
-> Map UID (LabelledContent, Int)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map UID (LabelledContent, Int))
  ChunkDB
  (Map UID (LabelledContent, Int))
Lens' ChunkDB (Map UID (LabelledContent, Int))
labelledcontentTable)      = UID -> String
forall a. Show a => a -> String
show UID
t
  | UID
t UID -> [UID] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Citation -> UID) -> [Citation] -> [UID]
forall a b. (a -> b) -> [a] -> [b]
map  (Citation -> Getting UID Citation UID -> UID
forall s a. s -> Getting a s a -> a
^. Getting UID Citation UID
forall c. HasUID c => Getter c UID
Getter Citation UID
uid) (SystemInformation -> [Citation]
citeDB SystemInformation
si) = String
""
  | Bool
otherwise = String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ UID -> String
forall a. Show a => a -> String
show UID
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Caught."
  where s :: ChunkDB
s = SystemInformation -> ChunkDB
_sysinfodb SystemInformation
si

-- | Helper that finds the header of a traceability matrix.
-- However, here we use this to get a list of 'UID's for a traceability graph instead.
traceGHeader :: (ChunkDB -> [UID]) -> SystemInformation -> [UID]
traceGHeader :: (ChunkDB -> [UID]) -> SystemInformation -> [UID]
traceGHeader ChunkDB -> [UID]
f SystemInformation
c = (UID -> UID) -> [UID] -> [UID]
forall a b. (a -> b) -> [a] -> [b]
map (UID -> SystemInformation -> UID
`checkUID` SystemInformation
c) ([UID] -> [UID]) -> [UID] -> [UID]
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 rows.
-- However, here we use this to get a list of 'UID's for a traceability graph instead.
-- This is then used to create the graph edges.
traceGRowHeader :: ([UID] -> [UID]) -> SystemInformation -> [UID]
traceGRowHeader :: ([UID] -> [UID]) -> SystemInformation -> [UID]
traceGRowHeader [UID] -> [UID]
f = (ChunkDB -> [UID]) -> SystemInformation -> [UID]
traceGHeader (([UID] -> [UID]) -> ChunkDB -> [UID]
traceMReferrers [UID] -> [UID]
f)

-- FIXME: Should take a Reference instead of just a Reference UID
-- | Helper that makes references of the form "@reference@ shows the dependencies of @something@". Only takes a reference `UID` instead of a `Reference`.
graphShows :: UID -> Sentence -> Sentence
graphShows :: UID -> Sentence -> Sentence
graphShows UID
r Sentence
end = Reference -> Sentence
forall r.
(HasUID r, HasRefAddress r, HasShortName r) =>
r -> Sentence
refS (UID -> Reference
makeFigRef' UID
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.of_` (Sentence
end !.)

-- * Functions to Create a Traceability Graphs
--
-- $createTraceyGraphs
--
-- Functions related to setting up the structure and contents of the traceability graphs section.

-- | Description of the @AllvsAll@ traceability graph.
allvsallDesc :: Sentence
allvsallDesc :: Sentence
allvsallDesc = String -> Sentence
S String
"dependencies of assumptions, models, definitions, requirements, goals, and changes with each other"

-- | Create a list of traceability graph references.
traceGLst :: Contents
traceGLst :: Contents
traceGLst = 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
$ ListType -> RawContent
Enumeration (ListType -> RawContent) -> ListType -> RawContent
forall a b. (a -> b) -> a -> b
$ [(ItemType, Maybe String)] -> ListType
Bullet ([(ItemType, Maybe String)] -> ListType)
-> [(ItemType, Maybe String)] -> ListType
forall a b. (a -> b) -> a -> b
$ (ItemType -> (ItemType, Maybe String))
-> [ItemType] -> [(ItemType, Maybe String)]
forall a b. (a -> b) -> [a] -> [b]
map (, Maybe String
forall a. Maybe a
Nothing) [ItemType]
folderList'

-- | The Traceability Graph contents.
traceGCon :: String -> [Contents]
traceGCon :: String -> [Contents]
traceGCon String
ex = (LabelledContent -> Contents) -> [LabelledContent] -> [Contents]
forall a b. (a -> b) -> [a] -> [b]
map LabelledContent -> Contents
LlC ((String -> UID -> LabelledContent)
-> [String] -> [UID] -> [LabelledContent]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (String -> String -> UID -> LabelledContent
traceGraphLC String
ex) [String]
traceGFiles [UID]
traceGUIDs) [Contents] -> [Contents] -> [Contents]
forall a. [a] -> [a] -> [a]
++ [Sentence -> Contents
mkParagraph (Sentence -> Contents) -> Sentence -> Contents
forall a b. (a -> b) -> a -> b
$ String -> Sentence
S String
"For convenience, the following graphs can be found at the links below:", Contents
traceGLst]

-- | Generates traceability graphs as figures on an SRS document.
traceGraphLC :: String -> FilePath -> UID -> LabelledContent
traceGraphLC :: String -> String -> UID -> LabelledContent
traceGraphLC String
ex String
fp UID
u = Reference -> RawContent -> LabelledContent
llcc (UID -> Reference
makeFigRef' UID
u) (RawContent -> LabelledContent) -> RawContent -> LabelledContent
forall a b. (a -> b) -> a -> b
$ Sentence -> String -> RawContent
fig (String -> Sentence
S (String -> Sentence) -> String -> Sentence
forall a b. (a -> b) -> a -> b
$ UID -> String
forall a. Show a => a -> String
show UID
u) (String -> String -> String
traceyGraphPath String
ex String
fp)

-- | Traceability graph file names.
traceGFiles :: [String]
-- | Traceabiliy graph reference 'UID's.
traceGUIDs :: [UID]
-- | Create reference paths to traceability graphs given an example name. For @.pdf@ links
traceyGraphPaths :: String -> [String]
-- | Create references to traceability graphs given an example name. Primarily used for reference database in examples.
traceyGraphGetRefs :: String -> [Reference]
-- | Gets the path of a traceability graph given an example folder name and the graph name. For @.png@ files
traceyGraphPath :: String -> String -> String

traceGFiles :: [String]
traceGFiles = [String
"avsa", String
"avsall", String
"refvsref", String
"allvsr", String
"allvsall"]
traceGUIDs :: [UID]
traceGUIDs = (String -> UID) -> [String] -> [UID]
forall a b. (a -> b) -> [a] -> [b]
map String -> UID
mkUid [String
"TraceGraphAvsA", String
"TraceGraphAvsAll", String
"TraceGraphRefvsRef", String
"TraceGraphAllvsR", String
"TraceGraphAllvsAll"]
traceyGraphPaths :: String -> [String]
traceyGraphPaths String
ex = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\String
x -> String
resourcePath String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
ex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".svg") [String]
traceGFiles
traceyGraphGetRefs :: String -> [Reference]
traceyGraphGetRefs String
ex = (UID -> Reference) -> [UID] -> [Reference]
forall a b. (a -> b) -> [a] -> [b]
map UID -> Reference
makeFigRef' [UID]
traceGUIDs [Reference] -> [Reference] -> [Reference]
forall a. [a] -> [a] -> [a]
++ (UID -> String -> Reference) -> [UID] -> [String] -> [Reference]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\UID
x String
y -> UID -> LblType -> ShortName -> Reference
Reference (UID
x UID -> String -> UID
+++. String
"Link") (String -> LblType
URI String
y) (Sentence -> ShortName
shortname' (Sentence -> ShortName) -> Sentence -> ShortName
forall a b. (a -> b) -> a -> b
$ String -> Sentence
S (String -> Sentence) -> String -> Sentence
forall a b. (a -> b) -> a -> b
$ UID -> String
forall a. Show a => a -> String
show UID
x)) [UID]
traceGUIDs (String -> [String]
traceyGraphPaths (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
ex)
-- for actual use in creating the graph figures
traceyGraphPath :: String -> String -> String
traceyGraphPath String
ex String
f = String
resourcePath String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
ex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".svg"

-- | Traceability graphs reference path.
resourcePath :: String
resourcePath :: String
resourcePath = String
"../../../../traceygraphs/"

-- | Helper to create a list of traceability graph references.
folderList' :: [ItemType]
folderList' :: [ItemType]
folderList' = (UID -> ItemType) -> [UID] -> [ItemType]
forall a b. (a -> b) -> [a] -> [b]
map (Sentence -> ItemType
Flat (Sentence -> ItemType) -> (UID -> Sentence) -> UID -> ItemType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\UID
x -> UID -> Sentence -> RefInfo -> Sentence
Ref (UID
x UID -> String -> UID
+++. String
"Link") Sentence
EmptyS RefInfo
None)) [UID]
traceGUIDs