{-|

Module      : Colours
Description : Explore semigroup with a colours example
Copyright   : © Frank Jung, 2022
License     : GPL-3

From "Get Programming with Haskell" by Will Kurt,
Lesson 17. Design by composition—Semigroups and Monoids

-}

module Colours (
                 Colour(..) -- Sample Colours
               ) where

import           Test.QuickCheck.Arbitrary (Arbitrary (arbitrary),
                                            arbitraryBoundedEnum)

-- | Acceptable colours.
data Colour = Red | Yellow | Blue | Green | Purple | Orange | Brown
                deriving (Int -> Colour -> ShowS
[Colour] -> ShowS
Colour -> String
(Int -> Colour -> ShowS)
-> (Colour -> String) -> ([Colour] -> ShowS) -> Show Colour
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Colour -> ShowS
showsPrec :: Int -> Colour -> ShowS
$cshow :: Colour -> String
show :: Colour -> String
$cshowList :: [Colour] -> ShowS
showList :: [Colour] -> ShowS
Show, Colour -> Colour -> Bool
(Colour -> Colour -> Bool)
-> (Colour -> Colour -> Bool) -> Eq Colour
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Colour -> Colour -> Bool
== :: Colour -> Colour -> Bool
$c/= :: Colour -> Colour -> Bool
/= :: Colour -> Colour -> Bool
Eq, Colour
Colour -> Colour -> Bounded Colour
forall a. a -> a -> Bounded a
$cminBound :: Colour
minBound :: Colour
$cmaxBound :: Colour
maxBound :: Colour
Bounded, Int -> Colour
Colour -> Int
Colour -> [Colour]
Colour -> Colour
Colour -> Colour -> [Colour]
Colour -> Colour -> Colour -> [Colour]
(Colour -> Colour)
-> (Colour -> Colour)
-> (Int -> Colour)
-> (Colour -> Int)
-> (Colour -> [Colour])
-> (Colour -> Colour -> [Colour])
-> (Colour -> Colour -> [Colour])
-> (Colour -> Colour -> Colour -> [Colour])
-> Enum Colour
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Colour -> Colour
succ :: Colour -> Colour
$cpred :: Colour -> Colour
pred :: Colour -> Colour
$ctoEnum :: Int -> Colour
toEnum :: Int -> Colour
$cfromEnum :: Colour -> Int
fromEnum :: Colour -> Int
$cenumFrom :: Colour -> [Colour]
enumFrom :: Colour -> [Colour]
$cenumFromThen :: Colour -> Colour -> [Colour]
enumFromThen :: Colour -> Colour -> [Colour]
$cenumFromTo :: Colour -> Colour -> [Colour]
enumFromTo :: Colour -> Colour -> [Colour]
$cenumFromThenTo :: Colour -> Colour -> Colour -> [Colour]
enumFromThenTo :: Colour -> Colour -> Colour -> [Colour]
Enum)

-- | Example semigroup with a Colour.
instance Semigroup Colour where
    <> :: Colour -> Colour -> Colour
(<>) Colour
a Colour
b  | Colour
a Colour -> Colour -> Bool
forall a. Eq a => a -> a -> Bool
== Colour
b = Colour
a
              | (Colour -> Bool) -> [Colour] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Colour -> [Colour] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Colour
Red,Colour
Blue,Colour
Purple]) [Colour
a,Colour
b] = Colour
Purple
              | (Colour -> Bool) -> [Colour] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Colour -> [Colour] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Colour
Blue,Colour
Yellow,Colour
Green]) [Colour
a,Colour
b] = Colour
Green
              | (Colour -> Bool) -> [Colour] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Colour -> [Colour] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Colour
Red,Colour
Yellow,Colour
Orange]) [Colour
a,Colour
b] = Colour
Orange
              | Bool
otherwise = Colour
Brown

-- | Declare QuickCheck generator for Colour.
instance Arbitrary Colour where
  arbitrary :: Gen Colour
arbitrary = Gen Colour
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum