module Music.Pitch.Common.Quality (
Quality(..),
HasQuality(..),
invertQuality,
isPerfect,
isMajor,
isMinor,
isAugmented,
isDiminished,
QualityType(..),
expectedQualityType,
qualityTypes,
qualityToDiff
) where
import Music.Pitch.Augmentable
import Music.Pitch.Common.Number
import Music.Pitch.Common.Chromatic
class HasQuality a where
quality :: a -> Quality
isPerfect :: HasQuality a => a -> Bool
isPerfect a = case quality a of { Perfect -> True ; _ -> False }
isMajor :: HasQuality a => a -> Bool
isMajor a = case quality a of { Major -> True ; _ -> False }
isMinor :: HasQuality a => a -> Bool
isMinor a = case quality a of { Minor -> True ; _ -> False }
isAugmented :: HasQuality a => a -> Bool
isAugmented a = case quality a of { Augmented _ -> True ; _ -> False }
isDiminished :: HasQuality a => a -> Bool
isDiminished a = case quality a of { Diminished _ -> True ; _ -> False }
data Quality
= Major
| Minor
| Perfect
| Augmented Integer
| Diminished Integer
deriving (Eq, Ord, Show)
instance HasQuality Quality where
quality = id
instance Augmentable Quality where
augment Major = Augmented 1
augment Minor = Major
augment Perfect = Augmented 1
augment (Augmented n) = Augmented (n + 1)
augment (Diminished n) = Diminished (n 1)
diminish Major = Minor
diminish Minor = Diminished 1
diminish Perfect = Diminished 1
diminish (Augmented n) = Augmented (n 1)
diminish (Diminished n) = Diminished (n + 1)
invertQuality :: Quality -> Quality
invertQuality = go
where
go Major = Minor
go Minor = Major
go Perfect = Perfect
go (Augmented n) = Diminished n
go (Diminished n) = Augmented n
data QualityType = PerfectType | MajorMinorType
deriving (Eq, Ord, Read, Show)
expectedQualityType :: HasNumber a => a -> QualityType
expectedQualityType x = if ((abs (number x) 1) `mod` 7) + 1 `elem` [1,4,5]
then PerfectType else MajorMinorType
qualityTypes :: Quality -> [QualityType]
qualityTypes Perfect = [PerfectType]
qualityTypes Major = [MajorMinorType]
qualityTypes Minor = [MajorMinorType]
qualityTypes _ = [PerfectType, MajorMinorType]
qualityToDiff :: Bool -> QualityType -> Quality -> ChromaticSteps
qualityToDiff positive qt q = fromIntegral $ go positive qt q
where
go True MajorMinorType (Augmented n) = 0 + n
go True MajorMinorType Major = 0
go True MajorMinorType Minor = (1)
go True MajorMinorType (Diminished n) = (1 + n)
go False MajorMinorType (Augmented n) = (1 + n)
go False MajorMinorType Major = 1
go False MajorMinorType Minor = 0
go False MajorMinorType (Diminished n) = 0 + n
go _ PerfectType (Augmented n) = 0 + n
go _ PerfectType Perfect = 0
go _ PerfectType (Diminished n) = 0 n
go _ qt q = error $ "qualityToDiff: Unknown interval expression (" ++ show qt ++ ", " ++ show q ++ ")"