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, )


{-# INLINE checkRange #-}
checkRange :: (Bounded a, Ord a, Show a) =>
   String -> (Int -> a) -> Int -> a
checkRange :: String -> (Int -> a) -> Int -> a
checkRange String
typ Int -> a
f Int
x =
   let y :: a
y = Int -> a
f Int
x
   in  if a
forall a. Bounded a => a
minBound a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
y Bool -> Bool -> Bool
&& a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
forall a. Bounded a => a
maxBound
         then a
y
         else String -> a
forall a. HasCallStack => String -> a
error (String
typ String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": value " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" outside range " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                     (a, a) -> String
forall a. Show a => a -> String
show ((a
forall a. Bounded a => a
minBound, a
forall a. Bounded a => a
maxBound) (a, a) -> (a, a) -> (a, a)
forall a. a -> a -> a
`asTypeOf` (a
y,a
y)))

{-# INLINE loopM #-}
loopM :: Monad m => (a -> Bool) -> m a -> (a -> m ()) -> m a
loopM :: (a -> Bool) -> m a -> (a -> m ()) -> m a
loopM a -> Bool
p m a
preExit a -> m ()
postExit =
   let go :: m a
go =
         m a
preExit m a -> (a -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
x ->
            if a -> Bool
p a
x
              then a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
              else a -> m ()
postExit a
x m () -> m a -> m a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m a
go
   in  m a
go




-- random generators

enumRandomR :: (Enum a, RandomGen g) => (a,a) -> g -> (a,g)
enumRandomR :: (a, a) -> g -> (a, g)
enumRandomR (a
l,a
r) =
   (Int -> a) -> (Int, g) -> (a, g)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst Int -> a
forall a. Enum a => Int -> a
toEnum ((Int, g) -> (a, g)) -> (g -> (Int, g)) -> g -> (a, g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Int) -> g -> (Int, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (a -> Int
forall a. Enum a => a -> Int
fromEnum a
l, a -> Int
forall a. Enum a => a -> Int
fromEnum a
r)

boundedEnumRandom :: (Enum a, Bounded a, RandomGen g) => g -> (a,g)
boundedEnumRandom :: g -> (a, g)
boundedEnumRandom  =  (a, a) -> g -> (a, g)
forall a g. (Enum a, RandomGen g) => (a, a) -> g -> (a, g)
enumRandomR (a
forall a. Bounded a => a
minBound, a
forall a. Bounded a => a
maxBound)

chooseEnum :: (Enum a, Bounded a, Random a) => QC.Gen a
chooseEnum :: Gen a
chooseEnum = (a, a) -> Gen a
forall a. Random a => (a, a) -> Gen a
QC.choose (a
forall a. Bounded a => a
minBound, a
forall a. Bounded a => a
maxBound)


quantityRandomR :: (Random b, RandomGen g) =>
   (a -> b) -> (b -> a) -> (a,a) -> g -> (a,g)
quantityRandomR :: (a -> b) -> (b -> a) -> (a, a) -> g -> (a, g)
quantityRandomR a -> b
fromQuantity b -> a
toQuantity (a
l,a
r) =
   (b -> a) -> (b, g) -> (a, g)
forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst b -> a
toQuantity ((b, g) -> (a, g)) -> (g -> (b, g)) -> g -> (a, g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b, b) -> g -> (b, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (a -> b
fromQuantity a
l, a -> b
fromQuantity a
r)

boundedQuantityRandom :: (Bounded a, Random b, RandomGen g) =>
   (a -> b) -> (b -> a) -> g -> (a,g)
boundedQuantityRandom :: (a -> b) -> (b -> a) -> g -> (a, g)
boundedQuantityRandom a -> b
fromQuantity b -> a
toQuantity =
   (a -> b) -> (b -> a) -> (a, a) -> g -> (a, g)
forall b g a.
(Random b, RandomGen g) =>
(a -> b) -> (b -> a) -> (a, a) -> g -> (a, g)
quantityRandomR a -> b
fromQuantity b -> a
toQuantity (a
forall a. Bounded a => a
minBound, a
forall a. Bounded a => a
maxBound)

chooseQuantity :: (Bounded a, Random b) =>
   (a -> b) -> (b -> a) -> QC.Gen a
chooseQuantity :: (a -> b) -> (b -> a) -> Gen a
chooseQuantity a -> b
fromQuantity b -> a
toQuantity =
   (b -> a) -> Gen b -> Gen a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> a
toQuantity (Gen b -> Gen a) -> Gen b -> Gen a
forall a b. (a -> b) -> a -> b
$ (b, b) -> Gen b
forall a. Random a => (a, a) -> Gen a
QC.choose (a -> b
fromQuantity a
forall a. Bounded a => a
minBound, a -> b
fromQuantity a
forall a. Bounded a => a
maxBound)


newtype ArbChar = ArbChar {ArbChar -> Char
deconsArbChar :: Char}

instance QC.Arbitrary ArbChar where
   arbitrary :: Gen ArbChar
arbitrary =
      (Char -> ArbChar) -> Gen Char -> Gen ArbChar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> ArbChar
ArbChar (Gen Char -> Gen ArbChar) -> Gen Char -> Gen ArbChar
forall a b. (a -> b) -> a -> b
$
      [(Int, Gen Char)] -> Gen Char
forall a. [(Int, Gen a)] -> Gen a
QC.frequency
         [(Int
26, (Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
QC.choose (Char
'a',Char
'z')),
          (Int
26, (Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
QC.choose (Char
'A',Char
'Z')),
          (Int
10, (Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
QC.choose (Char
'0',Char
'9'))]

arbitraryString :: QC.Gen String
arbitraryString :: Gen String
arbitraryString =
   ([ArbChar] -> String) -> Gen [ArbChar] -> Gen String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ArbChar -> Char) -> [ArbChar] -> String
forall a b. (a -> b) -> [a] -> [b]
map ArbChar -> Char
deconsArbChar) Gen [ArbChar]
forall a. Arbitrary a => Gen a
QC.arbitrary


newtype ArbByte = ArbByte {ArbByte -> Word8
deconsArbByte :: Word8}

instance QC.Arbitrary ArbByte where
   arbitrary :: Gen ArbByte
arbitrary =
      (Int -> ArbByte) -> Gen Int -> Gen ArbByte
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word8 -> ArbByte
ArbByte (Word8 -> ArbByte) -> (Int -> Word8) -> Int -> ArbByte
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Gen Int -> Gen ArbByte) -> Gen Int -> Gen ArbByte
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
QC.choose (Int
0,Int
0xFF::Int)

arbitraryByteList :: QC.Gen [Word8] -- ByteList
arbitraryByteList :: Gen [Word8]
arbitraryByteList =
   ([ArbByte] -> [Word8]) -> Gen [ArbByte] -> Gen [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ArbByte -> Word8) -> [ArbByte] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map ArbByte -> Word8
deconsArbByte) Gen [ArbByte]
forall a. Arbitrary a => Gen a
QC.arbitrary