Extract game files from Vagante. UPDATE: See https://github.com/mtolly/vagante-extract for new version

vra.hs

{- |
Extracts and injects files from the game Vagante's data.vra.
The format (after a 0x18-byte-long header) is a simple repeating pattern:
- length of filename (4 bytes little-endian)
- filename
- length of file data (4 bytes little-endian)
- file data
The files themselves are all nice standard formats:
OGG, WAV, PNG, JSON, TTF, and OpenGL fragment shader.
-}
{-# LANGUAGE LambdaCase #-}
module Main (main) where

import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BL8
import Data.Binary.Get
import Data.Binary.Put
import System.Directory
import System.FilePath
import System.Environment (getArgs)
import Control.Monad (forM, forM_)
import Data.List (sort)

-- | Extracts the contents of data.vra into a directory.
extract :: FilePath -> FilePath -> IO ()
extract vra dir = do
  bs <- BL.readFile vra
  let files = runGet splitFiles $ BL.drop 0x18 bs
  forM_ files $ \(name, file) -> do
    let out = dir </> BL8.unpack name
    putStrLn $ "Extracting " ++ out
    createDirectoryIfMissing True $ takeDirectory out
    BL.writeFile out file

data FileType
  = Image
  | Jingle
  | Other
  deriving (Eq, Ord, Show, Read, Enum, Bounded)

assignType :: FilePath -> IO FileType
assignType f = case takeExtension f of
  ".png" -> return Image
  ".wav" -> do
    -- See if it's at least 10 seconds
    wav <- BL.readFile f
    let bytesPerSec = runGet (skip 28 >> getWord32le) wav
        bytes = runGet (skip 40 >> getWord32le) wav
        secs = fromIntegral bytes / fromIntegral bytesPerSec :: Double
    return $ if secs < 10 then Jingle else Other
  _ -> return Other

-- | Sorts a list of files into images, short sound effects, and other.
vaganteSort :: FilePath -> [FilePath] -> IO ([FilePath], [FilePath], [FilePath])
vaganteSort dir files = do
  types <- mapM (assignType . (dir </>)) files
  let pairs   = zip files types
      images  = sorter [ f | (f, Image ) <- pairs ]
      jingles = sorter [ f | (f, Jingle) <- pairs ]
      others  = sorter [ f | (f, Other ) <- pairs ]
      sorter fs = map snd $ sort $ map (\f -> (extNumber f, f)) fs
      extNumber f = case takeExtension f of
        ".png"  -> 0 :: Int
        ".wav"  -> 1
        ".ogg"  -> 2
        ".ttf"  -> 3
        ".frag" -> 4
        ".json" -> 5
        _       -> 6
  return (images, jingles, others)

-- | Collects the contents of a directory into a new data.vra.
archive :: FilePath -> FilePath -> IO ()
archive dir vra = do
  (images, jingles, others) <- listRecursive dir >>= vaganteSort dir
  forM_ [(images, "images"), (jingles, "jingles"), (others, "others")] $ \(files, filetype) -> do
    putStrLn $ show (length files) ++ " " ++ filetype ++ ":"
    mapM_ (putStrLn . ("  " ++)) files
  let files = images ++ jingles ++ others
  fileContents <- forM files $ \name -> do
    contents <- fmap BL.fromStrict $ B.readFile $ dir </> name
    return (BL8.pack name, contents)
  BL.writeFile vra $ runPut $ do
    putWord32le 5
    putWord32le $ fromIntegral $ length images
    putWord32le $ fromIntegral $ length jingles
    putWord32le 9
    putWord32le 1
    putWord32le 1
    joinFiles fileContents

listRecursive :: FilePath -> IO [FilePath]
listRecursive dir = do
  ents <- getDirectoryContents dir
  fmap concat $ forM (filter (\f -> take 1 f /= ".") ents) $ \ent -> do
    isFile <- doesFileExist $ dir </> ent
    if isFile
      then return [ent]
      else fmap (map (ent </>)) $ listRecursive (dir </> ent)

main :: IO ()
main = getArgs >>= \case
  ["extract", vra, dir] -> extract vra dir
  ["archive", dir, vra] -> archive dir vra
  [x] -> case splitExtension x of
    (dir, ".vra") -> extract x dir
    _             -> archive x $ x <.> "vra"
  _ -> error "incorrect usage"

splitFiles :: Get [(BL.ByteString, BL.ByteString)]
splitFiles = do
  eof <- isEmpty
  if eof
    then return []
    else do
      slen <- getWord32le
      s <- getLazyByteString $ fromIntegral slen
      flen <- getWord32le
      f <- getLazyByteString $ fromIntegral flen
      rest <- splitFiles
      return $ (s, f) : rest

joinFiles :: [(BL.ByteString, BL.ByteString)] -> Put
joinFiles = mapM_ $ \(name, file) -> do
  putWord32le $ fromIntegral $ BL.length name
  putLazyByteString name
  putWord32le $ fromIntegral $ BL.length file
  putLazyByteString file

This version no longer works with the current game; I've updated it here: https://github.com/mtolly/vagante-extract