Skip to content

Commit

Permalink
clarify nested <~ use with join (#101)
Browse files Browse the repository at this point in the history 
When I reused the pattern of nested `<~` in #100, I got surprised that the types seemed off. Indeed, I ended up with a `State StdGen (State StdGen Situation)` instead of just a `State StdGen Situation`, but hadn't noticed because `wrap` takes the quickcheck-like approach of recursing on the inner types. This PR at least clarifies things, so the types are what I'm used to. Should I go further and remove the recursion from `wrap`? I considered it (I even have the change stashed right now), but ultimately think that having the extra flexibility might be a good thing in case it's needed for something weird in the future. It's not even the end of the world if everything works with weird types and I don't notice the weirdness until much later, as previously demonstrated. but when I do notice the weirdness, I should get rid of it so the code is easier to understand, hence this PR.
  • Loading branch information
@penguinland
penguinland authored Sep 21, 2024
1 parent f3e7c2b commit d211502
Show file tree
Hide file tree
Showing 2 changed files with 67 additions and 62 deletions.
4 changes: 3 additions & 1 deletion src/Topics/Lebensohl.hs
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,7 @@
module Topics.Lebensohl(topic) where

import Control.Monad(join)

import qualified Bids.Cappelletti as Capp
import qualified Bids.DONT as DONT
import qualified Bids.Lebensohl as Leb
Expand Down Expand Up @@ -105,7 +107,7 @@ gameForce = let
inner response = situation "gfnat" action response explanation dlr vul
in return inner <~ responses
in
wrap $ return sit
wrap . join $ return sit
<~ [ (Nat.b1No2D, [Leb.b1No2D3C, Leb.b1No2D3H, Leb.b1No2D3S])
, (Nat.b1No2H, [Leb.b1No2H3C, Leb.b1No2H3D, Leb.b1No2H3S])
, (Nat.b1No2S, [Leb.b1No2S3C, Leb.b1No2S3D, Leb.b1No2S3H])
Expand Down
125 changes: 64 additions & 61 deletions src/Topics/StandardModernPrecision/TripleFourOne.hs
View file
Original file line number Diff line number Diff line change
@@ -1,5 +1,7 @@
module Topics.StandardModernPrecision.TripleFourOne(topic) where

import Control.Monad(join)

import Bids.StandardModernPrecision.BasicBids(setOpener, oppsPass)
import Bids.StandardModernPrecision.TwoDiamonds(name44Rkc)
import qualified Bids.StandardModernPrecision.OneClub as B
Expand All @@ -25,19 +27,19 @@ showAny4441 = let
in
return inner <~ dealers
in
wrap $ return sit <~ [ (do B.b1C
oppsPass
B.b1C1H
oppsPass
, B.b1C1H2S, T.South, [T.South, T.East])
, (do B.b1C
oppsPass
, B.b1C2S, T.North, [T.North, T.West])
, (do B.b1C
oppsPass
, B.bP1C2S, T.North, [T.South, T.East])
]
<~ T.allVulnerabilities
wrap . join $ return sit <~ [ (do B.b1C
oppsPass
B.b1C1H
oppsPass
, B.b1C1H2S, T.South, [T.South, T.East])
, (do B.b1C
oppsPass
, B.b1C2S, T.North, [T.North, T.West])
, (do B.b1C
oppsPass
, B.bP1C2S, T.North, [T.South, T.East])
]
<~ T.allVulnerabilities


relay :: Situations
Expand All @@ -56,25 +58,25 @@ relay = let
in
return inner <~ dealers
in
wrap $ return sit <~ [ (do B.b1C
oppsPass
B.b1C1H
oppsPass
B.b1C1H2S
oppsPass
, B.b1C1H2S2N, T.North, [T.North, T.West])
, (do B.b1C
oppsPass
B.b1C2S
oppsPass
, B.b1C2S2N, T.South, [T.South, T.East])
, (do B.b1C
oppsPass
B.bP1C2S
oppsPass
, B.b1C2S2N, T.South, [T.North, T.West])
]
<~ T.allVulnerabilities
wrap . join $ return sit <~ [ (do B.b1C
oppsPass
B.b1C1H
oppsPass
B.b1C1H2S
oppsPass
, B.b1C1H2S2N, T.North, [T.North, T.West])
, (do B.b1C
oppsPass
B.b1C2S
oppsPass
, B.b1C2S2N, T.South, [T.South, T.East])
, (do B.b1C
oppsPass
B.bP1C2S
oppsPass
, B.b1C2S2N, T.South, [T.North, T.West])
]
<~ T.allVulnerabilities


bidSingleton :: Situations
Expand All @@ -94,7 +96,7 @@ bidSingleton = let
in
return inner <~ answers <~ dealers
in
wrap $ return sit
wrap . join $ return sit
<~ [ (do B.b1C
oppsPass
B.b1C1H
Expand Down Expand Up @@ -144,34 +146,35 @@ singletonInPartnerSuit = let
in
return inner <~ lastTwoBids <~ dealers
in
wrap $ return sit <~ [ (do B.b1C
oppsPass
B.b1C1H
oppsPass
, [ (B.b1C1H1S, B.b1C1H1S3C)
, (B.b1C1H2C, B.b1C1H2C3D)
, (B.b1C1H2D, B.b1C1H2D3H)
, (B.b1C1H2H, B.b1C1H2H3S)
], T.North, [T.North, T.West])
, (do B.b1C
oppsPass
-- TODO: We're using the standard responses, not the
-- modified ones. Is it worth making a whole separate
-- topic for the modified version? Not sure.
, [ (B.b1C1S, B.b1C1S3C)
, (B.b1C2C, B.b1C2C3D)
, (B.b1C2D, B.b1C2D3H)
, (B.b1C2H, B.b1C2H3S)
], T.South, [T.South, T.East])
, (do B.b1C
oppsPass
, [ (B.bP1C1H, B.b1C1H2S)
, (B.bP1C1S, B.b1C1S3C)
, (B.bP1C2C, B.b1C2C3D)
, (B.bP1C2D, B.b1C2D3H)
], T.South, [T.North, T.West])
]
<~ T.allVulnerabilities
wrap . join $ return sit <~ [ (do B.b1C
oppsPass
B.b1C1H
oppsPass
, [ (B.b1C1H1S, B.b1C1H1S3C)
, (B.b1C1H2C, B.b1C1H2C3D)
, (B.b1C1H2D, B.b1C1H2D3H)
, (B.b1C1H2H, B.b1C1H2H3S)
], T.North, [T.North, T.West])
, (do B.b1C
oppsPass
-- TODO: We're using the standard responses,
-- not the modified ones. Is it worth making a
-- whole separate topic for the modified
-- version? Not sure.
, [ (B.b1C1S, B.b1C1S3C)
, (B.b1C2C, B.b1C2C3D)
, (B.b1C2D, B.b1C2D3H)
, (B.b1C2H, B.b1C2H3S)
], T.South, [T.South, T.East])
, (do B.b1C
oppsPass
, [ (B.bP1C1H, B.b1C1H2S)
, (B.bP1C1S, B.b1C1S3C)
, (B.bP1C2C, B.b1C2C3D)
, (B.bP1C2D, B.b1C2D3H)
], T.South, [T.North, T.West])
]
<~ T.allVulnerabilities


topic :: Topic
Expand Down

0 comments on commit d211502

Please sign in to comment.