along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-}
-module TestConnection where
+module TestParser where
import qualified Data.Map as Map
import Data.List
import qualified Test.HUnit as HU
import Test.QuickCheck
import TestInfrastructure
+import Network.IMAP.Parser
import Network.IMAP.Connection
import Network.IMAP.Types
-prop_identity :: String -> Bool
-prop_identity f = runStringConnection f (\_ -> return ()) == Right ((), (f, []))
-
-prop_linesidentity :: String -> Bool
-prop_linesidentity f =
- runLinesConnection [f] (\_ -> return ()) == Right ((), (f ++ "\r\n", []))
-
-prop_lineslistidentity :: [String] -> Property
-prop_lineslistidentity f =
- and (map (notElem '\r') f) ==>
- runLinesConnection f (\_ -> return ()) @?= Right ((), (expected, []))
- where expected = expectedString f
-
-expectedString f =
- case f of
- [] -> []
- _ -> (intercalate "\r\n" f) ++ "\r\n"
+import TestInfrastructure
+import TestConnection(expectedString, noCR)
+import TestParserPrim(isValidText, isValidAtom)
-prop_readLine :: [String] -> Property
-prop_readLine s =
- (and (map (notElem '\r') s)) ==>
- runLinesConnection s readLine @?=
+prop_getFullLine_basic :: [String] -> Property
+prop_getFullLine_basic s =
+ (null s || not ("}" `isSuffixOf` (head s))) && noCR s ==>
+ runLinesConnection s (getFullLine []) @?=
if null s
then Left "EOF in input in readLine"
else Right (head s, (expectedString (tail s), []))
-prop_readBytes :: String -> Int -> Result
-prop_readBytes s l =
- runStringConnection s (\c -> readBytes c (fromIntegral l)) @?=
- if l < 0
- then Left "readBytes: negative count"
- else case compare l (length s) of
- EQ -> Right (take l s, (drop l s, []))
- LT -> Right (take l s, (drop l s, []))
- GT -> Left "EOF in input in readBytes"
+prop_getFullLine_count :: [String] -> Property
+prop_getFullLine_count s =
+ length s >= 2 && noCR s && (length s < 3 || not ("}" `isSuffixOf` (s !! 2)))
+ ==>
+ runLinesConnection lenS (getFullLine []) @?=
+ Right (expectedResult, (expectedRemain, []))
+ 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 && ']' `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))
-q :: Testable a => String -> a -> HU.Test
-q = qccheck (defaultConfig {configMaxTest = 250, configMaxFail = 5000})
+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 "Identity" prop_identity,
- q "Lines identity" prop_linesidentity,
- q "Lines list identity" prop_lineslistidentity,
- q "readline" prop_readLine,
- q "readBytes" prop_readBytes
+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 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
]