{-# LANGUAGE 
        FlexibleInstances, 
        TypeSynonymInstances, 
        Rank2Types #-}

-- | Representing pitch
module Temporal.Music.Notation.Pitch (
	-- * Types
    --
    -- | There are four main datatypes 'Frequency', 'Pitch', 'Scale' and 'Tone'.
    -- 'Pitch' consists of 'Scale' and 'Tone'.
    -- Every 'Pitch' can be converted to 'Frequency' (see a 'absPitch'). 
    -- 'Scale' defines logarithmic mapping from 2d integer coordinates of
    -- 'Tone' to 1d double values. 'Scale' is 2d logarithmic grid in 
    -- frequency domain and 'Tone' is point on that grid. 
	Frequency, c1, a1,
    Pitch(..), etPitch,
    Interval, Scale(..), scaleSize, fromIntervals,
    Bend, Octave, Step, 
    Tone(..), tone, toneNum,
	-- * Transformers
    -- ** Pitch 
    PchFunctor(..),
    -- ** Scale 
    ScaleFunctor(..), setScale, mapBase, setBase, transposeScale,
    -- ** Tone
    ToneFunctor(..), 
	setBend, bend, step, low, high, lower, higher, invert,
    -- * Rendering
    frequency, absPitch
 )
where

import TypeLevel.NaturalNumber
import Data.Function(on)
import qualified Data.Vector as V

import Temporal.Music.Notation.Score(Score)
import Control.Arrow(first, second)

type Frequency = Double

-- | middle C (261.626 Hz)
c1 :: Frequency
c1 = 261.626 

-- | middle A (440 Hz)
a1 :: Frequency
a1 = 440

-- | 'Pitch' consists of 'Scale' and 'Tone'
data NaturalNumber n => Pitch n = Pitch 
        { pitchScale :: Scale n
        , pitchTone  :: Tone n
        } deriving (Show, Eq)


-- | twelve tone equal temperament scale pitch. Scale base tone is @(0, 'c1')@
etPitch :: Tone N12 -> Pitch N12
etPitch = Pitch etc
	where etc = Scale (0, c1) 2 (V.fromList $ map ((2 **) . (/12)) [0 .. 11])

--------------------------------------------------------------
-- Scale

-- | Musical interval. Ratio between two frequency values.
type Interval = Frequency

-- | 'Scale' defines 2d grid in frequency domain. First value of 2d vector 
-- is octave and second is step. 'Scale' consists of base tone, 
-- octave interval and individual tone intervals inside octave. 
-- Base tone links scale coordinates to frequency coordinates. 
-- Base tone is pair (n, f) of integer value and frequency value,
-- Base tone defines that @'tone' n@ corresponds to frequency @f@.
--
-- For example scales @s1@ and @s2@ are equal
--
-- >import Temporal.Music.Notation.Local.Scales(eqt)
-- >
-- >s1 = eqt 0 c1
-- >s2 = eqt 9 a1
--
-- This doesn't make much sense for equal temperament. But can be useful
-- for just scales. For example this gives just pythagorean scale in G major
--
-- >import Temporal.Music.Notation.Local.Scales(pyth)
-- > 
-- >pythG = pyth 7 (3/2 * c1)
-- 
-- if you write just @pyth 0 (3/2 * c1)@ note (0 :: Tone N12) corresponds
-- to G.

data NaturalNumber n => Scale n = Scale 
    { scaleBase   :: (Int, Frequency)   
            -- ^ start point of the grid,
            --   @(n, cps)@ corresponds to @(0, n)@
            --   where n is step id of 'scaleBase' and
            --   @cps@ is 'scaleBase' in frequency units.

    , scaleOctave :: Interval           
            -- ^ octave interval

    , scaleSteps  :: V.Vector Interval  
            -- ^ multipliers for each step in octave
    } deriving (Show, Eq)

-- | gives number of steps in one octave.
scaleSize :: NaturalNumber n => Scale n -> Int
scaleSize = naturalNumberAsInt . num
    where num :: NaturalNumber n => Scale n -> n
          num = const undefined

-- | 'fromIntervals' makes scale constructor from 'octave' interval and
-- scale step intervals.
fromIntervals :: NaturalNumber n 
    => Interval -> [Interval]
    -> (Int -> Frequency -> Scale n)
fromIntervals octave steps = \c0 f0 -> Scale (c0, f0) octave $ V.fromList steps

--------------------------------------------------------------
-- Tone

-- | represents tone's diversion from scale grid.
type Bend   = Double
type Octave = Int
type Step   = Int

-- | 'Tone' is 2d integer value (octave, step) that can be converted to 
-- frequency
-- with some scale. 'Bend' is a level of diversion from scale-tones
-- 1-level bend is equal to 1 step. For tones with fractional bends frequency
-- is calculated with linear interpolation by nearest values in scale.
data NaturalNumber n => Tone n = Tone
        { toneBend   :: Bend     
        , toneOctave :: Octave  
        , toneStep   :: Step
        } deriving (Eq, Show) 

-- | 'tone' constructs Tone from step value. Bend is set to zero.
tone :: NaturalNumber n  => Step -> Tone n
tone x = res
    where res = (uncurry $ Tone 0) $ divMod x d
          d = toneNum res

-- | 'toneNum' queries number of steps in scale for given tone. 
-- It decodes type value to 'Int'.
toneNum :: NaturalNumber n => Tone n -> Int
toneNum x = naturalNumberAsInt $ num x
    where num :: NaturalNumber n => Tone n -> n
          num = const undefined

-- instances

instance NaturalNumber n => Ord (Tone n) where
    compare = compare `on` (\(Tone b o s) -> (o, s, b))

instance NaturalNumber n => Enum (Tone n) where
    toEnum     = tone
    fromEnum x = toneOctave x * toneNum x + toneStep x
 
instance NaturalNumber n => Num (Tone n) where
    (+) = liftBi (+) (+)
    (-) = liftBi (-) (-)
    (*) = liftBi (*) (*)

    abs = liftOne abs abs
    signum t@(Tone b o s)
        | abs b < 1e-6 && o == 0 && s == 0 = 0
        | t > 0 = tone 1
        | otherwise = tone $ -1

    fromInteger = tone . fromInteger

-------------------------------------------------------------------
-------------------------------------------------------------------
-- Transformers

-- Pitch

class PchFunctor a where
	mapPch :: (forall n . NaturalNumber n => Pitch n -> Pitch n) -> (a -> a)
    
instance NaturalNumber n => PchFunctor (Pitch n) where
	mapPch f = f

instance (PchFunctor a) => PchFunctor (Score a) where
	mapPch f = fmap (mapPch f)


-- Scale

class ScaleFunctor a where
    mapScale :: (forall n . NaturalNumber n => Scale n -> Scale n) -> (a -> a)

instance NaturalNumber n => ScaleFunctor (Scale n) where
    mapScale f = f

instance (ScaleFunctor a) => ScaleFunctor (Score a) where
	mapScale f = fmap (mapScale f)

instance NaturalNumber n => ScaleFunctor (Pitch n) where
    mapScale f (Pitch s t) = Pitch (f s) t

-- | setting specific scale
setScale :: (NaturalNumber n, ScaleFunctor a) => Scale n -> a -> a
setScale x = mapScale $ 
    \s -> s{ scaleBase =  scaleBase x, scaleSteps = scaleSteps x }

-- | mapping of scale base tone 
mapBase :: ScaleFunctor a => (Frequency -> Frequency) -> a -> a
mapBase f = mapScale $ \s -> s{ scaleBase = second f $ scaleBase s }

-- | setting scale base tone
setBase :: ScaleFunctor a => Frequency -> a -> a 
setBase b = mapBase $ const b

-- | 'transposeScale' shifts scaleSteps by given number.
-- For example if your just scale is defined with middle C as base
-- and you want to transpose it to middle D you can write
--
-- >res = someScale 2 (wholeTone * c1)
-- >    where wholeTone = 9/8
--
-- or
-- 
-- >transposeScale 2 $ someScale 0 c1
--
-- And now 0 corresponds to middle C and step multipliers are rearranged 
-- so that someScale starts from middle D.
transposeScale :: ScaleFunctor a => Step -> a -> a
transposeScale n = mapScale $ \(Scale b o s) -> Scale b o $ rotateSteps n s
    where rotateSteps x s = V.map ( (/d) . (s V.! ) . flip mod n) ids
              where n   = V.length s  
                    d   = s V.! (mod x n)
                    ids = V.fromList [x .. x + n]
                    
-- Tone
-- | transformer for types that contain tone
class ToneFunctor a where
    mapTone :: (forall n . NaturalNumber n => Tone n -> Tone n) -> (a -> a)

instance NaturalNumber n => ToneFunctor (Tone n) where
    mapTone f = f

instance ToneFunctor a => ToneFunctor (Score a) where
	mapTone f = fmap (mapTone f)

instance NaturalNumber n => ToneFunctor (Pitch n) where
    mapTone f (Pitch s t) = Pitch s $ f t 

-- | set bend value 
setBend :: ToneFunctor a => Bend -> a -> a
setBend d = mapTone $ \x -> x{ toneBend = d }

-- | shift in bends
bend :: ToneFunctor a => Bend -> a -> a
bend d = mapTone $ \x -> x{ toneBend = toneBend x + d }

-- | transposition, shift in steps
step :: ToneFunctor a => Step -> a -> a
step n = mapTone (tone n + )

-- | one octave lower
low :: ToneFunctor a => a -> a
low = lower 1

-- | one octave higher
high :: ToneFunctor a => a -> a
high = higher 1

-- | shifts downwards in octaves
lower :: ToneFunctor a => Int -> a -> a
lower n = higher (-n)

-- | shifts upwards in octaves
higher :: ToneFunctor a => Int -> a -> a
higher n = mapTone $ \(Tone b o s) -> Tone b (o + n) s

-- | inverts note around some tone center. Tone center defines
-- two tones octave apart around current note in wich inversion takes place.
--
-- For example with center at 5 note @c@ in twelve tone scale 
-- @[5, 6, 7, 8, 9, bb, 11, c, 1, 2, 3, 4, 5]@ goes into note  bb.
-- Inversion counts number of steps from lower center tone to given tone
-- and then result is higher center tone shifted lower by this number.
invert :: ToneFunctor a => Step -> a -> a
invert center = mapTone $  
    \t@(Tone b o s) -> 
        let n = toneNum t
            c = mod center n
            q = if c <= s
                then (2 * c + n - s)
                else (2 * c - n - s)
            (o', s') = divMod q n
        in  Tone b (o + o') s'


-----------------------------------------------------------
-- rendering

-- | pitch to frequency conversion
absPitch :: NaturalNumber n => Pitch n -> Frequency
absPitch (Pitch s t) = frequency s t

-- | calculates frequency value for given tone on scale grid
frequency :: NaturalNumber n => Scale n -> Tone n -> Frequency
frequency s (Tone b o n) = (bendCoeff r' n' s * ) $
    f0 * (scaleOctave s ^^ (o + o')) * (scaleSteps s V.! n')
    where (o', n') = divMod (n - c0 + fromIntegral b') $ scaleSize s
          b' = floor b
          r' = b - fromInteger b'
          (c0, f0) = scaleBase s


bendCoeff :: NaturalNumber n => Bend -> Step -> Scale n -> Double
bendCoeff r n s
    | abs r < 1e-6 = 1
    | r > 0        = flip loginterpCoeff r       $ getTones s n $ n + 1
    | otherwise    = flip loginterpCoeff (abs r) $ getTones s n $ n - 1
    where getTones s n1 n2 = (getTone s n1, getTone s n2)  
          getTone  s = frequency s . tone 
    
loginterpCoeff :: (Double, Double) -> Double -> Double
loginterpCoeff (l, r) x = (r / l) ** x


-- tone manipulation

liftOne :: NaturalNumber n     
    => (Double -> Double) -> (Int -> Int) 
    -> Tone n -> Tone n
liftOne f g (Tone b o s) = fit $ Tone (f b) (g o) (g s)

liftBi :: NaturalNumber n 
    => (Double -> Double -> Double) -> (Int -> Int -> Int) 
    -> Tone n -> Tone n -> Tone n
liftBi f g (Tone b o s) (Tone b' o' s') = 
    fit $ Tone (b `f` b') (o `g` o') (s `g` s')

fit :: NaturalNumber n => Tone n -> Tone n
fit t@(Tone b o s) = Tone b (o + o') s'
    where (o', s') = divMod s $ toneNum t