diff --git a/quik-connector.cabal b/quik-connector.cabal index 1784780..b3cb067 100644 --- a/quik-connector.cabal +++ b/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 diff --git a/src/Data/ATrade.hs b/src/Data/ATrade.hs new file mode 100644 index 0000000..ac1c0d1 --- /dev/null +++ b/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, + +} diff --git a/src/QuoteSource/DDE.hs b/src/QuoteSource/DDE.hs index a268ce4..c76d31d 100644 --- a/src/QuoteSource/DDE.hs +++ b/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) diff --git a/src/QuoteSource/DataImport.hs b/src/QuoteSource/DataImport.hs index 7bb9a8a..f6cadc7 100644 --- a/src/QuoteSource/DataImport.hs +++ b/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 diff --git a/src/QuoteSource/XlParser.hs b/src/QuoteSource/XlParser.hs index 7f025b0..41d3cc0 100644 --- a/src/QuoteSource/XlParser.hs +++ b/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