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

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

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

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

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

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

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

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

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

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

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

instance Interval Int where
  type ICOf Int = MidiIC
  ic :: MidiInterval -> ICOf MidiInterval
ic     = MidiInterval -> MidiIC
mic
  octave :: MidiInterval
octave = MidiInterval
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 :: MidiInterval -> Bool
isStep MidiInterval
a = forall a. Num a => a -> a
abs MidiInterval
a forall a. Ord a => a -> a -> Bool
<= MidiInterval
2

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

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

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

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

type MidiPitch = Pitch MidiInterval
type MidiPC = Pitch MidiIC

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

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

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

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

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

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

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

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