{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
---------------------------------------------------------------
--
-- MetaPage   : The information taken from the yaml header of each md file. 
--  LayoutFlags deals with the data from the settingsN.yaml
---------------------------------------------------------------------
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# 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 #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
{-# LANGUAGE InstanceSigs #-}

{- | The data describing a page of the site (i.e. an md file)
 the default is merged with the values in the yaml head
 all entries there should be from this list
 all JSON related functions here!
-}
module Foundational.MetaPage (
    module Foundational.MetaPage,
    Default (..),
) where

import Data.Default.Class  
import Foundational.SettingsPage  
import Uniform.Json
import Uniform.Shake
import Uniform.Pandoc
import Uniform.Latex 
import Uniform.Yaml
import Uniform.HTMLout (extHTML)

-- the fields in the yaml header of each md file 
-- maybe values can be empty

data MetaPage = MetaPage
    { -- | the original dough fn
      MetaPage -> FilePath
dyFn :: FilePath
    , -- | the relative filename
      -- relative to the browser origin
      -- set in ? initializeIndex
      MetaPage -> FilePath
dyLink :: FilePath
     -- | the fields of miniblog
    , MetaPage -> Text
dyLang :: Text -- DocLanguage not used yet 
    , MetaPage -> Text
dyTitle :: Text  -- must be set 
    , MetaPage -> Text
dyAbstract :: Text -- must be set 
    , MetaPage -> Text
dyAuthor :: Text  -- default ?
    , -- | this is maybe a string,
      --  should be utctime
      MetaPage -> Maybe Text
dyDate :: Maybe Text -- must be set 
    , MetaPage -> Text
dyKeywords :: Text -- should be [Text] 
    , MetaPage -> Text
dyImage ::  Text  -- empty if nothing given
    , MetaPage -> Text
dyImageCaption :: Text 
    , MetaPage -> Maybe Text
dyBibliography :: Maybe Text
    -- a bibliography is trigger to process
    , MetaPage -> Maybe Text
dyStyle :: Maybe Text
    , MetaPage -> Text
dyStyleBiber :: Text
    , MetaPage -> Maybe Value
dyReferences :: Maybe Value --  [Reference]
    -- when references are given in markdown text
    , MetaPage -> Text
dyReference_section_title :: Text 
            --set default always, suppressed when not needed
    , MetaPage -> [Text]
dyContentFiles :: [Text] -- the list of md files to include 
    , MetaPage -> Maybe Text
dyNoCite :: Maybe Text
    , MetaPage -> Text
dyBook :: Text -- "book" to produce collection pdf
    , MetaPage -> Text
dyVersion ::  Text -- should be "publish"
    , MetaPage -> Text
dyVisibility ::  Text -- should be "public"
    -- , dyIndexPage :: Bool
    , MetaPage -> Maybe Text
dyIndexSort :: Maybe Text
    , MetaPage -> IndexEntry
dyIndexEntry :: IndexEntry
    -- , dyDirEntries   :: [IndexEntry]  -- reduce to one for indexEntry
    -- , dyFileEntries  :: [IndexEntry]
    -- is defined later, necessary here?
    , MetaPage -> [Text]
dyDoNotReplace:: [Text]
    , MetaPage -> Int
dyHeaderShift :: Int -- pandoc seems not to parse int in the yaml, mark, values    'zero' or 'one' 
    -- shift the header level, such that one # is hl2,
    -- because hl1 is title
    }
    deriving (Int -> MetaPage -> ShowS
[MetaPage] -> ShowS
MetaPage -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MetaPage] -> ShowS
$cshowList :: [MetaPage] -> ShowS
show :: MetaPage -> FilePath
$cshow :: MetaPage -> FilePath
showsPrec :: Int -> MetaPage -> ShowS
$cshowsPrec :: Int -> MetaPage -> ShowS
Show, MetaPage -> MetaPage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetaPage -> MetaPage -> Bool
$c/= :: MetaPage -> MetaPage -> Bool
== :: MetaPage -> MetaPage -> Bool
$c== :: MetaPage -> MetaPage -> Bool
Eq, forall x. Rep MetaPage x -> MetaPage
forall x. MetaPage -> Rep MetaPage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MetaPage x -> MetaPage
$cfrom :: forall x. MetaPage -> Rep MetaPage x
Generic, MetaPage
Eq MetaPage => MetaPage -> Bool
forall z.
z -> (Eq z => z -> Bool) -> (Eq z => z -> Bool) -> Zeros z
notZero :: Eq MetaPage => MetaPage -> Bool
$cnotZero :: Eq MetaPage => MetaPage -> Bool
isZero :: Eq MetaPage => MetaPage -> Bool
$cisZero :: Eq MetaPage => MetaPage -> Bool
zero :: MetaPage
$czero :: MetaPage
Zeros, ReadPrec [MetaPage]
ReadPrec MetaPage
Int -> ReadS MetaPage
ReadS [MetaPage]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MetaPage]
$creadListPrec :: ReadPrec [MetaPage]
readPrec :: ReadPrec MetaPage
$creadPrec :: ReadPrec MetaPage
readList :: ReadS [MetaPage]
$creadList :: ReadS [MetaPage]
readsPrec :: Int -> ReadS MetaPage
$creadsPrec :: Int -> ReadS MetaPage
Read) -- ord missing for references
instance Zeros Integer where zero :: Integer
zero = Integer
0

