{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module HsLua.Module.Zip (
documentedModule
, typeArchive
, mkArchive
, read_entry
, zip
, extract
, bytestring
, typeEntry
, peekEntryFuzzy
, contents
, peekZipOptions
)
where
import Prelude hiding (zip)
import Control.Applicative (optional)
import Control.Monad ((<$!>))
import Codec.Archive.Zip (Archive, Entry, ZipOption (..), emptyArchive)
import Data.Maybe (catMaybes, fromMaybe)
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup (Semigroup(..))
#endif
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 qualified Codec.Archive.Zip as Zip
import qualified Data.Text as T
#if MIN_VERSION_base(4,11,0)
import Data.Functor ((<&>))
#else
(<&>) :: Functor f => f a -> (a -> b) -> f b
(<&>) = flip fmap
#endif
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.unwords
[ Text
"Function for creating, modifying, and extracting files from zip"
, Text
"archives."
]
, moduleFields :: [Field e]
moduleFields = forall e. [Field e]
fields
, moduleFunctions :: [DocumentedFunction e]
moduleFunctions = forall e. LuaError e => [DocumentedFunction e]
functions
, moduleOperations :: [(Operation, DocumentedFunction e)]
moduleOperations =
[ forall e.
Operation
-> DocumentedFunction e -> (Operation, DocumentedFunction e)
operation Operation
Call forall a b. (a -> b) -> a -> b
$ forall a e. a -> HsFnPrecursor e a
lambda
### (do
_ <- getfield (nthBottom 1) (functionName @e zip)
replace (nthBottom 1)
nargs <- NumArgs . subtract 1 . fromStackIndex <$> gettop
call nargs 1
pure (NumResults 1))
forall e.
HsFnPrecursor e (LuaE e NumResults) -> Text -> DocumentedFunction e
=?> Text
"new Archive"
]
}
initialVersion :: Version
initialVersion :: Version
initialVersion = [Int] -> Version
makeVersion [Int
1,Int
0,Int
0]
fields :: [Field e]
fields :: forall e. [Field e]
fields = []
functions :: LuaError e => [DocumentedFunction e]
functions :: forall e. LuaError e => [DocumentedFunction e]
functions =
[ forall e. LuaError e => DocumentedFunction e
mkArchive
, forall e. LuaError e => DocumentedFunction e
mkEntry
, forall e. LuaError e => DocumentedFunction e
read_entry
, forall e. LuaError e => DocumentedFunction e
zip
]
zip :: LuaError e => DocumentedFunction e
zip :: forall e. LuaError e => DocumentedFunction e
zip = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"zip"
### (\filepaths mopts ->
let opts = fromMaybe [] mopts
in liftIO $! Zip.addFilesToArchive opts emptyArchive filepaths)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. Peeker e FilePath
peekString) Text
"{string,...}"
Text
"filepaths" Text
"list of files from which the archive is created."
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [ZipOption]
peekZipOptions Text
"table" Text
"opts" Text
"zip options")
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> Text -> FunctionResults e a
udresult forall e. LuaError e => DocumentedType e Archive
typeArchive Text
"a new archive"
#? T.unlines
[ "Package and compress the given files into a new Archive." ]
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` Version
initialVersion
read_entry :: LuaError e => DocumentedFunction e
read_entry :: forall e. LuaError e => DocumentedFunction e
read_entry = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"read_entry"
### (\filepath mopts -> liftIO $! Zip.readEntry (fromMaybe [] mopts) filepath)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. Peeker e FilePath
peekString Text
"string" Text
"filepath" Text
""
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [ZipOption]
peekZipOptions Text
"table" Text
"opts" Text
"zip options")
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> Text -> FunctionResults e a
udresult forall e. LuaError e => DocumentedType e Entry
typeEntry Text
"a new zip archive entry"
#? T.unlines
[ "Generates a ZipEntry from a file or directory."
]
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` Version
initialVersion
peekZipOptions :: LuaError e => Peeker e [ZipOption]
peekZipOptions :: forall e. LuaError e => Peeker e [ZipOption]
peekZipOptions = forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"Zip options" forall b c a. (b -> c) -> (a -> b) -> a -> c
. \StackIndex
idx -> forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
[ forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw forall e. Peeker e Bool
peekBool Name
"recursive" StackIndex
idx) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Just Bool
True -> forall a. a -> Maybe a
Just ZipOption
OptRecursive
Maybe Bool
_ -> forall a. Maybe a
Nothing
, forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw forall e. Peeker e Bool
peekBool Name
"verbose" StackIndex
idx) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Just Bool
True -> forall a. a -> Maybe a
Just ZipOption
OptVerbose
Maybe Bool
_ -> forall a. Maybe a
Nothing
, forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw forall e. Peeker e FilePath
peekString Name
"destination" StackIndex
idx) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Just FilePath
fp -> forall a. a -> Maybe a
Just (FilePath -> ZipOption
OptDestination FilePath
fp)
Maybe FilePath
_ -> forall a. Maybe a
Nothing
, forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw forall e. Peeker e FilePath
peekString Name
"location" StackIndex
idx) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Just FilePath
fp -> forall a. a -> Maybe a
Just (FilePath -> Bool -> ZipOption
OptLocation FilePath
fp Bool
True)
Maybe FilePath
_ -> forall a. Maybe a
Nothing
, forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw forall e. Peeker e Bool
peekBool Name
"preserve_symlinks" StackIndex
idx) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Just Bool
True -> (forall a. a -> Maybe a
Just ZipOption
OptPreserveSymbolicLinks)
Maybe Bool
_ -> forall a. Maybe a
Nothing
]
typeArchive :: LuaError e => DocumentedType e Archive
typeArchive :: forall e. LuaError e => DocumentedType e Archive
typeArchive = forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"ZipArchive"
[]
[ forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"entries" Text
"files in this zip archive"
(forall e. LuaError e => Pusher e [Entry]
pushEntries, Archive -> [Entry]
Zip.zEntries)
(forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e Entry
peekEntryFuzzy, \Archive
ar [Entry]
entries -> Archive
ar { zEntries :: [Entry]
Zip.zEntries = [Entry]
entries })
, forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method forall e. LuaError e => DocumentedFunction e
extract
, forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method forall e. LuaError e => DocumentedFunction e
bytestring
]
mkArchive :: LuaError e => DocumentedFunction e
mkArchive :: forall e. LuaError e => DocumentedFunction e
mkArchive = 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)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter (forall e a. LuaError e => [Peeker e a] -> Peeker e a
choice [ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Peeker e ByteString
peekLazyByteString
, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. LuaError e => Peeker e a -> Peeker e [a]
peekList forall e. LuaError e => Peeker e Entry
peekEntryFuzzy ])
Text
"string|{ZipEntry,...}" Text
"contents"
Text
"binary archive data or list of entries")
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> Text -> FunctionResults e a
udresult 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."
]
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` Version
initialVersion
extract :: LuaError e => DocumentedFunction e
= forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"extract"
### (\archive mopts ->
liftIO $! Zip.extractFilesFromArchive (fromMaybe [] mopts) archive)
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam forall e. LuaError e => DocumentedType e Archive
typeArchive Text
"self" Text
""
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. LuaError e => Peeker e [ZipOption]
peekZipOptions Text
"table" Text
"opts" Text
"zip options")
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."
]
bytestring :: LuaError e => DocumentedFunction e
bytestring :: forall e. LuaError e => DocumentedFunction e
bytestring = forall a e. Name -> a -> HsFnPrecursor e a
defun Name
"bytestring"
### liftPure Zip.fromArchive
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam forall e. LuaError e => DocumentedType e Archive
typeArchive Text
"self" Text
""
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult forall e. Pusher e ByteString
pushLazyByteString Text
"string" Text
"bytes of the archive"
#? "Returns the raw binary string representation of the archive."
typeEntry :: LuaError e => DocumentedType e Entry
typeEntry :: forall e. LuaError e => DocumentedType e Entry
typeEntry = forall e a.
LuaError e =>
Name
-> [(Operation, DocumentedFunction e)]
-> [Member e (DocumentedFunction e) a]
-> DocumentedType e a
deftype Name
"ZipEntry"
[]
[ forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"path" Text
"relative path, using `/` as separator"
(forall e. FilePath -> LuaE e ()
pushString, Entry -> FilePath
Zip.eRelativePath)
(forall e. Peeker e FilePath
peekString, \Entry
entry FilePath
path -> Entry
entry { eRelativePath :: FilePath
Zip.eRelativePath = FilePath
path })
, forall e b a fn.
LuaError e =>
Name
-> Text
-> (Pusher e b, a -> b)
-> (Peeker e b, a -> b -> a)
-> Member e fn a
property Name
"modtime" Text
"modification time (seconds since unix epoch)"
(forall a e. (Integral a, Show a) => a -> LuaE e ()
pushIntegral, Entry -> Integer
Zip.eLastModified)
(forall a e. (Integral a, Read a) => Peeker e a
peekIntegral, \Entry
entry Integer
modtime -> Entry
entry { eLastModified :: Integer
Zip.eLastModified = Integer
modtime})
, forall e a.
DocumentedFunction e -> Member e (DocumentedFunction e) a
method forall e. LuaError e => DocumentedFunction e
contents
]
mkEntry :: LuaError e => DocumentedFunction e
mkEntry :: forall e. LuaError e => DocumentedFunction e
mkEntry = 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')
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. Peeker e FilePath
peekString Text
"string" Text
"path" Text
"file path in archive"
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. Peeker e ByteString
peekLazyByteString Text
"string" Text
"contents" Text
"uncompressed contents"
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall a e. (Integral a, Read a) => Peeker e a
peekIntegral Text
"integer" Text
"modtime" Text
"modification time")
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype -> Text -> FunctionResults e a
udresult 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."
]
forall e. DocumentedFunction e -> Version -> DocumentedFunction e
`since` Version
initialVersion
contents :: LuaError e => DocumentedFunction e
contents :: forall e. LuaError e => DocumentedFunction e
contents = 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.")
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a itemtype.
LuaError e =>
DocumentedTypeWithList e a itemtype
-> Text -> Text -> Parameter e a
udparam forall e. LuaError e => DocumentedType e Entry
typeEntry Text
"self" Text
""
forall e a b.
HsFnPrecursor e (a -> b) -> Parameter e a -> HsFnPrecursor e b
<#> forall e a. Parameter e a -> Parameter e (Maybe a)
opt (forall e a. Peeker e a -> Text -> Text -> Text -> Parameter e a
parameter forall e. Peeker e FilePath
peekString Text
"string" Text
"password" Text
"password for entry")
forall e a.
HsFnPrecursor e (LuaE e a)
-> FunctionResults e a -> DocumentedFunction e
=#> forall e a. Pusher e a -> Text -> Text -> FunctionResults e a
functionResult forall e. Pusher e ByteString
pushLazyByteString Text
"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 = forall e a. Name -> Peek e a -> Peek e a
retrieving Name
"ZipEntry" forall b c a. (b -> c) -> (a -> b) -> a -> c
. \StackIndex
idx ->
forall e a. LuaE e a -> Peek e a
liftLua (forall e. StackIndex -> LuaE e Type
ltype StackIndex
idx) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Type
TypeUserdata -> forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> Peeker e a
peekUD forall e. LuaError e => DocumentedType e Entry
typeEntry StackIndex
idx
Type
TypeTable -> forall e. LuaError e => Peeker e Entry
peekEntryFromTable StackIndex
idx
Type
_ -> forall a e. ByteString -> Peek e a
failPeek forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
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
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw forall e. Peeker e FilePath
peekString Name
"path" StackIndex
idx
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw (forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a e. (Integral a, Read a) => Peeker e a
peekIntegral) Name
"modtime" StackIndex
idx forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Integer
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0
Just Integer
t -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
t)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e a. LuaError e => Peeker e a -> Name -> Peeker e a
peekFieldRaw forall e. Peeker e ByteString
peekLazyByteString Name
"contents" StackIndex
idx
pushEntries :: LuaError e => Pusher e [Entry]
pushEntries :: forall e. LuaError e => Pusher e [Entry]
pushEntries [Entry]
es = do
forall e a. LuaError e => Pusher e a -> [a] -> LuaE e ()
pushList (forall e fn a itemtype.
LuaError e =>
UDTypeWithList e fn a itemtype -> a -> LuaE e ()
pushUD forall e. LuaError e => DocumentedType e Entry
typeEntry) [Entry]
es
forall e. Name -> LuaE e () -> LuaE e ()
newListMetatable Name
"ZipEntry list" (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
forall e. StackIndex -> LuaE e ()
setmetatable (CInt -> StackIndex
nth CInt
2)