{-# LANGUAGE DeriveGeneric         #-}
---------------------------------------------------------------------
--
-- Module      :   
-- | create an index for a directory
--  in two steps: 
--  IndexCollect: collect all the date 
--  with call to addIndex2yam
--  and
--  indexMake: convert collected data for printing (convertIndexEntries)
--  . 
--  the data is stored in a file separately and managed by Shake
--  operates on metapage (or less? )
-- this could all be pure code?
----------------------------------------------------------------------
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}

module Lib.IndexMake (module Lib.IndexMake) where

-- import           Foundational.Filetypes4sites
import           Foundational.MetaPage
import Uniform.Json ( FromJSON, ToJSON, ErrIO ) 
import Uniform.Latex 
import           UniformBase
import Data.List (sortOn)
-- import Wave.Md2doc (includeBakeTest3docrep)

convertIndexEntries :: NoticeLevel ->  [Text] -> Text -> IndexEntry -> ErrIO MenuEntry
-- ^ take the index entries and convert their
-- form and push them back into the json
-- converts to values for printing if indexpage else null
-- date today is passed to feed in pages 
-- the authors which should be oppressed are passed 
-- is pure except for today! TODO today is not used 
-- use the date from the siteHeader? TODO
convertIndexEntries :: NoticeLevel -> [Text] -> Text -> IndexEntry -> ErrIO MenuEntry
convertIndexEntries NoticeLevel
debug [Text]
hpAuthor Text
indexSortField  IndexEntry
ixe1 =
  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
"convertIndexEntries", Text
"start ixe1", forall {a}. Show a => a -> Text
showT IndexEntry
ixe1
        , Text
"\n\thpAuthor", forall {a}. Show a => a -> Text
showT [Text]
hpAuthor]
    let fn :: Path Abs File
fn = FilePath -> Path Abs File
makeAbsFile forall a b. (a -> b) -> a -> b
$ IndexEntry -> FilePath
ixfn IndexEntry
ixe1
    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
"convertIndexEntries", Text
"fn", forall {a}. Show a => a -> Text
showT Path Abs File
fn]
    MenuEntry
menu4 <- if Path Abs File -> Bool
isIndexPage Path Abs File
fn
        then do
            let fils :: [IndexEntry]
fils = IndexEntry -> [IndexEntry]
fileEntries IndexEntry
ixe1  
            let dirs :: [IndexEntry]
dirs = IndexEntry -> [IndexEntry]
dirEntries IndexEntry
ixe1  

            let menu1 :: MenuEntry
menu1 = [Text]
-> Text -> (IndexEntry, [IndexEntry], [IndexEntry]) -> MenuEntry
convert2index [Text]
hpAuthor (Text
indexSortField ) (IndexEntry
ixe1, [IndexEntry]
fils, [IndexEntry]
dirs)
            -- let menu3 = menu1{today3 = "2021-01-01"}  
            -- to avoid the changes in testing leading to failures
            UTCTime
today1 :: UTCTime <- ErrIO UTCTime
getCurrentTimeUTC
            let menu3 :: MenuEntry
menu3 = MenuEntry
menu1 -- {today3 = showT today1}
            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
"convertIndexEntries", Text
"menu3", forall {a}. Show a => a -> Text
showT MenuEntry
menu3]
            forall (m :: * -> *) a. Monad m => a -> m a
return MenuEntry
menu3
        else forall (m :: * -> *) a. Monad m => a -> m a
return forall z. Zeros z => z
zero
    forall (m :: * -> *) a. Monad m => a -> m a
return MenuEntry
menu4

-- | convert the indexEntry1s and put some divider between
-- TODO  - avoid dividers if list empty
convert2index :: [Text] -> Text -> 
  (IndexEntry, [IndexEntry], [IndexEntry]) ->
  MenuEntry
