{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}
module Language.Drasil.Debug.Print where

import Prelude hiding ((<>))

import Control.Lens ((^.), view)
import Data.Foldable (foldl')
import Data.Maybe (fromMaybe)
import Text.PrettyPrint.HughesPJ
import qualified Data.Map as Map

import Language.Drasil
import Drasil.Database (IsChunk, findAll)
import Language.Drasil.Plain.Print
import Language.Drasil.Printing.PrintingInformation
import Drasil.System (systemdb, refbyTable, traceTable)

import Theory.Drasil
import Data.Typeable (Proxy (Proxy))

-- * Main Function
-- | Gathers all printing functions and creates the debugging tables from them.
printAllDebugInfo :: PrintingInformation -> [Doc]
printAllDebugInfo :: PrintingInformation -> [Doc]
printAllDebugInfo PrintingInformation
pinfo = ((PrintingInformation -> Doc) -> Doc)
-> [PrintingInformation -> Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map
  (Doc -> Doc
cdbSection (Doc -> Doc)
-> ((PrintingInformation -> Doc) -> Doc)
-> (PrintingInformation -> Doc)
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PrintingInformation -> Doc) -> PrintingInformation -> Doc
forall a b. (a -> b) -> a -> b
$ PrintingInformation
pinfo))
  [ PrintingInformation -> Doc
mkTableReferencedChunks
  , PrintingInformation -> Doc
mkTableDepChunks
  , PrintingInformation -> Doc
mkTableSymb
  , PrintingInformation -> Doc
mkTableOfTerms
  , PrintingInformation -> Doc
mkTableConcepts
  , PrintingInformation -> Doc
mkTableUnitDefn
  , PrintingInformation -> Doc
mkTableDataDef
  , PrintingInformation -> Doc
mkTableGenDef
  , PrintingInformation -> Doc
mkTableTMod
  , PrintingInformation -> Doc
mkTableIMod
  , PrintingInformation -> Doc
mkTableCI
  , PrintingInformation -> Doc
mkTableLC
  , PrintingInformation -> Doc
mkTableRef]

