fluent-logger 0.1.1.1 → 0.2.0.0

raw patch · 9 files changed

+410/−226 lines, 9 filesdep +cerealdep +cereal-conduitdep +conduit-extradep −msgpackdep −network-conduitdep ~networkPVP ok

version bump matches the API change (PVP)

Dependencies added: cereal, cereal-conduit, conduit-extra, containers, exceptions, messagepack, random, text, vector

Dependencies removed: msgpack, network-conduit

Dependency ranges changed: network

API changes (from Hackage documentation)

Files

• Network/Fluent/Logger.hs +0/−196
• README.md +13/−0
• fluent-logger.cabal +25/−8
• src/Network/Fluent/Logger.hs +211/−0
• src/Network/Fluent/Logger/Packable.hs +63/−0
• test/MockServer.hs +19/−20
• test/Network/Fluent/Logger/Unpackable.hs +77/−0
• test/Network/Fluent/LoggerSpec.hs +1/−1
• test/Spec.hs +1/−1

@@ -1,196 +0,0 @@------ Copyright (C) 2012 Noriyuki OHKAWA------ Licensed under the Apache License, Version 2.0 (the "License");--- you may not use this file except in compliance with the License.--- You may obtain a copy of the License at------     http://www.apache.org/licenses/LICENSE-2.0------ Unless required by applicable law or agreed to in writing, software--- distributed under the License is distributed on an "AS IS" BASIS,--- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.--- See the License for the specific language governing permissions and--- limitations under the License.----{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE CPP #-}-#if __GLASGOW_HASKELL__ < 706-{-# LANGUAGE DoRec #-}-#else-{-# LANGUAGE RecursiveDo #-}-#endif---- | Fluent Logger for Haskell-module Network.Fluent.Logger-    ( -- * Logger-      FluentLogger-    , withFluentLogger-    , newFluentLogger-    , closeFluentLogger-      -- * Settings-    , FluentSettings(..)-    , defaultFluentSettings-      -- * Post-    , post-    , postWithTime-    ) where--import qualified Data.ByteString as BS-import Data.ByteString.Char8 ( unpack )-import qualified Data.ByteString.Lazy as LBS-import Data.Monoid ( mconcat )-import qualified Network.Socket as NS-import Network.Socket.Options ( setRecvTimeout, setSendTimeout )-import Network.Socket.ByteString.Lazy ( sendAll )-import Control.Monad ( void, forever, when )-import Control.Applicative ( (<$>) )-import Control.Concurrent ( ThreadId, forkIO, killThread )-import Control.Concurrent.STM ( atomically-                              , TChan, newTChanIO, readTChan, peekTChan, writeTChan-                              , TVar, newTVarIO, readTVar, modifyTVar )-import Control.Exception ( SomeException, handle, bracket, throwIO )-import Data.MessagePack ( Packable, pack )-import Data.Int ( Int64 )-import Data.Time.Clock.POSIX ( getPOSIXTime )---- | Fluent logger settings------ Since 0.1.0.0----data FluentSettings =-    FluentSettings-    { fluentSettingsTag :: BS.ByteString-    , fluentSettingsHost :: BS.ByteString-    , fluentSettingsPort :: Int-    , fluentSettingsTimeout :: Double-    , fluentSettingsBufferLimit :: Int64-    }---- | Default fluent logger settings------ Since 0.1.0.0----defaultFluentSettings :: FluentSettings-defaultFluentSettings =-    FluentSettings-    { fluentSettingsTag = BS.empty-    , fluentSettingsHost = "localhost"-    , fluentSettingsPort = 24224-    , fluentSettingsTimeout = 3.0-    , fluentSettingsBufferLimit = 1024*1024-    }---- | Fluent logger------ Since 0.1.0.0----data FluentLogger =-    FluentLogger-    { fluentLoggerChan :: TChan LBS.ByteString-    , fluentLoggerBuffered :: TVar Int64-    , fluentLoggerSettings :: FluentSettings-    , fluentLoggerThread :: ThreadId-    }--getSocket :: BS.ByteString -> Int -> Int64 -> IO NS.Socket-getSocket host port timeout = do-  let hints = NS.defaultHints { NS.addrFlags = [NS.AI_ADDRCONFIG]-                              , NS.addrSocketType = NS.Stream-                              }-  (addr:_) <- NS.getAddrInfo (Just hints) (Just $ unpack host) (Just $ show port)-  sock <- NS.socket (NS.addrFamily addr) (NS.addrSocketType addr) (NS.addrProtocol addr)-  setRecvTimeout sock timeout-  setSendTimeout sock timeout-  let onErr :: SomeException -> IO a-      onErr e = NS.sClose sock >> throwIO e-  handle onErr $ do-    NS.connect sock $ NS.addrAddress addr-    return sock--sender :: FluentLogger -> IO ()-sender logger = forever $ connectFluent logger >>= sendFluent logger--connectFluent :: FluentLogger -> IO NS.Socket-connectFluent logger = handle (retry logger) (getSocket host port timeout)-    where-      host = fluentSettingsHost $ fluentLoggerSettings logger-      port = fluentSettingsPort $ fluentLoggerSettings logger-      timeout = round $ fluentSettingsTimeout (fluentLoggerSettings logger) * 1000000-      retry :: FluentLogger -> SomeException -> IO NS.Socket-      retry = const . connectFluent--sendFluent :: FluentLogger -> NS.Socket -> IO ()-sendFluent logger sock = handle (done sock) $ do-                           entry <- atomically $ peekTChan chan-                           sendAll sock entry-                           atomically $ do-                             void $ readTChan chan-                             modifyTVar buffered (subtract $ LBS.length entry)-                           sendFluent logger sock-    where-      chan = fluentLoggerChan logger-      buffered = fluentLoggerBuffered logger-      done :: NS.Socket -> SomeException -> IO ()-      done = const . NS.sClose---- | Create a fluent logger------ Since 0.1.0.0----newFluentLogger :: FluentSettings -> IO FluentLogger-newFluentLogger set = do-  tchan <- newTChanIO-  tvar <- newTVarIO 0-  let mkLogger tid = FluentLogger { fluentLoggerChan = tchan-                                  , fluentLoggerBuffered = tvar-                                  , fluentLoggerSettings = set-                                  , fluentLoggerThread = tid-                                  }-  rec logger <- mkLogger <$> forkIO (sender logger)-  return logger---- | Close logger------ Since 0.1.0.0----closeFluentLogger :: FluentLogger -> IO ()-closeFluentLogger = killThread . fluentLoggerThread---- | Create a fluent logger and run given action.------ Since 0.1.0.0----withFluentLogger :: FluentSettings -> (FluentLogger -> IO a) -> IO a-withFluentLogger set = bracket (newFluentLogger set) closeFluentLogger--getCurrentEpochTime :: IO Int-getCurrentEpochTime = round <$> getPOSIXTime---- | Post a message.------ Since 0.1.0.0----post :: Packable a => FluentLogger -> BS.ByteString -> a -> IO ()-post logger label obj = do-  time <- getCurrentEpochTime-  postWithTime logger label time obj---- | Post a message with given time.------ Since 0.1.0.0----postWithTime :: Packable a => FluentLogger -> BS.ByteString -> Int -> a -> IO ()-postWithTime logger label time obj = atomically $ do-                                       s <- readTVar buffered-                                       when (s + len <= limit) $ do-                                         writeTChan chan entry-                                         modifyTVar buffered (+ len)-  where-    tag = fluentSettingsTag $ fluentLoggerSettings logger-    lbl = if BS.null label then tag else mconcat [ tag, ".", label ]-    entry = pack ( lbl, time, obj )-    len = LBS.length entry-    chan = fluentLoggerChan logger-    buffered = fluentLoggerBuffered logger-    limit = fluentSettingsBufferLimit $ fluentLoggerSettings logger

