{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}

-- |
-- Module      :  Codec.Archive.Zip.Type
-- Copyright   :  © 2016–present Mark Karpov
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- Types used by the package.
module Codec.Archive.Zip.Type
  ( -- * Entry selector
    EntrySelector,
    mkEntrySelector,
    unEntrySelector,
    getEntryName,
    EntrySelectorException (..),

    -- * Entry description
    EntryDescription (..),
    CompressionMethod (..),

    -- * Archive description
    ArchiveDescription (..),

    -- * Exceptions
    ZipException (..),
  )
where

import Control.Exception (Exception)
import Control.Monad.Catch (MonadThrow (..))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI
import Data.Data (Data)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NE
import Data.Map (Map)
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Time.Clock (UTCTime)
import Data.Typeable (Typeable)
import Data.Version (Version)
import Data.Word (Word16, Word32)
import Numeric.Natural
import qualified System.FilePath as FP
import qualified System.FilePath.Posix as Posix
import qualified System.FilePath.Windows as Windows

----------------------------------------------------------------------------
-- Entry selector

-- | This data type serves for naming and selection of archive entries. It
-- can be created only with the help of the smart constructor
-- 'mkEntrySelector', and it's the only “key” that can be used to refer to
-- files in the archive or to name new archive entries.
--
-- The abstraction is crucial for ensuring that created archives are
-- portable across operating systems, file systems, and platforms. Since on
-- some operating systems, file paths are case-insensitive, this selector is
-- also case-insensitive. It makes sure that only relative paths are used to
-- name files inside archive, as it's recommended in the specification. It
-- also guarantees that forward slashes are used when the path is stored
-- inside the archive for compatibility with Unix-like operating systems (as
-- recommended in the specification). On the other hand, in can be rendered
-- as an ordinary relative file path in OS-specific format when needed.
newtype EntrySelector = EntrySelector
  { -- | Path pieces of relative path inside archive
    EntrySelector -> NonEmpty (CI String)
unES :: NonEmpty (CI String)
  }
  deriving (EntrySelector -> EntrySelector -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntrySelector -> EntrySelector -> Bool
$c/= :: EntrySelector -> EntrySelector -> Bool
== :: EntrySelector -> EntrySelector -> Bool
$c== :: EntrySelector -> EntrySelector -> Bool
Eq, Eq EntrySelector
EntrySelector -> EntrySelector -> Bool
EntrySelector -> EntrySelector -> Ordering
EntrySelector -> EntrySelector -> EntrySelector
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EntrySelector -> EntrySelector -> EntrySelector
$cmin :: EntrySelector -> EntrySelector -> EntrySelector
max :: EntrySelector -> EntrySelector -> EntrySelector
$cmax :: EntrySelector -> EntrySelector -> EntrySelector
>= :: EntrySelector -> EntrySelector -> Bool
$c>= :: EntrySelector -> EntrySelector -> Bool
> :: EntrySelector -> EntrySelector -> Bool
$c> :: EntrySelector -> EntrySelector -> Bool
<= :: EntrySelector -> EntrySelector -> Bool
$c<= :: EntrySelector -> EntrySelector -> Bool
< :: EntrySelector -> EntrySelector -> Bool
$c< :: EntrySelector -> EntrySelector -> Bool
compare :: EntrySelector -> EntrySelector -> Ordering
$ccompare :: EntrySelector -> EntrySelector -> Ordering
Ord, Typeable)

instance Show EntrySelector where
  show :: EntrySelector -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntrySelector -> String
unEntrySelector

-- | Create an 'EntrySelector' from a 'FilePath'. To avoid problems with
-- distribution of the archive, characters that some operating systems do
-- not expect in paths are not allowed.
--
-- Argument to 'mkEntrySelector' should pass these checks:
--
--     * 'System.FilePath.Posix.isValid'
--     * 'System.FilePath.Windows.isValid'
--     * it is a relative path without slash at the end
--     * binary representations of normalized path should be not longer than
--       65535 bytes
--
-- This function can throw an 'EntrySelectorException'.
mkEntrySelector :: (MonadThrow m) => FilePath -> m EntrySelector
mkEntrySelector :: forall (m :: * -> *). MonadThrow m => String -> m EntrySelector
mkEntrySelector String
path =
  let f :: String -> Maybe (CI String)
