From cafd48f2005987540c4cadb14970dd4101d4472e Mon Sep 17 00:00:00 2001
From: Joris Dral <joris@well-typed.com>
Date: Wed, 1 May 2024 12:33:56 +0200
Subject: [PATCH] Bugfix: handle forgotten `removeDirectoryRecursiveE` record
 field.

Due to `RecordWildCards`, we forgot to handle `removeDirectoryRecursiveE` in
three places: `allNull`, the `Show Errors` instance, and the shrinker for
`Errors`. We now use `safe-wild-cards` so that we get a compiler error if we
forget to handle a field.
---
 fs-sim/CHANGELOG.md               |  8 ++++++
 fs-sim/fs-sim.cabal               |  1 +
 fs-sim/src/System/FS/Sim/Error.hs | 45 ++++++++++++++++++-------------
 3 files changed, 35 insertions(+), 19 deletions(-)

diff --git a/fs-sim/CHANGELOG.md b/fs-sim/CHANGELOG.md
index 34e901f..9546627 100644
--- a/fs-sim/CHANGELOG.md
+++ b/fs-sim/CHANGELOG.md
@@ -6,6 +6,14 @@
 
 * Orphan `Show` instance for `Foreign.C.Error.Errno` removed by `fs-api`.
 * New `primitive ^>=0.9` dependency
+* New `safe-wild-cards^>=1.0`dependency
+
+### Patch
+
+* `allNull` was not actually checking whether all streams in the argument
+  `Errors` are empty.
+* The `Show Errors` instance was not printing every stream.
+* The shrinker for `Errors` was not shrinking every stream.
 
 ## 0.2.1.1 -- 2023-10-30
 
diff --git a/fs-sim/fs-sim.cabal b/fs-sim/fs-sim.cabal
index d3dedd1..dca9da1 100644
--- a/fs-sim/fs-sim.cabal
+++ b/fs-sim/fs-sim.cabal
@@ -46,6 +46,7 @@ library
     , mtl
     , primitive          ^>=0.9
     , QuickCheck
+    , safe-wild-cards    ^>=1.0
     , strict-stm         >=0.3  && <1.5
     , text               >=1.2  && <2.2
 
diff --git a/fs-sim/src/System/FS/Sim/Error.hs b/fs-sim/src/System/FS/Sim/Error.hs
index b3f3f9b..d5ce0e7 100644
--- a/fs-sim/src/System/FS/Sim/Error.hs
+++ b/fs-sim/src/System/FS/Sim/Error.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE RecordWildCards       #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TemplateHaskell       #-}
 {-# LANGUAGE TupleSections         #-}
 {-# LANGUAGE UndecidableInstances  #-}
 
@@ -53,6 +54,7 @@ import qualified Data.List as List
 import           Data.Maybe (catMaybes)
 import           Data.String (IsString (..))
 import           Data.Word (Word64)
+import           SafeWildCards
 
 import qualified Test.QuickCheck as QC
 import           Test.QuickCheck (ASCIIString (..), Arbitrary (..), Gen,
@@ -227,29 +229,32 @@ data Errors = Errors
   , removeFileE               :: ErrorStream
   , renameFileE               :: ErrorStream
   }
+$(pure []) -- https://blog.monadfix.com/th-groups
 
 -- | Return 'True' if all streams are empty ('null').
 allNull :: Errors -> Bool
-allNull Errors {..} = Stream.null dumpStateE
-                   && Stream.null hOpenE
-                   && Stream.null hCloseE
-                   && Stream.null hSeekE
-                   && Stream.null hGetSomeE
-                   && Stream.null hGetSomeAtE
-                   && Stream.null hPutSomeE
-                   && Stream.null hTruncateE
-                   && Stream.null hGetSizeE
-                   && Stream.null createDirectoryE
-                   && Stream.null createDirectoryIfMissingE
-                   && Stream.null listDirectoryE
-                   && Stream.null doesDirectoryExistE
-                   && Stream.null doesFileExistE
-                   && Stream.null removeFileE
-                   && Stream.null renameFileE
-
+allNull $(fields 'Errors) = and [
+      Stream.null dumpStateE
+    , Stream.null hOpenE
+    , Stream.null hCloseE
+    , Stream.null hSeekE
+    , Stream.null hGetSomeE
+    , Stream.null hGetSomeAtE
+    , Stream.null hPutSomeE
+    , Stream.null hTruncateE
+    , Stream.null hGetSizeE
+    , Stream.null createDirectoryE
+    , Stream.null createDirectoryIfMissingE
+    , Stream.null listDirectoryE
+    , Stream.null doesDirectoryExistE
+    , Stream.null doesFileExistE
+    , Stream.null removeDirectoryRecursiveE
+    , Stream.null removeFileE
+    , Stream.null renameFileE
+    ]
 
 instance Show Errors where
-  show Errors {..} =
+  show $(fields 'Errors) =
       "Errors {"  <> intercalate ", " streams <> "}"
     where
       -- | Show a stream unless it is empty
@@ -273,6 +278,7 @@ instance Show Errors where
         , s "listDirectoryE"            listDirectoryE
         , s "doesDirectoryExistE"       doesDirectoryExistE
         , s "doesFileExistE"            doesFileExistE
+        , s "removeDirectoryRecursiveE" removeDirectoryRecursiveE
         , s "removeFileE"               removeFileE
         , s "renameFileE"               renameFileE
         ]
@@ -365,7 +371,7 @@ genErrors genPartialWrites genSubstituteWithJunk = do
 instance Arbitrary Errors where
   arbitrary = genErrors True True
 
-  shrink err@Errors {..} = filter (not . allNull) $ concat
+  shrink err@($(fields 'Errors)) = filter (not . allNull) $ concat
       [ (\s' -> err { dumpStateE = s' })                <$> Stream.shrinkStream dumpStateE
       , (\s' -> err { hOpenE = s' })                    <$> Stream.shrinkStream hOpenE
       , (\s' -> err { hCloseE = s' })                   <$> Stream.shrinkStream hCloseE
@@ -380,6 +386,7 @@ instance Arbitrary Errors where
       , (\s' -> err { listDirectoryE = s' })            <$> Stream.shrinkStream listDirectoryE
       , (\s' -> err { doesDirectoryExistE = s' })       <$> Stream.shrinkStream doesDirectoryExistE
       , (\s' -> err { doesFileExistE = s' })            <$> Stream.shrinkStream doesFileExistE
+      , (\s' -> err { removeDirectoryRecursiveE = s' }) <$> Stream.shrinkStream removeDirectoryRecursiveE
       , (\s' -> err { removeFileE = s' })               <$> Stream.shrinkStream removeFileE
       , (\s' -> err { renameFileE = s' })               <$> Stream.shrinkStream renameFileE
       ]