{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wall #-}
module Lib.IndexCollect where
import Uniform.Pandoc ( extMD )
import Uniform.Latex
import Foundational.Filetypes4sites ( Docrep(Docrep) )
import Foundational.MetaPage
import Foundational.CmdLineFlags ( PubFlags )
import UniformBase
import Wave.Md2doc
( includeBakeTest3docrep, readMarkdownFile2docrep )
import Foundational.SettingsPage
import Data.List (sortOn)
completeIndex :: NoticeLevel -> PubFlags -> Settings -> Path Abs Dir -> Maybe Text -> IndexEntry -> ErrIO IndexEntry
completeIndex :: NoticeLevel
-> PubFlags
-> Settings
-> Path Abs Dir
-> Maybe Text
-> IndexEntry
-> ErrIO IndexEntry
completeIndex NoticeLevel
debug PubFlags
pubf Settings
sett4 Path Abs Dir
doughP Maybe Text
indexSortField IndexEntry
ix1 = 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
"completeIndex", Text
"start", forall a. PrettyStrings a => a -> Text
showPretty IndexEntry
ix1]
let fn :: Path Abs File
fn = Path Abs Dir
doughP forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> (IndexEntry -> FilePath
link IndexEntry
ix1) :: Path Abs File
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
"completeIndex"
, Text
"fn"
, forall {a}. Show a => a -> Text
showT Path Abs File
fn
]
([IndexEntry]
dirs, [IndexEntry]
files) <- NoticeLevel
-> PubFlags
-> Settings
-> Path Abs Dir
-> Path Abs File
-> ErrIO ([IndexEntry], [IndexEntry])
getDirContent2dirs_files NoticeLevel
debug PubFlags
pubf Settings
sett4 Path Abs Dir
doughP Path Abs File
fn
let
dirs1 :: [IndexEntry]
dirs1 = [IndexEntry] -> [IndexEntry]
sortField [IndexEntry]
dirs
files1 :: [IndexEntry]
files1 = [IndexEntry] -> [IndexEntry]
sortField [IndexEntry]
files
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
"completeIndex", Text
"\n dirs", forall {a}. Show a => a -> Text
showT [IndexEntry]
dirs, Text
"\n files", forall {a}. Show a => a -> Text
showT [IndexEntry]
files]
let ix2 :: IndexEntry
ix2 = IndexEntry
ix1{dirEntries :: [IndexEntry]
dirEntries = [IndexEntry]
dirs1, fileEntries :: [IndexEntry]
fileEntries = [IndexEntry]
files1}
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
"completeIndex", Text
"x2", forall {a}. Show a => a -> Text
showT IndexEntry
ix2]
forall (m :: * -> *) a. Monad m => a -> m a
return IndexEntry
ix2
where
sortField :: [IndexEntry] -> [IndexEntry]
sortField = case (Maybe Text
indexSortField) of
Just Text
"filename" -> forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn IndexEntry -> FilePath
link
Just Text
"date" -> forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn IndexEntry -> Text
date
Just Text
"reversedate" -> forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn IndexEntry -> Text
date
Maybe Text
_ -> forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn IndexEntry -> FilePath
link
getDirContent2dirs_files :: NoticeLevel -> PubFlags -> Settings -> Path Abs Dir -> Path Abs File -> ErrIO ([IndexEntry], [IndexEntry])
getDirContent2dirs_files :: NoticeLevel
-> PubFlags
-> Settings
-> Path Abs Dir
-> Path Abs File
-> ErrIO ([IndexEntry], [IndexEntry])
getDirContent2dirs_files NoticeLevel
debug PubFlags
pubf Settings
sett4 Path Abs Dir
doughP Path Abs File
indexpageFn = 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
"getDirContent2dirs_files for", forall a. PrettyStrings a => a -> Text
showPretty Path Abs File
indexpageFn]
let pageFn :: Path Abs Dir
pageFn = FilePath -> Path Abs Dir
makeAbsDir forall a b. (a -> b) -> a -> b
$ forall fp. Filenames1 fp => fp -> FilePath
getParentDir Path Abs File
indexpageFn :: Path Abs Dir
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
"getDirContent2dirs_files pageFn", forall a. PrettyStrings a => a -> Text
showPretty Path Abs Dir
pageFn]
[Path Abs Dir]
dirs1 :: [Path Abs Dir] <- forall fp. DirOps fp => fp -> ErrIO [fp]
getDirectoryDirs' Path Abs Dir
pageFn
let dirs2 :: [Path Abs Dir]
dirs2 = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CharChains a => a -> a -> Bool
isInfixOf' (SiteLayout -> Text
doNotBake (Settings -> SiteLayout
siteLayout Settings
sett4))forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall fp. Filenames1 fp => fp -> FilePath
getNakedDir) [Path Abs Dir]
dirs1
let dirs3 :: [Path Abs Dir]
dirs3 = forall a. (a -> Bool) -> [a] -> [a]
filter ( Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. CharChains a => a -> a -> Bool
isPrefixOf' FilePath
resourcesName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall fp. Filenames1 fp => fp -> FilePath
getNakedDir) [Path Abs Dir]
dirs2
let dirs4 :: [Path Abs Dir]
dirs4 = forall a. (a -> Bool) -> [a] -> [a]
filter ( Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. CharChains a => a -> a -> Bool
isPrefixOf' FilePath
templatesName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall fp. Filenames1 fp => fp -> FilePath
getNakedDir) [Path Abs Dir]
dirs3
let dirs5 :: [Path Abs Dir]
dirs5 = forall a. (a -> Bool) -> [a] -> [a]
filter ( Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. CharChains a => a -> a -> Bool
isPrefixOf' FilePath
"."
) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall fp. Filenames1 fp => fp -> FilePath
getNakedDir) [Path Abs Dir]
dirs4
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
"\ngetDirContent2dirs_files dirs4", forall a. PrettyStrings a => a -> Text
showPretty [Path Abs Dir]
dirs4]
[Path Abs File]
files1 :: [Path Abs File] <- forall fd ff. FileOps2a fd ff => fd -> ErrIO [ff]
getDirContentFiles Path Abs Dir
pageFn
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
"getDirContent2dirs_files files1", forall a. PrettyStrings a => a -> Text
showPretty [Path Abs File]
files1]
let files2 :: [Path Abs File]
files2 =
forall a. (a -> Bool) -> [a] -> [a]
filter (Path Abs File
indexpageFn forall a. Eq a => a -> a -> Bool
/=)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall fp. Extensions fp => ExtensionType fp -> fp -> Bool
hasExtension Extension
extMD)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CharChains a => a -> a -> Bool
isInfixOf' (SiteLayout -> Text
doNotBake (Settings -> SiteLayout
siteLayout Settings
sett4)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
s2tforall 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]
files1
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
"getDirContent2dirs files2", forall a. PrettyStrings a => a -> Text
showPretty [Path Abs File]
files2]
[Maybe IndexEntry]
ixfiles <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (NoticeLevel
-> PubFlags
-> Settings
-> Path Abs File
-> ErrIO (Maybe IndexEntry)
getFile2index NoticeLevel
debug PubFlags
pubf Settings
sett4 ) [Path Abs File]
files2
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
"getDirContent2dirs ixfiles", forall a. PrettyStrings a => a -> Text
showPretty [Maybe IndexEntry]
ixfiles]
let subindexDirs :: [Path Abs File]
subindexDirs = forall a b. (a -> b) -> [a] -> [b]
map (\Path Abs Dir
d -> Path Abs Dir
d forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> FilePath -> Path Rel File
makeRelFile FilePath
"index.md") [Path Abs Dir]
dirs5
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
"getDirContent2dirs subindexDirs", forall a. PrettyStrings a => a -> Text
showPretty [Path Abs File]
subindexDirs]
[Maybe IndexEntry]
ixdirs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (NoticeLevel
-> PubFlags
-> Settings
-> Path Abs File
-> ErrIO (Maybe IndexEntry)
getFile2index NoticeLevel
debug PubFlags
pubf Settings
sett4 ) [Path Abs File]
subindexDirs
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
"getDirContent2dirs xfiles", forall a. PrettyStrings a => a -> Text
showPretty [Maybe IndexEntry]
ixfiles, Text
"\n ixdirs", forall a. PrettyStrings a => a -> Text
showPretty [Maybe IndexEntry]
ixdirs]
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [Maybe a] -> [a]
catMaybes [Maybe IndexEntry]
ixdirs, forall a. [Maybe a] -> [a]
catMaybes [Maybe IndexEntry]
ixfiles)
getFile2index :: NoticeLevel -> PubFlags -> Settings -> Path Abs File -> ErrIO (Maybe IndexEntry)
getFile2index :: NoticeLevel
-> PubFlags
-> Settings
-> Path Abs File
-> ErrIO (Maybe IndexEntry)
getFile2index NoticeLevel
debug PubFlags
pubf Settings
sett4 Path Abs File
fnin =
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
"getFile2index fnin", forall a. PrettyStrings a => a -> Text
showPretty Path Abs File
fnin
,Text
"\ndebug", forall {a}. Show a => a -> Text
showT NoticeLevel
debug]
(Docrep MetaPage
y1 Pandoc
_) <- NoticeLevel -> Settings -> Path Abs File -> ErrIO Docrep
readMarkdownFile2docrep NoticeLevel
debug Settings
sett4 Path Abs File
fnin
let incl :: Bool
incl = PubFlags -> MetaPage -> Bool
includeBakeTest3docrep PubFlags
pubf MetaPage
y1
if Bool
incl then do
let IndexEntry
ix1 :: IndexEntry = MetaPage -> IndexEntry
dyIndexEntry MetaPage
y1
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
"getFile2index ix1", forall a. PrettyStrings a => a -> Text
showPretty IndexEntry
ix1]
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ IndexEntry
ix1
else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing