-- | Defines functions to create .toml and .csv config files for mdBook.
module Language.Drasil.Markdown.Config where

import Text.PrettyPrint (Doc, text, vcat, (<+>))
import Data.Map (empty, elems)
import Control.Lens
import System.FilePath (takeFileName)

import Utils.Drasil (makeCSV)
import Language.Drasil.Markdown.Print (pSpec)
import Language.Drasil.Printing.PrintingInformation (PrintingInformation(..))
import Database.Drasil (labelledcontentTable)
import Language.Drasil.Printing.Import.Sentence (spec)
import Language.Drasil.Printing.LayoutObj (Filepath)

import Language.Drasil hiding (Expr)

-- | Prints the .toml config file for mdBook.
makeBook :: Document -> PrintingInformation -> Doc  
makeBook :: Document -> PrintingInformation -> Doc
makeBook (Document Title
t Title
_ ShowTableOfContents
_ [Section]
_) PrintingInformation
sm = [Doc] -> Doc
vcat [
  String -> Doc
text String
"[book]",
  String -> Doc
text String
"language = \"en\"",
  String -> Doc
text String
"multilingual = false",
  String -> Doc
text String
"src = \"src\"",
  String -> Doc
text String
"title =" Doc -> Doc -> Doc
<+> PrintingInformation -> Title -> Doc
mkTitle PrintingInformation
sm Title
t,
  String -> Doc
text String
"[output.html]",
  String -> Doc
text String
"smart-punctuation = true",
  String -> Doc
text String
"mathjax-support = true"
  ]
makeBook Document
_ PrintingInformation
_ = String -> Doc
forall a. HasCallStack => String -> a
error String
"Type not supported: Notebook."

-- | Prints the .csv file mapping the original filepaths of assets to the
-- location mdBook uses.
makeRequirements :: PrintingInformation -> Doc
makeRequirements :: PrintingInformation -> Doc
makeRequirements PrintingInformation
sm = [[String]] -> Doc
makeCSV ([[String]] -> Doc) -> [[String]] -> Doc
forall a b. (a -> b) -> a -> b
$ [String
"Original", String
"Copy"] [String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
: PrintingInformation -> [[String]]
assetMat PrintingInformation
sm

-- | Render a title 'Sentence'.
mkTitle :: PrintingInformation -> Sentence -> Doc
mkTitle :: PrintingInformation -> Title -> Doc
mkTitle PrintingInformation
sm Title
t = String -> Doc
text String
"\"" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> RefMap -> Spec -> Doc
pSpec RefMap
forall k a. Map k a
empty (PrintingInformation -> Title -> Spec
spec PrintingInformation
sm Title
t) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"\""

-- | Map the original filepaths of assets to the location mdBook generator
-- needs.
assetMat :: PrintingInformation -> [[Filepath]]
assetMat :: PrintingInformation -> [[String]]
assetMat (PI {_ckdb :: PrintingInformation -> ChunkDB
_ckdb = ChunkDB
cdb}) = 
  [[String
fp, String
"src/assets/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
takeFileName String
fp] 
  | (LblC { _ctype :: LabelledContent -> RawContent
_ctype = Figure Title
_ String
fp MaxWidthPercent
_ HasCaption
_ }, Int
_) <- Map UID (LabelledContent, Int) -> [(LabelledContent, Int)]
forall k a. Map k a -> [a]
elems (Map UID (LabelledContent, Int) -> [(LabelledContent, Int)])
-> Map UID (LabelledContent, Int) -> [(LabelledContent, Int)]
forall a b. (a -> b) -> a -> b
$ ChunkDB
cdb ChunkDB
-> Getting
     (Map UID (LabelledContent, Int))
     ChunkDB
     (Map UID (LabelledContent, Int))
-> Map UID (LabelledContent, Int)
forall s a. s -> Getting a s a -> a
^. Getting
  (Map UID (LabelledContent, Int))
  ChunkDB
  (Map UID (LabelledContent, Int))
Lens' ChunkDB (Map UID (LabelledContent, Int))
labelledcontentTable
  ]
  -- FIXME: HACK: Almost nothing should ever be "gathering everything" from a
  -- ChunkDB unless it is intended to do something highly generic, such as an
  -- analysis, like walking along a UID-tree to build the "trace graphs." We
  -- should not be using this as part of the renderer, however, to search for
  -- all $x$ for rendering. The ChunkDB is allowed to have more knowledge in it
  -- than we strictly need for a specific use of Drasil. To get the point
  -- across, we should be able to merge ALL of our individual ChunkDBs in
  -- Drasil, feed the same ChunkDBs into the SmithEtAl generator along with the
  -- /specific/ problem descriptions and generate the exact same artifacts. The
  -- fact that there would be knowledge/chunks in the ChunkDB that the generator
  -- would never access should have no impact.