---------------------------------------------------------------------
--
-- Module      :  Uniform.Panrep2pdf
---------------------------------------------------------------------
{-# LANGUAGE ConstraintKinds #-}
-- {-# LANGUAGE DeriveAnyClass #-}
-- {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wall -fno-warn-orphans
            -fno-warn-missing-signatures
            -fno-warn-missing-methods
            -fno-warn-duplicate-exports
            -fno-warn-unused-imports
            -fno-warn-unused-matches #-}

{- |  ready for processing to HTML or to TexSnip -> Tex -> Pdf
-}
{-# OPTIONS_GHC -Wno-deferred-type-errors #-}
module Wave.Panrep2pdf (
    module Wave.Panrep2pdf,
) where

import Foundational.Filetypes4sites
import Foundational.MetaPage
import GHC.Generics (Generic)
import Uniform.Pandoc ( writeTexSnip2 )
import UniformBase

import Uniform.Latex
import Uniform.WritePDF
import Paths_daino (version)

-- ------------------------------------ panrep2texsnip

panrep2texsnip :: NoticeLevel -> Panrep -> ErrIO TexSnip
panrep2texsnip :: NoticeLevel -> Panrep -> ErrIO TexSnip
panrep2texsnip NoticeLevel
debug (Panrep MetaPage
y Pandoc
p) = 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
"\n panrep2texsnip start"]
    Text
res1 <- Pandoc -> ErrIO Text
writeTexSnip2 Pandoc
p
    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
"\n panrep2texsnip res1", forall {a}. Show a => a -> Text
showT Text
res1]
    let res :: TexSnip
res = (MetaPage -> Text -> TexSnip
TexSnip MetaPage
y Text
res1)
    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
"\n panrep2texsnip done"]
    forall (m :: * -> *) a. Monad m => a -> m a
return TexSnip
res


text2absFile :: Path Abs Dir -> Text -> Path Abs File 
text2absFile :: Path Abs Dir -> Text -> Path Abs File
text2absFile Path Abs Dir
doughP Text
t = Path Abs Dir
doughP forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> FilePath -> Path Rel File
makeRelFile (Text -> FilePath
t2s Text
t)

texsnip2tex :: NoticeLevel ->  Path Abs Dir -> Path Abs Dir -> TexSnip ->  Path Abs File -> ErrIO Latex
-- the (lead) snip which comes from the md which gives the name to the resulting tex and pdf 
-- and ist metadata are included (taken from the snip)
-- it may include other filenames, the snips of these
-- are then included in the pdf built. 

-- currently only one snip, 
-- currently the biblio and references seem not to work with the new citeproc stuff (which takes the info from the )
texsnip2tex :: NoticeLevel
-> Path Abs Dir
-> Path Abs Dir
-> TexSnip
-> Path Abs File
-> ErrIO Latex
texsnip2tex  NoticeLevel
debug Path Abs Dir
doughP Path Abs Dir
bakedP TexSnip
snip1 Path Abs File
latexDtpl = 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
"\n texsnip2tex start"]
    let yam :: MetaPage
yam = TexSnip -> MetaPage
snipyam TexSnip
snip1 
    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
"\n texsnip2tex for link", forall {a}. Show a => a -> Text
showT (MetaPage -> FilePath
dyFn MetaPage
yam)]
    let latexparam :: LatexParam
latexparam = LatexParam 
            { latTitle :: Text
latTitle = MetaPage -> Text
dyTitle MetaPage
yam 
            , latAuthor :: Text
latAuthor = MetaPage -> Text
dyAuthor MetaPage
yam
            , latAbstract :: Text
latAbstract = MetaPage -> Text
dyAbstract MetaPage
yam
            , latLanguage :: Text
latLanguage = Text -> Text
latexLangConversion forall a b. (a -> b) -> a -> b
$ MetaPage -> Text
dyLang MetaPage
yam 
            , latFn :: Text
latFn = FilePath -> Text
s2t forall a b. (a -> b) -> a -> b
$ MetaPage -> FilePath
dyFn MetaPage
yam
            , latBakedDir :: Text
latBakedDir = FilePath -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> FilePath
toFilePath forall a b. (a -> b) -> a -> b
$ Path Abs Dir
doughP 
            , latDainoVersion :: Text
latDainoVersion = forall {a}. Show a => a -> Text
showT Version
version
            , latBibliography :: Text
latBibliography = (FilePath -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> FilePath
toFilePath forall a b. (a -> b) -> a -> b
$ Path Abs Dir
doughP) forall a. Semigroup a => a -> a -> a
<> (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"resources/BibTexLatex.bib" forall a. a -> a
id (MetaPage -> Maybe Text
dyBibliography MetaPage
yam))
                -- fix an absolute path for the bib files 
                -- will be dificult if not in the resources?
            -- make this an abs file name 
            , latBiblioTitle :: Text
latBiblioTitle = Text
"References"
            -- todo depends on latLanguage
            , latStyle :: Text
latStyle    = MetaPage -> Text
dyStyleBiber (TexSnip -> MetaPage
snipyam  TexSnip
snip1)
                --  maybe "authoryear" id $ dyStyleBiber yam
            , latReferences :: Text
latReferences = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (forall a. NiceStrings a => a -> Text
shownice ) forall a b. (a -> b) -> a -> b
$ MetaPage -> Maybe Value
dyReferences MetaPage
yam
            , latBook :: Text
latBook = MetaPage -> Text
dyBook MetaPage
yam
            , latIndex :: IndexEntry
latIndex = forall z. Zeros z => z
zero -- the collected index 
            , latContent :: Text
latContent = TexSnip -> Text
unTexSnip TexSnip
snip1 -- the content of this file
            -- , latTheme = dy 
            -- , latSnips = zero 
        }
 

    let webroot :: Path Abs Dir
