XlTable parsing

quik-connector.cabal

@@ -22,9 +22,12 @@ library
                      , Win32
                      , gtk
                      , binary
+                     , data-binary-ieee754
                      , bytestring
+                     , text
   default-language:    Haskell2010
   extra-libraries:     "user32"
+  other-modules:       QuoteSource.XlParser
 
 executable quik-connector-exe
   hs-source-dirs:      app

src/Data/ATrade.hs

@@ -0,0 +1,10 @@
+
+module Data.ATrade (
+) where
+
+data DataType = Price | OpenInterest | BestBid | BestOffer | Depth | TheoryPrice | Volatility | TotalSupply | TotalDemand
+
+data Tick = Tick {
+  datatype :: DataType,
+
+}

src/QuoteSource/DDE.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE ForeignFunctionInterface #-}
+{-# LANGUAGE ForeignFunctionInterface, CPP #-}
 
 module QuoteSource.DDE (
   initializeDde,
@@ -11,9 +11,20 @@ module QuoteSource.DDE (
   ddeXtypPoke,
   ddeCpWinAnsi,
   queryString,
-  nullDdeState
+  nullDdeState,
+  accessData,
+  unaccessData,
+  withDdeData
 ) where
 
+#if defined(i386_HOST_ARCH)
+# define WINDOWS_CCONV stdcall
+#elif defined(x86_64_HOST_ARCH)
+# define WINDOWS_CCONV ccall
+#else
+# error Unknown mingw32 arch
+#endif
+
 import Control.Applicative
 import Control.Exception
 import Control.Monad
@@ -49,34 +60,34 @@ ddeCpWinAnsi = 1004
 
 instance Exception DdeException
 
-foreign import ccall unsafe "windows.h DdeInitializeW"
+foreign import WINDOWS_CCONV unsafe "windows.h DdeInitializeW"
   ddeInitialize :: LPDWORD -> FunPtr DdeCallback -> DWORD -> DWORD -> IO CUInt
 
-foreign import ccall unsafe "windows.h DdeUninitialize"
+foreign import WINDOWS_CCONV unsafe "windows.h DdeUninitialize"
   ddeUninitialize :: DWORD -> IO BOOL
 
-foreign import ccall unsafe "windows.h DdeCreateStringHandleW"
+foreign import WINDOWS_CCONV unsafe "windows.h DdeCreateStringHandleW"
   ddeCreateStringHandle :: DWORD -> LPSTR -> CInt -> IO HANDLE
 
-foreign import ccall unsafe "windows.h DdeFreeStringHandleW"
+foreign import WINDOWS_CCONV unsafe "windows.h DdeFreeStringHandleW"
   ddeFreeStringHandle :: DWORD -> LPSTR -> IO HANDLE
 
-foreign import ccall unsafe "windows.h DdeNameService"
+foreign import WINDOWS_CCONV unsafe "windows.h DdeNameService"
   ddeNameService :: DWORD -> HANDLE -> HANDLE -> CInt -> IO HANDLE
 
-foreign import ccall unsafe "windows.h DdeCmpStringHandles"
+foreign import WINDOWS_CCONV unsafe "windows.h DdeCmpStringHandles"
   ddeCmpStringHandles :: HANDLE -> HANDLE -> IO CInt
 
-foreign import ccall unsafe "windows.h DdeQueryStringW"
+foreign import WINDOWS_CCONV unsafe "windows.h DdeQueryStringW"
   ddeQueryString :: DWORD -> HANDLE -> CString -> DWORD -> CInt -> IO DWORD
 
-foreign import ccall unsafe "windows.h DdeAccessData"
+foreign import WINDOWS_CCONV unsafe "windows.h DdeAccessData"
   ddeAccessData :: HANDLE -> LPDWORD -> IO (Ptr CUChar)
 
-foreign import ccall unsafe "windows.h DdeUnaccessData"
+foreign import WINDOWS_CCONV unsafe "windows.h DdeUnaccessData"
   ddeUnaccessData :: HANDLE -> IO ()
 
-foreign import ccall "wrapper"
+foreign import WINDOWS_CCONV "wrapper"
   mkCallbackPtr :: DdeCallback -> IO (FunPtr DdeCallback)
 
 data DdeState = DdeState {
@@ -124,6 +135,11 @@ accessData :: HANDLE -> IO ByteString
 accessData handle = alloca (\dataSizePtr -> do
   dataPtr <- ddeAccessData handle dataSizePtr
   dataSize <- peek dataSizePtr
-  pack . (map (toEnum . fromEnum)) <$> peekArray (fromEnum dataSize) dataPtr)
+  pack . map (toEnum . fromEnum) <$> peekArray (fromEnum dataSize) dataPtr)
+
+unaccessData :: HANDLE -> IO ()
+unaccessData = ddeUnaccessData
 
+withDdeData :: HANDLE -> (ByteString -> IO a) -> IO a
+withDdeData handle = bracket (accessData handle) (\_ -> unaccessData handle)
 

src/QuoteSource/DataImport.hs

@@ -16,7 +16,8 @@ import QuoteSource.DDE
 import QuoteSource.XlParser
 import Data.IORef
 import Text.Printf
-import Data.Binary
+import Data.Binary.Get
+import qualified Data.ByteString.Lazy as BL
 
 data ServerState = ServerState {
   dde :: DdeState,
@@ -48,6 +49,12 @@ ddeCallback state msgType format hConv hsz1 hsz2 hData dwData1 dwData2
       maybeTopic <- queryString myDdeState 256 hsz1
       case maybeTopic of
         Nothing -> return ddeResultFalse
+        Just topic -> withDdeData hData (\xlData -> case runGetOrFail xlParser $ BL.fromStrict xlData of
+          Left (_,  _, errmsg) -> return ddeResultFalse
+          Right (_, _, (width, height, table)) -> do
+            putStrLn $ show width ++ ":" ++ show height
+            return ddeResultAck)
+          
 
 initDataImportServer :: String -> IO (IORef ServerState)
 initDataImportServer applicationName = do

src/QuoteSource/XlParser.hs

@@ -7,7 +7,12 @@ module QuoteSource.XlParser (
 import Control.Applicative
 import Control.Monad
 import Data.Binary.Get
-import Data.ByteString
+import Data.Binary.IEEE754
+import Data.ByteString hiding (concat, unpack)
+import Data.List as L
+import Data.Word
+import Data.Text as T hiding (concat)
+import Data.Text.Encoding
 
 data XlData = XlInt Int | XlDouble Double | XlString String | XlEmpty
 
@@ -20,20 +25,61 @@ btBlank = 5
 btInt = 6
 btSkip = 7
 
-incrementPosition :: XlPosition -> Maybe XlPosition
-incrementPosition pos = do
-  if 1 + xPos pos < width pos
-    then Just pos { xPos = 1 + xPos pos }
-    else if 1 + yPos pos < height pos
-      then Just pos { xPos = 0, yPos = 1 + yPos pos }
-      else Nothing
-
 xlParser :: Get (Int, Int, [XlData])
 xlParser = do
   datatype <- getWord16le
   when (datatype /= btTable) $ fail "First entry should be table"
   blocksize <- fromEnum <$> getWord16le
   when (blocksize /= 4) $ fail "Table entry should have size 4"
-  return (0, 0, [])
+  height <- getWord16le
+  width <- getWord16le
+  table <- parseTable
+  return (fromEnum width, fromEnum height, table)
+  where
+    parseTable :: Get [XlData]
+    parseTable = concat <$> parseTable'
+
+    parseTable' :: Get [[XlData]]
+    parseTable' = do
+      eof <- isEmpty
+      if eof
+        then return []
+        else do
+          cells <- parseEntry
+          rest <- parseTable'
+          return $ cells : rest
+
+    parseEntry :: Get [XlData]
+    parseEntry = do
+      datatype <- getWord16le
+      blocksize <- fromEnum <$> getWord16le
+      parseEntry' datatype blocksize
+
+    parseEntry' :: Word16 -> Int -> Get [XlData]
+    parseEntry' datatype blocksize
+      | datatype == btFloat = parseFloats blocksize
+      | datatype == btString = parseStrings blocksize
+      | datatype == btBlank = parseBlanks blocksize
+      | otherwise = fail $ "Unknown field type: " ++ show datatype
+
+    parseFloats blocksize = do
+      float <- getFloat64le
+      if blocksize - 8 <= 0
+        then return [XlDouble float]
+        else do
+          rest <- parseFloats (blocksize - 8)
+          return $ XlDouble float : rest
+
+    parseStrings blocksize = do
+      length <- fromEnum <$> getWord8
+      s <- unpack . decodeUtf8 <$> getByteString length
+      if length + 1 >= blocksize
+        then return [XlString s]
+        else do
+          rest <- parseStrings (blocksize - length - 1)
+          return $ XlString s : rest
 
+    parseBlanks blocksize = do
+      fields <- fromEnum <$> getWord16le
+      return $ L.replicate fields XlEmpty