{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}

module Sound.Tidal.Time where

import Control.Applicative
import Control.DeepSeq (NFData)
import Data.Ratio
import GHC.Generics

-- | Time is rational
type Time = Rational

-- | An arc of time, with a start time (or onset) and a stop time (or offset)
data ArcF a = Arc
  { forall a. ArcF a -> a
start :: a,
    forall a. ArcF a -> a
stop :: a
  }
  deriving (ArcF a -> ArcF a -> Bool
(ArcF a -> ArcF a -> Bool)
-> (ArcF a -> ArcF a -> Bool) -> Eq (ArcF a)
forall a. Eq a => ArcF a -> ArcF a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => ArcF a -> ArcF a -> Bool
== :: ArcF a -> ArcF a -> Bool
$c/= :: forall a. Eq a => ArcF a -> ArcF a -> Bool
/= :: ArcF a -> ArcF a -> Bool
Eq, Eq (ArcF a)
Eq (ArcF a) =>
(ArcF a -> ArcF a -> Ordering)
-> (ArcF a -> ArcF a -> Bool)
-> (ArcF a -> ArcF a -> Bool)
-> (ArcF a -> ArcF a -> Bool)
-> (ArcF a -> ArcF a -> Bool)
-> (ArcF a -> ArcF a -> ArcF a)
-> (ArcF a -> ArcF a -> ArcF a)
-> Ord (ArcF a)
ArcF a -> ArcF a -> Bool
ArcF a -> ArcF a -> Ordering
ArcF a -> ArcF a -> ArcF a
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
forall a. Ord a => Eq (ArcF a)
forall a. Ord a => ArcF a -> ArcF a -> Bool
forall a. Ord a => ArcF a -> ArcF a -> Ordering
forall a. Ord a => ArcF a -> ArcF a -> ArcF a
$ccompare :: forall a. Ord a => ArcF a -> ArcF a -> Ordering
compare :: ArcF a -> ArcF a -> Ordering
$c< :: forall a. Ord a => ArcF a -> ArcF a -> Bool
< :: ArcF a -> ArcF a -> Bool
$c<= :: forall a. Ord a => ArcF a -> ArcF a -> Bool
<= :: ArcF a -> ArcF a -> Bool
$c> :: forall a. Ord a => ArcF a -> ArcF a -> Bool
> :: ArcF a -> ArcF a -> Bool
$c>= :: forall a. Ord a => ArcF a -> ArcF a -> Bool
>= :: ArcF a -> ArcF a -> Bool
$cmax :: forall a. Ord a => ArcF a -> ArcF a -> ArcF a
max :: ArcF a -> ArcF a -> ArcF a
$cmin :: forall a. Ord a => ArcF a -> ArcF a -> ArcF a
min :: ArcF a -> ArcF a -> ArcF a
Ord, (forall a b. (a -> b) -> ArcF a -> ArcF b)
-> (forall a b. a -> ArcF b -> ArcF a) -> Functor ArcF
forall a b. a -> ArcF b -> ArcF a
forall a b. (a -> b) -> ArcF a -> ArcF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ArcF a -> ArcF b
fmap :: forall a b. (a -> b) -> ArcF a -> ArcF b
$c<$ :: forall a b. a -> ArcF b -> ArcF a
<$ :: forall a b. a -> ArcF b -> ArcF a
Functor, Int -> ArcF a -> ShowS
[ArcF a] -> ShowS
ArcF a -> String
(Int -> ArcF a -> ShowS)
-> (ArcF a -> String) -> ([ArcF a] -> ShowS) -> Show (ArcF a)
forall a. Show a => Int -> ArcF a -> ShowS
forall a. Show a => [ArcF a] -> ShowS
forall a. Show a => ArcF a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ArcF a -> ShowS
showsPrec :: Int -> ArcF a -> ShowS
$cshow :: forall a. Show a => ArcF a -> String
show :: ArcF a -> String
$cshowList :: forall a. Show a => [ArcF a] -> ShowS
showList :: [ArcF a] -> ShowS
Show, (forall x. ArcF a -> Rep (ArcF a) x)
-> (forall x. Rep (ArcF a) x -> ArcF a) -> Generic (ArcF a)
forall x. Rep (ArcF a) x -> ArcF a
forall x. ArcF a -> Rep (ArcF a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ArcF a) x -> ArcF a
forall a x. ArcF a -> Rep (ArcF a) x
$cfrom :: forall a x. ArcF a -> Rep (ArcF a) x
from :: forall x. ArcF a -> Rep (ArcF a) x
$cto :: forall a x. Rep (ArcF a) x -> ArcF a
to :: forall x. Rep (ArcF a) x -> ArcF a
Generic)

