{-# 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 Database.Drasil
import Language.Drasil.Plain.Print
import Language.Drasil.Printing.PrintingInformation

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
^. Getting ChunkDB PrintingInformation ChunkDB
Lens' PrintingInformation ChunkDB
ckdb

    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", ChunkDB -> Stage -> SingleLine -> Sentence -> Doc
sentenceDoc (PrintingInformation
pinfo PrintingInformation
-> Getting ChunkDB PrintingInformation ChunkDB -> ChunkDB
forall s a. s -> Getting a s a -> a
^. Getting ChunkDB PrintingInformation ChunkDB
Lens' PrintingInformation ChunkDB
ckdb) (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) 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", ChunkDB -> Stage -> SingleLine -> Sentence -> Doc
sentenceDoc (PrintingInformation
pinfo PrintingInformation
-> Getting ChunkDB PrintingInformation ChunkDB -> ChunkDB
forall s a. s -> Getting a s a -> a
^. Getting ChunkDB PrintingInformation ChunkDB
Lens' PrintingInformation ChunkDB
ckdb) (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) 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", ChunkDB -> Stage -> SingleLine -> Sentence -> Doc
sentenceDoc (PrintingInformation
pinfo PrintingInformation
-> Getting ChunkDB PrintingInformation ChunkDB -> ChunkDB
forall s a. s -> Getting a s a -> a
^. Getting ChunkDB PrintingInformation ChunkDB
Lens' PrintingInformation ChunkDB
ckdb) (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) 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", ChunkDB -> Stage -> SingleLine -> Sentence -> Doc
sentenceDoc (PrintingInformation
pinfo PrintingInformation
-> Getting ChunkDB PrintingInformation ChunkDB -> ChunkDB
forall s a. s -> Getting a s a -> a
^. Getting ChunkDB PrintingInformation ChunkDB
Lens' PrintingInformation ChunkDB
ckdb) (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) 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", ChunkDB -> Stage -> SingleLine -> Sentence -> Doc
sentenceDoc (PrintingInformation
pinfo PrintingInformation
-> Getting ChunkDB PrintingInformation ChunkDB -> ChunkDB
forall s a. s -> Getting a s a -> a
^. Getting ChunkDB PrintingInformation ChunkDB
Lens' PrintingInformation ChunkDB
ckdb) (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) 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
$ ChunkDB -> Map UID [UID]
traceTable (ChunkDB -> Map UID [UID]) -> ChunkDB -> Map UID [UID]
forall a b. (a -> b) -> a -> b
$ PrintingInformation
pinfo PrintingInformation
-> Getting ChunkDB PrintingInformation ChunkDB -> ChunkDB
forall s a. s -> Getting a s a -> a
^. Getting ChunkDB PrintingInformation ChunkDB
Lens' PrintingInformation ChunkDB
ckdb

    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
$ ChunkDB -> Map UID [UID]
refbyTable (ChunkDB -> Map UID [UID]) -> ChunkDB -> Map UID [UID]
forall a b. (a -> b) -> a -> b
$ PrintingInformation
pinfo PrintingInformation
-> Getting ChunkDB PrintingInformation ChunkDB -> ChunkDB
forall s a. s -> Getting a s a -> a
^. Getting ChunkDB PrintingInformation ChunkDB
Lens' PrintingInformation ChunkDB
ckdb

    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)