{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}


module Fadno.Midi where

import Sound.MIDI.File as MFile
import Data.EventList.Relative.TimeBody as EList hiding (concat,traverse)
import Sound.MIDI.File.Event as MEvent
import Sound.MIDI.File.Event.Meta as MMeta
import Sound.MIDI.Message.Channel as MChan
import Sound.MIDI.Message.Channel.Voice as MVoice
import Sound.MIDI.File.Load
import Sound.MIDI.File.Save
import Sound.MIDI.General
import Fadno.Note
import Data.List (mapAccumL)
import Control.Lens
import Control.Arrow
import System.Process
import Control.Monad

-- | Serializable midi data.
type MidiData = MFile.T

type IPitch = Int
type IDur = Int

-- | Convert some note value to midi-ready values.
class MidiNotes a where
    toMidiNotes :: a -> [([IPitch],IDur)]

instance MidiNotes [([IPitch],IDur)] where toMidiNotes :: [([Int], Int)] -> [([Int], Int)]
toMidiNotes = [([Int], Int)] -> [([Int], Int)]
forall a. a -> a
id

instance {-# OVERLAPPING #-} (Integral p, Traversable c, Integral d, Traversable t) => MidiNotes (t (Note (c p) d))  where
    toMidiNotes :: t (Note (c p) d) -> [([Int], Int)]
toMidiNotes = ((c p, d) -> ([Int], Int)) -> [(c p, d)] -> [([Int], Int)]
forall a b. (a -> b) -> [a] -> [b]
map (((p -> Int) -> [p] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map p -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([p] -> [Int]) -> (c p -> [p]) -> c p -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo [p]) (c p) p -> c p -> [p]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf Getting (Endo [p]) (c p) p
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> c a -> f (c b)
traverse) (c p -> [Int]) -> (d -> Int) -> (c p, d) -> ([Int], Int)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** d -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([(c p, d)] -> [([Int], Int)])
-> (t (Note (c p) d) -> [(c p, d)])
-> t (Note (c p) d)
-> [([Int], Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                  Getting (Endo [(c p, d)]) (t (Note (c p) d)) (c p, d)
-> t (Note (c p) d) -> [(c p, d)]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf ((Note (c p) d -> Const (Endo [(c p, d)]) (Note (c p) d))
-> t (Note (c p) d) -> Const (Endo [(c p, d)]) (t (Note (c p) d))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b)
traverse((Note (c p) d -> Const (Endo [(c p, d)]) (Note (c p) d))
 -> t (Note (c p) d) -> Const (Endo [(c p, d)]) (t (Note (c p) d)))
-> (((c p, d) -> Const (Endo [(c p, d)]) (c p, d))
    -> Note (c p) d -> Const (Endo [(c p, d)]) (Note (c p) d))
-> Getting (Endo [(c p, d)]) (t (Note (c p) d)) (c p, d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((c p, d) -> Const (Endo [(c p, d)]) (c p, d))
-> Note (c p) d -> Const (Endo [(c p, d)]) (Note (c p) d)
forall p1 d (p2 :: * -> * -> *) (f :: * -> *).
(Profunctor p2, Functor f) =>
p2 (p1, d) (f (p1, d)) -> p2 (Note p1 d) (f (Note p1 d))
toPair)

instance (Integral p, Integral d, Traversable t) => MidiNotes (t (Note p d))  where
    toMidiNotes :: t (Note p d) -> [([Int], Int)]
toMidiNotes = ((p, d) -> ([Int], Int)) -> [(p, d)] -> [([Int], Int)]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> [Int]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return(Int -> [Int]) -> (p -> Int) -> p -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.p -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (p -> [Int]) -> (d -> Int) -> (p, d) -> ([Int], Int)
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** d -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([(p, d)] -> [([Int], Int)])
-> (t (Note p d) -> [(p, d)]) -> t (Note p d) -> [([Int], Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo [(p, d)]) (t (Note p d)) (p, d)
-> t (Note p d) -> [(p, d)]
forall a s. Getting (Endo [a]) s a -> s -> [a]
toListOf ((Note p d -> Const (Endo [(p, d)]) (Note p d))
-> t (Note p d) -> Const (Endo [(p, d)]) (t (Note p d))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b)
traverse((Note p d -> Const (Endo [(p, d)]) (Note p d))
 -> t (Note p d) -> Const (Endo [(p, d)]) (t (Note p d)))
-> (((p, d) -> Const (Endo [(p, d)]) (p, d))
    -> Note p d -> Const (Endo [(p, d)]) (Note p d))
-> Getting (Endo [(p, d)]) (t (Note p d)) (p, d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((p, d) -> Const (Endo [(p, d)]) (p, d))
-> Note p d -> Const (Endo [(p, d)]) (Note p d)
forall p1 d (p2 :: * -> * -> *) (f :: * -> *).
(Profunctor p2, Functor f) =>
p2 (p1, d) (f (p1, d)) -> p2 (Note p1 d) (f (Note p1 d))
toPair)


-- | Tempo in microseconds per quarter. See 'fromBPM'.
newtype MidiTempo = MidiTempo Int
    deriving (MidiTempo -> MidiTempo -> Bool
(MidiTempo -> MidiTempo -> Bool)
-> (MidiTempo -> MidiTempo -> Bool) -> Eq MidiTempo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MidiTempo -> MidiTempo -> Bool
== :: MidiTempo -> MidiTempo -> Bool
$c/= :: MidiTempo -> MidiTempo -> Bool
/= :: MidiTempo -> MidiTempo -> Bool
Eq,Int -> MidiTempo -> ShowS
[MidiTempo] -> ShowS
MidiTempo -> String
(Int -> MidiTempo -> ShowS)
-> (MidiTempo -> String)
-> ([MidiTempo] -> ShowS)
-> Show MidiTempo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MidiTempo -> ShowS
showsPrec :: Int -> MidiTempo -> ShowS
$cshow :: MidiTempo -> String
show :: MidiTempo -> String
$cshowList :: [MidiTempo] -> ShowS
showList :: [MidiTempo] -> ShowS
Show,Int -> MidiTempo
MidiTempo -> Int
MidiTempo -> [MidiTempo]
MidiTempo -> MidiTempo
MidiTempo -> MidiTempo -> [MidiTempo]
MidiTempo -> MidiTempo -> MidiTempo -> [MidiTempo]
(MidiTempo -> MidiTempo)
-> (MidiTempo -> MidiTempo)
-> (Int -> MidiTempo)
-> (MidiTempo -> Int)
-> (MidiTempo -> [MidiTempo])
-> (MidiTempo -> MidiTempo -> [MidiTempo])
-> (MidiTempo -> MidiTempo -> [MidiTempo])
-> (MidiTempo -> MidiTempo -> MidiTempo -> [MidiTempo])
-> Enum MidiTempo
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: MidiTempo -> MidiTempo
succ :: MidiTempo -> MidiTempo
$cpred :: MidiTempo -> MidiTempo
pred :: MidiTempo -> MidiTempo
$ctoEnum :: Int -> MidiTempo
toEnum :: Int -> MidiTempo
$cfromEnum :: MidiTempo -> Int
fromEnum :: MidiTempo -> Int
$cenumFrom :: MidiTempo -> [MidiTempo]
enumFrom :: MidiTempo -> [MidiTempo]
$cenumFromThen :: MidiTempo -> MidiTempo -> [MidiTempo]
enumFromThen :: MidiTempo -> MidiTempo -> [MidiTempo]
$cenumFromTo :: MidiTempo -> MidiTempo -> [MidiTempo]
enumFromTo :: MidiTempo -> MidiTempo -> [MidiTempo]
$cenumFromThenTo :: MidiTempo -> MidiTempo -> MidiTempo -> [MidiTempo]
enumFromThenTo :: MidiTempo -> MidiTempo -> MidiTempo -> [MidiTempo]
Enum,MidiTempo
MidiTempo -> MidiTempo -> Bounded MidiTempo
forall a. a -> a -> Bounded a
$cminBound :: MidiTempo
minBound :: MidiTempo
$cmaxBound :: MidiTempo
maxBound :: MidiTempo
Bounded,Eq MidiTempo
Eq MidiTempo =>
(MidiTempo -> MidiTempo -> Ordering)
-> (MidiTempo -> MidiTempo -> Bool)
-> (MidiTempo -> MidiTempo -> Bool)
-> (MidiTempo -> MidiTempo -> Bool)
-> (MidiTempo -> MidiTempo -> Bool)
-> (MidiTempo -> MidiTempo -> MidiTempo)
-> (MidiTempo -> MidiTempo -> MidiTempo)
-> Ord MidiTempo
MidiTempo -> MidiTempo -> Bool
MidiTempo -> MidiTempo -> Ordering
MidiTempo -> MidiTempo -> MidiTempo
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
$ccompare :: MidiTempo -> MidiTempo -> Ordering
compare :: MidiTempo -> MidiTempo -> Ordering
$c< :: MidiTempo -> MidiTempo -> Bool
< :: MidiTempo -> MidiTempo -> Bool
$c<= :: MidiTempo -> MidiTempo -> Bool
<= :: MidiTempo -> MidiTempo -> Bool
$c> :: MidiTempo -> MidiTempo -> Bool
> :: MidiTempo -> MidiTempo -> Bool
$c>= :: MidiTempo -> MidiTempo -> Bool
>= :: MidiTempo -> MidiTempo -> Bool
$cmax :: MidiTempo -> MidiTempo -> MidiTempo
max :: MidiTempo -> MidiTempo -> MidiTempo
$cmin :: MidiTempo -> MidiTempo -> MidiTempo
min :: MidiTempo -> MidiTempo -> MidiTempo
Ord,Integer -> MidiTempo
MidiTempo -> MidiTempo
MidiTempo -> MidiTempo -> MidiTempo
(MidiTempo -> MidiTempo -> MidiTempo)
-> (MidiTempo -> MidiTempo -> MidiTempo)
-> (MidiTempo -> MidiTempo -> MidiTempo)
-> (MidiTempo -> MidiTempo)
-> (MidiTempo -> MidiTempo)
-> (MidiTempo -> MidiTempo)
-> (Integer -> MidiTempo)
-> Num MidiTempo
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: MidiTempo -> MidiTempo -> MidiTempo
+ :: MidiTempo -> MidiTempo -> MidiTempo
$c- :: MidiTempo -> MidiTempo -> MidiTempo
- :: MidiTempo -> MidiTempo -> MidiTempo
$c* :: MidiTempo -> MidiTempo -> MidiTempo
* :: MidiTempo -> MidiTempo -> MidiTempo
$cnegate :: MidiTempo -> MidiTempo
negate :: MidiTempo -> MidiTempo
$cabs :: MidiTempo -> MidiTempo
abs :: MidiTempo -> MidiTempo
$csignum :: MidiTempo -> MidiTempo
signum :: MidiTempo -> MidiTempo
$cfromInteger :: Integer -> MidiTempo
fromInteger :: Integer -> MidiTempo
Num,Num MidiTempo
Ord MidiTempo
(Num MidiTempo, Ord MidiTempo) =>
(MidiTempo -> Rational) -> Real MidiTempo
MidiTempo -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: MidiTempo -> Rational
toRational :: MidiTempo -> Rational
Real,Enum MidiTempo
Real MidiTempo
(Real MidiTempo, Enum MidiTempo) =>
(MidiTempo -> MidiTempo -> MidiTempo)
-> (MidiTempo -> MidiTempo -> MidiTempo)
-> (MidiTempo -> MidiTempo -> MidiTempo)
-> (MidiTempo -> MidiTempo -> MidiTempo)
-> (MidiTempo -> MidiTempo -> (MidiTempo, MidiTempo))
-> (MidiTempo -> MidiTempo -> (MidiTempo, MidiTempo))
-> (MidiTempo -> Integer)
-> Integral MidiTempo
MidiTempo -> Integer
MidiTempo -> MidiTempo -> (MidiTempo, MidiTempo)
MidiTempo -> MidiTempo -> MidiTempo
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: MidiTempo -> MidiTempo -> MidiTempo
quot :: MidiTempo -> MidiTempo -> MidiTempo
$crem :: MidiTempo -> MidiTempo -> MidiTempo
rem :: MidiTempo -> MidiTempo -> MidiTempo
$cdiv :: MidiTempo -> MidiTempo -> MidiTempo
div :: MidiTempo -> MidiTempo -> MidiTempo
$cmod :: MidiTempo -> MidiTempo -> MidiTempo
mod :: MidiTempo -> MidiTempo -> MidiTempo
$cquotRem :: MidiTempo -> MidiTempo -> (MidiTempo, MidiTempo)
quotRem :: MidiTempo -> MidiTempo -> (MidiTempo, MidiTempo)
$cdivMod :: MidiTempo -> MidiTempo -> (MidiTempo, MidiTempo)
divMod :: MidiTempo -> MidiTempo -> (MidiTempo, MidiTempo)
$ctoInteger :: MidiTempo -> Integer
toInteger :: MidiTempo -> Integer
Integral)

-- | Midi channel, 1-16 presumably.
newtype MidiChan = MidiChan Int
    deriving (MidiChan -> MidiChan -> Bool
(MidiChan -> MidiChan -> Bool)
-> (MidiChan -> MidiChan -> Bool) -> Eq MidiChan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MidiChan -> MidiChan -> Bool
== :: MidiChan -> MidiChan -> Bool
$c/= :: MidiChan -> MidiChan -> Bool
/= :: MidiChan -> MidiChan -> Bool
Eq,Int -> MidiChan -> ShowS
[MidiChan] -> ShowS
MidiChan -> String
(Int -> MidiChan -> ShowS)
-> (MidiChan -> String) -> ([MidiChan] -> ShowS) -> Show MidiChan
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MidiChan -> ShowS
showsPrec :: Int -> MidiChan -> ShowS
$cshow :: MidiChan -> String
show :: MidiChan -> String
$cshowList :: [MidiChan] -> ShowS
showList :: [MidiChan] -> ShowS
Show,Int -> MidiChan
MidiChan -> Int
MidiChan -> [MidiChan]
MidiChan -> MidiChan
MidiChan -> MidiChan -> [MidiChan]
MidiChan -> MidiChan -> MidiChan -> [MidiChan]
(MidiChan -> MidiChan)
-> (MidiChan -> MidiChan)
-> (Int -> MidiChan)
-> (MidiChan -> Int)
-> (MidiChan -> [MidiChan])
-> (MidiChan -> MidiChan -> [MidiChan])
-> (MidiChan -> MidiChan -> [MidiChan])
-> (MidiChan -> MidiChan -> MidiChan -> [MidiChan])
-> Enum MidiChan
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: MidiChan -> MidiChan
succ :: MidiChan -> MidiChan
$cpred :: MidiChan -> MidiChan
pred :: MidiChan -> MidiChan
$ctoEnum :: Int -> MidiChan
toEnum :: Int -> MidiChan
$cfromEnum :: MidiChan -> Int
fromEnum :: MidiChan -> Int
$cenumFrom :: MidiChan -> [MidiChan]
enumFrom :: MidiChan -> [MidiChan]
$cenumFromThen :: MidiChan -> MidiChan -> [MidiChan]
enumFromThen :: MidiChan -> MidiChan -> [MidiChan]
$cenumFromTo :: MidiChan -> MidiChan -> [MidiChan]
enumFromTo :: MidiChan -> MidiChan -> [MidiChan]
$cenumFromThenTo :: MidiChan -> MidiChan -> MidiChan -> [MidiChan]
enumFromThenTo :: MidiChan -> MidiChan -> MidiChan -> [MidiChan]
Enum,MidiChan
MidiChan -> MidiChan -> Bounded MidiChan
forall a. a -> a -> Bounded a
$cminBound :: MidiChan
minBound :: MidiChan
$cmaxBound :: MidiChan
maxBound :: MidiChan
Bounded,Eq MidiChan
Eq MidiChan =>
(MidiChan -> MidiChan -> Ordering)
-> (MidiChan -> MidiChan -> Bool)
-> (MidiChan -> MidiChan -> Bool)
-> (MidiChan -> MidiChan -> Bool)
-> (MidiChan -> MidiChan -> Bool)
-> (MidiChan -> MidiChan -> MidiChan)
-> (MidiChan -> MidiChan -> MidiChan)
-> Ord MidiChan
MidiChan -> MidiChan -> Bool
MidiChan -> MidiChan -> Ordering
MidiChan -> MidiChan -> MidiChan
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
$ccompare :: MidiChan -> MidiChan -> Ordering
compare :: MidiChan -> MidiChan -> Ordering
$c< :: MidiChan -> MidiChan -> Bool
< :: MidiChan -> MidiChan -> Bool
$c<= :: MidiChan -> MidiChan -> Bool
<= :: MidiChan -> MidiChan -> Bool
$c> :: MidiChan -> MidiChan -> Bool
> :: MidiChan -> MidiChan -> Bool
$c>= :: MidiChan -> MidiChan -> Bool
>= :: MidiChan -> MidiChan -> Bool
$cmax :: MidiChan -> MidiChan -> MidiChan
max :: MidiChan -> MidiChan -> MidiChan
$cmin :: MidiChan -> MidiChan -> MidiChan
min :: MidiChan -> MidiChan -> MidiChan
Ord,Integer -> MidiChan
MidiChan -> MidiChan
MidiChan -> MidiChan -> MidiChan
(MidiChan -> MidiChan -> MidiChan)
-> (MidiChan -> MidiChan -> MidiChan)
-> (MidiChan -> MidiChan -> MidiChan)
-> (MidiChan -> MidiChan)
-> (MidiChan -> MidiChan)
-> (MidiChan -> MidiChan)
-> (Integer -> MidiChan)
-> Num MidiChan
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: MidiChan -> MidiChan -> MidiChan
+ :: MidiChan -> MidiChan -> MidiChan
$c- :: MidiChan -> MidiChan -> MidiChan
- :: MidiChan -> MidiChan -> MidiChan
$c* :: MidiChan -> MidiChan -> MidiChan
* :: MidiChan -> MidiChan -> MidiChan
$cnegate :: MidiChan -> MidiChan
negate :: MidiChan -> MidiChan
$cabs :: MidiChan -> MidiChan
abs :: MidiChan -> MidiChan
$csignum :: MidiChan -> MidiChan
signum :: MidiChan -> MidiChan
$cfromInteger :: Integer -> MidiChan
fromInteger :: Integer -> MidiChan
Num,Num MidiChan
Ord MidiChan
(Num MidiChan, Ord MidiChan) =>
(MidiChan -> Rational) -> Real MidiChan
MidiChan -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: MidiChan -> Rational
toRational :: MidiChan -> Rational
Real,Enum MidiChan
Real MidiChan
(Real MidiChan, Enum MidiChan) =>
(MidiChan -> MidiChan -> MidiChan)
-> (MidiChan -> MidiChan -> MidiChan)
-> (MidiChan -> MidiChan -> MidiChan)
-> (MidiChan -> MidiChan -> MidiChan)
-> (MidiChan -> MidiChan -> (MidiChan, MidiChan))
-> (MidiChan -> MidiChan -> (MidiChan, MidiChan))
-> (MidiChan -> Integer)
-> Integral MidiChan
MidiChan -> Integer
MidiChan -> MidiChan -> (MidiChan, MidiChan)
MidiChan -> MidiChan -> MidiChan
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: MidiChan -> MidiChan -> MidiChan
quot :: MidiChan -> MidiChan -> MidiChan
$crem :: MidiChan -> MidiChan -> MidiChan
rem :: MidiChan -> MidiChan -> MidiChan
$cdiv :: MidiChan -> MidiChan -> MidiChan
div :: MidiChan -> MidiChan -> MidiChan
$cmod :: MidiChan -> MidiChan -> MidiChan
mod :: MidiChan -> MidiChan -> MidiChan
$cquotRem :: MidiChan -> MidiChan -> (MidiChan, MidiChan)
quotRem :: MidiChan -> MidiChan -> (MidiChan, MidiChan)
$cdivMod :: MidiChan -> MidiChan -> (MidiChan, MidiChan)
divMod :: MidiChan -> MidiChan -> (MidiChan, MidiChan)
$ctoInteger :: MidiChan -> Integer
toInteger :: MidiChan -> Integer
Integral)

-- | note velocity, 0-127
newtype MidiVelocity = MidiVelocity Int
    deriving (MidiVelocity -> MidiVelocity -> Bool
(MidiVelocity -> MidiVelocity -> Bool)
-> (MidiVelocity -> MidiVelocity -> Bool) -> Eq MidiVelocity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MidiVelocity -> MidiVelocity -> Bool
== :: MidiVelocity -> MidiVelocity -> Bool
$c/= :: MidiVelocity -> MidiVelocity -> Bool
/= :: MidiVelocity -> MidiVelocity -> Bool
Eq,Int -> MidiVelocity -> ShowS
[MidiVelocity] -> ShowS
MidiVelocity -> String
(Int -> MidiVelocity -> ShowS)
-> (MidiVelocity -> String)
-> ([MidiVelocity] -> ShowS)
-> Show MidiVelocity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MidiVelocity -> ShowS
showsPrec :: Int -> MidiVelocity -> ShowS
$cshow :: MidiVelocity -> String
show :: MidiVelocity -> String
$cshowList :: [MidiVelocity] -> ShowS
showList :: [MidiVelocity] -> ShowS
Show,Int -> MidiVelocity
MidiVelocity -> Int
MidiVelocity -> [MidiVelocity]
MidiVelocity -> MidiVelocity
MidiVelocity -> MidiVelocity -> [MidiVelocity]
MidiVelocity -> MidiVelocity -> MidiVelocity -> [MidiVelocity]
(MidiVelocity -> MidiVelocity)
-> (MidiVelocity -> MidiVelocity)
-> (Int -> MidiVelocity)
-> (MidiVelocity -> Int)
-> (MidiVelocity -> [MidiVelocity])
-> (MidiVelocity -> MidiVelocity -> [MidiVelocity])
-> (MidiVelocity -> MidiVelocity -> [MidiVelocity])
-> (MidiVelocity -> MidiVelocity -> MidiVelocity -> [MidiVelocity])
-> Enum MidiVelocity
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: MidiVelocity -> MidiVelocity
succ :: MidiVelocity -> MidiVelocity
$cpred :: MidiVelocity -> MidiVelocity
pred :: MidiVelocity -> MidiVelocity
$ctoEnum :: Int -> MidiVelocity
toEnum :: Int -> MidiVelocity
$cfromEnum :: MidiVelocity -> Int
fromEnum :: MidiVelocity -> Int
$cenumFrom :: MidiVelocity -> [MidiVelocity]
enumFrom :: MidiVelocity -> [MidiVelocity]
$cenumFromThen :: MidiVelocity -> MidiVelocity -> [MidiVelocity]
enumFromThen :: MidiVelocity -> MidiVelocity -> [MidiVelocity]
$cenumFromTo :: MidiVelocity -> MidiVelocity -> [MidiVelocity]
enumFromTo :: MidiVelocity -> MidiVelocity -> [MidiVelocity]
$cenumFromThenTo :: MidiVelocity -> MidiVelocity -> MidiVelocity -> [MidiVelocity]
enumFromThenTo :: MidiVelocity -> MidiVelocity -> MidiVelocity -> [MidiVelocity]
Enum,MidiVelocity
MidiVelocity -> MidiVelocity -> Bounded MidiVelocity
forall a. a -> a -> Bounded a
$cminBound :: MidiVelocity
minBound :: MidiVelocity
$cmaxBound :: MidiVelocity
maxBound :: MidiVelocity
Bounded,Eq MidiVelocity
Eq MidiVelocity =>
(MidiVelocity -> MidiVelocity -> Ordering)
-> (MidiVelocity -> MidiVelocity -> Bool)
-> (MidiVelocity -> MidiVelocity -> Bool)
-> (MidiVelocity -> MidiVelocity -> Bool)
-> (MidiVelocity -> MidiVelocity -> Bool)
-> (MidiVelocity -> MidiVelocity -> MidiVelocity)
-> (MidiVelocity -> MidiVelocity -> MidiVelocity)
-> Ord MidiVelocity
MidiVelocity -> MidiVelocity -> Bool
MidiVelocity -> MidiVelocity -> Ordering
MidiVelocity -> MidiVelocity -> MidiVelocity
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
$ccompare :: MidiVelocity -> MidiVelocity -> Ordering
compare :: MidiVelocity -> MidiVelocity -> Ordering
$c< :: MidiVelocity -> MidiVelocity -> Bool
< :: MidiVelocity -> MidiVelocity -> Bool
$c<= :: MidiVelocity -> MidiVelocity -> Bool
<= :: MidiVelocity -> MidiVelocity -> Bool
$c> :: MidiVelocity -> MidiVelocity -> Bool
> :: MidiVelocity -> MidiVelocity -> Bool
$c>= :: MidiVelocity -> MidiVelocity -> Bool
>= :: MidiVelocity -> MidiVelocity -> Bool
$cmax :: MidiVelocity -> MidiVelocity -> MidiVelocity
max :: MidiVelocity -> MidiVelocity -> MidiVelocity
$cmin :: MidiVelocity -> MidiVelocity -> MidiVelocity
min :: MidiVelocity -> MidiVelocity -> MidiVelocity
Ord,Integer -> MidiVelocity
MidiVelocity -> MidiVelocity
MidiVelocity -> MidiVelocity -> MidiVelocity
(MidiVelocity -> MidiVelocity -> MidiVelocity)
-> (MidiVelocity -> MidiVelocity -> MidiVelocity)
-> (MidiVelocity -> MidiVelocity -> MidiVelocity)
-> (MidiVelocity -> MidiVelocity)
-> (MidiVelocity -> MidiVelocity)
-> (MidiVelocity -> MidiVelocity)
-> (Integer -> MidiVelocity)
-> Num MidiVelocity
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: MidiVelocity -> MidiVelocity -> MidiVelocity
+ :: MidiVelocity -> MidiVelocity -> MidiVelocity
$c- :: MidiVelocity -> MidiVelocity -> MidiVelocity
- :: MidiVelocity -> MidiVelocity -> MidiVelocity
$c* :: MidiVelocity -> MidiVelocity -> MidiVelocity
* :: MidiVelocity -> MidiVelocity -> MidiVelocity
$cnegate :: MidiVelocity -> MidiVelocity
negate :: MidiVelocity -> MidiVelocity
$cabs :: MidiVelocity -> MidiVelocity
abs :: MidiVelocity -> MidiVelocity
$csignum :: MidiVelocity -> MidiVelocity
signum :: MidiVelocity -> MidiVelocity
$cfromInteger :: Integer -> MidiVelocity
fromInteger :: Integer -> MidiVelocity
Num,Num MidiVelocity
Ord MidiVelocity
(Num MidiVelocity, Ord MidiVelocity) =>
(MidiVelocity -> Rational) -> Real MidiVelocity
MidiVelocity -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: MidiVelocity -> Rational
toRational :: MidiVelocity -> Rational
Real,Enum MidiVelocity
Real MidiVelocity
(Real MidiVelocity, Enum MidiVelocity) =>
(MidiVelocity -> MidiVelocity -> MidiVelocity)
-> (MidiVelocity -> MidiVelocity -> MidiVelocity)
-> (MidiVelocity -> MidiVelocity -> MidiVelocity)
-> (MidiVelocity -> MidiVelocity -> MidiVelocity)
-> (MidiVelocity -> MidiVelocity -> (MidiVelocity, MidiVelocity))
-> (MidiVelocity -> MidiVelocity -> (MidiVelocity, MidiVelocity))
-> (MidiVelocity -> Integer)
-> Integral MidiVelocity
MidiVelocity -> Integer
MidiVelocity -> MidiVelocity -> (MidiVelocity, MidiVelocity)
MidiVelocity -> MidiVelocity -> MidiVelocity
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: MidiVelocity -> MidiVelocity -> MidiVelocity
quot :: MidiVelocity -> MidiVelocity -> MidiVelocity
$crem :: MidiVelocity -> MidiVelocity -> MidiVelocity
rem :: MidiVelocity -> MidiVelocity -> MidiVelocity
$cdiv :: MidiVelocity -> MidiVelocity -> MidiVelocity
div :: MidiVelocity -> MidiVelocity -> MidiVelocity
$cmod :: MidiVelocity -> MidiVelocity -> MidiVelocity
mod :: MidiVelocity -> MidiVelocity -> MidiVelocity
$cquotRem :: MidiVelocity -> MidiVelocity -> (MidiVelocity, MidiVelocity)
quotRem :: MidiVelocity -> MidiVelocity -> (MidiVelocity, MidiVelocity)
$cdivMod :: MidiVelocity -> MidiVelocity -> (MidiVelocity, MidiVelocity)
divMod :: MidiVelocity -> MidiVelocity -> (MidiVelocity, MidiVelocity)
$ctoInteger :: MidiVelocity -> Integer
toInteger :: MidiVelocity -> Integer
Integral)

-- | Midi program. See 'fromInstrument'.
newtype MidiProgram = MidiProgram Int
    deriving (MidiProgram -> MidiProgram -> Bool
(MidiProgram -> MidiProgram -> Bool)
-> (MidiProgram -> MidiProgram -> Bool) -> Eq MidiProgram
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MidiProgram -> MidiProgram -> Bool
== :: MidiProgram -> MidiProgram -> Bool
$c/= :: MidiProgram -> MidiProgram -> Bool
/= :: MidiProgram -> MidiProgram -> Bool
Eq,Int -> MidiProgram -> ShowS
[MidiProgram] -> ShowS
MidiProgram -> String
(Int -> MidiProgram -> ShowS)
-> (MidiProgram -> String)
-> ([MidiProgram] -> ShowS)
-> Show MidiProgram
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MidiProgram -> ShowS
showsPrec :: Int -> MidiProgram -> ShowS
$cshow :: MidiProgram -> String
show :: MidiProgram -> String
$cshowList :: [MidiProgram] -> ShowS
showList :: [MidiProgram] -> ShowS
Show,Int -> MidiProgram
MidiProgram -> Int
MidiProgram -> [MidiProgram]
MidiProgram -> MidiProgram
MidiProgram -> MidiProgram -> [MidiProgram]
MidiProgram -> MidiProgram -> MidiProgram -> [MidiProgram]
(MidiProgram -> MidiProgram)
-> (MidiProgram -> MidiProgram)
-> (Int -> MidiProgram)
-> (MidiProgram -> Int)
-> (MidiProgram -> [MidiProgram])
-> (MidiProgram -> MidiProgram -> [MidiProgram])
-> (MidiProgram -> MidiProgram -> [MidiProgram])
-> (MidiProgram -> MidiProgram -> MidiProgram -> [MidiProgram])
-> Enum MidiProgram
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: MidiProgram -> MidiProgram
succ :: MidiProgram -> MidiProgram
$cpred :: MidiProgram -> MidiProgram
pred :: MidiProgram -> MidiProgram
$ctoEnum :: Int -> MidiProgram
toEnum :: Int -> MidiProgram
$cfromEnum :: MidiProgram -> Int
fromEnum :: MidiProgram -> Int
$cenumFrom :: MidiProgram -> [MidiProgram]
enumFrom :: MidiProgram -> [MidiProgram]
$cenumFromThen :: MidiProgram -> MidiProgram -> [MidiProgram]
enumFromThen :: MidiProgram -> MidiProgram -> [MidiProgram]
$cenumFromTo :: MidiProgram -> MidiProgram -> [MidiProgram]
enumFromTo :: MidiProgram -> MidiProgram -> [MidiProgram]
$cenumFromThenTo :: MidiProgram -> MidiProgram -> MidiProgram -> [MidiProgram]
enumFromThenTo :: MidiProgram -> MidiProgram -> MidiProgram -> [MidiProgram]
Enum,MidiProgram
MidiProgram -> MidiProgram -> Bounded MidiProgram
forall a. a -> a -> Bounded a
$cminBound :: MidiProgram
minBound :: MidiProgram
$cmaxBound :: MidiProgram
maxBound :: MidiProgram
Bounded,Eq MidiProgram
Eq MidiProgram =>
(MidiProgram -> MidiProgram -> Ordering)
-> (MidiProgram -> MidiProgram -> Bool)
-> (MidiProgram -> MidiProgram -> Bool)
-> (MidiProgram -> MidiProgram -> Bool)
-> (MidiProgram -> MidiProgram -> Bool)
-> (MidiProgram -> MidiProgram -> MidiProgram)
-> (MidiProgram -> MidiProgram -> MidiProgram)
-> Ord MidiProgram
MidiProgram -> MidiProgram -> Bool
MidiProgram -> MidiProgram -> Ordering
MidiProgram -> MidiProgram -> MidiProgram
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
$ccompare :: MidiProgram -> MidiProgram -> Ordering
compare :: MidiProgram -> MidiProgram -> Ordering
$c< :: MidiProgram -> MidiProgram -> Bool
< :: MidiProgram -> MidiProgram -> Bool
$c<= :: MidiProgram -> MidiProgram -> Bool
<= :: MidiProgram -> MidiProgram -> Bool
$c> :: MidiProgram -> MidiProgram -> Bool
> :: MidiProgram -> MidiProgram -> Bool
$c>= :: MidiProgram -> MidiProgram -> Bool
>= :: MidiProgram -> MidiProgram -> Bool
$cmax :: MidiProgram -> MidiProgram -> MidiProgram
max :: MidiProgram -> MidiProgram -> MidiProgram
$cmin :: MidiProgram -> MidiProgram -> MidiProgram
min :: MidiProgram -> MidiProgram -> MidiProgram
Ord,Integer -> MidiProgram
MidiProgram -> MidiProgram
MidiProgram -> MidiProgram -> MidiProgram
(MidiProgram -> MidiProgram -> MidiProgram)
-> (MidiProgram -> MidiProgram -> MidiProgram)
-> (MidiProgram -> MidiProgram -> MidiProgram)
-> (MidiProgram -> MidiProgram)
-> (MidiProgram -> MidiProgram)
-> (MidiProgram -> MidiProgram)
-> (Integer -> MidiProgram)
-> Num MidiProgram
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: MidiProgram -> MidiProgram -> MidiProgram
+ :: MidiProgram -> MidiProgram -> MidiProgram
$c- :: MidiProgram -> MidiProgram -> MidiProgram
- :: MidiProgram -> MidiProgram -> MidiProgram
$c* :: MidiProgram -> MidiProgram -> MidiProgram
* :: MidiProgram -> MidiProgram -> MidiProgram
$cnegate :: MidiProgram -> MidiProgram
negate :: MidiProgram -> MidiProgram
$cabs :: MidiProgram -> MidiProgram
abs :: MidiProgram -> MidiProgram
$csignum :: MidiProgram -> MidiProgram
signum :: MidiProgram -> MidiProgram
$cfromInteger :: Integer -> MidiProgram
fromInteger :: Integer -> MidiProgram
Num,Num MidiProgram
Ord MidiProgram
(Num MidiProgram, Ord MidiProgram) =>
(MidiProgram -> Rational) -> Real MidiProgram
MidiProgram -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: MidiProgram -> Rational
toRational :: MidiProgram -> Rational
Real,Enum MidiProgram
Real MidiProgram
(Real MidiProgram, Enum MidiProgram) =>
(MidiProgram -> MidiProgram -> MidiProgram)
-> (MidiProgram -> MidiProgram -> MidiProgram)
-> (MidiProgram -> MidiProgram -> MidiProgram)
-> (MidiProgram -> MidiProgram -> MidiProgram)
-> (MidiProgram -> MidiProgram -> (MidiProgram, MidiProgram))
-> (MidiProgram -> MidiProgram -> (MidiProgram, MidiProgram))
-> (MidiProgram -> Integer)
-> Integral MidiProgram
MidiProgram -> Integer
MidiProgram -> MidiProgram -> (MidiProgram, MidiProgram)
MidiProgram -> MidiProgram -> MidiProgram
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: MidiProgram -> MidiProgram -> MidiProgram
quot :: MidiProgram -> MidiProgram -> MidiProgram
$crem :: MidiProgram -> MidiProgram -> MidiProgram
rem :: MidiProgram -> MidiProgram -> MidiProgram
$cdiv :: MidiProgram -> MidiProgram -> MidiProgram
div :: MidiProgram -> MidiProgram -> MidiProgram
$cmod :: MidiProgram -> MidiProgram -> MidiProgram
mod :: MidiProgram -> MidiProgram -> MidiProgram
$cquotRem :: MidiProgram -> MidiProgram -> (MidiProgram, MidiProgram)
quotRem :: MidiProgram -> MidiProgram -> (MidiProgram, MidiProgram)
$cdivMod :: MidiProgram -> MidiProgram -> (MidiProgram, MidiProgram)
divMod :: MidiProgram -> MidiProgram -> (MidiProgram, MidiProgram)
$ctoInteger :: MidiProgram -> Integer
toInteger :: MidiProgram -> Integer
Integral)

-- | Midi ticks per quarter.
newtype MidiTicks = MidiTicks Int
    deriving (MidiTicks -> MidiTicks -> Bool
(MidiTicks -> MidiTicks -> Bool)
-> (MidiTicks -> MidiTicks -> Bool) -> Eq MidiTicks
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MidiTicks -> MidiTicks -> Bool
== :: MidiTicks -> MidiTicks -> Bool
$c/= :: MidiTicks -> MidiTicks -> Bool
/= :: MidiTicks -> MidiTicks -> Bool
Eq,Int -> MidiTicks -> ShowS
[MidiTicks] -> ShowS
MidiTicks -> String
(Int -> MidiTicks -> ShowS)
-> (MidiTicks -> String)
-> ([MidiTicks] -> ShowS)
-> Show MidiTicks
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MidiTicks -> ShowS
showsPrec :: Int -> MidiTicks -> ShowS
$cshow :: MidiTicks -> String
show :: MidiTicks -> String
$cshowList :: [MidiTicks] -> ShowS
showList :: [MidiTicks] -> ShowS
Show,Int -> MidiTicks
MidiTicks -> Int
MidiTicks -> [MidiTicks]
MidiTicks -> MidiTicks
MidiTicks -> MidiTicks -> [MidiTicks]
MidiTicks -> MidiTicks -> MidiTicks -> [MidiTicks]
(MidiTicks -> MidiTicks)
-> (MidiTicks -> MidiTicks)
-> (Int -> MidiTicks)
-> (MidiTicks -> Int)
-> (MidiTicks -> [MidiTicks])
-> (MidiTicks -> MidiTicks -> [MidiTicks])
-> (MidiTicks -> MidiTicks -> [MidiTicks])
-> (MidiTicks -> MidiTicks -> MidiTicks -> [MidiTicks])
-> Enum MidiTicks
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: MidiTicks -> MidiTicks
succ :: MidiTicks -> MidiTicks
$cpred :: MidiTicks -> MidiTicks
pred :: MidiTicks -> MidiTicks
$ctoEnum :: Int -> MidiTicks
toEnum :: Int -> MidiTicks
$cfromEnum :: MidiTicks -> Int
fromEnum :: MidiTicks -> Int
$cenumFrom :: MidiTicks -> [MidiTicks]
enumFrom :: MidiTicks -> [MidiTicks]
$cenumFromThen :: MidiTicks -> MidiTicks -> [MidiTicks]
enumFromThen :: MidiTicks -> MidiTicks -> [MidiTicks]
$cenumFromTo :: MidiTicks -> MidiTicks -> [MidiTicks]
enumFromTo :: MidiTicks -> MidiTicks -> [MidiTicks]
$cenumFromThenTo :: MidiTicks -> MidiTicks -> MidiTicks -> [MidiTicks]
enumFromThenTo :: MidiTicks -> MidiTicks -> MidiTicks -> [MidiTicks]
Enum,MidiTicks
MidiTicks -> MidiTicks -> Bounded MidiTicks
forall a. a -> a -> Bounded a
$cminBound :: MidiTicks
minBound :: MidiTicks
$cmaxBound :: MidiTicks
maxBound :: MidiTicks
Bounded,Eq MidiTicks
Eq MidiTicks =>
(MidiTicks -> MidiTicks -> Ordering)
-> (MidiTicks -> MidiTicks -> Bool)
-> (MidiTicks -> MidiTicks -> Bool)
-> (MidiTicks -> MidiTicks -> Bool)
-> (MidiTicks -> MidiTicks -> Bool)
-> (MidiTicks -> MidiTicks -> MidiTicks)
-> (MidiTicks -> MidiTicks -> MidiTicks)
-> Ord MidiTicks
MidiTicks -> MidiTicks -> Bool
MidiTicks -> MidiTicks -> Ordering
MidiTicks -> MidiTicks -> MidiTicks
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
$ccompare :: MidiTicks -> MidiTicks -> Ordering
compare :: MidiTicks -> MidiTicks -> Ordering
$c< :: MidiTicks -> MidiTicks -> Bool
< :: MidiTicks -> MidiTicks -> Bool
$c<= :: MidiTicks -> MidiTicks -> Bool
<= :: MidiTicks -> MidiTicks -> Bool
$c> :: MidiTicks -> MidiTicks -> Bool
> :: MidiTicks -> MidiTicks -> Bool
$c>= :: MidiTicks -> MidiTicks -> Bool
>= :: MidiTicks -> MidiTicks -> Bool
$cmax :: MidiTicks -> MidiTicks -> MidiTicks
max :: MidiTicks -> MidiTicks -> MidiTicks
$cmin :: MidiTicks -> MidiTicks -> MidiTicks
min :: MidiTicks -> MidiTicks -> MidiTicks
Ord,Integer -> MidiTicks
MidiTicks -> MidiTicks
MidiTicks -> MidiTicks -> MidiTicks
(MidiTicks -> MidiTicks -> MidiTicks)
-> (MidiTicks -> MidiTicks -> MidiTicks)
-> (MidiTicks -> MidiTicks -> MidiTicks)
-> (MidiTicks -> MidiTicks)
-> (MidiTicks -> MidiTicks)
-> (MidiTicks -> MidiTicks)
-> (Integer -> MidiTicks)
-> Num MidiTicks
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: MidiTicks -> MidiTicks -> MidiTicks
+ :: MidiTicks -> MidiTicks -> MidiTicks
$c- :: MidiTicks -> MidiTicks -> MidiTicks
- :: MidiTicks -> MidiTicks -> MidiTicks
$c* :: MidiTicks -> MidiTicks -> MidiTicks
* :: MidiTicks -> MidiTicks -> MidiTicks
$cnegate :: MidiTicks -> MidiTicks
negate :: MidiTicks -> MidiTicks
$cabs :: MidiTicks -> MidiTicks
abs :: MidiTicks -> MidiTicks
$csignum :: MidiTicks -> MidiTicks
signum :: MidiTicks -> MidiTicks
$cfromInteger :: Integer -> MidiTicks
fromInteger :: Integer -> MidiTicks
Num,Num MidiTicks
Ord MidiTicks
(Num MidiTicks, Ord MidiTicks) =>
(MidiTicks -> Rational) -> Real MidiTicks
MidiTicks -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: MidiTicks -> Rational
toRational :: MidiTicks -> Rational
Real,Enum MidiTicks
Real MidiTicks
(Real MidiTicks, Enum MidiTicks) =>
(MidiTicks -> MidiTicks -> MidiTicks)
-> (MidiTicks -> MidiTicks -> MidiTicks)
-> (MidiTicks -> MidiTicks -> MidiTicks)
-> (MidiTicks -> MidiTicks -> MidiTicks)
-> (MidiTicks -> MidiTicks -> (MidiTicks, MidiTicks))
-> (MidiTicks -> MidiTicks -> (MidiTicks, MidiTicks))
-> (MidiTicks -> Integer)
-> Integral MidiTicks
MidiTicks -> Integer
MidiTicks -> MidiTicks -> (MidiTicks, MidiTicks)
MidiTicks -> MidiTicks -> MidiTicks
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: MidiTicks -> MidiTicks -> MidiTicks
quot :: MidiTicks -> MidiTicks -> MidiTicks
$crem :: MidiTicks -> MidiTicks -> MidiTicks
rem :: MidiTicks -> MidiTicks -> MidiTicks
$cdiv :: MidiTicks -> MidiTicks -> MidiTicks
div :: MidiTicks -> MidiTicks -> MidiTicks
$cmod :: MidiTicks -> MidiTicks -> MidiTicks
mod :: MidiTicks -> MidiTicks -> MidiTicks
$cquotRem :: MidiTicks -> MidiTicks -> (MidiTicks, MidiTicks)
quotRem :: MidiTicks -> MidiTicks -> (MidiTicks, MidiTicks)
$cdivMod :: MidiTicks -> MidiTicks -> (MidiTicks, MidiTicks)
divMod :: MidiTicks -> MidiTicks -> (MidiTicks, MidiTicks)
$ctoInteger :: MidiTicks -> Integer
toInteger :: MidiTicks -> Integer
Integral)

-- | Rational to ticks
toTicks :: MidiTicks -> Iso' Rational IDur
toTicks :: MidiTicks -> Iso' Rational Int
toTicks MidiTicks
t = (Rational -> Int) -> (Int -> Rational) -> Iso' Rational Int
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Rational -> Int
to' Int -> Rational
from' where
    to' :: Rational -> Int
to' = Rational -> Int
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Rational -> Int) -> (Rational -> Rational) -> Rational -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* MidiTicks -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (MidiTicks
tMidiTicks -> MidiTicks -> MidiTicks
forall a. Num a => a -> a -> a
*MidiTicks
4))
    from' :: Int -> Rational
from' = (Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% MidiTicks -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (MidiTicks
tMidiTicks -> MidiTicks -> MidiTicks
forall a. Num a => a -> a -> a
*MidiTicks
4)) (Integer -> Rational) -> (Int -> Integer) -> Int -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral


