----------------------------------------------------------------------
--
-- Module      :   check the md files 
----------------------------------------------------------------------
{-# LANGUAGE OverloadedStrings #-}
-- {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -Wall #-}

module Lib.CheckProcess where

import UniformBase
import ShakeBake.ReadSettingFile  
import Foundational.SettingsPage
import System.Directory.Recursive
import Uniform.Pandoc
-- import Foundational.Filetypes4sites  
-- import Wave.Md2doc 
import Foundational.MetaPage 
-- import Control.Exception
-- import Control.DeepSeq
import Data.Char

checkProcess :: NoticeLevel -> Path Abs File-> ErrIO ()
{- ^ the top call to check the md files. first collect all the filenames
-}
checkProcess :: NoticeLevel -> Path Abs File -> ErrIO ()
checkProcess NoticeLevel
debug Path Abs File
sitefn = 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
"checkProcess", Text
"start"]
    Settings
sett3 <- NoticeLevel -> Path Abs File -> ErrIO Settings
readSettings NoticeLevel
debug (Path Abs File
sitefn)
    let doughP :: Path Abs Dir
doughP = SiteLayout -> Path Abs Dir
doughDir (Settings -> SiteLayout
siteLayout 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
"checkProcess 1", Text
"doughP", forall a. PrettyStrings a => a -> Text
showPretty Path Abs Dir
doughP]

    -- get all md files in doughP 
    [FilePath]
fns :: [FilePath] <- forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
getDirRecursive (forall b t. Path b t -> FilePath
toFilePath Path Abs Dir
doughP) 

    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
"checkProcess 1", Text
"fns", forall {a}. Show a => a -> Text
showT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
10 forall a b. (a -> b) -> a -> b
$ [FilePath]
fns]

    let mds :: [FilePath]
mds = forall a. (a -> Bool) -> [a] -> [a]
filter (forall fp. Extensions fp => ExtensionType fp -> fp -> Bool
hasExtension FilePath
"md") [FilePath]
fns 
    -- let mds = filter (hasExtension extMD) fns -- TODO 
    
    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
"checkProcess 2", Text
"mds", forall {a}. Show a => a -> Text
showT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
10 forall a b. (a -> b) -> a -> b
$ [FilePath]
mds]

    let mds1 :: [FilePath]
mds1 = [FilePath]
mds -- filter (notDNB (siteLayout sett3)) mds
    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
"checkProcess 2", Text
"mds1", forall {a}. Show a => a -> Text
showT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
10 forall a b. (a -> b) -> a -> b
$ [FilePath]
mds1]
    let mds2 :: [Path Abs File]
mds2 = forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Path Abs File
makeAbsFile [FilePath]
mds1
    -- let hpname = blogAuthorToSuppress.storag sett3

    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (NoticeLevel -> Path Abs File -> ErrIO ()
checkOneMD NoticeLevel
debug ) [Path Abs File]
mds2 

    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
"checkProcess", Text
"end"]
    forall (m :: * -> *) a. Monad m => a -> m a
return ()



checkOneMD:: NoticeLevel ->  Path Abs File -> ErrIO ()
-- check one md file (only the yaml head) for necessary values 
checkOneMD :: NoticeLevel -> Path Abs File -> ErrIO ()
checkOneMD NoticeLevel
debug  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
"checkOneMD fnin", forall a. PrettyStrings a => a -> Text
showPretty Path Abs File
fnin]
        -- same setup as Startdainoprocess 
        Path Abs Dir
currDir :: Path Abs Dir  <- ErrIO (Path Abs Dir)
currentDir 
        let settfn :: FileResultT (Path Abs Dir) (Path Rel File)
settfn =  Path Abs Dir
currDir forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> Path Rel File
settingsFileName

        Settings
sett3 <- NoticeLevel -> Path Abs File -> ErrIO Settings
readSettings NoticeLevel
debug Path Abs File
settfn 

        -- (Docrep y1 _) <- readMarkdownFile2docrep debug doughP fnin
        -- copied from md2doc.hs
        -- mdfile <- read8 fnin markdownFileType 
        -- pd <- readMarkdown2 mdfile
        
        -- let doughP = doughDir (siteLayout sett3)
        -- let doughP = makeAbsDir "/home/frank/Workspace11/daino/docs/site/dough/"
                -- is not used 
        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

        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
"checkOneMD 1"]
        MetaPage
y1 <- NoticeLevel
-> Settings -> Path Abs File -> Pandoc -> ErrIO MetaPage
check_readMeta NoticeLevel
debug Settings
sett3 Path Abs File
fnin  Pandoc
pd 

        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
"checkOneMD 2", Text
"metapage", forall a. PrettyStrings a => a -> Text
showPretty  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
"checkOneMD", Text
"done"]
        forall (m :: * -> *) a. Monad m => a -> m a
return ()
    )
    forall (m :: * -> *) e a e'.
Monad m =>
ExceptT e m a -> (e -> ExceptT e' m a) -> ExceptT e' m a
`catchError` (\Text
e -> do
        forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"checkOneMD", Text
"discovered error in file", forall {a}. Show a => a -> Text
showT Path Abs File
fnin]
        -- putIOwords ["the yaml head is read as:", showPretty y1]
        forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"the error msg is:", Text
e ] -- showT (e :: SomeException)]
        forall (m :: * -> *) a. Monad m => a -> m a
return () 
        )

check_readMeta:: NoticeLevel -> Settings ->  Path Abs File -> Pandoc -> ErrIO  MetaPage
check_readMeta :: NoticeLevel
-> Settings -> Path Abs File -> Pandoc -> ErrIO MetaPage
check_readMeta NoticeLevel
debug Settings
sett3 Path Abs File
fnin  Pandoc
pd = 
    (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
"check_readMeta 1"]

        let meta6 :: MetaPage
meta6 = Settings -> Path Abs File -> Pandoc -> MetaPage
pandoc2MetaPage Settings
sett3 Path Abs File
fnin  Pandoc
pd
        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
"check_readMeta 2", Text
"metapage", forall a. PrettyStrings a => a -> Text
showPretty  MetaPage
meta6]    

        -- let y2 = meta6
        -- return y2
        let ll :: Int
ll = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
ord forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> FilePath
show forall a b. (a -> b) -> a -> b
$ MetaPage
meta6
        -- y2 <- liftIO $ do 
            -- putStr .   show $ ll  
            -- let y3 =   deepseq ll y1
        -- output is necessary to force evaluation - deepseq seems not to do it
        forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [forall {a}. Show a => a -> Text
showT  Int
ll]
        forall (m :: * -> *) a. Monad m => a -> m a
return MetaPage
meta6
      )

-- catch error is never reached. problem is in pure code (pandoc2meta)
-- discovered when output is forced 
--   `catchError` (\e -> do 
--             putIOwords ["\n\ncheck_readMeta", "discovered error in file", showT fnin]
--             -- putIOwords ["the yaml head is read as:", showPretty y1]
--             putIOwords ["the error msg is:", showT (e :: SomeException), "\n"]
--             return zero 
--             )