{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}
{-|
Module      : HsLua.Module.Zip
Copyright   : © 2022-2024 Albert Krewinkel
License     : MIT
Maintainer  : Albert Krewinkel <tarleb@hslua.org>

Lua module to work with file zips.
-}
module HsLua.Module.Zip (
  -- * Module
    documentedModule

  -- * Zip archives
  , typeArchive
  , mkArchive
  , read_entry
  , zip
  -- ** archive methods
  , extract
  , bytestring
  -- * Zip entry
  , typeEntry
  , peekEntryFuzzy
  -- ** entry methods
  , contents
  -- * Zip Options
  , peekZipOptions
  )
where

import Prelude hiding (zip)
import Control.Applicative (optional)
import Control.Monad ((<$!>))
import Codec.Archive.Zip (Archive, Entry, ZipOption (..), emptyArchive)
import Data.Functor ((<&>))
import Data.Maybe (catMaybes, fromMaybe)
import Data.Time.Clock.POSIX (getPOSIXTime)
import Data.Version (Version, makeVersion)
import HsLua.Core
  ( LuaError, NumArgs (..), NumResults (..), Type(..), call, failLua
  , fromStackIndex, getfield, gettop, replace, liftIO, ltype
  , nth, nthBottom, setmetatable )
import HsLua.List (newListMetatable)
import HsLua.Marshalling
  ( Peeker, Pusher, choice, failPeek, liftLua, peekBool
  , peekFieldRaw, peekIntegral, peekLazyByteString, peekList, peekString
  , pushLazyByteString, pushList, pushIntegral, pushString
  , retrieving, typeMismatchMessage )
import HsLua.Packaging
import HsLua.Typing

import qualified Codec.Archive.Zip as Zip
import qualified Data.Text as T


-- | The @zip@ module specification.
documentedModule :: forall e. LuaError e => Module e
documentedModule :: forall e. LuaError e => Module e
documentedModule = Module
  { moduleName :: Name
moduleName = Name
"zip"
  , moduleDescription :: Text
moduleDescription = [Text] -> Text
T.unlines
    [ Text
"Functions to create, modify, and extract files from zip archives."
    , Text
""
    , Text
"The module can be called as a function, in which case it behaves"
    , Text
"like the `zip` function described below."
    , Text
""
    , Text
"Zip options are optional; when defined, they must be a table with"
    , Text
"any of the following keys:"
    , Text
""
    , Text
"  - `recursive`: recurse directories when set to `true`;"
    , Text
"  - `verbose`: print info messages to stdout;"
    , Text
"  - `destination`: the value specifies the directory in which to"
    , Text
"    extract;"
    , Text
"  - `location`: value is used as path name, defining where files"
    , Text
"    are placed."
    , Text
"  - `preserve_symlinks`: Boolean value, controlling whether"
    , Text
"    symbolic links are preserved as such. This option is ignored"
    , Text
"    on Windows."
    ]
  , moduleFields :: [Field e]
moduleFields = [Field e]
forall e. [Field e]
fields
  , moduleFunctions :: [DocumentedFunction e]
moduleFunctions = [DocumentedFunction e]
forall e. LuaError e => [DocumentedFunction e]
functions
  , moduleOperations :: [(Operation, DocumentedFunction e)]
moduleOperations =
    [ Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Call (DocumentedFunction e -> (Operation, DocumentedFunction e))
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
forall a b. (a -> b) -> a -> b
$ LuaE e NumResults -> HsFnPrecursor e (LuaE e NumResults)
forall a e. a -> HsFnPrecursor e a
lambda
      ### (do
              -- call function `zip`
              _ <- getfield (nthBottom 1) (functionName @e zip)
              replace (nthBottom 1)
              nargs <- NumArgs . subtract 1 . fromStackIndex <$> gettop
              call nargs 1
              pure (NumResults 1))
      HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
=?> Text
"new Archive"
    ]
  , moduleTypeInitializers :: [LuaE e Name]
