-- A library for reading the various kinds of file-system-within-a-file types
-- used by lots of games. Currently handled: Doom 1/2, Rise of the Triad,
-- Hexen 1/2, Duke Nukem 3D, Redneck Rampage, Heretic 1, Quake 1/2/3,
-- uncompressed Zip files, Half-Life, Kingpin, Sin
-- 
-- Note: If not stated otherwise, Intel byte-order is assumed and all offsets
-- are measured from the start of the (sub-)file .

module PackLib(
   FileLength, DirectoryPath, FileName, ensureSuffix, separator, concPaths,
   SearchDescriptor(..), PackFinder(..), makePackFinder,
   pGetDirectoryContents, pDoesFileExist, pDoesDirectoryExist, pOpenFile,
   knownHandlers
) where

import IO
import List(isPrefixOf, nub)
import Monad(liftM, when, unless)
import Directory(getDirectoryContents)
import GHC.Handle(hSetBinaryMode)   -- see comment in front of openBinaryFile

{-
-- DEBUGGING ONLY
import Array(Array, listArray, (!))
import System(getArgs, getProgName)
import Directory(doesDirectoryExist)
-}

-- #############################################################################
-- basic definitions
-- #############################################################################

--------------------------------------------------------------------------------
-- Windows distinguishes between text mode and binary mode, so we have to use
-- something non-standard here. Sigh...

openBinaryFile :: FilePath -> IOMode -> IO Handle
openBinaryFile filePath mode = do
   handle <- openFile filePath mode
   hSetBinaryMode handle True
   return handle

--------------------------------------------------------------------------------
-- 16/32-bit unsigned integers; to keep things portable, we don't use GHC's
-- Word module here. The lengths are counted in bytes.

type Word16 = Integer

word16Len :: Int
word16Len = 2

type Word32 = Integer

word32Len :: Int
word32Len = 4

--------------------------------------------------------------------------------
-- C-like input of words and strings

getWord16 :: Handle -> IO Word16
getWord16 = getNByteNum 2

getWord32 :: Handle -> IO Word32
getWord32 = getNByteNum 4

-- TODO: Is this a hot spot?
getNByteNum :: Num a => Int -> Handle -> IO a
getNByteNum numBytes handle =
   liftM (foldr (\x val -> val * 256 + fromIntegral (fromEnum x)) 0)
         (getString handle numBytes)

-- Get a string of length numChars, stripping of trailing zeroes
getCString :: Handle -> Int -> IO String
getCString handle numChars =
   liftM (takeWhile (/= '\0')) (getString handle numChars)

-- Get a string of length numChars
getString :: Handle -> Int -> IO String
getString handle numChars =
   sequence . replicate numChars . hGetChar $ handle

--------------------------------------------------------------------------------
-- a relative distance within a file

type FileOffset = Word32

getFileOffset :: Handle -> IO FileOffset
getFileOffset = getWord32

--------------------------------------------------------------------------------
-- the length of a (sub-)file

type FileLength = Word32

getFileLength :: Handle -> IO FileLength
getFileLength = getWord32

--------------------------------------------------------------------------------
-- path components, always *nix-style, i.e. / instead of \

type DirectoryPath = FilePath
type FileName      = FilePath

-- Just in case this library gets ported to M$...
separator :: String
separator = "/"

ensureSuffix :: String -> String -> String
ensureSuffix str suff | rSuff `isPrefixOf` rStr = str
                      | otherwise               = reverse (rSuff ++ rStr)
       where rSuff = reverse suff
             rStr  = reverse str

concPaths :: DirectoryPath -> String -> String
concPaths p1 p2 = ensureSuffix p1 separator ++ p2

--------------------------------------------------------------------------------
-- A lump descriptor represents a portion of a larger file. The offset is
-- normally measured from the beginning of the file, but it could be measured
-- from the start of another lump, too.

data LumpDescriptor = LumpDescriptor {
   lumpOffset :: FileOffset,
   lumpLength :: FileLength }