@@ -0,0 +1,13 @@+Fluent logger for Haskell+=========================++A structured event loger++fluent-logger-haskell is a Haskell libraries, to record the events from Haskell application.++# Install++~~~ {.bash}+$ cabal update+$ cabal install fluent-logger+~~~

@@ -1,31 +1,40 @@ name:                fluent-logger-version:             0.1.1.1+version:             0.2.0.0 synopsis:            A structured logger for Fluentd (Haskell) description:         A structured logger for Fluentd (Haskell) <http://fluentd.org/>-license:             OtherLicense+license:             Apache-2.0 license-file:        LICENSE author:              Noriyuki OHKAWA <n.ohkawa@gmail.com> maintainer:          Noriyuki OHKAWA <n.ohkawa@gmail.com> copyright:           Copyright (c) 2012, Noriyuki OHKAWA category:            Network build-type:          Simple-cabal-version:       >=1.8-tested-with:         GHC ==7.4.2+extra-source-files:  README.md+cabal-version:       >=1.10+tested-with:         GHC ==7.6.1, GHC ==7.6.2, GHC ==7.6.3, GHC ==7.8.3  source-repository head   type:                git   location:            https://github.com/notogawa/fluent-logger-haskell.git  library+  hs-source-dirs:      src   exposed-modules:     Network.Fluent.Logger+                     , Network.Fluent.Logger.Packable   ghc-options:         -Wall   build-depends:       base ==4.*                      , bytestring-                     , network >=2.3.0.13 && <2.5+                     , text+                     , network >=2.3.0.13 && <2.7                      , network-socket-options >=0.1 && <0.3                      , time-                     , msgpack >=0.7.1 && <0.8+                     , cereal+                     , messagepack >= 0.2.0                      , stm >=2.3+                     , random+                     , vector+                     , containers+  default-language:    Haskell2010  test-suite fluent-logger-spec   hs-source-dirs:      test@@ -33,17 +42,24 @@   main-is:             Spec.hs   other-modules:       MockServer                      , Network.Fluent.LoggerSpec+                     , Network.Fluent.Logger.Unpackable   build-depends:       base ==4.*                      , fluent-logger+                     , text                      , network-                     , msgpack-                     , network-conduit+                     , messagepack                      , conduit+                     , conduit-extra                      , bytestring                      , transformers                      , hspec                      , attoparsec                      , time+                     , cereal+                     , cereal-conduit+                     , exceptions+                     , containers+  default-language:    Haskell2010  benchmark fluent-logger-benchmark   hs-source-dirs:      benchmark@@ -52,3 +68,4 @@   build-depends:       base ==4.*                      , fluent-logger                      , criterion+  default-language:    Haskell2010

