file-collection (empty) → 0.1.0.0

raw patch · 4 files changed

+171/−0 lines, 4 filesdep +basedep +directorydep +zip-archivesetup-changed

Dependencies added: base, directory, zip-archive

Files

• Archive/FileCollection.hs +114/−0
• LICENSE +30/−0
• Setup.hs +2/−0
• file-collection.cabal +25/−0

@@ -0,0 +1,114 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UnicodeSyntax #-}+-- 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+-- directory, and the contents of a zip archive. Where possible, the methods+-- associated with a FileCollection mimic those provided by+-- directory:System.Directory, but take an extra leading parameter denoting+-- the root to work from++module Archive.FileCollection+       (+       ) where++import qualified System.Directory as SD+import Codec.Archive.Zip+import Data.Monoid((<>))+import qualified Data.List as L+import Data.Maybe(mapMaybe,listToMaybe)++class FileCollection d where+  createDirectory :: d → FilePath → IO d+  createDirectoryIfMissing :: d → FilePath → IO d+  removeDirectory :: d → FilePath → IO d+  removeDirectoryRecursive :: d → FilePath → IO d+  renameDirectory :: d → FilePath → FilePath → IO d+  getDirectoryContents :: d → FilePath → IO [FilePath]+  removeFile :: d → FilePath → IO d+  renameFile :: d → FilePath → FilePath → IO d+  copyFile :: d → FilePath → FilePath → IO d+  -- These don't work recursively+  findFile :: d → [FilePath] → String → IO (Maybe FilePath)+  findFiles :: d → [FilePath] → String → IO [FilePath]+  doesFileExist :: d → FilePath → IO Bool+  doesDirectoryExist :: d → FilePath → IO Bool+++combine :: FilePath → FilePath → FilePath+combine root relative = root <> ('/':relative)++combineRunReturn action root rel = do+  let full = combine root rel+  _ ← action full+  return full+combineRunReturn2 action root old new = do+    let fullOld = combine root old+        fullNew = combine root new+    _ ← action fullOld fullNew+    return fullNew++-- This represents native files+instance FileCollection [Char] where+  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+  removeFile = combineRunReturn SD.removeFile+  renameFile = combineRunReturn2 SD.renameFile+  copyFile = combineRunReturn2 SD.copyFile+  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 arch path = filter (L.isPrefixOf path) $ map eRelativePath $ zEntries arch+getDirectoryContents' arch path = map (drop l) $ subFiles arch path+  where l = length path++instance FileCollection Archive where+  -- 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+  createDirectoryIfMissing a = return . const a+  removeDirectory a = return . const a+  removeDirectoryRecursive arch path = return $ foldr deleteEntryFromArchive arch $ subFiles arch path+  renameDirectory arch oldPath newPath =+    return $ foldr addEntryToArchive (foldr deleteEntryFromArchive arch oldNames) newEntries+    where oldNames = subFiles arch oldPath+          oldEntries = mapMaybe (`findEntryByPath` arch) oldNames+          newEntries = map rename oldEntries+          rename e@Entry{ eRelativePath = rp } =+            e { eRelativePath = newPath <> drop l rp }+          l = length oldPath+  getDirectoryContents arch path = return $ getDirectoryContents' arch path+  removeFile arch path = return $ deleteEntryFromArchive path arch+  renameFile arch old new+    | old == new = return arch+    | otherwise = copyFile arch old new >>= flip removeFile old+  copyFile arch old new+    | old == new = return arch+    | otherwise = case newEntry of+        (Just e) → return $ addEntryToArchive e arch+        Nothing → return arch+    where oldEntry = findEntryByPath old arch+          newEntry = changeName new <$> oldEntry+          changeName new e = e { eRelativePath = new }+  findFile arch subs target = listToMaybe <$> findFiles arch subs target+  findFiles arch subs target =+     return $ map (<>target)+     $ filter (elem target . getDirectoryContents' arch) subs+  doesFileExist arch path= case findEntryByPath path arch of+    Just e → if null $ subFiles arch $ eRelativePath e+             then return True+             else return False+    Nothing → return False+  doesDirectoryExist arch path= case findEntryByPath path arch of+    Just e → if null $ subFiles arch $ eRelativePath e+             then return False+             else return True+    Nothing → return False++          

@@ -0,0 +1,30 @@+Copyright (c) 2015, Joel Williamson++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 Joel Williamson 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.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,25 @@+name:                file-collection+version:             0.1.0.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+                     archive/root directory it is working under, and mutating+                     operations return the structure wrapped in IO.+homepage:            https://github.com/joelwilliamson/file-collection+license:             BSD3+license-file:        LICENSE+author:              Joel Williamson+maintainer:          joel.s.williamson@gmail.com+copyright:           2015 Joel Williamson+category:            Codec+build-type:          Simple+cabal-version:       >=1.10+source-repository head+        type: git+        location: https://github.com/joelwilliamson/file-collection.git+library+  exposed-modules:     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+  default-language:    Haskell2010+