{-# LANGUAGE LambdaCase #-}
-- | Defines a DLPlate for tracability between pieces of information.
module Drasil.TraceTable where

import Drasil.DocumentLanguage.Core

import Language.Drasil
import Language.Drasil.Development (lnames')
import Database.Drasil (TraceMap, traceMap)
import Theory.Drasil (Theory(..))

import Control.Lens ((^.))
import Data.Functor.Constant (Constant(Constant))
import Data.Generics.Multiplate (foldFor, preorderFold, purePlate)

-- | Creates a dependency plate for 'UID's.
dependencyPlate :: DLPlate (Constant [(UID, [UID])])
dependencyPlate :: DLPlate (Constant [(UID, [UID])])
dependencyPlate = DLPlate (Constant [(UID, [UID])])
-> DLPlate (Constant [(UID, [UID])])
forall (p :: (* -> *) -> *) o.
(Multiplate p, Monoid o) =>
p (Constant o) -> p (Constant o)
preorderFold (DLPlate (Constant [(UID, [UID])])
 -> DLPlate (Constant [(UID, [UID])]))
-> DLPlate (Constant [(UID, [UID])])
-> DLPlate (Constant [(UID, [UID])])
forall a b. (a -> b) -> a -> b
$ DLPlate (Constant [(UID, [UID])])
forall (p :: (* -> *) -> *) (f :: * -> *).
(Multiplate p, Applicative f) =>
p f
purePlate {
  pdSub = Constant <$> \case
    (Goals [Sentence]
_ [ConceptInstance]
c) -> [ConceptInstance -> [Sentence]]
-> [ConceptInstance] -> [(UID, [UID])]
forall a. HasUID a => [a -> [Sentence]] -> [a] -> [(UID, [UID])]
getDependenciesOf [ConceptInstance -> [Sentence]
forall a. Definition a => a -> [Sentence]
defs] [ConceptInstance]
c
    PDSub
_ -> [],
  scsSub = Constant <$> \case
    (Assumptions [ConceptInstance]
a) -> [ConceptInstance -> [Sentence]]
-> [ConceptInstance] -> [(UID, [UID])]
forall a. HasUID a => [a -> [Sentence]] -> [a] -> [(UID, [UID])]
getDependenciesOf [ConceptInstance -> [Sentence]
forall a. Definition a => a -> [Sentence]
defs] [ConceptInstance]
a
    (TMs [Sentence]
_ Fields
_ [TheoryModel]
t)     -> [TheoryModel -> [Sentence]] -> [TheoryModel] -> [(UID, [UID])]
forall a. HasUID a => [a -> [Sentence]] -> [a] -> [(UID, [UID])]
getDependenciesOf [\TheoryModel
x -> (ModelQDef -> Sentence) -> [ModelQDef] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map (ModelQDef -> Getting Sentence ModelQDef Sentence -> Sentence
forall s a. s -> Getting a s a -> a
^. Getting Sentence ModelQDef Sentence
forall c. Definition c => Lens' c Sentence
Lens' ModelQDef Sentence
defn) (TheoryModel
x TheoryModel
-> Getting [ModelQDef] TheoryModel [ModelQDef] -> [ModelQDef]
forall s a. s -> Getting a s a -> a
^. Getting [ModelQDef] TheoryModel [ModelQDef]
forall t. Theory t => Lens' t [ModelQDef]
Lens' TheoryModel [ModelQDef]
defined_quant) [Sentence] -> [Sentence] -> [Sentence]
forall a. [a] -> [a] -> [a]
++
      (ConceptChunk -> Sentence) -> [ConceptChunk] -> [Sentence]
forall a b. (a -> b) -> [a] -> [b]
map (ConceptChunk -> Getting Sentence ConceptChunk Sentence -> Sentence
forall s a. s -> Getting a s a -> a
^. Getting Sentence ConceptChunk Sentence
forall c. Definition c => Lens' c Sentence
Lens' ConceptChunk Sentence
defn) (TheoryModel
x TheoryModel
-> Getting [ConceptChunk] TheoryModel [ConceptChunk]
-> [ConceptChunk]
forall s a. s -> Getting a s a -> a
^. Getting [ConceptChunk] TheoryModel [ConceptChunk]
forall t. Theory t => Lens' t [ConceptChunk]
Lens' TheoryModel [ConceptChunk]
operations), TheoryModel -> [Sentence]
forall a. HasAdditionalNotes a => a -> [Sentence]
notes] [TheoryModel]
t
    (DDs [Sentence]
_ Fields
_ [DataDefinition]
d DerivationDisplay
_) -> [DataDefinition -> [Sentence]]
-> [DataDefinition] -> [(UID, [UID])]
forall a. HasUID a => [a -> [Sentence]] -> [a] -> [(UID, [UID])]
getDependenciesOf [DataDefinition -> [Sentence]
forall a. MayHaveDerivation a => a -> [Sentence]
derivs, DataDefinition -> [Sentence]
forall a. HasAdditionalNotes a => a -> [Sentence]
notes] [DataDefinition]
d
    (GDs [Sentence]
_ Fields
_ [GenDefn]
g DerivationDisplay
_) -> [GenDefn -> [Sentence]] -> [GenDefn] -> [(UID, [UID])]
forall a. HasUID a => [a -> [Sentence]] -> [a] -> [(UID, [UID])]
getDependenciesOf [GenDefn -> [Sentence]
forall a. Definition a => a -> [Sentence]
defs, GenDefn -> [Sentence]
forall a. MayHaveDerivation a => a -> [Sentence]
derivs, GenDefn -> [Sentence]
forall a. HasAdditionalNotes a => a -> [Sentence]
notes] [GenDefn]
g
    (IMs [Sentence]
_ Fields
_ [InstanceModel]
i DerivationDisplay
_) -> [InstanceModel -> [Sentence]] -> [InstanceModel] -> [(UID, [UID])]
forall a. HasUID a => [a -> [Sentence]] -> [a] -> [(UID, [UID])]
getDependenciesOf [InstanceModel -> [Sentence]
forall a. MayHaveDerivation a => a -> [Sentence]
derivs, InstanceModel -> [Sentence]
forall a. HasAdditionalNotes a => a -> [Sentence]
notes] [InstanceModel]
i
    SCSSub
_ -> [],
  reqSub = Constant . getDependenciesOf [defs] <$> \case
    (FReqsSub' [ConceptInstance]
c [LabelledContent]
_) -> [ConceptInstance]
c
    (FReqsSub [ConceptInstance]
c [LabelledContent]
_) -> [ConceptInstance]
c
    (NonFReqsSub [ConceptInstance]
c) -> [ConceptInstance]
c,
  lcsSec = Constant . getDependenciesOf [defs] <$> \(LCsProg [ConceptInstance]
c) -> [ConceptInstance]
c,
  ucsSec = Constant . getDependenciesOf [defs] <$> \(UCsProg [ConceptInstance]
c) -> [ConceptInstance]
c
} where
  getDependenciesOf :: HasUID a => [a -> [Sentence]] -> [a] -> [(UID, [UID])]
  getDependenciesOf :: forall a. HasUID a => [a -> [Sentence]] -> [a] -> [(UID, [UID])]
getDependenciesOf [a -> [Sentence]]
fs = (a -> (UID, [UID])) -> [a] -> [(UID, [UID])]
forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> (a
x 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 -> [Sentence]) -> [UID]) -> [a -> [Sentence]] -> [UID]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Sentence] -> [UID]
lnames' ([Sentence] -> [UID])
-> ((a -> [Sentence]) -> [Sentence]) -> (a -> [Sentence]) -> [UID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> [Sentence]) -> a -> [Sentence]
forall a b. (a -> b) -> a -> b
$ a
x)) [a -> [Sentence]]
fs))
  defs :: Definition a => a -> [Sentence]
  defs :: forall a. Definition a => a -> [Sentence]
