module L02A where
import Test.QuickCheck

-- Datatypes 
-- David Sands 
-- 2017-09-01 

-- Continued 2017-09-05 

-- Example of a datatype definition:  
-- data Bool = True | False

-- The Suit (An example of an enumeration type)
data Suit = Hearts | Diamonds | Clubs | Spades
    deriving (Eq,Show)
    
--   Concept [c] Show
  
-- Colour
data Colour = Red | Black
       deriving (Eq,Show)

-- colour (Eq)

colour :: Suit -> Colour
{- 
colour s | s == Hearts   = Red
         | s == Diamonds = Red
         | otherwise     = Black
 -}
-- Preferable to use Pattern matching 
colour Hearts   = Red
colour Diamonds = Red
colour _        = Black

-- Rank: a datatype for the rank of a card
data Rank =   Numeric Int  | Jack | Queen | King | Ace
  deriving (Eq,Show)

-- Datatype invariant 
prop_Rank :: Rank -> Bool
prop_Rank (Numeric n) = n > 1 && n < 11
prop_Rank _           = True

-- rank1 `rankBeats` rank2 ?
-- when is one rank higher than another?
-- "longhand" definition in the slides. 
rankBeats :: Rank -> Rank -> Bool
 
rankBeats _   Ace   = False
rankBeats Ace _     = True
rankBeats _   King  = False
rankBeats King _    = True
rankBeats _   Queen = False
rankBeats Queen _   = True
rankBeats _   Jack  = False
rankBeats Jack _    = True
rankBeats (Numeric m) (Numeric n) = m > n

prop_rankBeats r1 r2 = r1 `rankBeats` r2 || r2 `rankBeats` r1 || r1==r2

-- Is it correct?

-- Card: a data type containing a Rank and a Suit
-- and its projection functions

data Card = Card Rank Suit
  deriving (Eq,Show)

-------- Lecture ended here 2017---------------

-- example card
oneEye :: Card
oneEye = Card King Diamonds

-- projection functions
rank :: Card -> Rank
rank (Card r _) = r

suit :: Card -> Suit
suit (Card _ s) = s

-- and shorthand form defining all three
-- data Card = Card {rank::Rank, suit::Suit}
 

-- Really useful when there are lots of things e.g.

type Name = String
type Year = Int
type Month = Int
type Day = Int
type Pnr = Int

{- 
 data Person = Person [Name] Name Year Month Day Pnr

year :: Person -> Year
year (Person _ _ y _ _ _) = y
 -}
-- ...
-- type synonyms

-- type String = [Char]

data Person = Person{ firstnames :: [Name]
                    , familyname :: Name
                    , year       :: Year
                    , month      :: Month
                    , day        :: Day
                    , pnr        :: Pnr
                    }                    
turing :: Person
turing = Person ["Alan", "Mathison"] "Turing" 1912 6 23 0
-------------------------------------------------------------

-- cardBeats card1 card2 checks if card1 beats card2
-- w & wo pattern matching
cardBeats :: Card -> Card -> Bool
cardBeats (Card r1 s1) (Card r2 s2) = s1 == s2 && r1 `rankBeats` r2
{-
cardBeats c1 c2 = suit c1 == suit c2 && rank c1 `rankBeats` rank c2
 -}

-- Hand as a type synonym

type Hand = [Card]

-----------------------------------------------

-------------------------------------------------------
-- The quickCheck "magic" we need to get it to generate arbitrary
-- elements of our new datatypes:
 

instance Arbitrary Suit where
  arbitrary = elements [Spades, Hearts, Diamonds, Clubs]

instance Arbitrary Rank where
  arbitrary =
    oneof $
      [ do return c
      | c <- [Jack,Queen,King,Ace]
      ] ++
      [ do n <- choose (2,10)
           return (Numeric n)
      ]


{-

instance Arbitrary Card where
  arbitrary =
    do r <- arbitrary
       s <- arbitrary
       return (Card r s)
 -}
 
-------------------------------------------------------------------------