diff --git a/.gitignore b/.gitignore index 7553075..b024b1b 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,5 @@ dist +dist-newstyle .DS_Store *.ly *.pdf @@ -6,3 +7,8 @@ dist .hackette .ackoptions *sandbox.config +.stack-work/ +.cabal.project.local +.cabal.project.local~ +.envrc +.direnv diff --git a/Setup.lhs b/Setup.lhs old mode 100755 new mode 100644 diff --git a/music-pitch.cabal b/music-pitch.cabal old mode 100755 new mode 100644 index 76949f4..fcee6b3 --- a/music-pitch.cabal +++ b/music-pitch.cabal @@ -26,13 +26,13 @@ library containers, lens >= 4.11 && < 5, semigroups >= 0.13.0.1 && < 1, - data-interval >= 1.0.0 && < 2, + data-interval >= 1.0.0 && < 3, vector-space >= 0.10.2 && < 1, vector-space-points >= 0.2 && < 1, nats, positive >= 0.4 && < 1, type-unary >= 0.2.16 && < 1.0, - aeson >= 0.7.0.6 && < 1 + aeson >= 0.7.0.6 && < 2 exposed-modules: Music.Pitch Music.Pitch.Absolute Music.Pitch.Equal diff --git a/sketch/synopsis.hs b/sketch/synopsis.hs index 0121325..18c50d0 100644 --- a/sketch/synopsis.hs +++ b/sketch/synopsis.hs @@ -5,7 +5,7 @@ data Mode a = Mode [Diff a] (Diff a) -- intervals, repeat (usuall data Scale a = Scale a (Mode a) -- root, mode data Function a = Function [Diff a] (Diff a) -- intervals, repeat, repeat (usually octave) data Chord a = Chord a (Function a) -- root, function -data Ambitus a = Ambitus a a | Ambitus a (Diff a) | Ambitus (Diff a) a +data Ambitus a = Ambitus a a | Ambitus a (Diff a) | Ambitus (Diff a) a newtype ChromaticSteps = ChromaticSteps { getChromaticSteps :: Integer } newtype DiatonicSteps = DiatonicSteps { getDiatonicSteps :: Integer } diff --git a/src/Music/Pitch.hs b/src/Music/Pitch.hs index 2dff3ec..73035a8 100644 --- a/src/Music/Pitch.hs +++ b/src/Music/Pitch.hs @@ -1,5 +1,5 @@ --- | Standard pitch representation. +-- | Standard pitch representation. module Music.Pitch ( module Data.Semigroup, module Data.VectorSpace, diff --git a/src/Music/Pitch/Absolute.hs b/src/Music/Pitch/Absolute.hs index c5fdec0..b4de213 100644 --- a/src/Music/Pitch/Absolute.hs +++ b/src/Music/Pitch/Absolute.hs @@ -97,15 +97,15 @@ instance HasFrequency Fifths where instance HasFrequency Cents where frequency (Cents f) = (2/1) ** (f / 1200) --- | Convert a frequency to octaves. +-- | Convert a frequency to octaves. octaves :: HasFrequency a => a -> Octaves octaves a = Octaves $ logBase (2/1) (frequency a) --- | Convert a frequency to fifths. +-- | Convert a frequency to fifths. fifths :: HasFrequency a => a -> Fifths fifths a = Fifths $ logBase (3/2) (frequency a) --- | Convert a frequency to cents. +-- | Convert a frequency to cents. cents :: HasFrequency a => a -> Cents cents a = Cents $ logBase (2/1) (frequency a) * 1200 diff --git a/src/Music/Pitch/Ambitus.hs b/src/Music/Pitch/Ambitus.hs index c79b40a..17b74cb 100644 --- a/src/Music/Pitch/Ambitus.hs +++ b/src/Music/Pitch/Ambitus.hs @@ -40,8 +40,8 @@ ambitus = iso toA unA . _Unwrapped unA a = case (I.lowerBound a, I.upperBound a) of (Finite m, Finite n) -> (m, n) -- FIXME this can happen as empty span can be represented as PosInf..NegInf - -- _ -> error $ "Strange ambitus: " ++ show (I.lowerBound a, I.upperBound a) - _ -> error $ "Strange ambitus" + -- _ -> error $ "Strange ambitus: " ++ show (I.lowerBound a, I.upperBound a) + _ -> error $ "Strange ambitus" -- ambitus' :: (Num a, Ord a) => Iso' (a, a) (Ambitus a) -- ambitus' = ambitus diff --git a/src/Music/Pitch/Clef.hs b/src/Music/Pitch/Clef.hs index 5b34a3c..cd0e108 100644 --- a/src/Music/Pitch/Clef.hs +++ b/src/Music/Pitch/Clef.hs @@ -67,7 +67,7 @@ instance Show Clef where | x == altoClef = "altoClef" | x == tenorClef = "tenorClef" | x == baritoneClef = "baritoneClef" - | otherwise = show a + | otherwise = show a -- | Return the English name of the given clef. symbolName :: ClefSymbol -> String @@ -77,7 +77,7 @@ symbolName FClef = "F clef" symbolName PercClef = "Percussion clef" symbolName NeutralClef = "Neutral clef" --- | Return the pitch implied by the given clef at the middle space or line. +-- | Return the pitch implied by the given clef at the middle space or line. symbolPitch :: ClefSymbol -> Maybe Pitch symbolPitch GClef = Just b' symbolPitch CClef = Just c @@ -118,17 +118,17 @@ Map this to Pitch.Common -- | Standard treble clef. trebleClef :: Clef --- | Standard bass clef. +-- | Standard bass clef. bassClef :: Clef --- | Standard soprano clef. +-- | Standard soprano clef. sopranoClef :: Clef --- | Standard mezzo soprano clef. +-- | Standard mezzo soprano clef. mezzoSopranoClef :: Clef --- | Standard alto clef. +-- | Standard alto clef. altoClef :: Clef --- | Standard tenor clef. +-- | Standard tenor clef. tenorClef :: Clef --- | Standard baritone clef. +-- | Standard baritone clef. baritoneClef :: Clef trebleClef = Clef (GClef, -1 :: ClefOctave, -1 :: ClefLine) bassClef = Clef (FClef, 1 :: ClefOctave, -1 :: ClefLine) @@ -140,11 +140,11 @@ baritoneClef = Clef (CClef, 0 :: ClefOctave, 2 :: ClefLine) -- | Is this a clef used in contemporary notation? isModernClef :: Clef -> Bool -isModernClef x | x == trebleClef = True -isModernClef x | x == bassClef = True -isModernClef x | x == altoClef = True -isModernClef x | x == tenorClef = True -isModernClef x | otherwise = False +isModernClef x | x == trebleClef = True +isModernClef x | x == bassClef = True +isModernClef x | x == altoClef = True +isModernClef x | x == tenorClef = True +isModernClef x | otherwise = False -- | Is this an historical clef? isHistoricalClef :: Clef -> Bool @@ -152,8 +152,8 @@ isHistoricalClef _ = False -- | Is this a traditional voice clef, i.e. a C clef on some staff. isVoiceClef :: Clef -> Bool -isVoiceClef x | x == altoClef = True -isVoiceClef x | x == tenorClef = True -isVoiceClef x | otherwise = False +isVoiceClef x | x == altoClef = True +isVoiceClef x | x == tenorClef = True +isVoiceClef x | otherwise = False diff --git a/src/Music/Pitch/Common/Harmony.hs b/src/Music/Pitch/Common/Harmony.hs index 32c4fc8..0d8898d 100644 --- a/src/Music/Pitch/Common/Harmony.hs +++ b/src/Music/Pitch/Common/Harmony.hs @@ -21,7 +21,7 @@ import qualified Data.Set as Set {- TODO Generalize simple like this: - > (number (asInterval (m9))-(fromIntegral $ signum (m9))) `mod` 7 + > (number (asInterval (m9))-(fromIntegral $ signum (m9))) `mod` 7 -} diff --git a/src/Music/Pitch/Common/Interval.hs b/src/Music/Pitch/Common/Interval.hs index d9a283f..6761166 100644 --- a/src/Music/Pitch/Common/Interval.hs +++ b/src/Music/Pitch/Common/Interval.hs @@ -145,7 +145,7 @@ instance FromJSON ChromaticSteps where parseJSON = fmap fromInteger . parseJSON instance ToJSON Interval where - toJSON i = Data.Aeson.object [("steps", toJSON $ i^._steps), ("alteration", toJSON $ i^._alteration)] + toJSON i = Data.Aeson.object [("steps", toJSON $ i^._steps), ("alteration", toJSON $ i^._alteration)] instance FromJSON Interval where parseJSON (Data.Aeson.Object x) = liftA2 (curry (^.interval')) alteration steps diff --git a/src/Music/Pitch/Common/Names.hs b/src/Music/Pitch/Common/Names.hs index 779be8d..65b7ed7 100644 --- a/src/Music/Pitch/Common/Names.hs +++ b/src/Music/Pitch/Common/Names.hs @@ -42,7 +42,7 @@ showKey :: Language -> Pitch -> Mode -> String showKey lang pitch mode = showPitch lang pitch ++ showSep lang ++ showMode lang mode showPitch :: Language -> Pitch -> String -showPitch lang pitch = (!! (pitchToIndex + pitchNameOffset)) $ fromMaybe (error "showPitch: Bad lang") $ listToMaybe $ filter (\xs -> head xs == show lang) $ pitchNames +showPitch lang pitch = (!! (pitchToIndex + pitchNameOffset)) $ fromMaybe (error "showPitch: Bad lang") $ listToMaybe $ filter (\xs -> head xs == show lang) $ pitchNames where -- TODO normalize dbb etc. pitchToIndex = fromMaybe (error "showPitch: Bad pitch") $ Data.List.findIndex (== pitch) @@ -56,7 +56,7 @@ showPitch lang pitch = (!! (pitchToIndex + pitchNameOffset)) $ fromMaybe (error pitchNameOffset = 3 showMode :: Language -> Mode -> String -showMode lang mode = (!! (modeToIndex + modeNameOffset)) $ fromMaybe (error "showMode: Bad lang") $ listToMaybe $ filter (\xs -> head xs == show lang) $ modeNames +showMode lang mode = (!! (modeToIndex + modeNameOffset)) $ fromMaybe (error "showMode: Bad lang") $ listToMaybe $ filter (\xs -> head xs == show lang) $ modeNames where modeToIndex = fromMaybe (error "showPitch: Bad mode") $ Data.List.findIndex (== mode) [MajorMode,MinorMode] diff --git a/src/Music/Pitch/Common/Number.hs b/src/Music/Pitch/Common/Number.hs index 4cd4a0d..388a687 100644 --- a/src/Music/Pitch/Common/Number.hs +++ b/src/Music/Pitch/Common/Number.hs @@ -1,5 +1,5 @@ --- | Number component of intervals. +-- | Number component of intervals. module Music.Pitch.Common.Number ( Number, diff --git a/src/Music/Pitch/Common/Quality.hs b/src/Music/Pitch/Common/Quality.hs index aedcc36..f247b74 100644 --- a/src/Music/Pitch/Common/Quality.hs +++ b/src/Music/Pitch/Common/Quality.hs @@ -105,7 +105,7 @@ invertQuality = go go (Diminished n) = Augmented n --- |  +-- | -- The quality type expected for a given number, i.e. perfect for unisons, fourths, -- fifths and their compounds; major/minor for everything else. expectedQualityType :: Number -> QualityType @@ -127,7 +127,7 @@ qualityTypes _ = [PerfectType, MajorMinorType] isValidQualityNumber :: Quality -> Number -> Bool isValidQualityNumber q n = expectedQualityType n `elem` qualityTypes q -data Direction = Upward | Downward +data Direction = Upward | Downward deriving (Eq, Ord, Show) -- | diff --git a/src/Music/Pitch/Common/Types.hs b/src/Music/Pitch/Common/Types.hs index f9125f2..fd221ca 100644 --- a/src/Music/Pitch/Common/Types.hs +++ b/src/Music/Pitch/Common/Types.hs @@ -83,10 +83,10 @@ Alternatively, we could do it as a recursive type data Quality = Major - | Minor - | Perfect + | Minor + | Perfect | Augment Quality - | Diminish Quality + | Diminish Quality -} {-| diff --git a/src/Music/Pitch/Equal.hs b/src/Music/Pitch/Equal.hs index 8357ce7..86d44d2 100644 --- a/src/Music/Pitch/Equal.hs +++ b/src/Music/Pitch/Equal.hs @@ -48,7 +48,7 @@ import TypeUnary.Nat -- Based on Data.Fixed -newtype Equal a = Equal { getEqual :: Int } +newtype Equal a = Equal { getEqual :: Int } deriving instance Eq (Equal a) deriving instance Ord (Equal a) @@ -104,11 +104,11 @@ size = natToZ . getSize -- This type implements limited values (useful for interval *steps*) -- An ET-interval is just an int, with a type-level size (divMod is "separate") --- -- | Create an equal-temperament value. +-- -- | Create an equal-temperament value. -- toEqual :: IsNat a => Int -> Maybe (Equal a) -- toEqual = checkSize . Equal -- --- -- | Unsafely create an equal-temperament value. +-- -- | Unsafely create an equal-temperament value. -- unsafeToEqual :: IsNat a => Int -> Equal a -- unsafeToEqual n = case toEqual n of -- Nothing -> error $ "Bad equal: " ++ show n @@ -118,7 +118,7 @@ size = natToZ . getSize -- checkSize x = if 0 <= fromEqual x && fromEqual x < size x then Just x else Nothing -- --- | Create an equal-temperament value. +-- | Create an equal-temperament value. toEqual :: IsNat a => Int -> Equal a toEqual = Equal diff --git a/src/Music/Pitch/Intonation.hs b/src/Music/Pitch/Intonation.hs index 0ad3be4..e33a774 100644 --- a/src/Music/Pitch/Intonation.hs +++ b/src/Music/Pitch/Intonation.hs @@ -112,7 +112,7 @@ thirtyOneToneEqual = tetTune dddd3 where dddd3 = m3 ^-^ (4 *^ _A1) fiftyThreeToneEqual :: Tuning Interval fiftyThreeToneEqual = tetTune ddddddd6 where ddddddd6 = 31 *^ _P8 ^-^ 53 *^ _P5 -- (!) --- | Modern standard intonation, i.e. 12-TET with @a = 440 Hz@. +-- | Modern standard intonation, i.e. 12-TET with @a = 440 Hz@. standardIntonation :: Intonation Pitch standardIntonation = intone (a, 440) twelveToneEqual diff --git a/src/Music/Pitch/Scale.hs b/src/Music/Pitch/Scale.hs index 5522a3a..9e9929e 100644 --- a/src/Music/Pitch/Scale.hs +++ b/src/Music/Pitch/Scale.hs @@ -80,7 +80,7 @@ import Music.Pitch.Literal import Music.Pitch.Common hiding (Mode) --- | A mode is a list of intervals and a characteristic repeating interval. +-- | A mode is a list of intervals and a characteristic repeating interval. data Mode a = Mode [Diff a] (Diff a) -- intervals, repeat (usually octave) -- | @@ -98,7 +98,7 @@ modeIntervals f (Mode is r) = fmap (\is -> Mode is r) $ f is modeRepeat :: Lens' (Mode a) (Diff a) modeRepeat f (Mode is r) = fmap (\r -> Mode is r) $ f r --- | A scale is a mode with a specified tonic. +-- | A scale is a mode with a specified tonic. data Scale a = Scale a (Mode a) -- root, mode modeToScale :: AffineSpace a => a -> Mode a -> Scale a @@ -107,12 +107,12 @@ modeToScale = Scale -- | -- > Lens' (Scale Pitch) Pitch scaleTonic :: Lens' (Scale a) a -scaleTonic f (Scale t xs) = fmap (\t -> Scale t xs) $ f t +scaleTonic f (Scale t xs) = fmap (\t -> Scale t xs) $ f t -- | -- > Lens' (Scale Pitch) (Mode Pitch) scaleMode :: Lens' (Scale a) (Mode a) -scaleMode f (Scale t xs) = fmap (\xs -> Scale t xs) $ f xs +scaleMode f (Scale t xs) = fmap (\xs -> Scale t xs) $ f xs -- | -- @@ -168,12 +168,12 @@ functionToChord = Chord -- | -- > Lens' (Chord Pitch) Pitch chordTonic :: Lens' (Chord a) a -chordTonic f (Chord t xs) = fmap (\t -> Chord t xs) $ f t +chordTonic f (Chord t xs) = fmap (\t -> Chord t xs) $ f t -- | -- > Lens' (Chord Pitch) (Function Pitch) chordFunction :: Lens' (Chord a) (Function a) -chordFunction f (Chord t xs) = fmap (\xs -> Chord t xs) $ f xs +chordFunction f (Chord t xs) = fmap (\xs -> Chord t xs) $ f xs -- | --