defs a
x = [a
x a -> Getting Sentence a Sentence -> Sentence
forall s a. s -> Getting a s a -> a
^. Getting Sentence a Sentence
forall c. Definition c => Lens' c Sentence
Lens' a Sentence
defn]
  derivs :: MayHaveDerivation a => a -> [Sentence]
  derivs :: forall a. MayHaveDerivation a => a -> [Sentence]
derivs a
x = [Sentence]
-> (Derivation -> [Sentence]) -> Maybe Derivation -> [Sentence]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\(Derivation Sentence
h [Sentence]
d) -> Sentence
h Sentence -> [Sentence] -> [Sentence]
forall a. a -> [a] -> [a]
: [Sentence]
d) (Maybe Derivation -> [Sentence]) -> Maybe Derivation -> [Sentence]
forall a b. (a -> b) -> a -> b
$ a
x a
-> Getting (Maybe Derivation) a (Maybe Derivation)
-> Maybe Derivation
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Derivation) a (Maybe Derivation)
forall c. MayHaveDerivation c => Lens' c (Maybe Derivation)
Lens' a (Maybe Derivation)
derivations
  notes :: HasAdditionalNotes a => a -> [Sentence]
  notes :: forall a. HasAdditionalNotes a => a -> [Sentence]
notes = (a -> Getting [Sentence] a [Sentence] -> [Sentence]
forall s a. s -> Getting a s a -> a
^. Getting [Sentence] a [Sentence]
forall c. HasAdditionalNotes c => Lens' c [Sentence]
Lens' a [Sentence]
getNotes)

-- | Creates a traceability map from document sections.
generateTraceMap :: [DocSection] -> TraceMap
generateTraceMap :: [DocSection] -> TraceMap
generateTraceMap = [(UID, [UID])] -> TraceMap
traceMap ([(UID, [UID])] -> TraceMap)
-> ([DocSection] -> [(UID, [UID])]) -> [DocSection] -> TraceMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DocSection -> [(UID, [UID])]) -> [DocSection] -> [(UID, [UID])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Projector DLPlate DocSection
-> DLPlate (Constant [(UID, [UID])])
-> DocSection
-> [(UID, [UID])]
forall (p :: (* -> *) -> *) a o.
Multiplate p =>
Projector p a -> p (Constant o) -> a -> o
foldFor DLPlate f -> DocSection -> f DocSection
Projector DLPlate DocSection
docSec DLPlate (Constant [(UID, [UID])])
dependencyPlate)