-- * Helpers
-- ** Separators
-- | Debugging table separator.
cdbSection :: Doc -> Doc
cdbSection :: Doc -> Doc
cdbSection Doc
dd = String -> Doc
text (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
100 Char
'#' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n") Doc -> Doc -> Doc
$$ Doc
dd Doc -> Doc -> Doc
$$ String -> Doc
text String
"\n"

-- | Header for debugging tables.
header :: Doc -> Doc
header :: Doc -> Doc
header Doc
d = String -> Doc
text (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
100 Char
'-') Doc -> Doc -> Doc
$$ Doc
d Doc -> Doc -> Doc
$$ String -> Doc
text (Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
100 Char
'-')

-- ** Table Generators

-- | General function to make the debugging tables. Takes in printing
-- information, a function that extracts a certain field from the printing
-- information, a title, three column headers, and three functions that sort the
-- data from the printing information field into the required display formats
-- (often 'UID's, terms, shortnames, definitions, etc.).
mkTableFromLenses
  :: IsChunk a => PrintingInformation
  -> Proxy a -- Data is unused, but necessary for type constraint resolution.
  -> String
  -> [PrintingInformation -> (String, a -> Doc)]
  -> Doc
mkTableFromLenses :: forall a.
IsChunk a =>
PrintingInformation
-> Proxy a
-> String
-> [PrintingInformation -> (String, a -> Doc)]
-> Doc
mkTableFromLenses PrintingInformation
pin Proxy a
_ String
ttle [PrintingInformation -> (String, a -> Doc)]
hsNEs =
  String -> Doc
text String
ttle Doc -> Doc -> Doc
<> Doc
colon
  Doc -> Doc -> Doc
$$ Doc -> Doc
header Doc
hdr
  Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat ((a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
col [a]
chunks)
  where
    namedLenses :: [(String, a -> Doc)]
namedLenses = ((PrintingInformation -> (String, a -> Doc)) -> (String, a -> Doc))
-> [PrintingInformation -> (String, a -> Doc)]
-> [(String, a -> Doc)]
forall a b. (a -> b) -> [a] -> [b]
map ((PrintingInformation -> (String, a -> Doc))
-> PrintingInformation -> (String, a -> Doc)
forall a b. (a -> b) -> a -> b
$ PrintingInformation
pin) [PrintingInformation -> (String, a -> Doc)]
hsNEs
    ins :: [Int]
    ins :: [Int]
ins = [Int
1..]

    hdr :: Doc
hdr   = (Doc -> (String, Int) -> Doc) -> Doc -> [(String, Int)] -> Doc
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Doc
r (String, Int)
l -> Doc
r Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
nest (Int
nestNum Int -> Int -> Int
forall a. Num a => a -> a -> a
* (String, Int) -> Int
forall a b. (a, b) -> b
snd (String, Int)
l) (String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ (String, Int) -> String
forall a b. (a, b) -> a
fst (String, Int)
l)) (String -> Doc
text String
"UID")       ([String] -> [Int] -> [(String, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((String, a -> Doc) -> String) -> [(String, a -> Doc)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, a -> Doc) -> String
forall a b. (a, b) -> a
fst [(String, a -> Doc)]
namedLenses) [Int]
ins)
    col :: a -> Doc
col a
a = (Doc -> (a -> Doc, Int) -> Doc) -> Doc -> [(a -> Doc, Int)] -> Doc
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Doc
r (a -> Doc, Int)
l -> Doc
r Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
nest (Int
nestNum Int -> Int -> Int
forall a. Num a => a -> a -> a
* (a -> Doc, Int) -> Int
forall a b. (a, b) -> b
snd (a -> Doc, Int)
l) ((a -> Doc, Int) -> a -> Doc
forall a b. (a, b) -> a
fst (a -> Doc, Int)
l a
a)     ) (String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. HasUID a => a -> String
showUID a
a) ([a -> Doc] -> [Int] -> [(a -> Doc, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((String, a -> Doc) -> a -> Doc)
-> [(String, a -> Doc)] -> [a -> Doc]
forall a b. (a -> b) -> [a] -> [b]
map (String, a -> Doc) -> a -> Doc
forall a b. (a, b) -> b
snd [(String, a -> Doc)]
namedLenses) [Int]
ins)

    chunks :: [a]
chunks = ChunkDB -> [a]
forall a. IsChunk a => ChunkDB -> [a]
findAll (ChunkDB -> [a]) -> ChunkDB -> [a]
forall a b. (a -> b) -> a -> b
$ PrintingInformation
pin PrintingInformation
-> Getting ChunkDB PrintingInformation ChunkDB -> ChunkDB
forall s a. s -> Getting a s a -> a
^. (System -> Const ChunkDB System)
-> PrintingInformation -> Const ChunkDB PrintingInformation
Lens' PrintingInformation System
syst ((System -> Const ChunkDB System)
 -> PrintingInformation -> Const ChunkDB PrintingInformation)
-> ((ChunkDB -> Const ChunkDB ChunkDB)
    -> System -> Const ChunkDB System)
-> Getting ChunkDB PrintingInformation ChunkDB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChunkDB -> Const ChunkDB ChunkDB)
-> System -> Const ChunkDB System
forall c. HasSystem c => Lens' c ChunkDB
Lens' System ChunkDB
systemdb

    nestNum :: Int
nestNum = Int
30

openTerm :: NamedIdea a => PrintingInformation -> (String, a -> Doc)
openTerm :: forall a. NamedIdea a => PrintingInformation -> (String, a -> Doc)
openTerm PrintingInformation
pinfo = (String
"Term", PrintingInformation -> SingleLine -> Sentence -> Doc
sentenceDoc PrintingInformation
pinfo SingleLine
MultiLine (Sentence -> Doc) -> (a -> Sentence) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Sentence
forall n. NamedIdea n => n -> Sentence
phrase)

openSymbol :: HasSymbol a =>PrintingInformation -> (String, a -> Doc)
openSymbol :: forall a. HasSymbol a => PrintingInformation -> (String, a -> Doc)
openSymbol PrintingInformation
pinfo = (String
"Symbol", Symbol -> Doc
symbolDoc (Symbol -> Doc) -> (a -> Symbol) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Stage -> Symbol) -> Stage -> a -> Symbol
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> Stage -> Symbol
forall c. HasSymbol c => c -> Stage -> Symbol
symbol (PrintingInformation
pinfo PrintingInformation
-> Getting Stage PrintingInformation Stage -> Stage
forall s a. s -> Getting a s a -> a
^. Getting Stage PrintingInformation Stage
Lens' PrintingInformation Stage
stg))

