----------------------------------------------------------------------
--
-- Module Shake2 :
----------------------------------------------------------------------
{-  die struktur geht von den files aus, die man braucht und
    diese rekonstruieren die directories wieder, wenn sie kreiert werden.

    the start is with /getNeeds/ in phony:
        - md produces pdf
            - with convTex2pdf, calling
            - write2pdf (runs lualatex)
        - md produces html
            - with convPanrep2html, calling
            - bakeOneFile2panrep
            - docrep2panrep

    wird moeglicherweise ein filetyp (durch extension fixiert) aus zwei quellen produziert so muss dass in der regel fuer die generation
        beruecksichtigt werden
        (probleme html - entweder durch uebersestzen oder als resource eingestellt
        (problem pfd - dito )
        )

        anders geloest: 
        test ob file in dough existiert, dann kopiert

    ausgeschlossene directories werden durch DNB  markiert
    die files die in diesen gefunden werden, nicht zum umwandeln
        anzumelden, indem deren namen nicht in "want" eingeschlossen
        werden.

    pdf werden aus tex erzeugt, die aus texsnip erzeugt werden.
    jedes md ergibt ein texsnip
    jedes texsnip gibt ein tex
        die indexseiten, die grosse themen zusammenfassen
        produzieren ein tex mit includes fuer die subseiten
        und der preamble/post fuer e.g. biblio
    jedes tex gibt ein pdf
    das heisst: jedes md gibt ein pdf (auch eingestellte)
    -}
----------------------------------------------------------------------
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# OPTIONS_GHC -Wall -fno-warn-orphans
            -fno-warn-missing-signatures
            -fno-warn-missing-methods
            -fno-warn-duplicate-exports  #-}


module ShakeBake.Shake2 where

import           Uniform.Shake

import Foundational.SettingsPage
    -- ( SiteLayout(doughDir, bakedDir, themeDir),
    --   Settings(siteLayout) )
import Foundational.CmdLineFlags
      
import ShakeBake.ConvertFiles
    ( io2bool, convertAny, copyFileToBaked )

import Wave.Md2doc 

-- shakeDelete :: SiteLayout -> FilePath -> ErrIO ()
-- {- ^ experimental - twich found delete of md
--  not yet used
-- -}
-- shakeDelete _ filepath =
--     putIOwords
--         [ "\n\n*******************************************"
--         , "experimental -- twich found  DELETED MD file "
--         , s2t filepath
--         ]

shakeArgs2 :: Path b t -> Rules () -> IO ()

{- | set the options for shake
 called in shakeMD
-}
shakeArgs2 :: forall b t. Path b t -> Rules () -> IO ()
shakeArgs2 Path b t
bakedP = do
    -- putIOwords ["shakeArgs2", "bakedP", s2t . toFilePath $ bakedP]
    IO ()
res <-
        ShakeOptions -> Rules () -> IO ()
shake
            ShakeOptions
shakeOptions
                { shakeFiles :: FilePattern
shakeFiles = forall b t. Path b t -> FilePattern
toFilePath Path b t
bakedP  -- wgy should the shake files to into baked?
                , shakeVerbosity :: Verbosity
shakeVerbosity = Verbosity
Info -- Verbose --  Loud
                        -- verbose gives a single line for each file processed
                        --          plus info for copying
                        -- info gives nothing in normal process 
                , shakeLint :: Maybe Lint
shakeLint = forall a. a -> Maybe a
Just Lint
LintBasic
                }
    -- putIOwords ["shakeArgs2", "done"]
    forall (m :: * -> *) a. Monad m => a -> m a
return IO ()
res

shakeAll :: NoticeLevel -> Settings -> PubFlags -> FilePath -> ErrIO ()
-- ^ calls shake in the IO monade. this is in the ErrIO
shakeAll :: NoticeLevel -> Settings -> PubFlags -> FilePattern -> ErrIO ()
shakeAll NoticeLevel
debug Settings
sett3 PubFlags
flags FilePattern
causedby = do
    let layout :: SiteLayout
layout = Settings -> SiteLayout
siteLayout Settings
sett3 
        doughP :: Path Abs Dir
doughP = SiteLayout -> Path Abs Dir
doughDir SiteLayout
layout -- the regular dough
        bakedP :: Path Abs Dir
bakedP = SiteLayout -> Path Abs Dir
bakedDir SiteLayout
layout
        themeP :: Path Abs Dir
