Sanified the return type of greeting

[offlineimap] / testsrc / TestParser.hs

diff --git a/testsrc/TestParser.hs b/testsrc/TestParser.hs
index 31290391c0a67925f5782feaa6316e12143debfe..5735042ab2c6d73fbed578eb4e9f4572e18e1ac8 100644 (file)
--- a/testsrc/TestParser.hs
+++ b/testsrc/TestParser.hs
@@ -30,7 +30,7 @@ import Network.IMAP.Types
 
 import TestInfrastructure
 import TestConnection(expectedString, noCR)
-import TestParserPrim(isValidText)
+import TestParserPrim(isValidText, isValidAtom)
 
 prop_getFullLine_basic :: [String] -> Property
 prop_getFullLine_basic s =
@@ -71,12 +71,52 @@ noBrace s = and (map (not . isSuffixOf "}") s)
 prop_respTextSimple :: String -> Result
 prop_respTextSimple s =
     p respText s @?= 
-      if isValidText s
+      if isValidText s && (head s /= '[')
          then Just (RespText Nothing s)
          else Nothing
 
+prop_respTextAtom :: String -> Property
+prop_respTextAtom s2 =
+    isValidAtom s2 && isValidText s1 && ']' `notElem` s1 ==>
+    p respText ("[" ++ s2 ++ "] " ++ s1) @?=
+      Just (RespText (Just s2) s1)
+    where s1 = reverse s2 -- Gen manually to avoid test exhaustion
+          
+prop_respTextAtomOpt :: String -> String -> String -> Property
+prop_respTextAtomOpt codeatom codedesc text =
+    isValidAtom codeatom && isValidText codedesc && isValidText text &&
+                ']' `notElem` (codeatom ++ codedesc) &&
+                (head text) /= '[' ==>
+    p respText ("[" ++ codeatom ++ " " ++ codedesc ++ "] " ++ text) @?=
+      Just (RespText (Just (codeatom ++ " " ++ codedesc)) text)
+
+prop_greeting_bye :: String -> Property
+prop_greeting_bye s =
+    isValidAtom s && head s /= '[' ==>
+    p greeting ("* BYE " ++ s) @?=
+      (Just $ (AUTHBYE, RespText Nothing s))
+
+prop_greeting_auth :: String -> Property
+prop_greeting_auth s =
+    isValidAtom s && head s /= '[' ==>
+    p' greeting ("* OK " ++ s) @?=
+      (Right $ (AUTHOK, RespText Nothing s))
+
+prop_greeting_courier :: Result
+prop_greeting_courier =
+    p greeting courierStr @?=
+      (Just $ (AUTHOK, RespText (Just code) text))
+    where courierStr = "* OK [CAPABILITY IMAP4rev1 UIDPLUS CHILDREN NAMESPACE THREAD=ORDEREDSUBJECT THREAD=REFERENCES SORT QUOTA IDLE ACL ACL2=UNION] Courier-IMAP ready. See COPYING for distribution information."
+          code = "CAPABILITY IMAP4rev1 UIDPLUS CHILDREN NAMESPACE THREAD=ORDEREDSUBJECT THREAD=REFERENCES SORT QUOTA IDLE ACL ACL2=UNION"
+          text = "Courier-IMAP ready. See COPYING for distribution information."
+
 allt = [q "getFullLine_basic" prop_getFullLine_basic,
         q "getFullLine_count" prop_getFullLine_count,
         q "readFullResponse_basic" prop_rfr_basic,
-        q "respText simple" prop_respTextSimple
+        q "respText simple" prop_respTextSimple,
+        q "respText atom" prop_respTextAtom,
+        q "respTextAtomOpt" prop_respTextAtomOpt,
+        q "greeting_bye" prop_greeting_bye,
+        q "greeting_auth" prop_greeting_auth,
+        q "greeting_courier" prop_greeting_courier
        ]