moduleTypeInitializers =
      [ DocumentedTypeWithList e Archive Void -> LuaE e Name
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> LuaE e Name
initType DocumentedTypeWithList e Archive Void
forall e. LuaError e => DocumentedType e Archive
typeArchive
      , DocumentedTypeWithList e Entry Void -> LuaE e Name
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> LuaE e Name
initType DocumentedTypeWithList e Entry Void
forall e. LuaError e => DocumentedType e Entry
typeEntry
      ]
  }

-- | First published version of this library.
initialVersion :: Version
initialVersion :: Version
initialVersion = [Int] -> Version
makeVersion [Int
1,Int
0,Int
0]

--
-- Fields
--

-- | Exported fields.
fields :: [Field e]
fields :: forall e. [Field e]
fields = []


--
-- Functions
--

-- | Exported functions
functions :: LuaError e => [DocumentedFunction e]
functions :: forall e. LuaError e => [DocumentedFunction e]
functions =
  [ DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
mkArchive
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
mkEntry
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
read_entry
  , DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
zip
  ]

-- | Creates a new 'Archive' from a list of files.
zip :: LuaError e => DocumentedFunction e
zip :: forall e. LuaError e => DocumentedFunction e
zip = Name
-> ([FilePath] -> Maybe [ZipOption] -> LuaE e Archive)
-> HsFnPrecursor
     e ([FilePath] -> Maybe [ZipOption] -> LuaE e Archive)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"zip"
  ### (\filepaths mopts ->
         let opts = fromMaybe [] mopts
         in liftIO $! Zip.addFilesToArchive opts emptyArchive filepaths)
  HsFnPrecursor e ([FilePath] -> Maybe [ZipOption] -> LuaE e Archive)
-> Parameter e [FilePath]
-> HsFnPrecursor e (Maybe [ZipOption] -> LuaE e Archive)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e [FilePath]
-> TypeSpec -> Text -> Text -> Parameter e [FilePath]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter (Peeker e FilePath -> Peeker e [FilePath]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e FilePath
forall e. Peeker e FilePath
peekString) TypeSpec
"{string,...}"
       Text
"filepaths" Text
"list of files from which the archive is created."
  HsFnPrecursor e (Maybe [ZipOption] -> LuaE e Archive)
-> Parameter e (Maybe [ZipOption])
-> HsFnPrecursor e (LuaE e Archive)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e [ZipOption] -> Parameter e (Maybe [ZipOption])
forall e a. Parameter e a -> Parameter e (Maybe a)
opt (Peeker e [ZipOption]
-> TypeSpec -> Text -> Text -> Parameter e [ZipOption]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e [ZipOption]
forall e. LuaError e => Peeker e [ZipOption]
peekZipOptions TypeSpec
"table" Text
"opts" Text
"zip options")
  HsFnPrecursor e (LuaE e Archive)
-> FunctionResults e Archive -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> DocumentedTypeWithList e Archive Void
-> Text -> FunctionResults e Archive
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> Text -> FunctionResults e a
udresult DocumentedTypeWithList e Archive Void
forall e. LuaError e => DocumentedType e Archive
typeArchive Text
"a new archive"
  #? T.unlines
     [ "Package and compress the given files into a new Archive." ]
  DocumentedFunction e -> Version -> DocumentedFunction e
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` Version
initialVersion

-- | Creates a new 'ZipEntry' from a file; wraps 'Zip.readEntry'.
read_entry :: LuaError e => DocumentedFunction e
read_entry :: forall e. LuaError e => DocumentedFunction e
read_entry = Name
-> (FilePath -> Maybe [ZipOption] -> LuaE e Entry)
-> HsFnPrecursor e (FilePath -> Maybe [ZipOption] -> LuaE e Entry)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"read_entry"
  ### (\filepath mopts -> liftIO $! Zip.readEntry (fromMaybe [] mopts) filepath)
  HsFnPrecursor e (FilePath -> Maybe [ZipOption] -> LuaE e Entry)
-> Parameter e FilePath
-> HsFnPrecursor e (Maybe [ZipOption] -> LuaE e Entry)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e FilePath
-> TypeSpec -> Text -> Text -> Parameter e FilePath
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e FilePath
forall e. Peeker e FilePath
peekString TypeSpec
"string" Text
"filepath" Text
""
  HsFnPrecursor e (Maybe [ZipOption] -> LuaE e Entry)
-> Parameter e (Maybe [ZipOption])
-> HsFnPrecursor e (LuaE e Entry)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e [ZipOption] -> Parameter e (Maybe [ZipOption])
forall e a. Parameter e a -> Parameter e (Maybe a)
opt (Peeker e [ZipOption]
-> TypeSpec -> Text -> Text -> Parameter e [ZipOption]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e [ZipOption]
forall e. LuaError e => Peeker e [ZipOption]
peekZipOptions TypeSpec
"table" Text
"opts" Text
"zip options")
  HsFnPrecursor e (LuaE e Entry)
-> FunctionResults e Entry -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> DocumentedTypeWithList e Entry Void
-> Text -> FunctionResults e Entry
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> Text -> FunctionResults e a
udresult DocumentedTypeWithList e Entry Void
forall e. LuaError e => DocumentedType e Entry
typeEntry Text
"a new zip archive entry"
  #? T.unlines
     [ "Generates a ZipEntry from a file or directory."
     ]
  DocumentedFunction e -> Version -> DocumentedFunction e
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` Version
initialVersion