openDefSymbol :: DefinesQuantity s => PrintingInformation -> (String, s -> Doc)
openDefSymbol :: forall s.
DefinesQuantity s =>
PrintingInformation -> (String, s -> Doc)
openDefSymbol PrintingInformation
pinfo = (String
"Symbol Defining", Symbol -> Doc
symbolDoc (Symbol -> Doc) -> (s -> Symbol) -> s -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DefinedQuantityDict -> Stage -> Symbol)
-> Stage -> DefinedQuantityDict -> Symbol
forall a b c. (a -> b -> c) -> b -> a -> c
flip DefinedQuantityDict -> Stage -> Symbol
forall c. HasSymbol c => c -> Stage -> Symbol
symbol (PrintingInformation
pinfo PrintingInformation
-> Getting Stage PrintingInformation Stage -> Stage
forall s a. s -> Getting a s a -> a
^. Getting Stage PrintingInformation Stage
Lens' PrintingInformation Stage
stg) (DefinedQuantityDict -> Symbol)
-> (s -> DefinedQuantityDict) -> s -> Symbol
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting DefinedQuantityDict s DefinedQuantityDict
-> s -> DefinedQuantityDict
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting DefinedQuantityDict s DefinedQuantityDict
forall d. DefinesQuantity d => Getter d DefinedQuantityDict
Getter s DefinedQuantityDict
defLhs)

