{-# OPTIONS_GHC -fno-cse #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
---------------------------------------------------------
-- |
-- Copyright   : (c) 2006-2016, alpheccar.org
-- License     : BSD-style
--
-- Maintainer  : misc@NOSPAMalpheccar.org
-- Stability   : experimental
-- Portability : portable
--
-- Serializer
---------------------------------------------------------
-- #hide
module Graphics.PDF.LowLevel.Serializer(
  SerializeValue(..)
 ) where
   
import Data.Word 
import qualified Data.ByteString.Lazy as B
import qualified Data.Binary.Builder as BU
import qualified Data.ByteString.Lazy.Char8 as C
import Foreign.Ptr(Ptr)
import Data.ByteString.Internal
import qualified Data.ByteString.Lazy.Internal as L(ByteString(..))

import System.IO.Unsafe

foreign import ccall "conversion.h c_floatToString" cfloatToString :: Double -> Ptr Word8 -> IO Int
foreign import ccall "conversion.h c_shortToString" cshortToString :: Int -> Ptr Word8 -> IO Int



class (Monoid s) => SerializeValue s a where
    serialize :: a -> s
    cons :: a -> s -> s
    cons a
a s
b = (a -> s
forall s a. SerializeValue s a => a -> s
serialize a
a) s -> s -> s
forall a. Monoid a => a -> a -> a
`mappend` s
b
    
instance SerializeValue B.ByteString Word8 where
    serialize :: Word8 -> ByteString
serialize = Word8 -> ByteString
B.singleton
    cons :: Word8 -> ByteString -> ByteString
cons = Word8 -> ByteString -> ByteString
B.cons
    
instance SerializeValue B.ByteString Char where
    serialize :: Char -> ByteString
serialize = Char -> ByteString
C.singleton
    cons :: Char -> ByteString -> ByteString
cons = Char -> ByteString -> ByteString
C.cons  
    
instance SerializeValue B.ByteString [Char] where
    serialize :: [Char] -> ByteString
serialize = [Char] -> ByteString
C.pack
    
instance SerializeValue B.ByteString B.ByteString where
    serialize :: ByteString -> ByteString
serialize = ByteString -> ByteString
forall a. a -> a
id
    
convertShort :: Int -> ByteString    
convertShort :: Int -> ByteString
convertShort Int
a = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (Int -> (Ptr Word8 -> IO Int) -> IO ByteString
createAndTrim Int
12 (Int -> Ptr Word8 -> IO Int
cshortToString Int
a))
{-# NOINLINE convertShort #-}

convertFloat :: Double -> ByteString  
convertFloat :: Double -> ByteString
convertFloat Double
a = IO ByteString -> ByteString
forall a. IO a -> a
unsafePerformIO (Int -> (Ptr Word8 -> IO Int) -> IO ByteString
createAndTrim Int
12 (Double -> Ptr Word8 -> IO Int
cfloatToString Double
a))
{-# NOINLINE convertFloat #-}
    
instance SerializeValue B.ByteString Int where
    serialize :: Int -> ByteString
serialize Int
a = ByteString -> ByteString -> ByteString
L.Chunk (Int -> ByteString
convertShort Int
a) ByteString
L.Empty
 
instance SerializeValue B.ByteString Double where
    serialize :: Double -> ByteString
serialize Double
a = ByteString -> ByteString -> ByteString
L.Chunk (Double -> ByteString
convertFloat Double
a) ByteString
L.Empty

    
instance SerializeValue BU.Builder Word8 where
    serialize :: Word8 -> Builder
serialize = Word8 -> Builder
BU.singleton

instance SerializeValue BU.Builder Char where
    serialize :: Char -> Builder
serialize = Word8 -> Builder
BU.singleton (Word8 -> Builder) -> (Char -> Word8) -> Char -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Word8
c2w
    
instance SerializeValue BU.Builder [Char] where
    serialize :: [Char] -> Builder
serialize = ByteString -> Builder
BU.fromLazyByteString (ByteString -> Builder)
-> ([Char] -> ByteString) -> [Char] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
forall s a. SerializeValue s a => a -> s
serialize

instance SerializeValue BU.Builder B.ByteString where
    serialize :: ByteString -> Builder
serialize = ByteString -> Builder
BU.fromLazyByteString

instance SerializeValue BU.Builder Int where
    serialize :: Int -> Builder
serialize = ByteString -> Builder
BU.fromLazyByteString (ByteString -> Builder) -> (Int -> ByteString) -> Int -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString
forall s a. SerializeValue s a => a -> s
serialize

instance SerializeValue BU.Builder Double where
    serialize :: Double -> Builder
serialize = ByteString -> Builder
BU.fromLazyByteString (ByteString -> Builder)
-> (Double -> ByteString) -> Double -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> ByteString
forall s a. SerializeValue s a => a -> s
serialize