{-# LANGUAGE CPP #-}

{-# LANGUAGE LambdaCase #-}

{-# LANGUAGE OverloadedStrings #-}

{-# LANGUAGE ScopedTypeVariables #-}

{-# LANGUAGE TypeApplications #-}

module HsLua.Module.Zip (

-- * Module

documentedModule

, description

, callOp

-- * Zip archives

, typeArchive

, mkArchive

, read_entry

, zip

-- ** archive methods

, extract

, bytestring

-- * Zip entry

, typeEntry

, mkEntry

, peekEntryFuzzy

-- ** entry methods

, contents

, symlink

-- * Zip Options

, peekZipOptions

)

import Prelude hiding (zip)

import Control.Applicative (optional)

import Control.Monad ((<$!>))

import Codec.Archive.Zip

( Archive, Entry, ZipOption (..), emptyArchive

#ifndef _WINDOWS

, symbolicLinkEntryTarget

)

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, pushnil, 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

#ifdef _WINDOWS

-- | Windows replacement; always returns Nothing.

symbolicLinkEntryTarget :: Entry -> Maybe FilePath

symbolicLinkEntryTarget = const Nothing

-- | The @zip@ module specification.

documentedModule :: LuaError e => Module e

documentedModule = defmodule "zip"

`withDescription` description

`withFunctions` functions

`withOperations` [ operation Call callOp ]

`associateType` typeArchive

`associateType` typeEntry

-- | Textual description of this module; to be used for live documentation.

description :: T.Text

description = 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."

]

-- | Function for the `call` operation.

callOp :: forall e. LuaError e => DocumentedFunction e

callOp = 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"

-- | First published version of this library.

initialVersion :: Version

initialVersion = makeVersion [1,0,0]

-- | 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

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

]

-- | 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;

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."

-- | 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

, method symlink

]

-- | 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."

]

-- | Returns the target if the Entry represents a symbolic link.

symlink :: LuaError e => DocumentedFunction e

symlink = defun "symlink"

### liftPure symbolicLinkEntryTarget

<#> udparam typeEntry "self" ""

=#> functionResult (maybe pushnil pushString) "string|nil"

"link target if entry represents a symbolic link"

#? T.unlines

[ "Returns the target if the Entry represents a symbolic link,"

, "and `nil` otherwise. Always returns `nil` on Windows. "

]

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

pushEntries :: LuaError e => Pusher e [Entry]

pushEntries es = do

pushList (pushUD typeEntry) es

newListMetatable "ZipEntry list" (pure ())

setmetatable (nth 2)