openAbbreviation :: Idea a => PrintingInformation -> (String, a -> Doc)
openAbbreviation :: forall a. Idea a => PrintingInformation -> (String, a -> Doc)
openAbbreviation PrintingInformation
_ = (String
"Abbreviation", String -> Doc
text (String -> Doc) -> (a -> String) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> (a -> Maybe String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe String
forall c. Idea c => c -> Maybe String
getA)

openDefinition :: Definition a => PrintingInformation -> (String, a -> Doc)
openDefinition :: forall a. Definition a => PrintingInformation -> (String, a -> Doc)
openDefinition PrintingInformation
pinfo = (String
"Definition", PrintingInformation -> SingleLine -> Sentence -> Doc
sentenceDoc PrintingInformation
pinfo SingleLine
OneLine (Sentence -> Doc) -> (a -> Sentence) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Sentence a Sentence -> a -> Sentence
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Sentence a Sentence
forall c. Definition c => Lens' c Sentence
Lens' a Sentence
defn)

openUnitSymbol :: HasUnitSymbol a => PrintingInformation -> (String, a -> Doc)
openUnitSymbol :: forall a.
HasUnitSymbol a =>
PrintingInformation -> (String, a -> Doc)
openUnitSymbol PrintingInformation
pinfo = (String
"Unit Symbol", PrintingInformation -> SingleLine -> Sentence -> Doc
sentenceDoc PrintingInformation
pinfo SingleLine
OneLine (Sentence -> Doc) -> (a -> Sentence) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. USymb -> Sentence
Sy (USymb -> Sentence) -> (a -> USymb) -> a -> Sentence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> USymb
forall u. HasUnitSymbol u => u -> USymb
usymb)

openShortName :: HasShortName a => PrintingInformation -> (String, a -> Doc)
openShortName :: forall a.
HasShortName a =>
PrintingInformation -> (String, a -> Doc)
openShortName PrintingInformation
pinfo = (String
"Short Name", PrintingInformation -> SingleLine -> Sentence -> Doc
sentenceDoc PrintingInformation
pinfo SingleLine
OneLine (Sentence -> Doc) -> (a -> Sentence) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortName -> Sentence
getSentSN (ShortName -> Sentence) -> (a -> ShortName) -> a -> Sentence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ShortName
forall s. HasShortName s => s -> ShortName
shortname)

openTitle :: PrintingInformation -> (String, Section -> Doc)
openTitle :: PrintingInformation -> (String, Section -> Doc)
openTitle PrintingInformation
pinfo = (String
"Title", PrintingInformation -> SingleLine -> Sentence -> Doc
sentenceDoc PrintingInformation
pinfo SingleLine
MultiLine (Sentence -> Doc) -> (Section -> Sentence) -> Section -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Section -> Sentence
tle)

cntntToStr :: RawContent -> String
cntntToStr :: RawContent -> String
cntntToStr Table {} = String
"Table"
cntntToStr Paragraph {} = String
"Paragraph"
cntntToStr EqnBlock {} = String
"Equation"
cntntToStr DerivBlock {} = String
"Derivation"
cntntToStr Enumeration {} = String
"Enumeration"
cntntToStr Defini {} = String
"Definition or Model"
cntntToStr Figure {} = String
"Figure"
cntntToStr Bib {} = String
"Bibliography"
cntntToStr Graph {} = String
"Graph"
cntntToStr CodeBlock {} = String
"Code"

openContentType :: HasContents s => p -> (String, s -> Doc)
openContentType :: forall s p. HasContents s => p -> (String, s -> Doc)
openContentType p
_ = (String
"Content Type", String -> Doc
text (String -> Doc) -> (s -> String) -> s -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawContent -> String
cntntToStr (RawContent -> String) -> (s -> RawContent) -> s -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting RawContent s RawContent -> s -> RawContent
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting RawContent s RawContent
forall c. HasContents c => Lens' c RawContent
Lens' s RawContent
accessContents)

openRef :: HasRefAddress a => p -> (String, a -> Doc)
openRef :: forall a p. HasRefAddress a => p -> (String, a -> Doc)
openRef p
_ = (String
"Reference Address", String -> Doc
text (String -> Doc) -> (a -> String) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LblType -> String
getAdd (LblType -> String) -> (a -> LblType) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> LblType
forall b. HasRefAddress b => b -> LblType
getRefAdd)

-- | Makes a table with all symbolic quantities in the SRS.
mkTableSymb :: PrintingInformation -> Doc
mkTableSymb :: PrintingInformation -> Doc
mkTableSymb PrintingInformation
pinfo = PrintingInformation
-> Proxy DefinedQuantityDict
-> String
-> [PrintingInformation -> (String, DefinedQuantityDict -> Doc)]
-> Doc
forall a.
IsChunk a =>
PrintingInformation
-> Proxy a
-> String
-> [PrintingInformation -> (String, a -> Doc)]
-> Doc
mkTableFromLenses
  PrintingInformation
pinfo
  (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @DefinedQuantityDict)
  String
"Symbol Chunks"
  [PrintingInformation -> (String, DefinedQuantityDict -> Doc)
forall a. NamedIdea a => PrintingInformation -> (String, a -> Doc)
openTerm, PrintingInformation -> (String, DefinedQuantityDict -> Doc)
forall a. HasSymbol a => PrintingInformation -> (String, a -> Doc)
openSymbol]

-- | Makes a table with terms in the SRS.
mkTableOfTerms :: PrintingInformation -> Doc
mkTableOfTerms :: PrintingInformation -> Doc
mkTableOfTerms PrintingInformation
pinfo = PrintingInformation
-> Proxy IdeaDict
-> String
-> [PrintingInformation -> (String, IdeaDict -> Doc)]
-> Doc
forall a.
IsChunk a =>
PrintingInformation
-> Proxy a
-> String
-> [PrintingInformation -> (String, a -> Doc)]
-> Doc
mkTableFromLenses
  PrintingInformation
pinfo
  (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @IdeaDict)
  String
"Term Chunks"
  [PrintingInformation -> (String, IdeaDict -> Doc)
forall a. NamedIdea a => PrintingInformation -> (String, a -> Doc)
openTerm, PrintingInformation -> (String, IdeaDict -> Doc)
forall a. Idea a => PrintingInformation -> (String, a -> Doc)
openAbbreviation]

-- | Makes a table with all concepts in the SRS.
mkTableConcepts :: PrintingInformation -> Doc
mkTableConcepts :: PrintingInformation -> Doc
mkTableConcepts PrintingInformation
pinfo = PrintingInformation
-> Proxy ConceptChunk
-> String
-> [PrintingInformation -> (String, ConceptChunk -> Doc)]
-> Doc
forall a.
IsChunk a =>
PrintingInformation
-> Proxy a
-> String
-> [PrintingInformation -> (String, a -> Doc)]
-> Doc
mkTableFromLenses
  PrintingInformation
pinfo
  (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ConceptChunk)
  String
"Concepts"
  [PrintingInformation -> (String, ConceptChunk -> Doc)
forall a. NamedIdea a => PrintingInformation -> (String, a -> Doc)
openTerm] -- FIXME: `openDefinition` ommited because some ConceptChunks
             -- contain references to non-existent `Reference`s (which are only
             -- created at SRS generation time).

-- | Makes a table with all units used in the SRS.
mkTableUnitDefn :: PrintingInformation -> Doc
mkTableUnitDefn :: PrintingInformation -> Doc
mkTableUnitDefn PrintingInformation
pinfo = PrintingInformation
-> Proxy UnitDefn
-> String
-> [PrintingInformation -> (String, UnitDefn -> Doc)]
-> Doc
forall a.
IsChunk a =>
PrintingInformation
-> Proxy a
-> String
-> [PrintingInformation -> (String, a -> Doc)]
-> Doc
mkTableFromLenses
  PrintingInformation
pinfo
  (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @UnitDefn)
  String
"Unit Definitions"
  [PrintingInformation -> (String, UnitDefn -> Doc)
forall a. NamedIdea a => PrintingInformation -> (String, a -> Doc)
openTerm, PrintingInformation -> (String, UnitDefn -> Doc)
forall a.
HasUnitSymbol a =>
PrintingInformation -> (String, a -> Doc)
openUnitSymbol]

-- | Makes a table with all data definitions in the SRS.
mkTableDataDef :: PrintingInformation -> Doc
mkTableDataDef :: PrintingInformation -> Doc
mkTableDataDef PrintingInformation
pinfo = PrintingInformation
-> Proxy DataDefinition
-> String
-> [PrintingInformation -> (String, DataDefinition -> Doc)]
-> Doc
forall a.
IsChunk a =>
PrintingInformation
-> Proxy a
-> String
-> [PrintingInformation -> (String, a -> Doc)]
-> Doc
mkTableFromLenses
  PrintingInformation
pinfo
  (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @DataDefinition)
  String
"Data Definitions"
  [PrintingInformation -> (String, DataDefinition -> Doc)
forall a. NamedIdea a => PrintingInformation -> (String, a -> Doc)
openTerm, PrintingInformation -> (String, DataDefinition -> Doc)
forall s.
DefinesQuantity s =>
PrintingInformation -> (String, s -> Doc)
openDefSymbol]

-- | Makes a table with all general definitions in the SRS.
mkTableGenDef :: PrintingInformation -> Doc
mkTableGenDef :: PrintingInformation -> Doc
mkTableGenDef PrintingInformation
pinfo = PrintingInformation
-> Proxy GenDefn
-> String
-> [PrintingInformation -> (String, GenDefn -> Doc)]
-> Doc
forall a.
IsChunk a =>
PrintingInformation
-> Proxy a
-> String
-> [PrintingInformation -> (String, a -> Doc)]
-> Doc
mkTableFromLenses
  PrintingInformation
pinfo
  (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @GenDefn)
  String
"General Definitions"
  [PrintingInformation -> (String, GenDefn -> Doc)
forall a. NamedIdea a => PrintingInformation -> (String, a -> Doc)
openTerm, PrintingInformation -> (String, GenDefn -> Doc)
forall a. Definition a => PrintingInformation -> (String, a -> Doc)
openDefinition]

-- | Makes a table with all theoretical models in the SRS.
mkTableTMod :: PrintingInformation -> Doc
mkTableTMod :: PrintingInformation -> Doc
mkTableTMod PrintingInformation
pinfo = PrintingInformation
-> Proxy TheoryModel
-> String
-> [PrintingInformation -> (String, TheoryModel -> Doc)]
-> Doc
forall a.
IsChunk a =>
PrintingInformation
-> Proxy a
-> String
-> [PrintingInformation -> (String, a -> Doc)]
-> Doc
mkTableFromLenses
  PrintingInformation
pinfo
  (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @TheoryModel)
  String
"Theory Models"
  [PrintingInformation -> (String, TheoryModel -> Doc)
forall a. NamedIdea a => PrintingInformation -> (String, a -> Doc)
openTerm, PrintingInformation -> (String, TheoryModel -> Doc)
forall a. Definition a => PrintingInformation -> (String, a -> Doc)
openDefinition]

-- | Makes a table with all instance models in the SRS.
mkTableIMod :: PrintingInformation -> Doc
mkTableIMod :: PrintingInformation -> Doc
mkTableIMod PrintingInformation
pinfo = PrintingInformation
-> Proxy InstanceModel
-> String
-> [PrintingInformation -> (String, InstanceModel -> Doc)]
-> Doc
forall a.
IsChunk a =>
PrintingInformation
-> Proxy a
-> String
-> [PrintingInformation -> (String, a -> Doc)]
-> Doc
mkTableFromLenses
  PrintingInformation
pinfo
  (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @InstanceModel)
  String
"Instance Models"
  [PrintingInformation -> (String, InstanceModel -> Doc)
forall a. NamedIdea a => PrintingInformation -> (String, a -> Doc)
openTerm, PrintingInformation -> (String, InstanceModel -> Doc)
forall a. Definition a => PrintingInformation -> (String, a -> Doc)
openDefinition]

-- | Makes a table with all concept instances in the SRS.
mkTableCI :: PrintingInformation -> Doc
mkTableCI :: PrintingInformation -> Doc
mkTableCI PrintingInformation
pinfo = PrintingInformation
-> Proxy ConceptInstance
-> String
-> [PrintingInformation -> (String, ConceptInstance -> Doc)]
-> Doc
forall a.
IsChunk a =>
PrintingInformation
-> Proxy a
-> String
-> [PrintingInformation -> (String, a -> Doc)]
-> Doc
mkTableFromLenses
  PrintingInformation
pinfo
  (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @ConceptInstance)
  String
"ConceptInstance"
  [PrintingInformation -> (String, ConceptInstance -> Doc)
forall a. NamedIdea a => PrintingInformation -> (String, a -> Doc)
openTerm, PrintingInformation -> (String, ConceptInstance -> Doc)
forall a.
HasShortName a =>
PrintingInformation -> (String, a -> Doc)
openShortName]

-- | Makes a table with all labelled content in the SRS.
mkTableLC :: PrintingInformation -> Doc
mkTableLC :: PrintingInformation -> Doc
mkTableLC PrintingInformation
pinfo = PrintingInformation
-> Proxy LabelledContent
-> String
-> [PrintingInformation -> (String, LabelledContent -> Doc)]
-> Doc
forall a.
IsChunk a =>
PrintingInformation
-> Proxy a
-> String
-> [PrintingInformation -> (String, a -> Doc)]
-> Doc
mkTableFromLenses
  PrintingInformation
pinfo
  (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @LabelledContent)
  String
"LabelledContent"
  [PrintingInformation -> (String, LabelledContent -> Doc)
forall a.
HasShortName a =>
PrintingInformation -> (String, a -> Doc)
openShortName, PrintingInformation -> (String, LabelledContent -> Doc)
forall s p. HasContents s => p -> (String, s -> Doc)
openContentType]

-- | Makes a table with all references in the SRS.
mkTableRef :: PrintingInformation -> Doc
mkTableRef :: PrintingInformation -> Doc
mkTableRef PrintingInformation
pinfo = PrintingInformation
-> Proxy Reference
-> String
-> [PrintingInformation -> (String, Reference -> Doc)]
-> Doc
forall a.
IsChunk a =>
PrintingInformation
-> Proxy a
-> String
-> [PrintingInformation -> (String, a -> Doc)]
-> Doc
mkTableFromLenses
  PrintingInformation
pinfo
  (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Reference)
  String
"Reference"
  [PrintingInformation -> (String, Reference -> Doc)
forall a p. HasRefAddress a => p -> (String, a -> Doc)
openRef, PrintingInformation -> (String, Reference -> Doc)
forall a.
HasShortName a =>
PrintingInformation -> (String, a -> Doc)
openShortName]

-- | Chunks that depend on other chunks. An empty list means the chunks do not depend on anything.
mkTableDepChunks :: PrintingInformation -> Doc
mkTableDepChunks :: PrintingInformation -> Doc
mkTableDepChunks PrintingInformation
pinfo = String -> Doc
text
  String
"Dependent Chunks (the chunks on the left use the chunks on the right in some capacity)"
  Doc -> Doc -> Doc
<> Doc
colon
  Doc -> Doc -> Doc
$$ Doc -> Doc
header (String -> Doc
text String
"UID" Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
nest Int
nestNum (String -> Doc
text String
"Dependent UIDs"))
  Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat (((UID, [UID]) -> Doc) -> [(UID, [UID])] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (UID, [UID]) -> Doc
testIndepLayout [(UID, [UID])]
traceMapUIDs)
  where
    testIndepLayout :: (UID, [UID]) -> Doc
    testIndepLayout :: (UID, [UID]) -> Doc
testIndepLayout (UID
x, [UID]
ys) = String -> Doc
text (UID -> String
forall a. Show a => a -> String
show UID
x) Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
nest Int
nestNum (String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ [UID] -> String
forall a. Show a => a -> String
show [UID]
ys)

    traceMapUIDs :: [(UID, [UID])]
    traceMapUIDs :: [(UID, [UID])]
traceMapUIDs = Map UID [UID] -> [(UID, [UID])]
forall k a. Map k a -> [(k, a)]
Map.assocs (Map UID [UID] -> [(UID, [UID])])
-> Map UID [UID] -> [(UID, [UID])]
forall a b. (a -> b) -> a -> b
$ PrintingInformation
pinfo PrintingInformation
-> Getting (Map UID [UID]) PrintingInformation (Map UID [UID])
-> Map UID [UID]
forall s a. s -> Getting a s a -> a
^. (System -> Const (Map UID [UID]) System)
-> PrintingInformation -> Const (Map UID [UID]) PrintingInformation
Lens' PrintingInformation System
syst ((System -> Const (Map UID [UID]) System)
 -> PrintingInformation
 -> Const (Map UID [UID]) PrintingInformation)
-> ((Map UID [UID] -> Const (Map UID [UID]) (Map UID [UID]))
    -> System -> Const (Map UID [UID]) System)
-> Getting (Map UID [UID]) PrintingInformation (Map UID [UID])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map UID [UID] -> Const (Map UID [UID]) (Map UID [UID]))
-> System -> Const (Map UID [UID]) System
forall c. HasSystem c => Lens' c (Map UID [UID])
Lens' System (Map UID [UID])
traceTable

    nestNum :: Int
