----------------------------------------------------------------
--
-- Module      :  Uniform.latex
--
-- | convert latex to pdf 
---------------------------------------------------------------
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DeriveGeneric  #-}
{-# LANGUAGE DeriveAnyClass  #-}

{-# OPTIONS_GHC -w #-}

module Uniform.Latex
  ( module Uniform.Latex
--   , writePDF2
  ) where

import Uniform.PandocImports
import Text.DocTemplates as DocTemplates
import Text.DocLayout (render)

import UniformBase
import Data.Aeson


data LatexParam = LatexParam
-- | the fields from the yaml date passed to latex-pdf
    { LatexParam -> Text
latTitle ::  Text  
    , LatexParam -> Text
latAuthor :: Text 
    , LatexParam -> Text
latAbstract ::  Text
    , LatexParam -> Text
latLanguage :: Text
    , LatexParam -> Text
latFn :: Text         -- ^ the original source fn
    , LatexParam -> Text
latBakedDir :: Text -- ^ the baked dir 
    , LatexParam -> Text
latDainoVersion :: Text 
    , LatexParam -> Text
latBibliography  :: Text  -- the bibliio file 
    , LatexParam -> Text
latBiblioTitle :: Text 
            -- problem with multiple files? probably not required
    , LatexParam -> Text
latStyle :: Text
            -- is not used 
    , LatexParam -> Text
latReferences :: Text  -- ^ used only for citeproc to produce html, not for biblatex to produce pdf 
    -- , latReference_section_title :: Text -- ^ the text for the title of the ref section
    -- selection by language
    , LatexParam -> Text
latBook :: Text  -- is this a long text for a book/booklet
    , LatexParam -> IndexEntry
latIndex :: IndexEntry
    , LatexParam -> Text
latContent :: Text -- ^ the content to fill 
    -- , latThema :: Path Abs File 
    -- , latSnips :: [IndexEntry] -- ^ the snips 
    }
    deriving (LatexParam -> LatexParam -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LatexParam -> LatexParam -> Bool
$c/= :: LatexParam -> LatexParam -> Bool
== :: LatexParam -> LatexParam -> Bool
$c== :: LatexParam -> LatexParam -> Bool
Eq, Eq LatexParam
LatexParam -> LatexParam -> Bool
LatexParam -> LatexParam -> Ordering
LatexParam -> LatexParam -> LatexParam
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LatexParam -> LatexParam -> LatexParam
$cmin :: LatexParam -> LatexParam -> LatexParam
max :: LatexParam -> LatexParam -> LatexParam
$cmax :: LatexParam -> LatexParam -> LatexParam
>= :: LatexParam -> LatexParam -> Bool
$c>= :: LatexParam -> LatexParam -> Bool
> :: LatexParam -> LatexParam -> Bool
$c> :: LatexParam -> LatexParam -> Bool
<= :: LatexParam -> LatexParam -> Bool
$c<= :: LatexParam -> LatexParam -> Bool
< :: LatexParam -> LatexParam -> Bool
$c< :: LatexParam -> LatexParam -> Bool
compare :: LatexParam -> LatexParam -> Ordering
$ccompare :: LatexParam -> LatexParam -> Ordering
Ord, ReadPrec [LatexParam]
ReadPrec LatexParam
Int -> ReadS LatexParam
ReadS [LatexParam]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LatexParam]
$creadListPrec :: ReadPrec [LatexParam]
readPrec :: ReadPrec LatexParam
$creadPrec :: ReadPrec LatexParam
readList :: ReadS [LatexParam]
$creadList :: ReadS [LatexParam]
readsPrec :: Int -> ReadS LatexParam
$creadsPrec :: Int -> ReadS LatexParam
Read, Int -> LatexParam -> ShowS
[LatexParam] -> ShowS
LatexParam -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [LatexParam] -> ShowS
$cshowList :: [LatexParam] -> ShowS
show :: LatexParam -> FilePath
$cshow :: LatexParam -> FilePath
showsPrec :: Int -> LatexParam -> ShowS
$cshowsPrec :: Int -> LatexParam -> ShowS
Show, forall x. Rep LatexParam x -> LatexParam
forall x. LatexParam -> Rep LatexParam x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LatexParam x -> LatexParam
$cfrom :: forall x. LatexParam -> Rep LatexParam x
Generic, [LatexParam] -> Encoding
[LatexParam] -> Value
LatexParam -> Encoding
LatexParam -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [LatexParam] -> Encoding
$ctoEncodingList :: [LatexParam] -> Encoding
toJSONList :: [LatexParam] -> Value
$ctoJSONList :: [LatexParam] -> Value
toEncoding :: LatexParam -> Encoding
$ctoEncoding :: LatexParam -> Encoding
toJSON :: LatexParam -> Value
$ctoJSON :: LatexParam -> Value
ToJSON)


instance Zeros LatexParam where 
    zero :: LatexParam
zero = Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> IndexEntry
-> Text
-> LatexParam
LatexParam forall z. Zeros z => z
zero forall z. Zeros z => z
zero forall z. Zeros z => z
zero forall z. Zeros z => z
zero forall z. Zeros z => z
zero forall z. Zeros z => z
zero forall z. Zeros z => z
zero forall z. Zeros z => z
zero forall z. Zeros z => z
zero forall z. Zeros z => z
zero 
                forall z. Zeros z => z
zero forall z. Zeros z => z
zero forall z. Zeros z => z
zero forall z. Zeros z => z
zero 

-- instance FromJSON LatexParam where
--   parseJSON = genericParseJSON defaultOptions {
--                 fieldLabelModifier =  toLower' . drop 3 }

-- doclatexOptions =
--     defaultOptions
--         { fieldLabelModifier = t2s . toLowerStart . s2t . drop 2
--         }

-- instance ToJSON LatexParam where
--     toJSON = genericToJSON -- doclatexOptions - why dropping 2?

data IndexEntry = IndexEntry 
    { -- | the abs file path
      IndexEntry -> FilePath
ixfn :: FilePath -- Path Abs File
    , -- | the link for this page (relative to web root)}
      IndexEntry -> FilePath
link :: FilePath -- Path Rel File
    , IndexEntry -> Text
title :: Text
    , IndexEntry -> Text
abstract :: Text
    , IndexEntry -> Text
author :: Text
    , IndexEntry -> Text
date :: Text
    , IndexEntry -> Text
content :: Text   -- in latex style, only filled bevore use
    -- , publish :: Maybe Text
    -- , indexPage :: Bool
    , IndexEntry -> [IndexEntry]
dirEntries :: [IndexEntry] -- def []
    , IndexEntry -> [IndexEntry]
fileEntries :: [IndexEntry] -- def []
    , IndexEntry -> Int
headerShift :: Int   
    } deriving (Int -> IndexEntry -> ShowS
[IndexEntry] -> ShowS
IndexEntry -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [IndexEntry] -> ShowS
$cshowList :: [IndexEntry] -> ShowS
show :: IndexEntry -> FilePath
$cshow :: IndexEntry -> FilePath
showsPrec :: Int -> IndexEntry -> ShowS
$cshowsPrec :: Int -> IndexEntry -> ShowS
Show, ReadPrec [IndexEntry]
ReadPrec IndexEntry
Int -> ReadS IndexEntry
ReadS [IndexEntry]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IndexEntry]
$creadListPrec :: ReadPrec [IndexEntry]
readPrec :: ReadPrec IndexEntry
$creadPrec :: ReadPrec IndexEntry
readList :: ReadS [IndexEntry]
$creadList :: ReadS [IndexEntry]
readsPrec :: Int -> ReadS IndexEntry
$creadsPrec :: Int -> ReadS IndexEntry
Read, IndexEntry -> IndexEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexEntry -> IndexEntry -> Bool
$c/= :: IndexEntry -> IndexEntry -> Bool
== :: IndexEntry -> IndexEntry -> Bool
$c== :: IndexEntry -> IndexEntry -> Bool
Eq, Eq IndexEntry
IndexEntry -> IndexEntry -> Bool
IndexEntry -> IndexEntry -> Ordering
IndexEntry -> IndexEntry -> IndexEntry
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IndexEntry -> IndexEntry -> IndexEntry
$cmin :: IndexEntry -> IndexEntry -> IndexEntry
max :: IndexEntry -> IndexEntry -> IndexEntry
$cmax :: IndexEntry -> IndexEntry -> IndexEntry
>= :: IndexEntry -> IndexEntry -> Bool
$c>= :: IndexEntry -> IndexEntry -> Bool
> :: IndexEntry -> IndexEntry -> Bool
$c> :: IndexEntry -> IndexEntry -> Bool
<= :: IndexEntry -> IndexEntry -> Bool
$c<= :: IndexEntry -> IndexEntry -> Bool
< :: IndexEntry -> IndexEntry -> Bool
$c< :: IndexEntry -> IndexEntry -> Bool
compare :: IndexEntry -> IndexEntry -> Ordering
$ccompare :: IndexEntry -> IndexEntry -> Ordering
Ord, forall x. Rep IndexEntry x -> IndexEntry
forall x. IndexEntry -> Rep IndexEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IndexEntry x -> IndexEntry
$cfrom :: forall x. IndexEntry -> Rep IndexEntry x
Generic, IndexEntry
Eq IndexEntry => IndexEntry -> Bool
forall z.
z -> (Eq z => z -> Bool) -> (Eq z => z -> Bool) -> Zeros z
notZero :: Eq IndexEntry => IndexEntry -> Bool
$cnotZero :: Eq IndexEntry => IndexEntry -> Bool
isZero :: Eq IndexEntry => IndexEntry -> Bool
$cisZero :: Eq IndexEntry => IndexEntry -> Bool
zero :: IndexEntry
$czero :: IndexEntry
Zeros)
    --  IndexTitleSubdirs | IndexTitleFiles 

