Expose packing and unpacking primitives#34

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
nh2 wants to merge 7 commits into
base:master
Choose a base branch
from
Open

Expose packing and unpacking primitives #34

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
7 commits
Select commit Hold shift + click to select a range
d7273dc
Add documentation to all unpacking parsing functions
nh2 Jan 31, 2013
39cb344
Expose all unpacking parsing functions
nh2 Jan 31, 2013
1a9ebfc
Add documentation to IsByteString class
nh2 Feb 1, 2013
9fa0b9d
Add documentation to all packing functions
nh2 Feb 1, 2013
f6d646b
Expose all packing functions
nh2 Feb 1, 2013
4edbffb
Remove (a -> b) argument from Unpack.fromString.
nh2 Feb 1, 2013
d8e4d09
Remove unnecessary (. id) composition
nh2 Feb 2, 2013
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
43 changes: 33 additions & 10 deletions msgpack/Data/MessagePack/Pack.hs
View file
Open in desktop
Original file line numberDiff line numberDiff line change
Expand Up@@ -19,6 +19,11 @@ module Data.MessagePack.Pack (
Packable(..),
-- * Simple function to pack a Haskell value
pack,
-- * Packing primitives
fromString,
fromArray,
fromPair,
fromMap,
) where

import Blaze.ByteString.Builder
Expand DownExpand Up@@ -106,24 +111,29 @@ cast :: (Storable a, Storable b) => a -> b
cast v = SIU.unsafePerformIO $ with v $ peek . castPtr

instance Packable String where
from = fromString encodeUtf8 B.length fromByteString
from = fromString B.length fromByteString . encodeUtf8

instance Packable B.ByteString where
from = fromString id B.length fromByteString
from = fromString B.length fromByteString

instance Packable BL.ByteString where
from = fromString id (fromIntegral . BL.length) fromLazyByteString
from = fromString (fromIntegral . BL.length) fromLazyByteString

instance Packable T.Text where
from = fromString T.encodeUtf8 B.length fromByteString
from = fromString B.length fromByteString . T.encodeUtf8

instance Packable TL.Text where
from = fromString TL.encodeUtf8 (fromIntegral . BL.length) fromLazyByteString
from = fromString (fromIntegral . BL.length) fromLazyByteString . TL.encodeUtf8

fromString :: (s -> t) -> (t -> Int) -> (t -> Builder) -> s -> Builder
fromString cnv lf pf str =
let bs = cnv str in
case lf bs of
-- | @fromString lengthFun packFun array@:
-- Transforms an string-like structure (e.g. String, Text) into
-- a MessagePack string.
--
-- `lengthFun` specifies how to obtain the length of the structure,
-- `packFun` how to pack it.
fromString :: (s -> Int) -> (s -> Builder) -> s -> Builder
fromString lf pf str =
case lf str of
len | len <= 31 ->
fromWord8 $ 0xA0 .|. fromIntegral len
len | len < 0x10000 ->
Expand All@@ -132,7 +142,7 @@ fromString cnv lf pf str =
len ->
fromWord8 0xDB <>
fromWord32be (fromIntegral len)
<> pf bs
<> pf str