themeP = SiteLayout -> Path Abs Dir
themeDir SiteLayout
layout
    forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords
        [ Text
"\n\n===================================== shakeAll start"
        , Text
"\n flags"
        , forall a. PrettyStrings a => a -> Text
showPretty PubFlags
flags
        , Text
"\ncaused by"
        , FilePattern -> Text
s2t FilePattern
causedby
        , Text
"."
        , Text
"\ndebug:", forall {a}. Show a => a -> Text
showT NoticeLevel
debug
        , Text
"\ndough", forall {a}. Show a => a -> Text
showT Path Abs Dir
doughP 
        , Text
"\nbaked", forall {a}. Show a => a -> Text
showT Path Abs Dir
bakedP 
        , Text
"\ntheme", forall {a}. Show a => a -> Text
showT Path Abs Dir
themeP 

        , Text
"\n======================================="
        ]
            
    forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ NoticeLevel
-> Settings -> PubFlags -> Path Abs Dir -> Path Abs Dir -> IO ()
shakeMD NoticeLevel
debug Settings
sett3 PubFlags
flags Path Abs Dir
doughP Path Abs Dir
bakedP

-- todo remove shakeMD and pass only layout

shakeMD ::
    NoticeLevel ->
    Settings ->
    PubFlags ->
    Path Abs Dir -> -- dough (source for files)
    Path Abs Dir -> -- baked (target dir for site)
    IO ()
{- ^ bake all md files and copy the resources
 from each md produce:
    - html 
    - pdf 
 sets the current dir to doughDir
 copies banner image
 in IO
 TOP shake call
-}
shakeMD :: NoticeLevel
-> Settings -> PubFlags -> Path Abs Dir -> Path Abs Dir -> IO ()
shakeMD NoticeLevel
debug Settings
sett4 PubFlags
flags Path Abs Dir
doughP Path Abs Dir
bakedP = forall b t. Path b t -> Rules () -> IO ()
shakeArgs2 Path Abs Dir
bakedP forall a b. (a -> b) -> a -> b
$ do
    -- the special filenames which are necessary
    -- because the file types are not automatically
    -- copied
    -- todo remove doughP and bakedP

    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
"shakeMD dirs\n"
                                    , Text
"\tbakedP\n"
                                , forall {a}. Show a => a -> Text
showT Path Abs Dir
bakedP
                                ]
    -- let siteDirs = siteLayout sett4 
        -- doughP = doughDir siteDirs -- the regular dough
        -- bakedP = bakedDir siteDirs
        -- themeP = themeDir siteDirs



    Partial => [FilePattern] -> Rules ()
want [FilePattern
"allMarkdownConversion"]

    Partial => FilePattern -> Action () -> Rules ()
phony FilePattern
"allMarkdownConversion" forall a b. (a -> b) -> a -> b
$ do
        -- these are functions to construct the desired results
        -- which then produce them
        -- the original start needs in baked (from the files in dough)

        -- put a link to the themplates folder into dough/resources
        -- otherwise confusion with copying the files from two places

        -- from the theme folder copy woff, css and jpg/JPG 
        -- woffTheme <- getNeeds debug sett4 themeP bakedP "woff" "woff"
        -- needP woffTheme
        -- imgsTheme <- getNeeds debug sett4   themeP bakedP "jpg" "jpg"
        -- imgs2Theme <- getNeeds debug sett4   themeP bakedP "JPG" "JPG"
        -- needP imgsTheme
        -- needP imgs2Theme
        -- cssTheme <- getNeeds debug sett4 themeP bakedP "css" "css"
        -- needP cssTheme

            -- do the images first to be findable by latex processor
        [Path Abs File]
imgs <- NoticeLevel
-> Settings
-> Path Abs Dir
-> Path Abs Dir
-> Text
-> Text
-> Action [Path Abs File]
getNeeds NoticeLevel
debug Settings
sett4   Path Abs Dir
doughP Path Abs Dir
bakedP Text
"jpg" Text
"jpg"
        [Path Abs File]
imgs2 <- NoticeLevel
-> Settings
-> Path Abs Dir
-> Path Abs Dir
-> Text
-> Text
-> Action [Path Abs File]
getNeeds NoticeLevel
debug Settings
sett4   Path Abs Dir
doughP Path Abs Dir
bakedP Text
"JPG" Text
"JPG"
        forall r. [Path r File] -> Action ()
needP [Path Abs File]
imgs
        forall r. [Path r File] -> Action ()
