---------------------------------------------------------------
--
-- Module      :
---------------------------------------------------------------------
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wall -fno-warn-orphans 
            -fno-warn-missing-signatures
            -fno-warn-missing-methods 
            -fno-warn-unused-matches #-}

{- | convert the files and put in targe dir
              input is target filename
          this is the interface (only one) from shake to bake
-}
module ShakeBake.ConvertFiles where

import ShakeBake.Bake

import Foundational.Filetypes4sites
import Foundational.SettingsPage
import Foundational.CmdLineFlags

import Uniform.Pandoc

import Uniform.Shake
-- import UniformBase


io2bool :: MonadIO m => ErrIO b -> m b
io2bool :: forall (m :: * -> *) b. MonadIO m => ErrIO b -> m b
io2bool ErrIO b
op = do
    -- todo move
    ErrOrVal b
x <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. ErrIO a -> IO (ErrOrVal a)
runErr ErrIO b
op
    let res :: b
res = case ErrOrVal b
x of
            Left Text
msg -> forall a. [Text] -> a
errorT [Text
msg]
            Right b
b -> b
b
    forall (m :: * -> *) a. Monad m => a -> m a
return b
res

convertAny ::
    NoticeLevel ->
    Path Abs Dir ->
    Path Abs Dir ->
    PubFlags ->
    Settings ->
    FilePath ->
    -- | the name of the operation
    Text ->
    Action ()
-- produce any (either copy available in baked or produce with anyop)
convertAny :: NoticeLevel
-> Path Abs Dir
-> Path Abs Dir
-> PubFlags
-> Settings
-> FilePath
-> Text
-> Action ()
convertAny NoticeLevel
debug Path Abs Dir
sourceP Path Abs Dir
targetP PubFlags
flags Settings
layout FilePath
out Text
anyopName = 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
"-----------------", Text
"convertAny for", Text
anyopName]
    let outP :: Path Abs File
outP = FilePath -> Path Abs File
makeAbsFile FilePath
out :: Path Abs File
    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
"\nconvertAny 1", Text
"\n file out", forall {a}. Show a => a -> Text
showT FilePath
out]
    let (BakeOp
anyop, Extension
sourceExtA) = case Text
anyopName of 
            Text
"convMD2docrep" -> (BakeOp
bakeOneMD2docrep, Extension
extMD)
            Text
"convDocrep2panrep" -> (BakeOp
bakeOneDocrep2panrep, Extension
extDocrep)
            Text
"convPanrep2texsnip" -> (BakeOp
bakeOnePanrep2texsnip, Extension
extPanrep )
            Text
"convPanrep2html" -> (BakeOp
bakeOnePanrep2html, Extension
extPanrep )
            Text
"convTex2pdf" -> (BakeOp
bakeOneTex2pdf, Extension
extTex )
            Text
"convTexsnip2tex" -> (BakeOp
bakeOneTexsnip2tex, Extension
extTexSnip )
            Text
_  -> forall a. [Text] -> a
errorT [Text
"convertAny error unknown anyopName ", Text
anyopName]

    let fromfilePath :: FileResultT (Path Abs Dir) (Path Rel File)
fromfilePath = Path Abs Dir
sourceP 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
targetP Path Abs File
outP
    let fromfilePathExt :: Path Abs File
fromfilePathExt = forall a. Text -> Path a File -> Path a File
replaceExtension' (FilePath -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> FilePath
unExtension forall a b. (a -> b) -> a -> b
$ Extension
sourceExtA) FileResultT (Path Abs Dir) (Path Rel File)
fromfilePath 

    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
"\nconvertAny 2", Text
anyopName
        , Text
"extension", (FilePath -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. Extension -> FilePath
unExtension forall a b. (a -> b) -> a -> b
$ Extension
sourceExtA)
        ,  Text
"\n fromfilePath", forall {a}. Show a => a -> Text
showT FileResultT (Path Abs Dir) (Path Rel File)
fromfilePath
        , Text
" was causing NEED"   
        ,  Text
"\n fromfilePathExt", forall {a}. Show a => a -> Text
showT Path Abs File
fromfilePathExt   
        ,  Text
