-- | Defines functions to create .toml and .csv config files for mdBook.
module Language.Drasil.Markdown.Config (makeBook, makeRequirements, mkTitle) where

import Data.List (intercalate)
import Control.Lens((^.))
import Text.PrettyPrint (Doc, text, vcat, (<+>))
import System.FilePath (takeFileName)

import Language.Drasil (Document(Document), LabelledContent(LblC, _ctype),
  RawContent(Figure), Sentence)

import Drasil.Database.SearchTools (findAllLabelledContent)
import Language.Drasil.Markdown.Print (pSpec)
import Language.Drasil.Printing.PrintingInformation (PrintingInformation, sysdb)
import Language.Drasil.Printing.Import.Sentence (spec)
import Language.Drasil.Printing.LayoutObj (Filepath)

-- | 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 [
  [Char] -> Doc
text [Char]
"[book]",
  [Char] -> Doc
text [Char]
"language = \"en\"",
  [Char] -> Doc
text [Char]
"src = \"src\"",
  [Char] -> Doc
text [Char]
"title =" Doc -> Doc -> Doc
<+> PrintingInformation -> Title -> Doc
mkTitle PrintingInformation
sm Title
t,
  [Char] -> Doc
text [Char]
"[output.html]",
  [Char] -> Doc
text [Char]
"smart-punctuation = true",
  [Char] -> Doc
text [Char]
"mathjax-support = true"
  ]
makeBook Document
_ PrintingInformation
_ = [Char] -> Doc
forall a. HasCallStack => [Char] -> a
error [Char]
"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 = [[[Char]]] -> Doc
makeCSV ([[[Char]]] -> Doc) -> [[[Char]]] -> Doc
forall a b. (a -> b) -> a -> b
$ [[Char]
"Original", [Char]
"Copy"] [[Char]] -> [[[Char]]] -> [[[Char]]]
forall a. a -> [a] -> [a]
: PrintingInformation -> [[[Char]]]
assetMat PrintingInformation
sm

-- | Render a title 'Sentence'.
mkTitle :: PrintingInformation -> Sentence -> Doc
mkTitle :: PrintingInformation -> Title -> Doc
mkTitle PrintingInformation
sm Title
t = [Char] -> Doc
text [Char]
"\"" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> RefMap -> Spec -> Doc
pSpec RefMap
forall a. Monoid a => a
mempty (PrintingInformation -> Title -> Spec
spec PrintingInformation
sm Title
t) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Char] -> Doc
text [Char]
"\""

-- | Map the original filepaths of assets to the location mdBook generator
-- needs.
assetMat :: PrintingInformation -> [[Filepath]]
assetMat :: PrintingInformation -> [[[Char]]]
assetMat PrintingInformation
pinfo =
  [[[Char]
fp, [Char]
"src/assets/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
takeFileName [Char]
fp]
    | LblC { _ctype :: LabelledContent -> RawContent
_ctype = Figure Title
_ [Char]
fp MaxWidthPercent
_ HasCaption
_ } <- ChunkDB -> [LabelledContent]
findAllLabelledContent (PrintingInformation
pinfo PrintingInformation
-> Getting ChunkDB PrintingInformation ChunkDB -> ChunkDB
forall s a. s -> Getting a s a -> a
^. Getting ChunkDB PrintingInformation ChunkDB
Lens' PrintingInformation ChunkDB
sysdb)]

-- | Creates a CSV file as a 'Doc' from a 'String' matrix.
makeCSV :: [[String]] -> Doc
makeCSV :: [[[Char]]] -> Doc
makeCSV [[[Char]]]
rows = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ([[Char]] -> Doc) -> [[[Char]]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Doc
text ([Char] -> Doc) -> ([[Char]] -> [Char]) -> [[Char]] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
formatRow) [[[Char]]]
rows
  where
    -- | Seperates each row item with a comma.
    formatRow :: [String] -> String
    formatRow :: [[Char]] -> [Char]
formatRow = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," ([[Char]] -> [Char])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
escape

    -- | Adds quotations around the item if it contains ',', '"', \n', or ' '.
    escape :: String -> String
    escape :: [Char] -> [Char]
escape [Char]
s
      | (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
",\"\n ") [Char]
s = [Char]
"\"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ (Char -> [Char]) -> [Char] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> [Char]
escapeChar [Char]
s [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\""
      | Bool
otherwise = [Char]
s

    -- | Escapes double quotes.
    escapeChar :: Char -> String
    escapeChar :: Char -> [Char]
escapeChar Char
'"' = [Char]
"\"\""
    escapeChar Char
c   = [Char
c]