fix: allow parsing of mutt aliases using non-ASCII characters

purebred-mua · Dec 31, 2024 · bceca75 · bceca75
1 parent 550ccad
commit bceca75
Show file tree

Hide file tree

Showing 4 changed files with 16 additions and 13 deletions.
diff --git a/configs/purebred.hs b/configs/purebred.hs
@@ -37,6 +37,7 @@ import System.Environment (lookupEnv)
 import System.Exit (die)
 import System.IO.Unsafe
 
+import Data.MIME (defaultCharsets)
 import Purebred
 import Purebred.Storage.AddressBook.MuttAliasFile
 
@@ -86,7 +87,7 @@ main = do
 
   let addrsFile = fromMaybe cwd confdir <> "/aliases"
   addressBook <-
-    initMuttAliasFileAddressBook addrsFile
+    initMuttAliasFileAddressBook defaultCharsets addrsFile
     >>= either (die . show) pure
 
   purebred

diff --git a/src/Purebred.hs b/src/Purebred.hs
@@ -129,6 +129,7 @@ module Purebred
   , module Purebred.Plugin,
   module Purebred.Plugin.TweakConfig,
   module Purebred.Storage.Tags,
+  module Purebred.Storage.AddressBook.MuttAliasFile,
   module Purebred.Types,
   module Purebred.Types.Error,
   module Purebred.UI.Actions,
@@ -187,6 +188,7 @@ import Purebred.Plugin.Internal
 import Purebred.Plugin.TweakConfig
 import Purebred.Storage.Server
 import Purebred.Storage.Tags (TagOp(..))
+import Purebred.Storage.AddressBook.MuttAliasFile
 import Purebred.Types.Error
 
 -- re-exports for configuration

diff --git a/src/Purebred/Storage/AddressBook/MuttAliasFile.hs b/src/Purebred/Storage/AddressBook/MuttAliasFile.hs
@@ -39,7 +39,7 @@ import qualified Data.Text as T
 import qualified Data.Text.Internal.Search as T
 import Control.Lens (Lens', lens, toListOf, folded, filtered, view)
 
-import Data.MIME (defaultCharsets)
+import Data.MIME (CharsetLookup)
 import Data.IMF (address, Address)
 
 import Purebred.Types.Error (Error(ParseError))
@@ -53,13 +53,13 @@ import Purebred.Types.String (decodeLenient)
 --
 -- https://gitlab.com/muttmua/mutt/-/wikis/MuttGuide/Aliases
 
-initMuttAliasFileAddressBook :: FilePath -> IO (Either Error AddressBook)
-initMuttAliasFileAddressBook filePath = do
+initMuttAliasFileAddressBook :: CharsetLookup -> FilePath -> IO (Either Error AddressBook)
+initMuttAliasFileAddressBook charsets filePath = do
   contents <- B.readFile filePath
   let mk addrs = AddressBook
         (\substr -> pure $ filterMuttAliases substr addrs)
         Nothing
-  pure $ bimap ParseError mk $ parseMuttAliasFile contents
+  pure $ bimap ParseError mk $ parseMuttAliasFile charsets contents
 
 filterMuttAliases :: T.Text -> [MuttAlias] -> [Address]
 filterMuttAliases substr =
@@ -73,13 +73,13 @@ matchesSubstring :: T.Text -> T.Text -> Bool
 matchesSubstring needle haystack = not $ null $ T.indices needle haystack
 
 -- | Parser functions to parse a mutt alias file
-parseMuttAliasFile :: B.ByteString -> Either String [MuttAlias]
-parseMuttAliasFile = parseOnly (muttalias `sepBy` endOfLine)
+parseMuttAliasFile :: CharsetLookup -> B.ByteString -> Either String [MuttAlias]
+parseMuttAliasFile charsets = parseOnly (muttalias charsets `sepBy` endOfLine)
 
-muttalias :: Parser MuttAlias
-muttalias = do
+muttalias :: CharsetLookup -> Parser MuttAlias
+muttalias charsets = do
  nick <- string "alias" *> space *> takeTill isSpace_w8
- add <- skipSpace *> address defaultCharsets
+ add <- skipSpace *> address charsets
  pure $ MuttAlias (decodeLenient nick) add
 
 -- | Parser Datatypes

diff --git a/test/TestAddressBook.hs b/test/TestAddressBook.hs
@@ -23,7 +23,7 @@ module TestAddressBook (
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit ((@?=), testCase)
 
-import Data.IMF (Address(..))
+import Data.MIME (Address(..), defaultCharsets)
 
 import Purebred.Storage.AddressBook.MuttAliasFile
 
@@ -38,7 +38,7 @@ testParseMuttAlias =
     "parse mutt alias file"
     [
       testCase "no long names" $
-        parseMuttAliasFile "alias nick1 <nick1@test.example>\nalias nick2 nick2@foo.test"
+        parseMuttAliasFile defaultCharsets "alias nick1 <nick1@test.example>\nalias nick2 nick2@foo.test"
           @?= Right [
           MuttAlias {
               _muttAliasNick = "nick1"
@@ -50,7 +50,7 @@ testParseMuttAlias =
         }
       ]
     , testCase "with long names" $
-        parseMuttAliasFile "alias nick1 Mr Nick Name <nick1@test.example>\nalias nick2 Nick Test Name <nick2@foo.test>"
+        parseMuttAliasFile defaultCharsets "alias nick1 Mr Nick Name <nick1@test.example>\nalias nick2 Nick Test Name <nick2@foo.test>"
           @?= Right [
           MuttAlias {
               _muttAliasNick = "nick1"