-- instance Default MetaPage where
--     -- how is this used - defaults are set in pandoc2MetaPage
--     def :: MetaPage
--     def =
--         zero
--             { dyFn = zero
--             , dyLink = zero
--             , dyLang = "en_US" -- DLenglish
--             , dyTitle = "FILL_dytitle"
--             , dyAbstract = zero
--             , dyAuthor = "AOS"
--             , dyDate = Just . showT $ year2000
--             , dyKeywords = zero
--             , dyBibliography = Just "resources/BibTexLatex.bib"
--             , dyStyle = Just "chicago-fullnote-bibliography-bb.csl"
--             , dyStyleBiber = "authoryear"
--             , dyReferences = Nothing
--             , dyReference_section_title = "References"
--             , dyVersion =  "private"
--             , dyVisibility =  "draft"
--             -- , dyIndexPage = False
--             , dyIndexSort = zero
--             , dyIndexEntry = zero
--             -- , dyDirEntries = zero
--             -- , dyFileEntries = zero
--             , dyHeaderShift = zero 
--             }

docyamlOptions :: Options
docyamlOptions :: Options
docyamlOptions =
    Options
defaultOptions
        { fieldLabelModifier :: ShowS
fieldLabelModifier = Text -> FilePath
t2s forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
toLowerStart forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
2
        }

instance ToJSON MetaPage where
    toJSON :: MetaPage -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
docyamlOptions

instance FromJSON MetaPage where
    parseJSON :: Value -> Parser MetaPage
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
docyamlOptions

pandoc2MetaPage::  Settings ->  Path Abs File  -> Pandoc -> MetaPage
-- removed most default values, left only for image and caption, keywords
pandoc2MetaPage :: Settings -> Path Abs File -> Pandoc -> MetaPage
pandoc2MetaPage Settings
sett3 Path Abs File
filename  Pandoc
pd =  MetaPage
meta6
  where

    layout :: SiteLayout
layout = Settings -> SiteLayout
siteLayout Settings
sett3
    doughP :: Path Abs Dir
doughP = SiteLayout -> Path Abs Dir
doughDir SiteLayout
layout
    defAuthor :: Text
defAuthor = SiteLayout -> Text
defaultAuthor SiteLayout
layout 
    -- defBiblio = defaultBibliography layout  

    meta2 :: Value
meta2 = Meta -> Value
flattenMeta forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pandoc -> Meta
getMeta forall a b. (a -> b) -> a -> b
$ Pandoc
pd
    relfn :: Path Rel File
relfn = forall a c. Path2nd a c => Path a Dir -> Path a c -> Path Rel c
makeRelativeP Path Abs Dir
doughP Path Abs File
filename
    -- fromJustN means give error if not present!
    meta4 :: MetaPage