convert2index :: [Text]
-> Text -> (IndexEntry, [IndexEntry], [IndexEntry]) -> MenuEntry
convert2index [Text]
hpAuthor Text
indexSortField (IndexEntry
this, [IndexEntry]
fils, [IndexEntry]
dirs) =
    MenuEntry
        { menu2subdir :: [Index4html]
menu2subdir = [Index4html] -> [Index4html]
sortField forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> [IndexEntry] -> [Index4html]
getIndexEntryPure [Text]
hpAuthor) forall a b. (a -> b) -> a -> b
$ [IndexEntry]
dirs
        , menu2files :: [Index4html]
menu2files  = [Index4html] -> [Index4html]
sortField forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Text] -> [IndexEntry] -> [Index4html]
getIndexEntryPure [Text]
hpAuthor) forall a b. (a -> b) -> a -> b
$ [IndexEntry]
fils
        -- . indexFilter - if needed then use includeBakeTest3docrep from md2doc 
        -- , today3 = zero -- is set afterwards
        }
 where   -- done in collection now?
    sortField :: [Index4html] -> [Index4html]
sortField = case (Text
indexSortField) of 
        Text
"filename" -> forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Index4html -> Text
text2
        Text
"date"      -> forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Index4html -> Text
date2
        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  Index4html -> Text
date2
        Text
_ -> forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn Index4html -> Text
text2  -- what is best default? id?

-- indexFilter :: [IndexEntry] -> [IndexEntry]
-- indexFilter ixs = ixs -- filter ((Just "true" ==) . publish ) ixs
--     -- does not work because publish is not set
--     -- todo remove 


-- | the lines for the index 
-- TODO make a variant for the breaing marks
data Index4html = Index4html
  { -- fn :: Path Abs File   -- ^ naked filename -- not shown
    Index4html -> Text
text2      :: Text, -- the filename with no extension as title 

    -- | the url relative web root
    Index4html -> Text
link2      :: Text,  -- ^ link to html 
    Index4html -> Text
pdf2        :: Text, -- ^ link to pdf 
    -- | the title as shown
    Index4html -> Text
title2     :: Text,
    Index4html -> Text
abstract2  :: Text,
    Index4html -> Text
author2    :: Text,
    Index4html -> Text
date2      :: Text -- UTCTime -- read the time early one to find errors
    -- publish2   :: Text  -- not yet used 
                -- add language ?
    -- indexPage2 :: Bool -- mark for index entries
    }
  deriving (forall x. Rep Index4html x -> Index4html
forall x. Index4html -> Rep Index4html x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Index4html x -> Index4html
$cfrom :: forall x. Index4html -> Rep Index4html x
Generic, Index4html -> Index4html -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Index4html -> Index4html -> Bool
$c/= :: Index4html -> Index4html -> Bool
== :: Index4html -> Index4html -> Bool
$c== :: Index4html -> Index4html -> Bool
Eq, Eq Index4html
Index4html -> Index4html -> Bool
Index4html -> Index4html -> Ordering
Index4html -> Index4html -> Index4html
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Index4html -> Index4html -> Index4html
$cmin :: Index4html -> Index4html -> Index4html
max :: Index4html -> Index4html -> Index4html
$cmax :: Index4html -> Index4html -> Index4html
>= :: Index4html -> Index4html -> Bool
$c>= :: Index4html -> Index4html -> Bool
> :: Index4html -> Index4html -> Bool
$c> :: Index4html -> Index4html -> Bool
<= :: Index4html -> Index4html -> Bool
$c<= :: Index4html -> Index4html -> Bool
< :: Index4html -> Index4html -> Bool
$c< :: Index4html -> Index4html -> Bool
compare :: Index4html -> Index4html -> Ordering
$ccompare :: Index4html -> Index4html -> Ordering
Ord, Int -> Index4html -> ShowS
[Index4html] -> ShowS
Index4html -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Index4html] -> ShowS
$cshowList :: [Index4html] -> ShowS
show :: Index4html -> FilePath
$cshow :: Index4html -> FilePath
showsPrec :: Int -> Index4html -> ShowS
$cshowsPrec :: Int -> Index4html -> ShowS
Show, ReadPrec [Index4html]
ReadPrec Index4html
Int -> ReadS Index4html
ReadS [Index4html]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Index4html]
$creadListPrec :: ReadPrec [Index4html]
readPrec :: ReadPrec Index4html
$creadPrec :: ReadPrec Index4html
readList :: ReadS [Index4html]
$creadList :: ReadS [Index4html]
readsPrec :: Int -> ReadS Index4html
$creadsPrec :: Int -> ReadS Index4html
Read)