f String
x =
        case forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
FP.isPathSeparator) String
x of
          [] -> forall a. Maybe a
Nothing
          String
xs -> forall a. a -> Maybe a
Just (forall s. FoldCase s => s -> CI s
CI.mk String
xs)
      giveup :: m a
giveup = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (String -> EntrySelectorException
InvalidEntrySelector String
path)
   in case forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe (CI String)
f (String -> [String]
FP.splitPath String
path)) of
        Maybe (NonEmpty (CI String))
Nothing -> forall {a}. m a
giveup
        Just NonEmpty (CI String)
pieces ->
          let selector :: EntrySelector
selector = NonEmpty (CI String) -> EntrySelector
EntrySelector NonEmpty (CI String)
pieces
              binLength :: EntrySelector -> Int
binLength = ByteString -> Int
B.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntrySelector -> Text
getEntryName
           in if String -> Bool
Posix.isValid String
path
                Bool -> Bool -> Bool
&& String -> Bool
Windows.isValid String
path
                Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
FP.isAbsolute String
path Bool -> Bool -> Bool
|| String -> Bool
FP.hasTrailingPathSeparator String
path)
                Bool -> Bool -> Bool
&& (forall s. FoldCase s => s -> CI s
CI.mk String
"." forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` NonEmpty (CI String)
pieces)
                Bool -> Bool -> Bool
&& (forall s. FoldCase s => s -> CI s
CI.mk String
".." forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` NonEmpty (CI String)
pieces)
                Bool -> Bool -> Bool
&& EntrySelector -> Int
binLength EntrySelector
selector forall a. Ord a => a -> a -> Bool
<= Int
0xffff
                then forall (m :: * -> *) a. Monad m => a -> m a
return EntrySelector
selector
                else forall {a}. m a
giveup

-- | Restore a relative path from 'EntrySelector'. Every 'EntrySelector'
-- corresponds to a 'FilePath'.
unEntrySelector :: EntrySelector -> FilePath
unEntrySelector :: EntrySelector -> String
unEntrySelector =
  [String] -> String
FP.joinPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s. CI s -> s
CI.original forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntrySelector -> NonEmpty (CI String)
unES

-- | Get an entry name in the from that is suitable for writing to file
-- header, given an 'EntrySelector'.
getEntryName :: EntrySelector -> Text
getEntryName :: EntrySelector -> Text
getEntryName =
  String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> NonEmpty a -> NonEmpty a
NE.intersperse String
"/" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall s. CI s -> s
CI.original forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntrySelector -> NonEmpty (CI String)
unES

-- | The problems you can have with an 'EntrySelector'.
newtype EntrySelectorException
  = -- | 'EntrySelector' cannot be created from this path
    InvalidEntrySelector FilePath
  deriving (EntrySelectorException -> EntrySelectorException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntrySelectorException -> EntrySelectorException -> Bool
$c/= :: EntrySelectorException -> EntrySelectorException -> Bool
== :: EntrySelectorException -> EntrySelectorException -> Bool
$c== :: EntrySelectorException -> EntrySelectorException -> Bool
Eq, Eq EntrySelectorException
EntrySelectorException -> EntrySelectorException -> Bool
EntrySelectorException -> EntrySelectorException -> Ordering
EntrySelectorException
-> EntrySelectorException -> EntrySelectorException
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EntrySelectorException
-> EntrySelectorException -> EntrySelectorException
$cmin :: EntrySelectorException
-> EntrySelectorException -> EntrySelectorException
max :: EntrySelectorException
-> EntrySelectorException -> EntrySelectorException
$cmax :: EntrySelectorException
-> EntrySelectorException -> EntrySelectorException
>= :: EntrySelectorException -> EntrySelectorException -> Bool
$c>= :: EntrySelectorException -> EntrySelectorException -> Bool
> :: EntrySelectorException -> EntrySelectorException -> Bool
$c> :: EntrySelectorException -> EntrySelectorException -> Bool
<= :: EntrySelectorException -> EntrySelectorException -> Bool
$c<= :: EntrySelectorException -> EntrySelectorException -> Bool
< :: EntrySelectorException -> EntrySelectorException -> Bool
$c< :: EntrySelectorException -> EntrySelectorException -> Bool
compare :: EntrySelectorException -> EntrySelectorException -> Ordering
$ccompare :: EntrySelectorException -> EntrySelectorException -> Ordering
Ord, Typeable)

