zip-1.1.0: tests/Main.hs
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS -fno-warn-orphans #-}
module Main (main) where
import Codec.Archive.Zip
import Codec.Archive.Zip.CP437
import Control.Monad
import Control.Monad.IO.Class
import Data.Bits (complement)
import Data.ByteString (ByteString)
import Data.List (intercalate)
import Data.Map (Map, (!))
import Data.Maybe (fromJust)
import Data.Text (Text)
import Data.Time
import Data.Version
import System.Directory
import System.FilePath ((</>))
import System.IO
import System.IO.Error (isDoesNotExistError)
import System.IO.Temp
import Test.Hspec
import Test.QuickCheck
import qualified Data.ByteString as B
import qualified Data.ByteString.Builder as LB
import qualified Data.ByteString.Lazy as LB
import qualified Data.Conduit as C
import qualified Data.Conduit.List as CL
import qualified Data.DList as DList
import qualified Data.Map.Strict as M
import qualified Data.Set as E
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified System.FilePath as FP
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid
#endif
-- | Zip tests. Please note that Zip64 feature is not currently tested
-- automatically because for it to expose itself we need > 4GB of
-- data. Handling such quantities of data locally is problematic and even
-- more problematic in the context of CI server.
main :: IO ()
main = hspec $ do
describe "mkEntrySelector" mkEntrySelectorSpec
describe "unEntrySelector" unEntrySelectorSpec
describe "getEntryName" getEntryNameSpec
describe "decodeCP437" decodeCP437Spec
around withSandbox $ do
describe "createArchive" createArchiveSpec
describe "withArchive" withArchiveSpec
describe "archive comment" archiveCommentSpec
describe "getEntryDesc" getEntryDescSpec
describe "version needed" versionNeededSpec
describe "addEntry" addEntrySpec
describe "sinkEntry" sinkEntrySpec
describe "loadEntry" loadEntrySpec
describe "copyEntry" copyEntrySpec
describe "checkEntry" checkEntrySpec
describe "recompress" recompressSpec
describe "entry comment" entryCommentSpec
describe "setModTime" setModTimeSpec
describe "extra field" extraFieldSpec
describe "renameEntry" renameEntrySpec
describe "deleteEntry" deleteEntrySpec
describe "forEntries" forEntriesSpec
describe "undoEntryChanges" undoEntryChangesSpec
describe "undoArchiveChanges" undoArchiveChangesSpec
describe "undoAll" undoAllSpec
describe "consistency" consistencySpec
describe "packDirRecur" packDirRecurSpec
describe "unpackInto" unpackIntoSpec
----------------------------------------------------------------------------
-- Arbitrary instances and generators
instance Arbitrary Text where
arbitrary = T.pack <$> listOf1 arbitrary
instance Arbitrary ByteString where
arbitrary = B.pack <$> listOf arbitrary
instance Arbitrary CompressionMethod where
arbitrary = elements [Store, Deflate, BZip2]
instance Arbitrary UTCTime where
arbitrary = UTCTime
<$> (ModifiedJulianDay <$> choose (44239, 90989))
<*> (secondsToDiffTime <$> choose (0, 86399))
newtype RelPath = RelPath FilePath
instance Show RelPath where
show (RelPath path) = show path
instance Arbitrary RelPath where
arbitrary = do
p <- intercalate "/" <$> listOf1
((++) <$> vectorOf 3 charGen
<*> listOf1 charGen)
case mkEntrySelector p of
Nothing -> arbitrary
Just _ -> return (RelPath p)
instance Arbitrary EntrySelector where
arbitrary = do
RelPath x <- arbitrary
case mkEntrySelector x of
Nothing -> arbitrary
Just s -> return s
data EM = EM EntrySelector EntryDescription (ZipArchive ()) deriving Show
instance Arbitrary EM where
arbitrary = do
s <- arbitrary
method <- arbitrary
content <- arbitrary
modTime <- arbitrary
comment <- arbitrary
extraFieldTag <- arbitrary `suchThat` (/= 1)
extraFieldContent <- arbitrary `suchThat` ((< 0xffff) . B.length)
let action = do
addEntry method content s
setModTime modTime s
setEntryComment comment s
addExtraField extraFieldTag extraFieldContent s
return $ EM s EntryDescription
{ edVersionMadeBy = undefined
, edVersionNeeded = undefined
, edCompression = method
, edModTime = modTime
, edCRC32 = undefined
, edCompressedSize = undefined
, edUncompressedSize = fromIntegral (B.length content)
, edOffset = undefined
, edComment = Just comment
, edExtraField = M.singleton extraFieldTag extraFieldContent }
action
data EC = EC (Map EntrySelector EntryDescription) (ZipArchive ()) deriving Show
instance Arbitrary EC where
arbitrary = do
let f (EM s d z) = (s, (d, z))
m <- M.fromList . fmap f <$> listOf arbitrary
return (EC (M.map fst m) (sequence_ $ snd <$> M.elems m))
charGen :: Gen Char
charGen = frequency
[ (3, choose ('a', 'z'))
, (3, choose ('A', 'Z'))
, (3, choose ('0', '9'))
, (1, arbitrary `suchThat` (>= ' ')) ]
binASCII :: Gen ByteString
binASCII = LB.toStrict . LB.toLazyByteString <$> go
where go = frequency
[ (10, (<>) <$> (LB.word8 <$> choose (0, 127)) <*> go)
, (1, return mempty) ]
instance Show EntryDescription where
show ed = "{ edCompression = " ++ show (edCompression ed) ++
"\n, edModTime = " ++ show (edModTime ed) ++
"\n, edUncompressedSize = " ++ show (edUncompressedSize ed) ++
"\n, edComment = " ++ show (edComment ed) ++
"\n, edExtraField = " ++ show (edExtraField ed) ++
" }"
instance Show (ZipArchive a) where
show = const "<zip archive>"
----------------------------------------------------------------------------
-- Pure operations and periphery
mkEntrySelectorSpec :: Spec
mkEntrySelectorSpec = do
let rejects x =
mkEntrySelector x `shouldThrow` isEntrySelectorException x
accepts x = do
s <- mkEntrySelector x
getEntryName s `shouldBe` T.pack x
context "when absolute paths are passed" $
it "they are rejected" $ property $ \(RelPath x) ->
rejects ('/' : x)
context "when paths with trailing path separator are passed" $
it "they are rejected" $ do
rejects "foo/"
rejects "foo/bar/"
context "when paths with dot as path segment are passed" $
it "they are rejected" $ do
rejects "./foo/bar"
rejects "foo/./bar"
rejects "foo/bar/."
context "when paths with double dot as path segment are passed" $
it "they are rejected" $ do
rejects "../foo/bar"
rejects "foo/../bar"
rejects "foo/bar/.."
context "when too long paths are passed" $
it "rejects them" $ do
let path = replicate 0x10000 'a'
mkEntrySelector path `shouldThrow` isEntrySelectorException path
context "when correct paths are passed" $
it "adequately represents them" $ do
accepts "foo"
accepts "one/two/three"
accepts "something.txt"
unEntrySelectorSpec :: Spec
unEntrySelectorSpec =
context "when entry selector exists" $
it "has corresponding path" . property $ \s ->
not . null . unEntrySelector $ s
getEntryNameSpec :: Spec
getEntryNameSpec =
context "when entry selector exists" $
it "has corresponding representation" . property $ \s ->
not . T.null . getEntryName $ s
decodeCP437Spec :: Spec
decodeCP437Spec = do
context "when ASCII-compatible subset is used" $
it "has the same result as decoding UTF-8" . property $
forAll binASCII $ \bin ->
decodeCP437 bin `shouldBe` T.decodeUtf8 bin
context "when non-ASCII subset is used" $
it "is decoded correctly" $ do
let c b t = decodeCP437 (B.pack b ) `shouldBe` t
c [0x80..0x9f] "ÇüéâäàåçêëèïîìÄÅÉæÆôöòûùÿÖÜ¢£¥₧ƒ"
c [0xa0..0xbf] "áíóúñѪº¿⌐¬½¼¡«»░▒▓│┤╡╢╖╕╣║╗╝╜╛┐"
c [0xc0..0xdf] "└┴┬├─┼╞╟╚╔╩╦╠═╬╧╨╤╥╙╘╒╓╫╪┘┌█▄▌▐▀"
c [0xe0..0xff] "αßΓπΣσµτΦΘΩδ∞φε∩≡±≥≤⌠⌡÷≈°∙·√ⁿ²■ "
----------------------------------------------------------------------------
-- Primitive editing/querying actions
createArchiveSpec :: SpecWith FilePath
createArchiveSpec = do
context "when called with non-existent path and empty recipe" $
it "creates correct representation of empty archive" $ \path -> do
createArchive path (return ())
B.readFile path `shouldReturn` emptyArchive
context "when called with an occupied path" $
it "overwrites it" $ \path -> do
B.writeFile path B.empty
createArchive path (return ())
B.readFile path `shouldNotReturn` B.empty
withArchiveSpec :: SpecWith FilePath
withArchiveSpec = do
context "when called with non-existent path" $
it "throws 'isDoesNotExistError' exception" $ \path ->
withArchive path (return ()) `shouldThrow` isDoesNotExistError
context "when called with occupied path (empty file)" $
it "throws 'ParsingFailed' exception" $ \path -> do
B.writeFile path B.empty
withArchive path (return ()) `shouldThrow`
isParsingFailed path "Cannot locate end of central directory"
context "when called with occupied path (empty archive)" $
it "does not overwrite the file unnecessarily" $ \path -> do
B.writeFile path emptyArchive
withArchive path $
liftIO $ B.writeFile path B.empty
B.readFile path `shouldNotReturn` emptyArchive
archiveCommentSpec :: SpecWith FilePath
archiveCommentSpec = do
context "when new archive is created" $
it "returns no archive comment" $ \path ->
createArchive path getArchiveComment `shouldReturn` Nothing
context "when comment contains end of central directory signature" $
it "reads it without problems" $ \path -> do
entries <- createArchive path $ do
setArchiveComment "I saw you want to have PK\ENQ\ACK here."
commit
getEntries
entries `shouldBe` M.empty
context "when comment is committed (delete/set)" $
it "reads it and updates" $ \path -> property $ \txt -> do
comment <- createArchive path $ do
deleteArchiveComment
setArchiveComment txt
commit
getArchiveComment
comment `shouldBe` Just txt
context "when comment is committed (set/delete)" $
it "reads it and updates" $ \path -> property $ \txt -> do
comment <- createArchive path $ do
setArchiveComment txt
deleteArchiveComment
commit
getArchiveComment
comment `shouldBe` Nothing
context "when pre-existing comment is overwritten" $
it "returns the new comment" $ \path -> property $ \txt txt' -> do
comment <- createArchive path $ do
setArchiveComment txt
commit
setArchiveComment txt'
commit
getArchiveComment
comment `shouldBe` Just txt'
context "when pre-existing comment is deleted" $
it "actually deletes it" $ \path -> property $ \txt -> do
comment <- createArchive path $ do
setArchiveComment txt
commit
deleteArchiveComment
commit
getArchiveComment
comment `shouldBe` Nothing
getEntryDescSpec :: SpecWith FilePath
getEntryDescSpec =
it "always returns correct description" $
\path -> property $ \(EM s desc z) -> do
desc' <- fromJust <$> createArchive path (z >> commit >> getEntryDesc s)
desc' `shouldSatisfy` softEq desc
versionNeededSpec :: SpecWith FilePath
versionNeededSpec =
it "writes correct version that is needed to extract archive" $
-- NOTE for now we check only how version depends on compression method,
-- it should be mentioned that the version also depends on Zip64 feature
\path -> property $ \(EM s desc z) -> do
desc' <- fromJust <$> createArchive path (z >> commit >> getEntryDesc s)
edVersionNeeded desc' `shouldBe` makeVersion
(case edCompression desc of
Store -> [2,0]
Deflate -> [2,0]
BZip2 -> [4,6])
addEntrySpec :: SpecWith FilePath
addEntrySpec =
context "when an entry is added" $
it "is there" $ \path -> property $ \m b s -> do
info <- createArchive path $ do
addEntry m b s
commit
(,) <$> getEntry s <*> (edCompression . (! s) <$> getEntries)
info `shouldBe` (b, m)
sinkEntrySpec :: SpecWith FilePath
sinkEntrySpec =
context "when an entry is sunk" $
it "is there" $ \path -> property $ \m b s -> do
info <- createArchive path $ do
sinkEntry m (C.yield b) s
commit
(,) <$> sourceEntry s (CL.foldMap id)
<*> (edCompression . (! s) <$> getEntries)
info `shouldBe` (b, m)
loadEntrySpec :: SpecWith FilePath
loadEntrySpec =
context "when an entry is loaded" $
it "is there" $ \path -> property $ \m b s t -> do
let vpath = deriveVacant path
B.writeFile vpath b
setModificationTime vpath t
createArchive path $ do
loadEntry m s vpath
commit
liftIO (removeFile vpath)
saveEntry s vpath
B.readFile vpath `shouldReturn` b
modTime <- getModificationTime vpath
modTime `shouldSatisfy` isCloseTo t
copyEntrySpec :: SpecWith FilePath
copyEntrySpec =
context "when entry is copied form another archive" $
it "is there" $ \path -> property $ \m b s -> do
let vpath = deriveVacant path
createArchive vpath (addEntry m b s)
info <- createArchive path $ do
copyEntry vpath s s
commit
(,) <$> getEntry s <*> (edCompression . (! s) <$> getEntries)
info `shouldBe` (b, m)
checkEntrySpec :: SpecWith FilePath
checkEntrySpec = do
context "when entry is intact" $
it "passes the check" $ \path -> property $ \m b s -> do
check <- createArchive path $ do
addEntry m b s
commit
checkEntry s
check `shouldBe` True
context "when entry is corrupted" $
it "does not pass the check" $ \path -> property $ \b s ->
not (B.null b) ==> do
let r = 50 + (B.length . T.encodeUtf8 . getEntryName $ s)
offset <- createArchive path $ do
addEntry Store b s
commit
fromIntegral . edOffset . (! s) <$> getEntries
withFile path ReadWriteMode $ \h -> do
hSeek h AbsoluteSeek (offset + fromIntegral r)
byte <- B.map complement <$> B.hGet h 1
hSeek h RelativeSeek (-1)
B.hPut h byte
withArchive path (checkEntry s) `shouldReturn` False
recompressSpec :: SpecWith FilePath
recompressSpec =
context "when recompression is used" $
it "gets recompressed" $ \path -> property $ \m m' b s -> do
info <- createArchive path $ do
addEntry m b s
commit
recompress m' s
commit
(,) <$> getEntry s <*> (edCompression . (! s) <$> getEntries)
info `shouldBe` (b, m')
entryCommentSpec :: SpecWith FilePath
entryCommentSpec = do
context "when comment is committed (delete/set)" $
it "reads it and updates" $ \path -> property $ \txt s -> do
comment <- createArchive path $ do
addEntry Store "foo" s
deleteEntryComment s
setEntryComment txt s
commit
edComment . (! s) <$> getEntries
comment `shouldBe` Just txt
context "when comment is committed (set/delete)" $
it "reads it and updates" $ \path -> property $ \txt s -> do
comment <- createArchive path $ do
addEntry Store "foo" s
setEntryComment txt s
deleteEntryComment s
commit
edComment . (! s) <$> getEntries
comment `shouldBe` Nothing
context "when pre-existing comment is overwritten" $
it "returns the new comment" $ \path -> property $ \txt txt' s -> do
comment <- createArchive path $ do
addEntry Store "foo" s
setEntryComment txt s
commit
setEntryComment txt' s
commit
edComment . (! s) <$> getEntries
comment `shouldBe` Just txt'
context "when pre-existing comment is deleted" $
it "actually deletes it" $ \path -> property $ \txt s -> do
comment <- createArchive path $ do
addEntry Store "foo" s
setEntryComment txt s
commit
deleteEntryComment s
commit
edComment . (! s) <$> getEntries
comment `shouldBe` Nothing
setModTimeSpec :: SpecWith FilePath
setModTimeSpec = do
context "when mod time is set (after creation)" $
it "reads it and updates" $ \path -> property $ \time s -> do
modTime <- createArchive path $ do
addEntry Store "foo" s
setModTime time s
commit
edModTime . (! s) <$> getEntries
modTime `shouldSatisfy` isCloseTo time
context "when mod time is set (before creation)" $
it "has no effect" $ \path -> property $ \time time' s ->
not (isCloseTo time time') ==> do
modTime <- createArchive path $ do
setModTime time s
addEntry Store "foo" s
commit
edModTime . (! s) <$> getEntries
modTime `shouldNotSatisfy` isCloseTo time
extraFieldSpec :: SpecWith FilePath
extraFieldSpec = do
context "when extra field is committed (delete/set)" $
it "reads it and updates" $ \path -> property $ \n b s ->
n /= 1 ==> do
efield <- createArchive path $ do
addEntry Store "foo" s
deleteExtraField n s
addExtraField n b s
commit
M.lookup n . edExtraField . (! s) <$> getEntries
efield `shouldBe` Just b
context "when extra field is committed (set/delete)" $
it "reads it and updates" $ \path -> property $ \n b s ->
n /= 1 ==> do
efield <- createArchive path $ do
addEntry Store "foo" s
addExtraField n b s
deleteExtraField n s
commit
M.lookup n . edExtraField . (! s) <$> getEntries
efield `shouldBe` Nothing
context "when pre-existing extra field is overwritten" $
it "reads it and updates" $ \path -> property $ \n b b' s ->
n /= 1 ==> do
efield <- createArchive path $ do
addEntry Store "foo" s
addExtraField n b s
commit
addExtraField n b' s
commit
M.lookup n . edExtraField . (! s) <$> getEntries
efield `shouldBe` Just b'
context "when pre-existing extra field is deleted" $
it "actually deletes it" $ \path -> property $ \n b s ->
n /= 1 ==> do
efield <- createArchive path $ do
addEntry Store "foo" s
addExtraField n b s
commit
deleteExtraField n s
commit
M.lookup n . edExtraField . (! s) <$> getEntries
efield `shouldBe` Nothing
renameEntrySpec :: SpecWith FilePath
renameEntrySpec = do
context "when renaming after editing of new entry" $
it "produces correct result" $ \path -> property $ \(EM s desc z) s' -> do
desc' <- createArchive path $ do
z
renameEntry s s'
commit
(! s') <$> getEntries
desc' `shouldSatisfy` softEq desc
context "when renaming existing entry" $
it "gets renamed" $ \path -> property $ \(EM s desc z) s' -> do
desc' <- createArchive path $ do
z
commit
renameEntry s s'
commit
(! s') <$> getEntries
desc' `shouldSatisfy` softEq desc
deleteEntrySpec :: SpecWith FilePath
deleteEntrySpec = do
context "when deleting after editing of new entry" $
it "produces correct result" $ \path -> property $ \(EM s _ z) -> do
member <- createArchive path $ do
z
deleteEntry s
commit
doesEntryExist s
member `shouldBe` False
context "when deleting existing entry" $
it "gets deleted" $ \path -> property $ \(EM s _ z) -> do
member <- createArchive path $ do
z
commit
deleteEntry s
commit
doesEntryExist s
member `shouldBe` False
forEntriesSpec :: SpecWith FilePath
forEntriesSpec =
it "affects all existing entries" $ \path -> property $ \(EC m z) txt -> do
m' <- createArchive path $ do
z
commit
forEntries (setEntryComment txt)
commit
getEntries
let f ed = ed { edComment = Just txt }
m' `shouldSatisfy` softEqMap (M.map f m)
undoEntryChangesSpec :: SpecWith FilePath
undoEntryChangesSpec =
it "cancels all actions for specified entry" $
\path -> property $ \(EM s _ z) -> do
member <- createArchive path $ do
z
undoEntryChanges s
commit
doesEntryExist s
member `shouldBe` False
undoArchiveChangesSpec :: SpecWith FilePath
undoArchiveChangesSpec = do
it "cancels archive comment editing" $ \path -> property $ \txt -> do
comment <- createArchive path $ do
setArchiveComment txt
undoArchiveChanges
commit
getArchiveComment
comment `shouldBe` Nothing
it "cancels archive comment deletion" $ \path -> property $ \txt -> do
comment <- createArchive path $ do
setArchiveComment txt
commit
deleteArchiveComment
undoArchiveChanges
commit
getArchiveComment
comment `shouldBe` Just txt
undoAllSpec :: SpecWith FilePath
undoAllSpec =
it "cancels all editing at once" $ \path -> property $ \(EC _ z) txt -> do
createArchive path (return ())
withArchive path $ do
z
setArchiveComment txt
undoAll
liftIO (B.writeFile path B.empty)
B.readFile path `shouldReturn` B.empty
----------------------------------------------------------------------------
-- Complex construction/restoration
consistencySpec :: SpecWith FilePath
consistencySpec =
it "can save and restore arbitrary archive" $
\path -> property $ \(EC m z) txt -> do
(txt', m') <- createArchive path $ do
z
setArchiveComment txt
commit
(,) <$> getArchiveComment <*> getEntries
txt' `shouldBe` Just txt
m' `shouldSatisfy` softEqMap m
packDirRecurSpec :: SpecWith FilePath
packDirRecurSpec =
it "packs arbitrary directory recursively" $
\path -> property $ \contents ->
withSystemTempDirectory "zip-sandbox" $ \dir -> do
forM_ contents $ \s -> do
let item = dir </> unEntrySelector s
createDirectoryIfMissing True (FP.takeDirectory item)
B.writeFile item "foo"
selectors <-
createArchive path $ do
packDirRecur Store mkEntrySelector dir
commit
M.keysSet <$> getEntries
selectors `shouldBe` E.fromList contents
unpackIntoSpec :: SpecWith FilePath
unpackIntoSpec =
it "unpacks archive contents into directory" $
\path -> property $ \(EC m z) ->
withSystemTempDirectory "zip-sandbox" $ \dir -> do
createArchive path $ do
z
commit
unpackInto dir
selectors <- listDirRecur dir >>= mapM mkEntrySelector
let x = E.fromList selectors
y = M.keysSet m
E.difference x y `shouldBe` E.empty
----------------------------------------------------------------------------
-- Helpers
-- | Check whether given exception is 'EntrySelectorException' with specific
-- path inside.
isEntrySelectorException :: FilePath -> EntrySelectorException -> Bool
isEntrySelectorException path (InvalidEntrySelector p) = p == path
-- | Check whether given exception is 'ParsingFailed' exception with
-- specific path and error message inside.
isParsingFailed :: FilePath -> String -> ZipException -> Bool
isParsingFailed path msg (ParsingFailed path' msg') =
path == path' && msg == msg'
isParsingFailed _ _ _ = False
-- | Create sandbox directory to model some situation in it and run some
-- tests. Note that we're using new unique sandbox directory for each test
-- case to avoid contamination and it's unconditionally deleted after test
-- case finishes. The function returns vacant file path in that directory.
withSandbox :: ActionWith FilePath -> IO ()
withSandbox action = withSystemTempDirectory "zip-sandbox" $ \dir ->
action (dir </> "foo.zip")
-- | Given primary name (name of archive), generate a name that does not
-- collide with it.
deriveVacant :: FilePath -> FilePath
deriveVacant = (</> "bar") . FP.takeDirectory
-- | Compare times forgiving minor difference.
isCloseTo :: UTCTime -> UTCTime -> Bool
isCloseTo a b = abs (diffUTCTime a b) < 2
-- | Compare only some fields of 'EntryDescription' record.
softEq :: EntryDescription -> EntryDescription -> Bool
softEq a b =
edCompression a == edCompression b &&
isCloseTo (edModTime a) (edModTime b) &&
edUncompressedSize a == edUncompressedSize b &&
edComment a == edComment b &&
M.delete 1 (edExtraField a) == M.delete 1 (edExtraField b)
-- | Compare two maps describing archive entries in such a way that only
-- some fields in 'EntryDescription' record are tested.
softEqMap
:: Map EntrySelector EntryDescription
-> Map EntrySelector EntryDescription
-> Bool
softEqMap n m = M.null (M.differenceWith f n m)
where f a b = if softEq a b then Nothing else Just a
-- | Canonical representation of empty Zip archive.
emptyArchive :: ByteString
emptyArchive = B.pack
[ 0x50, 0x4b, 0x05, 0x06, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 ]
-- | Recursively list a directory. Do not return paths to empty directories.
listDirRecur :: FilePath -> IO [FilePath]
listDirRecur path = DList.toList <$> go ""
where
go adir = do
let cdir = path </> adir
raw <- listDirectory cdir
fmap mconcat . forM raw $ \case
"" -> return mempty
"." -> return mempty
".." -> return mempty
x -> do
let fullx = cdir </> x
adir' = adir </> x
isFile <- doesFileExist fullx
isDir <- doesDirectoryExist fullx
if isFile
then return (DList.singleton adir')
else if isDir
then go adir'
else return mempty