{-# LANGUAGE DeriveGeneric #-}
module Data.Tempo where

import Data.Time
import GHC.Generics

-- | Musical tempo is represented as a data structure with three orthogonal components.
-- (Generic instances are derived in order to allow later generation of instances for
-- Aeson classes.)

data Tempo = Tempo {
  Tempo -> Rational
freq :: Rational, -- frequency of cycles/beats, ie. cycles/beats per second
  Tempo -> UTCTime
time :: UTCTime, -- a time at which a number of "elapsed" cycles/beats will be indicated
  Tempo -> Rational
count :: Rational -- the number of "elapsed" cycles/beats at the time indicated
  } deriving (Tempo -> Tempo -> Bool
(Tempo -> Tempo -> Bool) -> (Tempo -> Tempo -> Bool) -> Eq Tempo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tempo -> Tempo -> Bool
$c/= :: Tempo -> Tempo -> Bool
== :: Tempo -> Tempo -> Bool
$c== :: Tempo -> Tempo -> Bool
Eq,(forall x. Tempo -> Rep Tempo x)
-> (forall x. Rep Tempo x -> Tempo) -> Generic Tempo
forall x. Rep Tempo x -> Tempo
forall x. Tempo -> Rep Tempo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tempo x -> Tempo
$cfrom :: forall x. Tempo -> Rep Tempo x
Generic,Int -> Tempo -> ShowS
[Tempo] -> ShowS
Tempo -> String
(Int -> Tempo -> ShowS)
-> (Tempo -> String) -> ([Tempo] -> ShowS) -> Show Tempo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tempo] -> ShowS
$cshowList :: [Tempo] -> ShowS
show :: Tempo -> String
$cshow :: Tempo -> String
showsPrec :: Int -> Tempo -> ShowS
$cshowsPrec :: Int -> Tempo -> ShowS
Show)


-- | The 'origin' of a Tempo is the time at which the number of elapsed cycles/beats
-- would have been 0.

origin :: Tempo -> UTCTime
origin :: Tempo -> UTCTime
origin Tempo
x = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (Rational -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Rational -> NominalDiffTime) -> Rational -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Tempo -> Rational
count Tempo
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* (-Rational
1) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Tempo -> Rational
freq Tempo
x) (Tempo -> UTCTime
time Tempo
x)


-- | Given a Tempo and a clock time (UTCTime), timeToCount tells us how many cycles/beats
-- have elapsed at that time.

timeToCount :: Tempo -> UTCTime -> Rational
timeToCount :: Tempo -> UTCTime -> Rational
timeToCount Tempo
x UTCTime
t = (NominalDiffTime -> Rational
forall a b. (Real a, Fractional b) => a -> b
realToFrac (NominalDiffTime -> Rational) -> NominalDiffTime -> Rational
forall a b. (a -> b) -> a -> b
$ UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
t (UTCTime -> NominalDiffTime) -> UTCTime -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Tempo -> UTCTime
time Tempo
x) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Tempo -> Rational
freq Tempo
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Tempo -> Rational
count Tempo
x

-- | Given a Tempo and a count of elapsed cycles/beats, countToTime tells us when that "beat"
-- will (or would have) take(n) place.

countToTime :: Tempo -> Rational -> UTCTime
countToTime :: Tempo -> Rational -> UTCTime
countToTime Tempo
x Rational
c = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime  (Rational -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Rational -> NominalDiffTime) -> Rational -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Rational
c Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Tempo -> Rational
freq Tempo
x) (Tempo -> UTCTime
origin Tempo
x)


-- | Provided a new frequency and a pivot time, changeTempo modifies a given Tempo as if
-- the frequency changed at the pivot time, with the count continuing to increase 'monotonically'

changeTempo :: Rational -> UTCTime -> Tempo -> Tempo
changeTempo :: Rational -> UTCTime -> Tempo -> Tempo
changeTempo Rational
f UTCTime
t Tempo
x = Tempo :: Rational -> UTCTime -> Rational -> Tempo
Tempo {
  freq :: Rational
freq = Rational
f,
  time :: UTCTime
time = UTCTime
t,
  count :: Rational
count = Tempo -> UTCTime -> Rational
timeToCount Tempo
x UTCTime
t
  }

-- | For convenience, changeTempoNow is an IO action that changes the frequency of the tempo
-- 'now', ie. at the time returned by a call to getCurrentTime embedded in the action.

changeTempoNow :: Rational -> Tempo -> IO Tempo
changeTempoNow :: Rational -> Tempo -> IO Tempo
changeTempoNow Rational
f Tempo
x = do
  UTCTime