meta4 =
        MetaPage
            { dyFn :: FilePath
dyFn = forall b t. Path b t -> FilePath
toFilePath Path Abs File
filename
            , dyLink :: FilePath
dyLink = forall b t. Path b t -> FilePath
toFilePath Path Rel File
relfn
            , dyLang :: Text
dyLang = forall a. a -> Maybe a -> a
fromMaybe Text
"en_US" forall a b. (a -> b) -> a -> b
$ forall vk v. AtKey vk v => vk -> Key -> Maybe v
getAtKey Value
meta2 Key
"language"
            , dyTitle :: Text
dyTitle = forall a. Text -> Maybe a -> a
fromJustN Text
"title" forall a b. (a -> b) -> a -> b
$ forall vk v. AtKey vk v => vk -> Key -> Maybe v
getAtKey Value
meta2 Key
"title"
            -- , dyAbstract = fromJustN "abstract" $ getAtKey meta2 "abstract"
            , dyAbstract :: Text
dyAbstract = forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ forall vk v. AtKey vk v => vk -> Key -> Maybe v
getAtKey Value
meta2 Key
"abstract" 
                    -- allow empty abstract
            -- , dyAuthor = fromJustN "author" $ getAtKey meta2 "author"
            , dyAuthor :: Text
dyAuthor = forall a. a -> Maybe a -> a
fromMaybe Text
defAuthor forall a b. (a -> b) -> a -> b
$ forall vk v. AtKey vk v => vk -> Key -> Maybe v
getAtKey Value
meta2 Key
"author"
            -- allow empty author ??
            , dyDate :: Maybe Text
dyDate = forall vk v. AtKey vk v => vk -> Key -> Maybe v
getAtKey Value
meta2 Key
"date"
            , dyBibliography :: Maybe Text
dyBibliography = forall vk v. AtKey vk v => vk -> Key -> Maybe v
getAtKey Value
meta2 Key
"bibliography"
            -- not defaulted, value used is the one read into pandoc
            -- , dyBibliography = Just $ fromMaybe defBiblio $ getAtKey meta2 "bibliography"
            -- used as signal for processing biblio
            -- perhaps not the best idea? 
            , dyImage :: Text
dyImage = forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ forall vk v. AtKey vk v => vk -> Key -> Maybe v
getAtKey Value
meta2 Key
"image"
            , dyImageCaption :: Text
dyImageCaption = forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ forall vk v. AtKey vk v => vk -> Key -> Maybe v
getAtKey Value
meta2 Key
"caption"
            , dyKeywords :: Text
dyKeywords = forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ forall vk v. AtKey vk v => vk -> Key -> Maybe v
getAtKey Value
meta2 Key
"keywords"
            -- , dyKeywords = fromJustN "keywords" $ getAtKey meta2 "keywords"
            , dyStyle :: Maybe Text
dyStyle = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Text
"resources/chicago-fullnote-bibliography-bb.csl" forall a b. (a -> b) -> a -> b
$ forall vk v. AtKey vk v => vk -> Key -> Maybe v
getAtKey Value
meta2 Key
"style"
            , dyStyleBiber :: Text
dyStyleBiber = forall a. a -> Maybe a -> a
fromMaybe Text
"authoryear" forall a b. (a -> b) -> a -> b
$ forall vk v. AtKey vk v => vk -> Key -> Maybe v
getAtKey Value
meta2 Key
"styleBiber"
            , dyNoCite :: Maybe Text
dyNoCite = forall vk v. AtKey vk v => vk -> Key -> Maybe v
getAtKey Value
meta2 Key
"nocite"
            , dyReferences :: Maybe Value
dyReferences = forall vk v. AtKey vk v => vk -> Key -> Maybe v
getAtKey Value
meta2 Key
"references"
            , dyReference_section_title :: Text
dyReference_section_title= forall a. a -> Maybe a -> a
fromMaybe Text
"References" forall a b. (a -> b) -> a -> b
$ forall vk v. AtKey vk v => vk -> Key -> Maybe v
getAtKey Value
meta2 Key
"reference-section-title"
            -- default should be set depending on the language 
            -- default does not work, needs to be put into yaml 
            , dyContentFiles :: [Text]
dyContentFiles = forall a. Maybe a -> [a]
maybeToList  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall vk v. AtKey vk v => vk -> Key -> Maybe v
getAtKey Value
meta2 forall a b. (a -> b) -> a -> b
$ Key
"content"
            -- TODO make reading a list
            , dyBook :: Text
dyBook = forall a. a -> Maybe a -> a
fromMaybe Text
"" forall a b. (a -> b) -> a -> b
$ forall vk v. AtKey vk v => vk -> Key -> Maybe v
getAtKey Value
meta2 Key
"book"
            , dyVersion :: Text
dyVersion = forall a. Text -> Maybe a -> a
fromJustN Text
"version" forall a b. (a -> b) -> a -> b
$ forall vk v. AtKey vk v => vk -> Key -> Maybe v
getAtKey Value
meta2 Key
"version"  -- no default here, must be present 
            , dyVisibility :: Text
dyVisibility = forall a. a -> Maybe a -> a
fromMaybe Text
"public" forall a b. (a -> b) -> a -> b
$ forall vk v. AtKey vk v => vk -> Key -> Maybe v
getAtKey Value
meta2 Key
"visibility"   
            -- public is default, private must be set
            -- but not default for publish! 
            --   dyIndexPage = fromMaybe False $ getAtKey meta2 "indexPage"
            , dyIndexSort :: Maybe Text
dyIndexSort = forall vk v. AtKey vk v => vk -> Key -> Maybe v
getAtKey Value
meta2 Key
"indexSort"
            , dyIndexEntry :: IndexEntry
dyIndexEntry =   forall z. Zeros z => z
zero
            , dyHeaderShift :: Int
dyHeaderShift = Maybe Text -> Int
parseHeaderShift forall a b. (a -> b) -> a -> b
$ forall vk v. AtKey vk v => vk -> Key -> Maybe v
getAtKey  Value
meta2 forall a b. (a -> b) -> a -> b
$ Key
"headerShift"
                                        -- value 1 is correct
            , dyDoNotReplace :: [Text]
dyDoNotReplace = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall a. CharChains a => a -> [a]
words' forall a b. (a -> b) -> a -> b
$ forall vk v. AtKey vk v => vk -> Key -> Maybe v
getAtKey Value
meta2 forall a b. (a -> b) -> a -> b
$ Key
"doNotReplace"
            -- , dyDoNotReplace = maybe [] (\t -> fromJustNote "sdfwer" $ splitOnflip  "," t) $ getAtKey meta2 $ "doNotReplace"
            }

    -- splitOnflip sep inp = splitOn' inp sep 

    ix1 :: IndexEntry
