module Sound.MIDI.MachineControl (
   splitCommandList,

   getCommand,
   getCommands,

   Command (
      Stop,
      Play,
      DeferredPlay,
      FastForward,
      Rewind,
      RecordStrobe,
      RecordExit,
      RecordPause,
      Pause,
      Eject,
      Chase,
      CommandErrorReset,
      Reset,
      Wait,
      Resume
      {-
      I will export more constructors, when I am sure,
      that their definition is reasonable.
      -}
      ),

   runParser,

   ) where

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

import Sound.MIDI.IO (ByteList, )

import qualified Numeric.NonNegative.Wrapper as NonNeg

import qualified Control.Monad.Trans.Writer as MW
import qualified Control.Monad.Trans.State as MS
import Control.Monad (liftM, liftM2, liftM3, )

import Data.List (unfoldr, )
import Data.Tuple.HT (mapFst, )
import Data.Bool.HT (if', )
import Data.Word (Word8, )
import Data.Maybe (isNothing, catMaybes, )


-- * serialization

splitCommandList :: [Word8] -> [(Word8, [Word8])]
splitCommandList :: [Word8] -> [(Word8, [Word8])]
splitCommandList =
   forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr forall a b. (a -> b) -> a -> b
$ \[Word8]
xt ->
      case [Word8]
xt of
         [] -> forall a. Maybe a
Nothing
         Word8
x:[Word8]
xs ->
            forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ (forall a c b. (a -> c) -> (a, b) -> (c, b)
mapFst ((,) Word8
x)) forall a b. (a -> b) -> a -> b
$
            forall a. Bool -> a -> a -> a
if' (Word8
xforall a. Eq a => a -> a -> Bool
==Word8
0 Bool -> Bool -> Bool
|| Word8
xforall a. Eq a => a -> a -> Bool
==Word8
0xF7) ([Word8]
xs, []) forall a b. (a -> b) -> a -> b
$
            forall a. Bool -> a -> a -> a
if' (Word8
0x40 forall a. Ord a => a -> a -> Bool
<= Word8
x Bool -> Bool -> Bool
&& Word8
x forall a. Ord a => a -> a -> Bool
< Word8
0x78)
                   (case [Word8]
xs of
                      [] -> ([], [])
                      Word8
n:[Word8]
ys -> forall a. Int -> [a] -> ([a], [a])
splitAt (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n) [Word8]
ys) forall a b. (a -> b) -> a -> b
$
            ([], [Word8]
xs)


data Command =
     Stop
   | Play
   | DeferredPlay
   | FastForward
   | Rewind
   | RecordStrobe
   | RecordExit
   | RecordPause
   | Pause
   | Eject
   | Chase
   | CommandErrorReset
   | Reset

   | Write ByteList
   | MaskedWrite ByteList
   | Read ByteList
   | Update ByteList
   | Locate ByteList
   | VariablePlay Word8 Word8 Word8
   | Search Word8 Word8 Word8
   | Shuttle Word8 Word8 Word8
   | Step Word8
   | AssignSystemMaster Word8
   | GeneratorCommand Word8
   | MIDITimeCodeCommand Word8
   | Move Word8 Word8
   | Add Word8 Word8 Word8
   | Subtract Word8 Word8 Word8
   | DropFrameAdjust Word8
   | Procedure ByteList
   | Event ByteList
   | Group ByteList
   | CommandSegment ByteList
   | DeferredVariablePlay ByteList
   | RecordStrobeVariable ByteList

   | Wait
   | Resume

   | GenericNoData Word8
   | GenericVariableLength Word8 ByteList
   deriving (Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Command] -> ShowS
$cshowList :: [Command] -> ShowS
show :: Command -> String
$cshow :: Command -> String
showsPrec :: Int -> Command -> ShowS
$cshowsPrec :: Int -> Command -> ShowS
Show)