t <- IO UTCTime
getCurrentTime
  Tempo -> IO Tempo
forall (m :: * -> *) a. Monad m => a -> m a
return (Tempo -> IO Tempo) -> Tempo -> IO Tempo
forall a b. (a -> b) -> a -> b
$ Rational -> UTCTime -> Tempo -> Tempo
changeTempo Rational
f UTCTime
t Tempo
x

-- | Given a tempo, a window defined by two UTCTime-s, a metre (cycles of cycles), and an offset
-- within that metre, findBeats returns all occurrences of the defined metric position within the window.
-- The window is inclusive at the lower limit, and exclusive at the upper limit (so answers can
-- occur exactly at the lower limit but not at the upper limit).

findBeats :: Tempo -> UTCTime -> UTCTime -> Rational -> Rational -> [Rational]
findBeats :: Tempo -> UTCTime -> UTCTime -> Rational -> Rational -> [Rational]
findBeats Tempo
tempo UTCTime
lowerLimitUtc UTCTime
upperLimitUtc Rational
metre Rational
offset =
  let lowerLimitCycles :: Rational
lowerLimitCycles = Tempo -> UTCTime -> Rational
timeToCount Tempo
tempo UTCTime
lowerLimitUtc
      upperLimitCycles :: Rational
upperLimitCycles = Tempo -> UTCTime -> Rational
timeToCount Tempo
tempo UTCTime
upperLimitUtc
  in Rational -> Rational -> Rational -> Rational -> [Rational]
findBeats' Rational
metre Rational
offset Rational
lowerLimitCycles Rational
upperLimitCycles

-- | Given a metre and offset (eg. 2 and 0.5 to represent half-way through the first cycle
-- of a metre lasting 2 cycles), and lower and upper limits in elapsed cycles, findBeats'
-- returns all positions that match the given offset and metre and are greater than or equal
-- to the lower limit, and lower than the upper limit.

findBeats' :: Rational -> Rational -> Rational -> Rational -> [Rational]
findBeats' :: Rational -> Rational -> Rational -> Rational -> [Rational]
findBeats' Rational
metre Rational
offset Rational
lowerLimit Rational
upperLimit
  | Rational -> Rational -> Rational -> Rational
nextBeat Rational
metre Rational
offset Rational
lowerLimit Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= Rational
upperLimit = []
  | Bool
otherwise = Rational -> Rational -> Rational -> Rational
nextBeat Rational
metre Rational
offset Rational
lowerLimit Rational -> [Rational] -> [Rational]
forall a. a -> [a] -> [a]
: Rational -> Rational -> Rational -> Rational -> [Rational]
findBeats' Rational
metre Rational
offset (Rational
lowerLimitRational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
metre) Rational
upperLimit

-- | Given a metre, offset, and a lower limit in elapsed cycles, nextBeat returns the next
-- position in cycles that matches the given offset and metre, and is greater than
-- or equal to the lower limit.

nextBeat :: Rational -> Rational -> Rational -> Rational
nextBeat :: Rational -> Rational -> Rational -> Rational
nextBeat Rational
metre Rational
offset Rational
lowerLimit
  | Rational
metre Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
0 = String -> Rational
forall a. HasCallStack => String -> a
error String
"you can't have a metre of 0!!!"
  | Bool
otherwise =
  let fract :: a -> a
fract a
x = a
x a -> a -> a
forall a. Num a => a -> a -> a
- Integer -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac (a -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor a
x :: Integer) -- for convenience
      lowerLimitInMetre :: Rational
lowerLimitInMetre = Rational
lowerLimitRational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
metre -- lower limit expressed in multiples of the metre (cycles of cycles)
      offsetInMetre :: Rational
offsetInMetre = Rational -> Rational
forall a. RealFrac a => a -> a
fract (Rational -> Rational) -> Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Rational
offsetRational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
metre -- offset expressed in multiples of the metre
      -- the answer occurs either in this instance of the metre, or the next...
      nextBeatInMetre :: Rational
nextBeatInMetre | Rational
offsetInMetre Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= (Rational -> Rational
forall a. RealFrac a => a -> a
fract Rational
lowerLimitInMetre) = (Integer -> Rational
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor Rational
lowerLimitInMetre :: Integer)) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
offsetInMetre
                      | Bool
otherwise = (Integer -> Rational
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Rational
lowerLimitInMetre :: Integer)) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
offsetInMetre
  in Rational
nextBeatInMetreRational -> Rational -> Rational
forall a. Num a => a -> a -> a
*Rational
metre -- translate answer in terms of meter back to cycles