--
-- * Options
--
peekZipOptions :: LuaError e => Peeker e [ZipOption]
peekZipOptions :: forall e. LuaError e => Peeker e [ZipOption]
peekZipOptions = Name -> Peek e [ZipOption] -> Peek e [ZipOption]
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Zip options" (Peek e [ZipOption] -> Peek e [ZipOption])
-> (StackIndex -> Peek e [ZipOption])
-> StackIndex
-> Peek e [ZipOption]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \StackIndex
idx -> [Maybe ZipOption] -> [ZipOption]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe ZipOption] -> [ZipOption])
-> Peek e [Maybe ZipOption] -> Peek e [ZipOption]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Peek e (Maybe ZipOption)] -> Peek e [Maybe ZipOption]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
  [ Peek e Bool -> Peek e (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peeker e Bool -> Name -> Peeker e Bool
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e Bool
forall e. Peeker e Bool
peekBool Name
"recursive" StackIndex
idx) Peek e (Maybe Bool)
-> (Maybe Bool -> Maybe ZipOption) -> Peek e (Maybe ZipOption)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      Just Bool
True -> ZipOption -> Maybe ZipOption
forall a. a -> Maybe a
Just ZipOption
OptRecursive
      Maybe Bool
_         -> Maybe ZipOption
forall a. Maybe a
Nothing
  , Peek e Bool -> Peek e (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peeker e Bool -> Name -> Peeker e Bool
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e Bool
forall e. Peeker e Bool
peekBool Name
"verbose" StackIndex
idx) Peek e (Maybe Bool)
-> (Maybe Bool -> Maybe ZipOption) -> Peek e (Maybe ZipOption)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      Just Bool
True -> ZipOption -> Maybe ZipOption
forall a. a -> Maybe a
Just ZipOption
OptVerbose
      Maybe Bool
_         -> Maybe ZipOption
forall a. Maybe a
Nothing
  , Peek e FilePath -> Peek e (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peeker e FilePath -> Name -> Peeker e FilePath
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e FilePath
forall e. Peeker e FilePath
peekString Name
"destination" StackIndex
idx) Peek e (Maybe FilePath)
-> (Maybe FilePath -> Maybe ZipOption) -> Peek e (Maybe ZipOption)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      Just FilePath
fp -> ZipOption -> Maybe ZipOption
forall a. a -> Maybe a
Just (FilePath -> ZipOption
OptDestination FilePath
fp)
      Maybe FilePath
_       -> Maybe ZipOption
forall a. Maybe a
Nothing
  , Peek e FilePath -> Peek e (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peeker e FilePath -> Name -> Peeker e FilePath
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e FilePath
forall e. Peeker e FilePath
peekString Name
"location" StackIndex
idx) Peek e (Maybe FilePath)
-> (Maybe FilePath -> Maybe ZipOption) -> Peek e (Maybe ZipOption)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      Just FilePath
fp -> ZipOption -> Maybe ZipOption
forall a. a -> Maybe a
Just (FilePath -> Bool -> ZipOption
OptLocation FilePath
fp Bool
True)
      Maybe FilePath
_       -> Maybe ZipOption
forall a. Maybe a
Nothing
  , Peek e Bool -> Peek e (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peeker e Bool -> Name -> Peeker e Bool
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e Bool
forall e. Peeker e Bool
peekBool Name
"preserve_symlinks" StackIndex
idx) Peek e (Maybe Bool)
-> (Maybe Bool -> Maybe ZipOption) -> Peek e (Maybe ZipOption)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      Just Bool
True -> (ZipOption -> Maybe ZipOption
forall a. a -> Maybe a
Just ZipOption
OptPreserveSymbolicLinks)
      Maybe Bool
_         -> Maybe ZipOption
forall a. Maybe a
Nothing
  ]