instance Show EntrySelectorException where
  show :: EntrySelectorException -> String
show (InvalidEntrySelector String
path) = String
"Cannot build selector from " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
path

instance Exception EntrySelectorException

----------------------------------------------------------------------------
-- Entry description

-- | The information about archive entry that can be stored in a zip
-- archive. It does not mirror local file header or central directory file
-- header, but their binary representations can be built given this data
-- structure and the archive contents.
data EntryDescription = EntryDescription
  { -- | Version made by
    EntryDescription -> Version
edVersionMadeBy :: Version,
    -- | Version needed to extract
    EntryDescription -> Version
edVersionNeeded :: Version,
    -- | Compression method
    EntryDescription -> CompressionMethod
edCompression :: CompressionMethod,
    -- | Last modification date and time
    EntryDescription -> UTCTime
edModTime :: UTCTime,
    -- | CRC32 check sum
    EntryDescription -> Word32
edCRC32 :: Word32,
    -- | Size of compressed entry
    EntryDescription -> Natural
edCompressedSize :: Natural,
    -- | Size of uncompressed entry
    EntryDescription -> Natural
edUncompressedSize :: Natural,
    -- | Absolute offset of local file header
    EntryDescription -> Natural
edOffset :: Natural,
    -- | Entry comment
    EntryDescription -> Maybe Text
edComment :: Maybe Text,
    -- | All extra fields found
    EntryDescription -> Map Word16 ByteString
edExtraField :: Map Word16 ByteString,
    -- | External file attributes
    --
    -- @since 1.2.0
    EntryDescription -> Word32
edExternalFileAttrs :: Word32
  }
  deriving (EntryDescription -> EntryDescription -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntryDescription -> EntryDescription -> Bool
$c/= :: EntryDescription -> EntryDescription -> Bool
== :: EntryDescription -> EntryDescription -> Bool
$c== :: EntryDescription -> EntryDescription -> Bool
Eq, Typeable)

