{-# 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
import Data.Ratio

-- | 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 :: [([IPitch], IPitch)] -> [([IPitch], IPitch)]
toMidiNotes = [([IPitch], IPitch)] -> [([IPitch], IPitch)]
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) -> [([IPitch], IPitch)]
toMidiNotes = ((c p, d) -> ([IPitch], IPitch))
-> [(c p, d)] -> [([IPitch], IPitch)]
forall a b. (a -> b) -> [a] -> [b]
map (((p -> IPitch) -> [p] -> [IPitch]
forall a b. (a -> b) -> [a] -> [b]
map p -> IPitch
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([p] -> [IPitch]) -> (c p -> [p]) -> c p -> [IPitch]
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)
traverse) (c p -> [IPitch])
-> (d -> IPitch) -> (c p, d) -> ([IPitch], IPitch)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** d -> IPitch
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([(c p, d)] -> [([IPitch], IPitch)])
-> (t (Note (c p) d) -> [(c p, d)])
-> t (Note (c p) d)
-> [([IPitch], IPitch)]
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)
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 p d. Iso' (Note p d) (p, d)
toPair)

instance (Integral p, Integral d, Traversable t) => MidiNotes (t (Note p d))  where
    toMidiNotes :: t (Note p d) -> [([IPitch], IPitch)]
toMidiNotes = ((p, d) -> ([IPitch], IPitch)) -> [(p, d)] -> [([IPitch], IPitch)]
forall a b. (a -> b) -> [a] -> [b]
map (IPitch -> [IPitch]
forall (m :: * -> *) a. Monad m => a -> m a
return(IPitch -> [IPitch]) -> (p -> IPitch) -> p -> [IPitch]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.p -> IPitch
forall a b. (Integral a, Num b) => a -> b
fromIntegral (p -> [IPitch]) -> (d -> IPitch) -> (p, d) -> ([IPitch], IPitch)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** d -> IPitch
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([(p, d)] -> [([IPitch], IPitch)])
-> (t (Note p d) -> [(p, d)])
-> t (Note p d)
-> [([IPitch], IPitch)]
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)
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 p d. Iso' (Note p d) (p, 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
/= :: MidiTempo -> MidiTempo -> Bool
$c/= :: MidiTempo -> MidiTempo -> Bool
== :: MidiTempo -> MidiTempo -> Bool
$c== :: MidiTempo -> MidiTempo -> Bool
Eq,IPitch -> MidiTempo -> ShowS
[MidiTempo] -> ShowS
MidiTempo -> String
(IPitch -> MidiTempo -> ShowS)
-> (MidiTempo -> String)
-> ([MidiTempo] -> ShowS)
-> Show MidiTempo
forall a.
(IPitch -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MidiTempo] -> ShowS
$cshowList :: [MidiTempo] -> ShowS
show :: MidiTempo -> String
$cshow :: MidiTempo -> String
showsPrec :: IPitch -> MidiTempo -> ShowS
$cshowsPrec :: IPitch -> MidiTempo -> ShowS
Show,IPitch -> MidiTempo
MidiTempo -> IPitch
MidiTempo -> [MidiTempo]
MidiTempo -> MidiTempo
MidiTempo -> MidiTempo -> [MidiTempo]
MidiTempo -> MidiTempo -> MidiTempo -> [MidiTempo]
(MidiTempo -> MidiTempo)
-> (MidiTempo -> MidiTempo)
-> (IPitch -> MidiTempo)
-> (MidiTempo -> IPitch)
-> (MidiTempo -> [MidiTempo])
-> (MidiTempo -> MidiTempo -> [MidiTempo])
-> (MidiTempo -> MidiTempo -> [MidiTempo])
-> (MidiTempo -> MidiTempo -> MidiTempo -> [MidiTempo])
-> Enum MidiTempo
forall a.
(a -> a)
-> (a -> a)
-> (IPitch -> a)
-> (a -> IPitch)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MidiTempo -> MidiTempo -> MidiTempo -> [MidiTempo]
$cenumFromThenTo :: MidiTempo -> MidiTempo -> MidiTempo -> [MidiTempo]
enumFromTo :: MidiTempo -> MidiTempo -> [MidiTempo]
$cenumFromTo :: MidiTempo -> MidiTempo -> [MidiTempo]
enumFromThen :: MidiTempo -> MidiTempo -> [MidiTempo]
$cenumFromThen :: MidiTempo -> MidiTempo -> [MidiTempo]
enumFrom :: MidiTempo -> [MidiTempo]
$cenumFrom :: MidiTempo -> [MidiTempo]
fromEnum :: MidiTempo -> IPitch
$cfromEnum :: MidiTempo -> IPitch
toEnum :: IPitch -> MidiTempo
$ctoEnum :: IPitch -> MidiTempo
pred :: MidiTempo -> MidiTempo
$cpred :: MidiTempo -> MidiTempo
succ :: MidiTempo -> MidiTempo
$csucc :: MidiTempo -> MidiTempo
Enum,MidiTempo
MidiTempo -> MidiTempo -> Bounded MidiTempo
forall a. a -> a -> Bounded a
maxBound :: MidiTempo
$cmaxBound :: MidiTempo
minBound :: MidiTempo
$cminBound :: 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
min :: MidiTempo -> MidiTempo -> MidiTempo
$cmin :: MidiTempo -> MidiTempo -> MidiTempo
max :: MidiTempo -> MidiTempo -> MidiTempo
$cmax :: MidiTempo -> MidiTempo -> MidiTempo
>= :: MidiTempo -> MidiTempo -> Bool
$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
compare :: MidiTempo -> MidiTempo -> Ordering
$ccompare :: MidiTempo -> MidiTempo -> Ordering
$cp1Ord :: Eq 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
fromInteger :: Integer -> MidiTempo
$cfromInteger :: Integer -> MidiTempo
signum :: MidiTempo -> MidiTempo
$csignum :: MidiTempo -> MidiTempo
abs :: MidiTempo -> MidiTempo
$cabs :: MidiTempo -> MidiTempo
negate :: MidiTempo -> MidiTempo
$cnegate :: MidiTempo -> MidiTempo
* :: MidiTempo -> MidiTempo -> MidiTempo
$c* :: MidiTempo -> MidiTempo -> MidiTempo
- :: MidiTempo -> MidiTempo -> MidiTempo
$c- :: MidiTempo -> MidiTempo -> MidiTempo
+ :: MidiTempo -> MidiTempo -> MidiTempo
$c+ :: MidiTempo -> MidiTempo -> 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
toRational :: MidiTempo -> Rational
$ctoRational :: MidiTempo -> Rational
$cp2Real :: Ord MidiTempo
$cp1Real :: Num MidiTempo
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
toInteger :: MidiTempo -> Integer
$ctoInteger :: MidiTempo -> Integer
divMod :: MidiTempo -> MidiTempo -> (MidiTempo, MidiTempo)
$cdivMod :: MidiTempo -> MidiTempo -> (MidiTempo, MidiTempo)
quotRem :: MidiTempo -> MidiTempo -> (MidiTempo, MidiTempo)
$cquotRem :: MidiTempo -> MidiTempo -> (MidiTempo, MidiTempo)
mod :: MidiTempo -> MidiTempo -> MidiTempo
$cmod :: MidiTempo -> MidiTempo -> MidiTempo
div :: MidiTempo -> MidiTempo -> MidiTempo
$cdiv :: MidiTempo -> MidiTempo -> MidiTempo
rem :: MidiTempo -> MidiTempo -> MidiTempo
$crem :: MidiTempo -> MidiTempo -> MidiTempo
quot :: MidiTempo -> MidiTempo -> MidiTempo
$cquot :: MidiTempo -> MidiTempo -> MidiTempo
$cp2Integral :: Enum MidiTempo
$cp1Integral :: Real MidiTempo
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
/= :: MidiChan -> MidiChan -> Bool
$c/= :: MidiChan -> MidiChan -> Bool
== :: MidiChan -> MidiChan -> Bool
$c== :: MidiChan -> MidiChan -> Bool
Eq,IPitch -> MidiChan -> ShowS
[MidiChan] -> ShowS
MidiChan -> String
(IPitch -> MidiChan -> ShowS)
-> (MidiChan -> String) -> ([MidiChan] -> ShowS) -> Show MidiChan
forall a.
(IPitch -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MidiChan] -> ShowS
$cshowList :: [MidiChan] -> ShowS
show :: MidiChan -> String
$cshow :: MidiChan -> String
showsPrec :: IPitch -> MidiChan -> ShowS
$cshowsPrec :: IPitch -> MidiChan -> ShowS
Show,IPitch -> MidiChan
MidiChan -> IPitch
MidiChan -> [MidiChan]
MidiChan -> MidiChan
MidiChan -> MidiChan -> [MidiChan]
MidiChan -> MidiChan -> MidiChan -> [MidiChan]
(MidiChan -> MidiChan)
-> (MidiChan -> MidiChan)
-> (IPitch -> MidiChan)
-> (MidiChan -> IPitch)
-> (MidiChan -> [MidiChan])
-> (MidiChan -> MidiChan -> [MidiChan])
-> (MidiChan -> MidiChan -> [MidiChan])
-> (MidiChan -> MidiChan -> MidiChan -> [MidiChan])
-> Enum MidiChan
forall a.
(a -> a)
-> (a -> a)
-> (IPitch -> a)
-> (a -> IPitch)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MidiChan -> MidiChan -> MidiChan -> [MidiChan]
$cenumFromThenTo :: MidiChan -> MidiChan -> MidiChan -> [MidiChan]
enumFromTo :: MidiChan -> MidiChan -> [MidiChan]
$cenumFromTo :: MidiChan -> MidiChan -> [MidiChan]
enumFromThen :: MidiChan -> MidiChan -> [MidiChan]
$cenumFromThen :: MidiChan -> MidiChan -> [MidiChan]
enumFrom :: MidiChan -> [MidiChan]
$cenumFrom :: MidiChan -> [MidiChan]
fromEnum :: MidiChan -> IPitch
$cfromEnum :: MidiChan -> IPitch
toEnum :: IPitch -> MidiChan
$ctoEnum :: IPitch -> MidiChan
pred :: MidiChan -> MidiChan
$cpred :: MidiChan -> MidiChan
succ :: MidiChan -> MidiChan
$csucc :: MidiChan -> MidiChan
Enum,MidiChan
MidiChan -> MidiChan -> Bounded MidiChan
forall a. a -> a -> Bounded a
maxBound :: MidiChan
$cmaxBound :: MidiChan
minBound :: MidiChan
$cminBound :: 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
min :: MidiChan -> MidiChan -> MidiChan
$cmin :: MidiChan -> MidiChan -> MidiChan
max :: MidiChan -> MidiChan -> MidiChan
$cmax :: MidiChan -> MidiChan -> MidiChan
>= :: MidiChan -> MidiChan -> Bool
$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
compare :: MidiChan -> MidiChan -> Ordering
$ccompare :: MidiChan -> MidiChan -> Ordering
$cp1Ord :: Eq 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
fromInteger :: Integer -> MidiChan
$cfromInteger :: Integer -> MidiChan
signum :: MidiChan -> MidiChan
$csignum :: MidiChan -> MidiChan
abs :: MidiChan -> MidiChan
$cabs :: MidiChan -> MidiChan
negate :: MidiChan -> MidiChan
$cnegate :: MidiChan -> MidiChan
* :: MidiChan -> MidiChan -> MidiChan
$c* :: MidiChan -> MidiChan -> MidiChan
- :: MidiChan -> MidiChan -> MidiChan
$c- :: MidiChan -> MidiChan -> MidiChan
+ :: MidiChan -> MidiChan -> MidiChan
$c+ :: MidiChan -> MidiChan -> 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
toRational :: MidiChan -> Rational
$ctoRational :: MidiChan -> Rational
$cp2Real :: Ord MidiChan
$cp1Real :: Num MidiChan
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
toInteger :: MidiChan -> Integer
$ctoInteger :: MidiChan -> Integer
divMod :: MidiChan -> MidiChan -> (MidiChan, MidiChan)
$cdivMod :: MidiChan -> MidiChan -> (MidiChan, MidiChan)
quotRem :: MidiChan -> MidiChan -> (MidiChan, MidiChan)
$cquotRem :: MidiChan -> MidiChan -> (MidiChan, MidiChan)
mod :: MidiChan -> MidiChan -> MidiChan
$cmod :: MidiChan -> MidiChan -> MidiChan
div :: MidiChan -> MidiChan -> MidiChan
$cdiv :: MidiChan -> MidiChan -> MidiChan
rem :: MidiChan -> MidiChan -> MidiChan
$crem :: MidiChan -> MidiChan -> MidiChan
quot :: MidiChan -> MidiChan -> MidiChan
$cquot :: MidiChan -> MidiChan -> MidiChan
$cp2Integral :: Enum MidiChan
$cp1Integral :: Real MidiChan
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
/= :: MidiVelocity -> MidiVelocity -> Bool
$c/= :: MidiVelocity -> MidiVelocity -> Bool
== :: MidiVelocity -> MidiVelocity -> Bool
$c== :: MidiVelocity -> MidiVelocity -> Bool
Eq,IPitch -> MidiVelocity -> ShowS
[MidiVelocity] -> ShowS
MidiVelocity -> String
(IPitch -> MidiVelocity -> ShowS)
-> (MidiVelocity -> String)
-> ([MidiVelocity] -> ShowS)
-> Show MidiVelocity
forall a.
(IPitch -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MidiVelocity] -> ShowS
$cshowList :: [MidiVelocity] -> ShowS
show :: MidiVelocity -> String
$cshow :: MidiVelocity -> String
showsPrec :: IPitch -> MidiVelocity -> ShowS
$cshowsPrec :: IPitch -> MidiVelocity -> ShowS
Show,IPitch -> MidiVelocity
MidiVelocity -> IPitch
MidiVelocity -> [MidiVelocity]
MidiVelocity -> MidiVelocity
MidiVelocity -> MidiVelocity -> [MidiVelocity]
MidiVelocity -> MidiVelocity -> MidiVelocity -> [MidiVelocity]
(MidiVelocity -> MidiVelocity)
-> (MidiVelocity -> MidiVelocity)
-> (IPitch -> MidiVelocity)
-> (MidiVelocity -> IPitch)
-> (MidiVelocity -> [MidiVelocity])
-> (MidiVelocity -> MidiVelocity -> [MidiVelocity])
-> (MidiVelocity -> MidiVelocity -> [MidiVelocity])
-> (MidiVelocity -> MidiVelocity -> MidiVelocity -> [MidiVelocity])
-> Enum MidiVelocity
forall a.
(a -> a)
-> (a -> a)
-> (IPitch -> a)
-> (a -> IPitch)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MidiVelocity -> MidiVelocity -> MidiVelocity -> [MidiVelocity]
$cenumFromThenTo :: MidiVelocity -> MidiVelocity -> MidiVelocity -> [MidiVelocity]
enumFromTo :: MidiVelocity -> MidiVelocity -> [MidiVelocity]
$cenumFromTo :: MidiVelocity -> MidiVelocity -> [MidiVelocity]
enumFromThen :: MidiVelocity -> MidiVelocity -> [MidiVelocity]
$cenumFromThen :: MidiVelocity -> MidiVelocity -> [MidiVelocity]
enumFrom :: MidiVelocity -> [MidiVelocity]
$cenumFrom :: MidiVelocity -> [MidiVelocity]
fromEnum :: MidiVelocity -> IPitch
$cfromEnum :: MidiVelocity -> IPitch
toEnum :: IPitch -> MidiVelocity
$ctoEnum :: IPitch -> MidiVelocity
pred :: MidiVelocity -> MidiVelocity
$cpred :: MidiVelocity -> MidiVelocity
succ :: MidiVelocity -> MidiVelocity
$csucc :: MidiVelocity -> MidiVelocity
Enum,MidiVelocity
MidiVelocity -> MidiVelocity -> Bounded MidiVelocity
forall a. a -> a -> Bounded a
maxBound :: MidiVelocity
$cmaxBound :: MidiVelocity
minBound :: MidiVelocity
$cminBound :: 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
min :: MidiVelocity -> MidiVelocity -> MidiVelocity
$cmin :: MidiVelocity -> MidiVelocity -> MidiVelocity
max :: MidiVelocity -> MidiVelocity -> MidiVelocity
$cmax :: MidiVelocity -> MidiVelocity -> MidiVelocity
>= :: MidiVelocity -> MidiVelocity -> Bool
$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
compare :: MidiVelocity -> MidiVelocity -> Ordering
$ccompare :: MidiVelocity -> MidiVelocity -> Ordering
$cp1Ord :: Eq 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
fromInteger :: Integer -> MidiVelocity
$cfromInteger :: Integer -> MidiVelocity
signum :: MidiVelocity -> MidiVelocity
$csignum :: MidiVelocity -> MidiVelocity
abs :: MidiVelocity -> MidiVelocity
$cabs :: MidiVelocity -> MidiVelocity
negate :: MidiVelocity -> MidiVelocity
$cnegate :: MidiVelocity -> MidiVelocity
* :: MidiVelocity -> MidiVelocity -> MidiVelocity
$c* :: MidiVelocity -> MidiVelocity -> MidiVelocity
- :: MidiVelocity -> MidiVelocity -> MidiVelocity
$c- :: MidiVelocity -> MidiVelocity -> MidiVelocity
+ :: MidiVelocity -> MidiVelocity -> MidiVelocity
$c+ :: MidiVelocity -> MidiVelocity -> 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
toRational :: MidiVelocity -> Rational
$ctoRational :: MidiVelocity -> Rational
$cp2Real :: Ord MidiVelocity
$cp1Real :: Num MidiVelocity
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
toInteger :: MidiVelocity -> Integer
$ctoInteger :: MidiVelocity -> Integer
divMod :: MidiVelocity -> MidiVelocity -> (MidiVelocity, MidiVelocity)
$cdivMod :: MidiVelocity -> MidiVelocity -> (MidiVelocity, MidiVelocity)
quotRem :: MidiVelocity -> MidiVelocity -> (MidiVelocity, MidiVelocity)
$cquotRem :: MidiVelocity -> MidiVelocity -> (MidiVelocity, MidiVelocity)
mod :: MidiVelocity -> MidiVelocity -> MidiVelocity
$cmod :: MidiVelocity -> MidiVelocity -> MidiVelocity
div :: MidiVelocity -> MidiVelocity -> MidiVelocity
$cdiv :: MidiVelocity -> MidiVelocity -> MidiVelocity
rem :: MidiVelocity -> MidiVelocity -> MidiVelocity
$crem :: MidiVelocity -> MidiVelocity -> MidiVelocity
quot :: MidiVelocity -> MidiVelocity -> MidiVelocity
$cquot :: MidiVelocity -> MidiVelocity -> MidiVelocity
$cp2Integral :: Enum MidiVelocity
$cp1Integral :: Real MidiVelocity
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
/= :: MidiProgram -> MidiProgram -> Bool
$c/= :: MidiProgram -> MidiProgram -> Bool
== :: MidiProgram -> MidiProgram -> Bool
$c== :: MidiProgram -> MidiProgram -> Bool
Eq,IPitch -> MidiProgram -> ShowS
[MidiProgram] -> ShowS
MidiProgram -> String
(IPitch -> MidiProgram -> ShowS)
-> (MidiProgram -> String)
-> ([MidiProgram] -> ShowS)
-> Show MidiProgram
forall a.
(IPitch -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MidiProgram] -> ShowS
$cshowList :: [MidiProgram] -> ShowS
show :: MidiProgram -> String
$cshow :: MidiProgram -> String
showsPrec :: IPitch -> MidiProgram -> ShowS
$cshowsPrec :: IPitch -> MidiProgram -> ShowS
Show,IPitch -> MidiProgram
MidiProgram -> IPitch
MidiProgram -> [MidiProgram]
MidiProgram -> MidiProgram
MidiProgram -> MidiProgram -> [MidiProgram]
MidiProgram -> MidiProgram -> MidiProgram -> [MidiProgram]
(MidiProgram -> MidiProgram)
-> (MidiProgram -> MidiProgram)
-> (IPitch -> MidiProgram)
-> (MidiProgram -> IPitch)
-> (MidiProgram -> [MidiProgram])
-> (MidiProgram -> MidiProgram -> [MidiProgram])
-> (MidiProgram -> MidiProgram -> [MidiProgram])
-> (MidiProgram -> MidiProgram -> MidiProgram -> [MidiProgram])
-> Enum MidiProgram
forall a.
(a -> a)
-> (a -> a)
-> (IPitch -> a)
-> (a -> IPitch)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MidiProgram -> MidiProgram -> MidiProgram -> [MidiProgram]
$cenumFromThenTo :: MidiProgram -> MidiProgram -> MidiProgram -> [MidiProgram]
enumFromTo :: MidiProgram -> MidiProgram -> [MidiProgram]
$cenumFromTo :: MidiProgram -> MidiProgram -> [MidiProgram]
enumFromThen :: MidiProgram -> MidiProgram -> [MidiProgram]
$cenumFromThen :: MidiProgram -> MidiProgram -> [MidiProgram]
enumFrom :: MidiProgram -> [MidiProgram]
$cenumFrom :: MidiProgram -> [MidiProgram]
fromEnum :: MidiProgram -> IPitch
$cfromEnum :: MidiProgram -> IPitch
toEnum :: IPitch -> MidiProgram
$ctoEnum :: IPitch -> MidiProgram
pred :: MidiProgram -> MidiProgram
$cpred :: MidiProgram -> MidiProgram
succ :: MidiProgram -> MidiProgram
$csucc :: MidiProgram -> MidiProgram
Enum,MidiProgram
MidiProgram -> MidiProgram -> Bounded MidiProgram
forall a. a -> a -> Bounded a
maxBound :: MidiProgram
$cmaxBound :: MidiProgram
minBound :: MidiProgram
$cminBound :: 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
min :: MidiProgram -> MidiProgram -> MidiProgram
$cmin :: MidiProgram -> MidiProgram -> MidiProgram
max :: MidiProgram -> MidiProgram -> MidiProgram
$cmax :: MidiProgram -> MidiProgram -> MidiProgram
>= :: MidiProgram -> MidiProgram -> Bool
$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
compare :: MidiProgram -> MidiProgram -> Ordering
$ccompare :: MidiProgram -> MidiProgram -> Ordering
$cp1Ord :: Eq 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
fromInteger :: Integer -> MidiProgram
$cfromInteger :: Integer -> MidiProgram
signum :: MidiProgram -> MidiProgram
$csignum :: MidiProgram -> MidiProgram
abs :: MidiProgram -> MidiProgram
$cabs :: MidiProgram -> MidiProgram
negate :: MidiProgram -> MidiProgram
$cnegate :: MidiProgram -> MidiProgram
* :: MidiProgram -> MidiProgram -> MidiProgram
$c* :: MidiProgram -> MidiProgram -> MidiProgram
- :: MidiProgram -> MidiProgram -> MidiProgram
$c- :: MidiProgram -> MidiProgram -> MidiProgram
+ :: MidiProgram -> MidiProgram -> MidiProgram
$c+ :: MidiProgram -> MidiProgram -> 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
toRational :: MidiProgram -> Rational
$ctoRational :: MidiProgram -> Rational
$cp2Real :: Ord MidiProgram
$cp1Real :: Num MidiProgram
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
toInteger :: MidiProgram -> Integer
$ctoInteger :: MidiProgram -> Integer
divMod :: MidiProgram -> MidiProgram -> (MidiProgram, MidiProgram)
$cdivMod :: MidiProgram -> MidiProgram -> (MidiProgram, MidiProgram)
quotRem :: MidiProgram -> MidiProgram -> (MidiProgram, MidiProgram)
$cquotRem :: MidiProgram -> MidiProgram -> (MidiProgram, MidiProgram)
mod :: MidiProgram -> MidiProgram -> MidiProgram
$cmod :: MidiProgram -> MidiProgram -> MidiProgram
div :: MidiProgram -> MidiProgram -> MidiProgram
$cdiv :: MidiProgram -> MidiProgram -> MidiProgram
rem :: MidiProgram -> MidiProgram -> MidiProgram
$crem :: MidiProgram -> MidiProgram -> MidiProgram
quot :: MidiProgram -> MidiProgram -> MidiProgram
$cquot :: MidiProgram -> MidiProgram -> MidiProgram
$cp2Integral :: Enum MidiProgram
$cp1Integral :: Real MidiProgram
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
/= :: MidiTicks -> MidiTicks -> Bool
$c/= :: MidiTicks -> MidiTicks -> Bool
== :: MidiTicks -> MidiTicks -> Bool
$c== :: MidiTicks -> MidiTicks -> Bool
Eq,IPitch -> MidiTicks -> ShowS
[MidiTicks] -> ShowS
MidiTicks -> String
(IPitch -> MidiTicks -> ShowS)
-> (MidiTicks -> String)
-> ([MidiTicks] -> ShowS)
-> Show MidiTicks
forall a.
(IPitch -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MidiTicks] -> ShowS
$cshowList :: [MidiTicks] -> ShowS
show :: MidiTicks -> String
$cshow :: MidiTicks -> String
showsPrec :: IPitch -> MidiTicks -> ShowS
$cshowsPrec :: IPitch -> MidiTicks -> ShowS
Show,IPitch -> MidiTicks
MidiTicks -> IPitch
MidiTicks -> [MidiTicks]
MidiTicks -> MidiTicks
MidiTicks -> MidiTicks -> [MidiTicks]
MidiTicks -> MidiTicks -> MidiTicks -> [MidiTicks]
(MidiTicks -> MidiTicks)
-> (MidiTicks -> MidiTicks)
-> (IPitch -> MidiTicks)
-> (MidiTicks -> IPitch)
-> (MidiTicks -> [MidiTicks])
-> (MidiTicks -> MidiTicks -> [MidiTicks])
-> (MidiTicks -> MidiTicks -> [MidiTicks])
-> (MidiTicks -> MidiTicks -> MidiTicks -> [MidiTicks])
-> Enum MidiTicks
forall a.
(a -> a)
-> (a -> a)
-> (IPitch -> a)
-> (a -> IPitch)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MidiTicks -> MidiTicks -> MidiTicks -> [MidiTicks]
$cenumFromThenTo :: MidiTicks -> MidiTicks -> MidiTicks -> [MidiTicks]
enumFromTo :: MidiTicks -> MidiTicks -> [MidiTicks]
$cenumFromTo :: MidiTicks -> MidiTicks -> [MidiTicks]
enumFromThen :: MidiTicks -> MidiTicks -> [MidiTicks]
$cenumFromThen :: MidiTicks -> MidiTicks -> [MidiTicks]
enumFrom :: MidiTicks -> [MidiTicks]
$cenumFrom :: MidiTicks -> [MidiTicks]
fromEnum :: MidiTicks -> IPitch
$cfromEnum :: MidiTicks -> IPitch
toEnum :: IPitch -> MidiTicks
$ctoEnum :: IPitch -> MidiTicks
pred :: MidiTicks -> MidiTicks
$cpred :: MidiTicks -> MidiTicks
succ :: MidiTicks -> MidiTicks
$csucc :: MidiTicks -> MidiTicks
Enum,MidiTicks
MidiTicks -> MidiTicks -> Bounded MidiTicks
forall a. a -> a -> Bounded a
maxBound :: MidiTicks
$cmaxBound :: MidiTicks
minBound :: MidiTicks
$cminBound :: 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
min :: MidiTicks -> MidiTicks -> MidiTicks
$cmin :: MidiTicks -> MidiTicks -> MidiTicks
max :: MidiTicks -> MidiTicks -> MidiTicks
$cmax :: MidiTicks -> MidiTicks -> MidiTicks
>= :: MidiTicks -> MidiTicks -> Bool
$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
compare :: MidiTicks -> MidiTicks -> Ordering
$ccompare :: MidiTicks -> MidiTicks -> Ordering
$cp1Ord :: Eq 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
fromInteger :: Integer -> MidiTicks
$cfromInteger :: Integer -> MidiTicks
signum :: MidiTicks -> MidiTicks
$csignum :: MidiTicks -> MidiTicks
abs :: MidiTicks -> MidiTicks
$cabs :: MidiTicks -> MidiTicks
negate :: MidiTicks -> MidiTicks
$cnegate :: MidiTicks -> MidiTicks
* :: MidiTicks -> MidiTicks -> MidiTicks
$c* :: MidiTicks -> MidiTicks -> MidiTicks
- :: MidiTicks -> MidiTicks -> MidiTicks
$c- :: MidiTicks -> MidiTicks -> MidiTicks
+ :: MidiTicks -> MidiTicks -> MidiTicks
$c+ :: MidiTicks -> MidiTicks -> 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
toRational :: MidiTicks -> Rational
$ctoRational :: MidiTicks -> Rational
$cp2Real :: Ord MidiTicks
$cp1Real :: Num MidiTicks
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
toInteger :: MidiTicks -> Integer
$ctoInteger :: MidiTicks -> Integer
divMod :: MidiTicks -> MidiTicks -> (MidiTicks, MidiTicks)
$cdivMod :: MidiTicks -> MidiTicks -> (MidiTicks, MidiTicks)
quotRem :: MidiTicks -> MidiTicks -> (MidiTicks, MidiTicks)
$cquotRem :: MidiTicks -> MidiTicks -> (MidiTicks, MidiTicks)
mod :: MidiTicks -> MidiTicks -> MidiTicks
$cmod :: MidiTicks -> MidiTicks -> MidiTicks
div :: MidiTicks -> MidiTicks -> MidiTicks
$cdiv :: MidiTicks -> MidiTicks -> MidiTicks
rem :: MidiTicks -> MidiTicks -> MidiTicks
$crem :: MidiTicks -> MidiTicks -> MidiTicks
quot :: MidiTicks -> MidiTicks -> MidiTicks
$cquot :: MidiTicks -> MidiTicks -> MidiTicks
$cp2Integral :: Enum MidiTicks
$cp1Integral :: Real MidiTicks
Integral)

