module Info.Binary(putInfo, Info.Binary.getInfo) where

import Data.Dynamic
import qualified Data.Map as Map

import C.FFI(FfiExport)
import Data.Binary
import E.CPR
import GenUtil
import Info.Info
import Info.Types
import Util.BitSet as BS
import qualified E.Demand

data Binable = forall a . (Typeable a, Binary a, Show a) => Binable a

u :: (Typeable a, Binary a) => a
u = u

newEntry x = Entry { entryThing = toDyn x, entryString = show x, entryType = typeOf x }

cb n x = (n, Binable x, typeOf x)

-- Note: the numbers here are part of the ABI of the serialized files.
-- If you change them then you must change the ABI version number in
-- Ho.Binary and invalidate all old files.
binTableValues =  [
    cb 1 (u :: Properties),
    cb 2 (u :: E.CPR.Val),
    cb 3 (u :: FfiExport),
    cb 4 (u :: E.Demand.DemandSignature)
    ]

binTable :: Map.Map Word8 Binable
binTable = Map.fromList [ (n,x) | (n,x,_) <- binTableValues ]

revBinTable :: [(TypeRep,(Word8,Binable))]
revBinTable = [ (t,(n,x)) | (n,x,t) <- binTableValues ]

putDyn :: (Word8,Dynamic,Binable) -> Put
putDyn (ps,d,Binable (_::a)) = do
    put ps
    put (fromDyn d (error (show d)) :: a)

getDyn = do
    (ps::Word8) <- get
    case Map.lookup ps binTable of
        Just (Binable (_ :: a)) -> do
            x <- get :: Get a
            return $ newEntry x
        Nothing -> fail $ "getDyn: don't know how to read something of type: " ++ show ps

instance Binary Properties where
    put (Properties (EBS props)) = put (fromIntegral $ BS.toWord props :: Word32)
    get = (get :: Get Word32) >>= return . Properties . EBS . BS.fromWord . fromIntegral

instance Binary Info where
    put nfo = putInfo nfo
    get = Info.Binary.getInfo

putInfo :: Info.Info.Info -> Put
putInfo (Info ds) = do
    let ds' = concatMap (\d -> do
            case Prelude.lookup (entryType d) revBinTable of
              Just (ps,x)  -> return (ps,entryThing d,x)
              Nothing -> fail "key not found"
          ) ds
    putWord8 (fromIntegral $ length ds')
    mapM_ putDyn ds'

getInfo :: Get Info.Info.Info
getInfo = do
    n <- getWord8
    xs <- replicateM (fromIntegral n) getDyn
    return (Info xs)