module Sound.MIDI.ControllerPrivate where

import Data.Ix (Ix)
import Sound.MIDI.Utility (checkRange,
          enumRandomR, boundedEnumRandom, chooseEnum, )

import Test.QuickCheck (Arbitrary(arbitrary), )
import System.Random (Random(random, randomR), )



{- |
We do not define 'Controller' as enumeration with many constructors,
because some controllers have multiple names and some are undefined.
It is also more efficient this way.
Thus you cannot use @case@ for processing controller types,
but you can use 'Data.List.lookup' instead.

> maybe (putStrLn "unsupported controller") putStrLn $
> lookup ctrl $
>    (portamento, "portamento") :
>    (modulation, "modulation") :
>    []

-}
newtype Controller = Controller {Controller -> Int
fromController :: Int} deriving (Int -> Controller -> ShowS
[Controller] -> ShowS
Controller -> String
(Int -> Controller -> ShowS)
-> (Controller -> String)
-> ([Controller] -> ShowS)
-> Show Controller
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Controller] -> ShowS
$cshowList :: [Controller] -> ShowS
show :: Controller -> String
$cshow :: Controller -> String
showsPrec :: Int -> Controller -> ShowS
$cshowsPrec :: Int -> Controller -> ShowS
Show, Controller -> Controller -> Bool
(Controller -> Controller -> Bool)
-> (Controller -> Controller -> Bool) -> Eq Controller
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Controller -> Controller -> Bool
$c/= :: Controller -> Controller -> Bool
== :: Controller -> Controller -> Bool
$c== :: Controller -> Controller -> Bool
Eq, Eq Controller
Eq Controller
-> (Controller -> Controller -> Ordering)
-> (Controller -> Controller -> Bool)
-> (Controller -> Controller -> Bool)
-> (Controller -> Controller -> Bool)
-> (Controller -> Controller -> Bool)
-> (Controller -> Controller -> Controller)
-> (Controller -> Controller -> Controller)
-> Ord Controller
Controller -> Controller -> Bool
Controller -> Controller -> Ordering
Controller -> Controller -> Controller
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Controller -> Controller -> Controller
$cmin :: Controller -> Controller -> Controller
max :: Controller -> Controller -> Controller
$cmax :: Controller -> Controller -> Controller
>= :: Controller -> Controller -> Bool
$c>= :: Controller -> Controller -> Bool
> :: Controller -> Controller -> Bool
$c> :: Controller -> Controller -> Bool
<= :: Controller -> Controller -> Bool
$c<= :: Controller -> Controller -> Bool
< :: Controller -> Controller -> Bool
$c< :: Controller -> Controller -> Bool
compare :: Controller -> Controller -> Ordering
$ccompare :: Controller -> Controller -> Ordering
$cp1Ord :: Eq Controller
Ord, Ord Controller
Ord Controller
-> ((Controller, Controller) -> [Controller])
-> ((Controller, Controller) -> Controller -> Int)
-> ((Controller, Controller) -> Controller -> Int)
-> ((Controller, Controller) -> Controller -> Bool)
-> ((Controller, Controller) -> Int)
-> ((Controller, Controller) -> Int)
-> Ix Controller
(Controller, Controller) -> Int
(Controller, Controller) -> [Controller]
(Controller, Controller) -> Controller -> Bool
(Controller, Controller) -> Controller -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (Controller, Controller) -> Int
$cunsafeRangeSize :: (Controller, Controller) -> Int
rangeSize :: (Controller, Controller) -> Int
$crangeSize :: (Controller, Controller) -> Int
inRange :: (Controller, Controller) -> Controller -> Bool
$cinRange :: (Controller, Controller) -> Controller -> Bool
unsafeIndex :: (Controller, Controller) -> Controller -> Int
$cunsafeIndex :: (Controller, Controller) -> Controller -> Int
index :: (Controller, Controller) -> Controller -> Int
$cindex :: (Controller, Controller) -> Controller -> Int
range :: (Controller, Controller) -> [Controller]
$crange :: (Controller, Controller) -> [Controller]
$cp1Ix :: Ord Controller
Ix)

toController :: Int -> Controller
toController :: Int -> Controller
toController = String -> (Int -> Controller) -> Int -> Controller
forall a.
(Bounded a, Ord a, Show a) =>
String -> (Int -> a) -> Int -> a
checkRange String
"Controller" Int -> Controller
Controller


instance Random Controller where
   random :: g -> (Controller, g)
random  = g -> (Controller, g)
forall a g. (Enum a, Bounded a, RandomGen g) => g -> (a, g)
boundedEnumRandom
   randomR :: (Controller, Controller) -> g -> (Controller, g)
randomR = (Controller, Controller) -> g -> (Controller, g)
forall a g. (Enum a, RandomGen g) => (a, a) -> g -> (a, g)
enumRandomR

instance Arbitrary Controller where
   arbitrary :: Gen Controller
arbitrary = Gen Controller
forall a. (Enum a, Bounded a, Random a) => Gen a
chooseEnum


instance Enum Controller where
   toEnum :: Int -> Controller
toEnum   = Int -> Controller
toController
   fromEnum :: Controller -> Int
fromEnum = Controller -> Int
fromController

instance Bounded Controller where
   minBound :: Controller
minBound = Int -> Controller
Controller   Int
0
   maxBound :: Controller
maxBound = Int -> Controller
Controller Int
119
   -- higher controller numbers have special meanings