{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts  #-}

{-|
Module      : $header$
Copyright   : (c) Laurent P René de Cotret, 2020
License     : GNU GPL, version 2 or above
Maintainer  : laurent.decotret@outlook.com
Stability   : internal
Portability : portable

Utilities to clean pandoc-plot output directories.
-}

module Text.Pandoc.Filter.Plot.Clean (
      cleanOutputDirs
    , readDoc
) where

-- TODO: forConcurrently

import           Control.Monad.Reader             (forM)

import qualified Data.ByteString.Lazy             as B
import           Data.Char                        (toLower)
import           Data.List                        (nub)
import           Data.Maybe                       (fromMaybe, catMaybes)

import           Data.Text                        (Text)
import qualified Data.Text.IO                     as Text

import           System.Directory                 (removePathForcibly)

import           System.FilePath                  (takeExtension) 

import           Text.Pandoc.Class                (runIO)
import           Text.Pandoc.Definition
import           Text.Pandoc.Error                (handleError)
import qualified Text.Pandoc.Readers              as P
import qualified Text.Pandoc.Options              as P
import           Text.Pandoc.Walk                 (query, Walkable)

import Text.Pandoc.Filter.Plot.Parse
import Text.Pandoc.Filter.Plot.Monad


-- | Clean all output related to pandoc-plot. This includes output directories specified 

-- in the configuration and in the document/block, as well as log files. 

-- Note that *all* files in pandoc-plot output directories will be removed.

--

-- The cleaned directories are returned.

cleanOutputDirs :: Walkable Block b => Configuration -> b -> IO [FilePath]
cleanOutputDirs :: Configuration -> b -> IO [FilePath]
cleanOutputDirs conf :: Configuration
conf doc :: b
doc = do
    
    case Configuration -> LogSink
logSink Configuration
conf of 
        LogFile fp :: FilePath
fp -> FilePath -> IO ()
removePathForcibly FilePath
fp
        _          -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    
    [Maybe FilePath]
directories <- [IO (Maybe FilePath)] -> IO [Maybe FilePath]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([IO (Maybe FilePath)] -> IO [Maybe FilePath])
-> [IO (Maybe FilePath)] -> IO [Maybe FilePath]
forall a b. (a -> b) -> a -> b
$ (Block -> [IO (Maybe FilePath)]) -> b -> [IO (Maybe FilePath)]
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query (\b :: Block
b -> [Block -> IO (Maybe FilePath)
outputDir Block
b]) b
doc
    [FilePath] -> (FilePath -> IO FilePath) -> IO [FilePath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM ([FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath] -> [FilePath])
-> ([Maybe FilePath] -> [FilePath])
-> [Maybe FilePath]
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe FilePath] -> [FilePath]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe FilePath] -> [FilePath]) -> [Maybe FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [Maybe FilePath]
directories) FilePath -> IO FilePath
removeDir
    where
        outputDir :: Block -> IO (Maybe FilePath)
outputDir b :: Block
b = Configuration -> PlotM (Maybe FilePath) -> IO (Maybe FilePath)
forall a. Configuration -> PlotM a -> IO a
runPlotM Configuration
conf (Block -> PlotM (Maybe FigureSpec)
parseFigureSpec Block
b PlotM (Maybe FigureSpec)
-> (Maybe FigureSpec -> PlotM (Maybe FilePath))
-> PlotM (Maybe FilePath)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe FilePath -> PlotM (Maybe FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath -> PlotM (Maybe FilePath))
-> (Maybe FigureSpec -> Maybe FilePath)
-> Maybe FigureSpec
-> PlotM (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FigureSpec -> FilePath) -> Maybe FigureSpec -> Maybe FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FigureSpec -> FilePath
directory)
        
        removeDir :: FilePath -> IO FilePath
        removeDir :: FilePath -> IO FilePath
removeDir d :: FilePath
d = FilePath -> IO ()
removePathForcibly FilePath
d IO () -> IO FilePath -> IO FilePath
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
d


-- | Read document, guessing what extensions and reader options are appropriate. If

-- the file cannot be read for any reason, an error is thrown.

readDoc :: FilePath -> IO Pandoc
readDoc :: FilePath -> IO Pandoc
readDoc fp :: FilePath
fp = Either PandocError Pandoc -> IO Pandoc
forall a. Either PandocError a -> IO a
handleError (Either PandocError Pandoc -> IO Pandoc)
-> IO (Either PandocError Pandoc) -> IO Pandoc
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (PandocIO Pandoc -> IO (Either PandocError Pandoc)
forall a. PandocIO a -> IO (Either PandocError a)
runIO (PandocIO Pandoc -> IO (Either PandocError Pandoc))
-> PandocIO Pandoc -> IO (Either PandocError Pandoc)
forall a b. (a -> b) -> a -> b
$ do
        let fmt :: Text
fmt = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
forall a. Monoid a => a
mempty (FilePath -> Maybe Text
formatFromFilePath FilePath
fp)
        (reader :: Reader PandocIO
reader, exts :: Extensions
exts) <- Text -> PandocIO (Reader PandocIO, Extensions)
forall (m :: * -> *).
PandocMonad m =>
Text -> m (Reader m, Extensions)
P.getReader Text
fmt
        let readerOpts :: ReaderOptions
readerOpts = ReaderOptions
defaultReaderOptions {readerExtensions :: Extensions
P.readerExtensions = Extensions
exts}
        case Reader PandocIO
reader of 
            P.TextReader fct :: ReaderOptions -> Text -> PandocIO Pandoc
fct -> do
                Text
t <- IO Text -> PandocIO Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> PandocIO Text) -> IO Text -> PandocIO Text
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Text
Text.readFile FilePath
fp 
                ReaderOptions -> Text -> PandocIO Pandoc