"\n file out", forall {a}. Show a => a -> Text
showT FilePath
out
        ] 

    Bool
fileExists <-  if Path Abs Dir
sourceP forall a. Eq a => a -> a -> Bool
== Path Abs Dir
targetP 
        then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False 
        else 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)
fromfilePath  --targetExt

    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
"\nconvertAny - fromfile exist:"
            , forall {a}. Show a => a -> Text
showT Bool
fileExists
            -- , "\nfile"
            -- , showT fromfilePath
            ]
    if Bool
fileExists 
        -- gives recursion, if the file is produced in earlier run
        then do  -- copy file from source to target
            Path Abs File -> Path Abs File -> Action ()
copyFileChangedP FileResultT (Path Abs Dir) (Path Rel File)
fromfilePath Path Abs File
outP
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NoticeLevel -> Bool
inform NoticeLevel
debug) forall a b. (a -> b) -> a -> b
$
                -- liftIO $
                    forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords
                        [Text
"\n convertAny  copied"
                         ,   Text
"\n\tfromfilePath ", forall {a}. Show a => a -> Text
showT FileResultT (Path Abs Dir) (Path Rel File)
fromfilePath, Text
"added NEED automatically"
                         ,  Text
"\n\t  file out", forall {a}. Show a => a -> Text
showT FilePath
out]
        else 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
"\nconvertAny call", Text
anyopName
                ,  Text
"\n\t fromfilePathExt"
                    ,  Text
" cause NEED for" ,forall {a}. Show a => a -> Text
showT Path Abs File
fromfilePathExt  
                ,  Text
"\n\t file out", forall {a}. Show a => a -> Text
showT FilePath
out
                ] 
            Partial => [FilePath] -> Action ()
need [forall b t. Path b t -> FilePath
toFilePath Path Abs File
fromfilePathExt]    
            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
"\nconvertAny runErr2Action", Text
anyopName
                ,  Text
"\n\t fromfilePathExt",  Text
" caused NEED which was then probably satisfied for ", forall {a}. Show a => a -> Text
showT Path Abs File
fromfilePathExt   
                ,  Text
"\n\t file out", forall {a}. Show a => a -> Text
showT FilePath
out
                ]
            [FilePath]
needsFound <- forall a. ErrIO a -> Action a
runErr2action forall a b. (a -> b) -> a -> b
$ BakeOp
anyop NoticeLevel
debug PubFlags
flags Path Abs File
fromfilePathExt Settings
layout Path Abs File
outP
            Partial => [FilePath] -> Action ()
need [FilePath]
needsFound
    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
"convertAny end for", Text
anyopName]
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

{- | the generic copy for all the files
 which can just be copied
 (exceptions md, which are a special case of needed)
-}
copyFileToBaked ::
    ( Filenames3 fp (Path Rel File)
    , FileResultT fp (Path Rel File) ~ Path Abs File
    ) =>
    NoticeLevel ->
    fp ->
    Path Abs Dir ->
    FilePath ->
    Action ()
copyFileToBaked :: forall fp.
(Filenames3 fp (Path Rel File),
 FileResultT fp (Path Rel File) ~ Path Abs File) =>
NoticeLevel -> fp -> Path Abs Dir -> FilePath -> Action ()
copyFileToBaked NoticeLevel
debug fp
doughP Path Abs Dir
bakedP FilePath
out = do
    let outP :: Path Abs File
outP = FilePath -> Path Abs File
makeAbsFile FilePath
out :: Path Abs File
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NoticeLevel -> Bool
inform NoticeLevel
debug) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text
"\ncopyFileToBaked outP", forall {a}. Show a => a -> Text
showT Path Abs File
outP]
    let fromfile :: FileResultT fp (Path Rel File)
fromfile = fp
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
    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
"\ncopyFileToBaked fromfile ", forall {a}. Show a => a -> Text
showT FileResultT fp (Path Rel File)
fromfile, Text
"added NEED automatically"]
    Path Abs File -> Path Abs File -> Action ()
copyFileChangedP FileResultT fp (Path Rel File)
fromfile Path Abs File
outP