needP [Path Abs File]
imgs2

        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (PubFlags -> Bool
quickFlag PubFlags
flags) forall a b. (a -> b) -> a -> b
$ do 
            [Path Abs File]
pdfs <- NoticeLevel
-> PubFlags
-> Settings
-> Path Abs Dir
-> Path Abs Dir
-> Text
-> Text
-> Action [Path Abs File]
getNeedsMD NoticeLevel
debug PubFlags
flags Settings
sett4 Path Abs Dir
doughP Path Abs Dir
bakedP Text
"md" Text
"pdf"
            forall r. [Path r File] -> Action ()
needP [Path Abs File]
pdfs

        [Path Abs File]
htmls <- NoticeLevel
-> PubFlags
-> Settings
-> Path Abs Dir
-> Path Abs Dir
-> Text
-> Text
-> Action [Path Abs File]
getNeedsMD NoticeLevel
debug PubFlags
flags Settings
sett4 Path Abs Dir
doughP Path Abs Dir
bakedP Text
"md" Text
"html"
        forall r. [Path r File] -> Action ()
needP [Path Abs File]
htmls

        [Path Abs File]
csss <- NoticeLevel
-> Settings
-> Path Abs Dir
-> Path Abs Dir
-> Text
-> Text
-> Action [Path Abs File]
getNeeds NoticeLevel
debug Settings
sett4   Path Abs Dir
doughP Path Abs Dir
bakedP Text
"css" Text
"css"
        forall r. [Path r File] -> Action ()
needP [Path Abs File]
csss

        -- fonts, takes only the woff
        -- from the link to the template folder
        [Path Abs File]
woffs <- NoticeLevel
-> Settings
-> Path Abs Dir
-> Path Abs Dir
-> Text
-> Text
-> Action [Path Abs File]
getNeeds NoticeLevel
debug Settings
sett4   Path Abs Dir
doughP Path Abs Dir
bakedP Text
"woff" Text
"woff"
        forall r. [Path r File] -> Action ()
needP [Path Abs File]
woffs

        [Path Abs File]
publist <- NoticeLevel
-> Settings
-> Path Abs Dir
-> Path Abs Dir
-> Text
-> Text
-> Action [Path Abs File]
getNeeds NoticeLevel
debug Settings
sett4   Path Abs Dir
doughP Path Abs Dir
bakedP Text
"html" Text
"html"
        forall r. [Path r File] -> Action ()
needP [Path Abs File]
publist
        -- for the pdfs which are already given in dough
        [Path Abs File]
pdfs2 <- NoticeLevel
-> Settings
-> Path Abs Dir
-> Path Abs Dir
-> Text
-> Text
-> Action [Path Abs File]
getNeeds NoticeLevel
debug Settings
sett4   Path Abs Dir
doughP Path Abs Dir
bakedP Text
"pdf" Text
"pdf"
        forall r. [Path r File] -> Action ()
needP [Path Abs File]
pdfs2
        [Path Abs File]
bibs <- NoticeLevel
-> Settings
-> Path Abs Dir
-> Path Abs Dir
-> Text
-> Text
-> Action [Path Abs File]
getNeeds NoticeLevel
debug Settings
sett4   Path Abs Dir
doughP Path Abs Dir
bakedP Text
"bib" Text
"bib"
        forall r. [Path r File] -> Action ()
needP [Path Abs File]
bibs


    (forall b t. Path b t -> FilePattern
toFilePath Path Abs Dir
bakedP forall a. Semigroup a => a -> a -> a
<> FilePattern
"**/*.html") Partial => FilePattern -> (FilePattern -> Action ()) -> Rules ()
%> \FilePattern
out -> -- from Panrep
    -- calls the copy html if a html exist in dough 
            -- else calls the conversion from md

        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
"rule **/*.html", forall {a}. Show a => a -> Text
showT FilePattern
out]

            let outP :: Path Abs File
outP = FilePattern -> Path Abs File
makeAbsFile FilePattern
out :: Path Abs File
            let fromfile :: FileResultT (Path Abs Dir) (Path Rel File)
fromfile = Path Abs Dir
doughP forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> forall a c. Path2nd a c => Path a Dir -> Path a c -> Path Rel c
makeRelativeP Path Abs Dir
bakedP Path Abs File
outP
            Bool
