-- | 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

-- | Helper function to render the title
-- 'Sentence' as a 'Doc'
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
"\""

-- | Helper function to map the original filepaths of assets
-- to the location mdBook uses.
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
  ]