xhb-ewmh 0.1.0.0 → 0.1.0.1

raw patch · 2 files changed

+138/−2 lines, 2 files

Files

• src/Graphics/XHB/Ewmh/Serialize.hs +135/−0
• xhb-ewmh.cabal +3/−2

@@ -0,0 +1,135 @@+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE OverlappingInstances #-}++module Graphics.XHB.Ewmh.Serialize (Serialize(..)) where++import Control.Monad (replicateM_)+import Data.Binary.Get+import Data.Binary.Put+import Data.Char (chr, ord)+import Data.List (intersperse)+import Data.Word (Word8, Word32)+import Graphics.XHB+import qualified Data.ByteString.Lazy as B+import qualified Data.ByteString.Lazy.Char8 as C+import qualified Data.DList as DL++putSkip8 :: Int -> Put+putSkip8 n = replicateM_ n $ putWord8 0++putSkip16 :: Int -> Put+putSkip16 n = replicateM_ n $ putWord16host 0++putSkip32 :: Int -> Put+putSkip32 n = replicateM_ n $ putWord32host 0++class Serialize a where+    serialize :: a -> Put++    toBytes :: a -> [Word8]+    toBytes = B.unpack . runPut . serialize++    deserialize :: Get a++    fromBytes :: [Word8] -> Either String a+    fromBytes bs = case runGetOrFail deserialize (B.pack bs) of+        Right (_, _, a) -> Right a+        Left  (_, _, e) -> Left e++    serializeList :: [a] -> Put+    serializeList = mapM_ serialize++    deserializeList :: Get [a]+    deserializeList = fmap DL.toList $ loop DL.empty+        where+        loop as = do+            b <- isEmpty+            if b then return as+                 else deserialize >>= loop . DL.snoc as++instance Serialize a => Serialize [a] where+    serialize = serializeList+    deserialize = deserializeList++instance (Serialize a, Serialize b) => Serialize (a, b) where+    serialize (a,b) = serialize a >> serialize b+    deserialize = do+        a <- deserialize+        b <- deserialize+        return (a, b)++instance (Serialize a, Serialize b, Serialize c) => Serialize (a, b, c) where+    serialize (a,b,c) = serialize a >> serialize b >> serialize c+    deserialize = do+        a <- deserialize+        b <- deserialize+        c <- deserialize+        return (a, b, c)++instance (Serialize a, Serialize b, Serialize c, Serialize d) => Serialize (a, b, c, d) where+    serialize (a,b,c,d) = serialize a >> serialize b >> serialize c >> serialize d+    deserialize = do+        a <- deserialize+        b <- deserialize+        c <- deserialize+        d <- deserialize+        return (a, b, c, d)++instance Serialize Char where+    serialize = putWord8 . fromIntegral . ord+    deserialize = fmap (chr . fromIntegral) getWord8++instance Serialize String where+    serialize = mapM_ serialize++    deserialize = fmap C.unpack getRemainingLazyByteString++    serializeList = mapM_ putWord8 . map (fromIntegral . ord) . concat . intersperse "\0"++    deserializeList = fmap (init_ . convert) getRemainingLazyByteString+        where nul      = fromIntegral . ord $ '\0'+              convert  = map C.unpack . B.splitWith (== nul)+              init_ [] = []+              init_ xs = init xs++instance Serialize Word8 where+    serialize = putWord8+    deserialize = getWord8++instance Serialize Word32 where+    serialize = putWord32host+    deserialize = getWord32host++instance Serialize Int where+    -- this might cause some breakage, but practically `#define`s are not < 0+    serialize = putWord32host . fromIntegral+    deserialize = fmap fromIntegral getWord32host++instance Serialize ATOM where+    serialize   = putWord32host . fromXid . toXid+    deserialize = fmap (fromXid . toXid) getWord32host++instance Serialize WINDOW where+    serialize   = putWord32host . fromXid . toXid+    deserialize = fmap (fromXid . toXid) getWord32host++instance Serialize ClientMessageEvent where+    serialize (MkClientMessageEvent fmt win typ dat) = do+        putWord8 33 -- 33 ^= ClientMessageEvent+        putWord8 fmt+        putSkip8 2+        serialize win+        serialize typ+        serialize dat++    deserialize = error "deserialize for ClientMessageEvent not implemented"++instance Serialize ClientMessageData where+    serialize (ClientData8  ws) = do mapM_ putWord8 ws+                                     putSkip8 (20 - length ws)+    serialize (ClientData16 ws) = do mapM_ putWord16host ws+                                     putSkip16 (10 - length ws)+    serialize (ClientData32 ws) = do mapM_ putWord32host ws+                                     putSkip32 (5 - length ws)++    deserialize = error "deserialize for ClientMessageData not implemented"

@@ -1,5 +1,5 @@ name:                xhb-ewmh-version:             0.1.0.0+version:             0.1.0.1 synopsis:            EWMH utilities for XHB description:         EWMH utilities for XHB license:             BSD2@@ -32,7 +32,8 @@   exposed-modules:     Graphics.XHB.Ewmh,                        Graphics.XHB.Ewmh.Atoms,                        Graphics.XHB.Ewmh.Types,-                       Graphics.XHB.Ewmh.Values+                       Graphics.XHB.Ewmh.Values,+                       Graphics.XHB.Ewmh.Serialize    other-extensions:    DeriveDataTypeable,                        FlexibleContexts,