Automatically testing laws for Tree and RoseTree from assignment 1 of UU AFP '21

Main.hs

{-# LANGUAGE TypeApplications #-}
module Main where

import Data.Proxy
import Test.QuickCheck
import Test.QuickCheck.Classes

-- Definition of the types in assignment 1

data Tree a = Leaf a | Node (Tree a) (Tree a)
  deriving (Show, Eq)

data RoseTree a = RoseNode a [RoseTree a] | RoseLeaf
  deriving (Show, Eq)

data Teletype a = Get (Char -> Teletype a)
                | Put Char (Teletype a)
                | Return a


-- Add your instances here!

-- instance Functor Tree where ...


-- Some instances of Arbitrary so that we can generate values of our types

instance Arbitrary a => Arbitrary (Tree a) where
    arbitrary = frequency [(2, Leaf <$> arbitrary), (1, Node <$> arbitrary <*> arbitrary)]

instance Arbitrary a => Arbitrary (RoseTree a) where
    arbitrary =
        frequency [(2, pure RoseLeaf)
                  ,(1, RoseNode <$> arbitrary
                                <*> sized (\n ->
                                      resize ((n + 4) `div` 5)
                                             (listOf (resize (n `div` 2) arbitrary))))]

instance Arbitrary a => Arbitrary (Teletype a) where
    arbitrary =
        frequency [(2, Get <$> arbitrary)
                  ,(2, Put <$> arbitrary <*> arbitrary)
                  ,(1, Return <$> arbitrary)]

-- Check the laws for Tree and RoseTree.
-- We cannot easily check the laws automatically for Teletype because showing
-- and equality checking is hard for functions (i.e. the one in 'Get').
main :: IO ()
main = do
    lawsCheckMany
        [("Tree",
            let p = Proxy @Tree
            in [functorLaws p
               ,applicativeLaws p
               ,monadLaws p
               ,foldableLaws p
               ,traversableLaws p])
        ,("RoseTree",
            let p = Proxy @RoseTree
            in [functorLaws p
               ,applicativeLaws p
               ,monadLaws p
               ,foldableLaws p
               ,traversableLaws p])]

    putStrLn "Note: Teletype laws unchecked!"

test.cabal

cabal-version:       >=1.10
name:                test
synopsis:            Test
version:             0.0.1.0
license:             MIT
author:              My name
maintainer:          myemail@example.com
build-type:          Simple

executable test
  main-is:             Main.hs
  other-modules:
  build-depends:       base >= 4.12 && < 4.17, QuickCheck, quickcheck-classes
  hs-source-dirs:      .
  default-language:    Haskell2010
  ghc-options:         -Wall -O2 -threaded