{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_HADDOCK show-extensions #-}
{-|
Module: Musicology.Pitch.Midi
Description: Enharmonic pitch and interval types (MIDI).
Copyright: Christoph Finkensiep, 2021
License: BSD
Maintainer: chfin@chfin.de
Stability: experimental

This module defines pitch and interval types for enharmonic/chromatic pitch, (as used in MIDI).
Midi intervals are just 'Int's.
-}
module Musicology.Pitch.Midi
  ( -- * Interval types
    MidiInterval
  , MidiIC(..)
  , mic
  -- * Pitch types
  , MidiPitch
  , MidiPC
  , midip
  , midipc
  ) where

import           Musicology.Pitch.Class
import           Musicology.Pitch.Internal

import           Control.DeepSeq                ( NFData )
import           Data.Hashable                  ( Hashable )
import qualified Text.ParserCombinators.ReadP  as R
import           Text.Read                      ( readMaybe )

-- MidiInterval
---------------

newtype MidiIC = MidiIC Int
  deriving (MidiIC -> MidiIC -> Bool
(MidiIC -> MidiIC -> Bool)
-> (MidiIC -> MidiIC -> Bool) -> Eq MidiIC
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MidiIC -> MidiIC -> Bool
== :: MidiIC -> MidiIC -> Bool
$c/= :: MidiIC -> MidiIC -> Bool
/= :: MidiIC -> MidiIC -> Bool
Eq, Eq MidiIC
Eq MidiIC =>
(MidiIC -> MidiIC -> Ordering)
-> (MidiIC -> MidiIC -> Bool)
-> (MidiIC -> MidiIC -> Bool)
-> (MidiIC -> MidiIC -> Bool)
-> (MidiIC -> MidiIC -> Bool)
-> (MidiIC -> MidiIC -> MidiIC)
-> (MidiIC -> MidiIC -> MidiIC)
-> Ord MidiIC
MidiIC -> MidiIC -> Bool
MidiIC -> MidiIC -> Ordering
MidiIC -> MidiIC -> MidiIC
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 :: MidiIC -> MidiIC -> Ordering
compare :: MidiIC -> MidiIC -> Ordering
$c< :: MidiIC -> MidiIC -> Bool
< :: MidiIC -> MidiIC -> Bool
$c<= :: MidiIC -> MidiIC -> Bool
<= :: MidiIC -> MidiIC -> Bool
$c> :: MidiIC -> MidiIC -> Bool
> :: MidiIC -> MidiIC -> Bool
$c>= :: MidiIC -> MidiIC -> Bool
>= :: MidiIC -> MidiIC -> Bool
$cmax :: MidiIC -> MidiIC -> MidiIC
max :: MidiIC -> MidiIC -> MidiIC
$cmin :: MidiIC -> MidiIC -> MidiIC
min :: MidiIC -> MidiIC -> MidiIC
Ord, MidiIC -> ()
(MidiIC -> ()) -> NFData MidiIC
forall a. (a -> ()) -> NFData a
$crnf :: MidiIC -> ()
rnf :: MidiIC -> ()
NFData, Int -> MidiIC -> ShowS
[MidiIC] -> ShowS
MidiIC -> String
(Int -> MidiIC -> ShowS)
-> (MidiIC -> String) -> ([MidiIC] -> ShowS) -> Show MidiIC
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MidiIC -> ShowS
showsPrec :: Int -> MidiIC -> ShowS
$cshow :: MidiIC -> String
show :: MidiIC -> String
$cshowList :: [MidiIC] -> ShowS
showList :: [MidiIC] -> ShowS
Show, Eq MidiIC
Eq MidiIC =>
(Int -> MidiIC -> Int) -> (MidiIC -> Int) -> Hashable MidiIC
Int -> MidiIC -> Int
MidiIC -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> MidiIC -> Int
hashWithSalt :: Int -> MidiIC -> Int
$chash :: MidiIC -> Int
hash :: MidiIC -> Int
Hashable)

mic :: Int -> MidiIC
mic :: Int -> MidiIC
mic = Int -> MidiIC
MidiIC (Int -> MidiIC) -> (Int -> Int) -> Int -> MidiIC
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int) -> Int -> Int -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
12

instance AdditiveGroup MidiIC where
  zeroV :: MidiIC
zeroV = Int -> MidiIC
MidiIC Int
0
  negateV :: MidiIC -> MidiIC
negateV (MidiIC Int
m) = Int -> MidiIC
mic (Int -> MidiIC) -> Int -> MidiIC
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Num a => a -> a
negate Int
m
  (MidiIC Int
a) ^+^ :: MidiIC -> MidiIC -> MidiIC
^+^ (MidiIC Int
b) = Int -> MidiIC
mic (Int -> MidiIC) -> Int -> MidiIC
forall a b. (a -> b) -> a -> b
$ Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b
  (MidiIC Int
a) ^-^ :: MidiIC -> MidiIC -> MidiIC
^-^ (MidiIC Int
b) = Int -> MidiIC
mic (Int -> MidiIC) -> Int -> MidiIC
forall a b. (a -> b) -> a -> b
$ Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
b

instance VectorSpace MidiIC where
  type Scalar MidiIC = Int
  Scalar MidiIC
