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

-- |
-- Module      : $header$
-- Copyright   : (c) Laurent P René de Cotret, 2019 - present
-- 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,
    outputDirs,
    readDoc,
  )
where

-- TODO: forConcurrently
import Control.Monad.Reader (forM)
import qualified Data.ByteString.Lazy as B
import Data.Char (toLower)
import Data.Default (def)
import Data.List (nub)
import Data.Maybe (catMaybes, fromMaybe)
import Data.Text (Text, pack)
import qualified Data.Text.IO as Text
import System.Directory (removePathForcibly)
import System.FilePath (takeExtension)
import Text.Pandoc.Class (runIO)
import Text.Pandoc.Definition (Block, Pandoc)
import Text.Pandoc.Error (handleError)
import Text.Pandoc.Format (FlavoredFormat(..))
import Text.Pandoc.Filter.Plot.Monad
import Text.Pandoc.Filter.Plot.Parse
import qualified Text.Pandoc.Options as P
import qualified Text.Pandoc.Readers as P
import Text.Pandoc.Walk (Walkable, query)

-- | 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 :: forall b. Walkable Block b => Configuration -> b -> IO [String]
cleanOutputDirs Configuration
conf b
doc = do
  [String]
dirs <- forall a. Maybe Format -> Configuration -> PlotM a -> IO a
runPlotM forall a. Maybe a
Nothing Configuration
conf forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b. Walkable Block b => b -> PlotM [String]
cleanOutputDirsM forall a b. (a -> b) -> a -> b
$ b
doc
  -- Deletion of the log file must be done outside of PlotM
  -- to ensure the log file has been closed.
  case Configuration -> LogSink
logSink Configuration
conf of
    LogFile String
path -> String -> IO ()
removePathForcibly String
path
    LogSink
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
  forall (m :: * -> *) a. Monad m => a -> m a
return [String]
dirs

-- | Analyze a document to determine where would the pandoc-plot output directories be.
outputDirs ::
  Walkable Block b =>
  b ->
  PlotM [FilePath]
outputDirs :: forall b. Walkable Block b => b -> PlotM [String]
outputDirs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query (\Block
b -> [ParseFigureResult -> Maybe String
hasDirectory forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Block -> PlotM ParseFigureResult
parseFigureSpec Block
b])
  where
    hasDirectory :: ParseFigureResult -> Maybe FilePath
    hasDirectory :: ParseFigureResult -> Maybe String
hasDirectory (PFigure FigureSpec
fs) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ FigureSpec -> String
directory FigureSpec
fs
    hasDirectory ParseFigureResult
_ = forall a. Maybe a
Nothing

-- | PlotM version of @cleanOutputDirs@
cleanOutputDirsM ::
  Walkable Block b =>
  b ->
  PlotM [FilePath]
cleanOutputDirsM :: forall b. Walkable Block b => b -> PlotM [String]
cleanOutputDirsM b
doc = do
  [String]
directories <- forall b. Walkable Block b => b -> PlotM [String]
outputDirs b
doc
  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [String]
directories forall a b. (a -> b) -> a -> b
$ \String
fp -> do
    forall (m :: * -> *). (MonadLogger m, MonadIO m) => Text -> m ()
info forall a b. (a -> b) -> a -> b
$ Text
"Removing directory " forall a. Semigroup a => a -> a -> a
<> String -> Text
pack String
fp
    -- It is important to use `removePathForcibly` here, because it does
    -- not throw exceptions if the directory doesn't exist. This means
    -- we do not have to check in advance if directories are nested in our
    -- list of directories.
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
removePathForcibly String
fp
    forall (m :: * -> *) a. Monad m => a -> m a
return String
fp

-- | Read a 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 :: String -> IO Pandoc
readDoc String
fp =
  forall a. Either PandocError a -> IO a