-- | The supported compression methods.
data CompressionMethod
  = -- | Store file uncompressed
    Store
  | -- | Deflate
    Deflate
  | -- | Compressed using BZip2 algorithm
    BZip2
  | -- | Compressed using Zstandard algorithm
    --
    -- @since 1.6.0
    Zstd
  deriving (Int -> CompressionMethod -> ShowS
[CompressionMethod] -> ShowS
CompressionMethod -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompressionMethod] -> ShowS
$cshowList :: [CompressionMethod] -> ShowS
show :: CompressionMethod -> String
$cshow :: CompressionMethod -> String
showsPrec :: Int -> CompressionMethod -> ShowS
$cshowsPrec :: Int -> CompressionMethod -> ShowS
Show, ReadPrec [CompressionMethod]
ReadPrec CompressionMethod
Int -> ReadS CompressionMethod
ReadS [CompressionMethod]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompressionMethod]
$creadListPrec :: ReadPrec [CompressionMethod]
readPrec :: ReadPrec CompressionMethod
$creadPrec :: ReadPrec CompressionMethod
readList :: ReadS [CompressionMethod]
$creadList :: ReadS [CompressionMethod]
readsPrec :: Int -> ReadS CompressionMethod
$creadsPrec :: Int -> ReadS CompressionMethod
Read, CompressionMethod -> CompressionMethod -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompressionMethod -> CompressionMethod -> Bool
$c/= :: CompressionMethod -> CompressionMethod -> Bool
== :: CompressionMethod -> CompressionMethod -> Bool
$c== :: CompressionMethod -> CompressionMethod -> Bool
Eq, Eq CompressionMethod
CompressionMethod -> CompressionMethod -> Bool
CompressionMethod -> CompressionMethod -> Ordering
CompressionMethod -> CompressionMethod -> CompressionMethod
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CompressionMethod -> CompressionMethod -> CompressionMethod
$cmin :: CompressionMethod -> CompressionMethod -> CompressionMethod
max :: CompressionMethod -> CompressionMethod -> CompressionMethod
$cmax :: CompressionMethod -> CompressionMethod -> CompressionMethod
>= :: CompressionMethod -> CompressionMethod -> Bool
$c>= :: CompressionMethod -> CompressionMethod -> Bool
> :: CompressionMethod -> CompressionMethod -> Bool
$c> :: CompressionMethod -> CompressionMethod -> Bool
<= :: CompressionMethod -> CompressionMethod -> Bool
$c<= :: CompressionMethod -> CompressionMethod -> Bool
< :: CompressionMethod -> CompressionMethod -> Bool
$c< :: CompressionMethod -> CompressionMethod -> Bool
compare :: CompressionMethod -> CompressionMethod -> Ordering
$ccompare :: CompressionMethod -> CompressionMethod -> Ordering
Ord, Int -> CompressionMethod
CompressionMethod -> Int
CompressionMethod -> [CompressionMethod]
CompressionMethod -> CompressionMethod
CompressionMethod -> CompressionMethod -> [CompressionMethod]
CompressionMethod
-> CompressionMethod -> CompressionMethod -> [CompressionMethod]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CompressionMethod
-> CompressionMethod -> CompressionMethod -> [CompressionMethod]
$cenumFromThenTo :: CompressionMethod
-> CompressionMethod -> CompressionMethod -> [CompressionMethod]
enumFromTo :: CompressionMethod -> CompressionMethod -> [CompressionMethod]
$cenumFromTo :: CompressionMethod -> CompressionMethod -> [CompressionMethod]
enumFromThen :: CompressionMethod -> CompressionMethod -> [CompressionMethod]
$cenumFromThen :: CompressionMethod -> CompressionMethod -> [CompressionMethod]
enumFrom :: CompressionMethod -> [CompressionMethod]
$cenumFrom :: CompressionMethod -> [CompressionMethod]
fromEnum :: CompressionMethod -> Int
$cfromEnum :: CompressionMethod -> Int
toEnum :: Int -> CompressionMethod
$ctoEnum :: Int -> CompressionMethod
pred :: CompressionMethod -> CompressionMethod
$cpred :: CompressionMethod -> CompressionMethod
succ :: CompressionMethod -> CompressionMethod
$csucc :: CompressionMethod -> CompressionMethod
Enum, CompressionMethod
forall a. a -> a -> Bounded a
maxBound :: CompressionMethod
$cmaxBound :: CompressionMethod
minBound :: CompressionMethod
$cminBound :: CompressionMethod
Bounded, Typeable CompressionMethod
CompressionMethod -> DataType
CompressionMethod -> Constr
(forall b. Data b => b -> b)
-> CompressionMethod -> CompressionMethod
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> CompressionMethod -> u
forall u. (forall d. Data d => d -> u) -> CompressionMethod -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompressionMethod -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompressionMethod -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CompressionMethod -> m CompressionMethod
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompressionMethod -> m CompressionMethod
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CompressionMethod
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompressionMethod -> c CompressionMethod
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CompressionMethod)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompressionMethod)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompressionMethod -> m CompressionMethod
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompressionMethod -> m CompressionMethod
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompressionMethod -> m CompressionMethod
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> CompressionMethod -> m CompressionMethod
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CompressionMethod -> m CompressionMethod
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> CompressionMethod -> m CompressionMethod
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CompressionMethod -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> CompressionMethod -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> CompressionMethod -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CompressionMethod -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompressionMethod -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CompressionMethod -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompressionMethod -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CompressionMethod -> r
gmapT :: (forall b. Data b => b -> b)
-> CompressionMethod -> CompressionMethod
$cgmapT :: (forall b. Data b => b -> b)
-> CompressionMethod -> CompressionMethod
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompressionMethod)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c CompressionMethod)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CompressionMethod)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CompressionMethod)
dataTypeOf :: CompressionMethod -> DataType
$cdataTypeOf :: CompressionMethod -> DataType
toConstr :: CompressionMethod -> Constr
$ctoConstr :: CompressionMethod -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CompressionMethod
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CompressionMethod
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompressionMethod -> c CompressionMethod
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CompressionMethod -> c CompressionMethod
Data, Typeable)

