Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add Monoidal (->) tests #43

Merged
merged 4 commits into from
Oct 22, 2020
Merged
Changes from 3 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
33 changes: 32 additions & 1 deletion test/Test/Prolens/Property.hs
Original file line number Diff line number Diff line change
Expand Up @@ -26,8 +26,9 @@ lensPropertySpecs = describe "Lens Laws" $ do
set nameL valueNew (set nameL value source) === set nameL valueNew source

typeclassesPropertySpecs :: Spec
typeclassesPropertySpecs = describe "Class Laws" -- $ do
typeclassesPropertySpecs = describe "Class Laws" $ do
profunctorsSpec
monoidalSpec

profunctorsSpec :: Spec
profunctorsSpec = describe "Profunctor" $ do
Expand Down Expand Up @@ -66,3 +67,33 @@ eqFun :: Fun Maybe Int Int -> Fun Maybe Int Int -> PropertyT IO ()
eqFun fun1 fun2 = do
x <- forAll genInt
unFun fun1 x === unFun fun2 x

monoidalSpec :: Spec
monoidalSpec = describe "Monoidal" $ do
describe "(->)" $ do
it "Identity: pappend f pempty ≡ first f" $ hedgehog $ do
f <- forAllWith (const "f") genFunction
vrom911 marked this conversation as resolved.
Show resolved Hide resolved
x <- forAll genInt
y <- forAll genInt
pappend f pempty (x, y) === first f (x, y)
it "Identity: pappend pempty f ≡ second f" $ hedgehog $ do
f <- forAllWith (const "f") genFunction
x <- forAll genInt
y <- forAll genInt
pappend pempty f (x, y) === second f (x, y)
it "Associativity (right)" $ hedgehog $ do
f <- forAllWith (const "f") genFunction
vrom911 marked this conversation as resolved.
Show resolved Hide resolved
g <- forAllWith (const "g") genFunction
h <- forAllWith (const "h") genFunction
x <- forAll genInt
y <- forAll genInt
z <- forAll genInt
pappend f (pappend g h) (x, (y, z)) === (f x, (g y, h z))
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This looks right.
I think we could make it even more cooler, if we would check both associativity at once as well:

pappend f (pappend g h) (x, (y, z))  === dimap (\(a, (b, c)) -> ((a, b), c))  (\((a, b), c) -> (a, (b, c)))(pappend (pappend f g) h (x, (y, z)) )

What do you think?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think that line becomes quite long.

My counterproposal is to add two helper functions

untupleRight :: (a, (b, c)) -> (a, b, c)
untupleRight (a, (b, c)) = (a, b, c)

untupleLeft :: ((a, b), c) -> (a, b, c)
untupleLeft ((a, b), c) = (a, b, c)

And the test would become

it "Associativity" $ hedgehog $ do
    f <- forAllWith (const "f") genFunction
    g <- forAllWith (const "g") genFunction
    h <- forAllWith (const "h") genFunction
    x <- forAll genInt
    y <- forAll genInt
    z <- forAll genInt
    untupleRight (pappend f (pappend g h) (x, (y, z))) === untupleLeft (pappend (pappend f g) h ((x, y), z))

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Sure, the helper functions are way to go.
I don't think that dimap is too long to type, so I don't see why it is a problem..

Copy link
Contributor Author

@xplosunn xplosunn Oct 21, 2020

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

To be honest I can't get it to compile with dimap. I'm always running into issues like

Couldn't match type ‘Int’ with ‘((Int, b1), c0)’
      Expected type: (Int, (Int, Int))
                     -> (((a0, b0), Int), ((Int, b1), c0))
        Actual type: ((Int, Int), Int) -> ((Int, Int), Int)

Maybe it has something to do with the tuple type parameters?

Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Okay, no worries. I would look into that separately 🙂

it "Associativity (left)" $ hedgehog $ do
f <- forAllWith (const "f") genFunction
g <- forAllWith (const "g") genFunction
h <- forAllWith (const "h") genFunction
x <- forAll genInt
y <- forAll genInt
z <- forAll genInt
pappend (pappend f g) h ((x, y), z) === ((f x, g y), h z)
vrom911 marked this conversation as resolved.
Show resolved Hide resolved