fix doctests

source/Network/Xmpp/Types.hs

@@ -1029,6 +1029,11 @@ parseJid s = case jidFromText $ Text.pack s of
 -- >>> resourcepart <$> jidFromText "foo@bar/quux"
 -- Just (Just "quux")
 --
+-- @ and / can occur in the domain part
+--
+-- >>> jidFromText "foo/bar@quux/foo"
+-- Just parseJid "foo/bar@quux/foo"
+--
 -- * Counterexamples
 --
 -- A JID must only have one \'\@\':
@@ -1036,11 +1041,6 @@ parseJid s = case jidFromText $ Text.pack s of
 -- >>> jidFromText "foo@bar@quux"
 -- Nothing
 --
--- \'\@\' must come before \'/\':
---
--- >>> jidFromText "foo/bar@quux"
--- Nothing
---
 -- The domain part can\'t be empty:
 --
 -- >>> jidFromText "foo@/quux"
@@ -1057,6 +1057,7 @@ parseJid s = case jidFromText $ Text.pack s of
 --
 -- >>> jidToTexts <$> jidFromText "bar/"
 -- Nothing
+--
 jidFromText :: Text -> Maybe Jid
 jidFromText t = do
     (l, d, r) <- eitherToMaybe $ AP.parseOnly jidParts t

tests/Doctest.hs

@@ -15,6 +15,7 @@ main :: IO ()
 main = doctest $
     "-isource"
   : "-itests"
+  : "-w"
   : "-idist/build/autogen"
   : "-hide-all-packages"
   : "-XQuasiQuotes"

tests/Tests/Arbitrary/Xmpp.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE OverloadedStrings #-}
 module Tests.Arbitrary.Xmpp where
 
 import           Control.Applicative ((<$>), (<*>))
@@ -30,29 +31,31 @@ instance Arbitrary Jid where
         Just jid <- tryJid `suchThat` isJust
         return jid
       where
-        tryJid = jidFromTexts <$> maybeGen (genString nodeprepProfile)
+        tryJid = jidFromTexts <$> maybeGen (genString nodeprepProfile False)
-                              <*> genString (SP.namePrepProfile False)
+                              <*> genString (SP.namePrepProfile False) False
-                              <*> maybeGen (genString resourceprepProfile)
+                              <*> maybeGen (genString resourceprepProfile True)
 
-        genString profile = Text.pack . take 1024 <$> listOf1 genChar
+        genString profile node = Text.pack . take 1024 <$> listOf1 genChar
           where
             genChar = arbitrary `suchThat` (not . isProhibited)
             prohibited = Ranges.toSet $ concat (SP.prohibited profile)
             isProhibited x = Ranges.member x prohibited
-                             || x `elem` "@/"
+                             || if node
+                                then False
+                                else x `elem` ['@','/']
 
     shrink (Jid lp dp rp) = [ Jid lp' dp  rp  | lp' <- shrinkMaybe shrink lp]
                          ++ [ Jid lp  dp' rp  | dp' <- shrink dp]
                          ++ [ Jid lp  dp  rp' | rp' <- shrinkMaybe shrink rp]
 
 
-string :: SP.StringPrepProfile -> Gen [Char]
+-- string :: SP.StringPrepProfile -> Gen [Char]
-string profile = take 1024 <$> listOf1 genChar
+-- string profile = take 1024 <$> listOf1 genChar
-  where
+--   where
-    genChar = arbitrary `suchThat` (not . isProhibited)
+--     genChar = arbitrary `suchThat` (not . isProhibited)
-    prohibited = Ranges.toSet $ concat (SP.prohibited profile)
+--     prohibited = Ranges.toSet $ concat (SP.prohibited profile)
-    isProhibited x = Ranges.member x prohibited
+--     isProhibited x = Ranges.member x prohibited
-                     || x `elem` "@/"
+--                      || x `elem` "@/"
 
 instance Arbitrary LangTag where
     arbitrary = LangTag <$> genTag <*> listOf genTag