diff --git a/Main.hs b/Main.hs new file mode 100644 --- /dev/null +++ b/Main.hs @@ -0,0 +1,90 @@ +------------------------------------------------------------------------ +-- Zip.hs +-- Copyright (c) 2008 John MacFarlane +-- License : BSD3 (see LICENSE) +-- +-- This is a demonstration of the use of the 'Codec.Archive.Zip' library. +-- It duplicates some of the functionality of the 'zip' command-line +-- program. +------------------------------------------------------------------------ + +import Codec.Archive.Zip +import System.IO +import qualified Data.ByteString.Lazy as B +import System.Exit +import System.Environment +import System.Directory +import System.Console.GetOpt +import Control.Monad ( when ) +import Control.Applicative ( (<$>) ) +import Data.Version ( showVersion ) +import Paths_zip_archive ( version ) +import Debug.Trace ( traceShowId ) + +data Flag + = Quiet + | Version + | Decompress + | Recursive + | Remove + | List + | Debug + | Help + deriving (Eq, Show, Read) + +options :: [OptDescr Flag] +options = + [ Option ['d'] ["decompress"] (NoArg Decompress) "decompress (unzip)" + , Option ['r'] ["recursive"] (NoArg Recursive) "recursive" + , Option ['R'] ["remove"] (NoArg Remove) "remove" + , Option ['l'] ["list"] (NoArg List) "list" + , Option ['v'] ["version"] (NoArg Version) "version" + , Option ['q'] ["quiet"] (NoArg Quiet) "quiet" + , Option [] ["debug"] (NoArg Debug) "debug output" + , Option ['h'] ["help"] (NoArg Help) "help" + ] + +main :: IO () +main = do + argv <- getArgs + progname <- getProgName + let header = "Usage: " ++ progname ++ " [OPTION...] archive files..." + (opts, args) <- case getOpt Permute options argv of + (o, _, _) | Version `elem` o -> do + putStrLn ("version " ++ showVersion version) + exitWith ExitSuccess + (o, _, _) | Help `elem` o -> error $ usageInfo header options + (o, (a:as), []) -> return (o, a:as) + (_, _, errs) -> error $ concat errs ++ "\n" ++ usageInfo header options + let verbosity = if Quiet `elem` opts then [] else [OptVerbose] + let debug = Debug `elem` opts + let cmd = case filter (`notElem` [Quiet, Help, Version, Debug]) opts of + [] -> Recursive + (x:_) -> x + let (archivePath : files) = args + exists <- doesFileExist archivePath + archive <- if exists + then toArchive <$> B.readFile archivePath + else return emptyArchive + let showArchiveIfDebug x = if debug + then traceShowId x + else x + case cmd of + Decompress -> extractFilesFromArchive verbosity $ showArchiveIfDebug archive + Remove -> do tempDir <- getTemporaryDirectory + (tempArchivePath, tempArchive) <- openTempFile tempDir "zip" + B.hPut tempArchive $ fromArchive $ showArchiveIfDebug $ + foldr deleteEntryFromArchive archive files + hClose tempArchive + copyFile tempArchivePath archivePath + removeFile tempArchivePath + List -> mapM_ putStrLn $ filesInArchive $ showArchiveIfDebug archive + Recursive -> do when (null files) $ error "No files specified." + tempDir <- getTemporaryDirectory + (tempArchivePath, tempArchive) <- openTempFile tempDir "zip" + addFilesToArchive (verbosity ++ [OptRecursive]) archive files >>= + B.hPut tempArchive . fromArchive . showArchiveIfDebug + hClose tempArchive + copyFile tempArchivePath archivePath + removeFile tempArchivePath + _ -> error $ "Unknown command " ++ show cmd diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Setup.lhs b/Setup.lhs deleted file mode 100644 --- a/Setup.lhs +++ /dev/null @@ -1,11 +0,0 @@ -#!/usr/bin/env runhaskell - -> module Main ( main ) where -> -> import Distribution.Simple -> import Distribution.Simple.Program -> -> main :: IO () -> main = defaultMainWithHooks simpleUserHooks -> { hookedPrograms = [ simpleProgram "zip" ] -> } diff --git a/Zip.hs b/Zip.hs deleted file mode 100644 --- a/Zip.hs +++ /dev/null @@ -1,84 +0,0 @@ ------------------------------------------------------------------------- --- Zip.hs --- Copyright (c) 2008 John MacFarlane --- License : BSD3 (see LICENSE) --- --- This is a demonstration of the use of the 'Codec.Archive.Zip' library. --- It duplicates some of the functionality of the 'zip' command-line --- program. ------------------------------------------------------------------------- - -import Codec.Archive.Zip -import System.IO -import qualified Data.ByteString.Lazy as B -import System.Exit -import System.Environment -import System.Directory -import System.Console.GetOpt -import Control.Monad ( when ) -import Control.Applicative ( (<$>) ) -import Data.Version ( showVersion ) -import Paths_zip_archive ( version ) - -data Flag - = Quiet - | Version - | Decompress - | Recursive - | Remove - | List - | Help - deriving (Eq, Show, Read) - -options :: [OptDescr Flag] -options = - [ Option ['d'] ["decompress"] (NoArg Decompress) "decompress (unzip)" - , Option ['r'] ["recursive"] (NoArg Recursive) "recursive" - , Option ['R'] ["remove"] (NoArg Remove) "remove" - , Option ['l'] ["list"] (NoArg List) "list" - , Option ['v'] ["version"] (NoArg Version) "version" - , Option ['q'] ["quiet"] (NoArg Quiet) "quiet" - , Option ['h'] ["help"] (NoArg Help) "help" - ] - -main :: IO () -main = do - argv <- getArgs - progname <- getProgName - let header = "Usage: " ++ progname ++ " [OPTION...] archive files..." - (opts, args) <- case getOpt Permute options argv of - (o, _, _) | Version `elem` o -> do - putStrLn ("version " ++ showVersion version) - exitWith ExitSuccess - (o, _, _) | Help `elem` o -> error $ usageInfo header options - (o, (a:as), []) -> return (o, a:as) - (_, _, errs) -> error $ concat errs ++ "\n" ++ usageInfo header options - let verbosity = if Quiet `elem` opts then [] else [OptVerbose] - let cmd = take 1 $ filter (`notElem` [Quiet, Help, Version]) opts - let cmd' = if null cmd - then Recursive - else head cmd - let (archivePath : files) = args - exists <- doesFileExist archivePath - archive <- if exists - then toArchive <$> B.readFile archivePath - else return emptyArchive - case cmd' of - Decompress -> extractFilesFromArchive verbosity archive - Remove -> do tempDir <- getTemporaryDirectory - (tempArchivePath, tempArchive) <- openTempFile tempDir "zip" - B.hPut tempArchive $ fromArchive $ - foldr deleteEntryFromArchive archive files - hClose tempArchive - copyFile tempArchivePath archivePath - removeFile tempArchivePath - List -> mapM_ putStrLn $ filesInArchive archive - Recursive -> do when (null files) $ error "No files specified." - tempDir <- getTemporaryDirectory - (tempArchivePath, tempArchive) <- openTempFile tempDir "zip" - addFilesToArchive (verbosity ++ [OptRecursive]) archive files >>= - B.hPut tempArchive . fromArchive - hClose tempArchive - copyFile tempArchivePath archivePath - removeFile tempArchivePath - _ -> error "Unknown command" diff --git a/changelog b/changelog --- a/changelog +++ b/changelog @@ -1,3 +1,9 @@ +zip-archive 0.3.1 + + * Don't use a custom build (#28). + * Renamed executable Zip -> zip-archive, added --debug option. + The --debug option prints the intermediate Haskell data structure. + zip-archive 0.3.0.7 * Fix check for unix file attributes (#34). diff --git a/zip-archive.cabal b/zip-archive.cabal --- a/zip-archive.cabal +++ b/zip-archive.cabal @@ -1,7 +1,7 @@ Name: zip-archive -Version: 0.3.0.7 +Version: 0.3.1 Cabal-Version: >= 1.10 -Build-type: Custom +Build-type: Simple Synopsis: Library for creating and modifying zip archives. Description: The zip-archive library provides functions for creating, modifying, and extracting files from zip archives. @@ -42,12 +42,12 @@ else Build-depends: unix -Executable Zip +Executable zip-archive if flag(executable) Buildable: True else Buildable: False - Main-is: Zip.hs + Main-is: Main.hs Hs-Source-Dirs: . Build-Depends: base >= 4.2 && < 5, directory >= 1.1, bytestring >= 0.9.0, zip-archive @@ -64,7 +64,6 @@ HUnit, zip-archive, temporary Default-Language: Haskell98 Ghc-Options: -Wall - Build-Tools: zip if os(windows) cpp-options: -D_WINDOWS else