fileExists <- forall (m :: * -> *) b. MonadIO m => ErrIO b -> m b
io2bool forall a b. (a -> b) -> a -> b
$ forall fp. FileOps fp => fp -> ErrIO Bool
doesFileExist' FileResultT (Path Abs Dir) (Path Rel File)
fromfile
            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
"rule **/*.html - fileExist:", forall {a}. Show a => a -> Text
showT Bool
fileExists]
            
            if Bool
fileExists 
                then forall fp.
(Filenames3 fp (Path Rel File),
 FileResultT fp (Path Rel File) ~ Path Abs File) =>
NoticeLevel -> fp -> Path Abs Dir -> FilePattern -> Action ()
copyFileToBaked NoticeLevel
debug Path Abs Dir
doughP Path Abs Dir
bakedP FilePattern
out
                else 
            -- csss <- getNeeds debug sett4 doughP bakedP "css" "css"
            -- needP csss
            -- -- csss seems not necessary
            -- imgs <- getNeeds debug sett4 doughP bakedP "jpg" "jpg"
            -- imgs2 <- getNeeds debug sett4 doughP bakedP "JPG" "JPG"
            -- needP imgs
            -- needP imgs2
            -- when (inform debug) $ putIOwords ["rule **/*.html", showT out]
  
                    NoticeLevel
-> Path Abs Dir
-> Path Abs Dir
-> PubFlags
-> Settings
-> FilePattern
-> Text
-> Action ()
convertAny NoticeLevel
debug Path Abs Dir
bakedP Path Abs Dir
bakedP PubFlags
flags Settings
sett4 FilePattern
out  Text
"convPanrep2html"


    (forall b t. Path b t -> FilePattern
toFilePath Path Abs Dir
bakedP forall a. Semigroup a => a -> a -> a
<> FilePattern
"**/*.pdf") Partial => FilePattern -> (FilePattern -> Action ()) -> Rules ()
%> \FilePattern
out -> -- insert pdfFIles1
        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
"rule **/*.pdf", forall {a}. Show a => a -> Text
showT FilePattern
out]
            -- imgs <- getNeeds debug sett4 doughP bakedP "jpg" "jpg"
            -- imgs2 <- getNeeds debug sett4 doughP bakedP "JPG" "JPG"
            -- needP imgs
            -- needP imgs2
            -- why is this here necessary: failed on testSort.pdf?
            -- was ein jpg will ?
            -- TODO improve error from lualatex
            -- when (inform debug) $ putIOwords ["rule **/*.pdf need", showT imgs, showT imgs2]

            let outP :: Path Abs File
outP = FilePattern -> Path Abs File
makeAbsFile FilePattern
out :: Path Abs File
            let fromfile :: FileResultT (Path Abs Dir) (Path Rel File)
fromfile = Path Abs Dir
doughP forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> forall a c. Path2nd a c => Path a Dir -> Path a c -> Path Rel c
makeRelativeP Path Abs Dir
bakedP Path Abs File
outP
            Bool
fileExists <- forall (m :: * -> *) b. MonadIO m => ErrIO b -> m b
io2bool forall a b. (a -> b) -> a -> b
$ forall fp. FileOps fp => fp -> ErrIO Bool
doesFileExist' FileResultT (Path Abs Dir) (Path Rel File)
fromfile
            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
"fileExist:", forall {a}. Show a => a -> Text
showT Bool
fileExists]
            
            if Bool
fileExists 
                then forall fp.
(Filenames3 fp (Path Rel File),
 FileResultT fp (Path Rel File) ~ Path Abs File) =>
NoticeLevel -> fp -> Path Abs Dir -> FilePattern -> Action ()
copyFileToBaked NoticeLevel
debug Path Abs Dir
doughP Path Abs Dir
bakedP FilePattern
out
                else             
                    NoticeLevel
-> Path Abs Dir
-> Path Abs Dir
-> PubFlags
-> Settings
-> FilePattern
-> Text
-> Action ()
convertAny NoticeLevel
debug Path Abs Dir
bakedP Path Abs Dir
bakedP PubFlags
flags Settings
sett4 FilePattern
out  Text
"convTex2pdf"

    (forall b t. Path b t -> FilePattern
toFilePath Path Abs Dir
bakedP forall a. Semigroup a => a -> a -> a
<> FilePattern
"**/*.tex") Partial => FilePattern -> (FilePattern -> Action ()) -> Rules ()
%> \FilePattern
out -> -- insert pdfFIles1
        NoticeLevel
