{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{- |
Module      : Text.Pandoc.Class.PandocPure
Copyright   : Copyright (C) 2016-2020 Jesse Rosenthal, John MacFarlane
License     : GNU GPL, version 2 or above

Maintainer  : Jesse Rosenthal <jrosenthal@jhu.edu>
Stability   : alpha
Portability : portable

This module defines a pure instance 'PandocPure' of the @'PandocMonad'@
typeclass. This instance is useful for testing, or when all IO access is
prohibited for security reasons.
-}
module Text.Pandoc.Class.PandocPure
  ( PureState(..)
  , getPureState
  , getsPureState
  , putPureState
  , modifyPureState
  , PandocPure(..)
  , FileTree
  , FileInfo(..)
  , addToFileTree
  , insertInFileTree
  , runPure
  ) where

import Codec.Archive.Zip
import Control.Monad.Trans ( MonadTrans(lift) )
import Control.Monad.Except
    ( ExceptT(..), MonadError(throwError), runExceptT )
import Control.Monad.State.Strict
    ( StateT(StateT),
      State,
      MonadState(put, get),
      modify,
      evalState,
      evalStateT )
import Control.Monad (foldM)
import Data.Default
import Data.Text (Text)
import Data.Time (UTCTime)
import Data.Time.Clock.POSIX ( posixSecondsToUTCTime )
import Data.Time.LocalTime (TimeZone, utc)
import Data.Word (Word8)
import System.Directory (doesDirectoryExist, getDirectoryContents)
import System.FilePath ((</>))
import System.FilePath.Glob (match, compile)
import System.Random (StdGen, split, mkStdGen)
import Text.Pandoc.Class.CommonState (CommonState (..))
import Text.Pandoc.Class.PandocMonad
import Text.Pandoc.Error
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.Map as M
import qualified Data.Text as T
import qualified System.Directory as Directory (getModificationTime)

-- | The 'PureState' contains ersatz representations
-- of things that would normally be obtained through IO.
data PureState = PureState
  { PureState -> StdGen
stStdGen     :: StdGen
  , PureState -> [Word8]
stWord8Store :: [Word8]    -- ^ should be infinite, i.e. [1..]
  , PureState -> [Int]
stUniqStore  :: [Int]      -- ^ should be infinite and contain every
                               -- element at most once, e.g. [1..]
  , PureState -> [(Text, Text)]
stEnv :: [(Text, Text)]
  , PureState -> UTCTime
stTime :: UTCTime
  , PureState -> TimeZone
stTimeZone :: TimeZone
  , PureState -> Archive
stReferenceDocx :: Archive
  , PureState -> Archive
stReferencePptx :: Archive
  , PureState -> Archive
stReferenceODT :: Archive
  , PureState -> FileTree
stFiles :: FileTree
  , PureState -> ByteString
stStdin :: B.ByteString
  , PureState -> FileTree
stUserDataFiles :: FileTree
  , PureState -> FileTree
stCabalDataFiles :: FileTree
  }

instance Default PureState where
  def :: PureState
def = PureState
        { stStdGen :: StdGen
stStdGen = Int -> StdGen
mkStdGen Int
1848
        , stWord8Store :: [Word8]
stWord8Store = [Word8
1..]
        , stUniqStore :: [Int]
stUniqStore = [Int
1..]
        , stEnv :: [(Text, Text)]
stEnv = [(Text
"USER", Text
"pandoc-user")]
        , stTime :: UTCTime
stTime = POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
0
        , stTimeZone :: TimeZone
stTimeZone = TimeZone
utc
        , stReferenceDocx :: Archive
stReferenceDocx = Archive
emptyArchive
        , stReferencePptx :: Archive
stReferencePptx = Archive
emptyArchive
        , stReferenceODT :: Archive
stReferenceODT = Archive
emptyArchive
        , stFiles :: FileTree
stFiles = FileTree
forall a. Monoid a => a
mempty
        , stStdin :: ByteString
stStdin = ByteString
forall a. Monoid a => a
mempty
        , stUserDataFiles :: FileTree
stUserDataFiles = FileTree
forall a. Monoid a => a
mempty
        , stCabalDataFiles :: FileTree
stCabalDataFiles = FileTree
forall a. Monoid a => a
mempty
        }


-- | Retrieve the underlying state of the @'PandocPure'@ type.
getPureState :: PandocPure PureState
getPureState :: PandocPure PureState
getPureState = ExceptT
  PandocError (StateT CommonState (State PureState)) PureState
-> PandocPure PureState
forall a.
ExceptT PandocError (StateT CommonState (State PureState)) a
-> PandocPure a
PandocPure (ExceptT
   PandocError (StateT CommonState (State PureState)) PureState
 -> PandocPure PureState)
-> ExceptT
     PandocError (StateT CommonState (State PureState)) PureState
-> PandocPure PureState
forall a b. (a -> b) -> a -> b
$ StateT CommonState (State PureState) PureState
-> ExceptT
     PandocError (StateT CommonState (State PureState)) PureState
forall (m :: * -> *) a. Monad m => m a -> ExceptT PandocError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT CommonState (State PureState) PureState
 -> ExceptT
      PandocError (StateT CommonState (State PureState)) PureState)
