From 3aaaf5d60b97d9a2effaf566943432473e884322 Mon Sep 17 00:00:00 2001
From: Denis Tereshkin <denis@kasan.ws>
Date: Sun, 23 Jun 2019 23:31:02 +0700
Subject: [PATCH] Fix dde string parsing

---
 quik-connector.cabal         |  2 +-
 src/System/Win32/DDE.hs      | 14 ++++++++++----
 src/System/Win32/XlParser.hs | 36 +++++++++++++++++++++---------------
 3 files changed, 32 insertions(+), 20 deletions(-)

diff --git a/quik-connector.cabal b/quik-connector.cabal
index ad60a9a..4f7d4b6 100644
--- a/quik-connector.cabal
+++ b/quik-connector.cabal
@@ -49,7 +49,7 @@ library
                      , aeson
                      , cond
                      , scientific
-                     , libatrade == 0.8.0.0
+                     , libatrade >= 0.8 && < 0.9
                      , deepseq
                      , errors
                      , split
diff --git a/src/System/Win32/DDE.hs b/src/System/Win32/DDE.hs
index 760cc4b..128d6b8 100644
--- a/src/System/Win32/DDE.hs
+++ b/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
-            then ddeResultTrue
-            else ddeResultFalse
+          if incomingAppName == appName myDdeState
+            then do
+              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
diff --git a/src/System/Win32/XlParser.hs b/src/System/Win32/XlParser.hs
index 181a7bb..b85d2c6 100644
--- a/src/System/Win32/XlParser.hs
+++ b/src/System/Win32/XlParser.hs
@@ -4,15 +4,17 @@ module System.Win32.XlParser (
   xlParser
 ) where
 
-import Control.Applicative
-import Control.Monad
-import Data.Binary.Get
-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
+import           Codec.Text.IConv
+import           Control.Applicative
+import           Control.Monad
+import           Data.Binary.Get
+import           Data.Binary.IEEE754
+import           Data.ByteString      hiding (concat, unpack)
+import qualified Data.ByteString.Lazy as BL
+import           Data.List            as L
+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
-      if length + 1 >= blocksize
-        then return [XlString s]
-        else do
-          rest <- parseStrings (blocksize - length - 1)
-          return $ XlString s : rest
+      s <- convert "CP1251" "UTF-8" . BL.fromStrict <$> getByteString length
+      case decodeUtf8' (BL.toStrict s) of
+        Left err -> fail $ "Can't parse utf8: " ++ show err
+        Right bs -> do
+          let s = unpack bs
+          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