-> Path Abs Dir
-> Path Abs Dir
-> PubFlags
-> Settings
-> FilePattern
-> Text
-> Action ()
convertAny NoticeLevel
debug Path Abs Dir
bakedP Path Abs Dir
bakedP PubFlags
flags Settings
sett4 FilePattern
out  Text
"convTexsnip2tex"

    (forall b t. Path b t -> FilePattern
toFilePath Path Abs Dir
bakedP forall a. Semigroup a => a -> a -> a
<> FilePattern
"**/*.texsnip") Partial => FilePattern -> (FilePattern -> Action ()) -> Rules ()
%> \FilePattern
out -> -- insert pdfFIles1
        NoticeLevel
-> Path Abs Dir
-> Path Abs Dir
-> PubFlags
-> Settings
-> FilePattern
-> Text
-> Action ()
convertAny NoticeLevel
debug Path Abs Dir
bakedP Path Abs Dir
bakedP PubFlags
flags Settings
sett4 FilePattern
out  Text
"convPanrep2texsnip"

    (forall b t. Path b t -> FilePattern
toFilePath Path Abs Dir
bakedP forall a. Semigroup a => a -> a -> a
<> FilePattern
"**/*.panrep") Partial => FilePattern -> (FilePattern -> Action ()) -> Rules ()
%> \FilePattern
out -> -- insert pdfFIles1
        do NoticeLevel
-> Path Abs Dir
-> Path Abs Dir
-> PubFlags
-> Settings
-> FilePattern
-> Text
-> Action ()
convertAny NoticeLevel
debug Path Abs Dir
bakedP Path Abs Dir
bakedP PubFlags
flags Settings
sett4 FilePattern
out  Text
"convDocrep2panrep"

    (forall b t. Path b t -> FilePattern
toFilePath Path Abs Dir
bakedP forall a. Semigroup a => a -> a -> a
<> FilePattern
"**/*.docrep") Partial => FilePattern -> (FilePattern -> Action ()) -> Rules ()
%> \FilePattern
out -> -- insert pdfFIles1  -- here start with doughP
        do
            -- bibs <- getNeeds debug sett4 doughP bakedP "bib" "bib"
            -- needP bibs
            -- csls <- getNeeds debug sett4 doughP bakedP "csl" "csl"
            -- needP csls
            -- when (inform debug) $ putIOwords ["rule **/*.docrep need", showT bibs]
            -- when (inform debug) $ putIOwords ["rule **/*.docrep need", showT csls]

            NoticeLevel
-> Path Abs Dir
-> Path Abs Dir
-> PubFlags
-> Settings
-> FilePattern
-> Text
-> Action ()
convertAny NoticeLevel
debug Path Abs Dir
doughP Path Abs Dir
bakedP PubFlags
flags Settings
sett4 FilePattern
out  Text
"convMD2docrep"
            forall (m :: * -> *) a. Monad m => a -> m a
return ()

    -- rest are copies

    -- (toFilePath bakedP <> "/*.md") -- is required because the convA2B - but this is fixed 
    --     %> \out -> -- insert css -- no subdir
            -- copyFileToBaked debug doughP bakedP out
    (forall b t. Path b t -> FilePattern
toFilePath Path Abs Dir
bakedP forall a. Semigroup a => a -> a -> a
<> FilePattern
"/*.css")
        Partial => FilePattern -> (FilePattern -> Action ()) -> Rules ()
%> \FilePattern
out -> -- insert css -- no subdir
            forall fp.
(Filenames3 fp (Path Rel File),
 FileResultT fp (Path Rel File) ~ Path Abs File) =>
NoticeLevel -> fp -> Path Abs Dir -> FilePattern -> Action ()
copyFileToBaked NoticeLevel
debug Path Abs Dir
doughP Path Abs Dir
bakedP FilePattern
out
    (forall b t. Path b t -> FilePattern
toFilePath Path Abs Dir
bakedP forall a. Semigroup a => a -> a -> a
<> FilePattern
"/*.csl")  -- not used with biber TODO 
        Partial => FilePattern -> (FilePattern -> Action ()) -> Rules ()
%> \FilePattern
out -> -- insert css -- no subdir
            forall fp.
(Filenames3 fp (Path Rel File),
 FileResultT fp (Path Rel File) ~ Path Abs File) =>
