Skip to content

Commit 9bee2a8

Browse files
committed
Simplify Action.
We don't need `actionInput0`, because it was only used to pass to `actionRefreshInput`. So we can just hide it in a closure.
1 parent a2ad9db commit 9bee2a8

File tree

1 file changed

+13
-16
lines changed

1 file changed

+13
-16
lines changed

hedgehog/src/Hedgehog/Internal/State.hs

Lines changed: 13 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -449,17 +449,14 @@ commandGenOK (CommandA inputGen _ _ _) state =
449449
-- evaluated.
450450
--
451451
data Action m (state :: (Type -> Type) -> Type) =
452-
forall input0 input output.
452+
forall input output.
453453
(TraversableB input, Show (input Symbolic), Show output) =>
454454
Action {
455-
actionInput0 ::
456-
input0
457-
458-
, actionInput ::
455+
actionInput ::
459456
input Symbolic
460457

461458
, actionRefreshInput ::
462-
state Symbolic -> input0 -> Maybe (input Symbolic)
459+
state Symbolic -> Maybe (input Symbolic)
463460

464461
, actionOutput ::
465462
Symbolic output
@@ -478,7 +475,7 @@ data Action m (state :: (Type -> Type) -> Type) =
478475
}
479476

480477
instance Show (Action m state) where
481-
showsPrec p (Action _ input _ (Symbolic (Name output)) _ _ _ _) =
478+
showsPrec p (Action input _ (Symbolic (Name output)) _ _ _ _) =
482479
showParen (p > 10) $
483480
showString "Var " .
484481
showsPrec 11 output .
@@ -561,10 +558,10 @@ contextNewVar = do
561558
rethreadState :: [Action m state] -> State (Context state) [Action m state]
562559
rethreadState =
563560
let
564-
loop (Action input0 _ refreshInput output exec require update ensure) = do
561+
loop (Action _ refreshInput output exec require update ensure) = do
565562
Context state0 vars0 <- get
566563

567-
case refreshInput state0 input0 of
564+
case refreshInput state0 of
568565
Just input | require state0 input && variablesOK input vars0 -> do
569566
let
570567
state =
@@ -574,7 +571,7 @@ rethreadState =
574571
insertSymbolic output vars0
575572

576573
put $ Context state vars
577-
pure $ Just $ Action input0 input refreshInput output exec require update ensure
574+
pure $ Just $ Action input refreshInput output exec require update ensure
578575
_ ->
579576
pure Nothing
580577
in
@@ -615,7 +612,7 @@ action commands =
615612
callbackUpdate callbacks state0 input (Var output)
616613

617614
pure . Just $
618-
Action input input (const Just) output exec
615+
Action input (const $ Just input) output exec
619616
(callbackRequire callbacks)
620617
(callbackUpdate callbacks)
621618
(callbackEnsure callbacks)
@@ -634,7 +631,7 @@ action commands =
634631
callbackUpdate callbacks state0 input (Var output)
635632

636633
pure . Just $
637-
Action input0 input mkInput output exec
634+
Action input (flip mkInput input0) output exec
638635
(callbackRequire callbacks)
639636
(callbackUpdate callbacks)
640637
(callbackEnsure callbacks)
@@ -661,7 +658,7 @@ newtype Sequential m state =
661658
}
662659

663660
renderAction :: Action m state -> [String]
664-
renderAction (Action _ input _ (Symbolic (Name output)) _ _ _ _) =
661+
renderAction (Action input _ (Symbolic (Name output)) _ _ _ _) =
665662
let
666663
prefix0 =
667664
"Var " ++ show output ++ " = "
@@ -677,7 +674,7 @@ renderAction (Action _ input _ (Symbolic (Name output)) _ _ _ _) =
677674
fmap (prefix ++) xs
678675

679676
renderActionResult :: Environment -> Action m state -> [String]
680-
renderActionResult env (Action _ _ _ output@(Symbolic (Name name)) _ _ _ _) =
677+
renderActionResult env (Action _ _ output@(Symbolic (Name name)) _ _ _ _) =
681678
let
682679
prefix0 =
683680
"Var " ++ show name ++ " = "
@@ -776,7 +773,7 @@ data ActionCheck state =
776773
}
777774

778775
execute :: (MonadTest m, HasCallStack) => Action m state -> StateT Environment m (ActionCheck state)
779-
execute (Action _ sinput _ soutput exec _require update ensure) =
776+
execute (Action sinput _ soutput exec _require update ensure) =
780777
withFrozenCallStack $ do
781778
env0 <- get
782779
input <- evalEither $ reify env0 sinput
@@ -803,7 +800,7 @@ executeUpdateEnsure ::
803800
=> (state Concrete, Environment)
804801
-> Action m state
805802
-> m (state Concrete, Environment)
806-
executeUpdateEnsure (state0, env0) (Action _ sinput _ soutput exec _require update ensure) =
803+
executeUpdateEnsure (state0, env0) (Action sinput _ soutput exec _require update ensure) =
807804
withFrozenCallStack $ do
808805
input <- evalEither $ reify env0 sinput
809806
output <- exec input

0 commit comments

Comments
 (0)