-- | Internal type for midi event or pad.
data MidiEvent = Pad IDur | Event MEvent.T

-- | cover our tracks
type MidiTrack = Track


-- | write to disk.
writeMidiFile :: FilePath -> MidiData -> IO ()
writeMidiFile :: String -> MidiData -> IO ()
writeMidiFile = String -> MidiData -> IO ()
toFile

-- | debug midi file.
showMidiFile :: FilePath -> IO ()
showMidiFile :: String -> IO ()
showMidiFile = String -> IO ()
showFile

-- | Make midi file data
midi :: MidiTicks -> [MidiTrack] -> MidiData
midi :: MidiTicks -> [MidiTrack] -> MidiData
midi MidiTicks
ticks = Type -> Division -> [MidiTrack] -> MidiData
MFile.Cons Type
Parallel (Tempo -> Division
Ticks (Int -> Tempo
toTempo (Int -> Tempo) -> Int -> Tempo
forall a b. (a -> b) -> a -> b
$ MidiTicks -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral MidiTicks
ticks))

-- | make a standard track which specifies tempo and program.
-- | see 'makeTrack' for more control.
makeTrackFull
  :: (MidiNotes notes) =>
     MidiTempo
     -> MidiChan
     -> MidiProgram
     -> MidiVelocity
     -> notes
     -> MidiTrack