--
-- * Archive
--

-- | The Lua 'Archive' type
typeArchive :: forall e. LuaError e => DocumentedType e Archive
typeArchive :: forall e. LuaError e => DocumentedType e Archive
typeArchive = Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) Archive]
-> DocumentedType e Archive
forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"zip.Archive"
  []
  [ Name
-> TypeSpec
-> Text
-> (Pusher e [Entry], Archive -> [Entry])
-> (Peeker e [Entry], Archive -> [Entry] -> Archive)
-> Member e (DocumentedFunction e) Archive
forall e b a fn.
LuaError e =>
Name
-> TypeSpec
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property' Name
"entries" (TypeSpec -> TypeSpec
seqType (forall e fn a itemtype. UDTypeWithList e fn a itemtype -> TypeSpec
udTypeSpec @e UDTypeWithList e (DocumentedFunction e) Entry Void
forall e. LuaError e => DocumentedType e Entry
typeEntry))
    Text
"Files in this zip archive"
    (Pusher e [Entry]
forall e. LuaError e => Pusher e [Entry]
pushEntries, Archive -> [Entry]
Zip.zEntries)
    (Peeker e Entry -> Peeker e [Entry]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Entry
forall e. LuaError e => Peeker e Entry
peekEntryFuzzy, \Archive
ar [Entry]
entries -> Archive
ar { Zip.zEntries = entries })
  , DocumentedFunction e -> Member e (DocumentedFunction e) Archive
forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
extract
  , DocumentedFunction e -> Member e (DocumentedFunction e) Archive
forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
bytestring
  ]

-- | Wrapper for 'Zip.toArchive'; converts a string into an Archive.
mkArchive :: forall e. LuaError e => DocumentedFunction e
mkArchive :: forall e. LuaError e => DocumentedFunction e
mkArchive = Name
-> (Maybe (Either ByteString [Entry]) -> LuaE e Archive)
-> HsFnPrecursor
     e (Maybe (Either ByteString [Entry]) -> LuaE e Archive)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Archive"
  ### (\case
          Nothing                ->
            pure Zip.emptyArchive
          Just (Left bytestring') ->
            either failLua pure $ Zip.toArchiveOrFail bytestring'
          Just (Right entries)   ->
            pure $ foldr Zip.addEntryToArchive emptyArchive entries)
  HsFnPrecursor
  e (Maybe (Either ByteString [Entry]) -> LuaE e Archive)