handleError
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. PandocIO a -> IO (Either PandocError a)
runIO
      ( do
          let fmt :: Text
fmt = forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty (String -> Maybe Text
formatFromFilePath String
fp)
          (Reader PandocIO
reader, Extensions
exts) <- forall (m :: * -> *).
PandocMonad m =>
FlavoredFormat -> m (Reader m, Extensions)
P.getReader forall a b. (a -> b) -> a -> b
$ Text -> ExtensionsDiff -> FlavoredFormat
FlavoredFormat Text
fmt forall a. Monoid a => a
mempty
          let readerOpts :: ReaderOptions
readerOpts = forall a. Default a => a
def {readerExtensions :: Extensions
P.readerExtensions = Extensions
exts}
          case Reader PandocIO
reader of
            P.TextReader forall a. ToSources a => ReaderOptions -> a -> PandocIO Pandoc
fct -> do
              Text
t <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO Text
Text.readFile String
fp
              forall a. ToSources a => ReaderOptions -> a -> PandocIO Pandoc
fct ReaderOptions
readerOpts Text
t
            P.ByteStringReader ReaderOptions -> ByteString -> PandocIO Pandoc
bst -> do
              ByteString
b <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
B.readFile String
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 it must be re-defined here.
formatFromFilePath :: FilePath -> Maybe Text
formatFromFilePath :: String -> Maybe Text
formatFromFilePath String
x =
  case String -> String
takeExtension (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
x) of
    String
".adoc" -> forall a. a -> Maybe a
Just Text
"asciidoc"
    String
".asciidoc" -> forall a. a -> Maybe a
Just Text
"asciidoc"
    String
".context" -> forall a. a -> Maybe a
Just Text
"context"
    String
".ctx" -> forall a. a -> Maybe a
Just Text
"context"
    String
".db" -> forall a. a -> Maybe a
Just Text
"docbook"
    String
".doc" -> forall a. a -> Maybe a
Just Text
"doc" -- so we get an "unknown reader" error
    String
".docx" -> forall a. a -> Maybe a
Just Text
"docx"
    String
".dokuwiki" -> forall a. a -> Maybe a
Just Text
"dokuwiki"
    String
".epub" -> forall a. a -> Maybe a
Just Text
"epub"
    String
".fb2" -> forall a. a -> Maybe a
Just Text
"fb2"
    String
".htm" -> forall a. a -> Maybe a
Just Text
"html"
    String
".html" -> forall a. a -> Maybe a
Just Text
"html"
    String
".icml" -> forall a. a -> Maybe a
Just Text
"icml"
    String
".json" -> forall a. a -> Maybe a
Just Text
"json"
    String
".latex" -> forall a. a -> Maybe a
Just Text
"latex"
    String
".lhs" -> forall a. a -> Maybe a
Just Text
"markdown+lhs"
    String
".ltx" -> forall a. a -> Maybe a
Just Text
"latex"
    String
".markdown" -> forall a. a -> Maybe a
Just Text
"markdown"
    String
".mkdn" -> forall a. a -> Maybe a
Just Text
"markdown"
    String
".mkd" -> forall a. a -> Maybe a
Just Text
"markdown"
    String
".mdwn" -> forall a. a -> Maybe a
Just Text
"markdown"
    String
".mdown" -> forall a. a -> Maybe a
Just Text
"markdown"
    String
".Rmd" -> forall a. a -> Maybe a
Just Text
"markdown"
    String
".md" -> forall a. a -> Maybe a
Just Text
"markdown"
    String
".ms" -> forall a. a -> Maybe a
Just Text
"ms"
    String
".muse" -> forall a. a -> Maybe a
Just Text
"muse"
    String
".native" -> forall a. a -> Maybe a
Just Text
"native"
    String
".odt" -> forall a. a -> Maybe a
Just Text
"odt"
    String
".opml" -> forall a. a -> Maybe a
Just Text
"opml"
    String
".org" -> forall a. a -> Maybe a
Just Text
"org"
    String
".pdf" -> forall a. a -> Maybe a
Just Text
"pdf" -- so we get an "unknown reader" error
    String
".pptx" -> forall a. a -> Maybe a
Just Text
"pptx"
    String
".roff" -> forall a. a -> Maybe a
Just Text
"ms"
    String
".rst" -> forall a. a -> Maybe a
Just Text
"rst"
    String
".rtf" -> forall a. a -> Maybe a
Just Text
"rtf"
    String
".s5" -> forall a. a -> Maybe a
Just Text
"s5"
    String
".t2t" -> forall a. a -> Maybe a
Just Text
"t2t"
    String
".tei" -> forall a. a -> Maybe a
Just Text
"tei"
    String
".tei.xml" -> forall a. a -> Maybe a
Just Text
"tei"
    String
".tex" -> forall a. a -> Maybe a
Just Text
"latex"
    String
".texi" -> forall a. a -> Maybe a
Just Text
"texinfo"
    String
".texinfo" -> forall a. a -> Maybe a
Just Text
"texinfo"
    String
".text" -> forall a. a -> Maybe a
Just Text
"markdown"
    String
".textile" -> forall a. a -> Maybe a
Just Text
"textile"
    String
".txt" -> forall a. a -> Maybe a
Just Text
"markdown"
    String
".wiki" -> forall a. a -> Maybe a
Just Text
"mediawiki"
    String
".xhtml" -> forall a. a -> Maybe a
Just Text
"html"
    String
".ipynb" -> forall a. a -> Maybe a
Just Text
"ipynb"
    String
".csv" -> forall a. a -> Maybe a
Just Text
"csv"
    String
".bib" -> forall a. a -> Maybe a
Just Text
"biblatex"
    [Char
'.', Char
y] | Char
y forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char
'1' .. Char
'9'] -> forall a. a -> Maybe a
Just Text
"man"
    String
_ -> forall a. Maybe a
Nothing