ix1 =  MetaPage -> IndexEntry
initializeIndex MetaPage
meta4
    -- meta5 = meta4   -- {dyAuthor=blankAuthorName hpnames (dyAuthor meta4) }
    meta6 :: MetaPage
meta6 = MetaPage
meta4{dyIndexEntry :: IndexEntry
dyIndexEntry = IndexEntry
ix1} 

    fromJustN :: Text -> Maybe a -> a 
    fromJustN :: forall a. Text -> Maybe a -> a
fromJustN Text
a = forall a. [Text] -> Maybe a -> a
fromJustNoteT [Text
"fromJust Nothing pandoc2MetaPage\n", forall {a}. Show a => a -> Text
showT Path Abs File
filename, Text
"\n", Text
a]

    parseHeaderShift :: Maybe Text -> Int 
    parseHeaderShift :: Maybe Text -> Int
parseHeaderShift Maybe Text
Nothing = Int
1   -- this is the default
    parseHeaderShift (Just Text
"zero") = Int
0 
    parseHeaderShift (Just Text
"one") = Int
1 
    parseHeaderShift (Just Text
"0") = Int
0 
    parseHeaderShift (Just Text
"1") = Int
1 
    parseHeaderShift (Just Text
a) = forall a. [Text] -> a
errorT [Text
"parseHeaderShift", Text
"unexpected Value", Text
a, Text
"!"] 

    -- fromJust Nothing = errorT ["fromJust Nothing pandoc2MetaPage", showT filename]
    -- fromJust (Just a) = a
 

initializeIndex :: MetaPage -> IndexEntry
-- initialize the index with the values from the metapage yaml
initializeIndex :: MetaPage -> IndexEntry
initializeIndex MetaPage{Int
FilePath
[Text]
Maybe Text
Maybe Value
Text
IndexEntry
dyHeaderShift :: Int
dyDoNotReplace :: [Text]
dyIndexEntry :: IndexEntry
dyIndexSort :: Maybe Text
dyVisibility :: Text
dyVersion :: Text
dyBook :: Text
dyNoCite :: Maybe Text
dyContentFiles :: [Text]
dyReference_section_title :: Text
dyReferences :: Maybe Value
dyStyleBiber :: Text
dyStyle :: Maybe Text
dyBibliography :: Maybe Text
dyImageCaption :: Text
dyImage :: Text
dyKeywords :: Text
dyDate :: Maybe Text
dyAuthor :: Text
dyAbstract :: Text
dyTitle :: Text
dyLang :: Text
dyLink :: FilePath
dyFn :: FilePath
dyHeaderShift :: MetaPage -> Int
dyDoNotReplace :: MetaPage -> [Text]
dyIndexEntry :: MetaPage -> IndexEntry
dyIndexSort :: MetaPage -> Maybe Text
dyVisibility :: MetaPage -> Text
dyVersion :: MetaPage -> Text
dyBook :: MetaPage -> Text
dyNoCite :: MetaPage -> Maybe Text
dyContentFiles :: MetaPage -> [Text]
dyReference_section_title :: MetaPage -> Text
dyReferences :: MetaPage -> Maybe Value
dyStyleBiber :: MetaPage -> Text
dyStyle :: MetaPage -> Maybe Text
dyBibliography :: MetaPage -> Maybe Text
dyImageCaption :: MetaPage -> Text
dyImage :: MetaPage -> Text
dyKeywords :: MetaPage -> Text
dyDate :: MetaPage -> Maybe Text
dyAuthor :: MetaPage -> Text
dyAbstract :: MetaPage -> Text
dyTitle :: MetaPage -> Text
dyLang :: MetaPage -> Text
dyLink :: MetaPage -> FilePath
dyFn :: MetaPage -> FilePath
..} = IndexEntry
ix1
  where
    ix1 :: IndexEntry
