module Codec.Archive.Zip.Conduit.Types where

import           Control.Exception (Exception(..))
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Conduit as C
import           Data.Conduit.Binary (sourceLbs)
import           Data.Semigroup (Semigroup(..))
import           Data.String (IsString(..))
import qualified Data.Text as T
import           Data.Time.LocalTime (LocalTime)
import           Data.Typeable (Typeable)
import           Data.Word (Word32, Word64)

-- |Errors thrown during zip file processing
newtype ZipError = ZipError String
  deriving (Int -> ZipError -> ShowS
[ZipError] -> ShowS
ZipError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ZipError] -> ShowS
$cshowList :: [ZipError] -> ShowS
show :: ZipError -> String
$cshow :: ZipError -> String
showsPrec :: Int -> ZipError -> ShowS
$cshowsPrec :: Int -> ZipError -> ShowS
Show, Typeable)

instance IsString ZipError where
  fromString :: String -> ZipError
fromString = String -> ZipError
ZipError

instance Exception ZipError where
  displayException :: ZipError -> String
displayException (ZipError String
e) = String
"ZipError: " forall a. [a] -> [a] -> [a]
++ String
e

-- |Summary information at the end of a zip stream.
data ZipInfo = ZipInfo
  { ZipInfo -> ByteString
zipComment :: ByteString
  } deriving (ZipInfo -> ZipInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ZipInfo -> ZipInfo -> Bool
$c/= :: ZipInfo -> ZipInfo -> Bool
== :: ZipInfo -> ZipInfo -> Bool
$c== :: ZipInfo -> ZipInfo -> Bool
Eq, Int -> ZipInfo -> ShowS
[ZipInfo] -> ShowS
ZipInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ZipInfo] -> ShowS
$cshowList :: [ZipInfo] -> ShowS
show :: ZipInfo -> String
$cshow :: ZipInfo -> String
showsPrec :: Int -> ZipInfo -> ShowS
$cshowsPrec :: Int -> ZipInfo -> ShowS
Show)

-- |(The beginning of) a single entry in a zip stream, which may be any file or directory.
-- As per zip file conventions, directory names should end with a slash and have no data, but this library does not ensure that.
data ZipEntry = ZipEntry
  { ZipEntry -> Either Text ByteString
zipEntryName :: Either T.Text ByteString -- ^File name (in posix format, no leading slashes), either UTF-8 encoded text or raw bytes (CP437), with a trailing slash for directories
  , ZipEntry -> LocalTime
zipEntryTime :: LocalTime -- ^Modification time
  , ZipEntry -> Maybe Word64
zipEntrySize :: Maybe Word64 -- ^Size of file data (if known); checked on zipping and also used as hint to enable zip64. Disables compression for known 0-byte files.
  , ZipEntry -> Maybe Word32
zipEntryExternalAttributes :: Maybe Word32 -- ^Host-dependent attributes, often MS-DOS directory attribute byte (only supported when zipping)
  } deriving (ZipEntry -> ZipEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ZipEntry -> ZipEntry -> Bool
$c/= :: ZipEntry -> ZipEntry -> Bool
== :: ZipEntry -> ZipEntry -> Bool
$c== :: ZipEntry -> ZipEntry -> Bool
Eq, Int -> ZipEntry -> ShowS
[ZipEntry] -> ShowS
ZipEntry -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ZipEntry] -> ShowS
$cshowList :: [ZipEntry] -> ShowS
show :: ZipEntry -> String
$cshow :: ZipEntry -> String
showsPrec :: Int -> ZipEntry -> ShowS
$cshowsPrec :: Int -> ZipEntry -> ShowS
Show)

-- |The data contents for a 'ZipEntry'. For empty entries (e.g., directories), use 'mempty'.
data ZipData m
  = ZipDataByteString BSL.ByteString -- ^A known ByteString, which will be fully evaluated (not streamed)
  | ZipDataSource (C.ConduitM () ByteString m ()) -- ^A byte stream producer, streamed (and compressed) directly into the zip

instance Monad m => Semigroup (ZipData m) where
  ZipDataByteString ByteString
a <> :: ZipData m -> ZipData m -> ZipData m
<> ZipDataByteString ByteString
b = forall (m :: * -> *). ByteString -> ZipData m
ZipDataByteString forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a -> a -> a
mappend ByteString
a ByteString
b
  ZipData m
a <> ZipData m
b = forall (m :: * -> *). ConduitM () ByteString m () -> ZipData m
ZipDataSource forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a -> a -> a
mappend (forall (m :: * -> *).
Monad m =>
ZipData m -> ConduitM () ByteString m ()
sourceZipData ZipData m
a) (forall (m :: * -> *).
Monad m =>
ZipData m -> ConduitM () ByteString m ()
sourceZipData ZipData m
b)

instance Monad m => Monoid (ZipData m) where
  mempty :: ZipData m
mempty = forall (m :: * -> *). ByteString -> ZipData m
ZipDataByteString ByteString
BSL.empty
  mappend :: ZipData m -> ZipData m -> ZipData m
mappend = forall a. Semigroup a => a -> a -> a
(<>)

-- |Normalize any 'ZipData' to a simple source
sourceZipData :: Monad m => ZipData m -> C.ConduitM () ByteString m ()
sourceZipData :: forall (m :: * -> *).
Monad m =>
ZipData m -> ConduitM () ByteString m ()
sourceZipData (ZipDataByteString ByteString
b) = forall (m :: * -> *) i.
Monad m =>
ByteString -> ConduitT i ByteString m ()
sourceLbs ByteString
b
sourceZipData (ZipDataSource ConduitM () ByteString m ()
s) = ConduitM () ByteString m ()
s

-- |Convert between unpacked (as 'Codec.Archive.Zip.Conduit.UnZip.unZipStream' produces) and packed (as 'Codec.Archive.Zip.Conduit.Zip.zipStream' consumes) representations.
-- This is mainly for testing purposes, or if you really want to re-zip a stream on the fly for some reason.
-- Note that each 'ZipData' must be consumed completely before the next entry can be produced.
-- packZipEntries :: C.Conduit (Either ZipEntry BS.ByteString) m (ZipEntry, ZipData m)