@@ -0,0 +1,211 @@+--+-- Copyright (C) 2012 Noriyuki OHKAWA+--+-- Licensed under the Apache License, Version 2.0 (the "License");+-- you may not use this file except in compliance with the License.+-- You may obtain a copy of the License at+--+--     http://www.apache.org/licenses/LICENSE-2.0+--+-- Unless required by applicable law or agreed to in writing, software+-- distributed under the License is distributed on an "AS IS" BASIS,+-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+-- See the License for the specific language governing permissions and+-- limitations under the License.+--++-- | Fluent Logger for Haskell+module Network.Fluent.Logger+    ( -- * Logger+      FluentLogger+    , withFluentLogger+    , newFluentLogger+    , closeFluentLogger+      -- * Settings+    , FluentSettings(..)+    , defaultFluentSettings+      -- * Post+    , post+    , postWithTime+    ) where++import qualified Data.ByteString.Char8 as BS ( ByteString, pack, unpack, empty, null)+import qualified Data.ByteString.Lazy as LBS ( ByteString, length )+import Data.Monoid ( mconcat )+import qualified Network.Socket as NS+import Network.Socket.Options ( setRecvTimeout, setSendTimeout )+import Network.Socket.ByteString.Lazy ( sendAll )+import Control.Monad ( void, forever, when )+import Control.Applicative ( (<$>) )+import Control.Concurrent ( ThreadId, forkIO, killThread, threadDelay )+import Control.Concurrent.STM ( atomically+                              , TChan, newTChanIO, readTChan, peekTChan, writeTChan+                              , TVar, newTVarIO, readTVar, modifyTVar )+import Control.Exception ( SomeException, handle, bracket, throwIO )+import Data.MessagePack+import Data.Serialize hiding (label)+import Data.Int ( Int64 )+import Data.Time.Clock.POSIX ( getPOSIXTime )+import System.Random ( randomRIO )++import Network.Fluent.Logger.Packable++-- | Fluent logger settings+--+-- Since 0.1.0.0+--+data FluentSettings =+    FluentSettings+    { fluentSettingsTag :: BS.ByteString+    , fluentSettingsHost :: BS.ByteString+    , fluentSettingsPort :: Int+    , fluentSettingsTimeout :: Double+    , fluentSettingsBufferLimit :: Int64+    }++-- | Default fluent logger settings+--+-- Since 0.1.0.0+--+defaultFluentSettings :: FluentSettings+defaultFluentSettings =+    FluentSettings+    { fluentSettingsTag = BS.empty+    , fluentSettingsHost = BS.pack "localhost"+    , fluentSettingsPort = 24224+    , fluentSettingsTimeout = 3.0+    , fluentSettingsBufferLimit = 1024*1024+    }++-- | Fluent logger+--+-- Since 0.1.0.0+--+data FluentLogger =+    FluentLogger+    { fluentLoggerSender :: FluentLoggerSender+    , fluentLoggerThread :: ThreadId+    }++data FluentLoggerSender =+    FluentLoggerSender+    { fluentLoggerSenderChan :: TChan LBS.ByteString+    , fluentLoggerSenderBuffered :: TVar Int64+    , fluentLoggerSenderSettings :: FluentSettings+    }++getSocket :: BS.ByteString -> Int -> Int64 -> IO NS.Socket+getSocket host port timeout = do+  let hints = NS.defaultHints { NS.addrFlags = [NS.AI_ADDRCONFIG]+                              , NS.addrSocketType = NS.Stream+                              }+  (addr:_) <- NS.getAddrInfo (Just hints) (Just $ BS.unpack host) (Just $ show port)+  sock <- NS.socket (NS.addrFamily addr) (NS.addrSocketType addr) (NS.addrProtocol addr)+  setRecvTimeout sock timeout+  setSendTimeout sock timeout+  let onErr :: SomeException -> IO a+      onErr e = NS.sClose sock >> throwIO e+  handle onErr $ do+    NS.connect sock $ NS.addrAddress addr+    return sock++runSender :: FluentLoggerSender -> IO ()+runSender logger = forever $ connectFluent logger >>= sendFluent logger++connectFluent :: FluentLoggerSender -> IO NS.Socket+connectFluent logger = exponentialBackoff $ getSocket host port timeout where+    set = fluentLoggerSenderSettings logger+    host = fluentSettingsHost set+    port = fluentSettingsPort set+    timeout = round $ fluentSettingsTimeout set * 1000000++exponentialBackoff :: IO a -> IO a+exponentialBackoff action = handle (retry 100000) action where+    retry failCount exception =+        let _ = exception :: SomeException+        in exponentialBackoff' failCount+    exponentialBackoff' interval = do+      delay <- randomRIO (interval `div` 2, interval * 3 `div` 2)+      threadDelay delay+      handle (retry $ min 60000000 $ interval * 3 `div` 2) action++sendFluent :: FluentLoggerSender -> NS.Socket -> IO ()+sendFluent logger sock = handle (done sock) toSender where+    chan = fluentLoggerSenderChan logger+    buffered = fluentLoggerSenderBuffered logger+    done :: NS.Socket -> SomeException -> IO ()+    done = const . NS.sClose+    toSender = do+      entry <- atomically $ peekTChan chan+      sendAll sock entry+      atomically $ do+        void $ readTChan chan+        modifyTVar buffered (subtract $ LBS.length entry)+      sendFluent logger sock++-- | Create a fluent logger+--+-- Since 0.1.0.0+--+newFluentLogger :: FluentSettings -> IO FluentLogger+newFluentLogger set = do+  tchan <- newTChanIO+  tvar <- newTVarIO 0+  let sender = FluentLoggerSender+               { fluentLoggerSenderChan = tchan+               , fluentLoggerSenderBuffered = tvar+               , fluentLoggerSenderSettings = set+               }+  tid <- forkIO $ runSender sender+  let logger = FluentLogger+               { fluentLoggerSender = sender+               , fluentLoggerThread = tid+               }+  return logger++-- | Close logger+--+-- Since 0.1.0.0+--+closeFluentLogger :: FluentLogger -> IO ()+closeFluentLogger = killThread . fluentLoggerThread++-- | Create a fluent logger and run given action.+--+-- Since 0.1.0.0+--+withFluentLogger :: FluentSettings -> (FluentLogger -> IO a) -> IO a+withFluentLogger set = bracket (newFluentLogger set) closeFluentLogger++getCurrentEpochTime :: IO Int+getCurrentEpochTime = round <$> getPOSIXTime++-- | Post a message.+--+-- Since 0.2.0.0+--+post :: Packable a => FluentLogger -> BS.ByteString -> a -> IO ()+post logger label obj = do+  time <- getCurrentEpochTime+  postWithTime logger label time obj++-- | Post a message with given time.+--+-- Since 0.2.0.0+--+postWithTime :: Packable a => FluentLogger -> BS.ByteString -> Int -> a -> IO ()+postWithTime logger label time obj = atomically send where+    sender = fluentLoggerSender logger+    set = fluentLoggerSenderSettings sender+    tag = fluentSettingsTag set+    lbl = if BS.null label then tag else mconcat [ tag, BS.pack ".", label ]+    entry = encodeLazy $ ObjectArray [ObjectBinary lbl, ObjectInt (fromIntegral time), pack obj]+    len = LBS.length entry+    chan = fluentLoggerSenderChan sender+    buffered = fluentLoggerSenderBuffered sender+    limit = fluentSettingsBufferLimit set+    send = do+      s <- readTVar buffered+      when (s + len <= limit) $ do+        writeTChan chan entry+        modifyTVar buffered (+ len)