----------------------------------------------------------------------------
-- Archive description

-- | The information about the archive as a whole.
data ArchiveDescription = ArchiveDescription
  { -- | The comment of the entire archive
    ArchiveDescription -> Maybe Text
adComment :: Maybe Text,
    -- | Absolute offset of the start of central directory
    ArchiveDescription -> Natural
adCDOffset :: Natural,
    -- | The size of central directory record
    ArchiveDescription -> Natural
adCDSize :: Natural
  }
  deriving (Int -> ArchiveDescription -> ShowS
[ArchiveDescription] -> ShowS
ArchiveDescription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArchiveDescription] -> ShowS
$cshowList :: [ArchiveDescription] -> ShowS
show :: ArchiveDescription -> String
$cshow :: ArchiveDescription -> String
showsPrec :: Int -> ArchiveDescription -> ShowS
$cshowsPrec :: Int -> ArchiveDescription -> ShowS
Show, ReadPrec [ArchiveDescription]
ReadPrec ArchiveDescription
Int -> ReadS ArchiveDescription
ReadS [ArchiveDescription]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ArchiveDescription]
$creadListPrec :: ReadPrec [ArchiveDescription]
readPrec :: ReadPrec ArchiveDescription
$creadPrec :: ReadPrec ArchiveDescription
readList :: ReadS [ArchiveDescription]
$creadList :: ReadS [ArchiveDescription]
readsPrec :: Int -> ReadS ArchiveDescription
$creadsPrec :: Int -> ReadS ArchiveDescription
Read, ArchiveDescription -> ArchiveDescription -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArchiveDescription -> ArchiveDescription -> Bool
$c/= :: ArchiveDescription -> ArchiveDescription -> Bool
== :: ArchiveDescription -> ArchiveDescription -> Bool
$c== :: ArchiveDescription -> ArchiveDescription -> Bool
Eq, Eq ArchiveDescription
ArchiveDescription -> ArchiveDescription -> Bool
ArchiveDescription -> ArchiveDescription -> Ordering
ArchiveDescription -> ArchiveDescription -> ArchiveDescription
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ArchiveDescription -> ArchiveDescription -> ArchiveDescription
$cmin :: ArchiveDescription -> ArchiveDescription -> ArchiveDescription
max :: ArchiveDescription -> ArchiveDescription -> ArchiveDescription
$cmax :: ArchiveDescription -> ArchiveDescription -> ArchiveDescription
>= :: ArchiveDescription -> ArchiveDescription -> Bool
$c>= :: ArchiveDescription -> ArchiveDescription -> Bool
> :: ArchiveDescription -> ArchiveDescription -> Bool
$c> :: ArchiveDescription -> ArchiveDescription -> Bool
<= :: ArchiveDescription -> ArchiveDescription -> Bool
$c<= :: ArchiveDescription -> ArchiveDescription -> Bool
< :: ArchiveDescription -> ArchiveDescription -> Bool
$c< :: ArchiveDescription -> ArchiveDescription -> Bool
compare :: ArchiveDescription -> ArchiveDescription -> Ordering
$ccompare :: ArchiveDescription -> ArchiveDescription -> Ordering
Ord, Typeable, Typeable ArchiveDescription
ArchiveDescription -> DataType
ArchiveDescription -> Constr
(forall b. Data b => b -> b)
-> ArchiveDescription -> ArchiveDescription
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> ArchiveDescription -> u
forall u. (forall d. Data d => d -> u) -> ArchiveDescription -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArchiveDescription -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArchiveDescription -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ArchiveDescription -> m ArchiveDescription
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ArchiveDescription -> m ArchiveDescription
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArchiveDescription
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ArchiveDescription
-> c ArchiveDescription
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ArchiveDescription)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ArchiveDescription)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ArchiveDescription -> m ArchiveDescription
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ArchiveDescription -> m ArchiveDescription
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ArchiveDescription -> m ArchiveDescription
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ArchiveDescription -> m ArchiveDescription
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ArchiveDescription -> m ArchiveDescription
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ArchiveDescription -> m ArchiveDescription
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ArchiveDescription -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ArchiveDescription -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ArchiveDescription -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ArchiveDescription -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArchiveDescription -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArchiveDescription -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArchiveDescription -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArchiveDescription -> r
gmapT :: (forall b. Data b => b -> b)
-> ArchiveDescription -> ArchiveDescription
$cgmapT :: (forall b. Data b => b -> b)
-> ArchiveDescription -> ArchiveDescription
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ArchiveDescription)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ArchiveDescription)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ArchiveDescription)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ArchiveDescription)
dataTypeOf :: ArchiveDescription -> DataType
$cdataTypeOf :: ArchiveDescription -> DataType
toConstr :: ArchiveDescription -> Constr
$ctoConstr :: ArchiveDescription -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArchiveDescription
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArchiveDescription
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ArchiveDescription
-> c ArchiveDescription
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> ArchiveDescription
-> c ArchiveDescription
Data)

