diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index cc730e4..4041465 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -117,12 +117,11 @@ jobs: - name: Install dependencies run: | cabal update - cabal build --only-dependencies --enable-tests --enable-benchmarks ${{ matrix.package }} + cabal build --only-dependencies --enable-benchmarks ${{ matrix.package }} - name: Build - run: cabal build --enable-tests --enable-benchmarks ${{ matrix.package }} + run: cabal build --enable-benchmarks ${{ matrix.package }} - name: Run tests # https://github.com/fpringle/generic-diff/actions/runs/15353395135/job/43206848857?pr=10 run: | - cabal configure --enable-tests cd $(dirname ${{ matrix.cabal_file }}) - cabal test --enable-tests + cabal test diff --git a/cabal.project b/cabal.project index 46245a5..7ee69ec 100644 --- a/cabal.project +++ b/cabal.project @@ -1,3 +1,5 @@ packages: ./generic-diff/generic-diff.cabal ./generic-diff-instances/generic-diff-instances.cabal + +tests: True diff --git a/generic-diff/README.md b/generic-diff/README.md index a091505..f02bc1a 100644 --- a/generic-diff/README.md +++ b/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: diff --git a/generic-diff/src/Generics/Diff/Class.hs b/generic-diff/src/Generics/Diff/Class.hs index 1369e7b..3ac1746 100644 --- a/generic-diff/src/Generics/Diff/Class.hs +++ b/generic-diff/src/Generics/Diff/Class.hs @@ -29,6 +29,26 @@ 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,59 +82,61 @@ 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 + -ghci> printDiffResult $ diff Plus Minus +>>> printDiffResult $ diff Plus Minus Wrong constructor Constructor of left value: Plus Constructor of right value: Minus + -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 + -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 + -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 + -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 @@ -122,7 +144,7 @@ In field right: Not equal Left value: 1 Right value: 2 -@ + = Laws diff --git a/generic-diff/src/Generics/Diff/Render.hs b/generic-diff/src/Generics/Diff/Render.hs index 78513a9..9898ce3 100644 --- a/generic-diff/src/Generics/Diff/Render.hs +++ b/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 + -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 + -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 -@ + -} listDiffErrorDoc :: TB.Builder -> ListDiffError a -> Doc listDiffErrorDoc lst = \case diff --git a/generic-diff/src/Generics/Diff/Type.hs b/generic-diff/src/Generics/Diff/Type.hs index 38981e5..4646136 100644 --- a/generic-diff/src/Generics/Diff/Type.hs +++ b/generic-diff/src/Generics/Diff/Type.hs @@ -9,6 +9,28 @@ import qualified Data.Text.Lazy.Builder as TB import Generics.SOP as SOP import Numeric.Natural +{- $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) +:} + +>>> d = diff (Bin (Atom 1) Plus (Atom 1)) (Bin (Atom 1) Plus (Atom 2)) +-} + ------------------------------------------------------------ -- Types @@ -106,6 +128,42 @@ class (Show (SpecialDiffError a), Eq (SpecialDiffError a)) => SpecialDiff a wher {- | Configuration type used to tweak the output of 'Generics.Diff.Render.renderDiffResultWith'. Use 'Generics.Diff.Render.defaultRenderOpts' and the field accessors below to construct. + += Examples + +@ +d = diff (Bin (Atom 1) Plus (Atom 1)) (Bin (Atom 1) Plus (Atom 2)) +@ + +>>> printDiffResultWith defaultRenderOpts d +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 + + +>>> printDiffResultWith defaultRenderOpts {indentSize=0} d +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 + + +>>> printDiffResultWith defaultRenderOpts {indentSize=3, numberedLevels=True} d +1. Both values use constructor Bin but fields don't match + In field right: + 2. Both values use constructor Atom but fields don't match + In field 0 (0-indexed): + 3. Not equal + Left value: 1 + Right value: 2 + -} data RenderOpts = RenderOpts { indentSize :: Natural diff --git a/nix/pre-commit.nix b/nix/pre-commit.nix index bc1e25a..83d2dff 100644 --- a/nix/pre-commit.nix +++ b/nix/pre-commit.nix @@ -1,6 +1,6 @@ let sources = import ./sources.nix; - nixpkgs = import sources.nixpkgs { }; + nixpkgs = import ./nixpkgs.nix; nix-pre-commit-hooks = import sources.pre-commit-hooks; haskell-file-pattern = "\\.l?hs(-boot)?$"; @@ -27,6 +27,8 @@ let ${executable} "''${!n}" done' ''; + + doctest = nixpkgs.lib.getExe nixpkgs.haskellPackages.doctest; in nix-pre-commit-hooks.run { src = ./.; @@ -60,13 +62,22 @@ nix-pre-commit-hooks.run { files = nix-file-pattern; }; + "3-doctest" = { + name = "doctest"; + enable = true; + description = "Run doctest to check example in Haddock comments."; + pass_filenames = false; + entry = "cabal repl generic-diff --with-compiler=${doctest}"; + stages = [ "pre-push" ]; + }; + # by default, pre-commit fails if a hook modifies files, but doesn't # tell us which files have been modified. Smart, right? # this workaround runs a `git diff` to print any files that have # been modified by previous hooks. # NOTE: this should always be the last hook run, so when adding hooks # make sure to add them above this one. - "3-git-diff" = { + "4-git-diff" = { name = "git diff"; enable = true; entry = "git diff --name-only --exit-code"; diff --git a/shell.nix b/shell.nix index bd09aef..e876459 100644 --- a/shell.nix +++ b/shell.nix @@ -23,6 +23,7 @@ shellFor { niv nixpkgs-fmt pre-commit + nixpkgs.haskellPackages.doctest ]; shellHook = '' ${pre-commit-check.shellHook}