diff --git a/riemann.cabal b/riemann.cabal --- a/riemann.cabal +++ b/riemann.cabal @@ -1,5 +1,5 @@ name: riemann -version: 0.1.0.0 +version: 0.1.0.1 synopsis: A Riemann client for Haskell description: Very simple event sending to a Riemann server. homepage: https://github.com/telser/riemann-hs @@ -24,32 +24,35 @@ Network.Monitoring.Riemann.Types other-modules: build-depends: - base >= 4.8.0 && < 5.0, - network >= 2.4.0.0, - text >= 0.11.2.3, - containers >= 0.4.2.0, - protobuf >= 0.2, - either, - lens, - time, - errors, - data-default, - transformers, - cereal + base >= 4.8.0 && < 5.0 + , network >= 2.4.0.0 + , text >= 0.11.2.3 + , containers >= 0.4.2.0 + , protobuf >= 0.2 + , transformers >= 0.4.3.0 && < 0.5 + , either + , errors < 2.0 + , lens + , time + , data-default + , cereal default-language: Haskell2010 -test-suite doctest - type: exitcode-stdio-1.0 - ghc-options: -threaded - hs-source-dirs: test - main-is: Doctest.hs - build-depends: - base, - directory, - either, - doctest, - filepath - default-language: Haskell2010 +-- test-suite doctest +-- type: exitcode-stdio-1.0 +-- ghc-options: -threaded +-- hs-source-dirs: test +-- main-is: Doctest.hs +-- build-depends: +-- base +-- , transformers >= 0.4.3.0 && < 0.5 +-- , either +-- , errors < 2.0 +-- , directory +-- , either +-- , doctest +-- , filepath +-- default-language: Haskell2010 test-suite property type: exitcode-stdio-1.0 @@ -57,12 +60,14 @@ hs-source-dirs: test main-is: Property.hs build-depends: - base, - either, - QuickCheck >= 2.5.1.0, - test-framework, - test-framework-quickcheck2, - riemann + base + , transformers >= 0.4.3.0 && < 0.5 + , either + , errors < 2.0 + , QuickCheck >= 2.5.1.0 + , test-framework + , test-framework-quickcheck2 + , riemann default-language: Haskell2010 test-suite unit @@ -71,9 +76,12 @@ hs-source-dirs: test main-is: Unit.hs build-depends: - base, - HUnit, - test-framework, - test-framework-hunit, - riemann + base + , transformers >= 0.4.3.0 && < 0.5 + , either + , errors < 2.0 + , HUnit + , test-framework + , test-framework-hunit + , riemann default-language: Haskell2010 diff --git a/src/Network/Monitoring/Riemann.hs b/src/Network/Monitoring/Riemann.hs --- a/src/Network/Monitoring/Riemann.hs +++ b/src/Network/Monitoring/Riemann.hs @@ -20,9 +20,10 @@ import qualified Control.Monad as CM import qualified Control.Monad.IO.Class as CMIC import qualified Control.Error as Error +import qualified Control.Monad.Trans.Except as Except import Control.Monad.Trans.Either import Control.Lens -import qualified Control.Exception as Except +import Control.Exception import Network.Socket hiding (send, sendTo, recv, recvFrom) import Network.Socket.ByteString @@ -121,28 +122,28 @@ -- should not cause an application failure... makeClient :: Hostname -> Port -> IO Client makeClient hn po = UDP . Error.rightMay <$> sock - where sock :: IO (Either Except.SomeException (Socket, AddrInfo)) + where sock :: IO (Either SomeException (Socket, AddrInfo)) sock = - Except.try $ do addrs <- getAddrInfo - (Just $ defaultHints { - addrFlags = [AI_NUMERICSERV] }) - (Just hn) - (Just $ show po) - case addrs of - [] -> fail "No accessible addresses" - (addy:_) -> do - s <- socket (addrFamily addy) - Datagram - (addrProtocol addy) - return (s, addy) + try $ do addrs <- getAddrInfo + (Just $ defaultHints { + addrFlags = [AI_NUMERICSERV] }) + (Just hn) + (Just $ show po) + case addrs of + [] -> fail "No accessible addresses" + (addy:_) -> do + s <- socket (addrFamily addy) + Datagram + (addrProtocol addy) + return (s, addy) -- | Attempts to forward an event to a client. Fails silently. sendEvent :: CMIC.MonadIO m => Client -> Event -> m () -sendEvent c = CMIC.liftIO . CM.void . Error.runExceptT . sendEvent' c +sendEvent c = CMIC.liftIO . CM.void . runEitherT . sendEvent' c -- | Attempts to forward an event to a client. If it fails, it'll -- return an 'IOException' in the 'Either'. -sendEvent' :: Client -> Event -> Error.ExceptT Except.IOException IO () +sendEvent' :: Client -> Event -> EitherT IOException IO () sendEvent' (UDP Nothing) _ = return () sendEvent' (UDP (Just (s, addy))) e = Error.tryIO $ do now <- fmap round getPOSIXTime diff --git a/test/Doctest.hs b/test/Doctest.hs deleted file mode 100644 --- a/test/Doctest.hs +++ /dev/null @@ -1,20 +0,0 @@ -import Control.Applicative -import Control.Monad -import Data.List -import System.Directory -import System.FilePath -import Test.DocTest - -main = getSources >>= doctest - -getSources :: IO [FilePath] -getSources = filter (isSuffixOf ".hs") <$> go "src" - where - go dir = do - (dirs, files) <- getFilesAndDirectories dir - (files ++) . concat <$> mapM go dirs - -getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath]) -getFilesAndDirectories dir = do - c <- map (dir ) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir - (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c diff --git a/test/Property.hs b/test/Property.hs --- a/test/Property.hs +++ b/test/Property.hs @@ -1,10 +1,19 @@ import Test.Framework (defaultMain, testGroup) import Test.QuickCheck import Test.Framework.Providers.QuickCheck2 (testProperty) +import Network.Monitoring.Riemann +-- main :: IO () +-- main = defaultMain [ +-- testGroup "(default)" [ +-- testProperty "isGood" (\a -> a == (a `asTypeOf` True)) +-- ] +-- ] + main :: IO () -main = defaultMain [ - testGroup "(default)" [ - testProperty "isGood" (\a -> a == (a `asTypeOf` True)) - ] - ] +main = do + client <- makeClient "127.0.0.1" 5555 + print "Client made now attempting to send event" + sendEvent client (ev "test_service" (0.0 :: Double)) + print "post event send" + print $ show client