-> StateT CommonState (State PureState) PureState
-> ExceptT
     PandocError (StateT CommonState (State PureState)) PureState
forall a b. (a -> b) -> a -> b
$ State PureState PureState
-> StateT CommonState (State PureState) PureState
forall (m :: * -> *) a. Monad m => m a -> StateT CommonState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift State PureState PureState
forall s (m :: * -> *). MonadState s m => m s
get

-- | Retrieve a value from the underlying state of the @'PandocPure'@
-- type.
getsPureState :: (PureState -> a) -> PandocPure a
getsPureState :: forall a. (PureState -> a) -> PandocPure a
getsPureState PureState -> a
f = PureState -> a
f (PureState -> a) -> PandocPure PureState -> PandocPure a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PandocPure PureState
getPureState

-- | Set a new state for the @'PandocPure'@ type.
putPureState :: PureState -> PandocPure ()
putPureState :: PureState -> PandocPure ()
putPureState PureState
ps= ExceptT PandocError (StateT CommonState (State PureState)) ()
-> PandocPure ()
forall a.
ExceptT PandocError (StateT CommonState (State PureState)) a
-> PandocPure a
PandocPure (ExceptT PandocError (StateT CommonState (State PureState)) ()
 -> PandocPure ())
-> ExceptT PandocError (StateT CommonState (State PureState)) ()
-> PandocPure ()
forall a b. (a -> b) -> a -> b
$ StateT CommonState (State PureState) ()
-> ExceptT PandocError (StateT CommonState (State PureState)) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT PandocError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT CommonState (State PureState) ()
 -> ExceptT PandocError (StateT CommonState (State PureState)) ())
-> StateT CommonState (State PureState) ()
-> ExceptT PandocError (StateT CommonState (State PureState)) ()
forall a b. (a -> b) -> a -> b
$ State PureState () -> StateT CommonState (State PureState) ()
forall (m :: * -> *) a. Monad m => m a -> StateT CommonState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State PureState () -> StateT CommonState (State PureState) ())
-> State PureState () -> StateT CommonState (State PureState) ()
forall a b. (a -> b) -> a -> b
$ PureState -> State PureState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put PureState
ps

-- | Modify the underlying state of the @'PandocPure'@ type.
modifyPureState :: (PureState -> PureState) -> PandocPure ()
modifyPureState :: (PureState -> PureState) -> PandocPure ()
modifyPureState PureState -> PureState
f = ExceptT PandocError (StateT CommonState (State PureState)) ()
-> PandocPure ()
forall a.
ExceptT PandocError (StateT CommonState (State PureState)) a
-> PandocPure a
PandocPure (ExceptT PandocError (StateT CommonState (State PureState)) ()
 -> PandocPure ())
-> ExceptT PandocError (StateT CommonState (State PureState)) ()
-> PandocPure ()
forall a b. (a -> b) -> a -> b
$ StateT CommonState (State PureState) ()
-> ExceptT PandocError (StateT CommonState (State PureState)) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT PandocError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT CommonState (State PureState) ()
 -> ExceptT PandocError (StateT CommonState (State PureState)) ())
