github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-01 09:15:01 +03:00
Code Issues Projects Releases Wiki Activity

Add GitmonException

Browse Source
This commit is contained in:
Rick Winfrey 2017-03-08 10:30:32 -08:00
parent dd7fb995f1
commit 5df5581507
1 changed files with 7 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/GitmonClient.hs
View File

@ -2,6 +2,7 @@
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
module GitmonClient where
import Control.Exception (throw)
import Data.Aeson
import Data.Aeson.Types
import Data.ByteString.Lazy (toStrict)
@ -18,6 +19,11 @@ import System.Directory (getCurrentDirectory)
import System.Environment
import System.Timeout
newtype GitmonException = GitmonException String deriving (Show, Typeable)
instance Exception GitmonException
data ProcIO = ProcIO { read_bytes :: Integer
, write_bytes :: Integer } deriving (Show, Generic)
@ -73,7 +79,7 @@ reportGitmon' SocketFactory{..} program gitCommand = do
!result <- case join maybeCommand of
Just command | "fail" `isInfixOf` decodeUtf8 command ->
error . unpack $ "Received '" <> decodeUtf8 command <> "' from Gitmon"
throw . GitmonException . unpack $ "Received '" <> decodeUtf8 command <> "' from Gitmon"
_ -> gitCommand
(afterTime, afterProcIOContents) <- liftIO collectStats