diff --git a/Network/Fluent/Logger.hs b/Network/Fluent/Logger.hs
deleted file mode 100644
--- a/Network/Fluent/Logger.hs
+++ /dev/null
@@ -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
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -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
+~~~
diff --git a/fluent-logger.cabal b/fluent-logger.cabal
--- a/fluent-logger.cabal
+++ b/fluent-logger.cabal
@@ -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)
-license: OtherLicense
+license: Apache-2.0
license-file: LICENSE
author: Noriyuki OHKAWA
maintainer: Noriyuki OHKAWA
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
diff --git a/src/Network/Fluent/Logger.hs b/src/Network/Fluent/Logger.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/Fluent/Logger.hs
@@ -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)
diff --git a/src/Network/Fluent/Logger/Packable.hs b/src/Network/Fluent/Logger/Packable.hs
new file mode 100644
--- /dev/null
+++ b/src/Network/Fluent/Logger/Packable.hs
@@ -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)
diff --git a/test/MockServer.hs b/test/MockServer.hs
--- a/test/MockServer.hs
+++ b/test/MockServer.hs
@@ -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
diff --git a/test/Network/Fluent/Logger/Unpackable.hs b/test/Network/Fluent/Logger/Unpackable.hs
new file mode 100644
--- /dev/null
+++ b/test/Network/Fluent/Logger/Unpackable.hs
@@ -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
diff --git a/test/Network/Fluent/LoggerSpec.hs b/test/Network/Fluent/LoggerSpec.hs
--- a/test/Network/Fluent/LoggerSpec.hs
+++ b/test/Network/Fluent/LoggerSpec.hs
@@ -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 ()
diff --git a/test/Spec.hs b/test/Spec.hs
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -1,1 +1,1 @@
-{-# OPTIONS_GHC -F -pgmF cabal-dev/bin/hspec-discover #-}
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}