-> StateT CommonState (State PureState) ()
-> ExceptT PandocError (StateT CommonState (State PureState)) ()
forall a b. (a -> b) -> a -> b
$ State PureState () -> StateT CommonState (State PureState) ()
forall (m :: * -> *) a. Monad m => m a -> StateT CommonState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (State PureState () -> StateT CommonState (State PureState) ())
-> State PureState () -> StateT CommonState (State PureState) ()
forall a b. (a -> b) -> a -> b
$ (PureState -> PureState) -> State PureState ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify PureState -> PureState
f

-- | Captures all file-level information necessary for a @'PandocMonad'@
-- conforming mock file system.
data FileInfo = FileInfo
  { FileInfo -> UTCTime
infoFileMTime :: UTCTime
  , FileInfo -> ByteString
infoFileContents :: B.ByteString
  }

-- | Basis of the mock file system used by @'PandocPure'@.
newtype FileTree = FileTree { FileTree -> Map FilePath FileInfo
unFileTree :: M.Map FilePath FileInfo }
  deriving (NonEmpty FileTree -> FileTree
FileTree -> FileTree -> FileTree
(FileTree -> FileTree -> FileTree)
-> (NonEmpty FileTree -> FileTree)
-> (forall b. Integral b => b -> FileTree -> FileTree)
-> Semigroup FileTree
forall b. Integral b => b -> FileTree -> FileTree
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: FileTree -> FileTree -> FileTree
<> :: FileTree -> FileTree -> FileTree
$csconcat :: NonEmpty FileTree -> FileTree
sconcat :: NonEmpty FileTree -> FileTree
$cstimes :: forall b. Integral b => b -> FileTree -> FileTree
stimes :: forall b. Integral b => b -> FileTree -> FileTree
Semigroup, Semigroup FileTree
FileTree
Semigroup FileTree =>
FileTree
-> (FileTree -> FileTree -> FileTree)
-> ([FileTree] -> FileTree)
-> Monoid FileTree
[FileTree] -> FileTree
FileTree -> FileTree -> FileTree
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: FileTree
mempty :: FileTree
$cmappend :: FileTree -> FileTree -> FileTree
mappend :: FileTree -> FileTree -> FileTree
$cmconcat :: [FileTree] -> FileTree
mconcat :: [FileTree] -> FileTree
Monoid)

-- | Retrieve @'FileInfo'@ of the given @'FilePath'@ from a
-- @'FileTree'@.
getFileInfo :: FilePath -> FileTree -> Maybe FileInfo
getFileInfo :: FilePath -> FileTree -> Maybe FileInfo
getFileInfo FilePath
fp FileTree
tree =
  FilePath -> Map FilePath FileInfo -> Maybe FileInfo
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (FilePath -> FilePath
makeCanonical FilePath
fp) (FileTree -> Map FilePath FileInfo
unFileTree FileTree
tree)

-- | Add the specified file to the FileTree. If file
-- is a directory, add its contents recursively.
addToFileTree :: FileTree -> FilePath -> IO FileTree
addToFileTree :: FileTree -> FilePath -> IO FileTree
addToFileTree FileTree
tree FilePath
fp = do
  Bool
isdir <- FilePath -> IO Bool
doesDirectoryExist FilePath
fp
  if Bool
isdir
     then do -- recursively add contents of directories
       let isSpecial :: a -> Bool
isSpecial a
".." = Bool
True
           isSpecial a
"."  = Bool
True
           isSpecial a
_    = Bool
False
       [FilePath]
fs <- (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
fp FilePath -> FilePath -> FilePath
</>) ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
forall {a}. (Eq a, IsString a) => a -> Bool
isSpecial) ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
getDirectoryContents FilePath
fp
       (FileTree -> FilePath -> IO FileTree)
-> FileTree -> [FilePath] -> IO FileTree
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM FileTree -> FilePath -> IO FileTree
addToFileTree FileTree
tree [FilePath]
fs
     else do
       ByteString
contents <- FilePath -> IO ByteString
B.readFile FilePath
fp
       UTCTime
mtime <- FilePath -> IO UTCTime
Directory.getModificationTime FilePath
fp
       FileTree -> IO FileTree
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FileTree -> IO FileTree) -> FileTree -> IO FileTree
forall a b. (a -> b) -> a -> b
$ FilePath -> FileInfo -> FileTree -> FileTree
insertInFileTree FilePath
fp FileInfo{ infoFileMTime :: UTCTime
infoFileMTime = UTCTime
mtime
                                            , infoFileContents :: ByteString
infoFileContents = ByteString
contents } FileTree
tree