{- |
Read MIDI machine control commands
until an F7 marker for SysEx end.
-}
getCommands :: Parser.C parser => Parser.Partial parser [Command]
getCommands :: forall (parser :: * -> *). C parser => Partial parser [Command]
getCommands =
   forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [Maybe a] -> [a]
catMaybes) forall a b. (a -> b) -> a -> b
$
   forall (parser :: * -> *) a.
EndCheck parser =>
(a -> Bool) -> Fragile parser a -> Partial parser [a]
Parser.until forall a. Maybe a -> Bool
isNothing forall a b. (a -> b) -> a -> b
$ do
      Word8
code <- forall (parser :: * -> *). C parser => Fragile parser Word8
getByte
      if Word8
code forall a. Eq a => a -> a -> Bool
== Word8
0xF7
        then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        else forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (parser :: * -> *).
C parser =>
Word8 -> Fragile parser Command
getCommand Word8
code

getCommand :: Parser.C parser => Word8 -> Parser.Fragile parser Command
getCommand :: forall (parser :: * -> *).
C parser =>
Word8 -> Fragile parser Command
getCommand Word8
code =
   let fetchMany :: ([Word8] -> r) -> ExceptionalT String parser r
fetchMany [Word8] -> r
f = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [Word8] -> r
f forall a b. (a -> b) -> a -> b
$ forall (parser :: * -> *).
C parser =>
Int -> Fragile parser [Word8]
getN forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Ord a, Num a) => String -> a -> T a
NonNeg.fromNumberMsg String
"Midi.get1" forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (parser :: * -> *). C parser => Fragile parser Int
get1
       fetchN :: Int -> ExceptionalT String parser b -> ExceptionalT String parser b
fetchN Int
reqLen ExceptionalT String parser b
act = do
          Int
len <- forall (parser :: * -> *). C parser => Fragile parser Int
get1
          if Int
lenforall a. Eq a => a -> a -> Bool
==Int
reqLen
            then ExceptionalT String parser b
act
            else forall (m :: * -> *) a. Monad m => String -> T m a
Parser.giveUp forall a b. (a -> b) -> a -> b
$
                 String
"expect " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
reqLen forall a. [a] -> [a] -> [a]
++
                 String
" argument(s) for command " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word8
code forall a. [a] -> [a] -> [a]
++
                 String
", but got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
len
       fetch1 :: (Word8 -> b) -> ExceptionalT String parser b
fetch1 Word8 -> b
f = forall {parser :: * -> *} {b}.
C parser =>
Int -> ExceptionalT String parser b -> ExceptionalT String parser b
fetchN Int
1 (forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM  Word8 -> b
f forall (parser :: * -> *). C parser => Fragile parser Word8
getByte)
       fetch2 :: (Word8 -> Word8 -> b) -> ExceptionalT String parser b
fetch2 Word8 -> Word8 -> b
f = forall {parser :: * -> *} {b}.
C parser =>
Int -> ExceptionalT String parser b -> ExceptionalT String parser b
fetchN Int
2 (forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 Word8 -> Word8 -> b
f forall (parser :: * -> *). C parser => Fragile parser Word8
getByte forall (parser :: * -> *). C parser => Fragile parser Word8
getByte)
       fetch3 :: (Word8 -> Word8 -> Word8 -> b) -> ExceptionalT String parser b