instance Zeros Index4html where
  zero :: Index4html
zero = Text -> Text -> Text -> Text -> Text -> Text -> Text -> Index4html
Index4html forall z. Zeros z => z
zero forall z. Zeros z => z
zero forall z. Zeros z => z
zero forall z. Zeros z => z
zero forall z. Zeros z => z
zero forall z. Zeros z => z
zero forall z. Zeros z => z
zero 
instance FromJSON Index4html

-- parseJSON = genericParseJSON h4Options
instance ToJSON Index4html


getIndexEntryPure :: [Text]-> [IndexEntry] -> [Index4html]
-- pass the author names which should be oppressed in indices
getIndexEntryPure :: [Text] -> [IndexEntry] -> [Index4html]
getIndexEntryPure [Text]
hpAuthor [IndexEntry]
ixe2 = forall a b. (a -> b) -> [a] -> [b]
map ([Text] -> IndexEntry -> Index4html
getOneIndexEntryPure [Text]
hpAuthor)  [IndexEntry]
ixe2
                    -- mapMaybe (\i -> if (Just "true" == publish i)
                    --               then Just $ getOneIndexEntryPure i
                    --               else error "xsdwer" ) ixe2

getOneIndexEntryPure :: [Text] -> IndexEntry -> Index4html

-- | the pure code to compute an IndexEntry
-- Text should be "/Blog/postTufteStyled.html"
getOneIndexEntryPure :: [Text] -> IndexEntry -> Index4html
getOneIndexEntryPure [Text]
hpAuthor IndexEntry
indexEntry1 =
  Index4html
    { text2 :: Text
text2 = FilePath -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeBaseName'   forall b c a. (b -> c) -> (a -> b) -> a -> c
. IndexEntry -> FilePath
ixfn forall a b. (a -> b) -> a -> b
$ IndexEntry
indexEntry1
    , link2 :: Text
link2 =  IndexEntry -> Text
convertLink2html IndexEntry
indexEntry1
    , pdf2 :: Text
pdf2 =  IndexEntry -> Text
convertLink2pdf  IndexEntry
indexEntry1 
    , abstract2 :: Text
abstract2 = IndexEntry -> Text
abstract IndexEntry
indexEntry1
    , title2 :: Text
title2 =
        if forall z. (Zeros z, Eq z) => z -> Bool
isZero (IndexEntry -> Text
title IndexEntry
indexEntry1 :: Text)
          then FilePath -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
takeBaseName'   forall b c a. (b -> c) -> (a -> b) -> a -> c
.  IndexEntry -> FilePath
ixfn forall a b. (a -> b) -> a -> b
$ IndexEntry
indexEntry1
          else IndexEntry -> Text
title IndexEntry
indexEntry1
    , author2 :: Text
author2 = [Text] -> Text -> Text
blankAuthorName [Text]
hpAuthor (IndexEntry -> Text
author IndexEntry
indexEntry1)
    , date2 :: Text
date2 = IndexEntry -> Text
date IndexEntry
indexEntry1
    -- , publish2 = shownice $ publish indexEntry1
    --   indexPage2 = indexPage indexEntry1
    }