-- | Insert an ersatz file into the 'FileTree'.
insertInFileTree :: FilePath -> FileInfo -> FileTree -> FileTree
insertInFileTree :: FilePath -> FileInfo -> FileTree -> FileTree
insertInFileTree FilePath
fp FileInfo
info (FileTree Map FilePath FileInfo
treemap) =
  Map FilePath FileInfo -> FileTree
FileTree (Map FilePath FileInfo -> FileTree)
-> Map FilePath FileInfo -> FileTree
forall a b. (a -> b) -> a -> b
$ FilePath
-> FileInfo -> Map FilePath FileInfo -> Map FilePath FileInfo
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (FilePath -> FilePath
makeCanonical FilePath
fp) FileInfo
info Map FilePath FileInfo
treemap

newtype PandocPure a = PandocPure {
  forall a.
PandocPure a
-> ExceptT PandocError (StateT CommonState (State PureState)) a
unPandocPure :: ExceptT PandocError
                  (StateT CommonState (State PureState)) a
  } deriving ( (forall a b. (a -> b) -> PandocPure a -> PandocPure b)
-> (forall a b. a -> PandocPure b -> PandocPure a)
-> Functor PandocPure
forall a b. a -> PandocPure b -> PandocPure a
forall a b. (a -> b) -> PandocPure a -> PandocPure b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> PandocPure a -> PandocPure b
fmap :: forall a b. (a -> b) -> PandocPure a -> PandocPure b
$c<$ :: forall a b. a -> PandocPure b -> PandocPure a
<$ :: forall a b. a -> PandocPure b -> PandocPure a
Functor
             , Functor PandocPure
Functor PandocPure =>
(forall a. a -> PandocPure a)
-> (forall a b.
    PandocPure (a -> b) -> PandocPure a -> PandocPure b)
-> (forall a b c.
    (a -> b -> c) -> PandocPure a -> PandocPure b -> PandocPure c)
-> (forall a b. PandocPure a -> PandocPure b -> PandocPure b)
-> (forall a b. PandocPure a -> PandocPure b -> PandocPure a)
-> Applicative PandocPure
forall a. a -> PandocPure a
forall a b. PandocPure a -> PandocPure b -> PandocPure a
forall a b. PandocPure a -> PandocPure b -> PandocPure b
forall a b. PandocPure (a -> b) -> PandocPure a -> PandocPure b
forall a b c.
(a -> b -> c) -> PandocPure a -> PandocPure b -> PandocPure c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> PandocPure a
pure :: forall a. a -> PandocPure a
$c<*> :: forall a b. PandocPure (a -> b) -> PandocPure a -> PandocPure b
<*> :: forall a b. PandocPure (a -> b) -> PandocPure a -> PandocPure b
$cliftA2 :: forall a b c.
(a -> b -> c) -> PandocPure a -> PandocPure b -> PandocPure c
liftA2 :: forall a b c.
(a -> b -> c) -> PandocPure a -> PandocPure b -> PandocPure c
$c*> :: forall a b. PandocPure a -> PandocPure b -> PandocPure b
*> :: forall a b. PandocPure a -> PandocPure b -> PandocPure b
$c<* :: forall a b. PandocPure a -> PandocPure b -> PandocPure a
<* :: forall a b. PandocPure a -> PandocPure b -> PandocPure a
Applicative
             , Applicative PandocPure
Applicative PandocPure =>
(forall a b. PandocPure a -> (a -> PandocPure b) -> PandocPure b)
-> (forall a b. PandocPure a -> PandocPure b -> PandocPure b)
-> (forall a. a -> PandocPure a)
-> Monad PandocPure
forall a. a -> PandocPure a
forall a b. PandocPure a -> PandocPure b -> PandocPure b
forall a b. PandocPure a -> (a -> PandocPure b) -> PandocPure b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. PandocPure a -> (a -> PandocPure b) -> PandocPure b
>>= :: forall a b. PandocPure a -> (a -> PandocPure b) -> PandocPure b
$c>> :: forall a b. PandocPure a -> PandocPure b -> PandocPure b
>> :: forall a b. PandocPure a -> PandocPure b -> PandocPure b
$creturn :: forall a. a -> PandocPure a
return :: forall a. a -> PandocPure a
Monad
             , MonadError PandocError
             )