nestNum = Int
30

-- | Chunks that are referenced and used by other chunks.
-- Those chunks build on top of the ones listed here.
mkTableReferencedChunks :: PrintingInformation -> Doc
mkTableReferencedChunks :: PrintingInformation -> Doc
mkTableReferencedChunks PrintingInformation
pinfo =
  String -> Doc
text String
"Referenced Chunks (other chunks build from these)" Doc -> Doc -> Doc
<> Doc
colon
  Doc -> Doc -> Doc
$$ Doc -> Doc
header (String -> Doc
text String
"UID" Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
nest Int
nestNum (String -> Doc
text String
"UIDs that use the left UID"))
  Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat (((UID, [UID]) -> Doc) -> [(UID, [UID])] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (UID, [UID]) -> Doc
testIsolateLayout [(UID, [UID])]
refbyUIDs)
  where
    testIsolateLayout :: (UID, [UID]) -> Doc
    testIsolateLayout :: (UID, [UID]) -> Doc
testIsolateLayout (UID
x, [UID]
ys) = String -> Doc
text (UID -> String
forall a. Show a => a -> String
show UID
x) Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
nest Int
nestNum (String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ [UID] -> String
forall a. Show a => a -> String
show [UID]
ys)

    refbyUIDs :: [(UID, [UID])]
    refbyUIDs :: [(UID, [UID])]
