module Sound.MIDI.Utility where
import qualified Test.QuickCheck as QC
import System.Random (Random(randomR), RandomGen)
import Data.Word(Word8)
mapFst :: (a -> c) -> (a,b) -> (c,b)
mapFst f ~(x,y) = (f x, y)
mapSnd :: (b -> d) -> (a,b) -> (a,d)
mapSnd g ~(x,y) = (x, g y)
fst3 :: (a,b,c) -> a
fst3 (x,_,_) = x
snd3 :: (a,b,c) -> b
snd3 (_,x,_) = x
thd3 :: (a,b,c) -> c
thd3 (_,_,x) = x
toMaybe :: Bool -> a -> Maybe a
toMaybe False _ = Nothing
toMaybe True x = Just x
swap :: (a,b) -> (b,a)
swap (a,b) = (b,a)
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)))
viewR :: [a] -> Maybe ([a], a)
viewR =
foldr (\x mxs -> Just (maybe ([],x) (mapFst (x:)) mxs)) Nothing
dropMatch :: [b] -> [a] -> [a]
dropMatch xs ys =
snd $ head $
dropWhile (not . null . fst) $
zip (iterate (drop 1) xs) (iterate (drop 1) ys)
untilM :: Monad m => (a -> Bool) -> m a -> m a
untilM p act =
let go =
act >>= \x ->
if p x
then return x
else go
in go
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