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