----------------------------------------------------------------------------
-- Exceptions

-- | The bad things that can happen when you use the library.
data ZipException
  = -- | Thrown when you try to get contents of non-existing entry
    EntryDoesNotExist FilePath EntrySelector
  | -- | Thrown when attempting to decompress an entry compressed with an
    -- unsupported compression method or the library is compiled without
    -- support for it.
    --
    -- @since 2.0.0
    UnsupportedCompressionMethod CompressionMethod
  | -- | Thrown when archive structure cannot be parsed.
    ParsingFailed FilePath String
  deriving (ZipException -> ZipException -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ZipException -> ZipException -> Bool
$c/= :: ZipException -> ZipException -> Bool
== :: ZipException -> ZipException -> Bool
$c== :: ZipException -> ZipException -> Bool
Eq, Eq ZipException
ZipException -> ZipException -> Bool
ZipException -> ZipException -> Ordering
ZipException -> ZipException -> ZipException
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ZipException -> ZipException -> ZipException
$cmin :: ZipException -> ZipException -> ZipException
max :: ZipException -> ZipException -> ZipException
$cmax :: ZipException -> ZipException -> ZipException
>= :: ZipException -> ZipException -> Bool
$c>= :: ZipException -> ZipException -> Bool
> :: ZipException -> ZipException -> Bool
$c> :: ZipException -> ZipException -> Bool
<= :: ZipException -> ZipException -> Bool
$c<= :: ZipException -> ZipException -> Bool
< :: ZipException -> ZipException -> Bool
$c< :: ZipException -> ZipException -> Bool
compare :: ZipException -> ZipException -> Ordering
$ccompare :: ZipException -> ZipException -> Ordering
Ord, Typeable)

instance Show ZipException where
  show :: ZipException -> String
show (EntryDoesNotExist String
file EntrySelector
s) =
    String
"No such entry found: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show EntrySelector
s forall a. [a] -> [a] -> [a]
++ String
" in " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
file
  show (ParsingFailed String
file String
msg) =
    String
"Parsing of archive structure failed: \n" forall a. [a] -> [a] -> [a]
++ String
msg forall a. [a] -> [a] -> [a]
++ String
"\nin " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
file
  show (UnsupportedCompressionMethod CompressionMethod
method) =
    String
"Encountered a zipfile entry with "
      forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show CompressionMethod
method
      forall a. [a] -> [a] -> [a]
++ String
" compression, but "
      forall a. [a] -> [a] -> [a]
++ String
"zip library does not support it or has been built without support for it."

instance Exception ZipException