PipeReader: read from zmq socket

app/Main.hs

@@ -130,9 +130,10 @@ main = do
     pipeReaderThread ctx config =
       case (tickPipePath config, pipeReaderQsEndpoint config) of
         (Just pipe, Just qsep) -> do
+          infoM "main" $ "Pipe/QS: " ++ pipe ++ "/" ++ qsep
           tickChan <- newBoundedChan 10000
-          bracket (startPipeReader (T.pack pipe) tickChan) stopPipeReader (\_ -> do
+          bracket (startPipeReader ctx (T.pack pipe) tickChan) stopPipeReader (\_ -> do
-            bracket (startQuoteSourceServer tickChan ctx (T.pack qsep) (Just "global")) stopQuoteSourceServer (\_ -> threadDelay 1000000))
+            bracket (startQuoteSourceServer tickChan ctx (T.pack qsep) (Just "global")) stopQuoteSourceServer (\_ -> forever $ threadDelay 1000000))
         _ -> return ()
 
 

src/QuoteSource/PipeReader.hs

@@ -6,33 +6,38 @@ module QuoteSource.PipeReader (
   stopPipeReader
   ) where
 
-import Data.IORef
+import           ATrade.QuoteSource.Server
-import qualified Data.Text as T
-import qualified Data.Map.Strict as M
-import qualified Data.HashSet as HS
-import Data.Time.Clock
-import Data.Time.Calendar
 import           ATrade.Types
+import           Control.Applicative
+import           Control.Concurrent             hiding (readChan, writeChan,
+                                                 writeList2Chan, yield)
+import           Control.Concurrent.BoundedChan
+import           Control.Error.Util
+import           Control.Exception
 import           Control.Monad
 import           Control.Monad.Extra
+import           Control.Monad.IO.Class
 import           Control.Monad.Loops
+import           Data.Attoparsec.Text
+import qualified Data.ByteString                as B
+import           Data.Conduit                   hiding (connect)
+import           Data.Conduit.Attoparsec
+import qualified Data.Conduit.List              as CL
+import qualified Data.HashSet                   as HS
+import           Data.IORef
+import qualified Data.Map.Strict                as M
 import           Data.Maybe
-import Foreign.Marshal.Alloc
+import qualified Data.Text                      as T
+import           Data.Text.Encoding
 import qualified Data.Text.Foreign              as FT
-import System.Win32.File
+import           Data.Time.Calendar
-import System.Win32.Types
+import           Data.Time.Clock
-import Control.Concurrent.BoundedChan
+import           Foreign.Marshal.Alloc
-import Control.Concurrent hiding (readChan, writeChan, writeList2Chan, yield)
-import Control.Exception
-import Control.Monad.IO.Class
-import Control.Applicative
 import           Safe
