---------------------------------------------------------------------
--
-- Module      :  Wave.Md2doc
-- the conversion of markdown to docrep
------------------------------------------------------------------
{-# 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 #-}

module Wave.Md2doc (
    module Wave.Md2doc,
    -- MarkdownText (..),
) where

import UniformBase

import Foundational.SettingsPage  
import Foundational.MetaPage
  
import Foundational.Filetypes4sites ( Docrep(Docrep), meta1)
import Foundational.CmdLineFlags
    ( PubFlags(draftFlag, privateFlag) )
import Uniform.Pandoc
    (pandocProcessCites, markdownFileType, readMarkdown2 )
import Uniform.Latex
import Lib.FileHandling
import Lib.OneMDfile
import Foundational.MetaPage (MetaPage(dyDoNotReplace))
import Lib.FileHandling (readErlaubt)

readMarkdownFile2docrep  :: NoticeLevel -> Settings ->  Path Abs File ->  ErrIO Docrep 
-- read a markdown file and convert to docrep
readMarkdownFile2docrep :: NoticeLevel -> Settings -> Path Abs File -> ErrIO Docrep
readMarkdownFile2docrep NoticeLevel
debug Settings
sett3 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
"readMarkdownFile2docrep fnin", forall a. PrettyStrings a => a -> Text
showPretty Path Abs File
fnin]
        -- place to find PandocParseError

    MarkdownText
mdfile <- forall a b.
TypedFiles7a a b =>
Path Abs File -> TypedFile5 a b -> ErrIO b
read8 Path Abs File
fnin TypedFile5 Text MarkdownText
markdownFileType 
    Pandoc
pd <- MarkdownText -> ErrIO Pandoc
readMarkdown2 MarkdownText
mdfile
    -- could perhaps "need" all ix as files?

    -- let doc1 = pandoc2docrep doughP fnin  pd
    let meta6 :: MetaPage
meta6 = Settings -> Path Abs File -> Pandoc -> MetaPage
pandoc2MetaPage Settings
sett3 Path Abs File
fnin  Pandoc
pd 
    -- gets value from pandoc reading of yaml header
    -- fills values which can be defaulted (if not present)
    let doc1 :: Docrep
doc1 = MetaPage -> Pandoc -> Docrep
Docrep MetaPage
meta6 Pandoc
pd 

    let langCode :: Text
langCode = Text -> Text
latexLangConversion forall b c a. (b -> c) -> (a -> b) -> a -> c
. MetaPage -> Text
dyLang forall b c a. (b -> c) -> (a -> b) -> a -> c
. Docrep -> MetaPage
meta1 forall a b. (a -> b) -> a -> b
$ Docrep
doc1
    let debugReplace :: Bool
debugReplace = NoticeLevel -> Bool
inform NoticeLevel
debug 
    Docrep
doc2 <- if Text
langCode forall a. Eq a => a -> a -> Bool
== Text
"ngerman"  -- obtained e.g. from YAML header
        then  do 
            [Text]
erl1 <- Path Abs File -> ErrIO [Text]
readErlaubt (SiteLayout -> Path Abs File
replaceErlaubtFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. Settings -> SiteLayout
siteLayout forall a b. (a -> b) -> a -> b
$ Settings
sett3)
            let addErl :: [Text]
addErl = MetaPage -> [Text]
dyDoNotReplace forall b c a. (b -> c) -> (a -> b) -> a -> c
. Docrep -> MetaPage
meta1 forall a b. (a -> b) -> a -> b
$ Docrep
doc1
                -- allow additions to the list in the YAML header
                -- addErl2 = fromJustNote "sdfwer" $ splitOn' addErl ","
                erl2 :: [Text]
erl2 = [Text]
addErl forall a. [a] -> [a] -> [a]
++ [Text]
erl1
            Bool
changed <- Bool -> [Text] -> Path Abs File -> ErrIO Bool
applyReplace Bool
debugReplace [Text]
erl2   Path Abs File
fnin 
            if (Bool
changed Bool -> Bool -> Bool
&& (Bool -> Bool
not Bool
debugReplace)) 
                then NoticeLevel -> Settings -> Path Abs File -> ErrIO Docrep
readMarkdownFile2docrep NoticeLevel
debug  Settings
sett3 Path Abs File
fnin 
                -- when debug true then changed files are not written 
                else forall (m :: * -> *) a. Monad m => a -> m a
return Docrep
doc1
        else forall (m :: * -> *) a. Monad m => a -> m a
return Docrep
doc1
    forall (m :: * -> *) a. Monad m => a -> m a
return Docrep
doc2

applyReplace :: Bool -> [Text] -> Path Abs File -> ErrIO Bool 
-- apply the replace for german 
-- if any change true; needs rereading 
applyReplace :: Bool -> [Text] -> Path Abs File -> ErrIO Bool
applyReplace Bool
debugReplace [Text]
erl2 Path Abs File
fnin = do 
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debugReplace forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords 
        [Text
"applyReplace fnin", forall a. PrettyStrings a => a -> Text
showPretty Path Abs File
fnin
        , Text
"\t erlaubt:", forall {a}. Show a => a -> Text
showT [Text]
erl2]
    
    -- let         fnerl = makeAbsFile "/home/frank/Workspace11/replaceUmlaut/nichtUmlaute.txt" :: Path Abs File
    -- cdir <- currentDir
    -- let fnerlabs =   fnerl :: Path Abs File
    -- erl2 <- readErlaubt fnerlabs
    Bool
