minesweeper-0.9: Random.hs

{-# LANGUAGE StandaloneDeriving, GeneralizedNewtypeDeriving #-}
module Random 
    ( RandomSeed
    , newRandomSeed
    , integerDomino
    ) where

import System.Random
import Data.Binary
import Data.Data

newtype RandomSeed 
    = RS StdGen 
        deriving (Read, Show, Typeable, Data)

instance Data StdGen where
   gunfold = error "gunfold not defined for StdGen"
   toConstr = error "toConstr not defined for StdGen"
   dataTypeOf = error "dataTypeOf not defined for StdGen"

deriving instance Typeable StdGen


newRandomSeed :: IO RandomSeed
newRandomSeed = fmap RS newStdGen

instance Binary RandomSeed where
    put = put . show
    get = fmap read get


-- | Get a value from a discrete distribution with the domino algorithm.
integerDomino :: [Integer] -> RandomSeed -> (Int, RandomSeed)
integerDomino is (RS r) = (length zeros + x, RS r'') 
 where 
    (zeros, is') = span (==0) is
    sis = scanl1 (+) is'
    sl = last sis   -- sum is

    (y, r') = randomR (1, sl) r
    j = length $ takeWhile (<y) sis

    (x, r'') 
        | head sis == sl   = (0, r)
        | otherwise = (j, r')