conduit-vfs-zip (empty) → 0.1.0.0
raw patch · 9 files changed
+468/−0 lines, 9 filesdep +basedep +bytestringdep +classy-preludesetup-changed
Dependencies added: base, bytestring, classy-prelude, conduit, conduit-extra, conduit-vfs, conduit-vfs-zip, directory, exceptions, extra, filepath, monad-loops, mono-traversable, mtl, resourcet, text, transformers, unix, unliftio, unordered-containers, zip-archive
Files
- ChangeLog.md +3/−0
- LICENSE +30/−0
- README.md +1/−0
- Setup.hs +2/−0
- conduit-vfs-zip.cabal +95/−0
- src/Data/Conduit/VFS/Zip.hs +20/−0
- src/Data/Conduit/VFS/Zip/Import.hs +41/−0
- src/Data/Conduit/VFS/Zip/Types.hs +272/−0
- test/Spec.hs +4/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for conduit-vfs-zip++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Robert Fischer (c) 2019++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Robert Fischer nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,1 @@+# conduit-vfs-zip
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ conduit-vfs-zip.cabal view
@@ -0,0 +1,95 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.1.+--+-- see: https://github.com/sol/hpack+--+-- hash: b2f014d90f20782c339ea3052983243780e92c7df8a79894de5974701a548c1c++name: conduit-vfs-zip+version: 0.1.0.0+synopsis: Zip archive interface for the Conduit Virtual File System.+description: This package provides the ability to work with zip archives as a part of a conduit. It does this by treating the zip file as a virtual file system and acting on it that way. The zip archive access does not require any IO, and so can be used in pure conduits. If you would like to have the zip file read from disk and then persisted at the beginning and end of your conduit run, you can do that but it does require constructing the Zip VFS within a MonadResource.+ For more information, please see the README on GitHub at <https://github.com/RobertFischer/vfs-conduit#README.md>+homepage: https://github.com/RobertFischer/vfs-conduit#readme+bug-reports: https://github.com/RobertFischer/vfs-conduit/issues+author: Robert Fischer+maintainer: smokejumperit@gmail.com+copyright: (c)2019 Robert Fischer. All Rights Reserved. See LICENSE for liscensing terms.+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ ChangeLog.md++source-repository head+ type: git+ location: https://github.com/RobertFischer/vfs-conduit++library+ exposed-modules:+ Data.Conduit.VFS.Zip+ Data.Conduit.VFS.Zip.Import+ Data.Conduit.VFS.Zip.Types+ other-modules:+ Paths_conduit_vfs_zip+ hs-source-dirs:+ src+ default-extensions: AutoDeriveTypeable BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MonadFailDesugaring MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TypeFamilies TypeSynonymInstances ViewPatterns TemplateHaskell TupleSections UnboxedTuples QuasiQuotes DeriveLift ExtendedDefaultRules+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -optP-Wno-nonportable-include-path -fno-warn-type-defaults -fno-warn-tabs -fno-warn-unused-top-binds -flate-dmd-anal -fmax-simplifier-iterations=12 -fregs-iterative -fsimplifier-phases=6 -flate-specialise -fstatic-argument-transformation -fstrictness-before=4 -funfolding-keeness-factor=3+ build-depends:+ base >=4.7 && <5+ , bytestring >=0.10.8.2 && <0.11+ , classy-prelude >=1.5.0 && <1.6+ , conduit >=1.3.1.1 && <1.4+ , conduit-extra >=1.3.1.1 && <1.4+ , conduit-vfs >=0.1.0.0 && <0.2+ , directory >=1.3.3.0 && <1.4+ , exceptions >=0.10.2 && <0.11+ , extra >=1.6.16 && <1.7+ , filepath >=1.4.2.1 && <1.5+ , monad-loops >=0.4.3 && <0.5+ , mono-traversable >=1.0.11.0 && <1.1+ , mtl >=2.2.2 && <2.3+ , resourcet >=1.2.2 && <1.3+ , text >=1.2.3.1 && <1.3+ , transformers >=0.5.6.2 && <0.6+ , unix >=2.7.2.2 && <2.8+ , unliftio >=0.2.10 && <0.3+ , unordered-containers >=0.2.10.0 && <0.3+ , zip-archive >=0.4.1 && <0.5+ default-language: Haskell2010++test-suite conduit-vfs-zip-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Paths_conduit_vfs_zip+ hs-source-dirs:+ test+ default-extensions: AutoDeriveTypeable BangPatterns BinaryLiterals ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable DoAndIfThenElse EmptyDataDecls ExistentialQuantification FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase MonadFailDesugaring MultiParamTypeClasses MultiWayIf NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving TypeFamilies TypeSynonymInstances ViewPatterns TemplateHaskell TupleSections UnboxedTuples QuasiQuotes DeriveLift ExtendedDefaultRules+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -optP-Wno-nonportable-include-path -fno-warn-type-defaults -fno-warn-tabs -fno-warn-unused-top-binds -threaded -rtsopts -with-rtsopts=-N -O0+ build-depends:+ base >=4.7 && <5+ , bytestring >=0.10.8.2 && <0.11+ , classy-prelude >=1.5.0 && <1.6+ , conduit >=1.3.1.1 && <1.4+ , conduit-extra >=1.3.1.1 && <1.4+ , conduit-vfs >=0.1.0.0 && <0.2+ , conduit-vfs-zip+ , directory >=1.3.3.0 && <1.4+ , exceptions >=0.10.2 && <0.11+ , extra >=1.6.16 && <1.7+ , filepath >=1.4.2.1 && <1.5+ , monad-loops >=0.4.3 && <0.5+ , mono-traversable >=1.0.11.0 && <1.1+ , mtl >=2.2.2 && <2.3+ , resourcet >=1.2.2 && <1.3+ , text >=1.2.3.1 && <1.3+ , transformers >=0.5.6.2 && <0.6+ , unix >=2.7.2.2 && <2.8+ , unliftio >=0.2.10 && <0.3+ , unordered-containers >=0.2.10.0 && <0.3+ , zip-archive >=0.4.1 && <0.5+ default-language: Haskell2010
+ src/Data/Conduit/VFS/Zip.hs view
@@ -0,0 +1,20 @@+{- | Description: Treats zip files like a virtual file system.++ This module provides two virtual file system implementations: 'ZipVFS' and 'DiskZipsVFS'. The 'ZipVFS' implementation represents a zip archive as a self-contained+ and in-memory filesystem. The 'DiskZipsVFS' is akin to the disk VFS, except that it knows how to read and write zip entries, so the entries internal to zip files+ work the same way.++ In both systems, compression within the archive is automatic: we attempt compression, and if the result saves us some bytes, then we used the compressed value; otherwise,+ we simply store the bytes uncompressed.++ -}++module Data.Conduit.VFS.Zip (+ module Data.Conduit.VFS.Zip.Types,+ module Data.Conduit.VFS.Zip.Import,+ module Data.Conduit.VFS.Types+) where++import Data.Conduit.VFS.Zip.Types+import Data.Conduit.VFS.Zip.Import+import Data.Conduit.VFS.Types
+ src/Data/Conduit/VFS/Zip/Import.hs view
@@ -0,0 +1,41 @@+module Data.Conduit.VFS.Zip.Import (+ createDiskZipVFS,+ emptyZipVFS,+ createZipVFS+) where++import ClassyPrelude hiding (finally)+import Data.Conduit.VFS.Zip.Types+import Conduit+import Control.Monad.State.Lazy+import Codec.Archive.Zip (Archive, toArchive, fromArchive, emptyArchive)+import qualified Data.ByteString.Lazy as LBS+import Control.Monad.Trans.Resource (allocate)+import UnliftIO.Directory (doesFileExist)+import Control.Monad.Extra (ifM)++-- | Creates a Zip VFSC backed by a file. The file will be loaded in the resulting monad, and the resulting archive will be written back to the file path+-- when the conduit completes. If the file does not exist when the monad is initially executed, then an empty archive is used initially and the zip+-- file will be created at the given filepath when the conduit completes.+createDiskZipVFS :: (MonadResource m) => FilePath -> m (ZipVFS m Archive)+createDiskZipVFS archiveFilePath = createZipVFS . snd <$> allocate readArchive writeArchive+ where+ readArchive =+ ifM+ (doesFileExist archiveFilePath)+ (toArchive <$> LBS.readFile archiveFilePath)+ (return emptyArchive)+ writeArchive = LBS.writeFile archiveFilePath . fromArchive+{-# INLINEABLE createDiskZipVFS #-}++-- | Creates a Zip VFSC without any entries, and not attached to any file.+emptyZipVFS :: (Applicative m) => ZipVFS m Archive+emptyZipVFS = createZipVFS emptyArchive+{-# INLINE emptyZipVFS #-}++-- | Creates a Zip VFSC based on the provided 'Archive', and not attached to any file.+createZipVFS :: (Applicative m) => Archive -> ZipVFS m Archive+createZipVFS archive = ZipVFS $ StateT stateImpl+ where+ stateImpl = const $ pure (archive, archive)+{-# INLINE createZipVFS #-}
+ src/Data/Conduit/VFS/Zip/Types.hs view
@@ -0,0 +1,272 @@+module Data.Conduit.VFS.Zip.Types (+ module Data.Conduit.VFS.Types,+ ZipVFS(..),+ DiskZipsVFS(..)+) where++import ClassyPrelude hiding (ByteString, finally)+import Codec.Archive.Zip (Archive, findEntryByPath, fromEntry, filesInArchive, addEntryToArchive, toEntry, deleteEntryFromArchive, toArchive, emptyArchive, fromArchive)+import Conduit+import Control.Monad.Catch (MonadCatch, MonadMask, finally)+import Control.Monad.Extra (whenJust, ifM)+import Control.Monad.Fail (MonadFail)+import Control.Monad.Reader.Class (MonadReader(..))+import Control.Monad.State.Lazy (StateT, put, get, MonadState, modify)+import Data.Conduit.VFS.Types+import Data.List.Extra (split, nub)+import System.FilePath (isPathSeparator, isExtensionOf, isSearchPathSeparator, takeDirectory, searchPathSeparator)+import qualified Data.ByteString.Lazy as LBS+import UnliftIO.Directory (doesFileExist, doesDirectoryExist, listDirectory, removeFile)++-- | Represents a single zip file as a conduit. Note that the zip file is resident in-memory as an 'Archive'. The 'Archive' type holds a list of 'Entry',+-- each of which holds their content as a lazy 'ByteString'. Because of this, you can use 'ZipVFS' as an alternative to 'Data.Conduit.VFS.PureVFS', which stores+-- its in-memory data as compressed bytes. It can also be used as an alternative to 'Data.Conduit.VFS.InMemoryVFS' as long as the conduit execution is single-threaded.+newtype ZipVFS m a = ZipVFS { unZipVFS :: StateT Archive m a }+ deriving (Functor, Applicative, Monad, MonadTrans, MonadState Archive, MonadIO, MonadFail, MonadThrow, MonadCatch, MonadMask, MonadResource)++instance (MonadMask m) => MonadReader Archive (ZipVFS m) where+ ask = get+ {-# INLINE ask #-}++ local f m = ask >>= \origState -> finally (runMonad origState) (put origState)+ where+ runMonad origState = put (f origState) >> m+ {-# INLINEABLE local #-}++instance (Monad m) => ReadVFSC (ZipVFS m) where++ vfsContentsC = awaitForever $ \rawFilepath -> get >>= \archive ->+ let filepath = unnormalize rawFilepath in+ whenJust (findEntryByPath filepath archive) $ \entry -> yield (filepath, fromEntry entry)+ {-# INLINEABLE vfsContentsC #-}++ vfsTypeC = awaitForever $ \rawFilepath -> get >>= \archive ->+ let filepath = unnormalize rawFilepath in+ let entryFilepaths = filesInArchive archive in+ let isFile = isJust $ find (filepath ==) entryFilepaths in+ let isDir = not isFile && isJust (find (`isPrefixOf` filepath) entryFilepaths) in+ yield . (filepath,) $+ if isFile then+ Just VFile+ else if isDir then+ Just VDirectory+ else+ Nothing+ {-# INLINEABLE vfsTypeC #-}++ vfsDescendentsC = awaitForever $ \rawFilepath -> get >>= \archive ->+ let filepath = unnormalize rawFilepath in+ let isFile = isJust $ findEntryByPath filepath archive in+ yieldMany $+ if isFile then+ [filepath]+ else+ filter (`isPrefixOf` filepath) (filesInArchive archive)+ {-# INLINEABLE vfsDescendentsC #-}++instance (Monad m) => WriteVFSC (ZipVFS m) where++ vfsWriteSink = awaitForever $ \(filepath, bytes) -> modify $+ addEntryToArchive (toEntry (unnormalize filepath) 0 bytes)+ {-# INLINEABLE vfsWriteSink #-}++ vfsRemoveSink = awaitForever $ \filepath -> modify $ deleteEntryFromArchive (unnormalize filepath)+ {-# INLINEABLE vfsRemoveSink #-}++instance (Monad m) => VFSC (ZipVFS m)++-- | The zip library that we are using assumes that paths are separated by forward slashes, so we have to+-- change the filepaths if the path separator generated by '</>' is not a forward slash. This is the+-- opposite of 'normalize'.+unnormalize :: FilePath -> FilePath+unnormalize filepath =+ if isPathSeparator '/' then+ filepath+ else+ intercalate "/" $ split isPathSeparator filepath+{-# INLINE unnormalize #-}+++-- | This type is similar to 'DiskVFS', but it automatically expands the contents of zip files that it encounters. Zip files are files denoted by the file suffix ".zip".+-- The filepaths for internal entries are separated by the 'searchPathSeparator' character.+newtype DiskZipsVFS m a = DiskZipsVFS { unDiskZipsVFS :: m a }+ deriving (Functor, Applicative, Monad, MonadIO, MonadFail, MonadThrow, MonadCatch, MonadMask, MonadResource)++instance MonadTrans DiskZipsVFS where+ lift = DiskZipsVFS+ {-# INLINE lift #-}++instance (MonadUnliftIO m) => ReadVFSC (DiskZipsVFS m) where++ vfsTypeC = awaitForeverForZipFile' zipHandler restHandler+ where+ restHandler (filepath, content) = yield . (filepath,) $+ case content of+ (NoContent _) -> Nothing+ (FileContent _ _) -> Just VFile+ (DirContent _ _) -> Just VDirectory+ zipHandler (filepath, archive) = yield . (filepath,) $+ let (_, entryPath) = splitFilepath filepath in+ case findEntryByPath entryPath archive of+ (Just _) -> Just VFile+ Nothing ->+ find (entryPath `isPrefixOf`) (filesInArchive archive) >> return VDirectory++ vfsContentsC = awaitForeverForZipFile' zipHandler restHandler+ where+ restHandler (filepath, content) =+ case content of+ (FileContent _ bytes) -> yield (filepath, bytes)+ _ -> return ()+ zipHandler (filepath, archive) = yield (filepath, fromArchive archive)++ vfsDescendentsC = awaitForeverForZipFile' zipHandler restHandler+ where+ restHandler (filepath, content) =+ case content of+ (FileContent _ _) -> yield filepath+ (NoContent _) -> return ()+ (DirContent _ children) -> do+ let absoluteChildren = (filepath </>) <$> children+ yieldMany absoluteChildren+ forM_ absoluteChildren recurseDescendents+ recurseDescendents rootFilePath =+ ifM (liftIO $ doesFileExist rootFilePath)+ ( do+ yield rootFilePath+ when ("zip" `isExtensionOf` rootFilePath) $ do+ archive <- toArchive <$> liftIO (LBS.readFile rootFilePath)+ transPipe unDiskZipsVFS $ zipHandler (rootFilePath, archive)+ )+ ( whenM (liftIO $ doesDirectoryExist rootFilePath) $ do+ yield rootFilePath+ children <- liftIO $ listDirectory rootFilePath+ let absoluteChildren = (rootFilePath </>) <$> children+ forM_ absoluteChildren recurseDescendents+ )+ zipHandler :: (FilePath, Archive) -> VFSPipe (DiskZipsVFS m)+ zipHandler (filepath, archive) =+ let archiveFiles = filesInArchive archive in+ let archiveDirs = nub ( takeDirectory <$> archiveFiles ) in+ let prefix = (filepath <> [searchPathSeparator]) in+ do+ yieldMany $ ( prefix <>) <$> archiveDirs+ yieldMany $ ( prefix <>) <$> archiveFiles+++instance (MonadUnliftIO m) => WriteVFSC (DiskZipsVFS m) where++ vfsWriteSink = awaitForeverForZipFile fst zipHandler restHandler+ where+ restHandler ((filepath, bytestring), _) = liftIO $ LBS.writeFile filepath bytestring+ zipHandler ((filepath, bytestring), archive) =+ let (archivePath, entryPath) = splitFilepath filepath in+ let archiveBytes =+ if null entryPath then+ bytestring+ else+ fromArchive $ addEntryToArchive (toEntry entryPath 0 bytestring) archive+ in+ transPipe DiskZipsVFS $ restHandler ( (archivePath, archiveBytes), FileContent archivePath archiveBytes)++ vfsRemoveSink = awaitForeverForZipFile' zipHandler restHandler+ where+ restHandler (filepath, _) = liftIO $ removeFile filepath+ zipHandler (filepath, oldArchive) =+ let (archivePath, entryPath) = splitFilepath filepath in+ if null entryPath then+ transPipe DiskZipsVFS $ restHandler ( archivePath, FileContent archivePath mempty)+ else+ let newArchive = deleteEntryFromArchive entryPath oldArchive in+ liftIO $ LBS.writeFile archivePath (fromArchive newArchive)++instance (MonadUnliftIO m) => VFSC (DiskZipsVFS m)++-- | Represents the content of a file, which may be nested super deeply somewhere.+data Content+ = FileContent FilePath ByteString -- ^ A file with its contents as a lazy byte string+ | DirContent FilePath [FilePath] -- ^ A directory with its immediate children+ | NoContent FilePath -- ^ A node that does not exist++-- | Performs an 'awaitForever', but processes differently depending on whether or not the filepath has ".zip" as its file extension.+awaitForeverForZipFile :: (MonadIO m)+ => (i -> FilePath) -- ^ Function to convert inputs into a filepath+ -> ((i,Archive) -> ConduitT i o (DiskZipsVFS m) ()) -- ^ Function for handling zip files+ -> ((i,Content) -> ConduitT i o m ()) -- ^ Function for handling non-zip files+ -> ConduitT i o (DiskZipsVFS m) ()+awaitForeverForZipFile toFilePath zipHandler restHandlerBase = awaitForever $ \input ->+ let filepath = toFilePath input in+ let (archiveFilePath, entryFilePath) = splitFilepath filepath in+ let isNested = not $ null entryFilePath in+ if "zip" `isExtensionOf` filepath then+ readArchive archiveFilePath >>= \archive ->+ if isNested then+ case findEntryByPath entryFilePath archive of+ Nothing -> return ()+ (Just entry) -> zipHandler (input, toArchive $ fromEntry entry)+ else+ zipHandler (input, archive)+ else+ if isNested then+ readArchive archiveFilePath >>= \archive ->+ case findEntryByPath entryFilePath archive of+ (Just entry) -> restHandler (input, FileContent archiveFilePath $ fromEntry entry)+ Nothing ->+ let children = filter (entryFilePath `isPrefixOf`) (filesInArchive archive) in+ if null children then+ return ()+ else+ restHandler (input, DirContent archiveFilePath children)+ else+ readContent filepath >>= \content -> restHandler (input, content)+ where+ restHandler = transPipe DiskZipsVFS . restHandlerBase+{-# INLINEABLE awaitForeverForZipFile #-}++-- | Performs an 'awaitForever', but processes differently depending on whether or not the filepath has ".zip" as its file extension. This version is for when+-- the input is just a 'FilePath': we can get rid of the first argument and specialize the types.+awaitForeverForZipFile' :: (MonadIO m)+ => ((FilePath, Archive) -> ConduitT FilePath o (DiskZipsVFS m) ()) -- ^ Function for handling zip files+ -> ((FilePath, Content) -> ConduitT FilePath o m ()) -- ^ Function for handling non-zip files+ -> ConduitT FilePath o (DiskZipsVFS m) ()+awaitForeverForZipFile' = awaitForeverForZipFile id+{-# INLINE awaitForeverForZipFile' #-}++-- | Reads an archive, which may be nested inside another archive+readArchive :: MonadIO m => FilePath -> m Archive+readArchive filepath = do+ fileExists <- liftIO $ doesFileExist archiveFilePath+ if not fileExists then+ return emptyArchive+ else+ toArchive <$> liftIO (LBS.readFile archiveFilePath) >>= \archive ->+ return $+ if null entryFilePath then+ archive+ else+ case findEntryByPath entryFilePath archive of+ Nothing -> archive+ (Just entry) -> toArchive $ fromEntry entry+ where+ (archiveFilePath, entryFilePath) = splitFilepath filepath+{-# INLINEABLE readArchive #-}++-- | Reads a filepath and determines what kind of 'Content' it is. Note that this assumes filepath is+-- an actual file on the filesystem, not nested via 'searchPathSeparator'.+readContent :: MonadIO m => FilePath -> m Content+readContent filepath = liftIO $ do+ isFile <- doesFileExist filepath+ isDir <- liftM2 (&&) (return (not isFile)) (doesDirectoryExist filepath)+ case (isDir, isFile) of+ (False, False) -> return $ NoContent filepath+ (True, _) -> DirContent filepath <$> liftIO (listDirectory filepath)+ (_, True) -> FileContent filepath <$> liftIO (LBS.readFile filepath)+{-# INLINEABLE readContent #-}++-- | Splits the filepath at 'searchPathSeparator'+splitFilepath :: FilePath -> (FilePath, FilePath)+splitFilepath filepath = (archivePath, entryPath)+ where+ (archivePath, rawEntryPath) = break isSearchPathSeparator filepath+ entryPath = unnormalize rawEntryPath+{-# INLINE splitFilepath #-}
+ test/Spec.hs view
@@ -0,0 +1,4 @@+import ClassyPrelude++main :: IO ()+main = putStrLn "Test suite not yet implemented"