{-# 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 :: PDSub -> Constant [(UID, [UID])] PDSub
pdSub = [(UID, [UID])] -> Constant [(UID, [UID])] PDSub
forall k a (b :: k). a -> Constant a b
Constant ([(UID, [UID])] -> Constant [(UID, [UID])] PDSub)
-> (PDSub -> [(UID, [UID])])
-> PDSub
-> Constant [(UID, [UID])] PDSub
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> \case
    (Goals _ c :: [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
    _ -> [],
  scsSub :: SCSSub -> Constant [(UID, [UID])] SCSSub
scsSub = [(UID, [UID])] -> Constant [(UID, [UID])] SCSSub
forall k a (b :: k). a -> Constant a b
Constant ([(UID, [UID])] -> Constant [(UID, [UID])] SCSSub)
-> (SCSSub -> [(UID, [UID])])
-> SCSSub
-> Constant [(UID, [UID])] SCSSub
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> \case
    (Assumptions a :: [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 _ _ t :: [TheoryModel]
t)     -> [TheoryModel -> [Sentence]] -> [TheoryModel] -> [(UID, [UID])]
forall a. HasUID a => [a -> [Sentence]] -> [a] -> [(UID, [UID])]
getDependenciesOf [\x :: 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
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]
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
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]
operations), TheoryModel -> [Sentence]
forall a. HasAdditionalNotes a => a -> [Sentence]
notes] [TheoryModel]
t
    (DDs _ _ d :: [DataDefinition]
d _) -> [DataDefinition -> [Sentence]]
-> [DataDefinition] -> [(UID, [UID])]
forall a. HasUID a => [a -> [Sentence]] -> [a] -> [(UID, [UID])]
getDependenciesOf [DataDefinition -> [Sentence]
forall a. HasDerivation a => a -> [Sentence]
derivs, DataDefinition -> [Sentence]
forall a. HasAdditionalNotes a => a -> [Sentence]
notes] [DataDefinition]
d
    (GDs _ _ g :: [GenDefn]
g _) -> [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. HasDerivation a => a -> [Sentence]
derivs, GenDefn -> [Sentence]
forall a. HasAdditionalNotes a => a -> [Sentence]
notes] [GenDefn]
g
    (IMs _ _ i :: [InstanceModel]
i _) -> [InstanceModel -> [Sentence]] -> [InstanceModel] -> [(UID, [UID])]
forall a. HasUID a => [a -> [Sentence]] -> [a] -> [(UID, [UID])]
getDependenciesOf [InstanceModel -> [Sentence]
forall a. HasDerivation a => a -> [Sentence]
derivs, InstanceModel -> [Sentence]
forall a. HasAdditionalNotes a => a -> [Sentence]
notes] [InstanceModel]
i
    _ -> [],
  reqSub :: ReqsSub -> Constant [(UID, [UID])] ReqsSub
reqSub = [(UID, [UID])] -> Constant [(UID, [UID])] ReqsSub
forall k a (b :: k). a -> Constant a b
Constant ([(UID, [UID])] -> Constant [(UID, [UID])] ReqsSub)
-> ([ConceptInstance] -> [(UID, [UID])])
-> [ConceptInstance]
-> Constant [(UID, [UID])] ReqsSub
forall b c a. (b -> c) -> (a -> b) -> a -> 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] -> Constant [(UID, [UID])] ReqsSub)
-> (ReqsSub -> [ConceptInstance])
-> ReqsSub
-> Constant [(UID, [UID])] ReqsSub
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> \case
    (FReqsSub' c :: [ConceptInstance]
c _) -> [ConceptInstance]
c
    (FReqsSub c :: [ConceptInstance]
c _) -> [ConceptInstance]
c
    (NonFReqsSub c :: [ConceptInstance]
c) -> [ConceptInstance]
c,
  lcsSec :: LCsSec -> Constant [(UID, [UID])] LCsSec
lcsSec = [(UID, [UID])] -> Constant [(UID, [UID])] LCsSec
forall k a (b :: k). a -> Constant a b
Constant ([(UID, [UID])] -> Constant [(UID, [UID])] LCsSec)
-> ([ConceptInstance] -> [(UID, [UID])])
-> [ConceptInstance]
-> Constant [(UID, [UID])] LCsSec
forall b c a. (b -> c) -> (a -> b) -> a -> 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] -> Constant [(UID, [UID])] LCsSec)
-> (LCsSec -> [ConceptInstance])
-> LCsSec
-> Constant [(UID, [UID])] LCsSec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> \(LCsProg c :: [ConceptInstance]
c) -> [ConceptInstance]
c,
  ucsSec :: UCsSec -> Constant [(UID, [UID])] UCsSec
ucsSec = [(UID, [UID])] -> Constant [(UID, [UID])] UCsSec
forall k a (b :: k). a -> Constant a b
Constant ([(UID, [UID])] -> Constant [(UID, [UID])] UCsSec)
-> ([ConceptInstance] -> [(UID, [UID])])
-> [ConceptInstance]
-> Constant [(UID, [UID])] UCsSec
forall b c a. (b -> c) -> (a -> b) -> a -> 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] -> Constant [(UID, [UID])] UCsSec)
-> (UCsSec -> [ConceptInstance])
-> UCsSec
-> Constant [(UID, [UID])] UCsSec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> \(UCsProg c :: [ConceptInstance]
c) -> [ConceptInstance]
c
} where
  getDependenciesOf :: HasUID a => [a -> [Sentence]] -> [a] -> [(UID, [UID])]
  getDependenciesOf :: [a -> [Sentence]] -> [a] -> [(UID, [UID])]
getDependenciesOf fs :: [a -> [Sentence]]
fs = (a -> (UID, [UID])) -> [a] -> [(UID, [UID])]
forall a b. (a -> b) -> [a] -> [b]
map (\x :: 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 => Lens' c 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 :: a -> [Sentence]
defs x :: 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
defn]
  derivs :: HasDerivation a => a -> [Sentence]
  derivs :: a -> [Sentence]
derivs x :: a
x = [Sentence]
-> (Derivation -> [Sentence]) -> Maybe Derivation -> [Sentence]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\(Derivation h :: Sentence
h d :: [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. HasDerivation c => Lens' c (Maybe Derivation)
derivations
  notes :: HasAdditionalNotes a => a -> [Sentence]
  notes :: 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]
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 Projector DLPlate DocSection
docSec DLPlate (Constant [(UID, [UID])])
dependencyPlate)