content: {-# LANGUAGE RecordWildCards #-}
  -- | JSLib file format.
  module Haste.JSLib (createJSLib, readModule) where
  import Control.Applicative
  import Control.Monad
  import Data.Binary
  import qualified Data.ByteString as BS
  import qualified Data.ByteString.Lazy as BSL
  import qualified Data.ByteString.UTF8 as BS
  import Haste.AST
  import System.Directory (doesFileExist)
  import System.IO
  
  jslibMagicNumber :: Word64
  jslibMagicNumber = 0x42494c534a -- "JSLIB\0\0\0"
  
  jslibCurrentVersion :: Word8
  jslibCurrentVersion = 0
  
  jslibMaxSize :: Integer
  jslibMaxSize = 2^(32 :: Int)-1
  
  -- | Static size, ever unchanging part of the file format.
  data JSLibStaticHdr = JSLibStaticHdr {
      hdrMagicNumber :: !Word64, -- ^ Always "JSLIB\0\0\0".
      hdrVersion     :: !Word8,  -- ^ JSLib format version.
      hdrSize        :: !Word32  -- ^ Size of the rest of the header, in bytes.
    }
  
  -- | Library metadata: package ID and info on how to find the actual data.
  data JSLibMetadata = JSLibMetadata {
      mdPkgId       :: !BS.ByteString, -- ^ Library's package ID.
      mdModules     :: ![(BS.ByteString, (Word32, Word32))]
                                       -- ^ Offsets and sizes of all modules in
                                       --   this lib, offsets starting from the
                                       --   end of the header.
    }
  
  data JSLibHdr = JSLibHdr {
      hdrStaticHdr :: JSLibStaticHdr,
      hdrMetadata  :: JSLibMetadata
    }
  
  instance Binary JSLibStaticHdr where
    put JSLibStaticHdr {..} = do
      put hdrMagicNumber
      put hdrVersion
      put hdrSize
    get = do
      JSLibStaticHdr <$> get <*> get <*> get
  
  instance Binary JSLibMetadata where
    put JSLibMetadata {..} = put mdPkgId >> put mdModules
    get = JSLibMetadata <$> get <*> get
  
  instance Binary JSLibHdr where
    put JSLibHdr {..} = put hdrStaticHdr >> put hdrMetadata
    get = JSLibHdr <$> get <*> get
  
  -- | Create a jslib file by the given name, for the package with the given
  --   package key, containing the modules described by the given list of files.
  createJSLib :: FilePath -> BS.ByteString -> [FilePath] -> IO ()
  createJSLib jslibfile pkgid jsmodfiles = do
    mods <- genModOffList 0 jsmodfiles
    let hdr = JSLibHdr {
            hdrStaticHdr = JSLibStaticHdr {
                hdrMagicNumber = jslibMagicNumber,
                hdrVersion = jslibCurrentVersion,
                hdrSize = fromIntegral . BSL.length $ encode (hdrMetadata hdr)
              },
            hdrMetadata = JSLibMetadata {
                mdPkgId = pkgid,
                mdModules = mods
              }
          }
    BSL.writeFile jslibfile $ encode hdr
    mapM_ (BSL.readFile >=> BSL.appendFile jslibfile) jsmodfiles
    where
      genModOffList off (f:fs) = do
        when (off > jslibMaxSize) $ error "jslib became too large!"
        (nm, sz) <- withBinaryFile f ReadMode $ \h -> do
          sz <- hFileSize h
          m <- decode `fmap` BSL.hGetContents h
          when (modPackageId m /= pkgid) $
            error $  "Module package key mismatch: expected " ++ BS.toString pkgid
                  ++ " but saw " ++ BS.toString (modPackageId m)
          return (modName m, sz)
  
        ms <- genModOffList (off + sz) fs
        return $ (nm, (fromIntegral off, fromIntegral sz)) : ms
      genModOffList _ _ = do
        return []
  
  -- | Read a module from a jslib file. Returns @Nothing@ if the jslib file does
  --   not exist or does not contain the requested module.
  readModule :: FilePath -> String -> IO (Maybe Module)
  readModule pkgfile modname = do
    exists <- doesFileExist pkgfile
    if exists
      then withBinaryFile pkgfile ReadMode $ \h -> do
        magic <- decode <$> BSL.hGet h 8
        when (magic /= jslibMagicNumber) $ error "Bad jslib magic number!"
        version <- decode <$> BSL.hGet h 1
        when (version > jslibCurrentVersion) $ error "Bad jslib format version!"
        size <- decode <$> BSL.hGet h 4
        md <- decode <$> BSL.hGet h (fromIntegral (size :: Word32))
        case lookup (BS.fromString modname) $ mdModules md of
          Just (off, sz) -> do
            hSeek h RelativeSeek (fromIntegral off)
            Just . decode <$> BSL.hGet h (fromIntegral sz)
          _ -> do
            return Nothing
      else return Nothing
  