-- | Run a 'PandocPure' operation.
runPure :: PandocPure a -> Either PandocError a
runPure :: forall a. PandocPure a -> Either PandocError a
runPure PandocPure a
x = (State PureState (Either PandocError a)
 -> PureState -> Either PandocError a)
-> PureState
-> State PureState (Either PandocError a)
-> Either PandocError a
forall a b c. (a -> b -> c) -> b -> a -> c
flip State PureState (Either PandocError a)
-> PureState -> Either PandocError a
forall s a. State s a -> s -> a
evalState PureState
forall a. Default a => a
def (State PureState (Either PandocError a) -> Either PandocError a)
-> State PureState (Either PandocError a) -> Either PandocError a
forall a b. (a -> b) -> a -> b
$
            (StateT CommonState (State PureState) (Either PandocError a)
 -> CommonState -> State PureState (Either PandocError a))
-> CommonState
-> StateT CommonState (State PureState) (Either PandocError a)
-> State PureState (Either PandocError a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT CommonState (State PureState) (Either PandocError a)
-> CommonState -> State PureState (Either PandocError a)
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT CommonState
forall a. Default a => a
def (StateT CommonState (State PureState) (Either PandocError a)
 -> State PureState (Either PandocError a))
-> StateT CommonState (State PureState) (Either PandocError a)
-> State PureState (Either PandocError a)
forall a b. (a -> b) -> a -> b
$
            ExceptT PandocError (StateT CommonState (State PureState)) a
-> StateT CommonState (State PureState) (Either PandocError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT PandocError (StateT CommonState (State PureState)) a
 -> StateT CommonState (State PureState) (Either PandocError a))
-> ExceptT PandocError (StateT CommonState (State PureState)) a
-> StateT CommonState (State PureState) (Either PandocError a)
forall a b. (a -> b) -> a -> b
$
            PandocPure a
-> ExceptT PandocError (StateT CommonState (State PureState)) a
forall a.
PandocPure a
-> ExceptT PandocError (StateT CommonState (State PureState)) a
unPandocPure PandocPure a
x

instance PandocMonad PandocPure where
  lookupEnv :: Text -> PandocPure (Maybe Text)
lookupEnv Text
s = do
    [(Text, Text)]
env <- (PureState -> [(Text, Text)]) -> PandocPure [(Text, Text)]
forall a. (PureState -> a) -> PandocPure a
getsPureState PureState -> [(Text, Text)]
stEnv
    Maybe Text -> PandocPure (Maybe Text)
forall a. a -> PandocPure a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> [(Text, Text)] -> Maybe Text
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
s [(Text, Text)]
env)

  getCurrentTime :: PandocPure UTCTime
getCurrentTime = (PureState -> UTCTime) -> PandocPure UTCTime
forall a. (PureState -> a) -> PandocPure a
getsPureState PureState -> UTCTime
stTime

  getCurrentTimeZone :: PandocPure TimeZone
getCurrentTimeZone = (PureState -> TimeZone) -> PandocPure TimeZone
forall a. (PureState -> a) -> PandocPure a
getsPureState PureState -> TimeZone
stTimeZone

  newStdGen :: PandocPure StdGen
newStdGen = do
    StdGen
oldGen <- (PureState -> StdGen) -> PandocPure StdGen
forall a. (PureState -> a) -> PandocPure a
getsPureState PureState -> StdGen
stStdGen
    let (StdGen
genToStore, StdGen
genToReturn) = StdGen -> (StdGen, StdGen)
forall g. RandomGen g => g -> (g, g)
split StdGen
oldGen
    (PureState -> PureState) -> PandocPure ()
modifyPureState ((PureState -> PureState) -> PandocPure ())
-> (PureState -> PureState) -> PandocPure ()
forall a b. (a -> b) -> a -> b
$ \PureState
st -> PureState
st { stStdGen = genToStore }
    StdGen -> PandocPure StdGen
forall a. a -> PandocPure a
forall (m :: * -> *) a. Monad m => a -> m a
return StdGen
genToReturn

  newUniqueHash :: PandocPure Int
