{-# OPTIONS_GHC -fno-warn-orphans #-}
module QuickCheck.Utils where
import Control.Arrow (first)
import Data.Bool
import Data.Eq (Eq(..))
import Data.Function (($), (.))
import Data.Functor (Functor(..))
import Data.Int (Int)
import Data.Ord (Ord(..))
import Data.Ratio ((%), Rational, numerator, denominator)
import Prelude (Num(..), Integral(..), Bounded(..))
import System.Random (Random(..))

import Test.QuickCheck
import Text.Show (Show(..))
import Types
import qualified Data.Set as Set

-- | Like 'nub', but O(n * log n).
nubList :: Ord a => [a] -> [a]
nubList = go Set.empty where
	go _ [] = []
	go s (x:xs) | x`Set.member`s = go s xs
	            | otherwise      = x:go (Set.insert x s) xs

instance Random Rational where
	random = randomR (toInteger (minBound::Int)%1, toInteger (maxBound::Int)%1)
	randomR (minR, maxR) g =
		if d - b == 0
		then first (% b) $ randomR (a, c) g
		else first (bd2ac . nat2bd) $ randomR (0, toInteger (maxBound::Int)) g
		where
		a = numerator   minR
		b = denominator minR
		c = numerator   maxR
		d = denominator maxR
		nat2bd x = ((d - b) % toInteger (maxBound::Int)) * (x%1) + (b%1)
		bd2ac x = alpha * x + beta
			where
			alpha = (c-a) % (d-b)
			beta = (a%1) - alpha * (b%1)
instance Arbitrary SchoolGrade where
	arbitrary = arbitraryBoundedEnum
instance Arbitrary DanishSchoolGrade where
	arbitrary = arbitraryBoundedEnum

-- * Type 'SameLength'
newtype SameLength a = SameLength a
 deriving (Eq, Show)
instance Functor SameLength where
	fmap f (SameLength x) = SameLength (f x)