NoticeLevel -> fp -> Path Abs Dir -> FilePattern -> Action ()
copyFileToBaked NoticeLevel
debug Path Abs Dir
doughP Path Abs Dir
bakedP FilePattern
out

    [forall b t. Path b t -> FilePattern
toFilePath Path Abs Dir
bakedP forall a. Semigroup a => a -> a -> a
<> FilePattern
"/*.JPG", forall b t. Path b t -> FilePattern
toFilePath Path Abs Dir
bakedP forall a. Semigroup a => a -> a -> a
<> FilePattern
"/*.jpg"]
    -- seems not to differentiate the JPG and jpg; copies whatever the original 
    -- the html and/or the pdf includegraphics seem to be case sensitive, even for the extension
        Partial => [FilePattern] -> (FilePattern -> Action ()) -> Rules ()
|%> \FilePattern
out -> -- insert img files
        -- no subdir (for now)
            forall fp.
(Filenames3 fp (Path Rel File),
 FileResultT fp (Path Rel File) ~ Path Abs File) =>
NoticeLevel -> fp -> Path Abs Dir -> FilePattern -> Action ()
copyFileToBaked NoticeLevel
debug Path Abs Dir
doughP Path Abs Dir
bakedP FilePattern
out

    (forall b t. Path b t -> FilePattern
toFilePath Path Abs Dir
bakedP forall a. Semigroup a => a -> a -> a
<> FilePattern
"**/*.bib")
        Partial => FilePattern -> (FilePattern -> Action ()) -> Rules ()
%> \FilePattern
out -> forall fp.
(Filenames3 fp (Path Rel File),
 FileResultT fp (Path Rel File) ~ Path Abs File) =>
NoticeLevel -> fp -> Path Abs Dir -> FilePattern -> Action ()
copyFileToBaked NoticeLevel
debug Path Abs Dir
doughP Path Abs Dir
bakedP FilePattern
out
    -- the fonts in a compressed format 
    (forall b t. Path b t -> FilePattern
toFilePath Path Abs Dir
bakedP forall a. Semigroup a => a -> a -> a
<> FilePattern
"**/*.woff")
        Partial => FilePattern -> (FilePattern -> Action ()) -> Rules ()
%> \FilePattern
out -> forall fp.
(Filenames3 fp (Path Rel File),
 FileResultT fp (Path Rel File) ~ Path Abs File) =>
NoticeLevel -> fp -> Path Abs Dir -> FilePattern -> Action ()
copyFileToBaked NoticeLevel
debug Path Abs Dir
doughP Path Abs Dir
bakedP FilePattern
out

getNeeds ::
    NoticeLevel 
    -> Settings -- ^ the site layout etc
    -> Path Abs Dir  -- ^ source dir
    -> Path Abs Dir  -- ^ target dir
    -> Text  -- ^ extension source
    -> Text  -- ^ extension target
    -> Action [Path Abs File]
{- ^ find the files which are needed (generic)
  from source with extension ext
  does not include directory DNB (do not bake)
-}
getNeeds :: NoticeLevel
-> Settings
-> Path Abs Dir
-> Path Abs Dir
-> Text
-> Text
-> Action [Path Abs File]
getNeeds NoticeLevel
debug  Settings
sett4 Path Abs Dir
sourceP Path Abs Dir
targetP Text
extSource Text
extTarget = do
    let sameExt :: Bool
sameExt = Text
extSource forall a. Eq a => a -> a -> Bool
== Text
extTarget
    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
"===================\ngetNeeds extSource"
            , Text
extSource
            , Text
"extTarget"
            , Text
extSource
            , Text
"sameExt"
            , forall {a}. Show a => a -> Text
showT Bool
sameExt
            ]

    [Path Rel File]
filesWithSource :: [Path Rel File] <- -- getDirectoryFilesP
        Text -> Path Abs Dir -> [FilePattern] -> Action [Path Rel File]
getFilesToBake
            (SiteLayout -> Text
doNotBake  (Settings -> SiteLayout
siteLayout Settings
sett4)) -- exclude files containing
            Path Abs Dir
sourceP
            [FilePattern
"**/*." forall a. Semigroup a => a -> a -> a
<> Text -> FilePattern
t2s Text
extSource]
    -- subdirs
    let filesWithTarget :: [Path Abs File]
filesWithTarget =
            if Bool
sameExt
                then [Path Abs Dir
targetP forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> Path Rel File
c | Path Rel File
c <- [Path Rel File]
filesWithSource]
                else
                    forall a b. (a -> b) -> [a] -> [b]
