-- | Common functions used by MuCheck
module Test.MuCheck.Utils.Common where
import System.Random
import Data.List
import Data.Time.Clock.POSIX (getPOSIXTime)
import Control.Monad (liftM)
import qualified Data.Hashable as H
-- | The `choose` function generates subsets of a given size
choose :: [a] -> Int -> [[a]]
choose xs n = filter (\x -> length x == n) $ subsequences xs
-- | The `coupling` function produces all possible pairings, and applies the
-- given function to each
coupling :: Eq a => (a -> a -> t) -> [a] -> [t]
coupling fn ops = [fn o1 o2 | o1 <- ops, o2 <- ops, o1 /= o2]
-- | The `replaceFst` function replaces first matching element in a list given old and new values as a pair
replaceFst :: Eq a => (a,a) -> [a] -> [a]
replaceFst _ [] = []
replaceFst (o, n) (v:vs)
| v == o = n : vs
| otherwise = v : replaceFst (o,n) vs
-- | The `sample` function takes a random generator and chooses a random sample
-- subset of given size.
sample :: (RandomGen g) => g -> Int -> [t] -> [t]
sample _ 0 _ = []
sample _ n xs | length xs <= n = xs
sample g n xs = val : sample g' (n - 1) (remElt idx xs)
where val = xs !! idx
(idx,g') = randomR (0, length xs - 1) g
-- | Wrapper around sample providing the random seed
rSample :: Int -> [t] -> IO [t]
rSample n t = do g <- genRandomSeed
return $ sample g n t
-- | The `sampleF` function takes a random generator, and a fraction and
-- returns subset of size given by fraction
sampleF :: (RandomGen g) => g -> Rational -> [t] -> [t]
sampleF g f xs = sample g l xs
where l = round $ f * fromIntegral (length xs)
-- | The `remElt` function removes element at index specified from a list
remElt :: Int -> [a] -> [a]
remElt idx xs = front ++ ack
where (front,_:ack) = splitAt idx xs
-- | The `swapElts` function swaps two elements in a list given their indices
swapElts :: Int -> Int -> [t] -> [t]
swapElts i j ls = [get k x | (k, x) <- zip [0..length ls - 1] ls]
where get k x | k == i = ls !! j
| k == j = ls !! i
| otherwise = x
-- | The `genSwapped` generates a list of lists where each element has been
-- swapped by another
genSwapped :: [t] -> [[t]]
genSwapped lst = map (\(x:y:_) -> swapElts x y lst) swaplst
where swaplst = choose [0..length lst - 1] 2
-- | Generate a random seed from the time.
genRandomSeed :: IO StdGen
genRandomSeed = liftM (mkStdGen . round) getPOSIXTime
-- | take a function of two args producing a monadic result, and apply it to
-- a pair
curryM :: (t1 -> t2 -> m t) -> (t1, t2) -> m t
curryM fn (a,b) = fn a b
-- | A simple hash
hash :: String -> String
hash s = (if h < 0 then "x" else "y") ++ show (abs h)
where h = H.hash s