-> Parameter e (Maybe (Either ByteString [Entry]))
-> HsFnPrecursor e (LuaE e Archive)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e (Either ByteString [Entry])
-> Parameter e (Maybe (Either ByteString [Entry]))
forall e a. Parameter e a -> Parameter e (Maybe a)
opt (Peeker e (Either ByteString [Entry])
-> TypeSpec
-> Text
-> Text
-> Parameter e (Either ByteString [Entry])
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter ([Peeker e (Either ByteString [Entry])]
-> Peeker e (Either ByteString [Entry])
forall e a. LuaError e => [Peeker e a] -> Peeker e a
choice [ (ByteString -> Either ByteString [Entry])
-> Peek e ByteString -> Peek e (Either ByteString [Entry])
forall a b. (a -> b) -> Peek e a -> Peek e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Either ByteString [Entry]
forall a b. a -> Either a b
Left  (Peek e ByteString -> Peek e (Either ByteString [Entry]))
-> (StackIndex -> Peek e ByteString)
-> Peeker e (Either ByteString [Entry])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e ByteString
forall e. Peeker e ByteString
peekLazyByteString
                             , ([Entry] -> Either ByteString [Entry])
-> Peek e [Entry] -> Peek e (Either ByteString [Entry])
forall a b. (a -> b) -> Peek e a -> Peek e b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Entry] -> Either ByteString [Entry]
forall a b. b -> Either a b
Right (Peek e [Entry] -> Peek e (Either ByteString [Entry]))
-> (StackIndex -> Peek e [Entry])
-> Peeker e (Either ByteString [Entry])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peeker e Entry -> StackIndex -> Peek e [Entry]
forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList Peeker e Entry
forall e. LuaError e => Peeker e Entry
peekEntryFuzzy ])
           (TypeSpec
stringType TypeSpec -> TypeSpec -> TypeSpec
#|# TypeSpec -> TypeSpec
seqType (forall e fn a itemtype. UDTypeWithList e fn a itemtype -> TypeSpec
udTypeSpec @e UDTypeWithList e (DocumentedFunction e) Entry Void
forall e. LuaError e => DocumentedType e Entry
typeEntry))
           Text
"bytestring_or_entries"
           Text
"binary archive data or list of entries; defaults to an empty list")
  HsFnPrecursor e (LuaE e Archive)
