---------------------------------------------------------------------
--
-- Module      :
----------------------------------------------------------------------
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wall -fno-warn-orphans 
            -fno-warn-missing-signatures
            -fno-warn-missing-methods 
            -fno-warn-unused-matches #-}

{- |  process to convert
              files from md to all the formats required
              orginals are found in dire doughDir and go to bakeDir
-}
module ShakeBake.Bake where

import Foundational.SettingsPage  
import Foundational.CmdLineFlags

import Foundational.Filetypes4sites

import Wave.Docrep2panrep 
import Wave.Md2doc  
import Wave.Panrep2pdf


-- import Uniform2.Markdown  
-- import Uniform.Pandoc
-- import Uniform2.ProcessPDF  
import Uniform.Http

import Wave.Panrep2html  
import UniformBase
-- import Foundational.SettingsPage (SiteLayout(texTemplateFile))

type BakeOp =
    NoticeLevel ->
    PubFlags ->
    -- | md file
    Path Abs File ->
    Settings->
    Path Abs File ->
    ErrIO [FilePath] -- additional needs found 

bakeOneMD2docrep :: BakeOp --    MD -> DOCREP
-- process the md to pandoc format (parser)
-- and add the refs 
bakeOneMD2docrep :: BakeOp
bakeOneMD2docrep NoticeLevel
debug PubFlags
flags Path Abs File
inputFn Settings
sett3 Path Abs File
resfn2 = 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-----------------"
        , Text
"bakeOneMD2docrep 1 fn", forall {a}. Show a => a -> Text
showT Path Abs File
inputFn
        , Text
"\n resfn2", forall {a}. Show a => a -> Text
showT Path Abs File
resfn2
        ]
    -- let layout = siteLayout sett3
    -- let doughP = doughDir layout
    -- let hpname = blogAuthorToSuppress . siteLayout $ sett3
    Docrep
dr3 <- NoticeLevel -> Settings -> Path Abs File -> ErrIO Docrep
readMarkdownFile2docrep NoticeLevel
debug Settings
sett3  Path Abs File
inputFn 
    Docrep
dr4 <- NoticeLevel -> Docrep -> ErrIO Docrep
addRefs NoticeLevel
debug Docrep
dr3

    forall a b.
TypedFiles7a a b =>
Path Abs File -> TypedFile5 a b -> b -> ExceptT Text IO ()
write8 Path Abs File
resfn2 TypedFile5 Text Docrep
docrepFileType Docrep
dr4

    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-----------------"
            , Text
"bakeOneMD2docrep done resfn2"
            , forall {a}. Show a => a -> Text
showT Path Abs File
resfn2
            ]
    forall (m :: * -> *) a. Monad m => a -> m a
return []

bakeOneDocrep2panrep :: BakeOp --  DOCREP -> PANREP
--   add index  
bakeOneDocrep2panrep :: BakeOp
bakeOneDocrep2panrep NoticeLevel
debug PubFlags
flags Path Abs File
inputFn Settings
sett3 Path Abs File
resfn2 = 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
"-----------------"
        , Text
"bakeOneDocrep2panrep 1 inputFn"
        , forall {a}. Show a => a -> Text
showT Path Abs File
inputFn
        , forall {a}. Show a => a -> Text
showT Path Abs File
resfn2
        ]
    Docrep
dr1 <- forall a b.
TypedFiles7a a b =>
Path Abs File -> TypedFile5 a b -> ErrIO b
read8 Path Abs File
inputFn TypedFile5 Text Docrep
docrepFileType

    -- let layout = siteLayout sett3
    (Panrep
p3, [FilePath]
needsFound) <- NoticeLevel
-> PubFlags -> Settings -> Docrep -> ErrIO (Panrep, [FilePath])
docrep2panrep NoticeLevel
debug PubFlags
flags Settings
sett3 Docrep
dr1
            -- completes index and should process reps 
            -- what to do with needs?
    -- needP needsFound 

    forall a b.
TypedFiles7a a b =>
Path Abs File -> TypedFile5 a b -> b -> ExceptT Text IO ()
write8 Path Abs File
resfn2 TypedFile5 Text Panrep
panrepFileType Panrep
p3 -- content is html style
    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-----------------", Text
"bakeOneDocrep2panrep done produced resf2n", forall {a}. Show a => a -> Text
showT Path Abs File
resfn2]
    forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath]
needsFound


bakeOnePanrep2html :: BakeOp -- PANREP -> HTML  -- TODO
bakeOnePanrep2html :: BakeOp
bakeOnePanrep2html NoticeLevel
debug PubFlags
flags Path Abs File
inputFn Settings
sett3 Path Abs File
resfn2 = 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-----------------"
        , Text
"bakeOnePanrep2html 1 fn"
        , forall {a}. Show a => a -> Text
showT Path Abs File
inputFn
        , Text
"\n resfn2"
        , forall {a}. Show a => a -> Text
showT Path Abs File
resfn2
        ]
    Panrep
dr1 <- forall a b.
TypedFiles7a a b =>
Path Abs File -> TypedFile5 a b -> ErrIO b
read8 Path Abs File
inputFn TypedFile5 Text Panrep
panrepFileType
    -- let layout = siteLayout sett3
    -- this gives the siteLayout section of settingsN.yml file
    -- let staticMenu = sett3
    -- let mf = masterTemplateFile layout
    -- let masterfn = templatesDir layout </> mf

    HTMLout
p <- NoticeLevel -> Settings -> Panrep -> ErrIO HTMLout
panrep2html NoticeLevel
debug  Settings
sett3 Panrep
dr1

    forall a b.
TypedFiles7a a b =>
Path Abs File -> TypedFile5 a b -> b -> ExceptT Text IO ()
write8 Path Abs File
resfn2 TypedFile5 Text HTMLout
htmloutFileType HTMLout
p -- content is html style
    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-----------------", Text
