Skip to content

Commit 0dcd8e2

Browse files
MaximilianAlgehedMaximilianAlgehed
committed
Fourmolu
1 parent 2ab37b3 commit 0dcd8e2

File tree

5 files changed

+73
-70
lines changed

5 files changed

+73
-70
lines changed

‎quickcheck-dynamic-iosim/src/Test/QuickCheck/StateModel/IOSim.hs

Lines changed: 11 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -17,9 +17,10 @@ module Test.QuickCheck.StateModel.IOSim where
1717

1818
import Control.Concurrent
1919
import Control.Concurrent.STM
20-
import Control.Monad.IOSim
2120
import Control.Monad.Class.MonadFork qualified as IOClass
22-
import Control.Monad.Class.MonadSTM qualified as IOClass
21+
import Control.Monad.Class.MonadSTM qualified as IOClass
22+
import Control.Monad.IOSim
23+
2324
-- TODO: when we've updated the dependency on io-sim
2425
-- import Control.Monad.Class.MonadMVar qualified as IOClass
2526

@@ -28,13 +29,13 @@ import Test.QuickCheck.StateModel
2829
type family RealizeIOSim s a where
2930
RealizeIOSim s ThreadId = IOClass.ThreadId (IOSim s)
3031
RealizeIOSim s (TVar a) = IOClass.TVar (IOSim s) a
31-
-- TODO: when we've updated the dependency on io-sim
32-
-- RealizeIOSim s (MVar a) = IOClass.MVar (IOSim s) a
33-
-- TODO: unfortunately no poly-kinded recursion for type families
34-
-- so we can't do something like :'(
35-
-- RealizeIOSim s (f a) = (RealizeIOSim f) (RealizeIOSim s a)
36-
RealizeIOSim s (f a b) = f (RealizeIOSim s a) (RealizeIOSim s b)
37-
RealizeIOSim s (f a) = f (RealizeIOSim s a)
38-
RealizeIOSim s a = a
32+
-- TODO: when we've updated the dependency on io-sim
33+
-- RealizeIOSim s (MVar a) = IOClass.MVar (IOSim s) a
34+
-- TODO: unfortunately no poly-kinded recursion for type families
35+
-- so we can't do something like :'(
36+
-- RealizeIOSim s (f a) = (RealizeIOSim f) (RealizeIOSim s a)
37+
RealizeIOSim s (f a b) = f (RealizeIOSim s a) (RealizeIOSim s b)
38+
RealizeIOSim s (f a) = f (RealizeIOSim s a)
39+
RealizeIOSim s a = a
3940

4041
type instance Realized (IOSim s) a = RealizeIOSim s a

‎quickcheck-dynamic-iosim/test/Spec.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@ module Main (main) where
44

55
import Spec.DynamicLogic.RegistryModel qualified
66
import Test.Tasty
7-
import qualified Test.Tasty.Runners.Reporter as Reporter
7+
import Test.Tasty.Runners.Reporter qualified as Reporter
88

99
main :: IO ()
1010
main = defaultMainWithIngredients [Reporter.ingredient] tests

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

Lines changed: 33 additions & 32 deletions
Original file line numberDiff line numberDiff line change
@@ -8,9 +8,9 @@
88
{-# LANGUAGE PolyKinds #-}
99
{-# LANGUAGE RankNTypes #-}
1010
{-# LANGUAGE StandaloneDeriving #-}
11+
{-# LANGUAGE TypeApplications #-}
1112
{-# LANGUAGE TypeFamilies #-}
1213
{-# LANGUAGE UndecidableInstances #-}
13-
{-# LANGUAGE TypeApplications #-}
1414

1515
module Spec.DynamicLogic.RegistryModel where
1616

@@ -35,12 +35,12 @@ import Test.Tasty.QuickCheck (testProperty)
3535
import Spec.DynamicLogic.Registry
3636
import Test.QuickCheck.DynamicLogic.Core
3737
import Test.QuickCheck.StateModel
38-
import Test.QuickCheck.StateModel.IOSim()
38+
import Test.QuickCheck.StateModel.IOSim ()
3939

4040
data RegState = RegState
41-
{ tids :: [Var ThreadId]
42-
, regs :: [(String, Var ThreadId)]
43-
, dead :: [Var ThreadId]
41+
{ tids :: [Var ThreadId]
42+
, regs :: [(String, Var ThreadId)]
43+
, dead :: [Var ThreadId]
4444
, setup :: Bool
4545
}
4646
deriving (Show)
@@ -50,10 +50,10 @@ deriving instance Eq (Action RegState a)
5050

5151
instance StateModel RegState where
5252
data Action RegState a where
53-
Init :: Action RegState ()
54-
Spawn :: Action RegState ThreadId
55-
WhereIs :: String -> Action RegState (Maybe ThreadId)
56-
Register :: String -> Var ThreadId -> Action RegState (Either SomeException ())
53+
Init :: Action RegState ()
54+
Spawn :: Action RegState ThreadId
55+
WhereIs :: String -> Action RegState (Maybe ThreadId)
56+
Register :: String -> Var ThreadId -> Action RegState (Either SomeException ())
5757
Unregister :: String -> Action RegState (Either SomeException ())
5858
KillThread :: Var ThreadId -> Action RegState ()
5959
-- not generated
@@ -110,7 +110,7 @@ instance StateModel RegState where
110110
s{tids = step : tids s}
111111
nextState s (Register name tid) _step
112112
| positive s (Register name tid) =
113-
s{regs = (name, tid) : regs s}
113+
s{regs = (name, tid) : regs s}
114114
| otherwise = s
115115
nextState s (Unregister name) _step =
116116
s{regs = filter ((/= name) . fst) (regs s)}
@@ -193,7 +193,7 @@ why :: RegState -> Action RegState a -> String
193193
why s (Register name tid) =
194194
unwords $
195195
["name already registered" | name `elem` map fst (regs s)]
196-
++ ["tid already registered" | tid `elem` map snd (regs s)]
196+
++ ["tid already registered" | tid `elem` map snd (regs s)]
197197
++ ["dead thread" | tid `elem` dead s]
198198
why _ _ = "(impossible)"
199199

@@ -287,13 +287,13 @@ canRegister s
287287
| length (regs s) == 5 = ignore -- all names are in use
288288
| null (tids s) = after Spawn canRegister
289289
| otherwise = forAllQ
290-
( elementsQ (allNames \\ map fst (regs s))
291-
, elementsQ (tids s)
292-
)
293-
$ \(name, tid) ->
294-
after
295-
(Successful $ Register name tid)
296-
done
290+
( elementsQ (allNames \\ map fst (regs s))
291+
, elementsQ (tids s)
292+
)
293+
$ \(name, tid) ->
294+
after
295+
(Successful $ Register name tid)
296+
done
297297

298298
canRegisterName :: String -> RegState -> DynFormula RegState
299299
canRegisterName name s = forAllQ (elementsQ availableTids) $ \tid ->
@@ -305,7 +305,7 @@ canReregister :: RegState -> DynFormula RegState
305305
canReregister s
306306
| null (regs s) = ignore
307307
| otherwise = forAllQ (elementsQ $ map fst (regs s)) $ \name ->
308-
after (Unregister name) (canRegisterName name)
308+
after (Unregister name) (canRegisterName name)
309309

310310
canRegisterName' :: String -> RegState -> DynFormula RegState
311311
canRegisterName' name s = forAllQ (elementsQ availableTids) $ \tid ->
@@ -316,22 +316,23 @@ canRegisterName' name s = forAllQ (elementsQ availableTids) $ \tid ->
316316
canReregister' :: Show (IOClass.ThreadId (IOSim s)) => RegState -> DynFormula RegState
317317
canReregister' s
318318
| null (regs s) =
319-
toStop $
320-
if null availableTids
321-
then after Spawn canReregister'
322-
else after (Register "a" (head availableTids)) canReregister'
319+
toStop $
320+
if null availableTids
321+
then after Spawn canReregister'
322+
else after (Register "a" (head availableTids)) canReregister'
323323
| otherwise = forAllQ (elementsQ $ map fst (regs s)) $ \name ->
324-
after (Unregister name) (canRegisterName' name)
324+
after (Unregister name) (canRegisterName' name)
325325
where
326326
availableTids = (tids s \\ map snd (regs s)) \\ dead s
327327

328328
tests :: TestTree
329329
tests = testGroup "registry model example" []
330-
-- TODO:
331-
-- * turn on this test
332-
-- * add DL properties
333-
{-
334-
testGroup
335-
"registry model example"
336-
[testProperty "prop_Registry" prop_Registry]
337-
-}
330+
331+
-- TODO:
332+
-- * turn on this test
333+
-- * add DL properties
334+
{-
335+
testGroup
336+
"registry model example"
337+
[testProperty "prop_Registry" prop_Registry]
338+
-}

‎quickcheck-dynamic/src/Test/QuickCheck/DynamicLogic/Core.hs

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -474,8 +474,8 @@ shrinkScript dl steps = shrink' dl steps initialState
474474
where
475475
shrink' _ [] _ = []
476476
shrink' d (step : as) s =
477-
[] :
478-
reverse (takeWhile (not . null) [drop (n - 1) as | n <- iterate (* 2) 1])
477+
[]
478+
: reverse (takeWhile (not . null) [drop (n - 1) as | n <- iterate (* 2) 1])
479479
++ case step of
480480
Do (Var i := act) ->
481481
[Do (Var i := act') : as | Some act' <- shrinkAction s act]
@@ -513,13 +513,13 @@ pruneDLTest dl = prune [dl] initialState
513513
prune _ _ [] = []
514514
prune ds s (Do (var := act) : rest)
515515
| precondition s act =
516-
case [d' | d <- ds, d' <- stepDL d s (Do $ var := act)] of
517-
[] -> prune ds s rest
518-
ds' ->
519-
Do (var := act) :
520-
prune ds' (nextState s act var) rest
516+
case [d' | d <- ds, d' <- stepDL d s (Do $ var := act)] of
517+
[] -> prune ds s rest
518+
ds' ->
519+
Do (var := act)
520+
: prune ds' (nextState s act var) rest
521521
| otherwise =
522-
prune ds s rest
522+
prune ds s rest
523523
prune ds s (Witness a : rest) =
524524
case [d' | d <- ds, d' <- stepDL d s (Witness a)] of
525525
[] -> prune ds s rest

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

Lines changed: 20 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE AllowAmbiguousTypes #-}
2+
{-# LANGUAGE ConstraintKinds #-}
23
{-# LANGUAGE DeriveDataTypeable #-}
34
{-# LANGUAGE FlexibleContexts #-}
45
{-# LANGUAGE FlexibleInstances #-}
@@ -12,8 +13,6 @@
1213
{-# LANGUAGE TypeApplications #-}
1314
{-# LANGUAGE TypeFamilies #-}
1415
{-# LANGUAGE UndecidableInstances #-}
15-
{-# LANGUAGE RecordWildCards #-}
16-
{-# LANGUAGE ConstraintKinds #-}
1716

1817
-- | Simple (stateful) Model-Based Testing library for use with Haskell QuickCheck.
1918
--
@@ -36,12 +35,12 @@ module Test.QuickCheck.StateModel (
3635
runActions,
3736
runActionsInState,
3837
lookUpVar,
39-
lookUpVarMaybe
38+
lookUpVarMaybe,
4039
) where
4140

4241
import Control.Monad
43-
import Control.Monad.State
4442
import Control.Monad.Reader
43+
import Control.Monad.State
4544
import Data.Data
4645
import Data.Kind
4746
import Test.QuickCheck as QC
@@ -145,11 +144,13 @@ class Monad m => RunModel state m where
145144
-- The `Lookup` parameter provides an /environment/ to lookup `Var
146145
-- a` instances from previous steps.
147146
perform :: forall a. Typeable a => state -> Action state a -> LookUp m -> m (Realized m a)
147+
148148
-- | Postcondition on the `a` value produced at some step.
149149
-- The result is `assert`ed and will make the property fail should it be `False`. This is useful
150150
-- to check the implementation produces expected values.
151151
postcondition :: forall a. (state, state) -> Action state a -> LookUp m -> Realized m a -> m Bool
152152
postcondition _ _ _ _ = pure True
153+
153154
-- | Allows the user to attach information to the `Property` at each step of the process.
154155
-- This function is given the full transition that's been executed, including the start and ending
155156
-- `state`, the `Action`, the current environment to `Lookup` and the value produced by `perform`
@@ -238,11 +239,11 @@ instance (forall a. Show (Action state a)) => Show (Actions state) where
238239
| d > 10 = ("(" ++) . shows (Actions as) . (")" ++)
239240
| null as = ("Actions []" ++)
240241
| otherwise =
241-
("Actions \n [" ++)
242-
. foldr
243-
(.)
244-
(shows (last as) . ("]" ++))
245-
[shows a . (",\n " ++) | a <- init as]
242+
("Actions \n [" ++)
243+
. foldr
244+
(.)
245+
(shows (last as) . ("]" ++))
246+
[shows a . (",\n " ++) | a <- init as]
246247

247248
instance (StateModel state) => Arbitrary (Actions state) where
248249
arbitrary = do
@@ -272,14 +273,14 @@ instance (StateModel state) => Arbitrary (Actions state) where
272273
go m n rej
273274
| m > n = return (Nothing, rej)
274275
| otherwise = do
275-
a <- resize m $ arbitraryAction s
276-
case a of
277-
Some act ->
278-
if precondition s act
279-
then return (Just (Some act), rej)
280-
else go (m + 1) n (actionName act : rej)
281-
Error _ ->
282-
go (m + 1) n rej
276+
a <- resize m $ arbitraryAction s
277+
case a of
278+
Some act ->
279+
if precondition s act
280+
then return (Just (Some act), rej)
281+
else go (m + 1) n (actionName act : rej)
282+
Error _ ->
283+
go (m + 1) n rej
283284

284285
shrink (Actions_ rs as) =
285286
map (Actions_ rs) (shrinkSmart (map (prune . map fst) . shrinkList shrinker . withStates) as)
@@ -292,9 +293,9 @@ prune = loop initialState
292293
loop _s [] = []
293294
loop s ((var := act) : as)
294295
| precondition s act =
295-
(var := act) : loop (nextState s act var) as
296+
(var := act) : loop (nextState s act var) as
296297
| otherwise =
297-
loop s as
298+
loop s as
298299

299300
withStates :: StateModel state => [Step state] -> [(Step state, state)]
300301
withStates = loop initialState

0 commit comments

Comments
 (0)