{- |
Parser which handles the running state
that is used in MIDI messages in realtime and files.
The running state consists of a message code and the message channel.
-}
module Sound.MIDI.Parser.Status
   (T, Status, set, get, run, lift,
    Channel, fromChannel, toChannel, ) where

import qualified Sound.MIDI.Parser.Class as Parser

import qualified Control.Monad.Exception.Synchronous  as Sync
import qualified Control.Monad.Trans.State as State
import qualified Control.Monad.Trans.Class as Trans
import Control.Monad.Trans.State (StateT, evalStateT, )
import Control.Monad (liftM, )

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

import Sound.MIDI.Utility (checkRange, )
import Data.Ix (Ix)


{- |
The 'T' monad parses a track of a MIDI File.
In MIDI, a shortcut is used for long strings of similar MIDI events:
If a stream of consecutive events all have the same type and channel,
the type and channel can be omitted for all but the first event.
To implement this /feature/,
the parser must keep track of the type and channel of the most recent MIDI Event.
This is done by managing a 'Status' in the parser.
-}
type T parser = StateT Status parser

type Status = Maybe (Int,Channel)


set :: Monad parser => Status -> Parser.Fragile (T parser) ()
set :: forall (parser :: * -> *).
Monad parser =>
Status -> Fragile (T parser) ()
set = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) s. Monad m => s -> StateT s m ()
State.put

get :: Monad parser => Parser.Fragile (T parser) Status
get :: forall (parser :: * -> *).
Monad parser =>
Fragile (T parser) Status
get = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift forall (m :: * -> *) s. Monad m => StateT s m s
State.get

run :: Monad parser => T parser a -> parser a
run :: forall (parser :: * -> *) a. Monad parser => T parser a -> parser a
run = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT forall a. Maybe a
Nothing


lift :: Monad parser => Parser.Fragile parser a -> Parser.Fragile (T parser) a
lift :: forall (parser :: * -> *) a.
Monad parser =>
Fragile parser a -> Fragile (T parser) a
lift = forall (m :: * -> *) e0 a (n :: * -> *) e1 b.
(m (Exceptional e0 a) -> n (Exceptional e1 b))
-> ExceptionalT e0 m a -> ExceptionalT e1 n b
Sync.mapExceptionalT forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
Trans.lift


-- * Channel definition

{- |
This definition should be in Message.Channel,
but this results in a cyclic import.
-}
newtype Channel = Channel {Channel -> Int
fromChannel :: Int} deriving (Int -> Channel -> ShowS
[Channel] -> ShowS
Channel -> UserMessage
forall a.
(Int -> a -> ShowS)
-> (a -> UserMessage) -> ([a] -> ShowS) -> Show a
showList :: [Channel] -> ShowS
$cshowList :: [Channel] -> ShowS
show :: Channel -> UserMessage
$cshow :: Channel -> UserMessage
showsPrec :: Int -> Channel -> ShowS
$cshowsPrec :: Int -> Channel -> ShowS
Show, Channel -> Channel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Channel -> Channel -> Bool
$c/= :: Channel -> Channel -> Bool
== :: Channel -> Channel -> Bool
$c== :: Channel -> Channel -> Bool
Eq, Eq Channel
Channel -> Channel -> Bool
Channel -> Channel -> Ordering
Channel -> Channel -> Channel
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 :: Channel -> Channel -> Channel
$cmin :: Channel -> Channel -> Channel
max :: Channel -> Channel -> Channel
$cmax :: Channel -> Channel -> Channel
>= :: Channel -> Channel -> Bool
$c>= :: Channel -> Channel -> Bool
> :: Channel -> Channel -> Bool
$c> :: Channel -> Channel -> Bool
<= :: Channel -> Channel -> Bool
$c<= :: Channel -> Channel -> Bool
< :: Channel -> Channel -> Bool
$c< :: Channel -> Channel -> Bool
compare :: Channel -> Channel -> Ordering
$ccompare :: Channel -> Channel -> Ordering
Ord, Ord Channel
(Channel, Channel) -> Int
(Channel, Channel) -> [Channel]
(Channel, Channel) -> Channel -> Bool
(Channel, Channel) -> Channel -> 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 :: (Channel, Channel) -> Int
$cunsafeRangeSize :: (Channel, Channel) -> Int
rangeSize :: (Channel, Channel) -> Int
$crangeSize :: (Channel, Channel) -> Int
inRange :: (Channel, Channel) -> Channel -> Bool
$cinRange :: (Channel, Channel) -> Channel -> Bool
unsafeIndex :: (Channel, Channel) -> Channel -> Int
$cunsafeIndex :: (Channel, Channel) -> Channel -> Int
index :: (Channel, Channel) -> Channel -> Int
$cindex :: (Channel, Channel) -> Channel -> Int
range :: (Channel, Channel) -> [Channel]
$crange :: (Channel, Channel) -> [Channel]
Ix)

toChannel :: Int -> Channel
toChannel :: Int -> Channel
toChannel = forall a.
(Bounded a, Ord a, Show a) =>
UserMessage -> (Int -> a) -> Int -> a
checkRange UserMessage
"Channel" Int -> Channel
Channel

instance Enum Channel where
   toEnum :: Int -> Channel
toEnum   = Int -> Channel
toChannel
   fromEnum :: Channel -> Int
fromEnum = Channel -> Int
fromChannel

instance Bounded Channel where
   minBound :: Channel
minBound = Int -> Channel
Channel  Int
0
   maxBound :: Channel
maxBound = Int -> Channel
Channel Int
15

instance Arbitrary Channel where
   arbitrary :: Gen Channel
arbitrary = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Int -> Channel
toChannel forall a b. (a -> b) -> a -> b
$ forall a. Random a => (a, a) -> Gen a
QC.choose (Int
0,Int
15)
   shrink :: Channel -> [Channel]
shrink = forall a b. (a -> b) -> [a] -> [b]
map (Int -> Channel
toChannel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. Integral a => a -> a -> a
mod Int
16) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Arbitrary a => a -> [a]
shrink forall b c a. (b -> c) -> (a -> b) -> a -> c
. Channel -> Int
fromChannel