s *^ :: Scalar MidiIC -> MidiIC -> MidiIC
*^ (MidiIC Int
i) = Int -> MidiIC
mic (Int
Scalar MidiIC
s Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i)

instance Interval MidiIC where
  type ICOf MidiIC = MidiIC
  ic :: MidiIC -> ICOf MidiIC
ic     = MidiIC -> ICOf MidiIC
MidiIC -> MidiIC
forall a. a -> a
id
  octave :: MidiIC
octave = Int -> MidiIC
mic Int
0
  direction :: MidiIC -> Ordering
direction (MidiIC Int
0) = Ordering
EQ
  direction (MidiIC Int
i) = if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Ordering
EQ else Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
6 Int
i

instance IntervalClass MidiIC where
  type IOf MidiIC = MidiInterval
  -- ic = mic
  emb :: MidiIC -> IOf MidiIC
emb (MidiIC Int
i) = Int
IOf MidiIC
i

instance Diatonic MidiIC where
  isStep :: MidiIC -> Bool
isStep (MidiIC Int
i) = Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
2 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
12 Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
9 -- no i < 12?

instance Chromatic MidiIC where
  chromaticSemitone :: MidiIC
chromaticSemitone = Int -> MidiIC
MidiIC Int
1

instance Notation MidiIC where
  showNotation :: MidiIC -> String
showNotation (MidiIC Int
i) = String
"ic" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
i
  parseNotation :: ReadP MidiIC
parseNotation = String -> ReadP String
R.string String
"ic" ReadP String -> ReadP MidiIC -> ReadP MidiIC
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int -> MidiIC
mic (Int -> MidiIC) -> ReadP Int -> ReadP MidiIC
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP Int
parseInt

instance ToMidi MidiIC where
  toMidi :: MidiIC -> Int
toMidi (MidiIC Int
x) = Int
x

type MidiInterval = Int
--  deriving (Eq, Ord, Show, Enum, Num, Real, Integral)

instance Interval Int where
  type ICOf Int = MidiIC
  ic :: Int -> ICOf Int
ic     = Int -> ICOf Int
Int -> MidiIC
mic
  octave :: Int
octave = Int
12
--  direction i = compare i 0
--  icInt int = if int > 6 then int - 12 else int

-- instance ClassyInterval Int where
--   type PCOf Int = MidiIC

instance Diatonic Int where
  isStep :: Int -> Bool
isStep Int
a = Int -> Int
forall a. Num a => a -> a
abs Int
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
2

instance Chromatic Int where
  chromaticSemitone :: Int
chromaticSemitone = Int
1

instance Notation MidiInterval where
  showNotation :: Int -> String
showNotation  = Int -> String
forall a. Show a => a -> String
show
  parseNotation :: ReadP Int
parseNotation = ReadP Int
parseInt
  readNotation :: String -> Maybe Int
readNotation  = String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe

instance ToMidi MidiInterval where
  toMidi :: Int -> Int
toMidi = Int -> Int
forall a. a -> a
id

-- midi pitch
-------------

type MidiPitch = Pitch MidiInterval
type MidiPC = Pitch MidiIC

midip :: Int -> MidiPitch
midip :: Int -> MidiPitch
midip = Int -> MidiPitch
forall a. a -> Pitch a
Pitch

midipc :: Int -> MidiPC
midipc :: Int -> MidiPC
midipc = MidiIC -> MidiPC
forall a. a -> Pitch a
Pitch (MidiIC -> MidiPC) -> (Int -> MidiIC) -> Int -> MidiPC
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> MidiIC
mic

instance Notation MidiPitch where
  showNotation :: MidiPitch -> String
showNotation (Pitch Int
i) = String
"p" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall i. Notation i => i -> String
showNotation Int
i
  parseNotation :: ReadP MidiPitch
parseNotation = Char -> ReadP Char
R.char Char
'p' ReadP Char -> ReadP MidiPitch -> ReadP MidiPitch
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Int -> MidiPitch
midip (Int -> MidiPitch) -> ReadP Int -> ReadP MidiPitch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP Int
parseInt)

instance Show MidiPitch where
  show :: MidiPitch -> String
show = MidiPitch -> String
forall i. Notation i => i -> String
showNotation

instance ToMidi MidiPitch where
  toMidi :: MidiPitch -> Int
toMidi (Pitch Int
i) = Int
i

instance Notation MidiPC where
  showNotation :: MidiPC -> String
showNotation (Pitch (MidiIC Int
i)) = String
"pc" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall i. Notation i => i -> String
showNotation Int
i
  parseNotation :: ReadP MidiPC
parseNotation = String -> ReadP String
R.string String
"pc" ReadP String -> ReadP MidiPC -> ReadP MidiPC
forall a b. ReadP a -> ReadP b -> ReadP b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Int -> MidiPC
midipc (Int -> MidiPC) -> ReadP Int -> ReadP MidiPC
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP Int
parseInt)

instance Show MidiPC where
  show :: MidiPC -> String
show = MidiPC -> String
forall i. Notation i => i -> String
showNotation

instance ToMidi MidiPC where
  toMidi :: MidiPC -> Int
toMidi (Pitch (MidiIC Int
ic)) = Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ic