-> FunctionResults e Archive -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> DocumentedTypeWithList e Archive Void
-> Text -> FunctionResults e Archive
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> Text -> FunctionResults e a
udresult DocumentedTypeWithList e Archive Void
forall e. LuaError e => DocumentedType e Archive
typeArchive Text
"new Archive"
  #? T.unlines
     [ "Reads an *Archive* structure from a raw zip archive or a list of"
     , "Entry items; throws an error if the given string cannot be decoded"
     , "into an archive."
     ]
  DocumentedFunction e -> Version -> DocumentedFunction e
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` Version
initialVersion

-- | Returns the raw binary string representation of the archive;
-- wraps 'Zip.extractFilesFromArchive'
extract :: LuaError e => DocumentedFunction e
extract :: forall e. LuaError e => DocumentedFunction e
extract = Name
-> (Archive -> Maybe [ZipOption] -> LuaE e ())
-> HsFnPrecursor e (Archive -> Maybe [ZipOption] -> LuaE e ())
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"extract"
  ### (\archive mopts ->
         liftIO $! Zip.extractFilesFromArchive (fromMaybe [] mopts) archive)
  HsFnPrecursor e (Archive -> Maybe [ZipOption] -> LuaE e ())
-> Parameter e Archive
-> HsFnPrecursor e (Maybe [ZipOption] -> LuaE e ())
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> DocumentedTypeWithList e Archive Void
-> Text -> Text -> Parameter e Archive
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam DocumentedTypeWithList e Archive Void
forall e. LuaError e => DocumentedType e Archive
typeArchive Text
"self" Text
""
  HsFnPrecursor e (Maybe [ZipOption] -> LuaE e ())
-> Parameter e (Maybe [ZipOption]) -> HsFnPrecursor e (LuaE e ())
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e [ZipOption] -> Parameter e (Maybe [ZipOption])
forall e a. Parameter e a -> Parameter e (Maybe a)
opt (Peeker e [ZipOption]
-> TypeSpec -> Text -> Text -> Parameter e [ZipOption]
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e [ZipOption]
forall e. LuaError e => Peeker e [ZipOption]
peekZipOptions TypeSpec
"table" Text
"opts" Text
"zip options")
  HsFnPrecursor e (LuaE e ())
-> FunctionResults e () -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> []
  #? T.unlines
     [ "Extract all files from this archive, creating directories as needed."
     , "Note that the last-modified time is set correctly only in POSIX, not"
     , "in Windows. This function fails if encrypted entries are present."
     ]

-- | Returns the raw binary string representation of the archive.
bytestring :: LuaError e => DocumentedFunction e
bytestring :: forall e. LuaError e => DocumentedFunction e
bytestring = Name
-> (Archive -> LuaE e ByteString)
-> HsFnPrecursor e (Archive -> LuaE e ByteString)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"bytestring"
  ### liftPure Zip.fromArchive
  HsFnPrecursor e (Archive -> LuaE e ByteString)
-> Parameter e Archive -> HsFnPrecursor e (LuaE e ByteString)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> DocumentedTypeWithList e Archive Void
-> Text -> Text -> Parameter e Archive
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam DocumentedTypeWithList e Archive Void
forall e. LuaError e => DocumentedType e Archive
typeArchive Text
"self" Text
""
  HsFnPrecursor e (LuaE e ByteString)
-> FunctionResults e ByteString -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e ByteString
-> TypeSpec -> Text -> FunctionResults e ByteString
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e ByteString
forall e. Pusher e ByteString
pushLazyByteString TypeSpec
"string" Text
"bytes of the archive"
  #? "Returns the raw binary string representation of the archive."

--
-- * Entry
--

-- | The Lua type for 'Entry' objects.
typeEntry :: forall e. LuaError e => DocumentedType e Entry
typeEntry :: forall e. LuaError e => DocumentedType e Entry
typeEntry = Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) Entry]
-> DocumentedType e Entry
forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"zip.Entry"
  []
  [ Name
-> TypeSpec
-> Text
-> (Pusher e FilePath, Entry -> FilePath)
-> (Peeker e FilePath, Entry -> FilePath -> Entry)
-> Member e (DocumentedFunction e) Entry
forall e b a fn.
LuaError e =>
Name
-> TypeSpec
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property' Name
"path" (forall e fn a itemtype. UDTypeWithList e fn a itemtype -> TypeSpec
udTypeSpec @e DocumentedType e Entry
forall e. LuaError e => DocumentedType e Entry
typeEntry)
    Text
"Relative path, using `/` as separator"
    (Pusher e FilePath
forall e. FilePath -> LuaE e ()
pushString, Entry -> FilePath
Zip.eRelativePath)
    (Peeker e FilePath
forall e. Peeker e FilePath
peekString, \Entry
entry FilePath
path -> Entry
entry { Zip.eRelativePath = path })
  , Name
-> TypeSpec
-> Text
-> (Pusher e Integer, Entry -> Integer)
-> (Peeker e Integer, Entry -> Integer -> Entry)
-> Member e (DocumentedFunction e) Entry
forall e b a fn.
LuaError e =>
Name
-> TypeSpec
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property' Name
"modtime" TypeSpec
integerType
    Text
"Modification time (seconds since unix epoch)"
    (Pusher e Integer
forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, Entry -> Integer
Zip.eLastModified)
    (Peeker e Integer
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \Entry
entry Integer
modtime -> Entry
entry { Zip.eLastModified = modtime})
  , DocumentedFunction e -> Member e (DocumentedFunction e) Entry
forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method DocumentedFunction e
forall e. LuaError e => DocumentedFunction e
contents
  ]

-- | Creates a new 'ZipEntry' from a file; wraps 'Zip.readEntry'.
mkEntry :: LuaError e => DocumentedFunction e
mkEntry :: forall e. LuaError e => DocumentedFunction e
mkEntry = Name
-> (FilePath -> ByteString -> Maybe Integer -> LuaE e Entry)
-> HsFnPrecursor
     e (FilePath -> ByteString -> Maybe Integer -> LuaE e Entry)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"Entry"
  ### (\filepath contents' mmodtime -> do
          modtime <- maybe (floor <$> liftIO getPOSIXTime) pure mmodtime
          pure $ Zip.toEntry filepath modtime contents')
  HsFnPrecursor
  e (FilePath -> ByteString -> Maybe Integer -> LuaE e Entry)
-> Parameter e FilePath
-> HsFnPrecursor e (ByteString -> Maybe Integer -> LuaE e Entry)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e FilePath
-> TypeSpec -> Text -> Text -> Parameter e FilePath
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e FilePath
forall e. Peeker e FilePath
peekString TypeSpec
"string" Text
"path" Text
"file path in archive"
  HsFnPrecursor e (ByteString -> Maybe Integer -> LuaE e Entry)
-> Parameter e ByteString
-> HsFnPrecursor e (Maybe Integer -> LuaE e Entry)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Peeker e ByteString
-> TypeSpec -> Text -> Text -> Parameter e ByteString
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e ByteString
forall e. Peeker e ByteString
peekLazyByteString TypeSpec
"string" Text
"contents" Text
"uncompressed contents"
  HsFnPrecursor e (Maybe Integer -> LuaE e Entry)
-> Parameter e (Maybe Integer) -> HsFnPrecursor e (LuaE e Entry)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e Integer -> Parameter e (Maybe Integer)
forall e a. Parameter e a -> Parameter e (Maybe a)
opt (Peeker e Integer -> TypeSpec -> Text -> Text -> Parameter e Integer
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e Integer
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral TypeSpec
"integer" Text
"modtime" Text
"modification time")
  HsFnPrecursor e (LuaE e Entry)
-> FunctionResults e Entry -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> DocumentedTypeWithList e Entry Void
-> Text -> FunctionResults e Entry
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> Text -> FunctionResults e a
udresult DocumentedTypeWithList e Entry Void
forall e. LuaError e => DocumentedType e Entry
typeEntry Text
"a new zip archive entry"
  #? T.unlines
     [ "Generates a ZipEntry from a filepath, uncompressed content, and"
     , "the file's modification time."
     ]
  DocumentedFunction e -> Version -> DocumentedFunction e
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` Version
initialVersion

