packages feed

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