getLumpDescriptor :: Handle -> IO LumpDescriptor
getLumpDescriptor handle = do
   offs <- getFileOffset handle
   len  <- getFileLength handle
   return (LumpDescriptor { lumpOffset = offs, lumpLength = len })

--------------------------------------------------------------------------------
-- An entry within a pack file consists of a name and the corresponding portion
-- of a larger file. Additionally there can be arbitrary info about the pack
-- file. To be flexible here, a simple string is used for this purpose.

type LumpInfo = String

data PackDirectoryEntry = PackDirectoryEntry {
   lumpName       :: FileName,
   lumpDescriptor :: LumpDescriptor,
   lumpInfo       :: LumpInfo }

--------------------------------------------------------------------------------
-- utilities

type Magic = String

checkMagic :: String -> [Magic] -> Magic -> IO ()
checkMagic format magics magic =
   unless (magic `elem` magics) (badMagic format magic)

badMagic :: String -> Magic -> IO a
badMagic format magic =
   (ioError (userError ("bad" ++ format ++ " magic `" ++ magic ++"'")))

-- #############################################################################
-- a table mapping keys to elements
-- #############################################################################

-- currently only an association list, this should definitely be improved
newtype Table k e = Table [(k,e)]

listToTable :: [(k,e)] -> Table k e
listToTable = Table

entriesWithPrefix :: Eq a => Table [a] e -> [a] -> [e]
entriesWithPrefix (Table assoc) prefix =
   [ e | (k,e) <- assoc, prefix `isPrefixOf` k ]

lookupTable :: Eq k => Table k e -> k -> Maybe e
lookupTable (Table assoc) key = lookup key assoc

-- #############################################################################
-- the basic interface to the different pack file formats
-- #############################################################################

type PackInfo    = String
type DirReader   = Handle -> IO [PackDirectoryEntry]
type PackHandler = Handle -> IO (
   PackInfo,     -- what kind of pack file has been recognized?
   FileOffset,   -- where does the directory start?
   Integer,      -- how often should the dir reader be called?
   DirReader)    -- guess...

-- internally we use a (hopefully) more efficient representation for a
-- collection of PackDirectoryEntries.
type PackDirectoryTable = Table FileName PackDirectoryEntry

makePackDirectoryTable :: [PackDirectoryEntry] -> PackDirectoryTable
makePackDirectoryTable entries =
   listToTable (zip (map lumpName entries) entries)

getPackEntries :: [PackHandler] -> Handle -> IO (PackInfo, PackDirectoryTable)
getPackEntries handlers handle = do
   start <- hGetPosn handle
   let determinePackType []     = ioError (userError "unknown pack format")
       determinePackType (h:hs) = catch (h handle)
                                        (\_ -> do hSetPosn start
                                                  determinePackType hs)
   (info, offset, num, dirReader) <- determinePackType handlers
   hSetPosn start
   hSeek handle RelativeSeek (fromIntegral offset)
   entries <- case num of   -- efficiency paranoia?
                 1 -> dirReader handle
                 n -> liftM concat . sequence . replicate (fromIntegral n) .
                      dirReader $ handle
   return (info, makePackDirectoryTable entries)

-- #############################################################################
-- handlers for the known formats
-- #############################################################################

--------------------------------------------------------------------------------
-- A Doom wad file has the following structure:
--
--    * a 12 byte header:
--       * a 4 byte magic: "IWAD" for internal wads, "PWAD" for patch wads
--       * a 32 bit count (number of entries in directory)
--       * a 32 bit offset to the directory
--
--    * a 16 byte directory entry:
--       * a 32 bit offset to the file
--       * a 32 bit length of the file
--       * an 8 character zero-padded string (the name of the file)
--
-- This format is used in Doom 1/2, Rise of the Triad, Hexen 1 and Heretic 1.

doomHandler :: PackHandler
doomHandler handle = do
   magic <- getString handle 4
   checkMagic "Doom" ["IWAD", "PWAD"] magic
   numEntries <- getFileLength handle
   offset <- getFileOffset handle
   return (magic, offset, fromIntegral numEntries, doomReader)