newUniqueHash = do
    [Int]
uniqs <- (PureState -> [Int]) -> PandocPure [Int]
forall a. (PureState -> a) -> PandocPure a
getsPureState PureState -> [Int]
stUniqStore
    case [Int]
uniqs of
      Int
u : [Int]
us -> do
        (PureState -> PureState) -> PandocPure ()
modifyPureState ((PureState -> PureState) -> PandocPure ())
-> (PureState -> PureState) -> PandocPure ()
forall a b. (a -> b) -> a -> b
$ \PureState
st -> PureState
st { stUniqStore = us }
        Int -> PandocPure Int
forall a. a -> PandocPure a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
u
      [Int]
_ -> PandocError -> PandocPure Int
forall a. PandocError -> PandocPure a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> PandocPure Int) -> PandocError -> PandocPure Int
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocShouldNeverHappenError
                        Text
"uniq store ran out of elements"
  openURL :: Text -> PandocPure (ByteString, Maybe Text)
openURL Text
u = PandocError -> PandocPure (ByteString, Maybe Text)
forall a. PandocError -> PandocPure a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> PandocPure (ByteString, Maybe Text))
-> PandocError -> PandocPure (ByteString, Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocResourceNotFound Text
u
  readFileLazy :: FilePath -> PandocPure ByteString
readFileLazy FilePath
fp = do
    FileTree
fps <- (PureState -> FileTree) -> PandocPure FileTree
forall a. (PureState -> a) -> PandocPure a
getsPureState PureState -> FileTree
stFiles
    case FileInfo -> ByteString
infoFileContents (FileInfo -> ByteString) -> Maybe FileInfo -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> FileTree -> Maybe FileInfo
getFileInfo FilePath
fp FileTree
fps of
      Just ByteString
bs -> ByteString -> PandocPure ByteString
forall a. a -> PandocPure a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> ByteString
BL.fromStrict ByteString
bs)
      Maybe ByteString
Nothing -> PandocError -> PandocPure ByteString
forall a. PandocError -> PandocPure a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> PandocPure ByteString)
-> PandocError -> PandocPure ByteString
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocResourceNotFound (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
fp
  readFileStrict :: FilePath -> PandocPure ByteString
readFileStrict FilePath
fp = do
    FileTree
fps <- (PureState -> FileTree) -> PandocPure FileTree
forall a. (PureState -> a) -> PandocPure a
getsPureState PureState -> FileTree
stFiles
    case FileInfo -> ByteString
infoFileContents (FileInfo -> ByteString) -> Maybe FileInfo -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> FileTree -> Maybe FileInfo
getFileInfo FilePath
fp FileTree
fps of
      Just ByteString
bs -> ByteString -> PandocPure ByteString
forall a. a -> PandocPure a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
      Maybe ByteString
Nothing -> PandocError -> PandocPure ByteString
forall a. PandocError -> PandocPure a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> PandocPure ByteString)
-> PandocError -> PandocPure ByteString
forall a b. (a -> b) -> a -> b
$ Text -> PandocError
PandocResourceNotFound (Text -> PandocError) -> Text -> PandocError
forall a b. (a -> b) -> a -> b
$ FilePath -> Text
T.pack FilePath
fp

  readStdinStrict :: PandocPure ByteString
readStdinStrict = (PureState -> ByteString) -> PandocPure ByteString
forall a. (PureState -> a) -> PandocPure a
getsPureState PureState -> ByteString
stStdin

  glob :: FilePath -> PandocPure [FilePath]
glob FilePath
s = do
    FileTree Map FilePath FileInfo
ftmap <- (PureState -> FileTree) -> PandocPure FileTree
forall a. (PureState -> a) -> PandocPure a
getsPureState PureState -> FileTree
stFiles
    [FilePath] -> PandocPure [FilePath]
forall a. a -> PandocPure a
forall (m :: * -> *) a. Monad m => a -> m a
return ([FilePath] -> PandocPure [FilePath])
-> [FilePath] -> PandocPure [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Pattern -> FilePath -> Bool
match (FilePath -> Pattern
compile FilePath
s)) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ Map FilePath FileInfo -> [FilePath]
forall k a. Map k a -> [k]
M.keys Map FilePath FileInfo
ftmap

  fileExists :: FilePath -> PandocPure Bool