makeTrackFull :: forall notes.
MidiNotes notes =>
MidiTempo
-> MidiChan -> MidiProgram -> MidiVelocity -> notes -> MidiTrack
makeTrackFull MidiTempo
tempo MidiChan
chan MidiProgram
prog MidiVelocity
vel notes
notes =
    [MidiEvent] -> MidiTrack
makeTrack ([MidiEvent] -> MidiTrack) -> [MidiEvent] -> MidiTrack
forall a b. (a -> b) -> a -> b
$ MidiTempo -> MidiEvent
setTempo MidiTempo
tempoMidiEvent -> [MidiEvent] -> [MidiEvent]
forall a. a -> [a] -> [a]
:
                MidiChan -> MidiProgram -> MidiEvent
programChange MidiChan
chan MidiProgram
progMidiEvent -> [MidiEvent] -> [MidiEvent]
forall a. a -> [a] -> [a]
:
                MidiChan -> MidiVelocity -> notes -> [MidiEvent]
forall notes.
MidiNotes notes =>
MidiChan -> MidiVelocity -> notes -> [MidiEvent]
toNoteEvents MidiChan
chan MidiVelocity
vel notes
notes


-- | BPM to microseconds per quarter note.
fromBPM :: (Real a, Show a) => a -> MidiTempo
fromBPM :: forall a. (Real a, Show a) => a -> MidiTempo
fromBPM a
b | a
b a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 = Rational -> MidiTempo
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational
60 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
1000000 Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ a -> Rational
forall a. Real a => a -> Rational
toRational a
b)
          | Bool