fct ReaderOptions
readerOpts Text
t
            P.ByteStringReader bst :: ReaderOptions -> ByteString -> PandocIO Pandoc
bst -> do
                ByteString
b <- IO ByteString -> PandocIO ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> PandocIO ByteString)
-> IO ByteString -> PandocIO ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
B.readFile FilePath
fp
                ReaderOptions -> ByteString -> PandocIO Pandoc
bst ReaderOptions
readerOpts ByteString
b)


-- Determine format based on file extension

-- Note : this is exactly the heuristic used by pandoc here:

-- https://github.com/jgm/pandoc/blob/master/src/Text/Pandoc/App/FormatHeuristics.hs

--

-- However, this is not exported, so I must re-define it here.

formatFromFilePath :: FilePath -> Maybe Text
formatFromFilePath :: FilePath -> Maybe Text
formatFromFilePath x :: FilePath
x =
  case FilePath -> FilePath
takeExtension ((Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower FilePath
x) of
    ".adoc"     -> Text -> Maybe Text
forall a. a -> Maybe a
Just "asciidoc"
    ".asciidoc" -> Text -> Maybe Text
forall a. a -> Maybe a
Just "asciidoc"
    ".context"  -> Text -> Maybe Text
forall a. a -> Maybe a
Just "context"
    ".ctx"      -> Text -> Maybe Text
forall a. a -> Maybe a
Just "context"
    ".db"       -> Text -> Maybe Text
forall a. a -> Maybe a
Just "docbook"
    ".doc"      -> Text -> Maybe Text
forall a. a -> Maybe a
Just "doc"  -- so we get an "unknown reader" error

    ".docx"     -> Text -> Maybe Text
forall a. a -> Maybe a
Just "docx"
    ".dokuwiki" -> Text -> Maybe Text
forall a. a -> Maybe a
Just "dokuwiki"
    ".epub"     -> Text -> Maybe Text
forall a. a -> Maybe a
Just "epub"
    ".fb2"      -> Text -> Maybe Text
forall a. a -> Maybe a
Just "fb2"
    ".htm"      -> Text -> Maybe Text
forall a. a -> Maybe a
Just "html"
    ".html"     -> Text -> Maybe Text
forall a. a -> Maybe a
Just "html"
    ".icml"     -> Text -> Maybe Text
forall a. a -> Maybe a
Just "icml"
    ".json"     -> Text -> Maybe Text
forall a. a -> Maybe a
Just "json"
    ".latex"    -> Text -> Maybe Text
forall a. a -> Maybe a
Just "latex"
    ".lhs"      -> Text -> Maybe Text
forall a. a -> Maybe a
Just "markdown+lhs"
    ".ltx"      -> Text -> Maybe Text
forall a. a -> Maybe a
Just "latex"
    ".markdown" -> Text -> Maybe Text
forall a. a -> Maybe a
Just "markdown"
    ".md"       -> Text -> Maybe Text
forall a. a -> Maybe a
Just "markdown"
    ".ms"       -> Text -> Maybe Text
forall a. a -> Maybe a
Just "ms"
    ".muse"     -> Text -> Maybe Text
forall a. a -> Maybe a
Just "muse"
    ".native"   -> Text -> Maybe Text
forall a. a -> Maybe a
Just "native"
    ".odt"      -> Text -> Maybe Text
forall a. a -> Maybe a
Just "odt"
    ".opml"     -> Text -> Maybe Text
forall a. a -> Maybe a
Just "opml"
    ".org"      -> Text -> Maybe Text
forall a. a -> Maybe a
Just "org"
    ".pdf"      -> Text -> Maybe Text
forall a. a -> Maybe a
Just "pdf"  -- so we get an "unknown reader" error

    ".pptx"     -> Text -> Maybe Text
forall a. a -> Maybe a
Just "pptx"
    ".roff"     -> Text -> Maybe Text
forall a. a -> Maybe a
Just "ms"
    ".rst"      -> Text -> Maybe Text
forall a. a -> Maybe a
Just "rst"
    ".rtf"      -> Text -> Maybe Text
forall a. a -> Maybe a
Just "rtf"
    ".s5"       -> Text -> Maybe Text
forall a. a -> Maybe a
Just "s5"
    ".t2t"      -> Text -> Maybe Text
forall a. a -> Maybe a
Just "t2t"
    ".tei"      -> Text -> Maybe Text
forall a. a -> Maybe a
Just "tei"
    ".tei.xml"  -> Text -> Maybe Text
forall a. a -> Maybe a
Just "tei"
    ".tex"      -> Text -> Maybe Text
forall a. a -> Maybe a
Just "latex"
    ".texi"     -> Text -> Maybe Text
forall a. a -> Maybe a
Just "texinfo"
    ".texinfo"  -> Text -> Maybe Text
forall a. a -> Maybe a
Just "texinfo"
    ".text"     -> Text -> Maybe Text
forall a. a -> Maybe a
Just "markdown"
    ".textile"  -> Text -> Maybe Text
forall a. a -> Maybe a
Just "textile"
    ".txt"      -> Text -> Maybe Text
forall a. a -> Maybe a
Just "markdown"
    ".wiki"     -> Text -> Maybe Text
forall a. a -> Maybe a
Just "mediawiki"
    ".xhtml"    -> Text -> Maybe Text
forall a. a -> Maybe a
Just "html"
    ".ipynb"    -> Text -> Maybe Text
forall a. a -> Maybe a
Just "ipynb"
    ".csv"      -> Text -> Maybe Text
forall a. a -> Maybe a
Just "csv"
    ['.',y :: Char
y]     | Char
y Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ['1'..'9'] -> Text -> Maybe Text
forall a. a -> Maybe a
Just "man"
    _           -> Maybe Text
forall a. Maybe a
Nothing