webroot = Path Abs Dir
doughP  -- use the images befor they are copied
        -- snip1 = unTexSnip p 
    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
"\n texsnip2tex dyIndexEntry"
        , forall {a}. Show a => a -> Text
showT (MetaPage -> IndexEntry
dyIndexEntry MetaPage
yam)]
    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
"\n texsnip2tex latexparam"
        , forall {a}. Show a => a -> Text
showT LatexParam
latexparam]
    -- snips :: [Text] <- if "book" == dyBook yam 
    --     then  collectSnips4index debug bakedP (dyIndexEntry yam)
    --     else return []
    -- let snips2 = concat' [snip1 , concat' snips ]
    -- -- let snips2 =  concat' .  map unTexSnip $ [p] :: Text
    -- res2 <- tex2latex debug webroot latexparam snips2
    LatexParam
latexparam4 <- if Text
"book" forall a. Eq a => a -> a -> Bool
== MetaPage -> Text
dyBook MetaPage
yam 
        then do 
            let latexparam2 :: LatexParam
latexparam2 = LatexParam
latexparam{latIndex :: IndexEntry
latIndex=MetaPage -> IndexEntry
dyIndexEntry MetaPage
yam}
            LatexParam
latexparam3 <- NoticeLevel
-> Path Abs Dir -> LatexParam -> ExceptT Text IO LatexParam
completeIndexWithContent NoticeLevel
debug Path Abs Dir
bakedP LatexParam
latexparam2
            forall (m :: * -> *) a. Monad m => a -> m a
return LatexParam
latexparam3
        else forall (m :: * -> *) a. Monad m => a -> m a
return LatexParam
latexparam
     

    Text
res2 <- NoticeLevel
-> Path Abs Dir -> LatexParam -> Path Abs File -> ErrIO Text
tex2latex NoticeLevel
debug Path Abs Dir
webroot LatexParam
latexparam4 Path Abs File
latexDtpl 
    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
"texsnip2tex unprocessed texsnip ", forall {a}. Show a => a -> Text
showT Text
res2]
   
    -- tex file must be full, ordinary latex content

    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
"\n texsnip2tex done"]
    forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Latex
Latex forall a b. (a -> b) -> a -> b
$ Text
res2

completeIndexWithContent :: NoticeLevel -> Path Abs Dir -> LatexParam -> ErrIO LatexParam
completeIndexWithContent :: NoticeLevel
-> Path Abs Dir -> LatexParam -> ExceptT Text IO LatexParam
completeIndexWithContent NoticeLevel
debug Path Abs Dir
bakedP LatexParam
latexparam2 = do 
    let 
        latix2 :: IndexEntry
latix2 = LatexParam -> IndexEntry
latIndex LatexParam
latexparam2 
        fileixs :: [IndexEntry]
fileixs = IndexEntry -> [IndexEntry]
fileEntries IndexEntry
latix2 
    [IndexEntry]
fileixs2 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (NoticeLevel -> Path Abs Dir -> IndexEntry -> ErrIO IndexEntry
completeOneIx NoticeLevel
debug Path Abs Dir
bakedP)  [IndexEntry]
fileixs
    
    let latix3 :: IndexEntry
latix3 = IndexEntry
latix2{fileEntries :: [IndexEntry]
fileEntries = [IndexEntry]
fileixs2}
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ LatexParam
latexparam2{latIndex :: IndexEntry
latIndex = IndexEntry
latix3}

-- collectSnips4index :: NoticeLevel -> Path Abs Dir -> IndexEntry -> ErrIO [Text]
-- -- collect the TexSnip for the index  
-- -- uses the link which is a web page relative to web root 
-- -- get title and abstract and add to snip 
-- collectSnips4index debug bakedP ix = do 
--     when (informAll debug) $ putIOwords ["\n collectSnips4index start"
--                 , "for ix", showT (ixfn ix)
--                 ]
--     texsnips :: [Text] <-  (completeOneSnip debug bakedP) (fileEntries ix)
--     return texsnips

