{-# LANGUAGE ConstraintKinds #-}
{-# 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.Panrep2html (
module Wave.Panrep2html,
) where
import Foundational.Filetypes4sites ( Panrep(Panrep) )
import Foundational.SettingsPage
import Foundational.MetaPage
import GHC.Generics (Generic)
import Uniform.Json ( ToJSON(toJSON), Value, ErrIO )
import Uniform.Pandoc ( writeHtml5String2 )
import Uniform.Latex
import qualified Text.Pandoc.Shared as P
import Uniform.Http ( HTMLout )
import UniformBase
import Data.Maybe (fromMaybe)
import Lib.IndexMake ( convertIndexEntries, MenuEntry )
import Lib.Templating ( putValinMaster )
import Text.Pandoc.SideNote ( usingSideNotes )
panrep2html :: NoticeLevel -> Settings -> Panrep -> ErrIO HTMLout
panrep2html :: NoticeLevel -> Settings -> Panrep -> ErrIO HTMLout
panrep2html NoticeLevel
debug Settings
sett3 (Panrep MetaPage
m1 Pandoc
p1) = do
let mf :: Path Rel File
mf = SiteLayout -> Path Rel File
masterTemplateFile forall a b. (a -> b) -> a -> b
$ Settings -> SiteLayout
siteLayout Settings
sett3
let masterfn :: FileResultT (Path Abs Dir) (Path Rel File)
masterfn = SiteLayout -> Path Abs Dir
templatesDir (Settings -> SiteLayout
siteLayout Settings
sett3) forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> Path Rel File
mf
let h :: Int
h = MetaPage -> Int
dyHeaderShift MetaPage
m1
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\t---------------------------panrep2html"
, Text
"shiftHeaderLevel"
, forall {a}. Show a => a -> Text
showT Int
h]
let p2 :: Pandoc
p2 = Int -> Pandoc -> Pandoc
P.headerShift Int
h Pandoc
p1
let p3 :: Pandoc
p3 = Pandoc -> Pandoc
usingSideNotes Pandoc
p2
[Value]
vals <- NoticeLevel -> Settings -> Panrep -> ErrIO [Value]
panrep2vals NoticeLevel
debug Settings
sett3 (MetaPage -> Pandoc -> Panrep
Panrep MetaPage
m1 Pandoc
p3)
HTMLout
p :: HTMLout <- NoticeLevel -> Path Abs File -> [Value] -> ErrIO HTMLout
panrep2html2 NoticeLevel
debug FileResultT (Path Abs Dir) (Path Rel File)
masterfn [Value]
vals
forall (m :: * -> *) a. Monad m => a -> m a
return HTMLout
p
panrep2vals :: NoticeLevel -> Settings -> Panrep -> ErrIO [Value]
panrep2vals :: NoticeLevel -> Settings -> Panrep -> ErrIO [Value]
panrep2vals NoticeLevel
debug Settings
sett3 (Panrep MetaPage
m1 Pandoc
p1) = do
let ixe1 :: IndexEntry
ixe1 = MetaPage -> IndexEntry
dyIndexEntry MetaPage
m1
let indexSortField :: Text
indexSortField = forall a. a -> Maybe a -> a
Data.Maybe.fromMaybe Text
"" (MetaPage -> Maybe Text
dyIndexSort MetaPage
m1)
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\t---------------------------panrep2vals"
, Text
"AuthorOppressed"
, forall {a}. Show a => a -> Text
showT (SiteLayout -> [Text]
blogAuthorToSuppress forall b c a. (b -> c) -> (a -> b) -> a -> c
. Settings -> SiteLayout
siteLayout forall a b. (a -> b) -> a -> b
$ Settings
sett3)]
MenuEntry
menu4 :: MenuEntry <- NoticeLevel -> [Text] -> Text -> IndexEntry -> ErrIO MenuEntry
convertIndexEntries NoticeLevel
debug (SiteLayout -> [Text]
blogAuthorToSuppressforall b c a. (b -> c) -> (a -> b) -> a -> c
.Settings -> SiteLayout
siteLayout forall a b. (a -> b) -> a -> b
$ Settings
sett3) Text
indexSortField IndexEntry
ixe1
Text
html <- Pandoc -> ErrIO Text
writeHtml5String2 Pandoc
p1
ContentHtml
p2 <- IndexEntry -> Text -> ErrIO ContentHtml
fillContent IndexEntry
ixe1 Text
html
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
"panrep2vals", Text
"m1", forall a. PrettyStrings a => a -> Text
showPretty MetaPage
m1]
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
"panrep2vals", Text
"sett3", forall a. PrettyStrings a => a -> Text
showPretty Settings
sett3]
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
"panrep2vals", Text
"menu4", forall a. PrettyStrings a => a -> Text
showPretty MenuEntry
menu4]
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
"panrep2vals", Text
"p2", forall a. PrettyStrings a => a -> Text
showPretty ContentHtml
p2]
let vals :: [Value]
vals = [forall a. ToJSON a => a -> Value
toJSON Settings
sett3, forall a. ToJSON a => a -> Value
toJSON MetaPage
m1, forall a. ToJSON a => a -> Value
toJSON MenuEntry
menu4, forall a. ToJSON a => a -> Value
toJSON ContentHtml
p2]
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
"panrep2vals", Text
"vals", forall a. PrettyStrings a => a -> Text
showPretty [Value]
vals]
forall (m :: * -> *) a. Monad m => a -> m a
return [Value]
vals
panrep2html2 :: NoticeLevel
-> Path Abs File
-> [Value]
-> ErrIO HTMLout
panrep2html2 :: NoticeLevel -> Path Abs File -> [Value] -> ErrIO HTMLout
panrep2html2 NoticeLevel
debug Path Abs File
masterfn [Value]
vals = do
HTMLout
p :: HTMLout <- NoticeLevel -> [Value] -> Path Abs File -> ErrIO HTMLout
putValinMaster NoticeLevel
debug [Value]
vals Path Abs File
masterfn
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 panrep2html done"]
forall (m :: * -> *) a. Monad m => a -> m a
return HTMLout
p
fillContent :: IndexEntry -> Text -> ErrIO ContentHtml
fillContent :: IndexEntry -> Text -> ErrIO ContentHtml
fillContent IndexEntry
ix Text
cont = do
UTCTime
today1 :: UTCTime <- ErrIO UTCTime
getCurrentTimeUTC
let res :: ContentHtml
res = ContentHtml
{ $sel:content3:ContentHtml :: Text
content3 = Text
cont
, $sel:today3:ContentHtml :: Text
today3 = forall {a}. Show a => a -> Text
showT UTCTime
today1
, $sel:linkpdf3:ContentHtml :: Text
linkpdf3 = IndexEntry -> Text
convertLink2pdf IndexEntry
ix
, $sel:filename3:ContentHtml :: Text
filename3 = IndexEntry -> Text
convertLink2html IndexEntry
ix
}
forall (m :: * -> *) a. Monad m => a -> m a
return ContentHtml
res
data ContentHtml = ContentHtml
{ ContentHtml -> Text
content3 :: Text
, ContentHtml -> Text
today3 :: Text
, ContentHtml -> Text
linkpdf3 :: Text
, ContentHtml -> Text
filename3 :: Text
} deriving (Int -> ContentHtml -> ShowS
[ContentHtml] -> ShowS
ContentHtml -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContentHtml] -> ShowS
$cshowList :: [ContentHtml] -> ShowS
show :: ContentHtml -> String
$cshow :: ContentHtml -> String
showsPrec :: Int -> ContentHtml -> ShowS
$cshowsPrec :: Int -> ContentHtml -> ShowS
Show, forall x. Rep ContentHtml x -> ContentHtml
forall x. ContentHtml -> Rep ContentHtml x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ContentHtml x -> ContentHtml
$cfrom :: forall x. ContentHtml -> Rep ContentHtml x
Generic)
instance ToJSON ContentHtml
instance Zeros ContentHtml where
zero :: ContentHtml
zero = Text -> Text -> Text -> Text -> ContentHtml
ContentHtml forall z. Zeros z => z
zero forall z. Zeros z => z
zero forall z. Zeros z => z
zero forall z. Zeros z => z
zero