Merge remote-tracking branch 'origin/master' into codex/issue-96-fetch-body-before-uid

# Conflicts:
#	HaskellNet.cabal
#	test/IMAPParsersTest.hs

Author: mpscholten

.github/workflows/ci.yml

@@ -22,6 +22,7 @@ jobs:
         - "9.8.4"
         - "9.10.2"
         - "9.12.2"
+        - "9.14.1"
         exclude:
         # These don't work on GitHub CI anymore because they need llvm@13, which became
         # disabled on 12/31/2024

HaskellNet.cabal

@@ -24,6 +24,7 @@ Tested-with:
    || ==9.8.4
    || ==9.10.2
    || ==9.12.2
+   || ==9.14.1
 
 Extra-Source-Files:
   CHANGELOG
@@ -67,7 +68,7 @@ Library
     Network.Mail.Mime
 
   Build-Depends:
-    base >= 4.3 && < 4.22,
+    base >= 4.3 && < 4.23,
     network >= 2.6.3.1 && < 3.3,
     mtl >= 2.2.2 && < 2.4,
     bytestring >=0.10.2 && < 0.13,
@@ -94,7 +95,7 @@ Test-suite imap-parsers
   Main-is: IMAPParsersTest.hs
   default-language: Haskell2010
   Build-Depends:
-    base >= 4.3 && < 4.22,
+    base >= 4.3 && < 4.23,
     bytestring >=0.10.2 && < 0.13,
     HaskellNet,
     HUnit >= 1.6 && < 1.7

src/Network/HaskellNet/IMAP/Parsers.hs

@@ -189,7 +189,7 @@ pFlag = do char '\\'
                   , string "Draft"    >> return Draft
                   , string "Recent"   >> return Recent
                   , char '*'          >> return (Keyword "*")
-                  , many1 atomChar    >>= return . Keyword ]
+                  , many1 atomChar    >>= return . Keyword . ('\\':) ]
     <|> (many1 atomChar >>= return . Keyword)
 
 pParenFlags :: RespDerivs -> Result RespDerivs [Flag]

src/Network/HaskellNet/IMAP/Types.hs

@@ -61,7 +61,8 @@ instance Show Flag where
               showFlag Deleted     = "\\Deleted"
               showFlag Draft       = "\\Draft"
               showFlag Recent      = "\\Recent"
-              showFlag (Keyword s) = "\\" ++ s
+              showFlag (Keyword "*") = "\\*"
+              showFlag (Keyword s)   = s
 
 data Attribute = Noinferiors
                | Noselect

test/IMAPParsersTest.hs

@@ -233,6 +233,19 @@ fetchTest =
                               \a005 OK +FLAGS completed\r\n"
     ]
 
+flagTest =
+    [ "keyword show omits backslash" ~:
+          "Custom" ~=? show (Keyword "Custom")
+    , "permanent wildcard show keeps backslash" ~:
+          "\\*" ~=? show (Keyword "*")
+    , "keyword parser keeps bare keyword" ~:
+          [Keyword "Custom"] ~=? eval' dvFlags "" "(Custom)"
+    , "keyword parser keeps permanent wildcard" ~:
+          [Keyword "*"] ~=? eval' dvFlags "" "(\\*)"
+    , "keyword parser preserves unknown system flag" ~:
+          [Keyword "\\Custom"] ~=? eval' dvFlags "" "(\\Custom)"
+    ]
+
 
 imapFetchTest =
     [ "fetch works when BODY precedes UID" ~: TestCase $ do
@@ -257,6 +270,7 @@ testData = [ "base" ~: baseTest
            , "search" ~: searchTest
            , "fetch" ~: fetchTest
            , "imap fetch api" ~: imapFetchTest
+           , "flags" ~: flagTest
            ]