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

module Sound.Tidal.Time where

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

-- | 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
forall a. Eq a => ArcF a -> ArcF a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArcF a -> ArcF a -> Bool
$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
Eq, ArcF a -> ArcF a -> Bool
ArcF a -> ArcF a -> Ordering
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
min :: ArcF a -> ArcF a -> ArcF a
$cmin :: forall a. Ord a => ArcF a -> ArcF a -> ArcF a
max :: ArcF a -> ArcF a -> ArcF a
$cmax :: forall a. Ord a => ArcF a -> ArcF a -> ArcF a
>= :: 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
$c< :: forall a. Ord a => ArcF a -> ArcF a -> Bool
compare :: ArcF a -> ArcF a -> Ordering
$ccompare :: forall a. Ord a => ArcF a -> ArcF a -> Ordering
Ord, 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
<$ :: forall a b. a -> ArcF b -> ArcF a
$c<$ :: forall a b. a -> ArcF b -> ArcF a
fmap :: forall a b. (a -> b) -> ArcF a -> ArcF b
$cfmap :: forall a b. (a -> b) -> ArcF a -> ArcF b
Functor, Int -> ArcF a -> ShowS
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
showList :: [ArcF a] -> ShowS
$cshowList :: forall a. Show a => [ArcF a] -> ShowS
show :: ArcF a -> String
$cshow :: forall a. Show a => ArcF a -> String
showsPrec :: Int -> ArcF a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ArcF a -> ShowS
Show, 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
$cto :: forall a x. Rep (ArcF a) x -> ArcF a
$cfrom :: forall a x. ArcF a -> Rep (ArcF a) x
Generic)

type Arc = ArcF Time

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

instance (Fractional a) => Fractional (ArcF a) where
  recip :: ArcF a -> ArcF a
recip        = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Fractional a => a -> a
recip
  fromRational :: Time -> ArcF a
fromRational = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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 = 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 = 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
1forall a. Num a => a -> a -> a
+) 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 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') = forall a. a -> a -> ArcF a
Arc (forall a. Ord a => a -> a -> a
min Time
s Time
s') (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')
  | forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Time
s'' forall a. Eq a => a -> a -> Bool
== Time
e'', Time
s'' forall a. Eq a => a -> a -> Bool
== Time
e, Time
s forall a. Ord a => a -> a -> Bool
< Time
e] = forall a. Maybe a
Nothing
  | forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Time
s'' forall a. Eq a => a -> a -> Bool
== Time
e'', Time
s'' forall a. Eq a => a -> a -> Bool
== Time
e', Time
s' forall a. Ord a => a -> a -> Bool
< Time
e'] = forall a. Maybe a
Nothing
  | Time
s'' forall a. Ord a => a -> a -> Bool
<= Time
e'' = forall a. a -> Maybe a
Just (forall a. a -> a -> ArcF a
Arc Time
s'' Time
e'')
  | Bool
otherwise = 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
                                   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Arc
sa
subMaybeArc Maybe Arc
_ Maybe Arc
_ = forall a. a -> Maybe a
Just 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') = forall a. a -> a -> ArcF a
Arc (forall a. Ord a => a -> a -> a
max Time
s Time
s') (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 = forall a. a -> a -> ArcF a
Arc (Time -> Time
sam Time
t) (Time -> Time
sam Time
t 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) = forall a. a -> a -> ArcF a
Arc (Time -> Time
cyclePos Time
s) (Time -> Time
cyclePos Time
s forall a. Num a => a -> a -> a
+ (Time
eforall 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
cyclesInArc :: Integral a => Arc -> [a]
cyclesInArc :: forall a. Integral a => Arc -> [a]
cyclesInArc (Arc Time
s Time
e)
  | Time
s forall a. Ord a => a -> a -> Bool
> Time
e = []
  | Time
s forall a. Eq a => a -> a -> Bool
== Time
e = [forall a b. (RealFrac a, Integral b) => a -> b
floor Time
s]
  | Bool
otherwise = [forall a b. (RealFrac a, Integral b) => a -> b
floor Time
s .. forall a b. (RealFrac a, Integral b) => a -> b
ceiling Time
eforall a. Num a => a -> a -> a
-a
1]

-- | The whole cycles that overlap the input Arc,
-- (excluding its endpoint, unless it has duration 0,
-- similarly to `cyclesInArc` --
-- see that function's description for details).
cycleArcsInArc :: Arc -> [Arc]
cycleArcsInArc :: Arc -> [Arc]
cycleArcsInArc = forall a b. (a -> b) -> [a] -> [b]
map (Time -> Arc
timeToCycleArc forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Real a => a -> Time
toTime :: Int -> Time)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall a. Ord a => a -> a -> Bool
>= Time
e = []
                | Time -> Time
sam Time
s forall a. Eq a => a -> a -> Bool
== Time -> Time
sam Time
e = [forall a. a -> a -> ArcF a
Arc Time
s Time
e]
                | Bool
otherwise = forall a. a -> a -> ArcF a
Arc Time
s (Time -> Time
nextSam Time
s) forall a. a -> [a] -> [a]
: Arc -> [Arc]
arcCycles (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 forall a. Eq a => a -> a -> Bool
== Time
e = [forall a. a -> a -> ArcF a
Arc Time
s Time
e]
                  | Bool
otherwise = Arc -> [Arc]
arcCycles (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) = forall a. a -> a -> ArcF a
Arc (Time
sam' forall a. Num a => a -> a -> a
+ Time -> Time
f (Time
s forall a. Num a => a -> a -> a
- Time
sam')) (Time
sam' forall a. Num a => a -> a -> a
+ Time -> Time
f (Time
e 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 forall a. Ord a => a -> a -> Bool
>= Time
s Bool -> Bool -> Bool
&& Time
t forall a. Ord a => a -> a -> Bool
< Time
e