-- instance Zeros IndexEntry where zero = IndexEntry zero zero zero zero zero zero zero zero zero

instance ToJSON IndexEntry
instance FromJSON IndexEntry

tex2latex :: NoticeLevel ->   Path Abs Dir -> LatexParam -> Path Abs File ->   ErrIO Text
-- ^ combine the latex template with the latexParam
-- the latexParam are previously filled with the content snip 
-- and the index entries 
-- needs the web root (dough dir) to find graphics

tex2latex :: NoticeLevel
-> Path Abs Dir -> LatexParam -> Path Abs File -> ErrIO Text
tex2latex NoticeLevel
debug   Path Abs Dir
webroot LatexParam
latpar Path Abs File
templFn = do 
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NoticeLevel -> Bool
inform NoticeLevel
debug) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"tex2latex start for latFn", LatexParam -> Text
latFn LatexParam
latpar]
    -- let templFn = makeAbsFile "/home/frank/Workspace11/u4blog/uniform-latex2pdf/src/Uniform/latex.dtpl"
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NoticeLevel -> Bool
inform NoticeLevel
debug) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"tex2latex template fn", forall {a}. Show a => a -> Text
showT Path Abs File
templFn]
    -- templtxt <- readFile2 templFn
    -- putIOwords ["tex2latex template", templtxt]
    Either FilePath (Template Text)
