Bool.hs

Bool.hs

test_binaryTrees :: TestTree
test_binaryTrees =
    testGroup "Combinations with operators that produce top or bottom"
        [ mkEquals_ internalTrue  internalFalse `becomes` bottom
        , mkEquals_ internalFalse internalTrue  `becomes` bottom
        , mkEquals_ internalTrue  internalTrue  `becomes` (pure internalTrue)
        , mkEquals_ internalFalse internalFalse `becomes` (pure internalFalse)

        , mkAnd internalTrue  internalFalse `becomes` bottom
        , mkAnd internalFalse internalTrue  `becomes` bottom
        , mkAnd internalFalse internalFalse `becomes` bottom
        , mkAnd internalTrue  internalTrue  `becomes` (pure internalTrue)
        ]
  where
    internalTrue  = mkDomainValue bootSort $ Domain.BuiltinBool True
    internalFalse = mkDomainValue bootSort $ Domain.BuiltinBool False

    becomes patt expected =
        withSolver $ \getSolver ->
            testCase "" $ do
                solver <- getSolver
                actual <- evaluateWith solver patt
                assertEqual "" expected actual

test_binaryTrees :: TestTree
test_binaryTrees =
    testGroup "Combinations with operators that produce top or bottom"
        [ mkEquals_ _True  _False `becomes` bottom
        , mkEquals_ _False _True  `becomes` bottom
        , mkEquals_ _True  _True  `becomes` (pure _True)
        , mkEquals_ _False _False `becomes` (pure _False)

        , mkAnd _True  _False `becomes` bottom
        , mkAnd _False _True  `becomes` bottom
        , mkAnd _False _False `becomes` bottom
        , mkAnd _True  _True  `becomes` (pure _True)
        ]
  where
    -- use `asPattern`? `asExpandedpattern`?
    builtin b = mkDomainValue boolSort $ Domain.BuiltinBool b
    _True  = builtin True
    _False = builtin False

    becomes makerInput =
      resource_maker_expected withSolver (flip evaluateWith makerInput)

    -- move this into Test.Terse?
    resource_maker_expected withResource maker expected =
      withResource $ \resource ->
        testCase "" $
          resource >>= maker >>= assertEqual "" expected >>= pure

    -- resource_maker_expected withResource maker expected =
    --   withResource $ \resourceHolder ->
    --     testCase "" $ do
    --       resource <- resourceHolder
    --       actual <- maker resource
    --       assertEqual "" expected actual

It is often discouraged to use flip fully-applied because it usually obscures meaning. For example, I think this is clearer:

becomes makerInput =
  resource_maker_expected withSolver (\solver -> evaluateWith solver makerInput)

(I think the idiomatic use-case of flip is to pass as an argument to a higher-order function, e.g. uncurry flip.)

pure (or return) is the unit of (>>=), so we might as well write:

resource_maker_expected withResource maker expected =
  withResource $ \resource ->
    testCase "" $
      resource >>= maker >>= assertEqual "" expected

Having a chain of >>= is idiomatic Haskell. As a matter of personal preference, I usually write such a pipeline when we are applying a sequence of operations to the same or related data, and "break" the chain when an unrelated piece of data appears. For example, I would write

resource_maker_expected withResource maker expected =
  withResource $ \getResource ->
    testCase "" $ do
      resource <- getResource
      maker resource >>= assertEqual "" expected

because, if I did not know what getResource is doing, I might think that maker does something to the resource and passes it along to assertEqual; of course, that isn't what happens at all: maker consumes resource to produce a new datum passed to assertEqual. That's probably what I would have written, but nobody is going to hold you to that style in code review.