@@ -0,0 +1,63 @@+{-# LANGUAGE FlexibleInstances, IncoherentInstances, TypeSynonymInstances #-}+-- | For compatibility with msgpack+module Network.Fluent.Logger.Packable (Packable(..)) where++import Data.MessagePack+import qualified Data.Map as M+import qualified Data.Vector as V+import qualified Data.Text as T+import qualified Data.Text.Lazy as LT+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy as LBS++-- | MessagePackable+--+-- Since 0.2.0.0+--+class Packable a where+    pack :: a -> Object++instance Packable Object where+    pack = id++instance Packable () where+    pack = const ObjectNil++instance Packable Int where+    pack = ObjectInt . fromIntegral++instance Packable String where+    pack = ObjectString . T.pack++instance Packable BS.ByteString where+    pack = ObjectBinary++instance Packable LBS.ByteString where+    pack = ObjectBinary . LBS.toStrict++instance Packable T.Text where+    pack = ObjectString++instance Packable LT.Text where+    pack = ObjectString . T.pack . LT.unpack++instance Packable a => Packable [a] where+    pack = ObjectArray . map pack++instance Packable a => Packable (V.Vector a) where+    pack = ObjectArray . map pack . V.toList++instance (Packable a1, Packable a2) => Packable (a1, a2) where+    pack (a1, a2) = ObjectArray [pack a1, pack a2]++instance (Packable a1, Packable a2, Packable a3) => Packable (a1, a2, a3) where+    pack (a1, a2, a3) = ObjectArray [pack a1, pack a2, pack a3]++instance (Packable a1, Packable a2, Packable a3, Packable a4) => Packable (a1, a2, a3, a4) where+    pack (a1, a2, a3, a4) = ObjectArray [pack a1, pack a2, pack a3, pack a4]++instance (Packable a1, Packable a2, Packable a3, Packable a4, Packable a5) => Packable (a1, a2, a3, a4, a5) where+    pack (a1, a2, a3, a4, a5) = ObjectArray [pack a1, pack a2, pack a3, pack a4, pack a5]++instance (Packable k, Packable v) => Packable (M.Map k v) where+    pack = ObjectMap . (M.foldWithKey (\k v -> M.insert (pack k) (pack v)) M.empty)

@@ -10,14 +10,19 @@  import Data.Conduit import Data.Conduit.Network+import Data.Conduit.Cereal import Data.ByteString ( ByteString ) import Control.Concurrent import Control.Monad.IO.Class+import Control.Monad.Catch (MonadThrow) import Control.Exception-import Data.MessagePack ( Unpackable, get )-import Data.Attoparsec+import Data.Serialize (Serialize, get)+import Data.MessagePack import Data.Monoid +import Network.Fluent.Logger.Packable (pack)+import Network.Fluent.Logger.Unpackable (Unpackable, unpack)+ data MockServer a = MockServer { mockServerChan :: Chan a                                , mockServerThread :: ThreadId                                }@@ -28,32 +33,26 @@ mockServerPort :: Int mockServerPort = 24224 -mockServerSettings :: ServerSettings IO-mockServerSettings = serverSettings mockServerPort HostAny+mockServerSettings :: ServerSettings+mockServerSettings = serverSettings mockServerPort "*" -app :: (MonadIO m, Unpackable a) => Chan a -> AppData m -> m ()-app chan ad = appSource ad $$ sinkChan chan ""+app :: (MonadIO m, MonadThrow m, Serialize a) => Chan a -> AppData -> m ()+app chan ad = appSource ad $= conduitGet get $$ sinkChan chan -sinkChan :: (MonadIO m, Unpackable a) => Chan a -> ByteString -> Sink ByteString m ()-sinkChan chan carry = do+sinkChan :: (MonadIO m, Serialize a) => Chan a -> Sink a m ()+sinkChan chan = do   mx <- await   case mx of     Nothing -> return ()-    Just x  -> parseAsPossible chan (carry <> x) >>= sinkChan chan--parseAsPossible :: (MonadIO m, Unpackable a) => Chan a -> ByteString -> m ByteString-parseAsPossible chan src =-    case parse get src of-      Done t r -> liftIO (writeChan chan r) >> parseAsPossible chan t-      _ -> return src+    Just x  -> liftIO (writeChan chan x) >> sinkChan chan -withMockServer :: Unpackable a => (MockServer a -> IO ()) -> IO ()+withMockServer :: Serialize a => (MockServer a -> IO ()) -> IO () withMockServer = bracket runMockServer stopMockServer -recvMockServer :: Unpackable a => MockServer a -> IO a-recvMockServer server = readChan (mockServerChan server)+recvMockServer :: Unpackable b => MockServer Object -> IO b+recvMockServer server = fmap unpack $ readChan (mockServerChan server) -runMockServer :: Unpackable a => IO (MockServer a)+runMockServer :: Serialize a => IO (MockServer a) runMockServer = do   chan <- newChan   tid <- forkIO $ runTCPServer mockServerSettings $ app chan@@ -62,7 +61,7 @@                     , mockServerThread = tid                     } -stopMockServer :: Unpackable a => MockServer a -> IO ()+stopMockServer :: Serialize a => MockServer a -> IO () stopMockServer server = do   killThread $ mockServerThread server   threadDelay 10000

