Test haddock documentation using doctest-parallel

.github/workflows/haskell.yml

@@ -120,9 +120,12 @@ jobs:
           cabal build --only-dependencies --enable-tests --enable-benchmarks ${{ matrix.package }}
       - name: Build
         run: cabal build --enable-tests --enable-benchmarks ${{ matrix.package }}
-      - name: Run tests
-        # https://github.com/fpringle/generic-diff/actions/runs/15353395135/job/43206848857?pr=10
+      - name: Run test suite
         run: |
-          cabal configure --enable-tests
           cd $(dirname ${{ matrix.cabal_file }})
-          cabal test --enable-tests
+          cabal run ${{ matrix.package }}-test
+      - name: Run doctests
+        run: |
+          if [[ "${{ matrix.package }}" == "generic-diff" ]]; then
+            cabal run doctests
+          fi

cabal.project

@@ -1,3 +1,6 @@
 packages:
     ./generic-diff/generic-diff.cabal
     ./generic-diff-instances/generic-diff-instances.cabal
+
+write-ghc-environment-files: always
+tests: True

generic-diff/README.md

@@ -36,6 +36,7 @@ expr2 = Bin (Atom 1) Plus (Bin (Atom 1) Plus (Atom 2))
 
 ```haskell
 ghci> printDiffResult $ diff expr1 expr2
+Both values use constructor Bin but fields don't match
 In field right:
   Both values use constructor Bin but fields don't match
   In field right:

generic-diff/generic-diff.cabal

@@ -107,3 +107,17 @@ test-suite generic-diff-test
     , QuickCheck
     , hspec
     , basic-sop
+
+test-suite doctests
+  import:
+      warnings
+    , deps
+    , extensions
+  type:             exitcode-stdio-1.0
+  hs-source-dirs:   test
+  main-is:          doctests.hs
+  ghc-options:      -threaded
+  build-depends:
+    , generic-diff
+    , doctest-parallel >= 0.4
+  default-language: Haskell2010

generic-diff/src/Generics/Diff/Class.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE EmptyCase #-}
+{-# LANGUAGE NoOverloadedStrings #-}
 {-# OPTIONS_GHC -Wno-redundant-constraints -Wno-orphans #-}
 
 module Generics.Diff.Class
@@ -22,13 +23,34 @@ where
 
 import Data.SOP
 import Data.SOP.NP
+import Data.String (fromString)
 import qualified Data.Text as T
 import qualified GHC.Generics as G
 import Generics.Diff.Render
 import Generics.Diff.Type
 import Generics.SOP as SOP
 import Generics.SOP.GGP as SOP
 
+{- $setup
+>>> :set -XDerivingStrategies
+>>> :set -XDeriveGeneric
+>>> :set -XDeriveAnyClass
+>>> import Generics.Diff
+>>> import Generics.Diff.Render
+>>> import qualified GHC.Generics as G
+>>> import Generics.SOP as SOP
+>>> :{
+ data BinOp = Plus | Minus
+   deriving stock (Show, G.Generic)
+   deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo, Diff)
+ data Expr
+   = Atom Int
+   | Bin {left :: Expr, op :: BinOp, right :: Expr}
+   deriving stock (Show, G.Generic)
+   deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo, Diff)
+:}
+-}
+
 {- | A type with an instance of 'Diff' permits a more nuanced comparison than 'Eq' or 'Ord'.
 If two values are not equal, 'diff' will tell you exactly where they differ ("in this contructor,
 at that field"). The granularity of the pinpointing of the difference (how many "levels" of 'Diff'
@@ -62,67 +84,69 @@ data Expr
 
 Now that we have our instances, we can 'diff' values to find out exactly where they differ:
 
-@
 -- If two values are equal, 'diff' should always return 'Equal'.
-ghci> diff Plus Plus
+>>> diff Plus Plus
 Equal
 
-ghci> diff Plus Minus
-Error (Nested (WrongConstructor (Z (Constructor \"Plus\")) (S (Z (Constructor \"Minus\")))))
+>>> diff Plus Minus
+Error (Nested (WrongConstructor (Z (Constructor "Plus")) (S (Z (Constructor "Minus")))))
 
-ghci> diff (Atom 1) (Atom 2)
-Error (Nested (FieldMismatch (AtLoc (Z (Constructor \"Atom\" :*: Z (Nested $ TopLevelNotEqualShow \"1\" \"2\"))))))
+>>> diff (Atom 1) (Atom 2)
+Error (Nested (FieldMismatch (DiffAtField (Z (Constructor "Atom" :*: Z (TopLevelNotEqualShow "1" "2"))))))
 
-ghci> diff (Bin (Atom 1) Plus (Atom 1)) (Atom 2)
-Error (Nested (WrongConstructor (S (Z (Constructor \"Bin\"))) (Z (Constructor \"Atom\"))))
+>>> diff (Bin (Atom 1) Plus (Atom 1)) (Atom 2)
+Error (Nested (WrongConstructor (S (Z (Record "Bin" (FieldInfo "left" :* FieldInfo "op" :* FieldInfo "right" :* Nil)))) (Z (Constructor "Atom"))))
 
-ghci> diff (Bin (Atom 1) Plus (Atom 1)) (Bin (Atom 1) Minus (Atom 1))
-Error (Nested (FieldMismatch (AtLoc (S (Z (Constructor \"Bin\" :*: S (Z (Nested (WrongConstructor (Z (Constructor \"Plus\")) (S (Z (Constructor \"Minus\"))))))))))))
+>>> diff (Bin (Atom 1) Plus (Atom 1)) (Bin (Atom 1) Minus (Atom 1))
+Error (Nested (FieldMismatch (DiffAtField (S (Z (Record "Bin" (FieldInfo "left" :* FieldInfo "op" :* FieldInfo "right" :* Nil) :*: S (Z (Nested (WrongConstructor (Z (Constructor "Plus")) (S (Z (Constructor "Minus"))))))))))))
 
-ghci> diff (Bin (Atom 1) Plus (Atom 1)) (Bin (Atom 1) Plus (Atom 2))
-Error (Nested (FieldMismatch (DiffAtField (S (Z (Record \"Bin\" (FieldInfo \"left\" :* FieldInfo \"op\" :* FieldInfo \"right\" :* Nil) :*: S (S (Z (Nested (FieldMismatch (DiffAtField (Z (Constructor \"Atom\" :*: Z $ TopLevelNotEqualShow "1" "2")))))))))))))
-@
+>>> diff (Bin (Atom 1) Plus (Atom 1)) (Bin (Atom 1) Plus (Atom 2))
+Error (Nested (FieldMismatch (DiffAtField (S (Z (Record "Bin" (FieldInfo "left" :* FieldInfo "op" :* FieldInfo "right" :* Nil) :*: S (S (Z (Nested (FieldMismatch (DiffAtField (Z (Constructor "Atom" :*: Z (TopLevelNotEqualShow "1" "2"))))))))))))))
 
 Of course, these are just as difficult to understand as derived 'Show' instances, or more so. Fortunately we can
 use the functions in "Generics.Diff.Render" to get a nice, intuitive representation of the diffs:
 
-@
-ghci> printDiffResult $ diff Plus Plus
+>>> printDiffResult $ diff Plus Plus
 Equal
+<BLANKLINE>
 
-ghci> printDiffResult $ diff Plus Minus
+>>> printDiffResult $ diff Plus Minus
 Wrong constructor
 Constructor of left value: Plus
 Constructor of right value: Minus
+<BLANKLINE>
 
-ghci> printDiffResult $ diff (Atom 1) (Atom 2)
+>>> printDiffResult $ diff (Atom 1) (Atom 2)
 Both values use constructor Atom but fields don't match
 In field 0 (0-indexed):
   Not equal
   Left value:  1
   Right value: 2
+<BLANKLINE>
 
-ghci> printDiffResult $ diff (Bin (Atom 1) Plus (Atom 1)) (Atom 2)
+>>> printDiffResult $ diff (Bin (Atom 1) Plus (Atom 1)) (Atom 2)
 Wrong constructor
 Constructor of left value: Bin
 Constructor of right value: Atom
+<BLANKLINE>
 
-ghci> printDiffResult $ diff (Bin (Atom 1) Plus (Atom 1)) (Bin (Atom 1) Minus (Atom 1))
+>>> printDiffResult $ diff (Bin (Atom 1) Plus (Atom 1)) (Bin (Atom 1) Minus (Atom 1))
 Both values use constructor Bin but fields don't match
 In field op:
   Wrong constructor
   Constructor of left value: Plus
   Constructor of right value: Minus
+<BLANKLINE>
 
-ghci> printDiffResult $ diff (Bin (Atom 1) Plus (Atom 1)) (Bin (Atom 1) Plus (Atom 2))
+>>> printDiffResult $ diff (Bin (Atom 1) Plus (Atom 1)) (Bin (Atom 1) Plus (Atom 2))
 Both values use constructor Bin but fields don't match
 In field right:
   Both values use constructor Atom but fields don't match
   In field 0 (0-indexed):
     Not equal
     Left value:  1
     Right value: 2
-@
+<BLANKLINE>
 
 = Laws
 
@@ -152,7 +176,7 @@ diffWithSpecial l r = maybe Equal (Error . DiffSpecial) $ specialDiff l r
 instance (Diff a) => SpecialDiff [a] where
   type SpecialDiffError [a] = ListDiffError a
   specialDiff = diffListWith diff
-  renderSpecialDiffError = listDiffErrorDoc "list"
+  renderSpecialDiffError = listDiffErrorDoc (fromString "list")
 
 {- | Given two lists and a way to 'diff' the elements of the list,
 return a 'ListDiffError'. Used to implement 'specialDiff' for list-like types.
@@ -319,3 +343,5 @@ shiftDiffError :: DiffErrorNested xs -> DiffErrorNested (x ': xs)
 shiftDiffError = \case
   WrongConstructor xs ys -> WrongConstructor (S xs) (S ys)
   FieldMismatch (DiffAtField ns) -> FieldMismatch (DiffAtField (S ns))
+
+{-# ANN module "doctest-parallel: --no-implicit-module-import" #-}

generic-diff/src/Generics/Diff/Render.hs

@@ -43,6 +43,12 @@ import qualified Data.Text.Lazy.IO as TL
 import Generics.Diff.Type
 import Generics.SOP as SOP
 
+{- $setup
+>>> import Generics.Diff
+>>> import qualified Data.Text.Lazy.Builder as TB
+>>> import qualified Data.Text.Lazy.IO as TL
+-}
+
 -- | Sensible rendering defaults. No numbers, 2-space indentation.
 defaultRenderOpts :: RenderOpts
 defaultRenderOpts =
@@ -120,22 +126,23 @@ diffErrorDoc = \case
 The first argument gives us a name for the type of list, for clearer output.
 For example:
 
-@
-ghci> 'TL.putStrLn' . 'TB.toLazyText' . 'renderDoc' 'defaultRenderOpts' 0 . 'listDiffErrorDoc' "list" $ 'DiffAtIndex' 3 'TopLevelNotEqual'
+>>> TL.putStrLn . TB.toLazyText . renderDoc defaultRenderOpts 0 . listDiffErrorDoc "list" $ DiffAtIndex 3 TopLevelNotEqual
 Diff at list index 3 (0-indexed)
   Not equal
+<BLANKLINE>
 
-ghci> 'TL.putStrLn' . 'TB.toLazyText' . 'renderDoc' 'defaultRenderOpts' 0 . 'listDiffErrorDoc' "list" $ 'DiffAtIndex' 3 $ 'TopLevelNotEqual' \"1\" \"2\"
+>>> TL.putStrLn . TB.toLazyText . renderDoc defaultRenderOpts 0 . listDiffErrorDoc "list" $ DiffAtIndex 3 $ TopLevelNotEqualShow "1" "2"
 Diff at list index 3 (0-indexed)
   Not equal
   Left value:  1
   Right value: 2
+<BLANKLINE>
 
-ghci> TL.putStrLn . TB.toLazyText . renderDoc defaultRenderOpts 0 . listDiffErrorDoc "non-empty list" $ WrongLengths 3 5
+>>> TL.putStrLn . TB.toLazyText . renderDoc defaultRenderOpts 0 . listDiffErrorDoc "non-empty list" $ WrongLengths 3 5
 non-empty lists are wrong lengths
 Length of left list: 3
 Length of right list: 5
-@
+<BLANKLINE>
 -}
 listDiffErrorDoc :: TB.Builder -> ListDiffError a -> Doc
 listDiffErrorDoc lst = \case

generic-diff/test/doctests.hs

@@ -0,0 +1,7 @@
+module Main where
+
+import System.Environment (getArgs)
+import Test.DocTest (mainFromCabal)
+
+main :: IO ()
+main = mainFromCabal "generic-diff" =<< getArgs