{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module      : Data.Pitch
-- Copyright   : (c) Eric Bailey, 2021-2025
--
-- License     : MIT
-- Maintainer  : eric@ericb.me
-- Stability   : experimental
-- Portability : POSIX
--
-- A pitch consists of a pitch class and an octave.
module Data.Pitch where

import Data.Bifoldable (bisum)
import Data.Bifunctor (bimap)
import Data.Finitary (Finitary (..))
import Data.Monoid (Sum (..))
import Data.Proxy (Proxy (..))
import GHC.TypeLits (natVal)

-- | A pitch consists of a pitch class and an octave.
newtype Pitch a = Pitch {forall a. Pitch a -> (a, Octave)
getPitch :: (a, Octave)}

deriving instance (Bounded a) => Bounded (Pitch a)

deriving instance (Eq a) => Eq (Pitch a)

instance (Finitary a, Show a) => Show (Pitch a) where
  show :: Pitch a -> String
show = (String -> ShowS) -> (String, String) -> String
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> ShowS
forall a. Semigroup a => a -> a -> a
(<>) ((String, String) -> String)
-> (Pitch a -> (String, String)) -> Pitch a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> String)
-> (Octave -> String) -> (a, Octave) -> (String, String)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> String
forall a. Show a => a -> String
show Octave -> String
forall a. Show a => a -> String
show ((a, Octave) -> (String, String))
-> (Pitch a -> (a, Octave)) -> Pitch a -> (String, String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pitch a -> (a, Octave)
forall a. Pitch a -> (a, Octave)
getPitch

-- | An octave is an integer.
type Octave = Int

-- | Label a pitch with an element of the group of integers under addition.
labelPitch :: forall a. (Finitary a) => Pitch a -> Sum Int
labelPitch :: forall a. Finitary a => Pitch a -> Sum Octave
labelPitch =
  Octave -> Sum Octave
forall a. a -> Sum a
Sum
    (Octave -> Sum Octave)
-> (Pitch a -> Octave) -> Pitch a -> Sum Octave
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Octave, Octave) -> Octave
forall (t :: * -> * -> *) a. (Bifoldable t, Num a) => t a a -> a
bisum
    ((Octave, Octave) -> Octave)
-> (Pitch a -> (Octave, Octave)) -> Pitch a -> Octave
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Octave)
-> (Octave -> Octave) -> (a, Octave) -> (Octave, Octave)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
      (Finite (Cardinality a) -> Octave
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Finite (Cardinality a) -> Octave)
-> (a -> Finite (Cardinality a)) -> a -> Octave
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Finite (Cardinality a)
forall a. Finitary a => a -> Finite (Cardinality a)
toFinite)
      (Integer -> Octave
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy (Cardinality a) -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (forall (t :: Nat). Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Cardinality a))) Octave -> Octave -> Octave
forall a. Num a => a -> a -> a
*)
    ((a, Octave) -> (Octave, Octave))
-> (Pitch a -> (a, Octave)) -> Pitch a -> (Octave, Octave)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pitch a -> (a, Octave)
forall a. Pitch a -> (a, Octave)
getPitch