-- | Returns the uncompressed contents of a zip entry.
contents :: LuaError e => DocumentedFunction e
contents :: forall e. LuaError e => DocumentedFunction e
contents = Name
-> (Entry -> Maybe FilePath -> LuaE e ByteString)
-> HsFnPrecursor e (Entry -> Maybe FilePath -> LuaE e ByteString)
forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"contents"
  ### (\entry mpasswd -> case mpasswd of
          Nothing -> return $! Zip.fromEntry entry
          Just passwd -> case Zip.fromEncryptedEntry passwd entry of
            Just contents' -> return $! contents'
            Nothing        -> failLua "Could not decrypt entry.")
  HsFnPrecursor e (Entry -> Maybe FilePath -> LuaE e ByteString)
-> Parameter e Entry
-> HsFnPrecursor e (Maybe FilePath -> LuaE e ByteString)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> DocumentedTypeWithList e Entry Void
-> Text -> Text -> Parameter e Entry
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam DocumentedTypeWithList e Entry Void
forall e. LuaError e => DocumentedType e Entry
typeEntry Text
"self" Text
""
  HsFnPrecursor e (Maybe FilePath -> LuaE e ByteString)
-> Parameter e (Maybe FilePath)
-> HsFnPrecursor e (LuaE e ByteString)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> Parameter e FilePath -> Parameter e (Maybe FilePath)
forall e a. Parameter e a -> Parameter e (Maybe a)
opt (Peeker e FilePath
-> TypeSpec -> Text -> Text -> Parameter e FilePath
forall e a. Peeker e a -> TypeSpec -> Text -> Text -> Parameter e a
parameter Peeker e FilePath
forall e. Peeker e FilePath
peekString TypeSpec
"string" Text
"password" Text
"password for entry")
  HsFnPrecursor e (LuaE e ByteString)
-> FunctionResults e ByteString -> DocumentedFunction e
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> Pusher e ByteString
-> TypeSpec -> Text -> FunctionResults e ByteString
forall e a. Pusher e a -> TypeSpec -> Text -> FunctionResults e a
functionResult Pusher e ByteString
forall e. Pusher e ByteString
pushLazyByteString TypeSpec
"string" Text
"binary contents"
  #? T.unlines
     [ "Get the uncompressed contents of a zip entry. If `password` is given,"
     , "then that password is used to decrypt the contents. An error is throws"
     , "if decrypting fails."
     ]

peekEntryFuzzy :: LuaError e => Peeker e Entry
peekEntryFuzzy :: forall e. LuaError e => Peeker e Entry
peekEntryFuzzy = Name -> Peek e Entry -> Peek e Entry
forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"ZipEntry" (Peek e Entry -> Peek e Entry)
-> (StackIndex -> Peek e Entry) -> StackIndex -> Peek e Entry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \StackIndex
idx ->
  LuaE e Type -> Peek e Type
