packages feed

msgpack-aeson (empty) → 0.1.0.0

raw patch · 5 files changed

+279/−0 lines, 5 filesdep +aesondep +basedep +bytestringsetup-changed

Dependencies added: aeson, base, bytestring, deepseq, msgpack, msgpack-aeson, scientific, tasty, tasty-hunit, text, unordered-containers, vector

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Hideyuki Tanaka++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Hideyuki Tanaka nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ msgpack-aeson.cabal view
@@ -0,0 +1,45 @@+name:                msgpack-aeson+version:             0.1.0.0+synopsis:            Aeson adapter for MessagePack+description:         Aeson adapter for MessagePack+homepage:            http://msgpack.org/+license:             BSD3+license-file:        LICENSE+author:              Hideyuki Tanaka+maintainer:          tanaka.hideyuki@gmail.com+copyright:           (c) 2015 Hideyuki Tanaka+category:            Data+build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.10++library+  exposed-modules:     Data.MessagePack.Aeson+  -- other-modules:       +  -- other-extensions:    +  build-depends:       base                 >=4.7 && <5+                     , aeson                >=0.8+                     , bytestring           >=0.10+                     , msgpack              >=1.0+                     , scientific           >=0.3+                     , text                 >=1.2+                     , unordered-containers >=0.2+                     , vector               >=0.10+                     , deepseq+  hs-source-dirs:      src+  default-language:    Haskell2010+++test-suite msgpack-aeson-test+  type:                exitcode-stdio-1.0+  main-is:             test.hs++  build-depends:       base+                     , msgpack+                     , aeson+                     , msgpack-aeson+                     , tasty+                     , tasty-hunit++  hs-source-dirs:      test+  default-language:    Haskell2010
+ src/Data/MessagePack/Aeson.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase                 #-}++-- | Aeson bridge for MessagePack++module Data.MessagePack.Aeson (+  -- * Conversion functions+  toAeson, fromAeson,++  -- * MessagePack instance for Aeson.Value+  -- $msgpackInstance++  -- * ToJSON and FromJSON instance for MessagePack.Object+  -- $aesonInstances++  -- * Wrapper instances+  AsMessagePack(..),+  AsAeson(..),++  -- * Utility functions+  packAeson, unpackAeson,+  decodeMessagePack, encodeMessagePack,+  ) where++import           Control.Applicative+import           Control.Arrow+import           Control.DeepSeq+import           Data.Aeson           as A+import qualified Data.ByteString.Lazy as L+import           Data.Data+import qualified Data.HashMap.Strict  as HM+import           Data.Maybe+import           Data.MessagePack     as MP+import           Data.Scientific+import qualified Data.Text.Encoding   as T+import qualified Data.Vector          as V++-- | Convert MessagePack Object to Aeson Value.+-- If the value unable to convert, it returns Nothing+toAeson :: MP.Object -> Maybe Value+toAeson = \case+  ObjectNil      -> Just Null+  ObjectBool b   -> Just $ Bool b+  ObjectInt n    -> Just $ Number $ fromIntegral n+  ObjectFloat f  -> Just $ Number $ realToFrac f+  ObjectDouble d -> Just $ Number $ realToFrac d+  ObjectStr t    -> Just $ String t+  ObjectBin b    -> String <$> either (const Nothing) Just (T.decodeUtf8' b)+  ObjectArray v  -> Array <$> V.mapM toAeson v+  ObjectMap m    ->+    A.Object . HM.fromList . V.toList+      <$> V.mapM (\(k, v) -> (,) <$> fromObject k <*> toAeson v) m+  ObjectExt _ _  -> Nothing++-- | Convert Aeson Value to MessagePack Object+fromAeson :: Value -> MP.Object+fromAeson = \case+  Null        -> ObjectNil+  Bool b      -> ObjectBool b+  Number s ->+    case floatingOrInteger s of+      Left f  -> ObjectDouble f+      Right n -> ObjectInt n+  String t    -> ObjectStr t+  Array v     -> ObjectArray $ V.map fromAeson v+  A.Object o  -> ObjectMap $ V.fromList $ map (toObject *** fromAeson) $ HM.toList o++-- $msgpackInstance+-- > instance MessagePack Value+instance MessagePack Value where+  fromObject = toAeson+  toObject = fromAeson++-- $aesonInstances+-- > instance ToJSON Object+-- > instance FromJSON Object+instance ToJSON MP.Object where+  -- When fail to convert, it returns `Null`+  toJSON = fromMaybe Null .toAeson++instance FromJSON MP.Object where+  parseJSON = return . fromAeson++-- | Wrapper for using Aeson values as MessagePack value.+newtype AsMessagePack a = AsMessagePack { getAsMessagePack :: a }+  deriving (Eq, Ord, Show, Read, Functor, Data, Typeable, NFData)++instance (FromJSON a, ToJSON a) => MessagePack (AsMessagePack a) where+  fromObject o = AsMessagePack <$> (fromJSON' =<< toAeson o)+  toObject = fromAeson . toJSON . getAsMessagePack++-- | Wrapper for using MessagePack values as Aeson value.+newtype AsAeson a = AsAeson { getAsAeson :: a }+  deriving (Eq, Ord, Show, Read, Functor, Data, Typeable, NFData)++instance MessagePack a => ToJSON (AsAeson a) where+  toJSON = fromMaybe Null . toAeson . toObject . getAsAeson++instance MessagePack a => FromJSON (AsAeson a) where+  parseJSON = maybe empty (return . AsAeson) . fromObject . fromAeson++-- | Pack Aeson value to MessagePack binary+packAeson :: ToJSON a => a -> L.ByteString+packAeson = pack . toJSON++-- | Unpack Aeson value from MessagePack binary+unpackAeson :: FromJSON a => L.ByteString -> Maybe a+unpackAeson b = fromJSON' =<< unpack b++-- | Encode MessagePack value to JSON+encodeMessagePack :: MessagePack a => a -> L.ByteString+encodeMessagePack = encode . toJSON . AsAeson++-- | Decode MessagePack value from JSON+decodeMessagePack :: MessagePack a => L.ByteString -> Maybe a+decodeMessagePack b = getAsAeson <$> (fromJSON' =<< decode b)++fromJSON' :: FromJSON a => Value -> Maybe a+fromJSON' = resultToMaybe . fromJSON++resultToMaybe :: Result a -> Maybe a+resultToMaybe = \case+  Success a -> Just a+  _         -> Nothing
+ test/test.hs view
@@ -0,0 +1,76 @@+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell     #-}++import           Control.Monad+import           Data.Aeson+import           Data.Aeson.TH+import           Data.MessagePack+import           Data.MessagePack.Aeson+import           Test.Tasty+import           Test.Tasty.HUnit++data T+  = A Int String+  | B Double+  deriving (Show, Eq)++deriveJSON defaultOptions ''T++data U+  = C { c1 :: Int, c2 :: String }+  | D { z1 :: Double }+  deriving (Show, Eq)++deriveJSON defaultOptions ''U++data V+  = E String | F+  deriving (Show, Eq)++deriveJSON defaultOptions ''V++data W a+  = G a String+  | H { hHoge :: Int, h_age :: a }+  deriving (Show, Eq)++deriveJSON defaultOptions ''W++test :: (MessagePack a, Show a, Eq a) => a -> IO ()+test v = do+  let bs = pack v+  print bs+  print (unpack bs == Just v)++  let oa = toObject v+  print oa+  print (fromObject oa == Just v)++roundTrip :: (Show a, Eq a, ToJSON a, FromJSON a) => a -> IO ()+roundTrip v = do+  let mp = pack (AsMessagePack v)+      v' = unpack mp+  v' @?= Just (AsMessagePack v)++main :: IO ()+main =+  defaultMain $+  testGroup "test case"+  [ testCase "unnamed 1" $+    roundTrip $ A 123 "hoge"+  , testCase "unnamed 2" $+    roundTrip $ B 3.14+  , testCase "named 1" $+    roundTrip $ C 123 "hoge"+  , testCase "named 2" $+    roundTrip $ D 3.14+  , testCase "unit 1" $+    roundTrip $ E "hello"+  , testCase "unit 2" $+    roundTrip F+  , testCase "parameterized 1" $+    roundTrip $ G (E "hello") "world"+  , testCase "parameterized 2" $+    roundTrip $ H 123 F+  ]