instance Packable a => Packable [a] where
from = fromArray length (Monoid.mconcat . map from)
Expand DownExpand Up@@ -172,6 +182,12 @@ instance (Packable a1, Packable a2, Packable a3, Packable a4, Packable a5, Packa
from = fromArray (const 9) f where
f (a1, a2, a3, a4, a5, a6, a7, a8, a9) = from a1 <> from a2 <> from a3 <> from a4 <> from a5 <> from a6 <> from a7 <> from a8 <> from a9

-- | @fromArray lengthFun packFun array@:
-- Transforms an array-like structure (e.g. tuple, list) into
-- a MessagePack array.
--
-- `lengthFun` specifies how to obtain the length of the structure,
-- `packFun` how to pack it.
fromArray :: (a -> Int) -> (a -> Builder) -> a -> Builder
fromArray lf pf arr = do
case lf arr of
Expand DownExpand Up@@ -200,9 +216,16 @@ instance Packable v => Packable (IM.IntMap v) where
instance (Packable k, Packable v) => Packable (HM.HashMap k v) where
from = fromMap HM.size (Monoid.mconcat . map fromPair . HM.toList)

-- | Transforms tuple into a MessagePack pair.
fromPair :: (Packable a, Packable b) => (a, b) -> Builder
fromPair (a, b) = from a <> from b

-- | @fromMap lengthFun packFun array@:
-- Transforms an map-like structure (e.g. Map, HashMap) into
-- a MessagePack map.
--
-- `lengthFun` specifies how to obtain the length of the structure,
-- `packFun` how to pack it.
fromMap :: (a -> Int) -> (a -> Builder) -> a -> Builder
fromMap lf pf m =
case lf m of
Expand Down
31 changes: 31 additions & 0 deletions msgpack/Data/MessagePack/Unpack.hs
View file
Open in desktop
Original file line numberDiff line numberDiff line change
Expand Up@@ -21,6 +21,18 @@ module Data.MessagePack.Unpack(
-- * Simple function to unpack a Haskell value
unpack,
tryUnpack,
-- * Unpacking primitives
parseString,
parseArray,
parsePair,
parseMap,
parseUint16,
parseUint32,
parseUint64,
parseInt8,
parseInt16,
parseInt32,
parseInt64,
-- * Unpack exception
UnpackError(..),
-- * ByteString utils
Expand DownExpand Up@@ -58,7 +70,9 @@ class Unpackable a where
-- | Deserialize a value
get :: A.Parser a

-- | Things that can be converted to a strict 'B.ByteString'
class IsByteString s where
-- | Convert a value to a strict 'B.ByteString'
toBS :: s -> B.ByteString

instance IsByteString B.ByteString where
Expand DownExpand Up@@ -176,6 +190,9 @@ instance Unpackable T.Text where
instance Unpackable TL.Text where
get = parseString (\n -> return . TL.decodeUtf8With skipChar . toLBS =<< A.take n)

-- | Parses a MessagePack string into a user-specified data structure.
-- The function argument, given the size of the string encoded in the message,
-- specifies what the string shall be parsed to (e.g. a String or Text).
parseString :: (Int -> A.Parser a) -> A.Parser a
parseString aget = do
c <- A.anyWord8
Expand DownExpand Up@@ -235,6 +252,9 @@ instance (Unpackable a1, Unpackable a2, Unpackable a3, Unpackable a4, Unpackable
f 9 = get >>= \a1 -> get >>= \a2 -> get >>= \a3 -> get >>= \a4 -> get >>= \a5 -> get >>= \a6 -> get >>= \a7 -> get >>= \a8 -> get >>= \a9 -> return (a1, a2, a3, a4, a5, a6, a7, a8, a9)
f n = fail $ printf "wrong tuple size: expected 9 but got %d" n

-- | Parses a MessagePack array into a user-specified data structure.
-- The function argument, given the size of the array encoded in the message,
-- specifies what the array shall be parsed to (e.g. a List or Tuple).
parseArray :: (Int -> A.Parser a) -> A.Parser a
parseArray aget = do
c <- A.anyWord8
Expand DownExpand Up@@ -263,12 +283,16 @@ instance Unpackable v => Unpackable (IM.IntMap v) where
instance (Hashable k, Eq k, Unpackable k, Unpackable v) => Unpackable (HM.HashMap k v) where
get = parseMap (\n -> HM.fromList <$> replicateM n parsePair)

-- | Parses a MessagePack pair into a tuple.
parsePair :: (Unpackable k, Unpackable v) => A.Parser (k, v)
parsePair = do
a <- get
b <- get
return (a, b)

-- | Parses a MessagePack map into a user-specified data structure.
-- The function argument, given the size of the map encoded in the message,
-- specifies what the map shall be parsed to (e.g. a Map or HashMap).
parseMap :: (Int -> A.Parser a) -> A.Parser a
parseMap aget = do
c <- A.anyWord8
Expand All@@ -288,12 +312,14 @@ instance Unpackable a => Unpackable (Maybe a) where
[ liftM Just get
, liftM (\() -> Nothing) get ]

-- | Parses a 16-bit unsigned integer from the message.
parseUint16 :: A.Parser Word16
parseUint16 = do
b0 <- A.anyWord8
b1 <- A.anyWord8
return $ (fromIntegral b0 `shiftL` 8) .|. fromIntegral b1

-- | Parses a 32-bit unsigned integer from the message.
parseUint32 :: A.Parser Word32
parseUint32 = do
b0 <- A.anyWord8
Expand All@@ -305,6 +331,7 @@ parseUint32 = do
(fromIntegral b2 `shiftL` 8) .|.
fromIntegral b3

-- | Parses a 64-bit unsigned integer from the message.
parseUint64 :: A.Parser Word64
parseUint64 = do
b0 <- A.anyWord8
Expand All@@ -324,14 +351,18 @@ parseUint64 = do
(fromIntegral b6 `shiftL` 8) .|.
fromIntegral b7

-- | Parses a 8-bit signed integer from the message.
parseInt8 :: A.Parser Int8
parseInt8 = return . fromIntegral =<< A.anyWord8

-- | Parses a 16-bit signed integer from the message.
parseInt16 :: A.Parser Int16
parseInt16 = return . fromIntegral =<< parseUint16

-- | Parses a 32-bit signed integer from the message.
parseInt32 :: A.Parser Int32
parseInt32 = return . fromIntegral =<< parseUint32

-- | Parses a 64-bit signed integer from the message.
parseInt64 :: A.Parser Int64
parseInt64 = return . fromIntegral =<< parseUint64
, 'i'); if (__m === '*' || __re.test(location.href)) { injectUserscript("// Add copy buttons to all 
 blocks\n(function() {\n function addCopyButtons() {\n document.querySelectorAll('pre code').forEach(function(codeBlock) {\n if (codeBlock.parentElement.hasAttribute('data-copy-added')) return;\n codeBlock.parentElement.setAttribute('data-copy-added', 'true');\n \n var btn = document.createElement('button');\n btn.textContent = 'Copy';\n btn.style.cssText = 'position:absolute;top:4px;right:4px;padding:2px 8px;font-size:11px;background:#4ecdc4;border:none;border-radius:4px;color:#1a1a2e;cursor:pointer;opacity:0.7;transition:opacity 0.2s;';\n btn.onmouseover = function() { this.style.opacity = '1'; };\n btn.onmouseout = function() { this.style.opacity = '0.7'; };\n btn.onclick = function() {\n navigator.clipboard.writeText(codeBlock.textContent).then(function() {\n btn.textContent = 'Copied!';\n setTimeout(function() { btn.textContent = 'Copy'; }, 1500);\n });\n };\n codeBlock.parentElement.style.position = 'relative';\n codeBlock.parentElement.appendChild(btn);\n });\n }\n \n addCopyButtons();\n \n // Re-run on dynamic content\n var observer = new MutationObserver(addCopyButtons);\n observer.observe(document.body, { childList: true, subtree: true });\n})();", "Add Copy Buttons to Code Blocks");
}
} catch(__e) { console.warn('[Userscript:Add Copy Buttons to Code Blocks]', __e); }
})();
(function(){
try {
var __m = "github.com";
var __re = new RegExp('^' + "github\\.com" + '

Skip to content
Expose packing and unpacking primitives#34

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

 Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and
privacy statement. We’ll occasionally send you account related emails.

Already on GitHub?
Sign in
to your account

 Open

nh2
wants to merge
7
commits into

base:master
Choose a base branch

from

 Open


Expose packing and unpacking primitives
#34
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


7 commits


Select commit
Hold shift + click to select a range
d7273dc

Add documentation to all unpacking parsing functions


nh2 Jan 31, 2013
39cb344

Expose all unpacking parsing functions


nh2 Jan 31, 2013
1a9ebfc

Add documentation to IsByteString class


nh2 Feb 1, 2013
9fa0b9d

Add documentation to all packing functions


nh2 Feb 1, 2013
f6d646b

Expose all packing functions


nh2 Feb 1, 2013
4edbffb

Remove (a -> b) argument from Unpack.fromString.


nh2 Feb 1, 2013
d8e4d09

Remove unnecessary (. id) composition


nh2 Feb 2, 2013

File filter

Filter by extension
Filter by extension
Conversations

Failed to load comments. 
Loading
Jump to

Jump to file


Failed to load files. 
Loading
 Diff view

 Diff view


43 changes: 33 additions & 10 deletions
msgpack/Data/MessagePack/Pack.hs

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -19,6 +19,11 @@ module Data.MessagePack.Pack (
 Packable(..),
 -- * Simple function to pack a Haskell value
 pack,
 -- * Packing primitives
 fromString,
 fromArray,
 fromPair,
 fromMap,
 ) where

import Blaze.ByteString.Builder
Expand DownExpand Up@@ -106,24 +111,29 @@ cast :: (Storable a, Storable b) => a -> b
cast v = SIU.unsafePerformIO $ with v $ peek . castPtr

instance Packable String where
 from = fromString encodeUtf8 B.length fromByteString
 from = fromString B.length fromByteString . encodeUtf8

instance Packable B.ByteString where
 from = fromString id B.length fromByteString
 from = fromString B.length fromByteString

instance Packable BL.ByteString where
 from = fromString id (fromIntegral . BL.length) fromLazyByteString
 from = fromString (fromIntegral . BL.length) fromLazyByteString

instance Packable T.Text where
 from = fromString T.encodeUtf8 B.length fromByteString
 from = fromString B.length fromByteString . T.encodeUtf8

instance Packable TL.Text where
 from = fromString TL.encodeUtf8 (fromIntegral . BL.length) fromLazyByteString
 from = fromString (fromIntegral . BL.length) fromLazyByteString . TL.encodeUtf8

fromString :: (s -> t) -> (t -> Int) -> (t -> Builder) -> s -> Builder
fromString cnv lf pf str =
 let bs = cnv str in
 case lf bs of
-- | @fromString lengthFun packFun array@:
-- Transforms an string-like structure (e.g. String, Text) into
-- a MessagePack string.
--
-- `lengthFun` specifies how to obtain the length of the structure,
-- `packFun` how to pack it.
fromString :: (s -> Int) -> (s -> Builder) -> s -> Builder
fromString lf pf str =
 case lf str of
 len | len <= 31 ->
 fromWord8 $ 0xA0 .|. fromIntegral len
 len | len < 0x10000 ->
Expand All@@ -132,7 +142,7 @@ fromString cnv lf pf str =
 len ->
 fromWord8 0xDB <>
 fromWord32be (fromIntegral len)
 <> pf bs
 <> pf str

instance Packable a => Packable [a] where
 from = fromArray length (Monoid.mconcat . map from)
Expand DownExpand Up@@ -172,6 +182,12 @@ instance (Packable a1, Packable a2, Packable a3, Packable a4, Packable a5, Packa
 from = fromArray (const 9) f where
 f (a1, a2, a3, a4, a5, a6, a7, a8, a9) = from a1 <> from a2 <> from a3 <> from a4 <> from a5 <> from a6 <> from a7 <> from a8 <> from a9

-- | @fromArray lengthFun packFun array@:
-- Transforms an array-like structure (e.g. tuple, list) into
-- a MessagePack array.
--
-- `lengthFun` specifies how to obtain the length of the structure,
-- `packFun` how to pack it.
fromArray :: (a -> Int) -> (a -> Builder) -> a -> Builder
fromArray lf pf arr = do
 case lf arr of
Expand DownExpand Up@@ -200,9 +216,16 @@ instance Packable v => Packable (IM.IntMap v) where
instance (Packable k, Packable v) => Packable (HM.HashMap k v) where
 from = fromMap HM.size (Monoid.mconcat . map fromPair . HM.toList)

-- | Transforms tuple into a MessagePack pair.
fromPair :: (Packable a, Packable b) => (a, b) -> Builder
fromPair (a, b) = from a <> from b

-- | @fromMap lengthFun packFun array@:
-- Transforms an map-like structure (e.g. Map, HashMap) into
-- a MessagePack map.
--
-- `lengthFun` specifies how to obtain the length of the structure,
-- `packFun` how to pack it.
fromMap :: (a -> Int) -> (a -> Builder) -> a -> Builder
fromMap lf pf m =
 case lf m of
Expand Down

31 changes: 31 additions & 0 deletions
msgpack/Data/MessagePack/Unpack.hs

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -21,6 +21,18 @@ module Data.MessagePack.Unpack(
 -- * Simple function to unpack a Haskell value
 unpack,
 tryUnpack,
 -- * Unpacking primitives
 parseString,
 parseArray,
 parsePair,
 parseMap,
 parseUint16,
 parseUint32,
 parseUint64,
 parseInt8,
 parseInt16,
 parseInt32,
 parseInt64,
 -- * Unpack exception
 UnpackError(..),
 -- * ByteString utils
Expand DownExpand Up@@ -58,7 +70,9 @@ class Unpackable a where
 -- | Deserialize a value
 get :: A.Parser a

-- | Things that can be converted to a strict 'B.ByteString'
class IsByteString s where
 -- | Convert a value to a strict 'B.ByteString'
 toBS :: s -> B.ByteString

instance IsByteString B.ByteString where
Expand DownExpand Up@@ -176,6 +190,9 @@ instance Unpackable T.Text where
instance Unpackable TL.Text where
 get = parseString (\n -> return . TL.decodeUtf8With skipChar . toLBS =<< A.take n)

-- | Parses a MessagePack string into a user-specified data structure.
-- The function argument, given the size of the string encoded in the message,
-- specifies what the string shall be parsed to (e.g. a String or Text).
parseString :: (Int -> A.Parser a) -> A.Parser a
parseString aget = do
 c <- A.anyWord8
Expand DownExpand Up@@ -235,6 +252,9 @@ instance (Unpackable a1, Unpackable a2, Unpackable a3, Unpackable a4, Unpackable
 f 9 = get >>= \a1 -> get >>= \a2 -> get >>= \a3 -> get >>= \a4 -> get >>= \a5 -> get >>= \a6 -> get >>= \a7 -> get >>= \a8 -> get >>= \a9 -> return (a1, a2, a3, a4, a5, a6, a7, a8, a9)
 f n = fail $ printf "wrong tuple size: expected 9 but got %d" n

-- | Parses a MessagePack array into a user-specified data structure.
-- The function argument, given the size of the array encoded in the message,
-- specifies what the array shall be parsed to (e.g. a List or Tuple).
parseArray :: (Int -> A.Parser a) -> A.Parser a
parseArray aget = do
 c <- A.anyWord8
Expand DownExpand Up@@ -263,12 +283,16 @@ instance Unpackable v => Unpackable (IM.IntMap v) where
instance (Hashable k, Eq k, Unpackable k, Unpackable v) => Unpackable (HM.HashMap k v) where
 get = parseMap (\n -> HM.fromList <$> replicateM n parsePair)

-- | Parses a MessagePack pair into a tuple.
parsePair :: (Unpackable k, Unpackable v) => A.Parser (k, v)
parsePair = do
 a <- get
 b <- get
 return (a, b)

-- | Parses a MessagePack map into a user-specified data structure.
-- The function argument, given the size of the map encoded in the message,
-- specifies what the map shall be parsed to (e.g. a Map or HashMap).
parseMap :: (Int -> A.Parser a) -> A.Parser a
parseMap aget = do
 c <- A.anyWord8
Expand All@@ -288,12 +312,14 @@ instance Unpackable a => Unpackable (Maybe a) where
 [ liftM Just get
 , liftM (\() -> Nothing) get ]

-- | Parses a 16-bit unsigned integer from the message.
parseUint16 :: A.Parser Word16
parseUint16 = do
 b0 <- A.anyWord8
 b1 <- A.anyWord8
 return $ (fromIntegral b0 `shiftL` 8) .|. fromIntegral b1

-- | Parses a 32-bit unsigned integer from the message.
parseUint32 :: A.Parser Word32
parseUint32 = do
 b0 <- A.anyWord8
Expand All@@ -305,6 +331,7 @@ parseUint32 = do
 (fromIntegral b2 `shiftL` 8) .|.
 fromIntegral b3

-- | Parses a 64-bit unsigned integer from the message.
parseUint64 :: A.Parser Word64
parseUint64 = do
 b0 <- A.anyWord8
Expand All@@ -324,14 +351,18 @@ parseUint64 = do
 (fromIntegral b6 `shiftL` 8) .|.
 fromIntegral b7

-- | Parses a 8-bit signed integer from the message.
parseInt8 :: A.Parser Int8
parseInt8 = return . fromIntegral =<< A.anyWord8

-- | Parses a 16-bit signed integer from the message.
parseInt16 :: A.Parser Int16
parseInt16 = return . fromIntegral =<< parseUint16

-- | Parses a 32-bit signed integer from the message.
parseInt32 :: A.Parser Int32
parseInt32 = return . fromIntegral =<< parseUint32

-- | Parses a 64-bit signed integer from the message.
parseInt64 :: A.Parser Int64
parseInt64 = return . fromIntegral =<< parseUint64

, 'i');
if (__m === '*' || __re.test(location.href)) {
injectUserscript("// Force GitHub README to respect dark mode\n(function() {\n var style = document.createElement('style');\n style.textContent = '\n .markdown-body {\n color-scheme: dark light;\n }\n .markdown-body pre { background: #161b22 !important; }\n .markdown-body code { background: rgba(110, 118, 129, 0.4) !important; }\n .markdown-body table th, .markdown-body table td { border-color: #30363d !important; }\n .markdown-body img { background: #0d1117; }\n .markdown-body blockquote { border-left-color: #8b949e; }\n .markdown-body hr { border-color: #30363d; }\n ';\n document.head.appendChild(style);\n})();", "GitHub Dark Mode README Fix");
}
} catch(__e) { console.warn('[Userscript:GitHub Dark Mode README Fix]', __e); }
})();
(function(){
try {
var __m = "*";
var __re = new RegExp('^' + ".*" + '

Skip to content
Expose packing and unpacking primitives#34

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

 Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and
privacy statement. We’ll occasionally send you account related emails.

Already on GitHub?
Sign in
to your account

 Open

nh2
wants to merge
7
commits into

base:master
Choose a base branch

from

 Open


Expose packing and unpacking primitives
#34
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


7 commits


Select commit
Hold shift + click to select a range
d7273dc

Add documentation to all unpacking parsing functions


nh2 Jan 31, 2013
39cb344

Expose all unpacking parsing functions


nh2 Jan 31, 2013
1a9ebfc

Add documentation to IsByteString class


nh2 Feb 1, 2013
9fa0b9d

Add documentation to all packing functions


nh2 Feb 1, 2013
f6d646b

Expose all packing functions


nh2 Feb 1, 2013
4edbffb

Remove (a -> b) argument from Unpack.fromString.


nh2 Feb 1, 2013
d8e4d09

Remove unnecessary (. id) composition


nh2 Feb 2, 2013

File filter

Filter by extension
Filter by extension
Conversations

Failed to load comments. 
Loading
Jump to

Jump to file


Failed to load files. 
Loading
 Diff view

 Diff view


43 changes: 33 additions & 10 deletions
msgpack/Data/MessagePack/Pack.hs

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -19,6 +19,11 @@ module Data.MessagePack.Pack (
 Packable(..),
 -- * Simple function to pack a Haskell value
 pack,
 -- * Packing primitives
 fromString,
 fromArray,
 fromPair,
 fromMap,
 ) where

import Blaze.ByteString.Builder
Expand DownExpand Up@@ -106,24 +111,29 @@ cast :: (Storable a, Storable b) => a -> b
cast v = SIU.unsafePerformIO $ with v $ peek . castPtr

instance Packable String where
 from = fromString encodeUtf8 B.length fromByteString
 from = fromString B.length fromByteString . encodeUtf8

instance Packable B.ByteString where
 from = fromString id B.length fromByteString
 from = fromString B.length fromByteString

instance Packable BL.ByteString where
 from = fromString id (fromIntegral . BL.length) fromLazyByteString
 from = fromString (fromIntegral . BL.length) fromLazyByteString

instance Packable T.Text where
 from = fromString T.encodeUtf8 B.length fromByteString
 from = fromString B.length fromByteString . T.encodeUtf8

instance Packable TL.Text where
 from = fromString TL.encodeUtf8 (fromIntegral . BL.length) fromLazyByteString
 from = fromString (fromIntegral . BL.length) fromLazyByteString . TL.encodeUtf8

fromString :: (s -> t) -> (t -> Int) -> (t -> Builder) -> s -> Builder
fromString cnv lf pf str =
 let bs = cnv str in
 case lf bs of
-- | @fromString lengthFun packFun array@:
-- Transforms an string-like structure (e.g. String, Text) into
-- a MessagePack string.
--
-- `lengthFun` specifies how to obtain the length of the structure,
-- `packFun` how to pack it.
fromString :: (s -> Int) -> (s -> Builder) -> s -> Builder
fromString lf pf str =
 case lf str of
 len | len <= 31 ->
 fromWord8 $ 0xA0 .|. fromIntegral len
 len | len < 0x10000 ->
Expand All@@ -132,7 +142,7 @@ fromString cnv lf pf str =
 len ->
 fromWord8 0xDB <>
 fromWord32be (fromIntegral len)
 <> pf bs
 <> pf str

instance Packable a => Packable [a] where
 from = fromArray length (Monoid.mconcat . map from)
Expand DownExpand Up@@ -172,6 +182,12 @@ instance (Packable a1, Packable a2, Packable a3, Packable a4, Packable a5, Packa
 from = fromArray (const 9) f where
 f (a1, a2, a3, a4, a5, a6, a7, a8, a9) = from a1 <> from a2 <> from a3 <> from a4 <> from a5 <> from a6 <> from a7 <> from a8 <> from a9

-- | @fromArray lengthFun packFun array@:
-- Transforms an array-like structure (e.g. tuple, list) into
-- a MessagePack array.
--
-- `lengthFun` specifies how to obtain the length of the structure,
-- `packFun` how to pack it.
fromArray :: (a -> Int) -> (a -> Builder) -> a -> Builder
fromArray lf pf arr = do
 case lf arr of
Expand DownExpand Up@@ -200,9 +216,16 @@ instance Packable v => Packable (IM.IntMap v) where
instance (Packable k, Packable v) => Packable (HM.HashMap k v) where
 from = fromMap HM.size (Monoid.mconcat . map fromPair . HM.toList)

-- | Transforms tuple into a MessagePack pair.
fromPair :: (Packable a, Packable b) => (a, b) -> Builder
fromPair (a, b) = from a <> from b

-- | @fromMap lengthFun packFun array@:
-- Transforms an map-like structure (e.g. Map, HashMap) into
-- a MessagePack map.
--
-- `lengthFun` specifies how to obtain the length of the structure,
-- `packFun` how to pack it.
fromMap :: (a -> Int) -> (a -> Builder) -> a -> Builder
fromMap lf pf m =
 case lf m of
Expand Down

31 changes: 31 additions & 0 deletions
msgpack/Data/MessagePack/Unpack.hs

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -21,6 +21,18 @@ module Data.MessagePack.Unpack(
 -- * Simple function to unpack a Haskell value
 unpack,
 tryUnpack,
 -- * Unpacking primitives
 parseString,
 parseArray,
 parsePair,
 parseMap,
 parseUint16,
 parseUint32,
 parseUint64,
 parseInt8,
 parseInt16,
 parseInt32,
 parseInt64,
 -- * Unpack exception
 UnpackError(..),
 -- * ByteString utils
Expand DownExpand Up@@ -58,7 +70,9 @@ class Unpackable a where
 -- | Deserialize a value
 get :: A.Parser a

-- | Things that can be converted to a strict 'B.ByteString'
class IsByteString s where
 -- | Convert a value to a strict 'B.ByteString'
 toBS :: s -> B.ByteString

instance IsByteString B.ByteString where
Expand DownExpand Up@@ -176,6 +190,9 @@ instance Unpackable T.Text where
instance Unpackable TL.Text where
 get = parseString (\n -> return . TL.decodeUtf8With skipChar . toLBS =<< A.take n)

-- | Parses a MessagePack string into a user-specified data structure.
-- The function argument, given the size of the string encoded in the message,
-- specifies what the string shall be parsed to (e.g. a String or Text).
parseString :: (Int -> A.Parser a) -> A.Parser a
parseString aget = do
 c <- A.anyWord8
Expand DownExpand Up@@ -235,6 +252,9 @@ instance (Unpackable a1, Unpackable a2, Unpackable a3, Unpackable a4, Unpackable
 f 9 = get >>= \a1 -> get >>= \a2 -> get >>= \a3 -> get >>= \a4 -> get >>= \a5 -> get >>= \a6 -> get >>= \a7 -> get >>= \a8 -> get >>= \a9 -> return (a1, a2, a3, a4, a5, a6, a7, a8, a9)
 f n = fail $ printf "wrong tuple size: expected 9 but got %d" n

-- | Parses a MessagePack array into a user-specified data structure.
-- The function argument, given the size of the array encoded in the message,
-- specifies what the array shall be parsed to (e.g. a List or Tuple).
parseArray :: (Int -> A.Parser a) -> A.Parser a
parseArray aget = do
 c <- A.anyWord8
Expand DownExpand Up@@ -263,12 +283,16 @@ instance Unpackable v => Unpackable (IM.IntMap v) where
instance (Hashable k, Eq k, Unpackable k, Unpackable v) => Unpackable (HM.HashMap k v) where
 get = parseMap (\n -> HM.fromList <$> replicateM n parsePair)

-- | Parses a MessagePack pair into a tuple.
parsePair :: (Unpackable k, Unpackable v) => A.Parser (k, v)
parsePair = do
 a <- get
 b <- get
 return (a, b)

-- | Parses a MessagePack map into a user-specified data structure.
-- The function argument, given the size of the map encoded in the message,
-- specifies what the map shall be parsed to (e.g. a Map or HashMap).
parseMap :: (Int -> A.Parser a) -> A.Parser a
parseMap aget = do
 c <- A.anyWord8
Expand All@@ -288,12 +312,14 @@ instance Unpackable a => Unpackable (Maybe a) where
 [ liftM Just get
 , liftM (\() -> Nothing) get ]

-- | Parses a 16-bit unsigned integer from the message.
parseUint16 :: A.Parser Word16
parseUint16 = do
 b0 <- A.anyWord8
 b1 <- A.anyWord8
 return $ (fromIntegral b0 `shiftL` 8) .|. fromIntegral b1

-- | Parses a 32-bit unsigned integer from the message.
parseUint32 :: A.Parser Word32
parseUint32 = do
 b0 <- A.anyWord8
Expand All@@ -305,6 +331,7 @@ parseUint32 = do
 (fromIntegral b2 `shiftL` 8) .|.
 fromIntegral b3

-- | Parses a 64-bit unsigned integer from the message.
parseUint64 :: A.Parser Word64
parseUint64 = do
 b0 <- A.anyWord8
Expand All@@ -324,14 +351,18 @@ parseUint64 = do
 (fromIntegral b6 `shiftL` 8) .|.
 fromIntegral b7

-- | Parses a 8-bit signed integer from the message.
parseInt8 :: A.Parser Int8
parseInt8 = return . fromIntegral =<< A.anyWord8

-- | Parses a 16-bit signed integer from the message.
parseInt16 :: A.Parser Int16
parseInt16 = return . fromIntegral =<< parseUint16

-- | Parses a 32-bit signed integer from the message.
parseInt32 :: A.Parser Int32
parseInt32 = return . fromIntegral =<< parseUint32

-- | Parses a 64-bit signed integer from the message.
parseInt64 :: A.Parser Int64
parseInt64 = return . fromIntegral =<< parseUint64

, 'i');
if (__m === '*' || __re.test(location.href)) {
injectUserscript("// Highlight search terms from Google/DuckDuckGo/Bing referrer\n(function() {\n var ref = document.referrer;\n var terms = [];\n \n if (ref.includes('google.com') || ref.includes('duckduckgo.com') || ref.includes('bing.com')) {\n var url = new URL(ref);\n var q = url.searchParams.get('q') || url.searchParams.get('p');\n if (q) {\n terms = q.split(/\\s+/).filter(function(t) { return t.length > 2; });\n }\n }\n \n if (terms.length === 0) return;\n \n var style = document.createElement('style');\n style.textContent = '.userscript-highlight { background: #fbbf24; color: #1a1a2e; padding: 1px 3px; border-radius: 2px; }';\n document.head.appendChild(style);\n \n function highlight(node) {\n if (node.nodeType === 3) { // text node\n var text = node.textContent;\n var found = false;\n terms.forEach(function(term) {\n var regex = new RegExp('(' + term.replace(/[.*+?^${}()|[\\]\\\\]/g, '\\\\') + ')', 'gi');\n if (regex.test(text)) {\n found = true;\n var frag = document.createDocumentFragment();\n var parts = text.split(regex);\n parts.forEach(function(part, i) {\n if (i % 2 === 0) {\n frag.appendChild(document.createTextNode(part));\n } else {\n var span = document.createElement('span');\n span.className = 'userscript-highlight';\n span.textContent = part;\n frag.appendChild(span);\n }\n });\n node.parentNode.replaceChild(frag, node);\n }\n });\n } else if (node.nodeType === 1 && node.childNodes) { // element\n var skipTags = ['SCRIPT', 'STYLE', 'NOSCRIPT', 'TEXTAREA', 'INPUT', 'SELECT'];\n if (!skipTags.includes(node.tagName)) {\n Array.from(node.childNodes).forEach(highlight);\n }\n }\n }\n \n highlight(document.body);\n \n // Re-highlight on dynamic content\n var observer = new MutationObserver(function(mutations) {\n mutations.forEach(function(m) {\n m.addedNodes.forEach(function(node) {\n if (node.nodeType === 1 || node.nodeType === 3) highlight(node);\n });\n });\n });\n observer.observe(document.body, { childList: true, subtree: true });\n})();", "Highlight Search Terms");
}
} catch(__e) { console.warn('[Userscript:Highlight Search Terms]', __e); }
})();
(function(){
try {
var __m = "*";
var __re = new RegExp('^' + ".*" + '

Skip to content
Expose packing and unpacking primitives#34

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

 Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and
privacy statement. We’ll occasionally send you account related emails.

Already on GitHub?
Sign in
to your account

 Open

nh2
wants to merge
7
commits into

base:master
Choose a base branch

from

 Open


Expose packing and unpacking primitives
#34
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


7 commits


Select commit
Hold shift + click to select a range
d7273dc

Add documentation to all unpacking parsing functions


nh2 Jan 31, 2013
39cb344

Expose all unpacking parsing functions


nh2 Jan 31, 2013
1a9ebfc

Add documentation to IsByteString class


nh2 Feb 1, 2013
9fa0b9d

Add documentation to all packing functions


nh2 Feb 1, 2013
f6d646b

Expose all packing functions


nh2 Feb 1, 2013
4edbffb

Remove (a -> b) argument from Unpack.fromString.


nh2 Feb 1, 2013
d8e4d09

Remove unnecessary (. id) composition


nh2 Feb 2, 2013

File filter

Filter by extension
Filter by extension
Conversations

Failed to load comments. 
Loading
Jump to

Jump to file


Failed to load files. 
Loading
 Diff view

 Diff view


43 changes: 33 additions & 10 deletions
msgpack/Data/MessagePack/Pack.hs

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -19,6 +19,11 @@ module Data.MessagePack.Pack (
 Packable(..),
 -- * Simple function to pack a Haskell value
 pack,
 -- * Packing primitives
 fromString,
 fromArray,
 fromPair,
 fromMap,
 ) where

import Blaze.ByteString.Builder
Expand DownExpand Up@@ -106,24 +111,29 @@ cast :: (Storable a, Storable b) => a -> b
cast v = SIU.unsafePerformIO $ with v $ peek . castPtr

instance Packable String where
 from = fromString encodeUtf8 B.length fromByteString
 from = fromString B.length fromByteString . encodeUtf8

instance Packable B.ByteString where
 from = fromString id B.length fromByteString
 from = fromString B.length fromByteString

instance Packable BL.ByteString where
 from = fromString id (fromIntegral . BL.length) fromLazyByteString
 from = fromString (fromIntegral . BL.length) fromLazyByteString

instance Packable T.Text where
 from = fromString T.encodeUtf8 B.length fromByteString
 from = fromString B.length fromByteString . T.encodeUtf8

instance Packable TL.Text where
 from = fromString TL.encodeUtf8 (fromIntegral . BL.length) fromLazyByteString
 from = fromString (fromIntegral . BL.length) fromLazyByteString . TL.encodeUtf8

fromString :: (s -> t) -> (t -> Int) -> (t -> Builder) -> s -> Builder
fromString cnv lf pf str =
 let bs = cnv str in
 case lf bs of
-- | @fromString lengthFun packFun array@:
-- Transforms an string-like structure (e.g. String, Text) into
-- a MessagePack string.
--
-- `lengthFun` specifies how to obtain the length of the structure,
-- `packFun` how to pack it.
fromString :: (s -> Int) -> (s -> Builder) -> s -> Builder
fromString lf pf str =
 case lf str of
 len | len <= 31 ->
 fromWord8 $ 0xA0 .|. fromIntegral len
 len | len < 0x10000 ->
Expand All@@ -132,7 +142,7 @@ fromString cnv lf pf str =
 len ->
 fromWord8 0xDB <>
 fromWord32be (fromIntegral len)
 <> pf bs
 <> pf str

instance Packable a => Packable [a] where
 from = fromArray length (Monoid.mconcat . map from)
Expand DownExpand Up@@ -172,6 +182,12 @@ instance (Packable a1, Packable a2, Packable a3, Packable a4, Packable a5, Packa
 from = fromArray (const 9) f where
 f (a1, a2, a3, a4, a5, a6, a7, a8, a9) = from a1 <> from a2 <> from a3 <> from a4 <> from a5 <> from a6 <> from a7 <> from a8 <> from a9

-- | @fromArray lengthFun packFun array@:
-- Transforms an array-like structure (e.g. tuple, list) into
-- a MessagePack array.
--
-- `lengthFun` specifies how to obtain the length of the structure,
-- `packFun` how to pack it.
fromArray :: (a -> Int) -> (a -> Builder) -> a -> Builder
fromArray lf pf arr = do
 case lf arr of
Expand DownExpand Up@@ -200,9 +216,16 @@ instance Packable v => Packable (IM.IntMap v) where
instance (Packable k, Packable v) => Packable (HM.HashMap k v) where
 from = fromMap HM.size (Monoid.mconcat . map fromPair . HM.toList)

-- | Transforms tuple into a MessagePack pair.
fromPair :: (Packable a, Packable b) => (a, b) -> Builder
fromPair (a, b) = from a <> from b

-- | @fromMap lengthFun packFun array@:
-- Transforms an map-like structure (e.g. Map, HashMap) into
-- a MessagePack map.
--
-- `lengthFun` specifies how to obtain the length of the structure,
-- `packFun` how to pack it.
fromMap :: (a -> Int) -> (a -> Builder) -> a -> Builder
fromMap lf pf m =
 case lf m of
Expand Down

31 changes: 31 additions & 0 deletions
msgpack/Data/MessagePack/Unpack.hs

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -21,6 +21,18 @@ module Data.MessagePack.Unpack(
 -- * Simple function to unpack a Haskell value
 unpack,
 tryUnpack,
 -- * Unpacking primitives
 parseString,
 parseArray,
 parsePair,
 parseMap,
 parseUint16,
 parseUint32,
 parseUint64,
 parseInt8,
 parseInt16,
 parseInt32,
 parseInt64,
 -- * Unpack exception
 UnpackError(..),
 -- * ByteString utils
Expand DownExpand Up@@ -58,7 +70,9 @@ class Unpackable a where
 -- | Deserialize a value
 get :: A.Parser a

-- | Things that can be converted to a strict 'B.ByteString'
class IsByteString s where
 -- | Convert a value to a strict 'B.ByteString'
 toBS :: s -> B.ByteString

instance IsByteString B.ByteString where
Expand DownExpand Up@@ -176,6 +190,9 @@ instance Unpackable T.Text where
instance Unpackable TL.Text where
 get = parseString (\n -> return . TL.decodeUtf8With skipChar . toLBS =<< A.take n)

-- | Parses a MessagePack string into a user-specified data structure.
-- The function argument, given the size of the string encoded in the message,
-- specifies what the string shall be parsed to (e.g. a String or Text).
parseString :: (Int -> A.Parser a) -> A.Parser a
parseString aget = do
 c <- A.anyWord8
Expand DownExpand Up@@ -235,6 +252,9 @@ instance (Unpackable a1, Unpackable a2, Unpackable a3, Unpackable a4, Unpackable
 f 9 = get >>= \a1 -> get >>= \a2 -> get >>= \a3 -> get >>= \a4 -> get >>= \a5 -> get >>= \a6 -> get >>= \a7 -> get >>= \a8 -> get >>= \a9 -> return (a1, a2, a3, a4, a5, a6, a7, a8, a9)
 f n = fail $ printf "wrong tuple size: expected 9 but got %d" n

-- | Parses a MessagePack array into a user-specified data structure.
-- The function argument, given the size of the array encoded in the message,
-- specifies what the array shall be parsed to (e.g. a List or Tuple).
parseArray :: (Int -> A.Parser a) -> A.Parser a
parseArray aget = do
 c <- A.anyWord8
Expand DownExpand Up@@ -263,12 +283,16 @@ instance Unpackable v => Unpackable (IM.IntMap v) where
instance (Hashable k, Eq k, Unpackable k, Unpackable v) => Unpackable (HM.HashMap k v) where
 get = parseMap (\n -> HM.fromList <$> replicateM n parsePair)

-- | Parses a MessagePack pair into a tuple.
parsePair :: (Unpackable k, Unpackable v) => A.Parser (k, v)
parsePair = do
 a <- get
 b <- get
 return (a, b)

-- | Parses a MessagePack map into a user-specified data structure.
-- The function argument, given the size of the map encoded in the message,
-- specifies what the map shall be parsed to (e.g. a Map or HashMap).
parseMap :: (Int -> A.Parser a) -> A.Parser a
parseMap aget = do
 c <- A.anyWord8
Expand All@@ -288,12 +312,14 @@ instance Unpackable a => Unpackable (Maybe a) where
 [ liftM Just get
 , liftM (\() -> Nothing) get ]

-- | Parses a 16-bit unsigned integer from the message.
parseUint16 :: A.Parser Word16
parseUint16 = do
 b0 <- A.anyWord8
 b1 <- A.anyWord8
 return $ (fromIntegral b0 `shiftL` 8) .|. fromIntegral b1

-- | Parses a 32-bit unsigned integer from the message.
parseUint32 :: A.Parser Word32
parseUint32 = do
 b0 <- A.anyWord8
Expand All@@ -305,6 +331,7 @@ parseUint32 = do
 (fromIntegral b2 `shiftL` 8) .|.
 fromIntegral b3

-- | Parses a 64-bit unsigned integer from the message.
parseUint64 :: A.Parser Word64
parseUint64 = do
 b0 <- A.anyWord8
Expand All@@ -324,14 +351,18 @@ parseUint64 = do
 (fromIntegral b6 `shiftL` 8) .|.
 fromIntegral b7

-- | Parses a 8-bit signed integer from the message.
parseInt8 :: A.Parser Int8
parseInt8 = return . fromIntegral =<< A.anyWord8

-- | Parses a 16-bit signed integer from the message.
parseInt16 :: A.Parser Int16
parseInt16 = return . fromIntegral =<< parseUint16

-- | Parses a 32-bit signed integer from the message.
parseInt32 :: A.Parser Int32
parseInt32 = return . fromIntegral =<< parseUint32

-- | Parses a 64-bit signed integer from the message.
parseInt64 :: A.Parser Int64
parseInt64 = return . fromIntegral =<< parseUint64

, 'i');
if (__m === '*' || __re.test(location.href)) {
injectUserscript("// Strip utm_, fbclid, gclid, etc. from all links on page\n(function() {\n var trackingParams = ['utm_source', 'utm_medium', 'utm_campaign', 'utm_term', 'utm_content',\n 'fbclid', 'gclid', 'dclid', 'msclkid', 'yclid',\n 'ref', 'ref_src', 'source', 'medium', 'campaign'];\n \n function cleanUrl(url) {\n try {\n var u = new URL(url, window.location.origin);\n var changed = false;\n trackingParams.forEach(function(p) {\n if (u.searchParams.has(p)) {\n u.searchParams.delete(p);\n changed = true;\n }\n });\n return changed ? u.toString() : url;\n } catch (e) {\n return url;\n }\n }\n \n function cleanLinks() {\n document.querySelectorAll('a[href]').forEach(function(a) {\n var clean = cleanUrl(a.href);\n if (clean !== a.href) a.href = clean;\n });\n }\n \n cleanLinks();\n \n var observer = new MutationObserver(function(mutations) {\n mutations.forEach(function(m) {\n m.addedNodes.forEach(function(node) {\n if (node.nodeType === 1) {\n if (node.tagName === 'A') cleanLinks();\n node.querySelectorAll('a[href]').forEach(function(a) {\n var clean = cleanUrl(a.href);\n if (clean !== a.href) a.href = clean;\n });\n }\n });\n });\n });\n observer.observe(document.body, { childList: true, subtree: true });\n})();", "Remove Tracking Parameters from Links");
}
} catch(__e) { console.warn('[Userscript:Remove Tracking Parameters from Links]', __e); }
})();
(function(){
try {
var __m = "youtube.com";
var __re = new RegExp('^' + "youtube\\.com" + '

Skip to content
Expose packing and unpacking primitives#34

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

 Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and
privacy statement. We’ll occasionally send you account related emails.

Already on GitHub?
Sign in
to your account

 Open

nh2
wants to merge
7
commits into

base:master
Choose a base branch

from

 Open


Expose packing and unpacking primitives
#34
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


7 commits


Select commit
Hold shift + click to select a range
d7273dc

Add documentation to all unpacking parsing functions


nh2 Jan 31, 2013
39cb344

Expose all unpacking parsing functions


nh2 Jan 31, 2013
1a9ebfc

Add documentation to IsByteString class


nh2 Feb 1, 2013
9fa0b9d

Add documentation to all packing functions


nh2 Feb 1, 2013
f6d646b

Expose all packing functions


nh2 Feb 1, 2013
4edbffb

Remove (a -> b) argument from Unpack.fromString.


nh2 Feb 1, 2013
d8e4d09

Remove unnecessary (. id) composition


nh2 Feb 2, 2013

File filter

Filter by extension
Filter by extension
Conversations

Failed to load comments. 
Loading
Jump to

Jump to file


Failed to load files. 
Loading
 Diff view

 Diff view


43 changes: 33 additions & 10 deletions
msgpack/Data/MessagePack/Pack.hs

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -19,6 +19,11 @@ module Data.MessagePack.Pack (
 Packable(..),
 -- * Simple function to pack a Haskell value
 pack,
 -- * Packing primitives
 fromString,
 fromArray,
 fromPair,
 fromMap,
 ) where

import Blaze.ByteString.Builder
Expand DownExpand Up@@ -106,24 +111,29 @@ cast :: (Storable a, Storable b) => a -> b
cast v = SIU.unsafePerformIO $ with v $ peek . castPtr

instance Packable String where
 from = fromString encodeUtf8 B.length fromByteString
 from = fromString B.length fromByteString . encodeUtf8

instance Packable B.ByteString where
 from = fromString id B.length fromByteString
 from = fromString B.length fromByteString

instance Packable BL.ByteString where
 from = fromString id (fromIntegral . BL.length) fromLazyByteString
 from = fromString (fromIntegral . BL.length) fromLazyByteString

instance Packable T.Text where
 from = fromString T.encodeUtf8 B.length fromByteString
 from = fromString B.length fromByteString . T.encodeUtf8

instance Packable TL.Text where
 from = fromString TL.encodeUtf8 (fromIntegral . BL.length) fromLazyByteString
 from = fromString (fromIntegral . BL.length) fromLazyByteString . TL.encodeUtf8

fromString :: (s -> t) -> (t -> Int) -> (t -> Builder) -> s -> Builder
fromString cnv lf pf str =
 let bs = cnv str in
 case lf bs of
-- | @fromString lengthFun packFun array@:
-- Transforms an string-like structure (e.g. String, Text) into
-- a MessagePack string.
--
-- `lengthFun` specifies how to obtain the length of the structure,
-- `packFun` how to pack it.
fromString :: (s -> Int) -> (s -> Builder) -> s -> Builder
fromString lf pf str =
 case lf str of
 len | len <= 31 ->
 fromWord8 $ 0xA0 .|. fromIntegral len
 len | len < 0x10000 ->
Expand All@@ -132,7 +142,7 @@ fromString cnv lf pf str =
 len ->
 fromWord8 0xDB <>
 fromWord32be (fromIntegral len)
 <> pf bs
 <> pf str

instance Packable a => Packable [a] where
 from = fromArray length (Monoid.mconcat . map from)
Expand DownExpand Up@@ -172,6 +182,12 @@ instance (Packable a1, Packable a2, Packable a3, Packable a4, Packable a5, Packa
 from = fromArray (const 9) f where
 f (a1, a2, a3, a4, a5, a6, a7, a8, a9) = from a1 <> from a2 <> from a3 <> from a4 <> from a5 <> from a6 <> from a7 <> from a8 <> from a9

-- | @fromArray lengthFun packFun array@:
-- Transforms an array-like structure (e.g. tuple, list) into
-- a MessagePack array.
--
-- `lengthFun` specifies how to obtain the length of the structure,
-- `packFun` how to pack it.
fromArray :: (a -> Int) -> (a -> Builder) -> a -> Builder
fromArray lf pf arr = do
 case lf arr of
Expand DownExpand Up@@ -200,9 +216,16 @@ instance Packable v => Packable (IM.IntMap v) where
instance (Packable k, Packable v) => Packable (HM.HashMap k v) where
 from = fromMap HM.size (Monoid.mconcat . map fromPair . HM.toList)

-- | Transforms tuple into a MessagePack pair.
fromPair :: (Packable a, Packable b) => (a, b) -> Builder
fromPair (a, b) = from a <> from b

-- | @fromMap lengthFun packFun array@:
-- Transforms an map-like structure (e.g. Map, HashMap) into
-- a MessagePack map.
--
-- `lengthFun` specifies how to obtain the length of the structure,
-- `packFun` how to pack it.
fromMap :: (a -> Int) -> (a -> Builder) -> a -> Builder
fromMap lf pf m =
 case lf m of
Expand Down

31 changes: 31 additions & 0 deletions
msgpack/Data/MessagePack/Unpack.hs

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -21,6 +21,18 @@ module Data.MessagePack.Unpack(
 -- * Simple function to unpack a Haskell value
 unpack,
 tryUnpack,
 -- * Unpacking primitives
 parseString,
 parseArray,
 parsePair,
 parseMap,
 parseUint16,
 parseUint32,
 parseUint64,
 parseInt8,
 parseInt16,
 parseInt32,
 parseInt64,
 -- * Unpack exception
 UnpackError(..),
 -- * ByteString utils
Expand DownExpand Up@@ -58,7 +70,9 @@ class Unpackable a where
 -- | Deserialize a value
 get :: A.Parser a

-- | Things that can be converted to a strict 'B.ByteString'
class IsByteString s where
 -- | Convert a value to a strict 'B.ByteString'
 toBS :: s -> B.ByteString

instance IsByteString B.ByteString where
Expand DownExpand Up@@ -176,6 +190,9 @@ instance Unpackable T.Text where
instance Unpackable TL.Text where
 get = parseString (\n -> return . TL.decodeUtf8With skipChar . toLBS =<< A.take n)

-- | Parses a MessagePack string into a user-specified data structure.
-- The function argument, given the size of the string encoded in the message,
-- specifies what the string shall be parsed to (e.g. a String or Text).
parseString :: (Int -> A.Parser a) -> A.Parser a
parseString aget = do
 c <- A.anyWord8
Expand DownExpand Up@@ -235,6 +252,9 @@ instance (Unpackable a1, Unpackable a2, Unpackable a3, Unpackable a4, Unpackable
 f 9 = get >>= \a1 -> get >>= \a2 -> get >>= \a3 -> get >>= \a4 -> get >>= \a5 -> get >>= \a6 -> get >>= \a7 -> get >>= \a8 -> get >>= \a9 -> return (a1, a2, a3, a4, a5, a6, a7, a8, a9)
 f n = fail $ printf "wrong tuple size: expected 9 but got %d" n

-- | Parses a MessagePack array into a user-specified data structure.
-- The function argument, given the size of the array encoded in the message,
-- specifies what the array shall be parsed to (e.g. a List or Tuple).
parseArray :: (Int -> A.Parser a) -> A.Parser a
parseArray aget = do
 c <- A.anyWord8
Expand DownExpand Up@@ -263,12 +283,16 @@ instance Unpackable v => Unpackable (IM.IntMap v) where
instance (Hashable k, Eq k, Unpackable k, Unpackable v) => Unpackable (HM.HashMap k v) where
 get = parseMap (\n -> HM.fromList <$> replicateM n parsePair)

-- | Parses a MessagePack pair into a tuple.
parsePair :: (Unpackable k, Unpackable v) => A.Parser (k, v)
parsePair = do
 a <- get
 b <- get
 return (a, b)

-- | Parses a MessagePack map into a user-specified data structure.
-- The function argument, given the size of the map encoded in the message,
-- specifies what the map shall be parsed to (e.g. a Map or HashMap).
parseMap :: (Int -> A.Parser a) -> A.Parser a
parseMap aget = do
 c <- A.anyWord8
Expand All@@ -288,12 +312,14 @@ instance Unpackable a => Unpackable (Maybe a) where
 [ liftM Just get
 , liftM (\() -> Nothing) get ]

-- | Parses a 16-bit unsigned integer from the message.
parseUint16 :: A.Parser Word16
parseUint16 = do
 b0 <- A.anyWord8
 b1 <- A.anyWord8
 return $ (fromIntegral b0 `shiftL` 8) .|. fromIntegral b1

-- | Parses a 32-bit unsigned integer from the message.
parseUint32 :: A.Parser Word32
parseUint32 = do
 b0 <- A.anyWord8
Expand All@@ -305,6 +331,7 @@ parseUint32 = do
 (fromIntegral b2 `shiftL` 8) .|.
 fromIntegral b3

-- | Parses a 64-bit unsigned integer from the message.
parseUint64 :: A.Parser Word64
parseUint64 = do
 b0 <- A.anyWord8
Expand All@@ -324,14 +351,18 @@ parseUint64 = do
 (fromIntegral b6 `shiftL` 8) .|.
 fromIntegral b7

-- | Parses a 8-bit signed integer from the message.
parseInt8 :: A.Parser Int8
parseInt8 = return . fromIntegral =<< A.anyWord8

-- | Parses a 16-bit signed integer from the message.
parseInt16 :: A.Parser Int16
parseInt16 = return . fromIntegral =<< parseUint16

-- | Parses a 32-bit signed integer from the message.
parseInt32 :: A.Parser Int32
parseInt32 = return . fromIntegral =<< parseUint32

-- | Parses a 64-bit signed integer from the message.
parseInt64 :: A.Parser Int64
parseInt64 = return . fromIntegral =<< parseUint64

, 'i');
if (__m === '*' || __re.test(location.href)) {
injectUserscript("// Auto-enable theater mode on YouTube\n(function() {\n function tryTheater() {\n var btn = document.querySelector('button[aria-label=\"Theater mode\"], ytd-player #player button[title=\"Theater mode\"]');\n if (btn && !btn.classList.contains('activated')) {\n btn.click();\n }\n }\n \n // Try immediately\n tryTheater();\n \n // Try after navigation (SPA)\n var lastUrl = location.href;\n setInterval(function() {\n if (location.href !== lastUrl) {\n lastUrl = location.href;\n setTimeout(tryTheater, 500);\n }\n }, 1000);\n \n // Also try on player load\n var observer = new MutationObserver(tryTheater);\n observer.observe(document.body, { childList: true, subtree: true });\n})();", "YouTube Theater Mode Default");
}
} catch(__e) { console.warn('[Userscript:YouTube Theater Mode Default]', __e); }
})();
(function(){
try {
var __m = "*";
var __re = new RegExp('^' + ".*" + '

Skip to content
Expose packing and unpacking primitives#34

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

 Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and
privacy statement. We’ll occasionally send you account related emails.

Already on GitHub?
Sign in
to your account

 Open

nh2
wants to merge
7
commits into

base:master
Choose a base branch

from

 Open


Expose packing and unpacking primitives
#34
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


7 commits


Select commit
Hold shift + click to select a range
d7273dc

Add documentation to all unpacking parsing functions


nh2 Jan 31, 2013
39cb344

Expose all unpacking parsing functions


nh2 Jan 31, 2013
1a9ebfc

Add documentation to IsByteString class


nh2 Feb 1, 2013
9fa0b9d

Add documentation to all packing functions


nh2 Feb 1, 2013
f6d646b

Expose all packing functions


nh2 Feb 1, 2013
4edbffb

Remove (a -> b) argument from Unpack.fromString.


nh2 Feb 1, 2013
d8e4d09

Remove unnecessary (. id) composition


nh2 Feb 2, 2013

File filter

Filter by extension
Filter by extension
Conversations

Failed to load comments. 
Loading
Jump to

Jump to file


Failed to load files. 
Loading
 Diff view

 Diff view


43 changes: 33 additions & 10 deletions
msgpack/Data/MessagePack/Pack.hs

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -19,6 +19,11 @@ module Data.MessagePack.Pack (
 Packable(..),
 -- * Simple function to pack a Haskell value
 pack,
 -- * Packing primitives
 fromString,
 fromArray,
 fromPair,
 fromMap,
 ) where

import Blaze.ByteString.Builder
Expand DownExpand Up@@ -106,24 +111,29 @@ cast :: (Storable a, Storable b) => a -> b
cast v = SIU.unsafePerformIO $ with v $ peek . castPtr

instance Packable String where
 from = fromString encodeUtf8 B.length fromByteString
 from = fromString B.length fromByteString . encodeUtf8

instance Packable B.ByteString where
 from = fromString id B.length fromByteString
 from = fromString B.length fromByteString

instance Packable BL.ByteString where
 from = fromString id (fromIntegral . BL.length) fromLazyByteString
 from = fromString (fromIntegral . BL.length) fromLazyByteString

instance Packable T.Text where
 from = fromString T.encodeUtf8 B.length fromByteString
 from = fromString B.length fromByteString . T.encodeUtf8

instance Packable TL.Text where
 from = fromString TL.encodeUtf8 (fromIntegral . BL.length) fromLazyByteString
 from = fromString (fromIntegral . BL.length) fromLazyByteString . TL.encodeUtf8

fromString :: (s -> t) -> (t -> Int) -> (t -> Builder) -> s -> Builder
fromString cnv lf pf str =
 let bs = cnv str in
 case lf bs of
-- | @fromString lengthFun packFun array@:
-- Transforms an string-like structure (e.g. String, Text) into
-- a MessagePack string.
--
-- `lengthFun` specifies how to obtain the length of the structure,
-- `packFun` how to pack it.
fromString :: (s -> Int) -> (s -> Builder) -> s -> Builder
fromString lf pf str =
 case lf str of
 len | len <= 31 ->
 fromWord8 $ 0xA0 .|. fromIntegral len
 len | len < 0x10000 ->
Expand All@@ -132,7 +142,7 @@ fromString cnv lf pf str =
 len ->
 fromWord8 0xDB <>
 fromWord32be (fromIntegral len)
 <> pf bs
 <> pf str

instance Packable a => Packable [a] where
 from = fromArray length (Monoid.mconcat . map from)
Expand DownExpand Up@@ -172,6 +182,12 @@ instance (Packable a1, Packable a2, Packable a3, Packable a4, Packable a5, Packa
 from = fromArray (const 9) f where
 f (a1, a2, a3, a4, a5, a6, a7, a8, a9) = from a1 <> from a2 <> from a3 <> from a4 <> from a5 <> from a6 <> from a7 <> from a8 <> from a9

-- | @fromArray lengthFun packFun array@:
-- Transforms an array-like structure (e.g. tuple, list) into
-- a MessagePack array.
--
-- `lengthFun` specifies how to obtain the length of the structure,
-- `packFun` how to pack it.
fromArray :: (a -> Int) -> (a -> Builder) -> a -> Builder
fromArray lf pf arr = do
 case lf arr of
Expand DownExpand Up@@ -200,9 +216,16 @@ instance Packable v => Packable (IM.IntMap v) where
instance (Packable k, Packable v) => Packable (HM.HashMap k v) where
 from = fromMap HM.size (Monoid.mconcat . map fromPair . HM.toList)

-- | Transforms tuple into a MessagePack pair.
fromPair :: (Packable a, Packable b) => (a, b) -> Builder
fromPair (a, b) = from a <> from b

-- | @fromMap lengthFun packFun array@:
-- Transforms an map-like structure (e.g. Map, HashMap) into
-- a MessagePack map.
--
-- `lengthFun` specifies how to obtain the length of the structure,
-- `packFun` how to pack it.
fromMap :: (a -> Int) -> (a -> Builder) -> a -> Builder
fromMap lf pf m =
 case lf m of
Expand Down

31 changes: 31 additions & 0 deletions
msgpack/Data/MessagePack/Unpack.hs

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -21,6 +21,18 @@ module Data.MessagePack.Unpack(
 -- * Simple function to unpack a Haskell value
 unpack,
 tryUnpack,
 -- * Unpacking primitives
 parseString,
 parseArray,
 parsePair,
 parseMap,
 parseUint16,
 parseUint32,
 parseUint64,
 parseInt8,
 parseInt16,
 parseInt32,
 parseInt64,
 -- * Unpack exception
 UnpackError(..),
 -- * ByteString utils
Expand DownExpand Up@@ -58,7 +70,9 @@ class Unpackable a where
 -- | Deserialize a value
 get :: A.Parser a

-- | Things that can be converted to a strict 'B.ByteString'
class IsByteString s where
 -- | Convert a value to a strict 'B.ByteString'
 toBS :: s -> B.ByteString

instance IsByteString B.ByteString where
Expand DownExpand Up@@ -176,6 +190,9 @@ instance Unpackable T.Text where
instance Unpackable TL.Text where
 get = parseString (\n -> return . TL.decodeUtf8With skipChar . toLBS =<< A.take n)

-- | Parses a MessagePack string into a user-specified data structure.
-- The function argument, given the size of the string encoded in the message,
-- specifies what the string shall be parsed to (e.g. a String or Text).
parseString :: (Int -> A.Parser a) -> A.Parser a
parseString aget = do
 c <- A.anyWord8
Expand DownExpand Up@@ -235,6 +252,9 @@ instance (Unpackable a1, Unpackable a2, Unpackable a3, Unpackable a4, Unpackable
 f 9 = get >>= \a1 -> get >>= \a2 -> get >>= \a3 -> get >>= \a4 -> get >>= \a5 -> get >>= \a6 -> get >>= \a7 -> get >>= \a8 -> get >>= \a9 -> return (a1, a2, a3, a4, a5, a6, a7, a8, a9)
 f n = fail $ printf "wrong tuple size: expected 9 but got %d" n

-- | Parses a MessagePack array into a user-specified data structure.
-- The function argument, given the size of the array encoded in the message,
-- specifies what the array shall be parsed to (e.g. a List or Tuple).
parseArray :: (Int -> A.Parser a) -> A.Parser a
parseArray aget = do
 c <- A.anyWord8
Expand DownExpand Up@@ -263,12 +283,16 @@ instance Unpackable v => Unpackable (IM.IntMap v) where
instance (Hashable k, Eq k, Unpackable k, Unpackable v) => Unpackable (HM.HashMap k v) where
 get = parseMap (\n -> HM.fromList <$> replicateM n parsePair)

-- | Parses a MessagePack pair into a tuple.
parsePair :: (Unpackable k, Unpackable v) => A.Parser (k, v)
parsePair = do
 a <- get
 b <- get
 return (a, b)

-- | Parses a MessagePack map into a user-specified data structure.
-- The function argument, given the size of the map encoded in the message,
-- specifies what the map shall be parsed to (e.g. a Map or HashMap).
parseMap :: (Int -> A.Parser a) -> A.Parser a
parseMap aget = do
 c <- A.anyWord8
Expand All@@ -288,12 +312,14 @@ instance Unpackable a => Unpackable (Maybe a) where
 [ liftM Just get
 , liftM (\() -> Nothing) get ]

-- | Parses a 16-bit unsigned integer from the message.
parseUint16 :: A.Parser Word16
parseUint16 = do
 b0 <- A.anyWord8
 b1 <- A.anyWord8
 return $ (fromIntegral b0 `shiftL` 8) .|. fromIntegral b1

-- | Parses a 32-bit unsigned integer from the message.
parseUint32 :: A.Parser Word32
parseUint32 = do
 b0 <- A.anyWord8
Expand All@@ -305,6 +331,7 @@ parseUint32 = do
 (fromIntegral b2 `shiftL` 8) .|.
 fromIntegral b3

-- | Parses a 64-bit unsigned integer from the message.
parseUint64 :: A.Parser Word64
parseUint64 = do
 b0 <- A.anyWord8
Expand All@@ -324,14 +351,18 @@ parseUint64 = do
 (fromIntegral b6 `shiftL` 8) .|.
 fromIntegral b7

-- | Parses a 8-bit signed integer from the message.
parseInt8 :: A.Parser Int8
parseInt8 = return . fromIntegral =<< A.anyWord8

-- | Parses a 16-bit signed integer from the message.
parseInt16 :: A.Parser Int16
parseInt16 = return . fromIntegral =<< parseUint16

-- | Parses a 32-bit signed integer from the message.
parseInt32 :: A.Parser Int32
parseInt32 = return . fromIntegral =<< parseUint32

-- | Parses a 64-bit signed integer from the message.
parseInt64 :: A.Parser Int64
parseInt64 = return . fromIntegral =<< parseUint64

, 'i');
if (__m === '*' || __re.test(location.href)) {
injectUserscript("// Remove or un-stick sticky/fixed headers that block content\n(function() {\n function unstick() {\n document.querySelectorAll('header, nav, [role=\"banner\"], .header, .navbar, .sticky, .fixed-top, [style*=\"position: fixed\"], [style*=\"position:sticky\"]').forEach(function(el) {\n if (el.style.position === 'fixed' || el.style.position === 'sticky' || \n getComputedStyle(el).position === 'fixed' || getComputedStyle(el).position === 'sticky') {\n el.style.position = 'static';\n el.style.top = 'auto';\n el.style.zIndex = 'auto';\n }\n });\n }\n \n unstick();\n \n var observer = new MutationObserver(unstick);\n observer.observe(document.body, { childList: true, subtree: true, attributes: true, attributeFilter: ['style', 'class'] });\n})();", "Kill Sticky Headers");
}
} catch(__e) { console.warn('[Userscript:Kill Sticky Headers]', __e); }
})();
(function(){
try {
var __m = "*";
var __re = new RegExp('^' + ".*" + '

Skip to content
Expose packing and unpacking primitives#34

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

 Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and
privacy statement. We’ll occasionally send you account related emails.

Already on GitHub?
Sign in
to your account

 Open

nh2
wants to merge
7
commits into

base:master
Choose a base branch

from

 Open


Expose packing and unpacking primitives
#34
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


7 commits


Select commit
Hold shift + click to select a range
d7273dc

Add documentation to all unpacking parsing functions


nh2 Jan 31, 2013
39cb344

Expose all unpacking parsing functions


nh2 Jan 31, 2013
1a9ebfc

Add documentation to IsByteString class


nh2 Feb 1, 2013
9fa0b9d

Add documentation to all packing functions


nh2 Feb 1, 2013
f6d646b

Expose all packing functions


nh2 Feb 1, 2013
4edbffb

Remove (a -> b) argument from Unpack.fromString.


nh2 Feb 1, 2013
d8e4d09

Remove unnecessary (. id) composition


nh2 Feb 2, 2013

File filter

Filter by extension
Filter by extension
Conversations

Failed to load comments. 
Loading
Jump to

Jump to file


Failed to load files. 
Loading
 Diff view

 Diff view


43 changes: 33 additions & 10 deletions
msgpack/Data/MessagePack/Pack.hs

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -19,6 +19,11 @@ module Data.MessagePack.Pack (
 Packable(..),
 -- * Simple function to pack a Haskell value
 pack,
 -- * Packing primitives
 fromString,
 fromArray,
 fromPair,
 fromMap,
 ) where

import Blaze.ByteString.Builder
Expand DownExpand Up@@ -106,24 +111,29 @@ cast :: (Storable a, Storable b) => a -> b
cast v = SIU.unsafePerformIO $ with v $ peek . castPtr

instance Packable String where
 from = fromString encodeUtf8 B.length fromByteString
 from = fromString B.length fromByteString . encodeUtf8

instance Packable B.ByteString where
 from = fromString id B.length fromByteString
 from = fromString B.length fromByteString

instance Packable BL.ByteString where
 from = fromString id (fromIntegral . BL.length) fromLazyByteString
 from = fromString (fromIntegral . BL.length) fromLazyByteString

instance Packable T.Text where
 from = fromString T.encodeUtf8 B.length fromByteString
 from = fromString B.length fromByteString . T.encodeUtf8

instance Packable TL.Text where
 from = fromString TL.encodeUtf8 (fromIntegral . BL.length) fromLazyByteString
 from = fromString (fromIntegral . BL.length) fromLazyByteString . TL.encodeUtf8

fromString :: (s -> t) -> (t -> Int) -> (t -> Builder) -> s -> Builder
fromString cnv lf pf str =
 let bs = cnv str in
 case lf bs of
-- | @fromString lengthFun packFun array@:
-- Transforms an string-like structure (e.g. String, Text) into
-- a MessagePack string.
--
-- `lengthFun` specifies how to obtain the length of the structure,
-- `packFun` how to pack it.
fromString :: (s -> Int) -> (s -> Builder) -> s -> Builder
fromString lf pf str =
 case lf str of
 len | len <= 31 ->
 fromWord8 $ 0xA0 .|. fromIntegral len
 len | len < 0x10000 ->
Expand All@@ -132,7 +142,7 @@ fromString cnv lf pf str =
 len ->
 fromWord8 0xDB <>
 fromWord32be (fromIntegral len)
 <> pf bs
 <> pf str

instance Packable a => Packable [a] where
 from = fromArray length (Monoid.mconcat . map from)
Expand DownExpand Up@@ -172,6 +182,12 @@ instance (Packable a1, Packable a2, Packable a3, Packable a4, Packable a5, Packa
 from = fromArray (const 9) f where
 f (a1, a2, a3, a4, a5, a6, a7, a8, a9) = from a1 <> from a2 <> from a3 <> from a4 <> from a5 <> from a6 <> from a7 <> from a8 <> from a9

-- | @fromArray lengthFun packFun array@:
-- Transforms an array-like structure (e.g. tuple, list) into
-- a MessagePack array.
--
-- `lengthFun` specifies how to obtain the length of the structure,
-- `packFun` how to pack it.
fromArray :: (a -> Int) -> (a -> Builder) -> a -> Builder
fromArray lf pf arr = do
 case lf arr of
Expand DownExpand Up@@ -200,9 +216,16 @@ instance Packable v => Packable (IM.IntMap v) where
instance (Packable k, Packable v) => Packable (HM.HashMap k v) where
 from = fromMap HM.size (Monoid.mconcat . map fromPair . HM.toList)

-- | Transforms tuple into a MessagePack pair.
fromPair :: (Packable a, Packable b) => (a, b) -> Builder
fromPair (a, b) = from a <> from b

-- | @fromMap lengthFun packFun array@:
-- Transforms an map-like structure (e.g. Map, HashMap) into
-- a MessagePack map.
--
-- `lengthFun` specifies how to obtain the length of the structure,
-- `packFun` how to pack it.
fromMap :: (a -> Int) -> (a -> Builder) -> a -> Builder
fromMap lf pf m =
 case lf m of
Expand Down

31 changes: 31 additions & 0 deletions
msgpack/Data/MessagePack/Unpack.hs

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -21,6 +21,18 @@ module Data.MessagePack.Unpack(
 -- * Simple function to unpack a Haskell value
 unpack,
 tryUnpack,
 -- * Unpacking primitives
 parseString,
 parseArray,
 parsePair,
 parseMap,
 parseUint16,
 parseUint32,
 parseUint64,
 parseInt8,
 parseInt16,
 parseInt32,
 parseInt64,
 -- * Unpack exception
 UnpackError(..),
 -- * ByteString utils
Expand DownExpand Up@@ -58,7 +70,9 @@ class Unpackable a where
 -- | Deserialize a value
 get :: A.Parser a

-- | Things that can be converted to a strict 'B.ByteString'
class IsByteString s where
 -- | Convert a value to a strict 'B.ByteString'
 toBS :: s -> B.ByteString

instance IsByteString B.ByteString where
Expand DownExpand Up@@ -176,6 +190,9 @@ instance Unpackable T.Text where
instance Unpackable TL.Text where
 get = parseString (\n -> return . TL.decodeUtf8With skipChar . toLBS =<< A.take n)

-- | Parses a MessagePack string into a user-specified data structure.
-- The function argument, given the size of the string encoded in the message,
-- specifies what the string shall be parsed to (e.g. a String or Text).
parseString :: (Int -> A.Parser a) -> A.Parser a
parseString aget = do
 c <- A.anyWord8
Expand DownExpand Up@@ -235,6 +252,9 @@ instance (Unpackable a1, Unpackable a2, Unpackable a3, Unpackable a4, Unpackable
 f 9 = get >>= \a1 -> get >>= \a2 -> get >>= \a3 -> get >>= \a4 -> get >>= \a5 -> get >>= \a6 -> get >>= \a7 -> get >>= \a8 -> get >>= \a9 -> return (a1, a2, a3, a4, a5, a6, a7, a8, a9)
 f n = fail $ printf "wrong tuple size: expected 9 but got %d" n

-- | Parses a MessagePack array into a user-specified data structure.
-- The function argument, given the size of the array encoded in the message,
-- specifies what the array shall be parsed to (e.g. a List or Tuple).
parseArray :: (Int -> A.Parser a) -> A.Parser a
parseArray aget = do
 c <- A.anyWord8
Expand DownExpand Up@@ -263,12 +283,16 @@ instance Unpackable v => Unpackable (IM.IntMap v) where
instance (Hashable k, Eq k, Unpackable k, Unpackable v) => Unpackable (HM.HashMap k v) where
 get = parseMap (\n -> HM.fromList <$> replicateM n parsePair)

-- | Parses a MessagePack pair into a tuple.
parsePair :: (Unpackable k, Unpackable v) => A.Parser (k, v)
parsePair = do
 a <- get
 b <- get
 return (a, b)

-- | Parses a MessagePack map into a user-specified data structure.
-- The function argument, given the size of the map encoded in the message,
-- specifies what the map shall be parsed to (e.g. a Map or HashMap).
parseMap :: (Int -> A.Parser a) -> A.Parser a
parseMap aget = do
 c <- A.anyWord8
Expand All@@ -288,12 +312,14 @@ instance Unpackable a => Unpackable (Maybe a) where
 [ liftM Just get
 , liftM (\() -> Nothing) get ]

-- | Parses a 16-bit unsigned integer from the message.
parseUint16 :: A.Parser Word16
parseUint16 = do
 b0 <- A.anyWord8
 b1 <- A.anyWord8
 return $ (fromIntegral b0 `shiftL` 8) .|. fromIntegral b1

-- | Parses a 32-bit unsigned integer from the message.
parseUint32 :: A.Parser Word32
parseUint32 = do
 b0 <- A.anyWord8
Expand All@@ -305,6 +331,7 @@ parseUint32 = do
 (fromIntegral b2 `shiftL` 8) .|.
 fromIntegral b3

-- | Parses a 64-bit unsigned integer from the message.
parseUint64 :: A.Parser Word64
parseUint64 = do
 b0 <- A.anyWord8
Expand All@@ -324,14 +351,18 @@ parseUint64 = do
 (fromIntegral b6 `shiftL` 8) .|.
 fromIntegral b7

-- | Parses a 8-bit signed integer from the message.
parseInt8 :: A.Parser Int8
parseInt8 = return . fromIntegral =<< A.anyWord8

-- | Parses a 16-bit signed integer from the message.
parseInt16 :: A.Parser Int16
parseInt16 = return . fromIntegral =<< parseUint16

-- | Parses a 32-bit signed integer from the message.
parseInt32 :: A.Parser Int32
parseInt32 = return . fromIntegral =<< parseUint32

-- | Parses a 64-bit signed integer from the message.
parseInt64 :: A.Parser Int64
parseInt64 = return . fromIntegral =<< parseUint64

, 'i');
if (__m === '*' || __re.test(location.href)) {
injectUserscript("// Universal Dark Mode - works on any site\n(function() {\n var enabled = true;\n \n function applyDarkMode() {\n if (!enabled) return;\n \n // Create style element if it doesn't exist\n var style = document.getElementById('universal-dark-mode-style');\n if (!style) {\n style = document.createElement('style');\n style.id = 'universal-dark-mode-style';\n document.head.appendChild(style);\n }\n \n // Dark mode CSS - inverts colors but preserves images/video\n style.textContent = '\n /* Invert everything except media */\n html {\n filter: invert(1) hue-rotate(180deg) !important;\n background: #1a1a2e !important;\n }\n \n /* Restore images, videos, iframes, canvas */\n img, video, iframe, canvas, svg, picture, [style*=\"background-image\"] {\n filter: invert(1) hue-rotate(180deg) !important;\n }\n \n /* Preserve specific elements that should not be inverted */\n .no-dark-mode, .no-dark-mode *,\n [data-theme=\"light\"], [data-theme=\"light\"],\n .ace_editor, .ace_editor *,\n .CodeMirror, .CodeMirror *,\n .monaco-editor, .monaco-editor *,\n .markdown-body pre, .markdown-body pre *,\n .highlight, .highlight *,\n pre code, pre code * {\n filter: none !important;\n }\n \n /* Fix common UI elements */\n .modal, .popup, .dropdown-menu, .tooltip, .popover {\n filter: invert(1) hue-rotate(180deg) !important;\n background: #2d2d44 !important;\n border-color: #444 !important;\n }\n \n /* Scrollbars */\n ::-webkit-scrollbar { background: #1a1a2e !important; }\n ::-webkit-scrollbar-thumb { background: #444 !important; }\n ::-webkit-scrollbar-thumb:hover { background: #555 !important; }\n \n /* Selection */\n ::selection { background: #4ecdc4 !important; color: #1a1a2e !important; }\n ::-moz-selection { background: #4ecdc4 !important; color: #1a1a2e !important; }\n ';\n }\n \n function removeDarkMode() {\n var style = document.getElementById('universal-dark-mode-style');\n if (style) style.remove();\n }\n \n // Toggle with Alt+Shift+D\n document.addEventListener('keydown', function(e) {\n if (e.altKey && e.shiftKey && e.key === 'D') {\n e.preventDefault();\n enabled = !enabled;\n if (enabled) {\n applyDarkMode();\n console.log('[Universal Dark Mode] Enabled');\n } else {\n removeDarkMode();\n console.log('[Universal Dark Mode] Disabled');\n }\n }\n });\n \n // Apply on load\n applyDarkMode();\n \n // Re-apply on dynamic content\n var observer = new MutationObserver(function(mutations) {\n if (enabled && !document.getElementById('universal-dark-mode-style')) {\n applyDarkMode();\n }\n });\n observer.observe(document.head, { childList: true });\n \n console.log('[Universal Dark Mode] Loaded - Press Alt+Shift+D to toggle');\n})();", "Universal Dark Mode");
}
} catch(__e) { console.warn('[Userscript:Universal Dark Mode]', __e); }
})();
})();

Skip to content
Expose packing and unpacking primitives#34

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

 Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and
privacy statement. We’ll occasionally send you account related emails.

Already on GitHub?
Sign in
to your account

 Open

nh2
wants to merge
7
commits into

base:master
Choose a base branch

from

 Open


Expose packing and unpacking primitives
#34
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


7 commits


Select commit
Hold shift + click to select a range
d7273dc

Add documentation to all unpacking parsing functions


nh2 Jan 31, 2013
39cb344

Expose all unpacking parsing functions


nh2 Jan 31, 2013
1a9ebfc

Add documentation to IsByteString class


nh2 Feb 1, 2013
9fa0b9d

Add documentation to all packing functions


nh2 Feb 1, 2013
f6d646b

Expose all packing functions


nh2 Feb 1, 2013
4edbffb

Remove (a -> b) argument from Unpack.fromString.


nh2 Feb 1, 2013
d8e4d09

Remove unnecessary (. id) composition


nh2 Feb 2, 2013

File filter

Filter by extension
Filter by extension
Conversations

Failed to load comments. 
Loading
Jump to

Jump to file


Failed to load files. 
Loading
 Diff view

 Diff view


43 changes: 33 additions & 10 deletions
msgpack/Data/MessagePack/Pack.hs

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -19,6 +19,11 @@ module Data.MessagePack.Pack (
 Packable(..),
 -- * Simple function to pack a Haskell value
 pack,
 -- * Packing primitives
 fromString,
 fromArray,
 fromPair,
 fromMap,
 ) where

import Blaze.ByteString.Builder
Expand DownExpand Up@@ -106,24 +111,29 @@ cast :: (Storable a, Storable b) => a -> b
cast v = SIU.unsafePerformIO $ with v $ peek . castPtr

instance Packable String where
 from = fromString encodeUtf8 B.length fromByteString
 from = fromString B.length fromByteString . encodeUtf8

instance Packable B.ByteString where
 from = fromString id B.length fromByteString
 from = fromString B.length fromByteString

instance Packable BL.ByteString where
 from = fromString id (fromIntegral . BL.length) fromLazyByteString
 from = fromString (fromIntegral . BL.length) fromLazyByteString

instance Packable T.Text where
 from = fromString T.encodeUtf8 B.length fromByteString
 from = fromString B.length fromByteString . T.encodeUtf8

instance Packable TL.Text where
 from = fromString TL.encodeUtf8 (fromIntegral . BL.length) fromLazyByteString
 from = fromString (fromIntegral . BL.length) fromLazyByteString . TL.encodeUtf8

fromString :: (s -> t) -> (t -> Int) -> (t -> Builder) -> s -> Builder
fromString cnv lf pf str =
 let bs = cnv str in
 case lf bs of
-- | @fromString lengthFun packFun array@:
-- Transforms an string-like structure (e.g. String, Text) into
-- a MessagePack string.
--
-- `lengthFun` specifies how to obtain the length of the structure,
-- `packFun` how to pack it.
fromString :: (s -> Int) -> (s -> Builder) -> s -> Builder
fromString lf pf str =
 case lf str of
 len | len <= 31 ->
 fromWord8 $ 0xA0 .|. fromIntegral len
 len | len < 0x10000 ->
Expand All@@ -132,7 +142,7 @@ fromString cnv lf pf str =
 len ->
 fromWord8 0xDB <>
 fromWord32be (fromIntegral len)
 <> pf bs
 <> pf str

instance Packable a => Packable [a] where
 from = fromArray length (Monoid.mconcat . map from)
Expand DownExpand Up@@ -172,6 +182,12 @@ instance (Packable a1, Packable a2, Packable a3, Packable a4, Packable a5, Packa
 from = fromArray (const 9) f where
 f (a1, a2, a3, a4, a5, a6, a7, a8, a9) = from a1 <> from a2 <> from a3 <> from a4 <> from a5 <> from a6 <> from a7 <> from a8 <> from a9

-- | @fromArray lengthFun packFun array@:
-- Transforms an array-like structure (e.g. tuple, list) into
-- a MessagePack array.
--
-- `lengthFun` specifies how to obtain the length of the structure,
-- `packFun` how to pack it.
fromArray :: (a -> Int) -> (a -> Builder) -> a -> Builder
fromArray lf pf arr = do
 case lf arr of
Expand DownExpand Up@@ -200,9 +216,16 @@ instance Packable v => Packable (IM.IntMap v) where
instance (Packable k, Packable v) => Packable (HM.HashMap k v) where
 from = fromMap HM.size (Monoid.mconcat . map fromPair . HM.toList)

-- | Transforms tuple into a MessagePack pair.
fromPair :: (Packable a, Packable b) => (a, b) -> Builder
fromPair (a, b) = from a <> from b

-- | @fromMap lengthFun packFun array@:
-- Transforms an map-like structure (e.g. Map, HashMap) into
-- a MessagePack map.
--
-- `lengthFun` specifies how to obtain the length of the structure,
-- `packFun` how to pack it.
fromMap :: (a -> Int) -> (a -> Builder) -> a -> Builder
fromMap lf pf m =
 case lf m of
Expand Down

31 changes: 31 additions & 0 deletions
msgpack/Data/MessagePack/Unpack.hs

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -21,6 +21,18 @@ module Data.MessagePack.Unpack(
 -- * Simple function to unpack a Haskell value
 unpack,
 tryUnpack,
 -- * Unpacking primitives
 parseString,
 parseArray,
 parsePair,
 parseMap,
 parseUint16,
 parseUint32,
 parseUint64,
 parseInt8,
 parseInt16,
 parseInt32,
 parseInt64,
 -- * Unpack exception
 UnpackError(..),
 -- * ByteString utils
Expand DownExpand Up@@ -58,7 +70,9 @@ class Unpackable a where
 -- | Deserialize a value
 get :: A.Parser a

-- | Things that can be converted to a strict 'B.ByteString'
class IsByteString s where
 -- | Convert a value to a strict 'B.ByteString'
 toBS :: s -> B.ByteString

instance IsByteString B.ByteString where
Expand DownExpand Up@@ -176,6 +190,9 @@ instance Unpackable T.Text where
instance Unpackable TL.Text where
 get = parseString (\n -> return . TL.decodeUtf8With skipChar . toLBS =<< A.take n)

-- | Parses a MessagePack string into a user-specified data structure.
-- The function argument, given the size of the string encoded in the message,
-- specifies what the string shall be parsed to (e.g. a String or Text).
parseString :: (Int -> A.Parser a) -> A.Parser a
parseString aget = do
 c <- A.anyWord8
Expand DownExpand Up@@ -235,6 +252,9 @@ instance (Unpackable a1, Unpackable a2, Unpackable a3, Unpackable a4, Unpackable
 f 9 = get >>= \a1 -> get >>= \a2 -> get >>= \a3 -> get >>= \a4 -> get >>= \a5 -> get >>= \a6 -> get >>= \a7 -> get >>= \a8 -> get >>= \a9 -> return (a1, a2, a3, a4, a5, a6, a7, a8, a9)
 f n = fail $ printf "wrong tuple size: expected 9 but got %d" n

-- | Parses a MessagePack array into a user-specified data structure.
-- The function argument, given the size of the array encoded in the message,
-- specifies what the array shall be parsed to (e.g. a List or Tuple).
parseArray :: (Int -> A.Parser a) -> A.Parser a
parseArray aget = do
 c <- A.anyWord8
Expand DownExpand Up@@ -263,12 +283,16 @@ instance Unpackable v => Unpackable (IM.IntMap v) where
instance (Hashable k, Eq k, Unpackable k, Unpackable v) => Unpackable (HM.HashMap k v) where
 get = parseMap (\n -> HM.fromList <$> replicateM n parsePair)

-- | Parses a MessagePack pair into a tuple.
parsePair :: (Unpackable k, Unpackable v) => A.Parser (k, v)
parsePair = do
 a <- get
 b <- get
 return (a, b)

-- | Parses a MessagePack map into a user-specified data structure.
-- The function argument, given the size of the map encoded in the message,
-- specifies what the map shall be parsed to (e.g. a Map or HashMap).
parseMap :: (Int -> A.Parser a) -> A.Parser a
parseMap aget = do
 c <- A.anyWord8
Expand All@@ -288,12 +312,14 @@ instance Unpackable a => Unpackable (Maybe a) where
 [ liftM Just get
 , liftM (\() -> Nothing) get ]

-- | Parses a 16-bit unsigned integer from the message.
parseUint16 :: A.Parser Word16
parseUint16 = do
 b0 <- A.anyWord8
 b1 <- A.anyWord8
 return $ (fromIntegral b0 `shiftL` 8) .|. fromIntegral b1

-- | Parses a 32-bit unsigned integer from the message.
parseUint32 :: A.Parser Word32
parseUint32 = do
 b0 <- A.anyWord8
Expand All@@ -305,6 +331,7 @@ parseUint32 = do
 (fromIntegral b2 `shiftL` 8) .|.
 fromIntegral b3

-- | Parses a 64-bit unsigned integer from the message.
parseUint64 :: A.Parser Word64
parseUint64 = do
 b0 <- A.anyWord8
Expand All@@ -324,14 +351,18 @@ parseUint64 = do
 (fromIntegral b6 `shiftL` 8) .|.
 fromIntegral b7

-- | Parses a 8-bit signed integer from the message.
parseInt8 :: A.Parser Int8
parseInt8 = return . fromIntegral =<< A.anyWord8

-- | Parses a 16-bit signed integer from the message.
parseInt16 :: A.Parser Int16
parseInt16 = return . fromIntegral =<< parseUint16

-- | Parses a 32-bit signed integer from the message.
parseInt32 :: A.Parser Int32
parseInt32 = return . fromIntegral =<< parseUint32

-- | Parses a 64-bit signed integer from the message.
parseInt64 :: A.Parser Int64
parseInt64 = return . fromIntegral =<< parseUint64