refbyUIDs = Map UID [UID] -> [(UID, [UID])]
forall k a. Map k a -> [(k, a)]
Map.assocs (Map UID [UID] -> [(UID, [UID])])
-> Map UID [UID] -> [(UID, [UID])]
forall a b. (a -> b) -> a -> b
$ PrintingInformation
pinfo PrintingInformation
-> Getting (Map UID [UID]) PrintingInformation (Map UID [UID])
-> Map UID [UID]
forall s a. s -> Getting a s a -> a
^. (System -> Const (Map UID [UID]) System)
-> PrintingInformation -> Const (Map UID [UID]) PrintingInformation
Lens' PrintingInformation System
syst ((System -> Const (Map UID [UID]) System)
 -> PrintingInformation
 -> Const (Map UID [UID]) PrintingInformation)
-> ((Map UID [UID] -> Const (Map UID [UID]) (Map UID [UID]))
    -> System -> Const (Map UID [UID]) System)
-> Getting (Map UID [UID]) PrintingInformation (Map UID [UID])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map UID [UID] -> Const (Map UID [UID]) (Map UID [UID]))
-> System -> Const (Map UID [UID]) System
forall c. HasSystem c => Lens' c (Map UID [UID])
Lens' System (Map UID [UID])
refbyTable

    nestNum :: Int
nestNum = Int
30

-- ** 'UID' Manipulation
-- | Creates a table of all UIDs and their "highest" recorded level of information. See 'mkListShowUsedUIDs'
-- for more details.
renderUsedUIDs :: [(UID, String)] -> Doc
renderUsedUIDs :: [(UID, String)] -> Doc
renderUsedUIDs [(UID, String)]
chs = Doc -> Doc
header (String -> Doc
text String
"UIDs" Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
nest Int
40 (String -> Doc
text String
"Associated Chunks"))
  Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat (((UID, String) -> Doc) -> [(UID, String)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (UID, String) -> Doc
forall {a}. Show a => (a, String) -> Doc
renderUsedUID [(UID, String)]
chs)
  where
    renderUsedUID :: (a, String) -> Doc
renderUsedUID (a
u, String
chks) = String -> Doc
text (a -> String
forall a. Show a => a -> String
show a
u) Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
nest Int
40 (String -> Doc
text String
chks)