Move GitmonClient to semantic-diff/src

src/GitmonClient.hs

@@ -0,0 +1,66 @@
+{-# LANGUAGE RecordWildCards, DeriveGeneric #-}
+module GitmonClient where
+
+import Prelude
+import GHC.Generics
+import Data.Aeson
+import Data.Aeson.Types
+
+import Network.Socket hiding (send)
+import Network.Socket.ByteString (send)
+
+import Data.ByteString.Lazy (toStrict)
+
+data Stats =
+    StartStats { repoName :: String
+               , via :: String
+               , gitDir :: String
+               , program :: String
+               , realIP :: Maybe String
+               , repoID :: Maybe String
+               , userID :: Maybe String }
+  | FinishStats { cpu :: Integer
+                , diskReadBytes :: Integer
+                , diskWriteBytes :: Integer
+                , resultCode :: Integer } deriving (Generic, Show)
+
+instance ToJSON Stats where
+  toJSON = genericToJSON defaultOptions { fieldLabelModifier = camelTo2 '_' }
+
+data GitmonCommand = Update
+                   | Finish
+                   | Schedule deriving (Show)
+
+instance ToJSON GitmonCommand where
+  toJSON command = String $ case command of
+    Update -> "update"
+    Finish -> "finish"
+    Schedule -> "schedule"
+
+data GitmonMsg = GitmonMsg { command :: GitmonCommand, stats :: Stats } deriving (Show)
+
+instance ToJSON GitmonMsg where
+  toJSON GitmonMsg{..} = object [
+    "command" .= command,
+    "data" .= stats
+    ]
+
+track :: IO a -> IO a
+track command = do
+  soc <- socket AF_UNIX Stream defaultProtocol
+  connect soc (SockAddrUnix "/tmp/gitstats.sock")
+
+  let startStats = StartStats { repoName = "test-js", via = "gitrpc", gitDir = "/Users/vera/github/test-js", program = "semantic-diff", realIP = Nothing, repoID = Nothing, userID = Nothing}
+  let startStatsJSON = toStrict . encode $ GitmonMsg Update startStats
+  _ <- send soc startStatsJSON
+
+  thing <- command
+
+  let finishStats = FinishStats { cpu = 100, diskReadBytes = 1000, diskWriteBytes = 1000, resultCode = 0 }
+  let finishStatsJSON = toStrict . encode $ GitmonMsg Finish finishStats
+
+  _ <- send soc finishStatsJSON
+
+  close soc
+
+  return thing