JoinList.hs

{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables        #-}
import           Control.Applicative
import           Data.Monoid
import           Test.QuickCheck

data JoinList m a = Empty
                  | Single m a
                  | Append m (JoinList m a) (JoinList m a)
    deriving (Eq, Show)

-- where `m` is a Monoid

newtype Size = Size Int
  deriving (Eq, Ord, Show, Num)

getSize :: Size -> Int
getSize (Size i) = i

class Sized a where
  size :: a -> Size

instance Sized Size where
  size = id

-- This instance means that things like
--   (Foo, Size)
--   (Foo, (Bar, Size))
--   ...
-- are all instances of Sized.
instance Sized b => Sized (a,b) where
  size = size . snd

instance Monoid Size where
  mempty  = Size 0
  mappend = (+)

instance (Arbitrary m, Arbitrary a) => Arbitrary (JoinList m a) where
  arbitrary = oneof [ pure Empty
                    , Single <$> arbitrary <*> arbitrary
                    , Append <$> arbitrary <*> arbitrary <*> arbitrary
                    ]


main :: IO ()
main = quickCheck \(jl :: JoinList [Int] Int) (error "your property here")