otherwise = String -> MidiTempo
forall a. HasCallStack => String -> a
error (String -> MidiTempo) -> String -> MidiTempo
forall a b. (a -> b) -> a -> b
$ String
"fromBPM: must be > 0: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
b

-- | convert a General MIDI 'Instrument'.
fromInstrument :: Instrument -> MidiProgram
fromInstrument :: Instrument -> MidiProgram
fromInstrument = Int -> MidiProgram
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> MidiProgram)
-> (Instrument -> Int) -> Instrument -> MidiProgram
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instrument -> Int
forall a. Enum a => a -> Int
fromEnum

-- | make a track from track events.
makeTrack :: [MidiEvent] -> MidiTrack
makeTrack :: [MidiEvent] -> MidiTrack
makeTrack = [(ElapsedTime, T)] -> MidiTrack
forall a b. [(a, b)] -> T a b
fromPairList ([(ElapsedTime, T)] -> MidiTrack)
-> ([MidiEvent] -> [(ElapsedTime, T)]) -> [MidiEvent] -> MidiTrack
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(ElapsedTime, T)]] -> [(ElapsedTime, T)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(ElapsedTime, T)]] -> [(ElapsedTime, T)])
-> ([MidiEvent] -> [[(ElapsedTime, T)]])
-> [MidiEvent]
-> [(ElapsedTime, T)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [[(ElapsedTime, T)]]) -> [[(ElapsedTime, T)]]
forall a b. (a, b) -> b
snd ((Int, [[(ElapsedTime, T)]]) -> [[(ElapsedTime, T)]])
-> ([MidiEvent] -> (Int, [[(ElapsedTime, T)]]))
-> [MidiEvent]
-> [[(ElapsedTime, T)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> MidiEvent -> (Int, [(ElapsedTime, T)]))
-> Int -> [MidiEvent] -> (Int, [[(ElapsedTime, T)]])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL Int -> MidiEvent -> (Int, [(ElapsedTime, T)])
conv Int
0
    where conv :: IDur -> MidiEvent -> (IDur,[(ElapsedTime,MEvent.T)])
          conv :: Int -> MidiEvent -> (Int, [(ElapsedTime, T)])
conv Int
_ (Pad Int
dur') = (Int
dur',[])
          conv Int
off (Event T
e) = (Int
0,[(Integer -> ElapsedTime
toElapsedTime (Integer -> ElapsedTime) -> Integer -> ElapsedTime
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off,T
e)])


-- | turn notes into track events.
toNoteEvents :: MidiNotes notes => MidiChan -> MidiVelocity -> notes -> [MidiEvent]
toNoteEvents :: forall notes.
MidiNotes notes =>
MidiChan -> MidiVelocity -> notes -> [MidiEvent]
toNoteEvents MidiChan
chan MidiVelocity
vel = (([Int], Int) -> [MidiEvent]) -> [([Int], Int)] -> [MidiEvent]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (MidiChan -> MidiVelocity -> ([Int], Int) -> [MidiEvent]
noteEvents MidiChan
chan MidiVelocity
vel) ([([Int], Int)] -> [MidiEvent])
-> (notes -> [([Int], Int)]) -> notes -> [MidiEvent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. notes -> [([Int], Int)]
forall a. MidiNotes a => a -> [([Int], Int)]
toMidiNotes


-- | create a "Voice" MIDI event
voiceEvent :: MidiChan -> MVoice.T -> MidiEvent
voiceEvent :: MidiChan -> T -> MidiEvent
voiceEvent MidiChan
chan = MidiChan -> Body -> MidiEvent
midiEvent MidiChan
chan (Body -> MidiEvent) -> (T -> Body) -> T -> MidiEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> Body
Voice

-- | tempo meta event.
setTempo :: MidiTempo -> MidiEvent
setTempo :: MidiTempo -> MidiEvent
setTempo = T -> MidiEvent
metaEvent (T -> MidiEvent) -> (MidiTempo -> T) -> MidiTempo -> MidiEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tempo -> T
SetTempo (Tempo -> T) -> (MidiTempo -> Tempo) -> MidiTempo -> T
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Tempo
toTempo (Int -> Tempo) -> (MidiTempo -> Int) -> MidiTempo -> Tempo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MidiTempo -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | create a "Meta" MIDI event
metaEvent :: MMeta.T -> MidiEvent
metaEvent :: T -> MidiEvent
metaEvent = T -> MidiEvent
Event (T -> MidiEvent) -> (T -> T) -> T -> MidiEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> T
MetaEvent

-- | create a "Voice" or "Mode" MIDI event.
midiEvent :: MidiChan -> MChan.Body -> MidiEvent
midiEvent :: MidiChan -> Body -> MidiEvent
midiEvent MidiChan
chan = T -> MidiEvent
Event (T -> MidiEvent) -> (Body -> T) -> Body -> MidiEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> T
MIDIEvent (T -> T) -> (Body -> T) -> Body -> T
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Channel -> Body -> T
MChan.Cons (Int -> Channel
toChannel (Int -> Channel) -> Int -> Channel
forall a b. (a -> b) -> a -> b
$ MidiChan -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral MidiChan
chan)

-- TODO: sysex.

-- | program change MIDI Voice event.
programChange :: MidiChan -> MidiProgram -> MidiEvent
programChange :: MidiChan -> MidiProgram -> MidiEvent
programChange MidiChan
chan MidiProgram
prog = MidiChan -> T -> MidiEvent
voiceEvent MidiChan
chan (Program -> T
ProgramChange (Int -> Program
toProgram (Int -> Program) -> Int -> Program
forall a b. (a -> b) -> a -> b
$ MidiProgram -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral MidiProgram
prog))

-- | note on + note off events, using 'Pad' to carve out space.
noteEvents :: MidiChan -> MidiVelocity -> ([IPitch],IDur) -> [MidiEvent]
noteEvents :: MidiChan -> MidiVelocity -> ([Int], Int) -> [MidiEvent]
noteEvents MidiChan
chan MidiVelocity
vel ([Int]
ps,Int
dur') = (MidiChan -> MidiVelocity -> Int -> MidiEvent) -> [MidiEvent]
forall {b} {b}.
Num b =>
(MidiChan -> MidiVelocity -> b -> b) -> [b]
evs MidiChan -> MidiVelocity -> Int -> MidiEvent
noteOn [MidiEvent] -> [MidiEvent] -> [MidiEvent]
forall a. [a] -> [a] -> [a]
++ [Int -> MidiEvent
Pad Int
dur'] [MidiEvent] -> [MidiEvent] -> [MidiEvent]
forall a. [a] -> [a] -> [a]
++ (MidiChan -> MidiVelocity -> Int -> MidiEvent) -> [MidiEvent]
forall {b} {b}.
Num b =>
(MidiChan -> MidiVelocity -> b -> b) -> [b]
evs MidiChan -> MidiVelocity -> Int -> MidiEvent
noteOff
    where evs :: (MidiChan -> MidiVelocity -> b -> b) -> [b]
evs MidiChan -> MidiVelocity -> b -> b
f = (Int -> b) -> [Int] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (MidiChan -> MidiVelocity -> b -> b
f MidiChan
chan MidiVelocity
vel (b -> b) -> (Int -> b) -> Int -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral) [Int]
ps

-- TODO: figure out polymorphic way to attach velocity and anything else to notes.

-- | note on or note off event.
noteEvent :: (Pitch -> Velocity -> MVoice.T) ->
             MidiChan -> MidiVelocity -> IPitch -> MidiEvent
noteEvent :: (Pitch -> Velocity -> T)
-> MidiChan -> MidiVelocity -> Int -> MidiEvent
noteEvent Pitch -> Velocity -> T
f MidiChan
chan MidiVelocity
vel Int
pitch' = MidiChan -> T -> MidiEvent
voiceEvent MidiChan
chan
                             (Pitch -> Velocity -> T
f (Int -> Pitch
toPitch (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pitch'))
                                    (Int -> Velocity
toVelocity (Int -> Velocity) -> Int -> Velocity
forall a b. (a -> b) -> a -> b
$ MidiVelocity -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral MidiVelocity
vel))
noteOn :: MidiChan -> MidiVelocity -> IPitch -> MidiEvent
noteOn :: MidiChan -> MidiVelocity -> Int -> MidiEvent
noteOn = (Pitch -> Velocity -> T)
-> MidiChan -> MidiVelocity -> Int -> MidiEvent
noteEvent Pitch -> Velocity -> T
NoteOn

noteOff :: MidiChan -> MidiVelocity -> IPitch -> MidiEvent
noteOff :: MidiChan -> MidiVelocity -> Int -> MidiEvent
noteOff = (Pitch -> Velocity -> T)
-> MidiChan -> MidiVelocity -> Int -> MidiEvent
noteEvent Pitch -> Velocity -> T
NoteOff


test1 :: IO ()
test1 :: IO ()
test1 = String -> Int -> [(Instrument, [Note [Int] Int])] -> IO ()
forall n.
MidiNotes n =>
String -> Int -> [(Instrument, n)] -> IO ()
playMidi String
"/tmp/first.midi" Int
120 [(Instrument
AcousticGrandPiano,
         (([Int], Int) -> Note [Int] Int)
-> [([Int], Int)] -> [Note [Int] Int]
forall a b. (a -> b) -> [a] -> [b]
map (([Int] -> Int -> Note [Int] Int) -> ([Int], Int) -> Note [Int] Int
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [Int] -> Int -> Note [Int] Int
forall p d. p -> d -> Note p d
Note)
                 [([Int
60 :: Int],Int
48 :: Int),([Int
61],Int
48),([Int
62],Int
24),([Int
64],Int
64),
                  ([],Int
96),([Int
60,Int
66],Int
96)])]


playMidi :: MidiNotes n => FilePath -> Int -> [(Instrument,n)] -> IO ()
playMidi :: forall n.
MidiNotes n =>
String -> Int -> [(Instrument, n)] -> IO ()
playMidi String
file Int
bpm [(Instrument, n)]
tracks = do
    String -> MidiData -> IO ()
writeMidiFile String
file (MidiData -> IO ()) -> MidiData -> IO ()
forall a b. (a -> b) -> a -> b
$ MidiTicks -> [MidiTrack] -> MidiData
midi MidiTicks
96 ([MidiTrack] -> MidiData) -> [MidiTrack] -> MidiData
forall a b. (a -> b) -> a -> b
$ ((Instrument, n) -> MidiTrack) -> [(Instrument, n)] -> [MidiTrack]
forall a b. (a -> b) -> [a] -> [b]
map (\(Instrument
inst,n
notes) -> MidiTempo
-> MidiChan -> MidiProgram -> MidiVelocity -> n -> MidiTrack
forall notes.
MidiNotes notes =>
MidiTempo
-> MidiChan -> MidiProgram -> MidiVelocity -> notes -> MidiTrack
makeTrackFull (Int -> MidiTempo
forall a. (Real a, Show a) => a -> MidiTempo
fromBPM Int
bpm) MidiChan
0 (Instrument -> MidiProgram
fromInstrument Instrument
inst) MidiVelocity
127 n
notes) [(Instrument, n)]
tracks
    IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
 -> IO ())
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO ()
forall a b. (a -> b) -> a -> b
$ CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess (String -> CreateProcess
shell (String -> CreateProcess) -> String -> CreateProcess
forall a b. (a -> b) -> a -> b
$ String
"scripts/qt7play.applescript " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
file)



-- playMidi "/tmp/boston.mid" DrawbarOrgan notes
-- let boston = [Db@:5,F@:4,Db@:5,Eb@:5,Ab@:4,C@:5]
-- map (\p -> (p - 60) * 2 + 60)
-- let notes = concat $ replicate 8 $ map (`Note` (1 % 16)) boston
-- playMidi "/tmp/boston.mid" DrawbarOrgan 140
--    (toListOf (traverse.seconding (toTicks 96)) notes)