{- |
Channel mode messages
-}
module Sound.MIDI.Message.Channel.Mode
    (T(..), get, put,
     fromControllerValue, toControllerValue, ) where

import           Sound.MIDI.Parser.Primitive
import qualified Sound.MIDI.Parser.Class as Parser

import qualified Sound.MIDI.Writer.Basic as Writer

import Sound.MIDI.Parser.Report (UserMessage, )

import qualified Control.Monad.Exception.Asynchronous as Async
import Data.Maybe.HT (toMaybe, )
import Control.Monad.Trans.Class (lift, )
import Control.Monad (liftM, )

import Test.QuickCheck (Arbitrary(arbitrary), )
import qualified Test.QuickCheck as QC



data T =
     AllSoundOff
   | ResetAllControllers
   | LocalControl Bool
   | AllNotesOff
   | OmniMode Bool
   | MonoMode Int
   | PolyMode
     deriving (Int -> T -> ShowS
[T] -> ShowS
T -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [T] -> ShowS
$cshowList :: [T] -> ShowS
show :: T -> String
$cshow :: T -> String
showsPrec :: Int -> T -> ShowS
$cshowsPrec :: Int -> T -> ShowS
Show, T -> T -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: T -> T -> Bool
$c/= :: T -> T -> Bool
== :: T -> T -> Bool
$c== :: T -> T -> Bool
Eq, Eq T
T -> T -> Bool
T -> T -> Ordering
T -> T -> T
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 :: T -> T -> T
$cmin :: T -> T -> T
max :: T -> T -> T
$cmax :: T -> T -> T
>= :: T -> T -> Bool
$c>= :: T -> T -> Bool
> :: T -> T -> Bool
$c> :: T -> T -> Bool
<= :: T -> T -> Bool
$c<= :: T -> T -> Bool
< :: T -> T -> Bool
$c< :: T -> T -> Bool
compare :: T -> T -> Ordering
$ccompare :: T -> T -> Ordering
Ord)

instance Arbitrary T where
   arbitrary :: Gen T
arbitrary =
      forall a. [Gen a] -> Gen a
QC.oneof forall a b. (a -> b) -> a -> b
$
         forall (m :: * -> *) a. Monad m => a -> m a
return T
AllSoundOff forall a. a -> [a] -> [a]
:
         forall (m :: * -> *) a. Monad m => a -> m a
return T
ResetAllControllers forall a. a -> [a] -> [a]
:
         forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  Bool -> T
LocalControl forall a. Arbitrary a => Gen a
arbitrary forall a. a -> [a] -> [a]
:
         forall (m :: * -> *) a. Monad m => a -> m a
return T
AllNotesOff forall a. a -> [a] -> [a]
:
         forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  Bool -> T
OmniMode forall a. Arbitrary a => Gen a
arbitrary forall a. a -> [a] -> [a]
:
         forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  Int -> T
MonoMode (forall a. Random a => (a, a) -> Gen a
QC.choose (Int
0,Int
16)) forall a. a -> [a] -> [a]
:
         forall (m :: * -> *) a. Monad m => a -> m a
return T
PolyMode forall a. a -> [a] -> [a]
:
         []


-- * serialization

get :: Parser.C parser => Int -> Parser.Fragile parser T
get :: forall (parser :: * -> *). C parser => Int -> Fragile parser T
get Int
mode =
   do Int
x <- forall (parser :: * -> *). C parser => Fragile parser Int
get1
      forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (parser :: * -> *) a.
C parser =>
PossiblyIncomplete a -> parser a
Parser.warnIncomplete forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall e a. Maybe e -> a -> Exceptional e a
Async.Exceptional forall a b. (a -> b) -> a -> b
$ forall a. (Show a, Integral a) => (a, a) -> (Maybe String, T)
fromControllerValue (Int
mode,Int
x)

{- |
This function is also used in alsa-midi,
we could give it the result type @Parser.PossiblyIncomplete T@ otherwise.
-}
fromControllerValue :: (Show a, Integral a) => (a, a) -> (Maybe UserMessage, T)
fromControllerValue :: forall a. (Show a, Integral a) => (a, a) -> (Maybe String, T)
fromControllerValue (a
mode,a
x) =
   case a
mode of
      a
0x78 ->
         (forall a.
(Show a, Integral a) =>
String -> [a] -> a -> Maybe String
checkValidValue String
"AllSoundOff" [a
0] a
x,
          T
AllSoundOff)
      a
0x79 ->
         (forall a.
(Show a, Integral a) =>
String -> [a] -> a -> Maybe String
checkValidValue String
"ResetAllControllers" [a
0] a
x,
          T
ResetAllControllers)
      a
0x7A ->
         (forall a.
(Show a, Integral a) =>
String -> [a] -> a -> Maybe String
checkValidValue String
"LocalControl" [a
0,a
127] a
x,
          Bool -> T
LocalControl (a
xforall a. Eq a => a -> a -> Bool
/=a
0))
      a
0x7B ->
         (forall a.
(Show a, Integral a) =>
String -> [a] -> a -> Maybe String
checkValidValue String
"AllNotesOff" [a
0] a
x,
          T
AllNotesOff)
      a
0x7C ->
         (forall a.
(Show a, Integral a) =>
String -> [a] -> a -> Maybe String
checkValidValue String
"OmniMode Off" [a
0] a
x,
          Bool -> T
OmniMode Bool
False)
      a
0x7D ->
         (forall a.
(Show a, Integral a) =>
String -> [a] -> a -> Maybe String
checkValidValue String
"OmniMode On" [a
0] a
x,
          Bool -> T
OmniMode Bool
True)
      a
0x7E ->
         (forall a. Maybe a
Nothing, Int -> T
MonoMode (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x))
      a
0x7F ->
         (forall a.
(Show a, Integral a) =>
String -> [a] -> a -> Maybe String
checkValidValue String
"PolyMode On" [a
0] a
x,
          T
PolyMode)
      a
_ -> forall a. HasCallStack => String -> a
error (String
"Channel.Mode.get: mode value out of range: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
mode)


checkValidValue ::
   (Show a, Integral a) => String -> [a] -> a -> Maybe UserMessage
checkValidValue :: forall a.
(Show a, Integral a) =>
String -> [a] -> a -> Maybe String
checkValidValue String
name [a]
validValues a
value =
   forall a. Bool -> a -> Maybe a
toMaybe
      (Bool -> Bool
not (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem a
value [a]
validValues))
      (String
"Invalid value for " forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
value)


put :: Writer.C writer => T -> writer
put :: forall writer. C writer => T -> writer
put T
mode =
   let (Word8
code, Word8
value) = forall a. Integral a => T -> (a, a)
toControllerValue T
mode
   in  forall writer. C writer => ByteList -> writer
Writer.putByteList [Word8
code, Word8
value]

toControllerValue :: Integral a => T -> (a, a)
toControllerValue :: forall a. Integral a => T -> (a, a)
toControllerValue T
mode =
   case T
mode of
      T
AllSoundOff         -> (,) a
0x78 a
0
      T
ResetAllControllers -> (,) a
0x79 a
0
      LocalControl Bool
b      -> (,) a
0x7A (if Bool
b then a
127 else a
0)
      T
AllNotesOff         -> (,) a
0x7B a
0
      OmniMode Bool
b          -> (,) (if Bool
b then a
0x7D else a
0x7C) a
0
      MonoMode Int
x          -> (,) a
0x7E (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
      T
PolyMode            -> (,) a
0x7F a
0