res <- Bool -> [Text] -> Path Abs File -> ErrIO Bool
procMd1 Bool
debugReplace [Text]
erl2 Path Abs File
fnin
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debugReplace forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"applyReplace done. Changed:", forall {a}. Show a => a -> Text
showT Bool
res ]

    forall (m :: * -> *) a. Monad m => a -> m a
return Bool
res 

    


-- pandoc2docrep ::  Path Abs Dir ->  Path Abs File  -> Pandoc -> Docrep
-- {- | convert the pandoc text to DocrepJSON
--  reads the markdown file with pandoc and extracts the yaml metadat
--  the metadata are then converted to metaPage from the json pandoc
--  -- duplication possible for data in the pandoc metada (no used)
--  TODO may use json record parse, which I have already done
-- -}
-- -- pure 
-- pandoc2docrep  doughP filename  pd = Docrep meta6  pd
--     where 
--         meta6 = pandoc2MetaPage doughP filename  pd 



--------------------------------
addRefs :: NoticeLevel -> Docrep -> ErrIO Docrep
{- ^ add the references to the pandoc block
 the biblio is in the yaml (otherwise nothing is done)
 the cls file must be in the yaml as well

-}


-- Process a Pandoc document by adding citations formatted according to a CSL style. Add a bibliography (if one is called for) at the end of the document.

addRefs :: NoticeLevel -> Docrep -> ErrIO Docrep
addRefs NoticeLevel
debug dr1 :: Docrep
dr1@(Docrep MetaPage
y1 Pandoc
p1) = do
    -- the biblio entry is the signal that refs need to be processed
    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
"addRefs", forall {a}. Show a => a -> Text
showT Docrep
dr1, Text
"\n"]
    case (MetaPage -> Maybe Text
dyBibliography MetaPage
y1) of
        Maybe Text
Nothing -> (forall (m :: * -> *) a. Monad m => a -> m a
return Docrep
dr1) 
        Just Text
_ ->  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
"addRefs2-1", forall {a}. Show a => a -> Text
showT forall a b. (a -> b) -> a -> b
$ MetaPage -> FilePath
dyFn MetaPage
y1
                    -- , "\npandoc", showT dr1, "\n"
                    , Text
"\n\t biblio1" , forall {a}. Show a => a -> Text
showT forall a b. (a -> b) -> a -> b
$ MetaPage -> Maybe Text
dyBibliography MetaPage
y1
                    , Text
"\n\t style1" , forall {a}. Show a => a -> Text
showT forall a b. (a -> b) -> a -> b
$ MetaPage -> Maybe Text
dyStyle MetaPage
y1
                    ]

            Pandoc
p2 <- Pandoc -> ErrIO Pandoc
pandocProcessCites  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
"addRefs2-4", Text
"p2\n", forall {a}. Show a => a -> Text
showT Pandoc
p2]

            forall (m :: * -> *) a. Monad m => a -> m a
return (MetaPage -> Pandoc -> Docrep
Docrep MetaPage
y1 Pandoc
p2)

filterNeeds :: NoticeLevel -> PubFlags -> Settings -> Path Rel File -> ErrIO(Maybe (Path Rel File))
-- ^ for md check the flags

filterNeeds :: NoticeLevel
-> PubFlags
-> Settings
-> Path Rel File
-> ErrIO (Maybe (Path Rel File))
filterNeeds NoticeLevel
debug PubFlags
pubf Settings
sett4 Path Rel File
fn =  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
"filterNeeds", Text
"\nPubFlags", forall {a}. Show a => a -> Text
showT PubFlags
pubf ]
    let doughP :: Path Abs Dir
doughP = SiteLayout -> Path Abs Dir
doughDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. Settings -> SiteLayout
siteLayout forall a b. (a -> b) -> a -> b
$ Settings
sett4
    Docrep
d1 <- NoticeLevel -> Settings -> Path Abs File -> ErrIO Docrep
readMarkdownFile2docrep NoticeLevel
debug Settings
sett4  (Path Abs Dir
doughP forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> Path Rel File
fn) 
    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
"filterNeeds2", Text
"\nMeta", forall {a}. Show a => a -> Text
showT (Docrep -> MetaPage
meta1 Docrep
d1) ]

    let t :: Bool
t = PubFlags -> MetaPage -> Bool
includeBakeTest3docrep PubFlags
pubf (Docrep -> MetaPage
meta1 Docrep
d1)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
t then forall a. a -> Maybe a
Just Path Rel File
fn else forall a. Maybe a
Nothing



includeBakeTest3docrep :: PubFlags -> MetaPage -> Bool 

-- ^ decide whether this is to be included in the bake 

includeBakeTest3docrep :: PubFlags -> MetaPage -> Bool
includeBakeTest3docrep PubFlags
pubf MetaPage
doc1 = 
        (PubFlags -> Bool
draftFlag PubFlags
pubf Bool -> Bool -> Bool
|| Text
vers1 forall a. Eq a => a -> a -> Bool
==   Text
"publish") 
        -- should be less than eq
            Bool -> Bool -> Bool
&& (PubFlags -> Bool
privateFlag PubFlags
pubf Bool -> Bool -> Bool
|| Text
vis1 forall a. Eq a => a -> a -> Bool
==  Text
"public")
    where
        -- draftF = draftFlag pubf 
        vers1 :: Text
vers1 = MetaPage -> Text
dyVersion   MetaPage
doc1
        vis1 :: Text
vis1 = MetaPage -> Text
dyVisibility  MetaPage
doc1