-import Control.Error.Util
+import           System.IO
-import Data.Attoparsec.Text
+import           System.Log.Logger              (debugM, warningM)
-import Data.Conduit
+import           System.ZMQ4
-import qualified Data.Conduit.List as CL
+
-import Data.Conduit.Attoparsec
-import ATrade.QuoteSource.Server
 
 data PipeReaderHandle =
   PipeReaderHandle {
@@ -42,6 +47,7 @@ data PipeReaderHandle =
 
 data DataLine = CurrentParamLine T.Text Double Integer Double Integer Integer Double Integer Integer
               | AllTradeLine T.Text Integer Double Integer UTCTime
+              deriving (Show, Eq)
 
 yieldJust :: Maybe a -> Source IO a
 yieldJust maybeV = do -- Probably already present in some library
@@ -49,17 +55,15 @@ yieldJust maybeV = do -- Probably already present in some library
     Just v  -> yield v
     Nothing -> return ()
 
-win32FileConduit :: HANDLE -> Source IO T.Text
+zmqSocketConduit :: (Receiver a) => Socket a -> Source IO T.Text
-win32FileConduit handle = do -- TODO actually i have to check if pipe is closed
+zmqSocketConduit sock = do
-  maybeStr <- liftIO $ allocaBytes 4096 $ \buf -> do
+  maybeStr <- liftIO $ do
-    r <- win32_ReadFile handle buf 4096 Nothing
+    bs <- receive sock
-    if r > 0
+    case decodeUtf8' bs of
-       then do
+      Left _  -> return Nothing
-         s <- FT.peekCStringLen (buf, fromEnum r)
+      Right v -> return (Just v)
-         return $ Just s
-       else return Nothing
   yieldJust maybeStr
-  win32FileConduit handle
+  zmqSocketConduit sock
 
 line2TickConduit :: Conduit DataLine IO Tick
 line2TickConduit = do
@@ -90,7 +94,7 @@ line2TickConduit = do
       AllTradeLine tickerId flags price volume ts -> do
         liftIO $ writeIORef lastTimestamp ts
         if
-           | flags == 1 -> yieldTick tickerId LastTradePrice ts (fromDouble price) (-volume)
+           | flags == 1 -> yieldTick tickerId LastTradePrice ts (fromDouble price) volume
            | flags == 2 -> yieldTick tickerId LastTradePrice ts (fromDouble price) volume
            | otherwise  -> return ()
         liftIO $ atomicModifyIORef' ignoreCPSet (\s -> (HS.insert tickerId s, ()))
@@ -104,17 +108,22 @@ line2TickConduit = do
                      volume = vol }
 
 chanSink :: BoundedChan QuoteSourceServerData -> Sink Tick IO ()
-chanSink chan = awaitForever (\t -> liftIO $ writeChan chan (QSSTick t))
+chanSink chan = awaitForever
-
+  (\t -> liftIO $ do
-startPipeReader :: T.Text -> BoundedChan QuoteSourceServerData -> IO PipeReaderHandle
+      writeChan chan (QSSTick t))
-startPipeReader pipeName tickChan = do
+
-  f <- createFile (T.unpack pipeName) gENERIC_READ 0 Nothing oPEN_EXISTING 0 Nothing
+startPipeReader :: Context -> T.Text -> BoundedChan QuoteSourceServerData -> IO PipeReaderHandle
-  when (f == iNVALID_HANDLE_VALUE) $ error $ "Unable to open pipe: " ++ T.unpack pipeName
+startPipeReader ctx pipeEndpoint tickChan = do
+  debugM "PipeReader" $ "Trying to open pipe: " ++ T.unpack pipeEndpoint
+  s <- socket ctx Sub
+  connect s (T.unpack pipeEndpoint)
+  subscribe s B.empty
+  debugM "PipeReader" "Pipe opened"
   running' <- newIORef True
-  tid <- forkIO $ readerThread f running'
+  tid <- forkIO $ readerThread s running'
   return PipeReaderHandle { prThreadId = tid, running = running' }
     where
-      readerThread f running' = runConduit $ (win32FileConduit f) =$= conduitParser parseTrade =$= CL.map snd =$= line2TickConduit =$= chanSink tickChan
+      readerThread s running' = runConduit $ (zmqSocketConduit s) =$= conduitParserEither parseTrade =$= handleParseResult =$= line2TickConduit =$= chanSink tickChan
       parseTrade = parseCurrentParam <|> parseAllTrade
       parseCurrentParam = do
         string "CT:"
@@ -168,5 +177,12 @@ startPipeReader pipeName tickChan = do
         ms <- fromInteger <$> decimal
         return $ UTCTime (fromGregorian y mon day) $ h * 3600 + m * 60 + s + ms / 1000
 
+      handleParseResult = do
+        awaitForever $ \res ->
+          case res of
+            Left err -> liftIO $ warningM "PipeReader" $ "Can't parse: " ++ show err
+            Right (_, r) -> yield r
+
+
 stopPipeReader :: PipeReaderHandle -> IO ()
 stopPipeReader h = killThread (prThreadId h) >> writeIORef (running h) False