gremlin-haskell 0.1.0.1 → 0.1.0.2

raw patch · 3 files changed

+37/−18 lines, 3 filesdep +transformersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: transformers

API changes (from Hackage documentation)

Files

• gremlin-haskell.cabal +2/−1
• src/Database/TinkerPop.hs +8/−4
• src/Database/TinkerPop/Internal.hs +27/−13

@@ -1,5 +1,5 @@ name:                gremlin-haskell-version:             0.1.0.1+version:             0.1.0.2 synopsis:            Graph database client for TinkerPop3 Gremlin Server description:         Please see README.md homepage:            http://github.com/nakaji-dayo/gremlin-haskell@@ -36,6 +36,7 @@                      , mtl                      , stm                      , uuid+                     , transformers   default-language:    Haskell2010   executable gremlin-haskell-examples

@@ -11,8 +11,9 @@ import Database.TinkerPop.Types import Database.TinkerPop.Internal -import Prelude hiding (putStrLn)+import Prelude import qualified Network.WebSockets as WS+import Control.Exception  import qualified Data.Map.Strict as M import Data.Text (unpack)@@ -20,19 +21,22 @@ import qualified Control.Monad.STM as S import qualified Control.Concurrent.STM.TChan as S import qualified Control.Concurrent.STM.TVar as S+import qualified Control.Concurrent.MVar as MV import qualified Data.UUID as U import qualified Data.UUID.V4 as U import Control.Lens  -- | Connect to Gremlin Server run :: String -> Int -> (Connection -> IO ()) -> IO ()-run host port app = do    -    WS.runClient host port "/" $ \ws -> do+run host port app = do+    handle (wsExceptionHandler "main thread") $ WS.runClient host port "/" $ \ws -> do+        done <- MV.newEmptyMVar         cs <- S.newTVarIO M.empty         let conn = Connection ws cs-        _ <- handle conn+        _ <- handler conn done         app conn         close conn+        MV.takeMVar done  -- | Send script toGremlin Server and get the result by List --

@@ -5,12 +5,13 @@ import Data.Text (Text, pack, append) import Data.Text.IO import Data.Text.Encoding+import Control.Exception import qualified Data.Map.Strict as M import qualified Control.Monad.STM as S import qualified Control.Concurrent.STM.TChan as S import qualified Control.Concurrent.STM.TVar as S import Control.Concurrent-import Control.Monad (forever)+import Control.Monad import Control.Lens import Data.Aeson (eitherDecodeStrict) import qualified Network.WebSockets as WS@@ -20,18 +21,31 @@ inStatus2xx x =  (x `quot` 100) == 2  -- | Start thread to recieve response-handle :: Connection -> IO (ThreadId)-handle conn = do-    forkIO $ forever $ do-        msg <- WS.receiveData (conn ^. socket) :: IO Text---        putStrLn $ "recv: " `append` msg-        case eitherDecodeStrict (encodeUtf8 msg) of-         Right r -> do-             cs <- S.readTVarIO (conn ^. chans)-             case M.lookup (r ^. requestId) cs of-              Just chan -> S.atomically $ S.writeTChan chan (Right r)-              Nothing -> putStrLn $ "ERROR: chan not found"-         Left s -> putStrLn $ "ERROR: parse response message: " `append` (pack s)+handler :: Connection -> MVar () -> IO ()+handler conn done = do+    void $ forkIO $ do+        handle (wsExceptionHandler "child thread") $ forever $ do+            msg <- (WS.receiveData (conn ^. socket) :: IO Text)+            case eitherDecodeStrict (encodeUtf8 msg) of+             Right r -> do+                 cs <- S.readTVarIO (conn ^. chans)+                 case M.lookup (r ^. requestId) cs of+                  Just chan -> S.atomically $ S.writeTChan chan (Right r)+                  Nothing -> putStrLn $ "ERROR: chan not found"+             Left s -> putStrLn $ "ERROR: parse response message: " `append` (pack s)+        putMVar done ()++-- | Handle exception from websocket.+--+-- Ignore ConnectionClised exception that expected.+wsExceptionHandler :: Text -> SomeException -> IO ()+wsExceptionHandler label e = do+    -- putStrLn $ "handle exception[" `append` label `append` "]: " `append` (pack $ show e)+    case fromException e of+     Just WS.ConnectionClosed -> return ()+     _ -> do+         putStrLn $ "unexpect exception[" `append` label `append` "]: " `append` (pack $ show e)+         throw e  -- | Close connection close :: Connection -> IO ()