Make ellipsis match an arbitrary part of a line.

README.markdown

@@ -203,6 +203,15 @@ arbitrary content. For instance,
 -- baz
 ```
 
+If a line contains three dots and additional content, the three dots will match
+anything *within that line*:
+
+```haskell
+-- |
+-- >>> putStrLn "foo bar baz"
+-- foo ... baz
+```
+
 ### QuickCheck properties
 
 Haddock (since version 2.13.0) has markup support for properties.  Doctest can

src/Parse.hs

@@ -1,16 +1,19 @@
 {-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE OverloadedStrings #-}
 module Parse (
   Module (..)
 , DocTest (..)
 , Interaction
 , Expression
 , ExpectedResult
-, ResultLine (..)
+, ExpectedLine (..)
+, LineChunk (..)
 , getDocTests
 
 -- * exported for testing
 , parseInteractions
 , parseProperties
+, mkLineChunks
 ) where
 
 import           Data.Char (isSpace)
@@ -26,17 +29,24 @@ import           Location
 data DocTest = Example Expression ExpectedResult | Property Expression
   deriving (Eq, Show)
 
-data ResultLine = PlainResultLine String | WildCardLine
+data LineChunk = LineChunk String | WildCardChunk
   deriving (Show, Eq)
 
-instance IsString ResultLine where
-    fromString = PlainResultLine
+instance IsString LineChunk where
+    fromString = LineChunk
+
+data ExpectedLine = ExpectedLine [LineChunk] | WildCardLine
+  deriving (Show, Eq)
+
+instance IsString ExpectedLine where
+    fromString = ExpectedLine . return . LineChunk
 
 type Expression = String
-type ExpectedResult = [ResultLine]
+type ExpectedResult = [ExpectedLine]
 
 type Interaction = (Expression, ExpectedResult)
 
+
 -- |
 -- Extract 'DocTest's from all given modules and all modules included by the
 -- given modules.
@@ -111,7 +121,7 @@ toInteraction (Located loc x) xs = Located loc $
   (
     (strip   cleanedE)  -- we do not care about leading and trailing
                         -- whitespace in expressions, so drop them
-  , map mkResultLine result_
+  , map mkExpectedLine result_
   )
   where
     -- 1. drop trailing whitespace from the prompt, remember the prefix
@@ -138,13 +148,23 @@ toInteraction (Located loc x) xs = Located loc $
 tryStripPrefix :: String -> String -> String
 tryStripPrefix prefix ys = fromMaybe ys $ stripPrefix prefix ys
 
-mkResultLine :: String -> ResultLine
-mkResultLine x = case x of
-    "<BLANKLINE>" -> PlainResultLine ""
+mkExpectedLine :: String -> ExpectedLine
+mkExpectedLine x = case x of
+    "<BLANKLINE>" -> ""
     "..." -> WildCardLine
-    _ -> PlainResultLine x
+    _ -> ExpectedLine $ mkLineChunks x
+
+mkLineChunks :: String -> [LineChunk]
+mkLineChunks = finish . foldr go (0, [], [])
+  where
+    go :: Char -> (Int, String, [LineChunk]) -> (Int, String, [LineChunk])
+    go '.' (count, acc, res) = if count == 2
+          then (0,  "", [WildCardChunk, LineChunk acc] ++ res)
+          else (count + 1, acc, res)
+    go c   (count, acc, res) = (0, c : replicate count '.' ++ acc, res)
+    finish (count, acc, res) = LineChunk (replicate count '.' ++ acc) : res
+
 
 -- | Remove leading and trailing whitespace.
 strip :: String -> String
 strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse
-

src/Runner/Example.hs

@@ -4,6 +4,7 @@ module Runner.Example (
 ) where
 
 import           Data.Char
+import           Data.List
 import           Util
 
 import           Parse
@@ -16,12 +17,21 @@ mkResult expected actual
   | expected `matches` actual = Equal
   | otherwise = NotEqual (formatNotEqual expected actual)
   where
+    chunksMatch :: [LineChunk] -> String -> Bool
+    chunksMatch [] "" = True
+    chunksMatch [LineChunk xs] ys = stripEnd xs == stripEnd ys
+    chunksMatch (LineChunk x : xs) ys =
+        x `isPrefixOf` ys && xs `chunksMatch` drop (length x) ys
+    chunksMatch zs@(WildCardChunk : xs) (_:ys) =
+        xs `chunksMatch` ys || zs `chunksMatch` ys
+    chunksMatch _ _ = False
+
     matches :: ExpectedResult -> [String] -> Bool
     matches [] [] = True
     matches [] _  = False
     matches _  [] = False
-    matches (PlainResultLine x : xs) (y:ys) =
-        stripEnd x == stripEnd y && xs `matches` ys
+    matches (ExpectedLine x : xs) (y:ys) =
+        x `chunksMatch` y && xs `matches` ys
     matches zs@(WildCardLine : xs) (_:ys) =
         xs `matches` ys || zs `matches` ys
 
@@ -31,7 +41,7 @@ formatNotEqual expected_ actual = formatLines "expected: " expected ++ formatLin
   where
     expected :: [String]
     expected = map (\x -> case x of
-        PlainResultLine str -> str
+        ExpectedLine str -> concatMap lineChunkToString str
         WildCardLine -> "..." ) expected_
 
     -- use show to escape special characters in output lines if any output line
@@ -49,3 +59,7 @@ formatNotEqual expected_ actual = formatLines "expected: " expected ++ formatLin
       []   -> [message]
       where
         padding = replicate (length message) ' '
+
+lineChunkToString :: LineChunk -> String
+lineChunkToString WildCardChunk = "..."
+lineChunkToString (LineChunk str) = str

test/ParseSpec.hs

@@ -2,6 +2,7 @@
 module ParseSpec (main, spec) where
 
 import           Test.Hspec
+import           Data.String
 import           Data.String.Builder (Builder, build)
 import           Control.Monad.Trans.Writer
 
@@ -17,7 +18,7 @@ group :: Writer [DocTest] () -> Writer [[DocTest]] ()
 group g = tell [execWriter g]
 
 ghci :: Expression -> Builder -> Writer [DocTest] ()
-ghci expressions expected = tell [Example expressions $ (map PlainResultLine . lines . build) expected]
+ghci expressions expected = tell [Example expressions $ (map fromString . lines . build) expected]
 
 prop_ :: Expression -> Writer [DocTest] ()
 prop_ e = tell [Property e]
@@ -162,14 +163,19 @@ spec = do
         " output"
       `shouldBe` [(":{ first\n:}", ["output"])]
 
-    context "when a result line contains ellipsis" $ do
-      it "parses it into WildCardLine" $ do
-        parse_ $ do
-          " >>> action"
-          " foo"
-          " ..."
-          " bar"
-        `shouldBe` [("action", ["foo", WildCardLine, "bar"])]
+    it "parses wild cards lines" $ do
+      parse_ $ do
+        " >>> action"
+        " foo"
+        " ..."
+        " bar"
+      `shouldBe` [("action", ["foo", WildCardLine, "bar"])]
+
+    it "parses wild card chunks" $ do
+      parse_ $ do
+        " >>> action"
+        " foo ... bar"
+      `shouldBe` [("action", [ExpectedLine ["foo ", WildCardChunk, " bar"]])]
 
   describe " parseProperties (an internal function)" $ do
     let parse_ = map unLoc . parseProperties . noLocation . build
@@ -178,3 +184,16 @@ spec = do
       parse_ $ do
         "prop> foo"
       `shouldBe` ["foo"]
+
+  describe " mkLineChunks (an internal function)" $ do
+
+    it "replaces ellipsis with WildCardChunks" $ do
+      mkLineChunks "foo ... bar ... baz" `shouldBe`
+        ["foo ", WildCardChunk, " bar ", WildCardChunk, " baz"]
+
+    it "doesn't replace fewer than 3 consecutive dots" $ do
+      mkLineChunks "foo .. bar .. baz" `shouldBe`
+        ["foo .. bar .. baz"]
+
+    it "handles leading and trailing dots" $ do
+      mkLineChunks ".. foo bar .." `shouldBe` [".. foo bar .."]

test/Runner/ExampleSpec.hs

@@ -2,6 +2,7 @@
 module Runner.ExampleSpec (main, spec) where
 
 import           Control.Applicative
+import           Data.String
 import           Test.Hspec
 import           Test.QuickCheck
 
@@ -21,7 +22,7 @@ instance Arbitrary Line where
 
 lineToExpected :: [Line] -> ExpectedResult
 lineToExpected = map $ \x -> case x of
-                                 PlainLine str -> PlainResultLine str
+                                 PlainLine str -> fromString str
                                  WildCardLines _ -> WildCardLine
 
 lineToActual :: [Line] -> [String]
@@ -34,7 +35,7 @@ spec = do
   describe "mkResult" $ do
     it "returns Equal when output matches" $ do
       property $ \xs -> do
-        mkResult (map PlainResultLine xs) xs `shouldBe` Equal
+        mkResult (map fromString xs) xs `shouldBe` Equal
 
     it "ignores trailing whitespace" $ do
       mkResult ["foo\t"] ["foo  "] `shouldBe` Equal
@@ -48,6 +49,11 @@ spec = do
         property $ \xs -> mkResult (lineToExpected xs) (lineToActual xs)
             `shouldBe` Equal
 
+    context "with WildCardChunk" $ do
+      it "matches an arbitrary line chunk" $ do
+        mkResult [ExpectedLine ["foo", WildCardChunk, "bar"]] ["foo baz bar"]
+            `shouldBe` Equal
+
     context "when output does not match" $ do
       it "constructs failure message" $ do
         mkResult ["foo"] ["bar"] `shouldBe` NotEqual [