ix1 =
        forall z. Zeros z => z
zero
            { ixfn :: FilePath
ixfn = FilePath
dyFn  
            , title :: Text
title = Text
dyTitle
            , link :: FilePath
link = FilePath
dyLink 
            , abstract :: Text
abstract = Text
dyAbstract
            , author :: Text
author = Text
dyAuthor
            , date :: Text
date = forall a. a -> Maybe a -> a
fromMaybe (forall {a}. Show a => a -> Text
showT UTCTime
year2000) Maybe Text
dyDate
            , content :: Text
content = forall z. Zeros z => z
zero
            -- , publish = dyVersion
            , dirEntries :: [IndexEntry]
dirEntries = forall z. Zeros z => z
zero
            , fileEntries :: [IndexEntry]
fileEntries = forall z. Zeros z => z
zero
            , headerShift :: Int
headerShift = Int
dyHeaderShift
            }

isIndexPage :: Path Abs File -> Bool 
isIndexPage :: Path Abs File -> Bool
isIndexPage Path Abs File
filename =  forall fp. Filenames1 fp => fp -> FilePath
getNakedFileName Path Abs File
filename forall a. Eq a => a -> a -> Bool
== FilePath
"index"

convertLink2html :: IndexEntry -> Text
convertLink2html IndexEntry
ix = FilePath -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. -- s2t . toFilePath $ 
          forall fp. Extensions fp => ExtensionType fp -> fp -> fp
setExtension (Extension -> FilePath
unExtension Extension
extHTML)   forall a b. (a -> b) -> a -> b
$ IndexEntry -> FilePath
link IndexEntry
ix

convertLink2pdf :: IndexEntry -> Text
convertLink2pdf IndexEntry
ix =  FilePath -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. -- s2t . toFilePath $ 
          forall fp. Extensions fp => ExtensionType fp -> fp -> fp
setExtension (Extension -> FilePath
unExtension Extension
extPDF)   forall a b. (a -> b) -> a -> b
$ IndexEntry -> FilePath
link IndexEntry
ix


-- extHTML :: Extension
-- extHTML = Extension "html"


extPDF :: Extension
extPDF :: Extension
extPDF = FilePath -> Extension
Extension FilePath
"pdf"

-- addFileMetaPage :: Path Abs Dir -> Path Abs Dir -> Path Abs File -> MetaPage
-- addFileMetaPage doughP bakedP fn =
--     if getNakedFileName fn == "index"
--         then mp1{dyIndexPage = True}
--         else mp1
--   where
--     mp1 =
--         zero
--             { dyFn = toFilePath fn
--             , dyLink =
--                 toFilePath
--                     (makeRelativeP doughP fn :: Path Rel File)
--             , dyStyle =  addBakedRoot bakedP ( dyStyle zero)
--             , dyBibliography = addBakedRoot bakedP                                           (dyBibliography zero)
--             } ::
--             MetaPage

-- addBakedRoot :: Path Abs Dir -> Maybe Text -> Maybe Text
-- addBakedRoot bakedP Nothing = Nothing
-- addBakedRoot bakedP (Just fp) = Just . s2t . toFilePath $ addFileName bakedP . t2s $ fp

-- -- | another data type to rep languages
-- not yet used - go for de_AT style and uses standard lang codes
-- data DocLanguage = DLgerman | DLenglish
--     deriving (Show, Read, Ord, Eq, Generic)

-- instance Zeros DocLanguage where zero = DLenglish

-- instance FromJSON DocLanguage

-- instance ToJSON DocLanguage

-- TODO is this clever to have a new language datatype?

-- this is not used yet:
-- data PublicationState = PSpublish | PSdraft | PSold | PSzero
--     deriving (Generic, Show, Read, Ord, Eq)
-- -- ^ is this file ready to publish

-- instance Zeros PublicationState where
--     zero = PSzero

-- instance NiceStrings PublicationState where
--     shownice = drop' 2 . showT

-- instance ToJSON PublicationState

-- instance FromJSON PublicationState