-- Copyright 2013 Evan Laforge -- This program is distributed under the terms of the GNU General Public -- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt {-# LANGUAGE DeriveDataTypeable #-} {- | Representation for scales, pitches, and frequencies (note numbers). There are many representations for a pitch, at many different levels of abstraction. -} module Perform.Pitch ( -- * Note Note(..), note_text -- * Pitch , Pitch(..), pitch, Degree(..) , Octave, PitchClass, Accidentals, Semi, FSemi, Step , pitch_accidentals, pitch_pc , add_octave, add_pc, diff_pc , middle_octave, middle_c -- * Input , Input(..), KbdType(..), Frac -- * NoteNumber , NoteNumber(..), nn, nn_to_double , Cent, nn_to_cents , nns_equal, nns_close -- * Hz , Hz, add_hz, modify_hz, nn_to_hz, hz_to_nn, middle_c_hz -- * Scale , ScaleId(..), empty_scale, twelve , Transpose(..), zero_transpose, modify_transpose , Key(Key), key_text ) where import qualified Data.String as String import qualified Data.Text as Text import qualified Data.Typeable as Typeable import qualified Text.ParserCombinators.ReadP as ReadP import qualified Text.Read as Read import qualified Util.Num as Num import qualified Util.Pretty as Pretty import qualified Util.Serialize as Serialize import qualified Util.Test.ApproxEq as ApproxEq import qualified Derive.ShowVal as ShowVal import Global -- * Note -- | A Note is the most abstract representation of pitch, in that it's simply -- an unparsed bit of text representing that pitch. Given a Scale, it's -- expected to name a val call exported by that scale. newtype Note = Note Text deriving (Note -> Note -> Bool (Note -> Note -> Bool) -> (Note -> Note -> Bool) -> Eq Note forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Note -> Note -> Bool $c/= :: Note -> Note -> Bool == :: Note -> Note -> Bool $c== :: Note -> Note -> Bool Eq, Eq Note Eq Note -> (Note -> Note -> Ordering) -> (Note -> Note -> Bool) -> (Note -> Note -> Bool) -> (Note -> Note -> Bool) -> (Note -> Note -> Bool) -> (Note -> Note -> Note) -> (Note -> Note -> Note) -> Ord Note Note -> Note -> Bool Note -> Note -> Ordering Note -> Note -> Note 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 :: Note -> Note -> Note $cmin :: Note -> Note -> Note max :: Note -> Note -> Note $cmax :: Note -> Note -> Note >= :: Note -> Note -> Bool $c>= :: Note -> Note -> Bool > :: Note -> Note -> Bool $c> :: Note -> Note -> Bool <= :: Note -> Note -> Bool $c<= :: Note -> Note -> Bool < :: Note -> Note -> Bool $c< :: Note -> Note -> Bool compare :: Note -> Note -> Ordering $ccompare :: Note -> Note -> Ordering Ord, Cent -> Note -> ShowS [Note] -> ShowS Note -> String (Cent -> Note -> ShowS) -> (Note -> String) -> ([Note] -> ShowS) -> Show Note forall a. (Cent -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Note] -> ShowS $cshowList :: [Note] -> ShowS show :: Note -> String $cshow :: Note -> String showsPrec :: Cent -> Note -> ShowS $cshowsPrec :: Cent -> Note -> ShowS Show, String -> Note (String -> Note) -> IsString Note forall a. (String -> a) -> IsString a fromString :: String -> Note $cfromString :: String -> Note String.IsString, Get Note Putter Note Putter Note -> Get Note -> Serialize Note forall a. Putter a -> Get a -> Serialize a get :: Get Note $cget :: Get Note put :: Putter Note $cput :: Putter Note Serialize.Serialize) note_text :: Note -> Text note_text :: Note -> Text note_text (Note Text s) = Text s instance Pretty Note where pretty :: Note -> Text pretty (Note Text n) = Text n -- * pitch -- | A Pitch is a parsed 'Note'. Functions that want to manipulate notes -- in a scale-independent way can ask the scale to convert to and from a Note. -- Not all scales use all the fields. data Pitch = Pitch { Pitch -> Cent pitch_octave :: !Octave , Pitch -> Degree pitch_degree :: !Degree } deriving (Pitch -> Pitch -> Bool (Pitch -> Pitch -> Bool) -> (Pitch -> Pitch -> Bool) -> Eq Pitch forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Pitch -> Pitch -> Bool $c/= :: Pitch -> Pitch -> Bool == :: Pitch -> Pitch -> Bool $c== :: Pitch -> Pitch -> Bool Eq, Eq Pitch Eq Pitch -> (Pitch -> Pitch -> Ordering) -> (Pitch -> Pitch -> Bool) -> (Pitch -> Pitch -> Bool) -> (Pitch -> Pitch -> Bool) -> (Pitch -> Pitch -> Bool) -> (Pitch -> Pitch -> Pitch) -> (Pitch -> Pitch -> Pitch) -> Ord Pitch Pitch -> Pitch -> Bool Pitch -> Pitch -> Ordering Pitch -> Pitch -> Pitch 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 :: Pitch -> Pitch -> Pitch $cmin :: Pitch -> Pitch -> Pitch max :: Pitch -> Pitch -> Pitch $cmax :: Pitch -> Pitch -> Pitch >= :: Pitch -> Pitch -> Bool $c>= :: Pitch -> Pitch -> Bool > :: Pitch -> Pitch -> Bool $c> :: Pitch -> Pitch -> Bool <= :: Pitch -> Pitch -> Bool $c<= :: Pitch -> Pitch -> Bool < :: Pitch -> Pitch -> Bool $c< :: Pitch -> Pitch -> Bool compare :: Pitch -> Pitch -> Ordering $ccompare :: Pitch -> Pitch -> Ordering Ord, ReadPrec [Pitch] ReadPrec Pitch Cent -> ReadS Pitch ReadS [Pitch] (Cent -> ReadS Pitch) -> ReadS [Pitch] -> ReadPrec Pitch -> ReadPrec [Pitch] -> Read Pitch forall a. (Cent -> ReadS a) -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a readListPrec :: ReadPrec [Pitch] $creadListPrec :: ReadPrec [Pitch] readPrec :: ReadPrec Pitch $creadPrec :: ReadPrec Pitch readList :: ReadS [Pitch] $creadList :: ReadS [Pitch] readsPrec :: Cent -> ReadS Pitch $creadsPrec :: Cent -> ReadS Pitch Read, Cent -> Pitch -> ShowS [Pitch] -> ShowS Pitch -> String (Cent -> Pitch -> ShowS) -> (Pitch -> String) -> ([Pitch] -> ShowS) -> Show Pitch forall a. (Cent -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Pitch] -> ShowS $cshowList :: [Pitch] -> ShowS show :: Pitch -> String $cshow :: Pitch -> String showsPrec :: Cent -> Pitch -> ShowS $cshowsPrec :: Cent -> Pitch -> ShowS Show) pitch :: Enum pc => Octave -> pc -> Pitch pitch :: forall pc. Enum pc => Cent -> pc -> Pitch pitch Cent oct pc pc = Cent -> Degree -> Pitch Pitch Cent oct (Cent -> Cent -> Degree Degree (pc -> Cent forall a. Enum a => a -> Cent fromEnum pc pc) Cent 0) instance Pretty Pitch where pretty :: Pitch -> Text pretty (Pitch Cent oct Degree degree) = Cent -> Text forall a. Show a => a -> Text showt Cent oct Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "-" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Degree -> Text forall a. Pretty a => a -> Text pretty Degree degree -- | This relies on the presence of a @pitch@ val call. instance ShowVal.ShowVal Pitch where show_val :: Pitch -> Text show_val (Pitch Cent oct (Degree Cent pc Cent accs)) = Text "(pitch " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> [Text] -> Text Text.unwords [Text] args Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ")" where args :: [Text] args = (Cent -> Text) -> [Cent] -> [Text] forall a b. (a -> b) -> [a] -> [b] map Cent -> Text forall a. Show a => a -> Text showt ([Cent] -> [Text]) -> [Cent] -> [Text] forall a b. (a -> b) -> a -> b $ Cent oct Cent -> [Cent] -> [Cent] forall a. a -> [a] -> [a] : Cent pc Cent -> [Cent] -> [Cent] forall a. a -> [a] -> [a] : if Cent accs Cent -> Cent -> Bool forall a. Eq a => a -> a -> Bool == Cent 0 then [] else [Cent accs] instance Serialize.Serialize Pitch where put :: Putter Pitch put (Pitch Cent a Degree b) = Putter Cent forall a. Serialize a => Putter a Serialize.put Cent a PutM () -> PutM () -> PutM () forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Putter Degree forall a. Serialize a => Putter a Serialize.put Degree b get :: Get Pitch get = Cent -> Degree -> Pitch Pitch (Cent -> Degree -> Pitch) -> Get Cent -> Get (Degree -> Pitch) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Get Cent forall a. Serialize a => Get a Serialize.get Get (Degree -> Pitch) -> Get Degree -> Get Pitch forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Get Degree forall a. Serialize a => Get a Serialize.get -- | A scale degree, without reference to an octave. data Degree = Degree { Degree -> Cent degree_pc :: !PitchClass -- | Ignored for diatonic scales. , Degree -> Cent degree_accidentals :: !Accidentals } deriving (Degree -> Degree -> Bool (Degree -> Degree -> Bool) -> (Degree -> Degree -> Bool) -> Eq Degree forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Degree -> Degree -> Bool $c/= :: Degree -> Degree -> Bool == :: Degree -> Degree -> Bool $c== :: Degree -> Degree -> Bool Eq, Eq Degree Eq Degree -> (Degree -> Degree -> Ordering) -> (Degree -> Degree -> Bool) -> (Degree -> Degree -> Bool) -> (Degree -> Degree -> Bool) -> (Degree -> Degree -> Bool) -> (Degree -> Degree -> Degree) -> (Degree -> Degree -> Degree) -> Ord Degree Degree -> Degree -> Bool Degree -> Degree -> Ordering Degree -> Degree -> Degree 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 :: Degree -> Degree -> Degree $cmin :: Degree -> Degree -> Degree max :: Degree -> Degree -> Degree $cmax :: Degree -> Degree -> Degree >= :: Degree -> Degree -> Bool $c>= :: Degree -> Degree -> Bool > :: Degree -> Degree -> Bool $c> :: Degree -> Degree -> Bool <= :: Degree -> Degree -> Bool $c<= :: Degree -> Degree -> Bool < :: Degree -> Degree -> Bool $c< :: Degree -> Degree -> Bool compare :: Degree -> Degree -> Ordering $ccompare :: Degree -> Degree -> Ordering Ord, ReadPrec [Degree] ReadPrec Degree Cent -> ReadS Degree ReadS [Degree] (Cent -> ReadS Degree) -> ReadS [Degree] -> ReadPrec Degree -> ReadPrec [Degree] -> Read Degree forall a. (Cent -> ReadS a) -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a readListPrec :: ReadPrec [Degree] $creadListPrec :: ReadPrec [Degree] readPrec :: ReadPrec Degree $creadPrec :: ReadPrec Degree readList :: ReadS [Degree] $creadList :: ReadS [Degree] readsPrec :: Cent -> ReadS Degree $creadsPrec :: Cent -> ReadS Degree Read, Cent -> Degree -> ShowS [Degree] -> ShowS Degree -> String (Cent -> Degree -> ShowS) -> (Degree -> String) -> ([Degree] -> ShowS) -> Show Degree forall a. (Cent -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Degree] -> ShowS $cshowList :: [Degree] -> ShowS show :: Degree -> String $cshow :: Degree -> String showsPrec :: Cent -> Degree -> ShowS $cshowsPrec :: Cent -> Degree -> ShowS Show) instance Pretty Degree where pretty :: Degree -> Text pretty (Degree Cent pc Cent acc) = Cent -> Text forall a. Show a => a -> Text showt Cent pc Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> if Cent acc Cent -> Cent -> Bool forall a. Ord a => a -> a -> Bool < Cent 0 then Cent -> Text -> Text Text.replicate (Cent -> Cent forall a. Num a => a -> a abs Cent acc) Text "b" else Cent -> Text -> Text Text.replicate Cent acc Text "#" instance Serialize.Serialize Degree where put :: Putter Degree put (Degree Cent a Cent b) = Putter Cent forall a. Serialize a => Putter a Serialize.put Cent a PutM () -> PutM () -> PutM () forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Putter Cent forall a. Serialize a => Putter a Serialize.put Cent b get :: Get Degree get = Cent -> Cent -> Degree Degree (Cent -> Cent -> Degree) -> Get Cent -> Get (Cent -> Degree) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Get Cent forall a. Serialize a => Get a Serialize.get Get (Cent -> Degree) -> Get Cent -> Get Degree forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Get Cent forall a. Serialize a => Get a Serialize.get -- | Just a way to label an octave, either relative or absolute. type Octave = Int -- | A PitchClass maps directly to a scale degree, which is a letter in -- traditional Western notation, though this PitchClass may have fewer or -- greater than 7 notes. The PitchClass is absolute in that it doesn't depend -- on the tonic of a key. -- -- These numbers are expected to wrap around at the octave, so they usually use -- modular arithmetic, but if an octave is not handy (i.e. they're not in -- a 'Pitch'), then steps exceeding an octave will be wrapped into an octave -- when one is available. type PitchClass = Int -- | Positive for sharps, negative for flats. type Accidentals = Int -- | Number of semitones. This is an absolute measure from octave 0, -- regardless of whether the scale has notes at octave 0. This is so you can -- convert between Semis and the similarly absolute 'Pitch' in the same way for -- all scales. type Semi = Int -- | This is like 'Semi', but floating point. type FSemi = Double -- | This is a relative amount of transposition. It could be either chromatic -- or diatonic. type Step = Int pitch_accidentals :: Pitch -> Accidentals pitch_accidentals :: Pitch -> Cent pitch_accidentals = Degree -> Cent degree_accidentals (Degree -> Cent) -> (Pitch -> Degree) -> Pitch -> Cent forall b c a. (b -> c) -> (a -> b) -> a -> c . Pitch -> Degree pitch_degree pitch_pc :: Pitch -> PitchClass pitch_pc :: Pitch -> Cent pitch_pc = Degree -> Cent degree_pc (Degree -> Cent) -> (Pitch -> Degree) -> Pitch -> Cent forall b c a. (b -> c) -> (a -> b) -> a -> c . Pitch -> Degree pitch_degree add_octave :: Octave -> Pitch -> Pitch add_octave :: Cent -> Pitch -> Pitch add_octave Cent oct (Pitch Cent octave Degree degree) = Cent -> Degree -> Pitch Pitch (Cent oct Cent -> Cent -> Cent forall a. Num a => a -> a -> a + Cent octave) Degree degree -- | Add diatonic steps. This doesn't deal with key signatures or non-diatonic -- scales. add_pc :: PitchClass -> PitchClass -> Pitch -> Pitch add_pc :: Cent -> Cent -> Pitch -> Pitch add_pc Cent per_octave Cent steps (Pitch Cent octave (Degree Cent pc Cent accs)) = Cent -> Degree -> Pitch Pitch (Cent oct Cent -> Cent -> Cent forall a. Num a => a -> a -> a + Cent octave) (Cent -> Cent -> Degree Degree Cent pc2 Cent accs) where (Cent oct, Cent pc2) = (Cent pc Cent -> Cent -> Cent forall a. Num a => a -> a -> a + Cent steps) Cent -> Cent -> (Cent, Cent) forall a. Integral a => a -> a -> (a, a) `divMod` Cent per_octave diff_pc :: PitchClass -> Pitch -> Pitch -> PitchClass diff_pc :: Cent -> Pitch -> Pitch -> Cent diff_pc Cent per_octave (Pitch Cent oct1 (Degree Cent pc1 Cent _)) (Pitch Cent oct2 (Degree Cent pc2 Cent _)) = Cent oct_diff Cent -> Cent -> Cent forall a. Num a => a -> a -> a + Cent pc1 Cent -> Cent -> Cent forall a. Num a => a -> a -> a - Cent pc2 where oct_diff :: Cent oct_diff = Cent per_octave Cent -> Cent -> Cent forall a. Num a => a -> a -> a * (Cent oct1 Cent -> Cent -> Cent forall a. Num a => a -> a -> a - Cent oct2) -- | The middle octave. The \"center\" of a scale should be oriented around -- this. middle_octave :: Octave middle_octave :: Cent middle_octave = Cent 4 middle_c :: Pitch middle_c :: Pitch middle_c = Cent -> Degree -> Pitch Pitch Cent middle_octave (Cent -> Cent -> Degree Degree Cent 0 Cent 0) -- * Input -- | A physically played note on some input device. This hasn't been mapped to -- a scale yet, so the Pitch is in the context of the device's layout. -- -- I have 3 kinds of kbds: -- -- ASCII has 10 white keys, and black keys between each one. It should be -- relative, so that C or sa is always on Q and Z, and if the octave is <10 -- then it will wrap on the same row. -- -- MIDI has the usual piano layout. It's absolute, so that a relative scale -- can start at keys other than C, if that would be convenient for the layout. -- The octave is rounded up to the nearest multiple of 7, and the extra keys -- are unused, so the octave always starts at C. -- -- Continuum has no keys, just NNs. So it gets the scale degree that's -- closest to the given NN. That's different from the MIDI kbd because the -- MIDI kbd never wants a key to emit something between notes. TODO not -- supported yet data Input = Input !KbdType !Pitch !Frac deriving (Input -> Input -> Bool (Input -> Input -> Bool) -> (Input -> Input -> Bool) -> Eq Input forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Input -> Input -> Bool $c/= :: Input -> Input -> Bool == :: Input -> Input -> Bool $c== :: Input -> Input -> Bool Eq, Cent -> Input -> ShowS [Input] -> ShowS Input -> String (Cent -> Input -> ShowS) -> (Input -> String) -> ([Input] -> ShowS) -> Show Input forall a. (Cent -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Input] -> ShowS $cshowList :: [Input] -> ShowS show :: Input -> String $cshow :: Input -> String showsPrec :: Cent -> Input -> ShowS $cshowsPrec :: Cent -> Input -> ShowS Show) data KbdType = -- | An absolute kbd maps the same key to the same absolute pitch, -- regardless of the key. This is the case for a piano style kbd. -- This is consistent with convention, but also the piano kbd has a fixed -- layout of white and black keys. So if you e.g. transpose A-major to -- start on C, then you have a mysterious black key in between B and C, and -- no way to play C#. PianoKbd -- | A relative kbd always maps the same key to the same relative pitch. -- This is appropriate for the ASCII kbd, because it has \"black keys\" -- between every white key, so scales can be transposed freely. | AsciiKbd deriving (KbdType -> KbdType -> Bool (KbdType -> KbdType -> Bool) -> (KbdType -> KbdType -> Bool) -> Eq KbdType forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: KbdType -> KbdType -> Bool $c/= :: KbdType -> KbdType -> Bool == :: KbdType -> KbdType -> Bool $c== :: KbdType -> KbdType -> Bool Eq, Cent -> KbdType -> ShowS [KbdType] -> ShowS KbdType -> String (Cent -> KbdType -> ShowS) -> (KbdType -> String) -> ([KbdType] -> ShowS) -> Show KbdType forall a. (Cent -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [KbdType] -> ShowS $cshowList :: [KbdType] -> ShowS show :: KbdType -> String $cshow :: KbdType -> String showsPrec :: Cent -> KbdType -> ShowS $cshowsPrec :: Cent -> KbdType -> ShowS Show) -- | A number between -1 and 1 exclusive, representing the portion of the way -- between two scale degrees. I could have used \"Cents\" for this, but that -- implies equal temperedness. type Frac = Double instance Pretty Input where pretty :: Input -> Text pretty (Input KbdType kbd Pitch pitch Double frac) = KbdType -> Text forall a. Show a => a -> Text showt KbdType kbd Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text ":" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Pitch -> Text forall a. Pretty a => a -> Text pretty Pitch pitch Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> if Double frac Double -> Double -> Bool forall a. Eq a => a -> a -> Bool == Double 0 then Text "" else Text "+" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Double -> Text forall a. Pretty a => a -> Text pretty Double frac -- * NoteNumber -- | This is equal tempered scale notes with the same definition as MIDI, so -- MIDI note 0 is NoteNumber 0, at 8.176 Hz, and is -1c. Middle C (4c) is -- NoteNumber 60. -- -- 'Derive.PSignal.PSignal's are converted into this before performance -- since performance doesn't understand scales. newtype NoteNumber = NoteNumber Double deriving (Double -> NoteNumber -> NoteNumber -> Bool (Double -> NoteNumber -> NoteNumber -> Bool) -> ApproxEq NoteNumber forall a. (Double -> a -> a -> Bool) -> ApproxEq a eq :: Double -> NoteNumber -> NoteNumber -> Bool $ceq :: Double -> NoteNumber -> NoteNumber -> Bool ApproxEq.ApproxEq, NoteNumber -> NoteNumber -> Bool (NoteNumber -> NoteNumber -> Bool) -> (NoteNumber -> NoteNumber -> Bool) -> Eq NoteNumber forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: NoteNumber -> NoteNumber -> Bool $c/= :: NoteNumber -> NoteNumber -> Bool == :: NoteNumber -> NoteNumber -> Bool $c== :: NoteNumber -> NoteNumber -> Bool Eq, Eq NoteNumber Eq NoteNumber -> (NoteNumber -> NoteNumber -> Ordering) -> (NoteNumber -> NoteNumber -> Bool) -> (NoteNumber -> NoteNumber -> Bool) -> (NoteNumber -> NoteNumber -> Bool) -> (NoteNumber -> NoteNumber -> Bool) -> (NoteNumber -> NoteNumber -> NoteNumber) -> (NoteNumber -> NoteNumber -> NoteNumber) -> Ord NoteNumber NoteNumber -> NoteNumber -> Bool NoteNumber -> NoteNumber -> Ordering NoteNumber -> NoteNumber -> NoteNumber 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 :: NoteNumber -> NoteNumber -> NoteNumber $cmin :: NoteNumber -> NoteNumber -> NoteNumber max :: NoteNumber -> NoteNumber -> NoteNumber $cmax :: NoteNumber -> NoteNumber -> NoteNumber >= :: NoteNumber -> NoteNumber -> Bool $c>= :: NoteNumber -> NoteNumber -> Bool > :: NoteNumber -> NoteNumber -> Bool $c> :: NoteNumber -> NoteNumber -> Bool <= :: NoteNumber -> NoteNumber -> Bool $c<= :: NoteNumber -> NoteNumber -> Bool < :: NoteNumber -> NoteNumber -> Bool $c< :: NoteNumber -> NoteNumber -> Bool compare :: NoteNumber -> NoteNumber -> Ordering $ccompare :: NoteNumber -> NoteNumber -> Ordering Ord, Num NoteNumber Num NoteNumber -> (NoteNumber -> NoteNumber -> NoteNumber) -> (NoteNumber -> NoteNumber) -> (Rational -> NoteNumber) -> Fractional NoteNumber Rational -> NoteNumber NoteNumber -> NoteNumber NoteNumber -> NoteNumber -> NoteNumber forall a. Num a -> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a fromRational :: Rational -> NoteNumber $cfromRational :: Rational -> NoteNumber recip :: NoteNumber -> NoteNumber $crecip :: NoteNumber -> NoteNumber / :: NoteNumber -> NoteNumber -> NoteNumber $c/ :: NoteNumber -> NoteNumber -> NoteNumber Fractional, Num NoteNumber Ord NoteNumber Num NoteNumber -> Ord NoteNumber -> (NoteNumber -> Rational) -> Real NoteNumber NoteNumber -> Rational forall a. Num a -> Ord a -> (a -> Rational) -> Real a toRational :: NoteNumber -> Rational $ctoRational :: NoteNumber -> Rational Real, Fractional NoteNumber Real NoteNumber Real NoteNumber -> Fractional NoteNumber -> (forall b. Integral b => NoteNumber -> (b, NoteNumber)) -> (forall b. Integral b => NoteNumber -> b) -> (forall b. Integral b => NoteNumber -> b) -> (forall b. Integral b => NoteNumber -> b) -> (forall b. Integral b => NoteNumber -> b) -> RealFrac NoteNumber forall b. Integral b => NoteNumber -> b forall b. Integral b => NoteNumber -> (b, NoteNumber) forall a. Real a -> Fractional a -> (forall b. Integral b => a -> (b, a)) -> (forall b. Integral b => a -> b) -> (forall b. Integral b => a -> b) -> (forall b. Integral b => a -> b) -> (forall b. Integral b => a -> b) -> RealFrac a floor :: forall b. Integral b => NoteNumber -> b $cfloor :: forall b. Integral b => NoteNumber -> b ceiling :: forall b. Integral b => NoteNumber -> b $cceiling :: forall b. Integral b => NoteNumber -> b round :: forall b. Integral b => NoteNumber -> b $cround :: forall b. Integral b => NoteNumber -> b truncate :: forall b. Integral b => NoteNumber -> b $ctruncate :: forall b. Integral b => NoteNumber -> b properFraction :: forall b. Integral b => NoteNumber -> (b, NoteNumber) $cproperFraction :: forall b. Integral b => NoteNumber -> (b, NoteNumber) RealFrac, Integer -> NoteNumber NoteNumber -> NoteNumber NoteNumber -> NoteNumber -> NoteNumber (NoteNumber -> NoteNumber -> NoteNumber) -> (NoteNumber -> NoteNumber -> NoteNumber) -> (NoteNumber -> NoteNumber -> NoteNumber) -> (NoteNumber -> NoteNumber) -> (NoteNumber -> NoteNumber) -> (NoteNumber -> NoteNumber) -> (Integer -> NoteNumber) -> Num NoteNumber forall a. (a -> a -> a) -> (a -> a -> a) -> (a -> a -> a) -> (a -> a) -> (a -> a) -> (a -> a) -> (Integer -> a) -> Num a fromInteger :: Integer -> NoteNumber $cfromInteger :: Integer -> NoteNumber signum :: NoteNumber -> NoteNumber $csignum :: NoteNumber -> NoteNumber abs :: NoteNumber -> NoteNumber $cabs :: NoteNumber -> NoteNumber negate :: NoteNumber -> NoteNumber $cnegate :: NoteNumber -> NoteNumber * :: NoteNumber -> NoteNumber -> NoteNumber $c* :: NoteNumber -> NoteNumber -> NoteNumber - :: NoteNumber -> NoteNumber -> NoteNumber $c- :: NoteNumber -> NoteNumber -> NoteNumber + :: NoteNumber -> NoteNumber -> NoteNumber $c+ :: NoteNumber -> NoteNumber -> NoteNumber Num, Get NoteNumber Putter NoteNumber Putter NoteNumber -> Get NoteNumber -> Serialize NoteNumber forall a. Putter a -> Get a -> Serialize a get :: Get NoteNumber $cget :: Get NoteNumber put :: Putter NoteNumber $cput :: Putter NoteNumber Serialize.Serialize, Typeable.Typeable) instance Show NoteNumber where show :: NoteNumber -> String show (NoteNumber Double nn) = Double -> String forall a. Show a => a -> String show Double nn String -> ShowS forall a. Semigroup a => a -> a -> a <> String "nn" instance Read NoteNumber where readPrec :: ReadPrec NoteNumber readPrec = do Double n <- ReadPrec Double forall a. Read a => ReadPrec a Read.readPrec ReadP String -> ReadPrec String forall a. ReadP a -> ReadPrec a Read.lift (ReadP String -> ReadPrec String) -> ReadP String -> ReadPrec String forall a b. (a -> b) -> a -> b $ ReadP () ReadP.skipSpaces ReadP () -> ReadP String -> ReadP String forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> String -> ReadP String ReadP.string String "nn" NoteNumber -> ReadPrec NoteNumber forall (m :: * -> *) a. Monad m => a -> m a return (Double -> NoteNumber NoteNumber Double n) instance ShowVal.ShowVal NoteNumber where show_val :: NoteNumber -> Text show_val (NoteNumber Double nn) = Double -> Text forall a. ShowVal a => a -> Text ShowVal.show_val Double nn Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "nn" -- The suffix should be the same as DeriveT.type_to_code Nn instance Pretty NoteNumber where pretty :: NoteNumber -> Text pretty (NoteNumber Double nn) = Maybe Cent -> Double -> Text forall a. RealFloat a => Maybe Cent -> a -> Text Num.showFloat0 (Cent -> Maybe Cent forall a. a -> Maybe a Just Cent 3) Double nn Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "nn" nn :: Real a => a -> NoteNumber nn :: forall a. Real a => a -> NoteNumber nn = Double -> NoteNumber NoteNumber (Double -> NoteNumber) -> (a -> Double) -> a -> NoteNumber forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> Double forall a b. (Real a, Fractional b) => a -> b realToFrac nn_to_double :: NoteNumber -> Double nn_to_double :: NoteNumber -> Double nn_to_double (NoteNumber Double nn) = Double nn type Cent = Int nn_to_cents :: NoteNumber -> Cent nn_to_cents :: NoteNumber -> Cent nn_to_cents = NoteNumber -> Cent forall a b. (RealFrac a, Integral b) => a -> b round (NoteNumber -> Cent) -> (NoteNumber -> NoteNumber) -> NoteNumber -> Cent forall b c a. (b -> c) -> (a -> b) -> a -> c . (NoteNumber -> NoteNumber -> NoteNumber forall a. Num a => a -> a -> a *NoteNumber 100) -- | True if the NoteNumbers are close enough that they sound the same. nns_equal :: NoteNumber -> NoteNumber -> Bool nns_equal :: NoteNumber -> NoteNumber -> Bool nns_equal = Cent -> NoteNumber -> NoteNumber -> Bool nns_close Cent 3 -- almost certainly less than JND nns_close :: Cent -> NoteNumber -> NoteNumber -> Bool nns_close :: Cent -> NoteNumber -> NoteNumber -> Bool nns_close Cent cents NoteNumber nn1 NoteNumber nn2 = Cent -> Cent forall a. Num a => a -> a abs (NoteNumber -> Cent nn_to_cents NoteNumber nn1 Cent -> Cent -> Cent forall a. Num a => a -> a -> a - NoteNumber -> Cent nn_to_cents NoteNumber nn2) Cent -> Cent -> Bool forall a. Ord a => a -> a -> Bool <= Cent cents -- * Hz -- | This is absolute non-logarithmic frequency. type Hz = Double add_hz :: Hz -> NoteNumber -> NoteNumber add_hz :: Double -> NoteNumber -> NoteNumber add_hz Double 0 NoteNumber nn = NoteNumber nn -- hz_to_nn . nn_to_hz adds a tiny bit of inaccuracy add_hz Double hz NoteNumber nn = Double -> NoteNumber hz_to_nn (Double hz Double -> Double -> Double forall a. Num a => a -> a -> a + NoteNumber -> Double nn_to_hz NoteNumber nn) modify_hz :: (Hz -> Hz) -> NoteNumber -> NoteNumber modify_hz :: (Double -> Double) -> NoteNumber -> NoteNumber modify_hz Double -> Double f = Double -> NoteNumber hz_to_nn (Double -> NoteNumber) -> (NoteNumber -> Double) -> NoteNumber -> NoteNumber forall b c a. (b -> c) -> (a -> b) -> a -> c . Double -> Double f (Double -> Double) -> (NoteNumber -> Double) -> NoteNumber -> Double forall b c a. (b -> c) -> (a -> b) -> a -> c . NoteNumber -> Double nn_to_hz nn_to_hz :: NoteNumber -> Hz nn_to_hz :: NoteNumber -> Double nn_to_hz (NoteNumber Double nn) = Double -> Double forall a. Floating a => a -> a exp (Double nn Double -> Double -> Double forall a. Num a => a -> a -> a * Double _hz_scale Double -> Double -> Double forall a. Num a => a -> a -> a + Double _hz_offset) -- | Negative hz will result in NaN. TODO take an abs or throw an error, or -- let the NaN propagate? hz_to_nn :: Hz -> NoteNumber hz_to_nn :: Double -> NoteNumber hz_to_nn Double hz = Double -> NoteNumber NoteNumber (Double -> NoteNumber) -> Double -> NoteNumber forall a b. (a -> b) -> a -> b $ (Double -> Double forall a. Floating a => a -> a log Double hz Double -> Double -> Double forall a. Num a => a -> a -> a - Double _hz_offset) Double -> Double -> Double forall a. Fractional a => a -> a -> a / Double _hz_scale -- | Constants to calculate equal tempered conversions. _hz_scale, _hz_offset :: Hz _hz_scale :: Double _hz_scale = Double -> Double forall a. Floating a => a -> a log Double 2 Double -> Double -> Double forall a. Fractional a => a -> a -> a / Double 12 _hz_offset :: Double _hz_offset = Double -> Double forall a. Floating a => a -> a log Double a_hz Double -> Double -> Double forall a. Num a => a -> a -> a - (Double a_nn Double -> Double -> Double forall a. Num a => a -> a -> a * Double _hz_scale) where -- NoteNumber is defined with these values. Ultimately it's because midi -- synthesizers are by default defined with these values. a_hz :: Double a_hz = Double 440 a_nn :: Double a_nn = Double 69 middle_c_hz :: Hz middle_c_hz :: Double middle_c_hz = NoteNumber -> Double nn_to_hz NoteNumber 60 -- Alternate implementation that also introduces a bit of imprecision. Seems -- to be about the same as the one above. -- -- nn_to_hz :: NoteNumber -> Hz -- nn_to_hz (NoteNumber nn) = a_hz * rt12 ** (nn - a_nn) -- where rt12 = 2**(1/12) -- -- hz_to_nn :: Hz -> NoteNumber -- hz_to_nn hz = NoteNumber $ logBase rt12 (hz / a_hz * (rt12**a_nn)) -- where rt12 = 2**(1/12) -- -- a_hz, a_nn :: Double -- a_hz = 440 -- a_nn = 69 -- * scale newtype ScaleId = ScaleId Text deriving (ScaleId -> ScaleId -> Bool (ScaleId -> ScaleId -> Bool) -> (ScaleId -> ScaleId -> Bool) -> Eq ScaleId forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: ScaleId -> ScaleId -> Bool $c/= :: ScaleId -> ScaleId -> Bool == :: ScaleId -> ScaleId -> Bool $c== :: ScaleId -> ScaleId -> Bool Eq, Eq ScaleId Eq ScaleId -> (ScaleId -> ScaleId -> Ordering) -> (ScaleId -> ScaleId -> Bool) -> (ScaleId -> ScaleId -> Bool) -> (ScaleId -> ScaleId -> Bool) -> (ScaleId -> ScaleId -> Bool) -> (ScaleId -> ScaleId -> ScaleId) -> (ScaleId -> ScaleId -> ScaleId) -> Ord ScaleId ScaleId -> ScaleId -> Bool ScaleId -> ScaleId -> Ordering ScaleId -> ScaleId -> ScaleId 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 :: ScaleId -> ScaleId -> ScaleId $cmin :: ScaleId -> ScaleId -> ScaleId max :: ScaleId -> ScaleId -> ScaleId $cmax :: ScaleId -> ScaleId -> ScaleId >= :: ScaleId -> ScaleId -> Bool $c>= :: ScaleId -> ScaleId -> Bool > :: ScaleId -> ScaleId -> Bool $c> :: ScaleId -> ScaleId -> Bool <= :: ScaleId -> ScaleId -> Bool $c<= :: ScaleId -> ScaleId -> Bool < :: ScaleId -> ScaleId -> Bool $c< :: ScaleId -> ScaleId -> Bool compare :: ScaleId -> ScaleId -> Ordering $ccompare :: ScaleId -> ScaleId -> Ordering Ord, ReadPrec [ScaleId] ReadPrec ScaleId Cent -> ReadS ScaleId ReadS [ScaleId] (Cent -> ReadS ScaleId) -> ReadS [ScaleId] -> ReadPrec ScaleId -> ReadPrec [ScaleId] -> Read ScaleId forall a. (Cent -> ReadS a) -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a readListPrec :: ReadPrec [ScaleId] $creadListPrec :: ReadPrec [ScaleId] readPrec :: ReadPrec ScaleId $creadPrec :: ReadPrec ScaleId readList :: ReadS [ScaleId] $creadList :: ReadS [ScaleId] readsPrec :: Cent -> ReadS ScaleId $creadsPrec :: Cent -> ReadS ScaleId Read, Cent -> ScaleId -> ShowS [ScaleId] -> ShowS ScaleId -> String (Cent -> ScaleId -> ShowS) -> (ScaleId -> String) -> ([ScaleId] -> ShowS) -> Show ScaleId forall a. (Cent -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [ScaleId] -> ShowS $cshowList :: [ScaleId] -> ShowS show :: ScaleId -> String $cshow :: ScaleId -> String showsPrec :: Cent -> ScaleId -> ShowS $cshowsPrec :: Cent -> ScaleId -> ShowS Show, String -> ScaleId (String -> ScaleId) -> IsString ScaleId forall a. (String -> a) -> IsString a fromString :: String -> ScaleId $cfromString :: String -> ScaleId String.IsString, Get ScaleId Putter ScaleId Putter ScaleId -> Get ScaleId -> Serialize ScaleId forall a. Putter a -> Get a -> Serialize a get :: Get ScaleId $cget :: Get ScaleId put :: Putter ScaleId $cput :: Putter ScaleId Serialize.Serialize) instance Pretty ScaleId where pretty :: ScaleId -> Text pretty (ScaleId Text s) = Text s -- | Usually this means to use the scale currently in scope. empty_scale :: ScaleId empty_scale :: ScaleId empty_scale = ScaleId "" twelve :: ScaleId twelve :: ScaleId twelve = ScaleId "twelve" -- | A generic transposition, for operations that can transpose diatonically, -- chromatically, or by absolute NoteNumber. data Transpose = Chromatic Double | Diatonic Double -- | Nn is scale-independent, so it's not suitable for symbolic -- transposition, but it's still useful for pitch transposition. | Nn Double deriving (Transpose -> Transpose -> Bool (Transpose -> Transpose -> Bool) -> (Transpose -> Transpose -> Bool) -> Eq Transpose forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Transpose -> Transpose -> Bool $c/= :: Transpose -> Transpose -> Bool == :: Transpose -> Transpose -> Bool $c== :: Transpose -> Transpose -> Bool Eq, Eq Transpose Eq Transpose -> (Transpose -> Transpose -> Ordering) -> (Transpose -> Transpose -> Bool) -> (Transpose -> Transpose -> Bool) -> (Transpose -> Transpose -> Bool) -> (Transpose -> Transpose -> Bool) -> (Transpose -> Transpose -> Transpose) -> (Transpose -> Transpose -> Transpose) -> Ord Transpose Transpose -> Transpose -> Bool Transpose -> Transpose -> Ordering Transpose -> Transpose -> Transpose 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 :: Transpose -> Transpose -> Transpose $cmin :: Transpose -> Transpose -> Transpose max :: Transpose -> Transpose -> Transpose $cmax :: Transpose -> Transpose -> Transpose >= :: Transpose -> Transpose -> Bool $c>= :: Transpose -> Transpose -> Bool > :: Transpose -> Transpose -> Bool $c> :: Transpose -> Transpose -> Bool <= :: Transpose -> Transpose -> Bool $c<= :: Transpose -> Transpose -> Bool < :: Transpose -> Transpose -> Bool $c< :: Transpose -> Transpose -> Bool compare :: Transpose -> Transpose -> Ordering $ccompare :: Transpose -> Transpose -> Ordering Ord, Cent -> Transpose -> ShowS [Transpose] -> ShowS Transpose -> String (Cent -> Transpose -> ShowS) -> (Transpose -> String) -> ([Transpose] -> ShowS) -> Show Transpose forall a. (Cent -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Transpose] -> ShowS $cshowList :: [Transpose] -> ShowS show :: Transpose -> String $cshow :: Transpose -> String showsPrec :: Cent -> Transpose -> ShowS $cshowsPrec :: Cent -> Transpose -> ShowS Show) instance Pretty Transpose where pretty :: Transpose -> Text pretty = Transpose -> Text forall a. ShowVal a => a -> Text ShowVal.show_val instance ShowVal.ShowVal Transpose where -- TODO convert to a ScoreT.Typed Signal.Y and use its ShowVal show_val :: Transpose -> Text show_val (Chromatic Double d) = Double -> Text forall a. ShowVal a => a -> Text ShowVal.show_val Double d Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "c" show_val (Diatonic Double d) = Double -> Text forall a. ShowVal a => a -> Text ShowVal.show_val Double d Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "d" show_val (Nn Double d) = Double -> Text forall a. ShowVal a => a -> Text ShowVal.show_val Double d Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text "nn" zero_transpose :: Transpose -> Bool zero_transpose :: Transpose -> Bool zero_transpose Transpose t = case Transpose t of Chromatic Double d -> Double d Double -> Double -> Bool forall a. Eq a => a -> a -> Bool == Double 0 Diatonic Double d -> Double d Double -> Double -> Bool forall a. Eq a => a -> a -> Bool == Double 0 Nn Double d -> Double d Double -> Double -> Bool forall a. Eq a => a -> a -> Bool == Double 0 modify_transpose :: (Double -> Double) -> Transpose -> Transpose modify_transpose :: (Double -> Double) -> Transpose -> Transpose modify_transpose Double -> Double f Transpose t = case Transpose t of Chromatic Double d -> Double -> Transpose Chromatic (Double -> Double f Double d) Diatonic Double d -> Double -> Transpose Diatonic (Double -> Double f Double d) Nn Double d -> Double -> Transpose Nn (Double -> Double f Double d) -- | Diatonic transposition often requires a Key for context. -- -- This is not very strongly typed, because it's intended to be scale -- independent, and not every scale will have the same values for key and -- mode. newtype Key = Key Text deriving (Key -> Key -> Bool (Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Key -> Key -> Bool $c/= :: Key -> Key -> Bool == :: Key -> Key -> Bool $c== :: Key -> Key -> Bool Eq, Eq Key Eq Key -> (Key -> Key -> Ordering) -> (Key -> Key -> Bool) -> (Key -> Key -> Bool) -> (Key -> Key -> Bool) -> (Key -> Key -> Bool) -> (Key -> Key -> Key) -> (Key -> Key -> Key) -> Ord Key Key -> Key -> Bool Key -> Key -> Ordering Key -> Key -> Key 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 :: Key -> Key -> Key $cmin :: Key -> Key -> Key max :: Key -> Key -> Key $cmax :: Key -> Key -> Key >= :: Key -> Key -> Bool $c>= :: Key -> Key -> Bool > :: Key -> Key -> Bool $c> :: Key -> Key -> Bool <= :: Key -> Key -> Bool $c<= :: Key -> Key -> Bool < :: Key -> Key -> Bool $c< :: Key -> Key -> Bool compare :: Key -> Key -> Ordering $ccompare :: Key -> Key -> Ordering Ord, ReadPrec [Key] ReadPrec Key Cent -> ReadS Key ReadS [Key] (Cent -> ReadS Key) -> ReadS [Key] -> ReadPrec Key -> ReadPrec [Key] -> Read Key forall a. (Cent -> ReadS a) -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a readListPrec :: ReadPrec [Key] $creadListPrec :: ReadPrec [Key] readPrec :: ReadPrec Key $creadPrec :: ReadPrec Key readList :: ReadS [Key] $creadList :: ReadS [Key] readsPrec :: Cent -> ReadS Key $creadsPrec :: Cent -> ReadS Key Read, Cent -> Key -> ShowS [Key] -> ShowS Key -> String (Cent -> Key -> ShowS) -> (Key -> String) -> ([Key] -> ShowS) -> Show Key forall a. (Cent -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Key] -> ShowS $cshowList :: [Key] -> ShowS show :: Key -> String $cshow :: Key -> String showsPrec :: Cent -> Key -> ShowS $cshowsPrec :: Cent -> Key -> ShowS Show, Key -> Text (Key -> Text) -> ShowVal Key forall a. (a -> Text) -> ShowVal a show_val :: Key -> Text $cshow_val :: Key -> Text ShowVal.ShowVal, Get Key Putter Key Putter Key -> Get Key -> Serialize Key forall a. Putter a -> Get a -> Serialize a get :: Get Key $cget :: Get Key put :: Putter Key $cput :: Putter Key Serialize.Serialize) key_text :: Key -> Text key_text :: Key -> Text key_text (Key Text t) = Text t instance Pretty Key where format :: Key -> Doc format (Key Text s) = Text -> Doc Pretty.text Text s