Util.hs

{-# LANGUAGE TupleSections #-}

module Test.Util where

import qualified Test.QuickCheck as Q

import qualified Control.Exception as E
import qualified Control.Monad     as M

import qualified Data.List as L

orElse :: IO x -> IO x -> IO x
orElse io1 io2 = io1 `E.catch` \ (E.SomeException _) -> io2

oneOf :: [IO x] -> IO x
oneOf (io:[])  = io
oneOf (io:ios) = io `orElse` oneOf ios
oneOf []       = error "actions must include at least one element"

oneOfWithIndex :: [IO x] -> IO (x, Int)
oneOfWithIndex = go 0
    where
        go _ []       = error "actions must include at least one element"
        go x (io:[])  = (, x) <$> io
        go x (io:ios) = ((, x) <$> io)
            `E.catch` \ (E.SomeException _) -> go (x+1) ios

genSatisfy :: Q.Arbitrary a => Int -> (a -> Bool) -> IO [a]
genSatisfy num f = M.replicateM num . Q.generate $ Q.arbitrary `Q.suchThat` f

pickUp :: Int -> [x] -> (x, [x])
pickUp idx xs = (rx, hxs ++ drop 1 txs)
    where
        (hxs, txs) = L.splitAt idx xs
        rx = case take 1 txs of
            r:_ -> r
            _   -> error "invalid index to pickUp"