dirtree 0.1.1 → 0.1.2

raw patch · 4 files changed

+271/−345 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• dirtree.cabal +8/−3
• src/System/DirTree.hs +222/−294
• src/System/DirTree/Zip.hs +39/−47
• test/System/DirTreeSpec.hs +2/−1

@@ -1,17 +1,18 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.1.+-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: 04b2faaa60c67c8e41c9199e27a349c490f89680aaacffd35aa25967f4984de0+-- hash: eff64c4926d1a5563a628314d1284f818a7d00e225a378f5c3b2b387494a1e32  name:           dirtree-version:        0.1.1+version:        0.1.2 synopsis:       A small library for working with directories. description:    A small library for loading and building directories as trees. category:       System homepage:       https://github.com/kalhauge/dirtree#readme+bug-reports:    https://github.com/kalhauge/dirtree/issues author:         Christian Gram Kalhauge maintainer:     christian@kalhauge.dk copyright:      MIT@@ -20,6 +21,10 @@ build-type:     Simple extra-source-files:     README.md++source-repository head+  type: git+  location: https://github.com/kalhauge/dirtree  library   exposed-modules:

@@ -22,119 +22,110 @@  -} module System.DirTree- (+  (    -- * 'DirTreeNode'    -- $DirTreeNode--   DirTreeNode (..)- , RelativeFile (..)+    DirTreeNode(..)+  , RelativeFile(..)     -- ** Helpers- , FileType- , fileTypeOfNode-- , AsDirTreeNode (..)- , AsRelativeFile (..)+  , FileType+  , fileTypeOfNode+  , AsDirTreeNode(..)+  , AsRelativeFile(..)     -- ** IO- , getFileType- , readPath+  , getFileType+  , checkFileType+  , readPath     -- * 'FileMap'    -- $FileMap-- , FileMap (..)+  , FileMap(..)   -- ** Constructors- , emptyFileMap- , singletonFileMap- , toFileList- , fromFileList- , (.*), (./), (.*>), (.*.)+  , emptyFileMap+  , singletonFileMap+  , toFileList+  , fromFileList+  , (.*)+  , (./)+  , (.*>)+  , (.*.)   -- ** Accessors- , lookupFileMap+  , lookupFileMap     -- * 'DirTree'    -- $DirTree- , DirTree (..)- , RelativeDirTree- , asRelativeDirTree+  , DirTree(..)+  , RelativeDirTree+  , asRelativeDirTree     -- ** Constructors- , file- , realfile- , symlink- , directory-- , directory'-- , emptyDirectory-- , createDeepFile- , createDeepTree+  , file+  , realfile+  , symlink+  , directory+  , directory'+  , emptyDirectory+  , createDeepFile+  , createDeepTree     -- ** Accessors- , FileKey-- , fileKeyFromPath- , fileKeyToPath-- , diffFileKey- , diffPath-- , alterFile+  , FileKey+  , fileKeyFromPath+  , fileKeyToPath+  , diffFileKey+  , diffPath+  , alterFile     -- ** Iterators    -- Most of the iterators can be done with the 'FunctorWithIndex',    -- 'FoldableWithIndex', and 'TraversableWithIndex', but some accumilations    -- are easier.- , iflattenDirTree- , flattenDirTree-- , depthfirst- , findNode- , listNodes+  , iflattenDirTree+  , flattenDirTree+  , depthfirst+  , findNode+  , listNodes     -- ** IO-- , readDirTree- , writeDirTree- , Link (..)- , toLink- , readRelativeDirTree- , followLinks- , writeRelativeDirTree+  , readDirTree+  , writeDirTree+  , Link(..)+  , toLink+  , readRelativeDirTree+  , followLinks+  , writeRelativeDirTree   -- * 'DirForest'  -- $DirForest-- , DirForest (..)- , RelativeDirForest-- , ForestFileKey- , fromForestFileKey- , toForestFileKey+  , DirForest(..)+  , RelativeDirForest+  , ForestFileKey+  , fromForestFileKey+  , toForestFileKey   -- ** Constructors- , asRelativeDirForest- , emptyForest- , singletonForest- , createDeepForest+  , asRelativeDirForest+  , emptyForest+  , singletonForest+  , createDeepForest   -- ** Iterators- , alterForest-- ) where+  , alterForest+  )+where  -- containers-import qualified Data.Map                 as Map+import qualified Data.Map                      as Map  -- deepseq import           Control.DeepSeq  -- directory-import           System.Directory         hiding (findFile)+import           System.Directory        hiding ( findFile )  -- filepath import           System.FilePath@@ -142,18 +133,20 @@ -- lens import           Control.Lens.Combinators import           Control.Lens--- import           Control.Lens.Indexed  -- base import           Data.Functor import           Data.Foldable import           Data.Bifunctor import           Data.Maybe-import           Data.List.NonEmpty (NonEmpty (..), nonEmpty)-import           Data.Semigroup (sconcat)+import           Data.List.NonEmpty             ( NonEmpty(..)+                                                , nonEmpty+                                                )+import           Data.Semigroup                 ( sconcat ) import           Data.Monoid import           Data.Bitraversable import           Data.Bifoldable+import           System.IO.Error import           Control.Monad import           Text.Show import           GHC.Generics@@ -171,17 +164,17 @@ instance Bifunctor DirTreeNode where   bimap fr fa = \case     Directory r -> Directory (fr r)-    File a -> File (fa a)+    File      a -> File (fa a)  instance Bifoldable DirTreeNode where   bifoldMap fr fa = \case     Directory r -> fr r-    File a -> fa a+    File      a -> fa a  instance Bitraversable DirTreeNode where   bitraverse fr fa = \case     Directory r -> Directory <$> fr r-    File a -> File <$> fa a+    File      a -> File <$> fa a  makeClassyPrisms ''DirTreeNode @@ -195,17 +188,17 @@ instance Bifunctor RelativeFile where   bimap fr fa = \case     Symlink r -> Symlink (fr r)-    Real a -> Real (fa a)+    Real    a -> Real (fa a)  instance Bifoldable RelativeFile where   bifoldMap fr fa = \case     Symlink r -> fr r-    Real a -> fa a+    Real    a -> fa a  instance Bitraversable RelativeFile where   bitraverse fr fa = \case     Symlink r -> Symlink <$> fr r-    Real a -> Real <$> fa a+    Real    a -> Real <$> fa a  makeClassyPrisms ''RelativeFile @@ -224,26 +217,24 @@ getFileType :: FilePath -> IO FileType getFileType fp =   -- TODO: Throw a resonable exception if the file does not exist.-  pathIsSymbolicLink fp >>= \case-  True ->-    return $ File (Symlink ())-  False ->-    doesDirectoryExist fp >>= \case-    True ->-      return $ Directory ()-    False ->-      return $ File (Real ())+                 pathIsSymbolicLink fp >>= \case+  True  -> return $ File (Symlink ())+  False -> doesDirectoryExist fp >>= \case+    True  -> return $ Directory ()+    False -> return $ File (Real ()) +-- | Check a filepath for Type, return Nothing if the path does not+-- exist.+checkFileType :: FilePath -> IO (Maybe FileType)+checkFileType fp =+  catchIOError (Just <$> getFileType fp) (const . return $ Nothing)+ -- | Reads the structure of the filepath-readPath ::-  FilePath-  -> IO (DirTreeNode [String] (RelativeFile FilePath ()))-readPath fp = bitraverse-  (const $ listDirectory fp)-  (bitraverse-   (const $ getSymbolicLinkTarget fp)-   return-  ) =<< getFileType fp+readPath :: FilePath -> IO (DirTreeNode [String] (RelativeFile FilePath ()))+readPath fp =+  bitraverse (const $ listDirectory fp)+             (bitraverse (const $ getSymbolicLinkTarget fp) return)+    =<< getFileType fp   -- $FileMap@@ -258,15 +249,14 @@ singletonFileMap :: String -> a -> FileMap a singletonFileMap s a = FileMap (Map.singleton s a) --- | empty filemap+-- | An empty filemap emptyFileMap :: FileMap a emptyFileMap = FileMap Map.empty  -- | The 'FileMap' is a semigroup if the contnent is. It tries -- to union the content under each item. instance Semigroup a => Semigroup (FileMap a) where-  FileMap as <> FileMap bs =-    FileMap (Map.unionWith (<>) as bs)+  FileMap as <> FileMap bs = FileMap (Map.unionWith (<>) as bs)  -- | The empty monoid is the emptyFileMap instance Semigroup a => Monoid (FileMap a) where@@ -279,21 +269,22 @@   {-# INLINE itraverse #-}  instance Show a => Show (DirForest a) where-  showsPrec d m = showParen (d > 9) $ showString "DirForest . fromFileList " . showFileList m-    where-      showFileList =-        showListWith (\(s, x) -> f s $ dirTreeNode x) . toFileList . getInternalFileMap+  showsPrec d m =+    showParen (d > 9) $ showString "DirForest . fromFileList " . showFileList m+   where+    showFileList =+      showListWith (\(s, x) -> f s $ dirTreeNode x)+        . toFileList+        . getInternalFileMap -      f s (Directory x) =-        showsPrec (dir_prec+1) s .-        showString " ./ "      .-        showFileList x+    f s (Directory x) =+      showsPrec (dir_prec + 1) s . showString " ./ " . showFileList x -      f s (File x) =-        showsPrec (dir_prec+1) s .-        showString " .* "      .-        showsPrec (dir_prec+1) x-      dir_prec = 5+    f s (File x) =+      showsPrec (dir_prec + 1) s+        . showString " .* "+        . showsPrec (dir_prec + 1) x+    dir_prec = 5   -- | Create a list of pairs of filenames and file values.@@ -313,14 +304,13 @@ lookupFileMap s (FileMap a) = Map.lookup s a  -- | The 'Map.alterF' version to the FileMap.-alterFileMap ::-  Functor f+alterFileMap+  :: Functor f   => (Maybe a -> f (Maybe a))   -> String   -> FileMap a   -> f (FileMap a)-alterFileMap fn key (FileMap fm) =-  FileMap <$> Map.alterF fn key fm+alterFileMap fn key (FileMap fm) = FileMap <$> Map.alterF fn key fm  type instance Index (FileMap a) = String type instance IxValue (FileMap a) = a@@ -344,17 +334,11 @@ type DirTreeN a = DirTreeNode (DirForest a) a  -- | A specialized traversal of the DirTreeNode-itraverseDirTreeN ::-  Applicative f-  => (FileKey -> a -> f b)-  -> DirTreeN a-  -> f (DirTreeN b)+itraverseDirTreeN+  :: Applicative f => (FileKey -> a -> f b) -> DirTreeN a -> f (DirTreeN b) itraverseDirTreeN fia = \case-  Directory m ->-    Directory <$> itraverse (fia . fromForestFileKey) m-  File a ->-    File <$> fia [] a-+  Directory m -> Directory <$> itraverse (fia . fromForestFileKey) m+  File      a -> File <$> fia [] a  -- | A dir tree is a tree of nodes. newtype DirTree a = DirTree@@ -362,7 +346,6 @@   }   deriving (Eq, Ord, NFData, Generic) - instance Functor DirTree where   fmap f (DirTree a) = DirTree $ bimap (fmap f) f a @@ -385,15 +368,12 @@ asRelativeDirTree :: DirTree a -> RelativeDirTree s a asRelativeDirTree = fmap Real - instance (Show a) => Show (DirTree a) where-  showsPrec d c = showParen (d >9) (f $ dirTreeNode c)-    where+  showsPrec d c = showParen (d > 9) (f $ dirTreeNode c)+   where     f = \case-      Directory a ->-        showString "directory " . showsPrec 11 a-      File a ->-        showString "file " . showsPrec 11 a+      Directory a -> showString "directory " . showsPrec 11 a+      File      a -> showString "file " . showsPrec 11 a  -- | A DirTree is a semigroup, where it merges directories and take the last -- entry if there files.@@ -456,13 +436,11 @@  -- | Get a `FileKey` from a `FilePath` fileKeyFromPath :: FilePath -> FileKey-fileKeyFromPath =-  splitDirectories+fileKeyFromPath = splitDirectories  -- | Get a `FilePath` from a `FileKey` fileKeyToPath :: FileKey -> FilePath-fileKeyToPath =-  joinPath+fileKeyToPath = joinPath  -- | 'diffFileKey' produces a filepath which is needed to -- navigate from one FileKey to a other.@@ -477,17 +455,12 @@ -- "../../hello" diffFileKey :: FileKey -> FileKey -> FilePath diffFileKey f to' =-  let (n, bs) = prefix f to'-  in fileKeyToPath (replicate n ".." ++ bs)-  where-    prefix al@(a:as) bl@(b:bs)-      | a == b = prefix as bs-      | otherwise =-        (length al, bl)-    prefix (_:as) [] =-      (1 + length as, [])-    prefix [] bs =-      (0, bs)+  let (n, bs) = prefix f to' in fileKeyToPath (replicate n ".." ++ bs)+ where+  prefix al@(a : as) bl@(b : bs) | a == b    = prefix as bs+                                 | otherwise = (length al, bl)+  prefix (_ : as) [] = (1 + length as, [])+  prefix []       bs = (0, bs)  -- | 'diffPath' produces a the filekey at the end of -- a relative filepath, from one filekey.@@ -507,34 +480,32 @@ -- >>> diffPath ["world", "test"] "../../.." -- Nothing diffPath :: FileKey -> FilePath -> Maybe FileKey-diffPath f path-  | isAbsolute path = Nothing-  | otherwise = go (fileKeyFromPath path) (reverse f)-  where-    go = \case-      "..":rest -> \case-        _:as -> go rest as-        [] -> Nothing-      rest -> \m -> Just (reverse m ++ rest)+diffPath f path | isAbsolute path = Nothing+                | otherwise       = go (fileKeyFromPath path) (reverse f)+ where+  go = \case+    ".." : rest -> \case+      _ : as -> go rest as+      []     -> Nothing+    rest -> \m -> Just (reverse m ++ rest)  -- | Alter File is the 'DirTree' version of 'Map.alterF'. -- -- >>> alterFile (\x -> [Nothing, x, Just (file 'b')]) [] (Just (file 'a')) -- [Nothing,Just (file 'a'),Just (file 'b')]-alterFile ::-  forall f a. Functor f+alterFile+  :: forall f a+   . Functor f   => (Maybe (DirTree a) -> f (Maybe (DirTree a)))   -> FileKey   -> Maybe (DirTree a)   -> f (Maybe (DirTree a)) alterFile fn key = maybe (newFile key) (go key) where-  go key' tree@(DirTree node) =-    case key' of-      [] -> fn (Just tree)-      k : rest ->-        case node of-          Directory a -> Just . directory <$> alterForest fn (k :| rest) a-          File _ -> newFile rest+  go key' tree@(DirTree node) = case key' of+    []       -> fn (Just tree)+    k : rest -> case node of+      Directory a -> Just . directory <$> alterForest fn (k :| rest) a+      File      _ -> newFile rest    newFile :: FileKey -> f (Maybe (DirTree a))   newFile key' = fmap (createDeepTree key') <$> fn Nothing@@ -542,28 +513,24 @@  -- | Create a recursive `DirTree` from a FileKey and a value. createDeepFile :: FileKey -> a -> DirTree a-createDeepFile key a =-  createDeepTree key (file a)+createDeepFile key a = createDeepTree key (file a) {-# INLINE createDeepFile #-}  -- | Create a recursive `DirTree` from a FileKey and a value. createDeepTree :: FileKey -> DirTree a -> DirTree a-createDeepTree key a =-  foldr (\s f -> directory (singletonForest s f)) a key+createDeepTree key a = foldr (\s f -> directory (singletonForest s f)) a key {-# INLINE createDeepTree #-}  type instance Index (DirTree a) = FileKey type instance IxValue (DirTree a) = DirTree a  instance Ixed (DirTree a) where-  ix key fn = go key where-    go key' tree@(DirTree node) =-      case nonEmpty key' of-        Nothing -> fn tree-        Just fk ->-          case node of-            Directory a -> directory <$> ix fk fn a-            File _ -> pure tree+  ix key fn = go key   where+    go key' tree@(DirTree node) = case nonEmpty key' of+      Nothing -> fn tree+      Just fk -> case node of+        Directory a -> directory <$> ix fk fn a+        File      _ -> pure tree   {-# INLINE ix #-}  -- | Not a completly correct Lens, since it is implossible to@@ -577,52 +544,43 @@   {-# INLINE at #-}  -- | This method enables eta reduction of a DirTree a with an index.-iflattenDirTree ::-  (FileKey -> DirTreeNode (FileMap m) a -> m)-  -> DirTree a-  -> m+iflattenDirTree :: (FileKey -> DirTreeNode (FileMap m) a -> m) -> DirTree a -> m iflattenDirTree f = go id where   go fk =-    f (fk []) . first (imap (\k -> go (fk . (k:))) . getInternalFileMap) . dirTreeNode-{-# inline iflattenDirTree #-}+    f (fk [])+      . first (imap (\k -> go (fk . (k :))) . getInternalFileMap)+      . dirTreeNode+{-# INLINE iflattenDirTree #-}  -- | This method enables eta reduction of a DirTree a.-flattenDirTree ::-  (DirTreeNode (FileMap m) a -> m)-  -> DirTree a-  -> m-flattenDirTree f = go where-  go = f . first (fmap go . getInternalFileMap) . dirTreeNode-{-# inline flattenDirTree #-}+flattenDirTree :: (DirTreeNode (FileMap m) a -> m) -> DirTree a -> m+flattenDirTree f = go+  where go = f . first (fmap go . getInternalFileMap) . dirTreeNode+{-# INLINE flattenDirTree #-}  -- | Uses a semigroup to join together the results, This is slightly -- less powerfull than 'iflattenDirTree', but more convinient for -- summations.-depthfirst ::-  (Semigroup m)-  => (FileKey -> DirTreeNode [String] a -> m)-  -> DirTree a-  -> m+depthfirst+  :: (Semigroup m) => (FileKey -> DirTreeNode [String] a -> m) -> DirTree a -> m depthfirst f = iflattenDirTree $ \k -> \case-  Directory fm -> sconcat $-    f k (Directory . toFileNames $ fm) :| Data.Foldable.toList fm+  Directory fm ->+    sconcat $ f k (Directory . toFileNames $ fm) :| Data.Foldable.toList fm   File a -> f k (File a)-{-# inline depthfirst #-}+{-# INLINE depthfirst #-}  -- | Find a file given a predicate that takes a `FileKey` and `DirTreeNode`.-findNode ::-  (FileKey -> DirTreeNode [String] a -> Bool)+findNode+  :: (FileKey -> DirTreeNode [String] a -> Bool)   -> DirTree a   -> Maybe (FileKey, DirTreeNode [String] a)-findNode f =-  getFirst . depthfirst (\k a -> First $ guard (f k a) $> (k, a))-{-# inline findNode #-}+findNode f = getFirst . depthfirst (\k a -> First $ guard (f k a) $> (k, a))+{-# INLINE findNode #-}  -- List all the nodes in the dirtree listNodes :: DirTree a -> [(FileKey, DirTreeNode [String] a)]-listNodes =-  (`appEndo` []) . depthfirst (\k a -> Endo ((k, a):))-{-# inline listNodes #-}+listNodes = (`appEndo` []) . depthfirst (\k a -> Endo ((k, a) :))+{-# INLINE listNodes #-}   -- ** IO Methods@@ -636,97 +594,76 @@  -- | Figure out a link from the FileKey and FilePath of Link toLink :: FileKey -> FilePath -> Link-toLink key f =-  maybe (External f) Internal (diffPath (Prelude.init key) f)+toLink key f = maybe (External f) Internal (diffPath (Prelude.init key) f)   -- | Reads a DirTree. All file paths are absolute to the filepath-readRelativeDirTree ::-  (FilePath -> IO a)-  -> FilePath-  -> IO (RelativeDirTree Link a)+readRelativeDirTree+  :: (FilePath -> IO a) -> FilePath -> IO (RelativeDirTree Link a) readRelativeDirTree reader' fp = do   from' <- canonicalizePath fp   go from' fp-  where-    go from' fp' = do-      node <- readPath fp'-      DirTree <$> bimapM-        ( fmap (DirForest . fromFileList) . mapM (\k -> (k,) <$> go from' (fp' </> k)) )-        ( bimapM absolute (const $ reader' fp') )-        node-      where-        absolute a-          | isAbsolute a =-              return $ External a-          | otherwise = do-            a' <- canonicalizePath (takeDirectory fp' </> a)-            let a'' = makeRelative from' a'-            return $ if a'' /= a'-              then Internal (fileKeyFromPath a'')-              else External a'+ where+  go from' fp' = do+    node <- readPath fp'+    DirTree+      <$> bimapM+            ( fmap (DirForest . fromFileList)+            . mapM (\k -> (k, ) <$> go from' (fp' </> k))+            )+            (bimapM absolute (const $ reader' fp'))+            node+   where+    absolute a+      | isAbsolute a = return $ External a+      | otherwise = do+        a' <- canonicalizePath (takeDirectory fp' </> a)+        let a'' = makeRelative from' a'+        return+          $ if a'' /= a' then Internal (fileKeyFromPath a'') else External a'  -- | Reads a DirTree and follow all the relative links. Might recurse forever.-readDirTree ::-  (FilePath -> IO a)-  -> FilePath-  -> IO (DirTree a)-readDirTree fn fp =-  readRelativeDirTree fn fp >>= followLinks fn+readDirTree :: (FilePath -> IO a) -> FilePath -> IO (DirTree a)+readDirTree fn fp = readRelativeDirTree fn fp >>= followLinks fn  -- | Follow the links to create the tree. This function might recurse forever.-followLinks :: forall a. (FilePath -> IO a) -> RelativeDirTree Link a -> IO (DirTree a)+followLinks+  :: forall a . (FilePath -> IO a) -> RelativeDirTree Link a -> IO (DirTree a) followLinks fn tree = go tree where   go = flattenDirTree $ \case     File (Symlink a) -> case a of-      Internal s ->-        case tree ^? ix s of-          Just a' ->-            go a'-          Nothing ->-            error $ "Could not find " ++ show s-                ++ " in the dirtree " ++ show (void tree)-      External s ->-        readDirTree fn s+      Internal s -> case tree ^? ix s of+        Just a' -> go a'+        Nothing ->+          error $ "Could not find " ++ show s ++ " in the dirtree " ++ show+            (void tree)+      External s -> readDirTree fn s -    File (Real a) ->-      return $ file a+    File      (Real a) -> return $ file a -    Directory a ->-      directory . DirForest <$> sequence a+    Directory a        -> directory . DirForest <$> sequence a  -- | Writes a Relative DirTree to a file-writeRelativeDirTree ::-  (FilePath -> a -> IO ())-  -> FilePath-  -> RelativeDirTree Link a-  -> IO ()+writeRelativeDirTree+  :: (FilePath -> a -> IO ()) -> FilePath -> RelativeDirTree Link a -> IO () writeRelativeDirTree writer fp = depthfirst go where   go key = \case-    Directory _ ->-      createDirectory fp'-    File a ->-      case a of-        Symlink (External target) ->-          createFileLink target fp'-        Symlink (Internal key') ->-          createFileLink-          (case (key, key') of-              (_:fk',  _) -> diffFileKey fk' key'-              ([],    []) -> "."-              ([],     _) -> error "Fail"-          ) fp'-        Real a' ->-          writer fp' a'+    Directory _ -> createDirectory fp'+    File      a -> case a of+      Symlink (External target) -> createFileLink target fp'+      Symlink (Internal key'  ) -> createFileLink+        (case (key, key') of+          (_ : fk', _ ) -> diffFileKey fk' key'+          ([]     , []) -> "."+          ([]     , _ ) -> error "Fail"+        )+        fp'+      Real a' -> writer fp' a'     where fp' = fp </> fileKeyToPath key {-# INLINE writeRelativeDirTree #-}  -- | Writes a Relative DirTree to a file-writeDirTree ::-  (FilePath -> a -> IO ())-  -> FilePath-  -> DirTree a-  -> IO ()+writeDirTree :: (FilePath -> a -> IO ()) -> FilePath -> DirTree a -> IO () writeDirTree writer fp = writeRelativeDirTree writer fp . asRelativeDirTree {-# INLINE writeDirTree #-} @@ -752,7 +689,7 @@ instance FoldableWithIndex ForestFileKey DirForest instance TraversableWithIndex ForestFileKey DirForest where   itraverse f (DirForest fs) =-    DirForest <$> itraverse (\k -> itraverse (f . (k:|))) fs+    DirForest <$> itraverse (\k -> itraverse (f . (k :|))) fs   {-# INLINE itraverse #-}  instance Semigroup (DirForest a) where@@ -778,13 +715,11 @@  -- | Creates an singleton forest singletonForest :: String -> DirTree a -> DirForest a-singletonForest k f =-  DirForest $ singletonFileMap k f+singletonForest k f = DirForest $ singletonFileMap k f  -- | Creates an deep file in a forest createDeepForest :: ForestFileKey -> DirTree a -> DirForest a-createDeepForest (k :| rest) f =-  singletonForest k (createDeepTree rest f)+createDeepForest (k :| rest) f = singletonForest k (createDeepTree rest f)  -- | A relative dir forest also exists. type RelativeDirForest s a = DirForest (RelativeFile s a)@@ -798,18 +733,11 @@  instance Ixed (DirForest a) where   ix (k :| key) fn a = DirForest <$> ix k (ix key fn) (getInternalFileMap a)-  --   -- ix key fn . getInternalFileMap-  --   go key' tree@(DirTree node) =-  --     case key' of-  --       [] -> fn tree-  --       k : rest ->-  --         case node of-  --           Directory a -> directory <$> ix k (ix rest fn) a-  --           File _ -> pure tree   {-# INLINE ix #-} -alterForest ::-  forall f a. Functor f+alterForest+  :: forall f a+   . Functor f   => (Maybe (DirTree a) -> f (Maybe (DirTree a)))   -> ForestFileKey   -> DirForest a

@@ -15,14 +15,12 @@ -}  module System.DirTree.Zip-  (-    entriesToDirForest+  ( entriesToDirForest   , entriesFromDirForest    -- * Helpers   , entryToDirForest   , entryFromFile-   , files   , entries     -- * Re-Exports@@ -31,78 +29,72 @@   ) where + -- base-import Data.Foldable-import Data.Maybe-import Data.Bits-import System.Posix.Files (symbolicLinkMode, stdFileMode)+import           Data.Foldable+import           Data.Maybe+import           Data.Bits+import           System.Posix.Files             ( symbolicLinkMode+                                                , stdFileMode+                                                )  -- lens-import Control.Lens+import           Control.Lens  -- zip-archive-import Codec.Archive.Zip+import           Codec.Archive.Zip  -- dirtree-import System.DirTree+import           System.DirTree  -- bytestring-import qualified Data.ByteString.Lazy as BL-import qualified Data.ByteString.Lazy.Char8 as BLC+import qualified Data.ByteString.Lazy          as BL+import qualified Data.ByteString.Lazy.Char8    as BLC   -- | Convert a entry to a single filemap, fails if the entry path is empty.-entryToDirForest ::-  Entry-  -> Maybe (DirForest Entry)-entryToDirForest e =-  flip createDeepForest (file e)+entryToDirForest :: Entry -> Maybe (DirForest Entry)+entryToDirForest e = flip createDeepForest (file e)   <$> toForestFileKey (fileKeyFromPath (eRelativePath e))  -- | Convert entries to a 'FileMap' of 'RelativeDirTree'-entriesToDirForest ::-  [Entry]-  -> Maybe (RelativeDirForest Link BL.ByteString)-entriesToDirForest =-  fmap (imap parseEntry . fold)-  . traverse entryToDirForest-  where-    parseEntry key e =-      case symbolicLinkEntryTarget e of-        Just f -> Symlink . toLink (fromForestFileKey key) $ f-        Nothing -> Real $ fromEntry e+entriesToDirForest :: [Entry] -> Maybe (RelativeDirForest Link BL.ByteString)+entriesToDirForest = fmap (imap parseEntry . fold) . traverse entryToDirForest+ where+  parseEntry key e = case symbolicLinkEntryTarget e of+    Just f  -> Symlink . toLink (fromForestFileKey key) $ f+    Nothing -> Real $ fromEntry e  -- | Create a single entry from a file. This also handles symlinks, but changes -- saves all files with the 'stdFileMode'. entryFromFile :: Integer -> FileKey -> RelativeFile Link BL.ByteString -> Entry entryFromFile i key = \case-  Real bs -> toEntry (fileKeyToPath key) i bs-  Symlink x ->-    toSymlinkEntry (fileKeyToPath key) $ case x of-      Internal trgt -> diffFileKey (init key) trgt-      External f -> f-  where-    toSymlinkEntry path t =-      let e = toEntry path i (BLC.pack t)-      in e { eExternalFileAttributes =-             eExternalFileAttributes e .|. shiftL (fromIntegral ( symbolicLinkMode .|. stdFileMode)) 16-           , eVersionMadeBy = 798 -- Random high number-           }+  Real    bs -> toEntry (fileKeyToPath key) i bs+  Symlink x  -> toSymlinkEntry (fileKeyToPath key) $ case x of+    Internal trgt -> diffFileKey (init key) trgt+    External f    -> f+ where+  toSymlinkEntry path t =+    let e           = toEntry path i (BLC.pack t)+        shiftlength = fromIntegral (symbolicLinkMode .|. stdFileMode)+    in  e+          { eExternalFileAttributes = eExternalFileAttributes e+                                        .|. shiftL shiftlength 16+          , eVersionMadeBy          = 798 -- Random high number+          }  -- | Create a list of enties from a FileMap.-entriesFromDirForest ::-  Integer-  -> RelativeDirForest Link BL.ByteString-  -> [Entry]-entriesFromDirForest i =-  toList . imap (\k -> entryFromFile i (fromForestFileKey k))+entriesFromDirForest+  :: Integer -> RelativeDirForest Link BL.ByteString -> [Entry]+entriesFromDirForest i = toList . imap (entryFromFile i . fromForestFileKey)  -- | A simple lens into the entries of an archive. entries :: Lens' Archive [Entry] entries = lens zEntries (\a b -> a { zEntries = b })  -- | A list of entries can be seen as a FileMap of-entriesAsDirForest :: Integer -> Iso' [Entry] (RelativeDirForest Link BL.ByteString)+entriesAsDirForest+  :: Integer -> Iso' [Entry] (RelativeDirForest Link BL.ByteString) entriesAsDirForest i = iso from' to' where   from' = fromJust . entriesToDirForest   to'   = entriesFromDirForest i

@@ -12,7 +12,8 @@  spec :: Spec spec = do-  possibleSpec+  return () +  -- possibleSpec  possibleSpec :: Spec possibleSpec = do