Zip.hs

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-|
Module      : System.DirTree.Zip
Copyright   : (c) Christian Gram Kalhauge, 2019
License     : MIT
Maintainer  : kalhauge@cs.ucla.edu

Enables reading and writeing zipfiles using dirtrees. It is
not a complete 1-1 mapping but for many usecases it gets the
job done.

It is based of the `zip-archive` library, which can be used
if more control is needed.
-}

module System.DirTree.Zip
  ( entriesToDirForest
  , entriesFromDirForest

  -- * Helpers
  , entryToDirForest
  , entryFromFile
  , files
  , entries
    -- * Re-Exports
  , toArchive
  , fromArchive
  )
where


-- base
import           Data.Foldable
import           Data.Maybe
import           Data.Bits
import           System.Posix.Files             ( symbolicLinkMode
                                                , stdFileMode
                                                )

-- lens
import           Control.Lens

-- zip-archive
import           Codec.Archive.Zip

-- dirtree
import           System.DirTree

-- bytestring
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)
  <$> 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

-- | 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)
        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 (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 i = iso from' to' where
  from' = fromJust . entriesToDirForest
  to'   = entriesFromDirForest i

-- | A lens to get and set the files of an archive. Uses sparingly on
-- big archvies as it will convert forth and back.
files :: Lens' Archive (RelativeDirForest Link BL.ByteString)
files = entries . entriesAsDirForest 0