@@ -0,0 +1,77 @@+{-# LANGUAGE FlexibleInstances, IncoherentInstances, TypeSynonymInstances #-}+{-# LANGUAGE DeriveDataTypeable #-}+-- | For compatibility with msgpack+module Network.Fluent.Logger.Unpackable where++import Control.Exception+import Data.Typeable+import Data.MessagePack+import qualified Data.Map as M+import qualified Data.Text as T+import qualified Data.Text.Lazy as LT+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Lazy as LBS++data UnpackError =+    UnpackError String+    deriving (Show, Typeable)++instance Exception UnpackError++-- | Deserializable Type+--+-- Since 0.2.0.0+--+class Unpackable a where+    unpack :: Object -> a++instance Unpackable Object where+    unpack = id++instance Unpackable () where+    unpack ObjectNil = ()+    unpack x = throw $ UnpackError $ "invalid for nil: " ++ show x++instance Unpackable Int where+    unpack (ObjectInt x) = fromIntegral x+    unpack x = throw $ UnpackError $ "invalid for int: " ++ show x++instance Unpackable String where+    unpack (ObjectString x) = T.unpack x+    unpack x = throw $ UnpackError $ "invalid for string: " ++ show x++instance Unpackable BS.ByteString where+    unpack (ObjectBinary x) = x+    unpack x = throw $ UnpackError $ "invalid for binary: " ++ show x++instance Unpackable LBS.ByteString where+    unpack (ObjectBinary x) = LBS.fromStrict x+    unpack x = throw $ UnpackError $ "invalid for binary: " ++ show x++instance Unpackable T.Text where+    unpack (ObjectString x) = x+    unpack x = throw $ UnpackError $ "invalid for string: " ++ show x++instance Unpackable LT.Text where+    unpack (ObjectString x) = LT.pack . T.unpack $ x+    unpack x = throw $ UnpackError $ "invalid for string: " ++ show x++instance (Unpackable a1, Unpackable a2) => Unpackable (a1, a2) where+    unpack (ObjectArray (a1:a2:[])) = (unpack a1, unpack a2)+    unpack x = throw $ UnpackError $ "invalid for array: " ++ show x++instance (Unpackable a1, Unpackable a2, Unpackable a3) => Unpackable (a1, a2, a3) where+    unpack (ObjectArray (a1:a2:a3:[])) = (unpack a1, unpack a2, unpack a3)+    unpack x = throw $ UnpackError $ "invalid for array: " ++ show x++instance (Unpackable a1, Unpackable a2, Unpackable a3, Unpackable a4) => Unpackable (a1, a2, a3, a4) where+    unpack (ObjectArray (a1:a2:a3:a4:[])) = (unpack a1, unpack a2, unpack a3, unpack a4)+    unpack x = throw $ UnpackError $ "invalid for array: " ++ show x++instance (Unpackable a1, Unpackable a2, Unpackable a3, Unpackable a4, Unpackable a5) => Unpackable (a1, a2, a3, a4, a5) where+    unpack (ObjectArray (a1:a2:a3:a4:a5:[])) = (unpack a1, unpack a2, unpack a3, unpack a4, unpack a5)+    unpack x = throw $ UnpackError $ "invalid for array: " ++ show x++instance (Ord k, Unpackable k, Unpackable v) => Unpackable (M.Map k v) where+    unpack (ObjectMap x) = M.foldWithKey (\k v -> M.insert (unpack k) (unpack v)) M.empty x+    unpack x = throw $ UnpackError $ "invalid for map: " ++ show x

@@ -71,7 +71,7 @@         post logger label ( 2 :: Int )         (_, _, content) <- recvMockServer server :: IO (ByteString, Int, Int)         content `shouldBe` 1-        (_, _, content) <- recvMockServer server+        (_, _, content) <- recvMockServer server :: IO (ByteString, Int, Int)         content `shouldBe` 2  postBuffersMessageIfLostConnection :: IO ()

@@ -1,1 +1,1 @@-{-# OPTIONS_GHC -F -pgmF cabal-dev/bin/hspec-discover #-}+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}