"bakeOnePanrep2html done fn", forall {a}. Show a => a -> Text
showT Path Abs File
resfn2]
    forall (m :: * -> *) a. Monad m => a -> m a
return []


bakeOnePanrep2texsnip :: BakeOp --  PANREP -> TEXSNIP
-- TODO
bakeOnePanrep2texsnip :: BakeOp
bakeOnePanrep2texsnip NoticeLevel
debug PubFlags
flags Path Abs File
inputFn Settings
sett3 Path Abs File
resfn2 = do
                -- debug flags inputFn layout resfn2 
    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-----------------"
        , Text
"bakeOnePanrep2texsnip 1 fn"
        , forall {a}. Show a => a -> Text
showT Path Abs File
inputFn
        , Text
"debug"
        , forall {a}. Show a => a -> Text
showT NoticeLevel
debug
        , Text
"\n resfn2"
        , forall {a}. Show a => a -> Text
showT Path Abs File
resfn2
        ]

    Panrep
dr1 <- forall a b.
TypedFiles7a a b =>
Path Abs File -> TypedFile5 a b -> ErrIO b
read8 Path Abs File
inputFn TypedFile5 Text Panrep
panrepFileType
    TexSnip
snip1 <- NoticeLevel -> Panrep -> ErrIO TexSnip
panrep2texsnip NoticeLevel
debug Panrep
dr1
    forall a b.
TypedFiles7a a b =>
Path Abs File -> TypedFile5 a b -> b -> ExceptT Text IO ()
write8 Path Abs File
resfn2 TypedFile5 Text TexSnip
texSnipFileType TexSnip
snip1 -- content is html style
    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-----------------", Text
"bakeOneFile2html done fn", forall {a}. Show a => a -> Text
showT Path Abs File
resfn2]
    forall (m :: * -> *) a. Monad m => a -> m a
return []

bakeOneTexsnip2tex :: BakeOp -- TEXSNIP -> TEX
bakeOneTexsnip2tex :: BakeOp
bakeOneTexsnip2tex NoticeLevel
debug PubFlags
flags Path Abs File
inputFn Settings
sett3 Path Abs File
resfn2 = 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-----------------"
        , Text
"bakeOneFile2tex 1 fn"
        , forall {a}. Show a => a -> Text
showT Path Abs File
inputFn
        , Text
"\n resfn2"
        , forall {a}. Show a => a -> Text
showT Path Abs File
resfn2
        ]


    TexSnip
snip1 <- forall a b.
TypedFiles7a a b =>
Path Abs File -> TypedFile5 a b -> ErrIO b
read8 Path Abs File
inputFn TypedFile5 Text TexSnip
texSnipFileType

    let layout :: SiteLayout
layout = Settings -> SiteLayout
siteLayout Settings
sett3
    let doughP :: Path Abs Dir
doughP = SiteLayout -> Path Abs Dir
doughDir SiteLayout
layout
        bakedP :: Path Abs Dir
bakedP = SiteLayout -> Path Abs Dir
bakedDir SiteLayout
layout 


    Latex
tex1 <- NoticeLevel
-> Path Abs Dir
-> Path Abs Dir
-> TexSnip
-> Path Abs File
-> ErrIO Latex
texsnip2tex NoticeLevel
NoticeLevel0 Path Abs Dir
doughP Path Abs Dir
bakedP TexSnip
snip1 
        ((SiteLayout -> Path Abs Dir
templatesDir SiteLayout
layout) forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> (SiteLayout -> Path Rel File
texTemplateFile SiteLayout
layout))
    -- let tex1 = tex2latex2 zero [snip1]
    forall a b.
TypedFiles7a a b =>
Path Abs File -> TypedFile5 a b -> b -> ExceptT Text IO ()
write8 Path Abs File
resfn2 TypedFile5 Text Latex
texFileType Latex
tex1 -- content is html style
    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-----------------", Text
"bakeOneFile2tex done fn", forall {a}. Show a => a -> Text
showT Path Abs File
resfn2]
    forall (m :: * -> *) a. Monad m => a -> m a
return []

bakeOneTex2pdf :: BakeOp
bakeOneTex2pdf :: BakeOp
bakeOneTex2pdf NoticeLevel
debug PubFlags
flags Path Abs File
inputFn Settings
sett3 Path Abs File
resfn2 = 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-----------------"
        , Text
"bakeOneTex2pdf 1 fn:"
        , forall {a}. Show a => a -> Text
showT Path Abs File
inputFn
        , Text
"\n\t debug:"
        , forall {a}. Show a => a -> Text
showT NoticeLevel
debug
        , Text
"\n\t resfn2:"
        , forall {a}. Show a => a -> Text
showT Path Abs File
resfn2
        ]

    -- let refDir =
            -- makeAbsDir . getParentDir . toFilePath $ inputFn :: Path Abs Dir
    -- dr1 <- read8 inputFn docrepFileType
    let layout :: SiteLayout
layout = Settings -> SiteLayout
siteLayout Settings
sett3
    let doughP :: Path Abs Dir
doughP = SiteLayout -> Path Abs Dir
doughDir SiteLayout
layout

    NoticeLevel
-> Path Abs File
-> Path Abs File
-> Path Abs Dir
-> ExceptT Text IO ()
tex2pdf NoticeLevel
debug  Path Abs File
inputFn Path Abs File
resfn2 Path Abs Dir
doughP -- content is html style
    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-----------------", Text
"bakeOneTex2pdf done fn", forall {a}. Show a => a -> Text
showT Path Abs File
resfn2]
    forall (m :: * -> *) a. Monad m => a -> m a
return []