file-collection 0.1.0.3 → 0.1.1.0
raw patch · 2 files changed
+61/−8 lines, 2 filesdep +bytestringdep +clockPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: bytestring, clock
API changes (from Hackage documentation)
+ Codec.Archive.FileCollection: addFile :: FileCollection d => d -> AssocFile d -> IO d
+ Codec.Archive.FileCollection: getFile :: FileCollection d => d -> FilePath -> AssocFile d
+ Codec.Archive.FileCollection: instance Codec.Archive.FileCollection.File Codec.Archive.Zip.Entry
+ Codec.Archive.FileCollection: instance Codec.Archive.FileCollection.File GHC.IO.FilePath
- Codec.Archive.FileCollection: class FileCollection d
+ Codec.Archive.FileCollection: class File (AssocFile d) => FileCollection d where type family AssocFile d :: *
- Codec.Archive.FileCollection: findFile :: FileCollection d => d -> [FilePath] -> String -> IO (Maybe FilePath)
+ Codec.Archive.FileCollection: findFile :: FileCollection d => d -> [FilePath] -> String -> IO (Maybe (AssocFile d))
- Codec.Archive.FileCollection: findFiles :: FileCollection d => d -> [FilePath] -> String -> IO [FilePath]
+ Codec.Archive.FileCollection: findFiles :: FileCollection d => d -> [FilePath] -> String -> IO [AssocFile d]
Files
- Codec/Archive/FileCollection.hs +54/−6
- file-collection.cabal +7/−2
Codec/Archive/FileCollection.hs view
@@ -1,4 +1,6 @@+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UnicodeSyntax #-} -------------------------------------------------------------------------------@@ -22,6 +24,10 @@ import Data.Monoid((<>)) import qualified Data.List as L import Data.Maybe(mapMaybe,listToMaybe)+import qualified Data.ByteString.Lazy as BS(ByteString,appendFile,readFile,writeFile)+import System.Clock(Clock(Realtime),getTime,sec)++import Prelude hiding (readFile,writeFile) {- $intro This module represents an abstraction of a file tree. The motivating use case is abstracting the difference between a real file system tree, rooted in some@@ -31,9 +37,32 @@ the root to work from -} +class File f where+ readFile :: f → IO BS.ByteString+ writeFile :: f → BS.ByteString → IO f+ appendFile :: f → BS.ByteString → IO f++instance File FilePath where+ readFile f = BS.readFile f+ writeFile f c = BS.writeFile f c >> return f+ appendFile f c = BS.appendFile f c >> return f++instance File Entry where+ readFile = return . fromEntry+ writeFile e newContents = do+ now <- fromIntegral <$> sec <$> getTime Realtime+ return $ toEntry (eRelativePath e) now newContents+ appendFile e addContents = do+ oldContents <- readFile e+ writeFile e $ oldContents <> addContents+ + + -- | @class FileCollection d where@ An object that is a heirarchical arrangement -- | of files. This could be a tree in the file system, or a file archive.-class FileCollection d where+class File (AssocFile d) ⇒ FileCollection d where+ -- | An element in the collection, capable of being read from.+ type AssocFile d :: * -- | @'createDirectory' root path@ creates a new directory /root\/path/ which -- | is initially empty. The path to the new directory is returned. createDirectory :: d → FilePath → IO d@@ -52,6 +81,10 @@ -- | @'getDirectoryContents' root dir@ returns a list of all entries -- | immediately contained in /dir/. getDirectoryContents :: d → FilePath → IO [FilePath]+ -- | @'getFile' filePath@ returns a `AssocFile d` with the given path.+ -- | /Warning: Error checking is not guaranteed. This should only be used with+ -- | the output from `getDirectoryContents`+ getFile :: d → FilePath → AssocFile d -- | @'removeFile' root file@ removes the directory entry for an existing file, -- | where /file/ is not a directory. removeFile :: d → FilePath → IO d@@ -60,11 +93,14 @@ renameFile :: d → FilePath → FilePath → IO d -- | @'copyFile' root old new@ creates a duplicate of /old/ with the name /new/. copyFile :: d → FilePath → FilePath → IO d+ -- | @'addFile' root file@ adds the file to the collection if it isn't already+ -- | present.+ addFile :: d → AssocFile d → IO d -- These don't work recursively -- | @'findFile' root dirs file@ returns the path of /file/ if it can be found -- | in any of /dirs/.- findFile :: d → [FilePath] → String → IO (Maybe FilePath)- findFiles :: d → [FilePath] → String → IO [FilePath]+ findFile :: d → [FilePath] → String → IO (Maybe (AssocFile d))+ findFiles :: d → [FilePath] → String → IO [AssocFile d] -- | @'doesFileExist' root path@ returns True if /path/ exists and is not a -- | directory. doesFileExist :: d → FilePath → IO Bool@@ -76,10 +112,12 @@ combine :: FilePath → FilePath → FilePath combine root relative = root <> ('/':relative) +combineRunReturn :: (FilePath → IO a) → FilePath → FilePath → IO FilePath combineRunReturn action root rel = do let full = combine root rel _ ← action full return full+combineRunReturn2 :: (FilePath → FilePath → IO a) → FilePath → FilePath → FilePath → IO FilePath combineRunReturn2 action root old new = do let fullOld = combine root old fullNew = combine root new@@ -88,26 +126,32 @@ -- This represents native files instance FileCollection [Char] where+ type AssocFile [Char] = FilePath createDirectory = combineRunReturn SD.createDirectory createDirectoryIfMissing = combineRunReturn (SD.createDirectoryIfMissing True) removeDirectory = combineRunReturn SD.removeDirectory removeDirectoryRecursive = combineRunReturn SD.removeDirectoryRecursive renameDirectory = combineRunReturn2 SD.renameDirectory getDirectoryContents root rel = SD.getDirectoryContents $ combine root rel+ getFile _ f = f removeFile = combineRunReturn SD.removeFile renameFile = combineRunReturn2 SD.renameFile copyFile = combineRunReturn2 SD.copyFile+ addFile dir = return . const dir findFile root subs = SD.findFile (map (combine root) subs) findFiles root subs = SD.findFiles (map (combine root) subs) doesFileExist root rel = SD.doesFileExist $ combine root rel doesDirectoryExist root rel = SD.doesDirectoryExist $ combine root rel -- Returns all paths located beneath root in the heirarchy+subFiles :: Archive → FilePath → [FilePath] subFiles arch path = filter (L.isPrefixOf path) $ map eRelativePath $ zEntries arch+getDirectoryContents' :: Archive → FilePath → [FilePath] getDirectoryContents' arch path = map (drop l) $ subFiles arch path where l = length path instance FileCollection Archive where+ type AssocFile Archive = Entry -- Creating a directory doesn't really mean anything in a zip archive, since -- every entry has its own path fully specified createDirectory a = return . const a@@ -123,6 +167,9 @@ e { eRelativePath = newPath <> drop l rp } l = length oldPath getDirectoryContents arch path = return $ getDirectoryContents' arch path+ getFile arch path = case findEntryByPath path arch of+ Nothing → error "Called Archive:getFile on a non-existant path"+ Just e → e removeFile arch path = return $ deleteEntryFromArchive path arch renameFile arch old new | old == new = return arch@@ -133,11 +180,12 @@ (Just e) → return $ addEntryToArchive e arch Nothing → return arch where oldEntry = findEntryByPath old arch- newEntry = changeName new <$> oldEntry- changeName new e = e { eRelativePath = new }+ newEntry = changeName <$> oldEntry+ changeName e = e { eRelativePath = new }+ addFile arch entry = return $ addEntryToArchive entry arch findFile arch subs target = listToMaybe <$> findFiles arch subs target findFiles arch subs target =- return $ map (<>target)+ return $ map (getFile arch) $ map (<>target) $ filter (elem target . getDirectoryContents' arch) subs doesFileExist arch path= case findEntryByPath path arch of Just e → if null $ subFiles arch $ eRelativePath e
file-collection.cabal view
@@ -1,5 +1,5 @@ name: file-collection-version: 0.1.0.3+version: 0.1.1.0 synopsis: Provide a uniform interface over file archives and directories description: The interface is essentially the same as that provided by `directory`, except each function also take reference to the@@ -20,6 +20,11 @@ library exposed-modules: Codec.Archive.FileCollection other-extensions: FlexibleInstances, UnicodeSyntax- build-depends: base >=4.8 && <4.9, directory >=1.2 && <1.3, zip-archive >= 0.2.1 && < 0.3+ build-depends: base >=4.8 && <4.9,+ bytestring >=0.9 && <0.11,+ directory >=1.2 && <1.3,+ clock >= 0.4 && <0.5,+ zip-archive >= 0.2.1 && < 0.3 default-language: Haskell2010+ ghc-options: -Wall