Text.Pandoc.Class: add insertInFileTree (API change).
This gives a pure way to insert an ersatz file into a FileTree. In addition, we normalize paths both on insertion and on lookup, so that "foo" and "./foo" will be judged equivalent.
This commit is contained in:
parent
999dd2a239
commit
ddd6a89247
2 changed files with 15 additions and 14 deletions
|
@ -81,6 +81,7 @@ module Text.Pandoc.Class ( PandocMonad(..)
|
||||||
, FileTree(..)
|
, FileTree(..)
|
||||||
, FileInfo(..)
|
, FileInfo(..)
|
||||||
, addToFileTree
|
, addToFileTree
|
||||||
|
, insertInFileTree
|
||||||
, runIO
|
, runIO
|
||||||
, runIOorExplode
|
, runIOorExplode
|
||||||
, runPure
|
, runPure
|
||||||
|
@ -141,7 +142,7 @@ import qualified System.Environment as IO (lookupEnv)
|
||||||
import System.FilePath.Glob (match, compile)
|
import System.FilePath.Glob (match, compile)
|
||||||
import System.Directory (createDirectoryIfMissing, getDirectoryContents,
|
import System.Directory (createDirectoryIfMissing, getDirectoryContents,
|
||||||
doesDirectoryExist)
|
doesDirectoryExist)
|
||||||
import System.FilePath ((</>), (<.>), takeDirectory,
|
import System.FilePath ((</>), (<.>), takeDirectory, makeRelative,
|
||||||
takeExtension, dropExtension, isRelative, normalise)
|
takeExtension, dropExtension, isRelative, normalise)
|
||||||
import qualified System.FilePath.Glob as IO (glob)
|
import qualified System.FilePath.Glob as IO (glob)
|
||||||
import qualified System.Directory as IO (getModificationTime)
|
import qualified System.Directory as IO (getModificationTime)
|
||||||
|
@ -912,12 +913,13 @@ newtype FileTree = FileTree {unFileTree :: M.Map FilePath FileInfo}
|
||||||
deriving (Monoid)
|
deriving (Monoid)
|
||||||
|
|
||||||
getFileInfo :: FilePath -> FileTree -> Maybe FileInfo
|
getFileInfo :: FilePath -> FileTree -> Maybe FileInfo
|
||||||
getFileInfo fp tree = M.lookup fp $ unFileTree tree
|
getFileInfo fp tree =
|
||||||
|
M.lookup (makeRelative "." fp) (unFileTree tree)
|
||||||
|
|
||||||
-- | Add the specified file to the FileTree. If file
|
-- | Add the specified file to the FileTree. If file
|
||||||
-- is a directory, add its contents recursively.
|
-- is a directory, add its contents recursively.
|
||||||
addToFileTree :: FileTree -> FilePath -> IO FileTree
|
addToFileTree :: FileTree -> FilePath -> IO FileTree
|
||||||
addToFileTree (FileTree treemap) fp = do
|
addToFileTree tree fp = do
|
||||||
isdir <- doesDirectoryExist fp
|
isdir <- doesDirectoryExist fp
|
||||||
if isdir
|
if isdir
|
||||||
then do -- recursively add contents of directories
|
then do -- recursively add contents of directories
|
||||||
|
@ -925,13 +927,17 @@ addToFileTree (FileTree treemap) fp = do
|
||||||
isSpecial "." = True
|
isSpecial "." = True
|
||||||
isSpecial _ = False
|
isSpecial _ = False
|
||||||
fs <- (map (fp </>) . filter (not . isSpecial)) <$> getDirectoryContents fp
|
fs <- (map (fp </>) . filter (not . isSpecial)) <$> getDirectoryContents fp
|
||||||
foldM addToFileTree (FileTree treemap) fs
|
foldM addToFileTree tree fs
|
||||||
else do
|
else do
|
||||||
contents <- B.readFile fp
|
contents <- B.readFile fp
|
||||||
mtime <- IO.getModificationTime fp
|
mtime <- IO.getModificationTime fp
|
||||||
return $ FileTree $
|
return $ insertInFileTree fp FileInfo{ infoFileMTime = mtime
|
||||||
M.insert fp FileInfo{ infoFileMTime = mtime
|
, infoFileContents = contents } tree
|
||||||
, infoFileContents = contents } treemap
|
|
||||||
|
-- | Insert an ersatz file into the 'FileTree'.
|
||||||
|
insertInFileTree :: FilePath -> FileInfo -> FileTree -> FileTree
|
||||||
|
insertInFileTree fp info (FileTree treemap) =
|
||||||
|
FileTree $ M.insert (makeRelative "." fp) info treemap
|
||||||
|
|
||||||
newtype PandocPure a = PandocPure {
|
newtype PandocPure a = PandocPure {
|
||||||
unPandocPure :: ExceptT PandocError
|
unPandocPure :: ExceptT PandocError
|
||||||
|
|
|
@ -1,7 +1,6 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
module Tests.Readers.Org.Directive (tests) where
|
module Tests.Readers.Org.Directive (tests) where
|
||||||
|
|
||||||
import Control.Arrow (second)
|
|
||||||
import Data.Time (UTCTime (UTCTime), secondsToDiffTime)
|
import Data.Time (UTCTime (UTCTime), secondsToDiffTime)
|
||||||
import Data.Time.Calendar (Day (ModifiedJulianDay))
|
import Data.Time.Calendar (Day (ModifiedJulianDay))
|
||||||
import Test.Tasty (TestTree, testGroup)
|
import Test.Tasty (TestTree, testGroup)
|
||||||
|
@ -10,7 +9,6 @@ import Tests.Readers.Org.Shared ((=:), tagSpan)
|
||||||
import Text.Pandoc
|
import Text.Pandoc
|
||||||
import Text.Pandoc.Builder
|
import Text.Pandoc.Builder
|
||||||
import qualified Data.ByteString as BS
|
import qualified Data.ByteString as BS
|
||||||
import qualified Data.Map as Map
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
|
|
||||||
testWithFiles :: (ToString c)
|
testWithFiles :: (ToString c)
|
||||||
|
@ -31,11 +29,8 @@ orgWithFiles fileDefs input =
|
||||||
files :: [(FilePath, BS.ByteString)] -> FileTree
|
files :: [(FilePath, BS.ByteString)] -> FileTree
|
||||||
files fileDefs =
|
files fileDefs =
|
||||||
let dummyTime = UTCTime (ModifiedJulianDay 125) (secondsToDiffTime 0)
|
let dummyTime = UTCTime (ModifiedJulianDay 125) (secondsToDiffTime 0)
|
||||||
fileInfo content = FileInfo
|
in foldr (\(fp, bs) -> insertInFileTree fp (FileInfo dummyTime bs))
|
||||||
{ infoFileMTime = dummyTime
|
mempty fileDefs
|
||||||
, infoFileContents = content
|
|
||||||
}
|
|
||||||
in FileTree (Map.fromList (map (second fileInfo) fileDefs))
|
|
||||||
|
|
||||||
tests :: [TestTree]
|
tests :: [TestTree]
|
||||||
tests =
|
tests =
|
||||||
|
|
Loading…
Add table
Reference in a new issue