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