module Sound.MIDI.Utility where
import qualified Test.QuickCheck as QC
import System.Random (Random(randomR), RandomGen)
import Data.Tuple.HT (mapFst, )
import Data.Word (Word8, )
checkRange :: (Bounded a, Ord a, Show a) =>
String -> (Int -> a) -> Int -> a
checkRange typ f x =
let y = f x
in if minBound <= y && y <= maxBound
then y
else error (typ ++ ": value " ++ show x ++ " outside range " ++
show ((minBound, maxBound) `asTypeOf` (y,y)))
loopM :: Monad m => (a -> Bool) -> m a -> (a -> m ()) -> m a
loopM p preExit postExit =
let go =
preExit >>= \x ->
if p x
then return x
else postExit x >> go
in go
enumRandomR :: (Enum a, RandomGen g) => (a,a) -> g -> (a,g)
enumRandomR (l,r) =
mapFst toEnum . randomR (fromEnum l, fromEnum r)
boundedEnumRandom :: (Enum a, Bounded a, RandomGen g) => g -> (a,g)
boundedEnumRandom = enumRandomR (minBound, maxBound)
chooseEnum :: (Enum a, Bounded a, Random a) => QC.Gen a
chooseEnum = QC.choose (minBound, maxBound)
quantityRandomR :: (Random b, RandomGen g) =>
(a -> b) -> (b -> a) -> (a,a) -> g -> (a,g)
quantityRandomR fromQuantity toQuantity (l,r) =
mapFst toQuantity . randomR (fromQuantity l, fromQuantity r)
boundedQuantityRandom :: (Bounded a, Random b, RandomGen g) =>
(a -> b) -> (b -> a) -> g -> (a,g)
boundedQuantityRandom fromQuantity toQuantity =
quantityRandomR fromQuantity toQuantity (minBound, maxBound)
chooseQuantity :: (Bounded a, Random b) =>
(a -> b) -> (b -> a) -> QC.Gen a
chooseQuantity fromQuantity toQuantity =
fmap toQuantity $ QC.choose (fromQuantity minBound, fromQuantity maxBound)
newtype ArbChar = ArbChar {deconsArbChar :: Char}
instance QC.Arbitrary ArbChar where
arbitrary =
fmap ArbChar $
QC.frequency
[(26, QC.choose ('a','z')),
(26, QC.choose ('A','Z')),
(10, QC.choose ('0','9'))]
arbitraryString :: QC.Gen String
arbitraryString =
fmap (map deconsArbChar) QC.arbitrary
newtype ArbByte = ArbByte {deconsArbByte :: Word8}
instance QC.Arbitrary ArbByte where
arbitrary =
fmap (ArbByte . fromIntegral) $ QC.choose (0,0xFF::Int)
arbitraryByteList :: QC.Gen [Word8]
arbitraryByteList =
fmap (map deconsArbByte) QC.arbitrary