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:
John MacFarlane 2017-12-28 10:01:09 -08:00
parent 999dd2a239
commit ddd6a89247
2 changed files with 15 additions and 14 deletions

View file

@ -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

View file

@ -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 =