{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
module System.DirTree.Zip
(
entriesToDirForest
, entriesFromDirForest
, entryToDirForest
, entryFromFile
, files
, entries
, toArchive
, fromArchive
)
where
import Data.Foldable
import Data.Maybe
import Data.Bits
import System.Posix.Files (symbolicLinkMode, stdFileMode)
import Control.Lens
import Codec.Archive.Zip
import System.DirTree
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BLC
entryToDirForest ::
Entry
-> Maybe (DirForest Entry)
entryToDirForest e =
flip createDeepForest (file e)
<$> toForestFileKey (fileKeyFromPath (eRelativePath 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
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
}
entriesFromDirForest ::
Integer
-> RelativeDirForest Link BL.ByteString
-> [Entry]
entriesFromDirForest i =
toList . imap (\k -> entryFromFile i (fromForestFileKey k))
entries :: Lens' Archive [Entry]
entries = lens zEntries (\a b -> a { zEntries = b })
entriesAsDirForest :: Integer -> Iso' [Entry] (RelativeDirForest Link BL.ByteString)
entriesAsDirForest i = iso from' to' where
from' = fromJust . entriesToDirForest
to' = entriesFromDirForest i
files :: Lens' Archive (RelativeDirForest Link BL.ByteString)
files = entries . entriesAsDirForest 0