forall e a. LuaE e a -> Peek e a
liftLua (StackIndex -> LuaE e Type
forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) Peek e Type -> (Type -> Peek e Entry) -> Peek e Entry
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Type
TypeUserdata -> DocumentedTypeWithList e Entry Void -> StackIndex -> Peek e Entry
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> Peeker e a
peekUD DocumentedTypeWithList e Entry Void
forall e. LuaError e => DocumentedType e Entry
typeEntry StackIndex
idx
    Type
TypeTable    -> StackIndex -> Peek e Entry
forall e. LuaError e => Peeker e Entry
peekEntryFromTable StackIndex
idx
    Type
_            -> ByteString -> Peek e Entry
forall a e. ByteString -> Peek e a
failPeek (ByteString -> Peek e Entry) -> Peek e ByteString -> Peek e Entry
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
                    Name -> StackIndex -> Peek e ByteString
forall e. Name -> StackIndex -> Peek e ByteString
typeMismatchMessage Name
"ZipEntry userdata or table" StackIndex
idx

peekEntryFromTable :: LuaError e => Peeker e Entry
peekEntryFromTable :: forall e. LuaError e => Peeker e Entry
peekEntryFromTable StackIndex
idx = FilePath -> Integer -> ByteString -> Entry
Zip.toEntry
  (FilePath -> Integer -> ByteString -> Entry)
-> Peek e FilePath -> Peek e (Integer -> ByteString -> Entry)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Peeker e FilePath -> Name -> Peeker e FilePath
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e FilePath
forall e. Peeker e FilePath
peekString Name
"path" StackIndex
idx
  Peek e (Integer -> ByteString -> Entry)
-> Peek e Integer -> Peek e (ByteString -> Entry)
forall a b. Peek e (a -> b) -> Peek e a -> Peek e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  (Peeker e (Maybe Integer) -> Name -> Peeker e (Maybe Integer)
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw (Peek e Integer -> Peek e (Maybe Integer)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Peek e Integer -> Peek e (Maybe Integer))
-> (StackIndex -> Peek e Integer) -> Peeker e (Maybe Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackIndex -> Peek e Integer
forall a e. (Integral a, Read a) => Peeker e a
peekIntegral) Name
"modtime" StackIndex
idx Peek e (Maybe Integer)
-> (Maybe Integer -> Peek e Integer) -> Peek e Integer
forall a b. Peek e a -> (a -> Peek e b) -> Peek e b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Maybe Integer
Nothing -> Integer -> Peek e Integer
forall a. a -> Peek e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0
          Just Integer
t  -> Integer -> Peek e Integer
forall a. a -> Peek e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
t)
  Peek e (ByteString -> Entry) -> Peek e ByteString -> Peek e Entry
forall a b. Peek e (a -> b) -> Peek e a -> Peek e b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  Peeker e ByteString -> Name -> Peeker e ByteString
forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw Peeker e ByteString
forall e. Peeker e ByteString
peekLazyByteString Name
"contents" StackIndex
idx

-- | Pushes a list of entries as an Entries object, i.e., a list with
-- additional methods.
pushEntries :: LuaError e => Pusher e [Entry]
pushEntries :: forall e. LuaError e => Pusher e [Entry]
pushEntries [Entry]
es = do
  Pusher e Entry -> [Entry] -> LuaE e ()
forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList (DocumentedTypeWithList e Entry Void -> Pusher e Entry
forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> a -> LuaE e ()
pushUD DocumentedTypeWithList e Entry Void
forall e. LuaError e => DocumentedType e Entry
typeEntry) [Entry]
es
  Name -> LuaE e () -> LuaE e ()
forall e. Name -> LuaE e () -> LuaE e ()
newListMetatable Name
"ZipEntry list" (() -> LuaE e ()
forall a. a -> LuaE e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  StackIndex -> LuaE e ()
forall e. StackIndex -> LuaE e ()
setmetatable (CInt -> StackIndex
nth CInt
2)