{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module      : Data.PitchClass.Chromatic
-- Copyright   : (c) Eric Bailey, 2021-2025
--
-- License     : MIT
-- Maintainer  : eric@ericb.me
-- Stability   : experimental
-- Portability : POSIX
--
-- Chromatic pc-space and p-space.
module Data.PitchClass.Chromatic where

import Data.Act (Act (..), Finitely (..), Torsor (..))
import Data.Finitary (Finitary (fromFinite, toFinite))
import Data.Finite (Finite)
import Data.GIS (IntervalOf)
import Data.Monoid (Sum)
import Data.Pitch (Pitch)
import Data.Pitch.TH (genPitchPatterns)
import GHC.Generics (Generic)

-- | The twelve chromatic pitch classes.
data PitchClass = C | Cis | D | Dis | E | F | Fis | G | Gis | A | Ais | B
  deriving stock (PitchClass -> PitchClass -> Bool
(PitchClass -> PitchClass -> Bool)
-> (PitchClass -> PitchClass -> Bool) -> Eq PitchClass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PitchClass -> PitchClass -> Bool
== :: PitchClass -> PitchClass -> Bool
$c/= :: PitchClass -> PitchClass -> Bool
/= :: PitchClass -> PitchClass -> Bool
Eq, Eq PitchClass
Eq PitchClass =>
(PitchClass -> PitchClass -> Ordering)
-> (PitchClass -> PitchClass -> Bool)
-> (PitchClass -> PitchClass -> Bool)
-> (PitchClass -> PitchClass -> Bool)
-> (PitchClass -> PitchClass -> Bool)
-> (PitchClass -> PitchClass -> PitchClass)
-> (PitchClass -> PitchClass -> PitchClass)
-> Ord PitchClass
PitchClass -> PitchClass -> Bool
PitchClass -> PitchClass -> Ordering
PitchClass -> PitchClass -> PitchClass
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 :: PitchClass -> PitchClass -> Ordering
compare :: PitchClass -> PitchClass -> Ordering
$c< :: PitchClass -> PitchClass -> Bool
< :: PitchClass -> PitchClass -> Bool
$c<= :: PitchClass -> PitchClass -> Bool
<= :: PitchClass -> PitchClass -> Bool
$c> :: PitchClass -> PitchClass -> Bool
> :: PitchClass -> PitchClass -> Bool
$c>= :: PitchClass -> PitchClass -> Bool
>= :: PitchClass -> PitchClass -> Bool
$cmax :: PitchClass -> PitchClass -> PitchClass
max :: PitchClass -> PitchClass -> PitchClass
$cmin :: PitchClass -> PitchClass -> PitchClass
min :: PitchClass -> PitchClass -> PitchClass
Ord, Int -> PitchClass -> ShowS
[PitchClass] -> ShowS
PitchClass -> String
(Int -> PitchClass -> ShowS)
-> (PitchClass -> String)
-> ([PitchClass] -> ShowS)
-> Show PitchClass
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PitchClass -> ShowS
showsPrec :: Int -> PitchClass -> ShowS
$cshow :: PitchClass -> String
show :: PitchClass -> String
$cshowList :: [PitchClass] -> ShowS
showList :: [PitchClass] -> ShowS
Show, Int -> PitchClass
PitchClass -> Int
PitchClass -> [PitchClass]
PitchClass -> PitchClass
PitchClass -> PitchClass -> [PitchClass]
PitchClass -> PitchClass -> PitchClass -> [PitchClass]
(PitchClass -> PitchClass)
-> (PitchClass -> PitchClass)
-> (Int -> PitchClass)
-> (PitchClass -> Int)
-> (PitchClass -> [PitchClass])
-> (PitchClass -> PitchClass -> [PitchClass])
-> (PitchClass -> PitchClass -> [PitchClass])
-> (PitchClass -> PitchClass -> PitchClass -> [PitchClass])
-> Enum PitchClass
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: PitchClass -> PitchClass
succ :: PitchClass -> PitchClass
$cpred :: PitchClass -> PitchClass
pred :: PitchClass -> PitchClass
$ctoEnum :: Int -> PitchClass
toEnum :: Int -> PitchClass
$cfromEnum :: PitchClass -> Int
fromEnum :: PitchClass -> Int
$cenumFrom :: PitchClass -> [PitchClass]
enumFrom :: PitchClass -> [PitchClass]
$cenumFromThen :: PitchClass -> PitchClass -> [PitchClass]
enumFromThen :: PitchClass -> PitchClass -> [PitchClass]
$cenumFromTo :: PitchClass -> PitchClass -> [PitchClass]
enumFromTo :: PitchClass -> PitchClass -> [PitchClass]
$cenumFromThenTo :: PitchClass -> PitchClass -> PitchClass -> [PitchClass]
enumFromThenTo :: PitchClass -> PitchClass -> PitchClass -> [PitchClass]
Enum, PitchClass
PitchClass -> PitchClass -> Bounded PitchClass
forall a. a -> a -> Bounded a
$cminBound :: PitchClass
minBound :: PitchClass
$cmaxBound :: PitchClass
maxBound :: PitchClass
Bounded, (forall x. PitchClass -> Rep PitchClass x)
-> (forall x. Rep PitchClass x -> PitchClass) -> Generic PitchClass
forall x. Rep PitchClass x -> PitchClass
forall x. PitchClass -> Rep PitchClass x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PitchClass -> Rep PitchClass x
from :: forall x. PitchClass -> Rep PitchClass x
$cto :: forall x. Rep PitchClass x -> PitchClass
to :: forall x. Rep PitchClass x -> PitchClass
Generic)
  deriving anyclass (Eq PitchClass
KnownNat (Cardinality PitchClass)
(Eq PitchClass, KnownNat (Cardinality PitchClass)) =>
(Finite (Cardinality PitchClass) -> PitchClass)
-> (PitchClass -> Finite (Cardinality PitchClass))
-> ((1 <= Cardinality PitchClass) => PitchClass)
-> ((1 <= Cardinality PitchClass) => PitchClass)
-> (PitchClass -> Maybe PitchClass)
-> (PitchClass -> Maybe PitchClass)
-> Finitary PitchClass
(1 <= Cardinality PitchClass) => PitchClass
Finite (Cardinality PitchClass) -> PitchClass
PitchClass -> Maybe PitchClass
PitchClass -> Finite (Cardinality PitchClass)
forall a.
(Eq a, KnownNat (Cardinality a)) =>
(Finite (Cardinality a) -> a)
-> (a -> Finite (Cardinality a))
-> ((1 <= Cardinality a) => a)
-> ((1 <= Cardinality a) => a)
-> (a -> Maybe a)
-> (a -> Maybe a)
-> Finitary a
$cfromFinite :: Finite (Cardinality PitchClass) -> PitchClass
fromFinite :: Finite (Cardinality PitchClass) -> PitchClass
$ctoFinite :: PitchClass -> Finite (Cardinality PitchClass)
toFinite :: PitchClass -> Finite (Cardinality PitchClass)
$cstart :: (1 <= Cardinality PitchClass) => PitchClass
start :: (1 <= Cardinality PitchClass) => PitchClass
$cend :: (1 <= Cardinality PitchClass) => PitchClass
end :: (1 <= Cardinality PitchClass) => PitchClass
$cprevious :: PitchClass -> Maybe PitchClass
previous :: PitchClass -> Maybe PitchClass
$cnext :: PitchClass -> Maybe PitchClass
next :: PitchClass -> Maybe PitchClass
Finitary)
  deriving
    ( -- | 'C₁₂' acts on 'PitchClass'
      Act C₁₂,
      -- | The 'C₁₂'-torsor where the action determines the interval
      -- ('Data.GIS.int')
      Torsor C₁₂
    )
    via Finitely PitchClass

-- | Modular arithmetic. Only the 'fromInteger' function is supposed to be useful.
instance Num PitchClass where
  PitchClass
pcx + :: PitchClass -> PitchClass -> PitchClass
+ PitchClass
pcy = Finite (Cardinality PitchClass) -> PitchClass
forall a. Finitary a => Finite (Cardinality a) -> a
fromFinite (PitchClass -> Finite (Cardinality PitchClass)
forall a. Finitary a => a -> Finite (Cardinality a)
toFinite PitchClass
pcx Finite Integer 12 -> Finite Integer 12 -> Finite Integer 12
forall a. Num a => a -> a -> a
+ PitchClass -> Finite (Cardinality PitchClass)
forall a. Finitary a => a -> Finite (Cardinality a)
toFinite PitchClass
pcy)
  PitchClass
pcx - :: PitchClass -> PitchClass -> PitchClass
- PitchClass
pcy = Finite (Cardinality PitchClass) -> PitchClass
forall a. Finitary a => Finite (Cardinality a) -> a
fromFinite (PitchClass -> Finite (Cardinality PitchClass)
forall a. Finitary a => a -> Finite (Cardinality a)
toFinite PitchClass
pcx Finite Integer 12 -> Finite Integer 12 -> Finite Integer 12
forall a. Num a => a -> a -> a
- PitchClass -> Finite (Cardinality PitchClass)
forall a. Finitary a => a -> Finite (Cardinality a)
toFinite PitchClass
pcy)
  PitchClass
pcx * :: PitchClass -> PitchClass -> PitchClass
* PitchClass
pcy = Finite (Cardinality PitchClass) -> PitchClass
forall a. Finitary a => Finite (Cardinality a) -> a
fromFinite (PitchClass -> Finite (Cardinality PitchClass)
forall a. Finitary a => a -> Finite (Cardinality a)
toFinite PitchClass
pcx Finite Integer 12 -> Finite Integer 12 -> Finite Integer 12
forall a. Num a => a -> a -> a
* PitchClass -> Finite (Cardinality PitchClass)
forall a. Finitary a => a -> Finite (Cardinality a)
toFinite PitchClass
pcy)
  abs :: PitchClass -> PitchClass
abs PitchClass
pc = PitchClass
pc
  signum :: PitchClass -> PitchClass
signum PitchClass
_ = PitchClass
1
  fromInteger :: Integer -> PitchClass
fromInteger Integer
x = Finite (Cardinality PitchClass) -> PitchClass
forall a. Finitary a => Finite (Cardinality a) -> a
fromFinite (Integer -> Finite Integer 12
forall a. Num a => Integer -> a
fromInteger Integer
x)

-- * Chromatic pc-space

-- | In chromatic pc-space, the twelve [pitch classes]('PitchClass') can be
-- labeled by the elements of the cyclic group of order \(12\), 'C₁₂'.
type instance IntervalOf PitchClass = C₁₂

-- | The cyclic group of order \(12\), denoted
-- [\(C_{12}\)](https://people.maths.bris.ac.uk/~matyd/GroupNames/1/C12.html) or
-- [\(\mathbb{Z}_{12}\)](https://nathancarter.github.io/group-explorer/GroupInfo.html?groupURL=https://nathancarter.github.io/group-explorer/groups/Z_12.group).
type C₁₂ = Sum (Finite 12)

-- * Chromatic p-space

-- $doc
-- Pattern synonyms are defined for 'Data.PitchClass.Chromatic.C0' through
-- 'Data.PitchClass.Chromatic.B10'.

-- | In chromatic p-space, pitches can be labeled by the elements of the group
-- of integers under addition, \((\mathbb{Z}, +)\).
type instance IntervalOf (Pitch PitchClass) = Sum Int

$(genPitchPatterns ''PitchClass)