-- | Rational to ticks
toTicks :: MidiTicks -> Iso' Rational IDur
toTicks :: MidiTicks -> Iso' Rational IPitch
toTicks MidiTicks
t = (Rational -> IPitch)
-> (IPitch -> Rational) -> Iso' Rational IPitch
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Rational -> IPitch
to' IPitch -> Rational
from' where
    to' :: Rational -> IPitch
to' = Rational -> IPitch
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Rational -> IPitch)
-> (Rational -> Rational) -> Rational -> IPitch
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' :: IPitch -> 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) -> (IPitch -> Integer) -> IPitch -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPitch -> 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 (IPitch -> Tempo
toTempo (IPitch -> Tempo) -> IPitch -> Tempo
forall a b. (a -> b) -> a -> b
$ MidiTicks -> IPitch
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 :: 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 :: a -> MidiTempo
fromBPM a
b | a
b a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 = Rational -> MidiTempo
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 = IPitch -> MidiProgram
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IPitch -> MidiProgram)
-> (Instrument -> IPitch) -> Instrument -> MidiProgram
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instrument -> IPitch
forall a. Enum a => a -> IPitch
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
. (IPitch, [[(ElapsedTime, T)]]) -> [[(ElapsedTime, T)]]
forall a b. (a, b) -> b
snd ((IPitch, [[(ElapsedTime, T)]]) -> [[(ElapsedTime, T)]])
-> ([MidiEvent] -> (IPitch, [[(ElapsedTime, T)]]))
-> [MidiEvent]
-> [[(ElapsedTime, T)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IPitch -> MidiEvent -> (IPitch, [(ElapsedTime, T)]))
-> IPitch -> [MidiEvent] -> (IPitch, [[(ElapsedTime, T)]])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL IPitch -> MidiEvent -> (IPitch, [(ElapsedTime, T)])
conv IPitch
0
    where conv :: IDur -> MidiEvent -> (IDur,[(ElapsedTime,MEvent.T)])
          conv :: IPitch -> MidiEvent -> (IPitch, [(ElapsedTime, T)])
conv IPitch
_ (Pad IPitch
dur) = (IPitch
dur,[])
          conv IPitch
off (Event T
e) = (IPitch
0,[(Integer -> ElapsedTime
toElapsedTime (Integer -> ElapsedTime) -> Integer -> ElapsedTime
forall a b. (a -> b) -> a -> b
$ IPitch -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral IPitch
off,T
e)])


-- | turn notes into track events.
toNoteEvents :: MidiNotes notes => MidiChan -> MidiVelocity -> notes -> [MidiEvent]
toNoteEvents :: MidiChan -> MidiVelocity -> notes -> [MidiEvent]
toNoteEvents MidiChan
chan MidiVelocity
vel = (([IPitch], IPitch) -> [MidiEvent])
-> [([IPitch], IPitch)] -> [MidiEvent]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (MidiChan -> MidiVelocity -> ([IPitch], IPitch) -> [MidiEvent]
noteEvents MidiChan
chan MidiVelocity
vel) ([([IPitch], IPitch)] -> [MidiEvent])
-> (notes -> [([IPitch], IPitch)]) -> notes -> [MidiEvent]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. notes -> [([IPitch], IPitch)]
forall a. MidiNotes a => a -> [([IPitch], IPitch)]
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
. IPitch -> Tempo
toTempo (IPitch -> Tempo) -> (MidiTempo -> IPitch) -> MidiTempo -> Tempo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MidiTempo -> IPitch
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 (IPitch -> Channel
toChannel (IPitch -> Channel) -> IPitch -> Channel
forall a b. (a -> b) -> a -> b
$ MidiChan -> IPitch
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 (IPitch -> Program
toProgram (IPitch -> Program) -> IPitch -> Program
forall a b. (a -> b) -> a -> b
$ MidiProgram -> IPitch
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 -> ([IPitch], IPitch) -> [MidiEvent]
noteEvents MidiChan
chan MidiVelocity
vel ([IPitch]
ps,IPitch
dur) = (MidiChan -> MidiVelocity -> IPitch -> MidiEvent) -> [MidiEvent]
forall b b. Num b => (MidiChan -> MidiVelocity -> b -> b) -> [b]
evs MidiChan -> MidiVelocity -> IPitch -> MidiEvent
noteOn [MidiEvent] -> [MidiEvent] -> [MidiEvent]
forall a. [a] -> [a] -> [a]
++ [IPitch -> MidiEvent
Pad IPitch
dur] [MidiEvent] -> [MidiEvent] -> [MidiEvent]
forall a. [a] -> [a] -> [a]
++ (MidiChan -> MidiVelocity -> IPitch -> MidiEvent) -> [MidiEvent]
forall b b. Num b => (MidiChan -> MidiVelocity -> b -> b) -> [b]
evs MidiChan -> MidiVelocity -> IPitch -> MidiEvent
noteOff
    where evs :: (MidiChan -> MidiVelocity -> b -> b) -> [b]
evs MidiChan -> MidiVelocity -> b -> b
f = (IPitch -> b) -> [IPitch] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (MidiChan -> MidiVelocity -> b -> b
f MidiChan
chan MidiVelocity
vel (b -> b) -> (IPitch -> b) -> IPitch -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPitch -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral) [IPitch]
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 -> IPitch -> MidiEvent
noteEvent Pitch -> Velocity -> T
f MidiChan
chan MidiVelocity
vel IPitch
pitch = MidiChan -> T -> MidiEvent
voiceEvent MidiChan
chan
                             (Pitch -> Velocity -> T
f (IPitch -> Pitch
toPitch (IPitch -> IPitch
forall a b. (Integral a, Num b) => a -> b
fromIntegral IPitch
pitch))
                                    (IPitch -> Velocity
toVelocity (IPitch -> Velocity) -> IPitch -> Velocity
forall a b. (a -> b) -> a -> b
$ MidiVelocity -> IPitch
forall a b. (Integral a, Num b) => a -> b
fromIntegral MidiVelocity
vel))
noteOn :: MidiChan -> MidiVelocity -> IPitch -> MidiEvent
noteOn :: MidiChan -> MidiVelocity -> IPitch -> MidiEvent
noteOn = (Pitch -> Velocity -> T)
-> MidiChan -> MidiVelocity -> IPitch -> MidiEvent
noteEvent Pitch -> Velocity -> T
NoteOn

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


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


playMidi :: MidiNotes n => FilePath -> Int -> [(Instrument,n)] -> IO ()
playMidi :: String -> IPitch -> [(Instrument, n)] -> IO ()
playMidi String
file IPitch
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 (IPitch -> MidiTempo
forall a. (Real a, Show a) => a -> MidiTempo
fromBPM IPitch
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)