---------------------------------------------------------------------
--
-- Module      :  Uniform.Doc2html
--  converts an md document in 2steps 
--      docrep -> panrep
        --     includes preparing of index pages 
        --     the processsing of the refs are already done in doc processing 
        -- panrep -> html 
---------------------------------------------------------------------
{-# 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 #-}

 
module Wave.Docrep2panrep (
    module Wave.Docrep2panrep,
) where

import Foundational.Filetypes4sites
    ( Docrep(Docrep), Panrep(Panrep, panyam) )
import Foundational.SettingsPage
 
import Foundational.CmdLineFlags ( PubFlags )

import Foundational.MetaPage

import GHC.Generics (Generic)

import Uniform.Json ( ToJSON(toJSON), Value, ErrIO )
import Uniform.Pandoc ( writeHtml5String2 )
import Uniform.Latex
import Uniform.Http --- out ( HTMLout )
import UniformBase

import Data.Maybe (fromMaybe)

import Lib.IndexMake ( convertIndexEntries, MenuEntry )
import Lib.IndexCollect ( completeIndex )
import Lib.Templating ( putValinMaster )

------------------------------------------------docrep -> panrep

-- | transform a docrep to a panrep (which is the pandoc rep)
--  completes the index (if indexpage else nothing done)

--  the refs are processed before in md2docrep

docrep2panrep :: NoticeLevel -> PubFlags -> Settings -> Docrep -> ErrIO (Panrep, [FilePath])
docrep2panrep :: NoticeLevel
-> PubFlags -> Settings -> Docrep -> ErrIO (Panrep, [FilePath])
docrep2panrep NoticeLevel
debug PubFlags
pubf Settings
sett4 (Docrep MetaPage
y1 Pandoc
p1) = 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\ty1,p1-------------------------docrep2panrep"
                , Text
"\ny1: ", forall {a}. Show a => a -> Text
showT MetaPage
y1
                , Text
"\np1: ", forall {a}. Show a => a -> Text
showT Pandoc
p1]
    -- let pr = Panrep
    --             { panyam = y1
    --             , panpan = p1
    --             }
    let layout :: SiteLayout
layout = Settings -> SiteLayout
siteLayout Settings
sett4 
        hpname :: [Text]
hpname = SiteLayout -> [Text]
blogAuthorToSuppress SiteLayout
layout
        authorReduced :: Text
authorReduced = [Text] -> Text -> Text
blankAuthorName [Text]
hpname (MetaPage -> Text
dyAuthor MetaPage
y1)
        y2 :: MetaPage
y2 = MetaPage
y1{dyAuthor :: Text
dyAuthor = Text
authorReduced}
    
        panrep2 :: Panrep
panrep2 = MetaPage -> Pandoc -> Panrep
Panrep MetaPage
y2 Pandoc
p1

    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
"docrep2panrep"
                , Text
"hpname", forall {a}. Show a => a -> Text
showT [Text]
hpname
                , Text
"\nauthorReduced", Text
authorReduced]

    if Path Abs File -> Bool
isIndexPage (FilePath -> Path Abs File
makeAbsFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaPage -> FilePath
dyFn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Panrep -> MetaPage
panyam forall a b. (a -> b) -> a -> b
$ Panrep
panrep2 )
        then do
    -- if dyIndexPage . panyam $ pr
            let m1 :: MetaPage
m1 = Panrep -> MetaPage
panyam Panrep
panrep2
            let ix1 :: IndexEntry
ix1 =MetaPage -> IndexEntry
dyIndexEntry  MetaPage
m1
            -- let bakedP = bakedDir layout
            let doughP :: Path Abs Dir
doughP = SiteLayout -> Path Abs Dir
doughDir SiteLayout
layout
            IndexEntry
ix2 <- NoticeLevel
-> PubFlags
-> Settings
-> Path Abs Dir
-> Maybe Text
-> IndexEntry
-> ErrIO IndexEntry
completeIndex NoticeLevel
debug PubFlags
pubf Settings
sett4 Path Abs Dir
doughP (MetaPage -> Maybe Text
dyIndexSort forall b c a. (b -> c) -> (a -> b) -> a -> c
. Panrep -> MetaPage
panyam forall a b. (a -> b) -> a -> b
$ Panrep
panrep2) IndexEntry
ix1
            -- todo put ix2 into pr
            let m2 :: MetaPage
m2 = MetaPage
m1{dyIndexEntry :: IndexEntry
dyIndexEntry = IndexEntry
ix2}
            let ixs :: [IndexEntry]
ixs = IndexEntry -> [IndexEntry]
dirEntries  IndexEntry
ix2 forall a. [a] -> [a] -> [a]
++ IndexEntry -> [IndexEntry]
fileEntries IndexEntry
ix2
            let [FilePath]
needs :: [FilePath] = forall a b. (a -> b) -> [a] -> [b]
map IndexEntry -> FilePath
ixfn [IndexEntry]
ixs 
            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\tm2------------------------docrep2panrep end if"
                , forall {a}. Show a => a -> Text
showT MetaPage
m2
                , Text
"needs", forall {a}. Show a => a -> Text
showT [FilePath]
needs]

            forall (m :: * -> *) a. Monad m => a -> m a
return (Panrep
panrep2{panyam :: MetaPage
panyam = MetaPage
m2}, [FilePath]
needs)
        else
            forall (m :: * -> *) a. Monad m => a -> m a
return (Panrep
panrep2, [])