Fix dde string parsing

quik-connector.cabal

@@ -49,7 +49,7 @@ library
                      , aeson
                      , cond
                      , scientific
-                     , libatrade == 0.8.0.0
+                     , libatrade >= 0.8 && < 0.9
                      , deepseq
                      , errors
                      , split

src/System/Win32/DDE.hs

@@ -40,6 +40,7 @@ import Foreign
 import Foreign.C.Types
 import Foreign.C.String
 import Foreign.Marshal.Array
+import           System.Log.Logger              (debugM, warningM)
 
 import qualified Data.ByteString.Lazy as BL
 
@@ -121,11 +122,14 @@ ddeCallback state msgType format hConv hsz1 hsz2 hData dwData1 dwData2
     handleConnect state hsz1 hsz2 = do
       myDdeState <- readIORef state
       maybeAppName <- queryString myDdeState 256 hsz2
+      debugM "DDE" $ "Handle connect:" ++ show maybeAppName
       case maybeAppName of
         Just incomingAppName -> do
-          return $ if incomingAppName == appName myDdeState
+          if incomingAppName == appName myDdeState
-            then ddeResultTrue
+            then do
-            else ddeResultFalse
+              return ddeResultTrue
+            else do
+              return ddeResultFalse
         Nothing -> return ddeResultFalse
 
     handlePoke state hsz1 hData = do
@@ -135,7 +139,9 @@ ddeCallback state msgType format hConv hsz1 hsz2 hData dwData1 dwData2
         Nothing -> return ddeResultFalse
         Just topic -> withDdeData hData (\xlData -> do
           case runGetOrFail xlParser $ BL.fromStrict xlData of
-            Left (_,  _, errmsg) -> return ddeResultFalse
+            Left (_,  _, errmsg) -> do
+              warningM "DDE" $ "Parsing error: " ++ show errmsg
+              return ddeResultFalse
             Right (_, _, table) -> do
               rc <- (dataCallback myDdeState) topic table
               return $ if rc

src/System/Win32/XlParser.hs

@@ -4,15 +4,17 @@ module System.Win32.XlParser (
   xlParser
 ) where
 
-import Control.Applicative
+import           Codec.Text.IConv
-import Control.Monad
+import           Control.Applicative
-import Data.Binary.Get
+import           Control.Monad
-import Data.Binary.IEEE754
+import           Data.Binary.Get
-import Data.ByteString hiding (concat, unpack)
+import           Data.Binary.IEEE754
-import Data.List as L
+import           Data.ByteString      hiding (concat, unpack)
-import Data.Word
+import qualified Data.ByteString.Lazy as BL
-import Data.Text as T hiding (concat)
+import           Data.List            as L
-import Data.Text.Encoding
+import           Data.Text            as T hiding (concat)
+import           Data.Text.Encoding
+import           Data.Word
 
 data XlData = XlInt Int | XlDouble Double | XlString String | XlEmpty
   deriving (Eq, Show)
@@ -73,12 +75,16 @@ xlParser = do
 
     parseStrings blocksize = do
       length <- fromEnum <$> getWord8
-      s <- unpack . decodeUtf8 <$> getByteString length
+      s <- convert "CP1251" "UTF-8" . BL.fromStrict <$> getByteString length
-      if length + 1 >= blocksize
+      case decodeUtf8' (BL.toStrict s) of
-        then return [XlString s]
+        Left err -> fail $ "Can't parse utf8: " ++ show err
-        else do
+        Right bs -> do
-          rest <- parseStrings (blocksize - length - 1)
+          let s = unpack bs
-          return $ XlString s : rest
+          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