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