    module Sound.MIDI.Utility where

    import qualified Test.QuickCheck as QC
    import System.Random (Random(randomR), RandomGen)
    import Data.Word(Word8)

    {-# INLINE mapFst #-}
    mapFst :: (a -> c) -> (a,b) -> (c,b)
    mapFst f ~(x,y) = (f x, y)

    {-# INLINE mapSnd #-}
    mapSnd :: (b -> d) -> (a,b) -> (a,d)
    mapSnd g ~(x,y) = (x, g y)

    {-# INLINE fst3 #-}
    fst3 :: (a,b,c) -> a
    fst3 (x,_,_) = x

    {-# INLINE snd3 #-}
    snd3 :: (a,b,c) -> b
    snd3 (_,x,_) = x

    {-# INLINE thd3 #-}
    thd3 :: (a,b,c) -> c
    thd3 (_,_,x) = x

    {-# INLINE toMaybe #-}
    toMaybe :: Bool -> a -> Maybe a
    toMaybe False _ = Nothing
    toMaybe True  x = Just x

    {-# INLINE swap #-}
    swap :: (a,b) -> (b,a)
    swap (a,b) = (b,a)

    {-# INLINE checkRange #-}
    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)))

    {-# INLINE viewR #-}
    viewR :: [a] -> Maybe ([a], a)
    viewR =
       foldr (\x mxs -> Just (maybe ([],x) (mapFst (x:)) mxs)) Nothing

    {-# INLINE dropMatch #-}
    dropMatch :: [b] -> [a] -> [a]
    dropMatch xs ys =
       snd $ head $
       dropWhile (not . null . fst) $
       zip (iterate (drop 1) xs) (iterate (drop 1) ys)

    {-# INLINE untilM #-}
    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

    {-# INLINE loopM #-}
    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

    -- random generators

    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] -- ByteList
    arbitraryByteList =
       fmap (map deconsArbByte) QC.arbitrary