Clean up tests and added respText atom test

[offlineimap] / testsrc / TestParser.hs

diff --git a/testsrc/TestParser.hs b/testsrc/TestParser.hs
index 4049869e3978d189561bc01249fce9d9c16c5773..704d65622db16caa23d74767a49af82ec118c1bf 100644 (file)
--- a/testsrc/TestParser.hs
+++ b/testsrc/TestParser.hs
@@ -30,6 +30,7 @@ import Network.IMAP.Types
 
 import TestInfrastructure
 import TestConnection(expectedString, noCR)
+import TestParserPrim(isValidText, isValidAtom)
 
 prop_getFullLine_basic :: [String] -> Property
 prop_getFullLine_basic s =
@@ -45,11 +46,46 @@ prop_getFullLine_count s =
            ==> 
            runLinesConnection lenS (getFullLine []) @?=
                               Right (expectedResult, (expectedRemain, []))
-    where lenS = [head s ++ "{" ++ show (length (s !! 1)) ++ "}\r\n" ++ (s !! 1)]
-                 ++ (drop 2 s)
-          expectedResult = concat (take 2 s)
+    where lenS = [braceString] ++ [(head . tail $ s)] ++ drop 2 s
+          braceString = head s ++ "{" ++ show (length (s !! 1)) ++ "}"
+          expectedResult = braceString ++ "\r\n" ++ (s !! 1)
           expectedRemain = expectedString (drop 2 s)
 
+prop_rfr_basic :: [String] -> Property
+prop_rfr_basic s =
+    let testlist = 
+            case length s of
+              0 -> []
+              1 -> ["TAG " ++ head s]
+              _ -> map ("* " ++) (init s) ++
+                   ["TAG " ++ last s]
+        resultstr = expectedString testlist
+    in noCR s && noBrace s ==>
+       runLinesConnection testlist readFullResponse @?=
+             if null s
+                then Left "EOF in input in readLine"
+                else Right (resultstr, ([], []))
+
+noBrace s = and (map (not . isSuffixOf "}") s)
+
+prop_respTextSimple :: String -> Result
+prop_respTextSimple s =
+    p respText s @?= 
+      if isValidText s && (head s /= '[')
+         then Just (RespText Nothing s)
+         else Nothing
+
+prop_respTextAtom :: String -> Property
+prop_respTextAtom s2 =
+    isValidAtom s2 && isValidText s1 ==>
+    p respText ("[" ++ s2 ++ "] " ++ s1) @?=
+      Just (RespText (Just s2) s1)
+    where s1 = reverse s2 -- Gen manually to avoid test exhaustion
+          
+
 allt = [q "getFullLine_basic" prop_getFullLine_basic,
-        q "getFullLine_count" prop_getFullLine_count
+        q "getFullLine_count" prop_getFullLine_count,
+        q "readFullResponse_basic" prop_rfr_basic,
+        q "respText simple" prop_respTextSimple,
+        q "respText atom" prop_respTextAtom
        ]