{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-|
Module : HsLua.Module.Zip
Copyright : © 2022-2023 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 = Module
{ moduleName = "zip"
, moduleDescription = T.unlines
[ "Functions to create, modify, and extract files from zip archives."
, ""
, "The module can be called as a function, in which case it behaves"
, "like the `zip` function described below."
, ""
, "Zip options are optional; when defined, they must be a table with"
, "any of the following keys:"
, ""
, " - `recursive`: recurse directories when set to `true`;"
, " - `verbose`: print info messages to stdout;"
, " - `destination`: the value specifies the directory in which to"
, " extract;"
, " - `location`: value is used as path name, defining where files"
, " are placed."
, " - `preserve_symlinks`: Boolean value, controlling whether"
, " symbolic links are preserved as such. This option is ignored"
, " on Windows."
]
, moduleFields = fields
, moduleFunctions = functions
, moduleOperations =
[ operation Call $ 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))
=?> "new Archive"
]
, moduleTypeInitializers =
[ initType typeArchive
, initType typeEntry
]
}
-- | First published version of this library.
initialVersion :: Version
initialVersion = makeVersion [1,0,0]
--
-- Fields
--
-- | Exported fields.
fields :: [Field e]
fields = []
--
-- Functions
--
-- | Exported functions
functions :: LuaError e => [DocumentedFunction e]
functions =
[ mkArchive
, mkEntry
, read_entry
, zip
]
-- | Creates a new 'Archive' from a list of files.
zip :: LuaError e => DocumentedFunction e
zip = defun "zip"
### (\filepaths mopts ->
let opts = fromMaybe [] mopts
in liftIO $! Zip.addFilesToArchive opts emptyArchive filepaths)
<#> parameter (peekList peekString) "{string,...}"
"filepaths" "list of files from which the archive is created."
<#> opt (parameter peekZipOptions "table" "opts" "zip options")
=#> udresult typeArchive "a new archive"
#? T.unlines
[ "Package and compress the given files into a new Archive." ]
`since` initialVersion
-- | Creates a new 'ZipEntry' from a file; wraps 'Zip.readEntry'.
read_entry :: LuaError e => DocumentedFunction e
read_entry = defun "read_entry"
### (\filepath mopts -> liftIO $! Zip.readEntry (fromMaybe [] mopts) filepath)
<#> parameter peekString "string" "filepath" ""
<#> opt (parameter peekZipOptions "table" "opts" "zip options")
=#> udresult typeEntry "a new zip archive entry"
#? T.unlines
[ "Generates a ZipEntry from a file or directory."
]
`since` initialVersion
--
-- * Options
--
peekZipOptions :: LuaError e => Peeker e [ZipOption]
peekZipOptions = retrieving "Zip options" . \idx -> catMaybes <$> sequence
[ optional (peekFieldRaw peekBool "recursive" idx) <&> \case
Just True -> Just OptRecursive
_ -> Nothing
, optional (peekFieldRaw peekBool "verbose" idx) <&> \case
Just True -> Just OptVerbose
_ -> Nothing
, optional (peekFieldRaw peekString "destination" idx) <&> \case
Just fp -> Just (OptDestination fp)
_ -> Nothing
, optional (peekFieldRaw peekString "location" idx) <&> \case
Just fp -> Just (OptLocation fp True)
_ -> Nothing
, optional (peekFieldRaw peekBool "preserve_symlinks" idx) <&> \case
Just True -> (Just OptPreserveSymbolicLinks)
_ -> Nothing
]
--
-- * Archive
--
-- | The Lua 'Archive' type
typeArchive :: forall e. LuaError e => DocumentedType e Archive
typeArchive = deftype "zip.Archive"
[]
[ property' "entries" (seqType (udTypeSpec @e typeEntry))
"Files in this zip archive"
(pushEntries, Zip.zEntries)
(peekList peekEntryFuzzy, \ar entries -> ar { Zip.zEntries = entries })
, method extract
, method bytestring
]
-- | Wrapper for 'Zip.toArchive'; converts a string into an Archive.
mkArchive :: forall e. LuaError e => DocumentedFunction e
mkArchive = defun "Archive"
### (\case
Nothing ->
pure Zip.emptyArchive
Just (Left bytestring') ->
either failLua pure $ Zip.toArchiveOrFail bytestring'
Just (Right entries) ->
pure $ foldr Zip.addEntryToArchive emptyArchive entries)
<#> opt (parameter (choice [ fmap Left . peekLazyByteString
, fmap Right . peekList peekEntryFuzzy ])
(stringType #|# seqType (udTypeSpec @e typeEntry))
"bytestring_or_entries"
"binary archive data or list of entries; defaults to an empty list")
=#> udresult typeArchive "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."
]
`since` initialVersion
-- | Returns the raw binary string representation of the archive;
-- wraps 'Zip.extractFilesFromArchive'
extract :: LuaError e => DocumentedFunction e
extract = defun "extract"
### (\archive mopts ->
liftIO $! Zip.extractFilesFromArchive (fromMaybe [] mopts) archive)
<#> udparam typeArchive "self" ""
<#> opt (parameter peekZipOptions "table" "opts" "zip options")
=#> []
#? 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 = defun "bytestring"
### liftPure Zip.fromArchive
<#> udparam typeArchive "self" ""
=#> functionResult pushLazyByteString "string" "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 = deftype "zip.Entry"
[]
[ property' "path" (udTypeSpec @e typeEntry)
"Relative path, using `/` as separator"
(pushString, Zip.eRelativePath)
(peekString, \entry path -> entry { Zip.eRelativePath = path })
, property' "modtime" integerType
"Modification time (seconds since unix epoch)"
(pushIntegral, Zip.eLastModified)
(peekIntegral, \entry modtime -> entry { Zip.eLastModified = modtime})
, method contents
]
-- | Creates a new 'ZipEntry' from a file; wraps 'Zip.readEntry'.
mkEntry :: LuaError e => DocumentedFunction e
mkEntry = defun "Entry"
### (\filepath contents' mmodtime -> do
modtime <- maybe (floor <$> liftIO getPOSIXTime) pure mmodtime
pure $ Zip.toEntry filepath modtime contents')
<#> parameter peekString "string" "path" "file path in archive"
<#> parameter peekLazyByteString "string" "contents" "uncompressed contents"
<#> opt (parameter peekIntegral "integer" "modtime" "modification time")
=#> udresult typeEntry "a new zip archive entry"
#? T.unlines
[ "Generates a ZipEntry from a filepath, uncompressed content, and"
, "the file's modification time."
]
`since` initialVersion
-- | Returns the uncompressed contents of a zip entry.
contents :: LuaError e => DocumentedFunction e
contents = defun "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.")
<#> udparam typeEntry "self" ""
<#> opt (parameter peekString "string" "password" "password for entry")
=#> functionResult pushLazyByteString "string" "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 = retrieving "ZipEntry" . \idx ->
liftLua (ltype idx) >>= \case
TypeUserdata -> peekUD typeEntry idx
TypeTable -> peekEntryFromTable idx
_ -> failPeek =<<
typeMismatchMessage "ZipEntry userdata or table" idx
peekEntryFromTable :: LuaError e => Peeker e Entry
peekEntryFromTable idx = Zip.toEntry
<$!> peekFieldRaw peekString "path" idx
<*> (peekFieldRaw (optional . peekIntegral) "modtime" idx >>= \case
Nothing -> pure 0
Just t -> pure t)
<*> peekFieldRaw peekLazyByteString "contents" idx
-- | Pushes a list of entries as an Entries object, i.e., a list with
-- additional methods.
pushEntries :: LuaError e => Pusher e [Entry]
pushEntries es = do
pushList (pushUD typeEntry) es
newListMetatable "ZipEntry list" (pure ())
setmetatable (nth 2)