map
                        (forall a. Text -> Path a File -> Path a File
replaceExtension' Text
extTarget forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path Abs Dir
targetP forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</>))
                         [Path Rel File]
filesWithSource  
                                :: [Path Abs File]
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NoticeLevel -> Bool
inform NoticeLevel
debug) forall a b. (a -> b) -> a -> b
$ do
        forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords
            [ Text
"===================\ngetNeeds -  source files 1"
            , Text
"for ext"
            , Text
extSource
            , Text
"files\n"
            , forall {a}. Show a => a -> Text
showT [Path Rel File]
filesWithSource
            ]
        forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords
            [ Text
"\nbakePDF -  target files 2"
            , Text
"for ext"
            , Text
extTarget
            , Text
"files\n"
            , forall {a}. Show a => a -> Text
showT [Path Abs File]
filesWithTarget
            ]
    forall (m :: * -> *) a. Monad m => a -> m a
return [Path Abs File]
filesWithTarget

getNeedsMD ::
    NoticeLevel 
    -> PubFlags 
    -> Settings   -- perhaps the next two can be
    -> Path Abs Dir  -- ^ source dir
    -> Path Abs Dir  -- ^ target dir
    -> Text  -- ^ extension source
    -> Text  -- ^ extension target
    -> Action [Path Abs File]
{- ^ find the files which are needed (generic)
  from source with extension ext
  does not include directory DNB (do not bake)
-}
getNeedsMD :: NoticeLevel
-> PubFlags
-> Settings
-> Path Abs Dir
-> Path Abs Dir
-> Text
-> Text
-> Action [Path Abs File]
getNeedsMD NoticeLevel
debug PubFlags
flags Settings
sett4 Path Abs Dir
sourceP Path Abs Dir
targetP Text
extSource Text
extTarget = do
    let sameExt :: Bool
sameExt = Text
extSource forall a. Eq a => a -> a -> Bool
== Text
extTarget
    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
"===================\ngetNeeds extSource"
            , Text
extSource
            , Text
"extTarget"
            , Text
extSource
            , Text
"sameExt"
            , forall {a}. Show a => a -> Text
showT Bool
sameExt
            ]

    [Path Rel File]
filesWithSource :: [Path Rel File] <- -- getDirectoryFilesP
        Text -> Path Abs Dir -> [FilePattern] -> Action [Path Rel File]
getFilesToBake
             (SiteLayout -> Text
doNotBake  (Settings -> SiteLayout
siteLayout Settings
sett4))   -- exclude files containing
            Path Abs Dir
sourceP
            [FilePattern
"**/*." forall a. Semigroup a => a -> a -> a
<> Text -> FilePattern
t2s Text
extSource]
    [Maybe (Path Rel File)]
files2 <- forall a. ErrIO a -> Action a
runErr2action forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (NoticeLevel
-> PubFlags
-> Settings
-> Path Rel File
-> ErrIO (Maybe (Path Rel File))
filterNeeds NoticeLevel
debug PubFlags
flags Settings
sett4 ) [Path Rel File]
filesWithSource
    -- subdirs
    let filesWithTarget :: [Path Abs File]
filesWithTarget =
            if Bool
sameExt
                then [Path Abs Dir
targetP forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</> Path Rel File
c | Path Rel File
c <- [Path Rel File]
filesWithSource]
                else
                    forall a b. (a -> b) -> [a] -> [b]
map
                        (forall a. Text -> Path a File -> Path a File
replaceExtension' Text
extTarget forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path Abs Dir
targetP forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
</>))
                            (forall a. [Maybe a] -> [a]
catMaybes [Maybe (Path Rel File)]
files2) :: [Path Abs File]
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NoticeLevel -> Bool
inform NoticeLevel
debug) forall a b. (a -> b) -> a -> b
$ do
        forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords
            [ Text
"===================\ngetNeeds -  source files 1"
            , Text
"for ext"
            , Text
extSource
            , Text
"files\n"
            , forall {a}. Show a => a -> Text
showT [Path Rel File]
filesWithSource
            ]
        forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords
            [ Text
"\nbakePDF -  target files 2"
            , Text
"for ext"
            , Text
extTarget
            , Text
"files\n"
            , forall {a}. Show a => a -> Text
showT [Path Abs File]
filesWithTarget
            ]
    forall (m :: * -> *) a. Monad m => a -> m a
return [Path Abs File]
filesWithTarget