--     -- let fns = map (link)(fileEntries ix) :: [FilePath] 
--     --         -- what to do with the dirEntries? 
--     --     fnsFP = map makeRelFile fns :: [Path Rel File]
--     --     fnsP = map (\fn -> bakedP </> fn) fnsFP :: [Path Abs File]
--     -- -- texsnips :: [TexSnip] <- mapM (\fn -> read8 fn texSnipFileType) fnsP 
--     -- let snips = map unTexSnip texsnips 
--     -- let res = snips 
--     -- when (informAll debug) $ putIOwords ["\n collectSnips4index end"
--     --             , "for res", showT res]
--     -- return res

completeOneIx :: NoticeLevel -> Path Abs Dir -> IndexEntry -> ErrIO IndexEntry
    -- get the snip for one index entry 
    -- only the content (abstract and title collected before) 
completeOneIx :: NoticeLevel -> Path Abs Dir -> IndexEntry -> ErrIO IndexEntry
completeOneIx NoticeLevel
debug Path Abs Dir
bakedP IndexEntry
ix = 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
"\n completeOneIx start", forall {a}. Show a => a -> Text
showT IndexEntry
ix]
    let
        -- tit = title ix
        -- titsnip = "\\part{"<> title ix <> "}"
        -- abssnip = "\\begin{abstract}" <> abstract ix <> "\\end{abstract}"
        ln :: Path Rel File
ln = FilePath -> Path Rel File
makeRelFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexEntry -> FilePath
link forall a b. (a -> b) -> a -> b
$ IndexEntry
ix 
        lnfp :: Path Abs File
lnfp = Path Abs Dir
bakedP forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> Path Rel File
ln :: Path Abs File 

    TexSnip
texsnip1 :: TexSnip <-   forall a b.
TypedFiles7a a b =>
Path Abs File -> TypedFile5 a b -> ErrIO b
read8 Path Abs File
lnfp TypedFile5 Text TexSnip
texSnipFileType 
    -- let res = unlines' [zero, titsnip, "", abssnip, "", unTexSnip texsnip1]
    let ix2 :: IndexEntry
ix2 = IndexEntry
ix{content :: Text
content =  TexSnip -> Text
unTexSnip TexSnip
texsnip1}
    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
"\n completeOneIx end", forall {a}. Show a => a -> Text
showT IndexEntry
ix2]
    forall (m :: * -> *) a. Monad m => a -> m a
return IndexEntry
ix2


-- ------------------------------------ tex2pdf


-- refdir must be set to the dir where searches for 
-- biblio etc start - seems not correct
-- the refdir is where the intermediate files are put
-- this is fnres - just the doughPath
tex2pdf :: NoticeLevel -> Path Abs File ->  Path Abs File ->  Path Abs Dir ->  ErrIO ()
tex2pdf :: NoticeLevel
-> Path Abs File
-> Path Abs File
-> Path Abs Dir
-> ExceptT Text IO ()
tex2pdf NoticeLevel
debug Path Abs File
fn Path Abs File
fnres Path Abs Dir
doughP  =  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
"\n tex2pdf start for", forall {a}. Show a => a -> Text
showT Path Abs File
fn]
    let refDir :: Path Abs Dir
refDir = -- makeAbsDir "/home/frank/bakedTestSite"
                    -- dough does not work either
                    -- must be local dir of file to process
            FilePath -> Path Abs Dir
makeAbsDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall fp. Filenames1 fp => fp -> FilePath
getParentDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b t. Path b t -> FilePath
toFilePath forall a b. (a -> b) -> a -> b
$ Path Abs File
fn :: Path Abs Dir
    -- refDir must be the place where biblio is place (or searched from - best ) - i.e. the root for dough 
    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
"\n tex2pdf refDir", forall {a}. Show a => a -> Text
showT Path Abs Dir
refDir]
    Latex
texf <- forall a b.
TypedFiles7a a b =>
Path Abs File -> TypedFile5 a b -> ErrIO b
read8 Path Abs File
fn TypedFile5 Text Latex
texFileType
    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
"\n tex2pdf texf content", forall {a}. Show a => a -> Text
showT Latex
texf]
    NoticeLevel
-> Path Abs File
-> Path Abs File
-> Path Abs Dir
-> ExceptT Text IO ()
writePDF2 NoticeLevel
debug  Path Abs File
fn Path Abs File
fnres Path Abs Dir
refDir
    -- for debug put only the file unprocessed
    -- write8 fnres pdfFileType (PDFfile . unLatex $ texf)
    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
"\n tex2pdf done"]
    forall (m :: * -> *) a. Monad m => a -> m a
return ()