summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authortv <tv@krebsco.de>2020-04-28 21:37:18 +0200
committertv <tv@krebsco.de>2020-04-28 23:37:28 +0200
commitf2d3e7fa9d2ec7abf6d0a8aedafc2c228f538afe (patch)
tree42bc89c4afba0962c378b702cee7f7623a2b7be8
parentfa3e4365193857ecf78138d6e7aee55f38a61baa (diff)
Notmuch: handle JSON with broken UTF-8
-rw-r--r--Data/Aeson/Extends.hs15
-rw-r--r--Notmuch.hs10
2 files changed, 20 insertions, 5 deletions
diff --git a/Data/Aeson/Extends.hs b/Data/Aeson/Extends.hs
new file mode 100644
index 0000000..d78f81d
--- /dev/null
+++ b/Data/Aeson/Extends.hs
@@ -0,0 +1,15 @@
+module Data.Aeson.Extends (module Data.Aeson.Extends) where
+
+import Data.Aeson as Data.Aeson.Extends
+
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.Text.Encoding.Error as TE
+import qualified Data.Text.Lazy.Encoding as LT
+
+
+eitherDecodeLenient' :: FromJSON a => LBS.ByteString -> Either String a
+eitherDecodeLenient' s =
+ either (const $ eitherDecode' $ lenientReencode s) id (eitherDecode' s)
+ where
+ lenientReencode = LT.encodeUtf8 . LT.decodeUtf8With TE.lenientDecode
+
diff --git a/Notmuch.hs b/Notmuch.hs
index 00ac5a3..4d0ddd1 100644
--- a/Notmuch.hs
+++ b/Notmuch.hs
@@ -10,7 +10,7 @@ import qualified Network.Mail.Mime as M
import Control.Concurrent
import Control.DeepSeq (rnf)
import Control.Exception
-import Data.Aeson
+import Data.Aeson.Extends
import Data.Tree
import Notmuch.Class
import Notmuch.Message
@@ -142,7 +142,7 @@ notmuchWithInput args input = do
search :: [String] -> IO (Either String [SearchResult])
search args =
notmuch ("search" : "--format=json" : "--format-version=2" : args)
- >>= return . eitherDecode'
+ >>= return . eitherDecodeLenient'
data ReplyTo = ToAll | ToSender
@@ -158,7 +158,7 @@ notmuchReply replyTo term =
, "--reply-to=" ++ show replyTo
, term
]
- -- >>= return . eitherDecode'
+ -- >>= return . eitherDecodeLenient'
notmuchShow :: String -> IO (Forest Message)
@@ -167,7 +167,7 @@ notmuchShow term = do
, term ]
-- TODO why head?
return $ threadForest $ head $
- either error id (eitherDecode' c')
+ either error id (eitherDecodeLenient' c')
notmuchShowPart :: String -> Int -> IO (Either String MessagePart)
@@ -178,7 +178,7 @@ notmuchShowPart term partId = do
, "--part=" <> show partId
, term ]
return $ case exitCode of
- ExitSuccess -> eitherDecode' out
+ ExitSuccess -> eitherDecodeLenient' out
_ -> Left $ show exitCode <> ": " <> LBS8.unpack err