fileExists FilePath
fp = do
    FileTree
fps <- (PureState -> FileTree) -> PandocPure FileTree
forall a. (PureState -> a) -> PandocPure a
getsPureState PureState -> FileTree
stFiles
    case FilePath -> FileTree -> Maybe FileInfo
getFileInfo FilePath
fp FileTree
fps of
         Maybe FileInfo
Nothing -> Bool -> PandocPure Bool
forall a. a -> PandocPure a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
         Just FileInfo
_  -> Bool -> PandocPure Bool
forall a. a -> PandocPure a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

  getDataFileName :: FilePath -> PandocPure FilePath
getDataFileName FilePath
fp = FilePath -> PandocPure FilePath
forall a. a -> PandocPure a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> PandocPure FilePath)
-> FilePath -> PandocPure FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"data/" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
fp

  getModificationTime :: FilePath -> PandocPure UTCTime
getModificationTime FilePath
fp = do
    FileTree
fps <- (PureState -> FileTree) -> PandocPure FileTree
forall a. (PureState -> a) -> PandocPure a
getsPureState PureState -> FileTree
stFiles
    case FileInfo -> UTCTime
infoFileMTime (FileInfo -> UTCTime) -> Maybe FileInfo -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> FileTree -> Maybe FileInfo
getFileInfo FilePath
fp FileTree
fps of
      Just UTCTime
tm -> UTCTime -> PandocPure UTCTime
forall a. a -> PandocPure a
forall (m :: * -> *) a. Monad m => a -> m a
return UTCTime
tm
      Maybe UTCTime
Nothing -> PandocError -> PandocPure UTCTime
forall a. PandocError -> PandocPure a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (PandocError -> PandocPure UTCTime)
-> PandocError -> PandocPure UTCTime
forall a b. (a -> b) -> a -> b
$ Text -> IOError -> PandocError
PandocIOError (FilePath -> Text
T.pack FilePath
fp)
                    (FilePath -> IOError
userError FilePath
"Can't get modification time")

  getCommonState :: PandocPure CommonState
getCommonState = ExceptT
  PandocError (StateT CommonState (State PureState)) CommonState
-> PandocPure CommonState
forall a.
ExceptT PandocError (StateT CommonState (State PureState)) a
-> PandocPure a
PandocPure (ExceptT
   PandocError (StateT CommonState (State PureState)) CommonState
 -> PandocPure CommonState)
-> ExceptT
     PandocError (StateT CommonState (State PureState)) CommonState
-> PandocPure CommonState
forall a b. (a -> b) -> a -> b
$ StateT CommonState (State PureState) CommonState
-> ExceptT
     PandocError (StateT CommonState (State PureState)) CommonState
forall (m :: * -> *) a. Monad m => m a -> ExceptT PandocError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT CommonState (State PureState) CommonState
forall s (m :: * -> *). MonadState s m => m s
get
  putCommonState :: CommonState -> PandocPure ()
putCommonState CommonState
x = ExceptT PandocError (StateT CommonState (State PureState)) ()
-> PandocPure ()
forall a.
ExceptT PandocError (StateT CommonState (State PureState)) a
-> PandocPure a
PandocPure (ExceptT PandocError (StateT CommonState (State PureState)) ()
 -> PandocPure ())
-> ExceptT PandocError (StateT CommonState (State PureState)) ()
-> PandocPure ()
forall a b. (a -> b) -> a -> b
$ StateT CommonState (State PureState) ()
-> ExceptT PandocError (StateT CommonState (State PureState)) ()
forall (m :: * -> *) a. Monad m => m a -> ExceptT PandocError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT CommonState (State PureState) ()
 -> ExceptT PandocError (StateT CommonState (State PureState)) ())
-> StateT CommonState (State PureState) ()
-> ExceptT PandocError (StateT CommonState (State PureState)) ()
forall a b. (a -> b) -> a -> b
$ CommonState -> StateT CommonState (State PureState) ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put CommonState
x

  logOutput :: LogMessage -> PandocPure ()
logOutput LogMessage
_msg = () -> PandocPure ()
forall a. a -> PandocPure a
forall (m :: * -> *) a. Monad m => a -> m a
return ()