summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohn MacFarlane <jgm@berkeley.edu>2017-12-28 10:01:09 -0800
committerJohn MacFarlane <jgm@berkeley.edu>2017-12-28 10:23:09 -0800
commitddd6a892470181b321ac2f80ffb76809f15419c8 (patch)
tree9fea29363093361139f81ba49ba9108323f74b79
parent999dd2a2393d750c96091e0d0aaf75cbb8e5e4df (diff)
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.
-rw-r--r--src/Text/Pandoc/Class.hs20
-rw-r--r--test/Tests/Readers/Org/Directive.hs9
2 files changed, 15 insertions, 14 deletions
diff --git a/src/Text/Pandoc/Class.hs b/src/Text/Pandoc/Class.hs
index c63781adf..487f66793 100644
--- a/src/Text/Pandoc/Class.hs
+++ b/src/Text/Pandoc/Class.hs
@@ -81,6 +81,7 @@ module Text.Pandoc.Class ( PandocMonad(..)
, FileTree(..)
, FileInfo(..)
, addToFileTree
+ , insertInFileTree
, runIO
, runIOorExplode
, runPure
@@ -141,7 +142,7 @@ import qualified System.Environment as IO (lookupEnv)
import System.FilePath.Glob (match, compile)
import System.Directory (createDirectoryIfMissing, getDirectoryContents,
doesDirectoryExist)
-import System.FilePath ((</>), (<.>), takeDirectory,
+import System.FilePath ((</>), (<.>), takeDirectory, makeRelative,
takeExtension, dropExtension, isRelative, normalise)
import qualified System.FilePath.Glob as IO (glob)
import qualified System.Directory as IO (getModificationTime)
@@ -912,12 +913,13 @@ newtype FileTree = FileTree {unFileTree :: M.Map FilePath FileInfo}
deriving (Monoid)
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
-- is a directory, add its contents recursively.
addToFileTree :: FileTree -> FilePath -> IO FileTree
-addToFileTree (FileTree treemap) fp = do
+addToFileTree tree fp = do
isdir <- doesDirectoryExist fp
if isdir
then do -- recursively add contents of directories
@@ -925,13 +927,17 @@ addToFileTree (FileTree treemap) fp = do
isSpecial "." = True
isSpecial _ = False
fs <- (map (fp </>) . filter (not . isSpecial)) <$> getDirectoryContents fp
- foldM addToFileTree (FileTree treemap) fs
+ foldM addToFileTree tree fs
else do
contents <- B.readFile fp
mtime <- IO.getModificationTime fp
- return $ FileTree $
- M.insert fp FileInfo{ infoFileMTime = mtime
- , infoFileContents = contents } treemap
+ return $ insertInFileTree fp FileInfo{ infoFileMTime = mtime
+ , infoFileContents = contents } tree
+
+-- | 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 {
unPandocPure :: ExceptT PandocError
diff --git a/test/Tests/Readers/Org/Directive.hs b/test/Tests/Readers/Org/Directive.hs
index 1970a0471..862315ef3 100644
--- a/test/Tests/Readers/Org/Directive.hs
+++ b/test/Tests/Readers/Org/Directive.hs
@@ -1,7 +1,6 @@
{-# LANGUAGE OverloadedStrings #-}
module Tests.Readers.Org.Directive (tests) where
-import Control.Arrow (second)
import Data.Time (UTCTime (UTCTime), secondsToDiffTime)
import Data.Time.Calendar (Day (ModifiedJulianDay))
import Test.Tasty (TestTree, testGroup)
@@ -10,7 +9,6 @@ import Tests.Readers.Org.Shared ((=:), tagSpan)
import Text.Pandoc
import Text.Pandoc.Builder
import qualified Data.ByteString as BS
-import qualified Data.Map as Map
import qualified Data.Text as T
testWithFiles :: (ToString c)
@@ -31,11 +29,8 @@ orgWithFiles fileDefs input =
files :: [(FilePath, BS.ByteString)] -> FileTree
files fileDefs =
let dummyTime = UTCTime (ModifiedJulianDay 125) (secondsToDiffTime 0)
- fileInfo content = FileInfo
- { infoFileMTime = dummyTime
- , infoFileContents = content
- }
- in FileTree (Map.fromList (map (second fileInfo) fileDefs))
+ in foldr (\(fp, bs) -> insertInFileTree fp (FileInfo dummyTime bs))
+ mempty fileDefs
tests :: [TestTree]
tests =