type Arc = ArcF Time

instance Applicative ArcF where
  pure :: forall a. a -> ArcF a
pure a
t = a -> a -> ArcF a
forall a. a -> a -> ArcF a
Arc a
t a
t
  <*> :: forall a b. ArcF (a -> b) -> ArcF a -> ArcF b
(<*>) (Arc a -> b
sf a -> b
ef) (Arc a
sx a
ex) = b -> b -> ArcF b
forall a. a -> a -> ArcF a
Arc (a -> b
sf a
sx) (a -> b
ef a
ex)

instance (NFData a) => NFData (ArcF a)

instance (Num a) => Num (ArcF a) where
  negate :: ArcF a -> ArcF a
negate = (a -> a) -> ArcF a -> ArcF a
forall a b. (a -> b) -> ArcF a -> ArcF b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
negate
  + :: ArcF a -> ArcF a -> ArcF a
(+) = (a -> a -> a) -> ArcF a -> ArcF a -> ArcF a
forall a b c. (a -> b -> c) -> ArcF a -> ArcF b -> ArcF c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(+)
  * :: ArcF a -> ArcF a -> ArcF a
(*) = (a -> a -> a) -> ArcF a -> ArcF a -> ArcF a
forall a b c. (a -> b -> c) -> ArcF a -> ArcF b -> ArcF c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(*)
  fromInteger :: Integer -> ArcF a
fromInteger = a -> ArcF a
forall a. a -> ArcF a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> ArcF a) -> (Integer -> a) -> Integer -> ArcF a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger
  abs :: ArcF a -> ArcF a
abs = (a -> a) -> ArcF a -> ArcF a
forall a b. (a -> b) -> ArcF a -> ArcF b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
abs
  signum :: ArcF a -> ArcF a
signum = (a -> a) -> ArcF a -> ArcF a
forall a b. (a -> b) -> ArcF a -> ArcF b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
signum

instance (Fractional a) => Fractional (ArcF a) where
  recip :: ArcF a -> ArcF a
recip = (a -> a) -> ArcF a -> ArcF a
forall a b. (a -> b) -> ArcF a -> ArcF b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Fractional a => a -> a
recip
  fromRational :: Time -> ArcF a
fromRational = a -> ArcF a
forall a. a -> ArcF a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> ArcF a) -> (Time -> a) -> Time -> ArcF a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> a
forall a. Fractional a => Time -> a
fromRational

-- * Utility functions - Time

-- | The @sam@ (start of cycle) for the given time value.
-- Cycles have duration 1, so every integer Time value divides two cycles.
sam :: Time -> Time
sam :: Time -> Time
sam = Int -> Time
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Time) -> (Time -> Int) -> Time -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Time -> Int
forall b. Integral b => Time -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor :: Time -> Int)

-- | Turns a number into a (rational) time value. An alias for @toRational@.
toTime :: (Real a) => a -> Rational
toTime :: forall a. Real a => a -> Time
toTime = a -> Time
forall a. Real a => a -> Time
toRational

-- | Turns a (rational) time value into another number. An alias for @fromRational@.
fromTime :: (Fractional a) => Time -> a
fromTime :: forall a. Fractional a => Time -> a
fromTime = Time -> a
forall a. Fractional a => Time -> a
fromRational

-- | The end point of the current cycle (and starting point of the next cycle)
nextSam :: Time -> Time
nextSam :: Time -> Time
nextSam = (Time
1 Time -> Time -> Time
forall a. Num a => a -> a -> a
+) (Time -> Time) -> (Time -> Time) -> Time -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Time
sam

-- | The position of a time value relative to the start of its cycle.
cyclePos :: Time -> Time
cyclePos :: Time -> Time
cyclePos Time
t = Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time -> Time
sam Time
t

-- * Utility functions - Arc