doomReader :: DirReader
doomReader handle = do
   lumpDescr <- getLumpDescriptor handle
   lumpNam <- getCString handle 8
   return [PackDirectoryEntry {
      lumpName       = lumpNam,
      lumpDescriptor = lumpDescr,
      lumpInfo       = "" }]

--------------------------------------------------------------------------------
-- A wad23 file has the following structure:
--
--    * a 12 byte header:
--       * a 4 byte magic: "WAD2" (Quake 2) or "WAD3" (Half-Life)
--       * a 32 bit count (number of entries in directory)
--       * a 32 bit offset to the directory
--
--    * a 32 byte directory entry:
--       * long offset;                 // Position of the entry in WAD
--       * long dsize;                  // Size of the entry in WAD file
--       * long size;                   // Size of the entry in memory
--       * char type;                   // type of entry
--       * char cmprs;                  // Compression. 0 if none.
--       * short dummy;                 // Not used
--       * char name[16];               // 1 to 16 characters, '\0'-padded
--
--   * types:
--       * 0x40= '@'= Color Palette
--       * 0x42= 'B'= Pictures for status bar
--       * 0x43= 'C'= ??? (see Half-Life's xeno.wad)
--       * 0x44= 'D'= Used to be Mip Texture
--       * 0x45= 'E'= Console picture (flat)
-- 
-- This format is used for Quake 2 wads (gfx.wad) and Half-Life wads.

wad23Handler :: PackHandler
wad23Handler handle = do
   magic <- getString handle 4
   checkMagic "Wad23" ["WAD2", "WAD3"] magic
   numEntries <- getFileLength handle
   offset <- getFileOffset handle
   return (magic, offset, fromIntegral numEntries, wad23Reader)

wad23Reader :: DirReader
wad23Reader handle = do
   lumpDescr   <- getLumpDescriptor handle
   memLength   <- getFileLength handle
   fType       <- hGetChar handle
   compression <- hGetChar handle
   dummy1      <- hGetChar handle
   dummy2      <- hGetChar handle
   lumpNam     <- getCString handle 16
   when (memLength /= lumpLength lumpDescr || compression /= '\0' ||
         dummy1 /= '\0' || dummy2 /= '\0')
        (ioError (userError "strange Wad23 directory entry"))
   return [PackDirectoryEntry {
      lumpName       = lumpNam,
      lumpDescriptor = lumpDescr,
      lumpInfo       = [fType] }]

--------------------------------------------------------------------------------
-- A Quake 1 pack file (pak[0-9].pak) has the following structure:
--
--    * a 12 byte header:
--       * a 4 byte magic: "PACK"
--       * a 32 bit offset to the directory
--       * a 32 bit length of the directory
--
--    * a 64 byte directory entry:
--       * a 56 byte zero-terminated string (the file name in *nix-style)
--       * a 32 bit offset to the file
--       * a 32 bit length of the file
--
-- This format is used in Quake 1, Quake 2, Hexen 2, Half-Life, and Kingpin.
--
-- Sin's format (pak[0-9].sin) is almost the same, the only differences are the
-- magic "SPAK" and the length of the file name (120 instead of 56 characters).

quake1Handler :: PackHandler
quake1Handler = quake1SinHandler "Quake 1" "PACK" 56

sinHandler :: PackHandler
sinHandler = quake1SinHandler "Sin" "SPAK" 120

quake1SinHandler :: String -> Magic -> FileLength -> PackHandler
quake1SinHandler format expectedMagic nameLen handle = do
   magic <- getString handle 4
   checkMagic format [expectedMagic] magic
   lumpDescr <- getLumpDescriptor handle
   let numEntries = fromIntegral (lumpLength lumpDescr `div` (nameLen + 8))
   return (format, lumpOffset lumpDescr, numEntries,
           quake1SinReader (fromIntegral nameLen))

quake1SinReader :: Int -> DirReader
quake1SinReader nameLen handle = do
   lumpNam <- getCString handle nameLen
   lumpDescr <- getLumpDescriptor handle
   return [PackDirectoryEntry {
      lumpName       = lumpNam,
      lumpDescriptor = lumpDescr,
      lumpInfo       = "" }]

--------------------------------------------------------------------------------
-- A Build file has the following structure:
--
--    * a 16 byte header (same structure as a directory entry):
--       * a 12 byte magic: "KenSilverman"
--       * a 32 bit count (the number of directory entries following the header)
--
--    * a 16 byte directory entry:
--       * a 12 character zero-padded string (the name of the file)
--       * a 32 bit length of the file
--
-- This format is used by Duke Nukem 3D and Redneck Rampage.

data BuildDirectoryEntry = BuildDirectoryEntry {
   buildName   :: FileName,
   buildLength :: FileLength }   -- can be number of directory entries, too

getBuildDirectoryEntry :: Handle -> IO BuildDirectoryEntry
getBuildDirectoryEntry handle = do
   name <- getCString handle 12
   len  <- getFileLength handle
   return (BuildDirectoryEntry { buildName = name, buildLength = len })

buildHandler :: PackHandler
buildHandler handle = do
   header <- getBuildDirectoryEntry handle
   checkMagic "Build" ["KenSilverman"] (buildName header)
   let startOfLumps = (buildLength header + 1) * 16
   return ("Build", 16, 1, buildReader (buildLength header) startOfLumps)

buildReader :: FileLength -> FileOffset -> DirReader
buildReader 0 _ _ = return []
buildReader entriesLeft offset handle = do
   BuildDirectoryEntry lumpNam lumpLen <- getBuildDirectoryEntry handle
   rest <- buildReader (entriesLeft - 1) (offset + lumpLen) handle
   return $ PackDirectoryEntry {
      lumpName       = lumpNam,
      lumpDescriptor = LumpDescriptor { lumpOffset = offset,
                                        lumpLength = lumpLen },
      lumpInfo       = "" } :
           rest

--------------------------------------------------------------------------------
-- Overall zipfile format:
--
--    (<local file header> <file data> <data_descriptor>?)*
--    <central directory header>* <end of central directory record>
--
-- Zip files are a real pain to read and not very well designed. To get the
-- file infos, you basically have two options:
--
--    * Seek to the end of the file and guess the end of central directory
--      record. Because of a possible trailing comment with a *preceding*
--      length, this can only be a guess, nothing more. => DESIGN FLAW!
--      Another point is that we want to be able to nest pack files, so
--      we might not know the end of the file.
--
--    * Jump sequentially from local file header to local file header, thereby
--      collecting the necessary infos. Slow, but the only reliable method.
--      BTW, strace tells me that Quake 3 Arena does it the same way.
--
-- Guess what: We do it the latter way...

--------------------------------------------------------------------------------
-- magics for the different kinds of chunks in a zip file

data ZipMagic = ZipCDHMagic | ZipLFHMagic | ZipEDHMagic | ZipDDMagic

zipMagicLen :: Int
zipMagicLen = 4

getZipMagic :: Handle -> IO ZipMagic
getZipMagic handle = do
   magic <- getString handle 4
   case magic of
      "PK\1\2" -> return ZipCDHMagic
      "PK\3\4" -> return ZipLFHMagic
      "PK\5\6" -> return ZipEDHMagic
      "PK\7\8" -> return ZipDDMagic
      _        -> badMagic "Zip" magic

--------------------------------------------------------------------------------

-- used by local file header and central directory header
data ZipFileInfo = ZipFileInfo {
   zFIVersionNeededToExtract :: Word16,
   zFIGeneralPurposeBitFlag  :: Word16,
   zFICompressionMethod      :: Word16,
   zFILastModDosDatetime     :: Word32,
   zFIDataDescriptor         :: ZipDataDescriptor,
   zFIFilenameLength         :: Word16,
   zFIExtraFieldLength       :: Word16 }

zipFileInfoLen :: Int
zipFileInfoLen = 5 * word16Len + word32Len + zipDataDescriptorLen

getZipFileInfo :: Handle -> IO ZipFileInfo
getZipFileInfo handle = do
   versionNeededToExtract <- getWord16 handle
   generalPurposeBitFlag  <- getWord16 handle
   compressionMethod      <- getWord16 handle
   lastModDosDatetime     <- getWord32 handle
   dataDescriptor         <- getZipDataDescriptor handle
   filenameLength         <- getWord16 handle
   extraFieldLength       <- getWord16 handle
   return $ ZipFileInfo {
      zFIVersionNeededToExtract = versionNeededToExtract,
      zFIGeneralPurposeBitFlag  = generalPurposeBitFlag,
      zFICompressionMethod      = compressionMethod,
      zFILastModDosDatetime     = lastModDosDatetime,
      zFIDataDescriptor         = dataDescriptor,
      zFIFilenameLength         = filenameLength,
      zFIExtraFieldLength       = extraFieldLength }

--------------------------------------------------------------------------------
-- magic "PK\3\4"

data ZipLocalFileHeader = ZipLocalFileHeader {
   zLFHFileInfo   :: ZipFileInfo,
   zLFHFilename   :: String,
   zLFHExtraField :: String }

-- without magic
zipLocalFileHeaderLen :: ZipLocalFileHeader -> Int
zipLocalFileHeaderLen lfh =
   zipFileInfoLen +
   (fromIntegral . zFIFilenameLength   . zLFHFileInfo $ lfh) +
   (fromIntegral . zFIExtraFieldLength . zLFHFileInfo $ lfh)

getZipLocalFileHeader :: Handle -> IO ZipLocalFileHeader
getZipLocalFileHeader handle = do
   fInfo      <- getZipFileInfo handle
   filename   <- getString handle . fromIntegral . zFIFilenameLength   $ fInfo
   extraField <- getString handle . fromIntegral . zFIExtraFieldLength $ fInfo
   return $ ZipLocalFileHeader {
      zLFHFileInfo   = fInfo,
      zLFHFilename   = filename,
      zLFHExtraField = extraField }

--------------------------------------------------------------------------------
-- magic "PK\7\8"

data ZipDataDescriptor = ZipDataDescriptor {
   zDDCrc32  :: Word32,
   zDDCsize  :: Word32,
   zDDUcsize :: Word32 }

-- without magic
zipDataDescriptorLen :: Int
zipDataDescriptorLen = 3 * word32Len

getZipDataDescriptor :: Handle -> IO ZipDataDescriptor
getZipDataDescriptor handle = do
   crc32 <- getWord32 handle
   cSize <- getWord32 handle
   uSize <- getWord32 handle
   return $ ZipDataDescriptor {
      zDDCrc32  = crc32,
      zDDCsize  = cSize,
      zDDUcsize = uSize }

{-------------------------------------------------------------------------------
-- The following two chunks are unused in this library.

-- magic "PK\1\2"
data ZipCentralDirHeader = ZipCentralDirHeader {
   zCDHVersionMadeBy             :: Word16,
   zCDHFileInfo                  :: ZipFileInfo,
   zCDHFileCommentLength         :: Word16,
   zCDHDiskNumberStart           :: Word16,
   zCDHInternalFileAttributes    :: Word16,
   zCDHExternalFileAttributes    :: Word32,
   zCDHRelativeOffsetLocalHeader :: Word32,
   zCDHFilename                  :: String,
   zCDHExtraField                :: String,
   zCDHFileComment               :: String }

-- magic "PK\5\6"
data ZipEndDirHeader = ZipEndDirHeader {
   zEDHNumberThisDisk              :: Word16,
   zEDHNumDiskStartCDir            :: Word16,
   zEDHNumEntriesCentrlDirThsDisk  :: Word16,
   zEDHTotalEntriesCentralDir      :: Word16,
   zEDHSizeCentralDirectory        :: Word32,
   zEDHOffsetStartCentralDirectory :: Word32,
   zEDHZipfileCommentLength        :: Word16,
   zEDHZipfileComment              :: String }

-------------------------------------------------------------------------------}

zipHandler :: PackHandler
zipHandler handle = do
   zipMagic <- getZipMagic handle
   case zipMagic of
      ZipLFHMagic -> return ("Zip", 0, 1, zipReader False 0)
      -- The following alternative ensures that we don't have to deal with
      -- the end of central dir header in the dir reader when the file is empty.
      ZipEDHMagic -> return ("Zip", 0, 0, error "should not happen")
      _           -> ioError (userError "unexpected zip magic")

zipReader :: Bool -> FileOffset -> DirReader
zipReader allowDD offset handle = do
   zipMagic <- getZipMagic handle
   case zipMagic of
      ZipLFHMagic -> do
         lfh <- getZipLocalFileHeader handle
         let fileName = zLFHFilename lfh
             lfhLen   = fromIntegral (zipMagicLen + zipLocalFileHeaderLen lfh)
             fileLen  = zDDCsize . zFIDataDescriptor . zLFHFileInfo $ lfh
         hSeek handle RelativeSeek fileLen
         rest <- zipReader True (offset + lfhLen + fileLen) handle
         return $ if fileLen == 0 && head (reverse fileName) == '/'
                     then rest   -- ignore directory entries
                     else PackDirectoryEntry {
                        lumpName       = fileName,
                        lumpDescriptor = LumpDescriptor {
                           lumpOffset = offset + lfhLen,
                           lumpLength = fileLen },
                        lumpInfo       = zLFHExtraField lfh } :
                        rest
      ZipDDMagic  ->
         if allowDD
            then do getZipDataDescriptor handle
                    let ddLen = fromIntegral (zipMagicLen + zipDataDescriptorLen)
                    zipReader False (offset + ddLen) handle
            else ioError (userError "unexpected zip data descriptor")
      ZipCDHMagic -> return []
      ZipEDHMagic -> ioError (userError "unexpected zip end dir header")

-- #############################################################################
-- the high-level interface
-- #############################################################################

--------------------------------------------------------------------------------

data SearchDescriptor =
     SearchDirectory DirectoryPath   -- try files below given directory
   | SearchPackFile  FilePath        -- try files within given pack file

--------------------------------------------------------------------------------

data SearchDescriptorInternal =
     SearchDir  DirectoryPath
   | SearchPack FilePath PackInfo PackDirectoryTable

newtype PackFinder = PackFinder [SearchDescriptorInternal]

makePackFinder :: [PackHandler] -> [SearchDescriptor] -> IO PackFinder
makePackFinder packHandlers = liftM PackFinder . mapM handleSearchDescriptor
   where handleSearchDescriptor (SearchDirectory dir) = return (SearchDir dir)
         handleSearchDescriptor (SearchPackFile filePath) =
            bracket (openBinaryFile filePath ReadMode) hClose
                    (\handle -> do
                       (info, entries) <- getPackEntries packHandlers handle
                       return (SearchPack filePath info entries))

--------------------------------------------------------------------------------

pGetDirectoryContents :: PackFinder -> DirectoryPath -> IO [FileName]
pGetDirectoryContents (PackFinder searchDescriptors) dirPath = do
   let normDir = normalizeDirectoryPath dirPath
       charsToDrop | null normDir = 0
                   | otherwise    = length normDir + 1
       realEntry name =  name /= "." && name /= ".."
       getDir (SearchDir d) = do
            ret <- try (getDirectoryContents (concPaths d normDir))
            return $ case ret of
                        Right names -> filter realEntry names
                        Left _      -> []
       getDir (SearchPack _ _ entries) = return $
          -- EFFICIENCY ALERT! nub ahead...
          -- PORTABILITY ALERT, TOO! Should use separator here.
          nub [ takeWhile (/='/') . drop charsToDrop $ lumpName e |
                e <- entriesWithPrefix entries normDir ]
   dirEntryLists <- mapM getDir searchDescriptors
   return (concat dirEntryLists)

normalizeDirectoryPath :: DirectoryPath -> DirectoryPath
normalizeDirectoryPath "."            = ""
normalizeDirectoryPath ('.':'/':rest) = rest
normalizeDirectoryPath dirPath        = dirPath

-- TODO
pDoesFileExist :: PackFinder -> FilePath -> IO Bool
pDoesFileExist _packFinder _filePath = return False

-- TODO
pDoesDirectoryExist :: PackFinder -> DirectoryPath -> IO Bool
pDoesDirectoryExist _packFinder _dirPath = return False

--------------------------------------------------------------------------------

pOpenFile :: PackFinder -> FilePath -> IO (Handle, FileLength)
pOpenFile (PackFinder searchDescriptors) filePath = pof searchDescriptors
   where pof []       = ioError (userError (filePath ++ " not found"))
         pof (SearchDir dirPath : sds) = do
            ret <- try (openBinaryFile (concPaths dirPath filePath) ReadMode)
            case ret of
               Right handle -> do
                  len <- hFileSize handle
                  return (handle, fromIntegral len)
               Left _ -> pof sds
         pof (SearchPack packPath _ entries : sds) =
            case lookupTable entries filePath of
               Nothing    -> pof sds
               Just entry -> do
                  handle <- openBinaryFile packPath ReadMode
                  let ld = lumpDescriptor entry
                  hSeek handle RelativeSeek (fromIntegral (lumpOffset ld))
                  return (handle, lumpLength ld)

-- tried in order
knownHandlers :: [PackHandler]
knownHandlers = [ quake1Handler, wad23Handler, sinHandler, zipHandler,
                  doomHandler, buildHandler ]

{-
-- #############################################################################
-- simple test framework
-- #############################################################################

-- Module Printf could be used below, but it isn't because of portability
-- This (and import Array) can be removed when Show LumpDescriptor is rewritten.

instance Show LumpDescriptor where
   showsPrec _ lumpDescr =
      showChar '<' . showHex 8 (lumpOffset lumpDescr) . showChar ',' .
                     showHex 8 (lumpLength lumpDescr) . showChar '>' 

showHex :: Integral a => Int -> a -> ShowS
showHex numDigits x =
   showString "0x" .
   showString (take (max (numDigits - length str) 0) (repeat '0')) .
   showString str
      where str = integralToString 16 x

integralToString :: Integral a => a -> a -> String
integralToString base n = reverse (iToStr n)
   where iToStr m | m < base  = [hexChars ! fromIntegral m]
                  | otherwise = let (q, r) = quotRem m base
                                in (hexChars ! fromIntegral r) : iToStr q

hexChars :: Array Int Char
hexChars = listArray (0,15) "0123456789abcdef"

instance Show PackDirectoryEntry where
   showsPrec _ entry =
      showChar '{' . shows (lumpDescriptor entry) . showChar ' ' .
                     showString (lumpName entry)  . showChar ' ' .
                     showString (lumpInfo entry)  . showChar ' ' .
      showChar '}'

main :: IO ()
main = do
   args   <- getArgs
   case args of
      (dirPath:dirOrPacks) -> do
         searchDescriptors <- mapM makeSearchDescriptor dirOrPacks
         packFinder <- makePackFinder knownHandlers searchDescriptors
         names <- pGetDirectoryContents packFinder dirPath
         mapM_ putStrLn names
--   case args of
--      (fileName:dirOrPacks) -> do
--         searchDescriptors <- mapM makeSearchDescriptor dirOrPacks
--         packFinder <- makePackFinder knownHandlers searchDescriptors
--         (handle, fileLen) <- pOpenFile packFinder fileName
--         print fileLen
--         hClose handle
      [] -> do
         progName <- getProgName
         error ("Usage: " ++ progName ++ " FILE DIR/PACK1 DIR/PACK2...")
  where makeSearchDescriptor name = do
           isDir <- doesDirectoryExist name
           return . (if isDir then SearchDirectory else SearchPackFile) $ name
-}
