Fix/silence some warnings

Author: UlfNorell

quickcheck-dynamic/quickcheck-dynamic.cabal

@@ -65,6 +65,7 @@ common lang
     -Wall -Wnoncanonical-monad-instances -Wunused-packages
     -Wincomplete-uni-patterns -Wincomplete-record-updates
     -Wredundant-constraints -Widentities -Wno-unused-do-bind
+    -Wno-name-shadowing -Wno-x-partial
 
 library
   import:          lang

quickcheck-dynamic/src/Test/QuickCheck/StateModel.hs

@@ -374,9 +374,6 @@ instance Eq (Actions state) where
 instance StateModel state => Show (Actions state) where
   show = showWithUsed emptyContext
 
-getSteps :: Actions state -> [Step state]
-getSteps (Actions ss) = ss
-
 showWithUsed :: StateModel state => VarContext -> Actions state -> String
 showWithUsed ctx (Actions as) =
     let as' = WithUsedVars (combineContexts ctx $ usedVariables (Actions as)) <$> as
@@ -586,13 +583,15 @@ runActions (Actions_ rejected (Smart _ actions)) = do
       tabulate "Actions rejected by precondition" rejected
   return (finalState, env)
 
-bucket = \n -> let (a, b) = go n in show a ++ " - " ++ show b
-        where
-          go n
-            | n < 100 = (d * 10, d * 10 + 9)
-            | otherwise = let (a, b) = go d in (a * 10, b * 10 + 9)
-            where
-              d = div n 10
+bucket :: Int -> String
+bucket n = show a ++ " - " ++ show b
+  where
+    (a, b) = go n
+    go n
+      | n < 100 = (d * 10, d * 10 + 9)
+      | otherwise = let (a, b) = go d in (a * 10, b * 10 + 9)
+      where
+        d = div n 10
 
 -- | Core function to execute a sequence of `Step` given some initial `Env`ironment and `Annotated`
 -- state. Return the list of action names and polarities to work around
@@ -735,7 +734,7 @@ genParActions = do
   return $ ParallelActions as threadA threadB
   where go :: [Step state] -> VarContext -> VarContext -> [Int] -> [Int] -> Gen ([Int], [Int])
         go [] _ctxA _ctxB tA tB = return (reverse tA, reverse tB)
-        go (s@(v := a) : ss) ctxA ctxB tA tB = do
+        go ((v := a) : ss) ctxA ctxB tA tB = do
           let candidates = [ 'a' | a `wellTypedIn` ctxA ] ++ [ 'b' | a `wellTypedIn` ctxB ]
               i = unsafeVarIndex v
           if null candidates
@@ -803,7 +802,7 @@ runParActions pas = do
   monitorTrace env trA
   monitor $ counterexample "-- Monitoring thread B"
   monitorTrace env trB
-  let ilvs = interleavings trC trA trB
+  let ilvs = prepend trC $ interleavings trA trB
   monitor $ tabulate "TraceTree size" (map (bucket . length) ilvs)
   assert $ null ilvs || any (checkTrace initialAnnotatedState mempty) ilvs
   -- TODO: stats collection and cleanup
@@ -839,15 +838,14 @@ checkTrace s env (Node (TraceStep r v (ActionWithPolarity a _)) trs) =
                                       r
     in computePrecondition s act && checkPost && (null trs || any (checkTrace s' env') trs)
 
-interleavings :: [a] -> [a] -> [a] -> [Tree a]
-interleavings (p:ps) as bs = [Node p (interleavings ps as bs)]
-interleavings _ [] bs = spine bs
-interleavings _ as [] = spine as
-interleavings _ (a:as) (b:bs) = [Node a (interleavings [] as (b:bs)), Node b (interleavings [] (a:as) bs)]
+prepend :: [a] -> [Tree a] -> [Tree a]
+prepend []     ts = ts
+prepend (p:ps) ts = [Node p $ prepend ps ts]
 
-spine :: [a] -> [Tree a]
-spine [] = []
-spine (x:xs) = [Node x (spine xs)]
+interleavings :: [a] -> [a] -> [Tree a]
+interleavings [] bs = prepend bs []
+interleavings as [] = prepend as []
+interleavings (a:as) (b:bs) = [Node a (interleavings as (b:bs)), Node b (interleavings (a:as) bs)]
 
 -- TODO:
 --  - Decide how much of the old QCD interface we can afford to break

quickcheck-dynamic/test/Spec/DynamicLogic/RegistryModel.hs

@@ -13,7 +13,6 @@ import Data.Map qualified as Map
 import Test.QuickCheck (Gen, Property)
 import Test.QuickCheck qualified as QC
 import Test.QuickCheck.Monadic hiding (assert)
-import Test.QuickCheck.Monadic qualified as QC
 import Test.Tasty hiding (after)
 
 import Test.Tasty.QuickCheck (testProperty)