-- | convex hull union
hull :: Arc -> Arc -> Arc
hull :: Arc -> Arc -> Arc
hull (Arc Time
s Time
e) (Arc Time
s' Time
e') = Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc (Time -> Time -> Time
forall a. Ord a => a -> a -> a
min Time
s Time
s') (Time -> Time -> Time
forall a. Ord a => a -> a -> a
max Time
e Time
e')

-- | @subArc i j@ is the timespan that is the intersection of @i@ and @j@.
-- intersection
-- The definition is a bit fiddly as results might be zero-width, but
-- not at the end of an non-zero-width arc - e.g. (0,1) and (1,2) do
-- not intersect, but (1,1) (1,1) does.
subArc :: Arc -> Arc -> Maybe Arc
subArc :: Arc -> Arc -> Maybe Arc
subArc a :: Arc
a@(Arc Time
s Time
e) b :: Arc
b@(Arc Time
s' Time
e')
  | [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Time
s'' Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
e'', Time
s'' Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
e, Time
s Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
e] = Maybe Arc
forall a. Maybe a
Nothing
  | [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Time
s'' Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
e'', Time
s'' Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
e', Time
s' Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
e'] = Maybe Arc
forall a. Maybe a
Nothing
  | Time
s'' Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= Time
e'' = Arc -> Maybe Arc
forall a. a -> Maybe a
Just (Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc Time
s'' Time
e'')
  | Bool
otherwise = Maybe Arc
forall a. Maybe a
Nothing
  where
    (Arc Time
s'' Time
e'') = Arc -> Arc -> Arc
sect Arc
a Arc
b

subMaybeArc :: Maybe Arc -> Maybe Arc -> Maybe (Maybe Arc)
subMaybeArc :: Maybe Arc -> Maybe Arc -> Maybe (Maybe Arc)
subMaybeArc (Just Arc
a) (Just Arc
b) = do
  Arc
sa <- Arc -> Arc -> Maybe Arc
subArc Arc
a Arc
b
  Maybe Arc -> Maybe (Maybe Arc)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Arc -> Maybe (Maybe Arc)) -> Maybe Arc -> Maybe (Maybe Arc)
forall a b. (a -> b) -> a -> b
$ Arc -> Maybe Arc
forall a. a -> Maybe a
Just Arc
sa
subMaybeArc Maybe Arc
_ Maybe Arc
_ = Maybe Arc -> Maybe (Maybe Arc)
forall a. a -> Maybe a
Just Maybe Arc
forall a. Maybe a
Nothing

-- subMaybeArc = liftA2 subArc -- this typechecks, but doesn't work the same way.. hmm

-- | Simple intersection of two arcs
sect :: Arc -> Arc -> Arc
sect :: Arc -> Arc -> Arc
sect (Arc Time
s Time
e) (Arc Time
s' Time
e') = Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc (Time -> Time -> Time
forall a. Ord a => a -> a -> a
max Time
s Time
s') (Time -> Time -> Time
forall a. Ord a => a -> a -> a
min Time
e Time
e')

-- | The Arc returned is the cycle that the Time falls within.
--
-- Edge case: If the Time is an integer,
-- the Arc claiming it is the one starting at that Time,
-- not the previous one ending at that Time.
timeToCycleArc :: Time -> Arc
timeToCycleArc :: Time -> Arc
timeToCycleArc Time
t = Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc (Time -> Time
sam Time
t) (Time -> Time
sam Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
1)

-- | Shifts an Arc to one of equal duration that starts within cycle zero.
-- (Note that the output Arc probably does not start *at* Time 0 --
-- that only happens when the input Arc starts at an integral Time.)
cycleArc :: Arc -> Arc
cycleArc :: Arc -> Arc
cycleArc (Arc Time
s Time
e) = Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc (Time -> Time
cyclePos Time
s) (Time -> Time
cyclePos Time
s Time -> Time -> Time
forall a. Num a => a -> a -> a
+ (Time
e Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
s))

-- | Returns the numbers of the cycles that the input @Arc@ overlaps
-- (excluding the input @Arc@'s endpoint, unless it has duration 0 --
-- see "Edge cases" below).
-- (The "cycle number" of an @Arc@ is equal to its start value.
-- Thus, for instance, @cyclesInArc (Arc 0 1.5) == [0,1]@.)
--
-- Edge cases:
-- > cyclesInArc $ Arc 0 1.0001 == [0,1]
-- > cyclesInArc $ Arc 0 1      == [0] -- the endpoint is excluded
-- > cyclesInArc $ Arc 1 1      == [1] -- unless the Arc has duration 0
--
-- PITFALL: Don't be fooled by the name. The output cycles
-- are not necessarily completely contained in the input @Arc@,
-- but they definitely overlap it,
-- and they include every cycle that overlaps it.
cyclesInArc :: (Integral a) => Arc -> [a]
cyclesInArc :: forall a. Integral a => Arc -> [a]
cyclesInArc (Arc Time
s Time
e)
  | Time
s Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
e = []
  | Time
s Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
e = [Time -> a
forall b. Integral b => Time -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Time
s]
  | Bool
otherwise = [Time -> a
forall b. Integral b => Time -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Time
s .. Time -> a
forall b. Integral b => Time -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Time
e a -> a -> a
forall a. Num a => a -> a -> a
- a
1]

-- | This provides exactly the same information as @cyclesInArc@,
-- except that this represents its output as @Arc@s,
-- whereas @cyclesInArc@ represents the same information as integral indices.
-- (The @Arc@ from 0 to 1 corresponds to the index 0,
-- the one from 1 to 2 has index 1, etc.)
cycleArcsInArc :: Arc -> [Arc]
cycleArcsInArc :: Arc -> [Arc]
cycleArcsInArc = (Int -> Arc) -> [Int] -> [Arc]
forall a b. (a -> b) -> [a] -> [b]
map (Time -> Arc
timeToCycleArc (Time -> Arc) -> (Int -> Time) -> Int -> Arc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Time
forall a. Real a => a -> Time
toTime :: Int -> Time)) ([Int] -> [Arc]) -> (Arc -> [Int]) -> Arc -> [Arc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arc -> [Int]
forall a. Integral a => Arc -> [a]
cyclesInArc

-- | Splits the given @Arc@ into a list of @Arc@s, at cycle boundaries.
arcCycles :: Arc -> [Arc]
arcCycles :: Arc -> [Arc]
arcCycles (Arc Time
s Time
e)
  | Time
s Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
>= Time
e = []
  | Time -> Time
sam Time
s Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time -> Time
sam Time
e = [Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc Time
s Time
e]
  | Bool
otherwise = Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc Time
s (Time -> Time
nextSam Time
s) Arc -> [Arc] -> [Arc]
forall a. a -> [a] -> [a]
: Arc -> [Arc]
arcCycles (Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc (Time -> Time
nextSam Time
s) Time
e)

-- | Like arcCycles, but returns zero-width arcs
arcCyclesZW :: Arc -> [Arc]
arcCyclesZW :: Arc -> [Arc]
arcCyclesZW (Arc Time
s Time
e)
  | Time
s Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
e = [Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc Time
s Time
e]
  | Bool
otherwise = Arc -> [Arc]
arcCycles (Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc Time
s Time
e)

-- | Similar to @fmap@ but time is relative to the cycle (i.e. the
-- sam of the start of the arc)
mapCycle :: (Time -> Time) -> Arc -> Arc
mapCycle :: (Time -> Time) -> Arc -> Arc
mapCycle Time -> Time
f (Arc Time
s Time
e) = Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc (Time
sam' Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time -> Time
f (Time
s Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
sam')) (Time
sam' Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time -> Time
f (Time
e Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
sam'))
  where
    sam' :: Time
sam' = Time -> Time
sam Time
s

-- | @isIn a t@ is @True@ if @t@ is inside
-- the arc represented by @a@.
isIn :: Arc -> Time -> Bool
isIn :: Arc -> Time -> Bool
isIn (Arc Time
s Time
e) Time
t = Time
t Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
>= Time
s Bool -> Bool -> Bool
&& Time
t Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
e

-- | Returns the lowest common multiple of two rational numbers
lcmr :: Rational -> Rational -> Rational
lcmr :: Time -> Time -> Time
lcmr Time
a Time
b = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
lcm (Time -> Integer
forall a. Ratio a -> a
numerator Time
a) (Time -> Integer
forall a. Ratio a -> a
numerator Time
b) Integer -> Integer -> Time
forall a. Integral a => a -> a -> Ratio a
% Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
gcd (Time -> Integer
forall a. Ratio a -> a
denominator Time
a) (Time -> Integer
forall a. Ratio a -> a
denominator Time
b)