content: {- Binary-experiment test -}
  {-# LANGUAGE PackageImports ,FlexibleInstances ,MultiParamTypeClasses#-}
  module PkgCBOR(PkgCBOR(..),C.Serialise,sd) where
  
  import Data.Word
  import Control.Exception
  import Data.Monoid
  import Control.Applicative
  
  import qualified Data.Binary.Serialise.CBOR as C -- (serialise,deserialiseOrFail,Seriali)
  import Data.Binary.Serialise.CBOR (Serialise(..))
  import Data.Binary.Serialise.CBOR.Class
  import Data.Binary.Serialise.CBOR.Encoding hiding (Tokens(..))
  import Data.Binary.Serialise.CBOR.Decoding
  import Data.Binary.Serialise.CBOR.Read
  import Data.Binary.Serialise.CBOR.Write
  
  
  import Types
  import Test.Data
  
  -- t = let Encoding e = C.encode (33::Int32) in e OutStreamEnd
  
  data PkgCBOR a = PkgCBOR a deriving (Eq,Show)
  
  instance Arbitrary a => Arbitrary (PkgCBOR a) where arbitrary = fmap PkgCBOR arbitrary
  
  sd = ("cbor","cbor",serializeF,deserializeF)
  
  serializeF = C.serialise
  deserializeF = either (Left . error . show) Right . C.deserialiseOrFail
  
  {-
  instance Serialise a => Serialize (PkgCBOR a) where
    serialize (PkgCBOR a) = C.serialize $ a
    deserialize = either (Left . toException) (Right . PkgCBOR) . C.deserializeOrFail
  -}
  
  instance Serialise a => Serialize PkgCBOR a where
    serialize (PkgCBOR a) = serializeF a
    deserialize = (PkgCBOR <$>) . deserializeF
    pkg = PkgCBOR
    unpkg (PkgCBOR a) = a
  
  -- instance Serialise N where
  --     encode One = encodeCtr0 1
  --     encode Two = encodeCtr0 2
  --     encode Three = encodeCtr0 3
  --     encode Four = encodeCtr0 4
  --     encode Five = encodeCtr0 5
  
  --     decode = do
  --       (t,l) <- decodeCtrTag
  --       case t of
  --         1 -> decodeCtrBody0 l One
  --         2 -> decodeCtrBody0 l Two
  --         3 -> decodeCtrBody0 l Three
  --         4 -> decodeCtrBody0 l Four
  --         5 -> decodeCtrBody0 l Five
  
  -- instance Serialise a => Serialise (List a) where
  --   encode (N) = encodeCtr0 1
  --   encode (C v l) = encodeCtr2 2 v l
  
  --   decode = do
  --      (t,l) <- decodeCtrTag
  --      case t of
  --        1 -> decodeCtrBody0 l N
  --        2 -> decodeCtrBody2 l C
  
  -- instance Serialise a => Serialise (Tree a) where
  --   encode (Leaf a) = encodeCtr1 1 a
  --   encode (Node n1 n2) = encodeCtr2 2 n1 n2
  
  --   decode = do
  --      (t,l) <- decodeCtrTag
  --      case t of
  --        1 -> decodeCtrBody1 l Leaf
  --        2 -> decodeCtrBody2 l Node
  
  -- {-
  
  -- -- correct?
  -- instance Serialise () where
  --     encode _ = word 0
  --     decode = const () <$> expectInt
  -- -}
  
  -- encodeCtr0 :: Word -> Encoding
  -- encodeCtr1 :: Serialise a => Word -> a -> Encoding
  -- encodeCtr2 :: (Serialise a, Serialise b) => Word -> a -> b -> Encoding
  
  -- encodeCtr0 n     = encodeListLen 1 <> encode (n :: Word)
  -- encodeCtr1 n a   = encodeListLen 2 <> encode (n :: Word) <> encode a
  -- encodeCtr2 n a b = encodeListLen 3 <> encode (n :: Word) <> encode a <> encode b
  -- encodeCtr3 n a b c
  --                  = encodeListLen 4 <> encode (n :: Word) <> encode a <> encode b
  --                       <> encode c
  -- encodeCtr4 n a b c d
  --                  = encodeListLen 5 <> encode (n :: Word) <> encode a <> encode b
  --                       <> encode c <> encode d
  -- encodeCtr6 n a b c d e f
  --                  = encodeListLen 7 <> encode (n :: Word) <> encode a <> encode b
  --                       <> encode c <> encode d <> encode e <> encode f
  -- encodeCtr7 n a b c d e f g
  --                  = encodeListLen 8 <> encode (n :: Word) <> encode a <> encode b
  --                       <> encode c <> encode d <> encode e <> encode f
  --                       <> encode g
  
  -- {-# INLINE encodeCtr0 #-}
  -- {-# INLINE encodeCtr1 #-}
  -- {-# INLINE encodeCtr2 #-}
  -- {-# INLINE encodeCtr3 #-}
  -- {-# INLINE encodeCtr4 #-}
  -- {-# INLINE encodeCtr6 #-}
  -- {-# INLINE encodeCtr7 #-}
  
  -- {-# INLINE decodeCtrTag #-}
  -- {-# INLINE decodeCtrBody0 #-}
  -- {-# INLINE decodeCtrBody1 #-}
  -- {-# INLINE decodeCtrBody2 #-}
  -- {-# INLINE decodeCtrBody3 #-}
  
  -- decodeCtrTag = (\len tag -> (tag, len)) <$> decodeListLen <*> decodeWord
  
  -- decodeCtrBody0 1 f = pure f
  -- decodeCtrBody1 2 f = do x1 <- decode
  --                         return $! f x1
  -- decodeCtrBody2 3 f = do x1 <- decode
  --                         x2 <- decode
  --                         return $! f x1 x2
  -- decodeCtrBody3 4 f = do x1 <- decode
  --                         x2 <- decode
  --                         x3 <- decode
  --                         return $! f x1 x2 x3
  
  -- {-# INLINE decodeSingleCtr0 #-}
  -- {-# INLINE decodeSingleCtr1 #-}
  -- {-# INLINE decodeSingleCtr2 #-}
  -- {-# INLINE decodeSingleCtr3 #-}
  -- {-# INLINE decodeSingleCtr4 #-}
  -- {-# INLINE decodeSingleCtr6 #-}
  -- {-# INLINE decodeSingleCtr7 #-}
  
  -- decodeSingleCtr0 v f = decodeListLenOf 1 *> decodeWordOf v *> pure f
  -- decodeSingleCtr1 v f = decodeListLenOf 2 *> decodeWordOf v *> pure f <*> decode
  -- decodeSingleCtr2 v f = decodeListLenOf 3 *> decodeWordOf v *> pure f <*> decode <*> decode
  -- decodeSingleCtr3 v f = decodeListLenOf 4 *> decodeWordOf v *> pure f <*> decode <*> decode <*> decode
  -- decodeSingleCtr4 v f = decodeListLenOf 5 *> decodeWordOf v *> pure f <*> decode <*> decode <*> decode <*> decode
  -- decodeSingleCtr6 v f = decodeListLenOf 7 *> decodeWordOf v *> pure f <*> decode <*> decode <*> decode <*> decode <*> decode <*> decode
  -- decodeSingleCtr7 v f = decodeListLenOf 8 *> decodeWordOf v *> pure f <*> decode <*> decode <*> decode <*> decode <*> decode <*> decode <*> decode
  
  instance Serialise Car
  instance Serialise Acceleration
  instance Serialise Consumption
  instance Serialise CarModel
  instance Serialise OptionalExtra
  instance Serialise Engine
  instance Serialise Various
  
  instance Serialise N
  instance {-# OVERLAPPABLE #-} Serialise a => Serialise (List a)
  instance {-# OVERLAPPABLE #-} Serialise a => Serialise (Tree a)
  
  instance {-# OVERLAPPING #-} Serialise (Tree N)
  instance {-# OVERLAPPING #-} Serialise (Tree (N,N,N))
  instance {-# OVERLAPPING #-} Serialise [N]
  instance {-# OVERLAPPING #-} Serialise (N,N,N)
  