templ1<- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a.
TemplateTarget a =>
FilePath -> IO (Either FilePath (Template a))
compileTemplateFile (forall b t. Path b t -> FilePath
toFilePath Path Abs File
templFn) 
    -- templ1<- liftIO $ compileTemplate mempty templ 
    let templ3 :: Template Text
templ3 = case Either FilePath (Template Text)
templ1 of
            Left FilePath
msg -> forall a. [Text] -> a
errorT [Text
"applyTemplate4 error", FilePath -> Text
s2t FilePath
msg]
            Right Template Text
tmp2 -> Template Text
tmp2
    -- let latpar2 = latpar{latContent = snip}   already filled     
    let latparJ :: Value
latparJ = forall a. ToJSON a => a -> Value
toJSON LatexParam
latpar
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NoticeLevel -> Bool
inform NoticeLevel
debug) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"tex2latex latparJ", forall {a}. Show a => a -> Text
showT Value
latparJ]
    let doc1 :: Doc Text
doc1 =  forall a b.
(TemplateTarget a, ToContext a b) =>
Template a -> b -> Doc a
renderTemplate Template Text
templ3 Value
latparJ
    let doc2 :: Text
doc2 = forall a. HasChars a => Maybe Int -> Doc a -> a
render forall a. Maybe a
Nothing Doc Text
doc1
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NoticeLevel -> Bool
inform NoticeLevel
debug) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"tex2latex result",  Text
doc2]
    forall (m :: * -> *) a. Monad m => a -> m a
return Text
doc2


latexLangConversion :: Text -> Text 
latexLangConversion :: Text -> Text
latexLangConversion Text
inlang = 
    case Text
lang2 of 
        Text
"de" -> Text
"ngerman"
        Text
"en" -> Text
"english"
        Text
_ -> Text
"english"
    where 
        lang2 :: Text
lang2 = forall a. CharChains a => Int -> a -> a
take' Int
2 Text
inlang


-- https://tex.stackexchange.com/questions/82993/how-to-change-the-name-of-document-elements-like-figure-contents-bibliogr
-- for an automatic adaption based on the language
-- \renewcaptionname{ngerman}{\contentsname}{Inhalt}           %Table of contents
-- \renewcaptionname{ngerman}{\listfigurename}{Abbildungen}    %Figures
-- \renewcaptionname{ngerman}{\listtablename}{Tabellen}        %Tables
-- \renewcaptionname{ngerman}{\figurename}{Abb.}               %Figure
-- \renewcaptionname{ngerman}{\tablename}{Tab.}                %Table
-- \renewcaptionname{ngerman}{\bibname}{Literatur}             %Bibliography
--   \newcaptionname{ngerman}{\lstlistlistingname}{Quelltexte} %Table of listings 
--   \newcaptionname{ngerman}{\lstlistingname}{Quelltext}      %Listing