module DSL where
import Prelude hiding (sequence)
import Control.Monad.State as CMS hiding (sequence)
import System.Random (StdGen, randomR, newStdGen)

type Sem a = CMS.State StdGen a

-- |nextBoundedBy bound| for |0 < bound| returns a random result |0 <= result < bound|
nextBoundedBy :: Int -> Sem Int
nextBoundedBy bound = state $ randomR (0,bound-1)
  -- Not asked for in the exam question

-- a)

elements     = oneof . map returnGen

oneof        = frequency . map ((,) 1) -- Alternatively: zip (repeat 1)

fmapGen f g  = bindGen g $ \x -> return $ f x

sequence []      = returnGen []
sequence (g:gs)  = bindGen g $ \x -> bindGen (sequence gs) $ \xs -> return (x:xs)

-- b)

type Gen a = Sem a

returnGen a = CMS.state $ \s -> (a, s)

bindGen g f = CMS.state $ \s -> let (a, s') = runState g s in runState (f a) s'

frequency igs = do  let tot = sum $ map fst igs
                    j <- nextBoundedBy tot    
                    pick j igs
                   
pick :: Int -> [(Int, a)] -> a
pick j [] = error "pick: Out of bound"
pick j ((i, a):ias) | j < i      = a
                    | otherwise  = pick (j-i) ias
                         
run :: Gen a -> Int -> StdGen -> [a]      
run g n = take n . runInf g

runInf :: State s a -> s -> [a]
runInf g = evalState (sequence $ repeat g)

----
-- Testing code - not part of the exam question
runIO :: Gen a -> Int -> IO [a]
runIO g n = run g n `fmap` newStdGen

test = runIO (frequency 
  [ (3, return False),
    (1,return True)
  ]) 10