blankAuthorName :: [Text] -> Text -> Text 
-- suppress/oppress author name, if the author name is the same as one in the first arg (AUF, Andrew U..) then set it to empty else copy 
-- idea is to avoid to have each page say the obvious "author XX"
blankAuthorName :: [Text] -> Text -> Text
blankAuthorName [Text]
names Text
current = 
    if Text
current forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
names 
        then forall z. Zeros z => z
zero 
        else Text
current 

-- hpAuthor :: [Text]
-- the list of authornames which are blanked
-- should be the author of the blog
-- hpAuthor = ["AUF", "Andrew U. Frank"]

--       ------  S U P P O R T
-- the MenuEntry is one entry in the menu list 
data MenuEntry = MenuEntry {MenuEntry -> [Index4html]
menu2subdir :: [Index4html]
                            , MenuEntry -> [Index4html]
menu2files :: [Index4html]
    -- , today3 :: Text 
                            }
  -- menu2 is referenced in the template
  deriving (forall x. Rep MenuEntry x -> MenuEntry
forall x. MenuEntry -> Rep MenuEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MenuEntry x -> MenuEntry
$cfrom :: forall x. MenuEntry -> Rep MenuEntry x
Generic, MenuEntry -> MenuEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MenuEntry -> MenuEntry -> Bool
$c/= :: MenuEntry -> MenuEntry -> Bool
== :: MenuEntry -> MenuEntry -> Bool
$c== :: MenuEntry -> MenuEntry -> Bool
Eq, Eq MenuEntry
MenuEntry -> MenuEntry -> Bool
MenuEntry -> MenuEntry -> Ordering
MenuEntry -> MenuEntry -> MenuEntry
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MenuEntry -> MenuEntry -> MenuEntry
$cmin :: MenuEntry -> MenuEntry -> MenuEntry
max :: MenuEntry -> MenuEntry -> MenuEntry
$cmax :: MenuEntry -> MenuEntry -> MenuEntry
>= :: MenuEntry -> MenuEntry -> Bool
$c>= :: MenuEntry -> MenuEntry -> Bool
> :: MenuEntry -> MenuEntry -> Bool
$c> :: MenuEntry -> MenuEntry -> Bool
<= :: MenuEntry -> MenuEntry -> Bool
$c<= :: MenuEntry -> MenuEntry -> Bool
< :: MenuEntry -> MenuEntry -> Bool
$c< :: MenuEntry -> MenuEntry -> Bool
compare :: MenuEntry -> MenuEntry -> Ordering
$ccompare :: MenuEntry -> MenuEntry -> Ordering
Ord, Int -> MenuEntry -> ShowS
[MenuEntry] -> ShowS
MenuEntry -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MenuEntry] -> ShowS
$cshowList :: [MenuEntry] -> ShowS
show :: MenuEntry -> FilePath
$cshow :: MenuEntry -> FilePath
showsPrec :: Int -> MenuEntry -> ShowS
$cshowsPrec :: Int -> MenuEntry -> ShowS
Show, ReadPrec [MenuEntry]
ReadPrec MenuEntry
Int -> ReadS MenuEntry
ReadS [MenuEntry]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MenuEntry]
$creadListPrec :: ReadPrec [MenuEntry]
readPrec :: ReadPrec MenuEntry
$creadPrec :: ReadPrec MenuEntry
readList :: ReadS [MenuEntry]
$creadList :: ReadS [MenuEntry]
readsPrec :: Int -> ReadS MenuEntry
$creadsPrec :: Int -> ReadS MenuEntry
Read)

-- instance NiceStrings MenuEntry where
--     shownice = showNice

instance Zeros MenuEntry where
  zero :: MenuEntry
zero = [Index4html] -> [Index4html] -> MenuEntry
MenuEntry forall z. Zeros z => z
zero forall z. Zeros z => z
zero 

instance FromJSON MenuEntry

-- parseJSON = genericParseJSON h4Options

instance ToJSON MenuEntry

--  toJSON = genericToJSON h4Options