fetch3 Word8 -> Word8 -> Word8 -> b
f = forall {parser :: * -> *} {b}.
C parser =>
Int -> ExceptionalT String parser b -> ExceptionalT String parser b
fetchN Int
3 (forall (m :: * -> *) a1 a2 a3 r.
Monad m =>
(a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM3 Word8 -> Word8 -> Word8 -> b
f forall (parser :: * -> *). C parser => Fragile parser Word8
getByte forall (parser :: * -> *). C parser => Fragile parser Word8
getByte forall (parser :: * -> *). C parser => Fragile parser Word8
getByte)

   in  case Word8
code of
          Word8
0x01 -> forall (m :: * -> *) a. Monad m => a -> m a
return Command
Stop
          Word8
0x02 -> forall (m :: * -> *) a. Monad m => a -> m a
return Command
Play
          Word8
0x03 -> forall (m :: * -> *) a. Monad m => a -> m a
return Command
DeferredPlay
          Word8
0x04 -> forall (m :: * -> *) a. Monad m => a -> m a
return Command
FastForward
          Word8
0x05 -> forall (m :: * -> *) a. Monad m => a -> m a
return Command
Rewind
          Word8
0x06 -> forall (m :: * -> *) a. Monad m => a -> m a
return Command
RecordStrobe
          Word8
0x07 -> forall (m :: * -> *) a. Monad m => a -> m a
return Command
RecordExit
          Word8
0x08 -> forall (m :: * -> *) a. Monad m => a -> m a
return Command
RecordPause
          Word8
0x09 -> forall (m :: * -> *) a. Monad m => a -> m a
return Command
Pause
          Word8
0x0A -> forall (m :: * -> *) a. Monad m => a -> m a
return Command
Eject
          Word8
0x0B -> forall (m :: * -> *) a. Monad m => a -> m a
return Command
Chase
          Word8
0x0C -> forall (m :: * -> *) a. Monad m => a -> m a
return Command
CommandErrorReset
          Word8
0x0D -> forall (m :: * -> *) a. Monad m => a -> m a
return Command
Reset

          Word8
0x40 -> forall {parser :: * -> *} {r}.
C parser =>
([Word8] -> r) -> ExceptionalT String parser r
fetchMany [Word8] -> Command
Write
          Word8
0x41 -> forall {parser :: * -> *} {r}.
C parser =>
([Word8] -> r) -> ExceptionalT String parser r
fetchMany [Word8] -> Command
MaskedWrite
          Word8
0x42 -> forall {parser :: * -> *} {r}.
C parser =>
([Word8] -> r) -> ExceptionalT String parser r
fetchMany [Word8] -> Command
Read
          Word8
0x43 -> forall {parser :: * -> *} {r}.
C parser =>
([Word8] -> r) -> ExceptionalT String parser r
fetchMany [Word8] -> Command
Update
          Word8
0x44 -> forall {parser :: * -> *} {r}.
C parser =>
([Word8] -> r) -> ExceptionalT String parser r
fetchMany [Word8] -> Command
Locate
          Word8
0x45 -> forall {parser :: * -> *} {b}.
C parser =>
(Word8 -> Word8 -> Word8 -> b) -> ExceptionalT String parser b
fetch3 Word8 -> Word8 -> Word8 -> Command
VariablePlay
          Word8
0x46 -> forall {parser :: * -> *} {b}.
C parser =>
(Word8 -> Word8 -> Word8 -> b) -> ExceptionalT String parser b
fetch3 Word8 -> Word8 -> Word8 -> Command
Search
          Word8
0x47 -> forall {parser :: * -> *} {b}.
C parser =>
(Word8 -> Word8 -> Word8 -> b) -> ExceptionalT String parser b
fetch3 Word8 -> Word8 -> Word8 -> Command
Shuttle
          Word8
0x48 -> forall {parser :: * -> *} {b}.
C parser =>
(Word8 -> b) -> ExceptionalT String parser b
fetch1 Word8 -> Command
Step
          Word8
0x49 -> forall {parser :: * -> *} {b}.
C parser =>
(Word8 -> b) -> ExceptionalT String parser b
fetch1 Word8 -> Command
AssignSystemMaster
          Word8
0x4A -> forall {parser :: * -> *} {b}.
C parser =>
(Word8 -> b) -> ExceptionalT String parser b
fetch1 Word8 -> Command
GeneratorCommand
          Word8
0x4B -> forall {parser :: * -> *} {b}.
C parser =>
(Word8 -> b) -> ExceptionalT String parser b
fetch1 Word8 -> Command
MIDITimeCodeCommand
          Word8
0x4C -> forall {parser :: * -> *} {b}.
C parser =>
(Word8 -> Word8 -> b) -> ExceptionalT String parser b
fetch2 Word8 -> Word8 -> Command
Move
          Word8
0x4D -> forall {parser :: * -> *} {b}.
C parser =>
(Word8 -> Word8 -> Word8 -> b) -> ExceptionalT String parser b
fetch3 Word8 -> Word8 -> Word8 -> Command
Add
          Word8
0x4E -> forall {parser :: * -> *} {b}.
C parser =>
(Word8 -> Word8 -> Word8 -> b) -> ExceptionalT String parser b
fetch3 Word8 -> Word8 -> Word8 -> Command
Subtract
          Word8
0x4F -> forall {parser :: * -> *} {b}.
C parser =>
(Word8 -> b) -> ExceptionalT String parser b
fetch1 Word8 -> Command
DropFrameAdjust
          Word8
0x50 -> forall {parser :: * -> *} {r}.
C parser =>
([Word8] -> r) -> ExceptionalT String parser r
fetchMany [Word8] -> Command
Procedure
          Word8
0x51 -> forall {parser :: * -> *} {r}.
C parser =>
([Word8] -> r) -> ExceptionalT String parser r
fetchMany [Word8] -> Command
Event
          Word8
0x52 -> forall {parser :: * -> *} {r}.
C parser =>
([Word8] -> r) -> ExceptionalT String parser r
fetchMany [Word8] -> Command
Group
          Word8
0x53 -> forall {parser :: * -> *} {r}.
C parser =>
([Word8] -> r) -> ExceptionalT String parser r
fetchMany [Word8] -> Command
CommandSegment
          Word8
0x54 -> forall {parser :: * -> *} {r}.
C parser =>
([Word8] -> r) -> ExceptionalT String parser r
fetchMany [Word8] -> Command
DeferredVariablePlay
          Word8
0x55 -> forall {parser :: * -> *} {r}.
C parser =>
([Word8] -> r) -> ExceptionalT String parser r
fetchMany [Word8] -> Command
RecordStrobeVariable

          Word8
0x7C -> forall (m :: * -> *) a. Monad m => a -> m a
return Command
Wait
          Word8
0x7F -> forall (m :: * -> *) a. Monad m => a -> m a
return Command
Resume

          Word8
0x00 -> forall (m :: * -> *) a. Monad m => String -> T m a
Parser.giveUp String
"encountered command zero"
          Word8
0xF7 -> forall (m :: * -> *) a. Monad m => String -> T m a
Parser.giveUp String
"end of SysEx" -- should be handled by the caller

          Word8
_ ->
             forall a. Bool -> a -> a -> a
if' (Word8
0x40 forall a. Ord a => a -> a -> Bool
<= Word8
code Bool -> Bool -> Bool
&& Word8
code forall a. Ord a => a -> a -> Bool
< Word8
0x78)
                (forall {parser :: * -> *} {r}.
C parser =>
([Word8] -> r) -> ExceptionalT String parser r
fetchMany forall a b. (a -> b) -> a -> b
$ Word8 -> [Word8] -> Command
GenericVariableLength Word8
code)
                (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word8 -> Command
GenericNoData Word8
code)

runParser ::
   Parser.Partial (SP.T SP.ByteList) a ->
   ByteList ->
   (SP.PossiblyIncomplete a, [SP.UserMessage])
runParser :: forall a.
Partial (T ByteList) a
-> [Word8] -> (PossiblyIncomplete a, [String])
runParser Partial (T ByteList) a
p =
   forall s a. State s a -> s -> a
MS.evalState (forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
MW.runWriterT forall a b. (a -> b) -> a -> b
$ forall str a. T str a -> T (State str) a
SP.decons Partial (T ByteList) a
p) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   [Word8] -> ByteList
SP.ByteList