{-# 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
  { ArcF a -> a
start :: 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
/= :: 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, 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
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
$cp1Ord :: forall a. Ord a => Eq (ArcF a)
Ord, a -> ArcF b -> ArcF a
(a -> b) -> ArcF a -> ArcF b
(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
<$ :: a -> ArcF b -> ArcF a
$c<$ :: forall a b. a -> ArcF b -> ArcF a
fmap :: (a -> b) -> ArcF a -> ArcF b
$cfmap :: forall a b. (a -> b) -> ArcF a -> ArcF b
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
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 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
$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 :: a -> ArcF a
pure a
t = a -> a -> ArcF a
forall a. a -> a -> ArcF a
Arc a
t a
t
  <*> :: 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 (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 (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 (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 (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 (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 (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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Fractional a => a -> a
recip
  fromRational :: Rational -> ArcF a
fromRational = a -> ArcF a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> ArcF a) -> (Rational -> a) -> Rational -> ArcF a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. Fractional a => Rational -> a
fromRational

-- Utility functions - Time

-- | The 'sam' (start of cycle) for the given time value
sam :: Time -> Time
sam :: Rational -> Rational
sam = Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Rational) -> (Rational -> Int) -> Rational -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Rational -> Int
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 :: a -> Rational
toTime = a -> Rational
forall a. Real a => a -> Rational
toRational

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

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

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

-- Utility functions - Arc

-- | convex hull union
hull :: Arc -> Arc -> Arc
hull :: Arc -> Arc -> Arc
hull (Arc Rational
s Rational
e) (Arc Rational
s' Rational
e') = Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
min Rational
s Rational
s') (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
max Rational
e Rational
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 Rational
s Rational
e) b :: Arc
b@(Arc Rational
s' Rational
e')
  | [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Rational
s'' Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
e'', Rational
s'' Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
e, Rational
s Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
e] = Maybe Arc
forall a. Maybe a
Nothing
  | [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Rational
s'' Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
e'', Rational
s'' Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
e', Rational
s' Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
e'] = Maybe Arc
forall a. Maybe a
Nothing
  | Rational
s'' Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
<= Rational
e'' = Arc -> Maybe Arc
forall a. a -> Maybe a
Just (Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc Rational
s'' Rational
e'')
  | Bool
otherwise = Maybe Arc
forall a. Maybe a
Nothing
  where (Arc Rational
s'' Rational
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 (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 Rational
s Rational
e) (Arc Rational
s' Rational
e') = Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
max Rational
s Rational
s') (Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
min Rational
e Rational
e')


-- | The arc of the whole cycle that the given time value falls within
timeToCycleArc :: Time -> Arc
timeToCycleArc :: Rational -> Arc
timeToCycleArc Rational
t = Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc (Rational -> Rational
sam Rational
t) (Rational -> Rational
sam Rational
t Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
1)

-- | Shifts an arc to the equivalent one that starts during cycle zero
cycleArc :: Arc -> Arc
cycleArc :: Arc -> Arc
cycleArc (Arc Rational
s Rational
e) = Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc (Rational -> Rational
cyclePos Rational
s) (Rational -> Rational
cyclePos Rational
s Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ (Rational
eRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
s))

-- | A list of cycle numbers which are included in the given arc
cyclesInArc :: Integral a => Arc -> [a]
cyclesInArc :: Arc -> [a]
cyclesInArc (Arc Rational
s Rational
e)
  | Rational
s Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
e = []
  | Rational
s Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
e = [Rational -> a
forall a b. (RealFrac a, Integral b) => a -> b
floor Rational
s]
  | Bool
otherwise = [Rational -> a
forall a b. (RealFrac a, Integral b) => a -> b
floor Rational
s .. Rational -> a
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Rational
ea -> a -> a
forall a. Num a => a -> a -> a
-a
1]

-- | A list of arcs of the whole cycles which are included in the given arc
cycleArcsInArc :: Arc -> [Arc]
cycleArcsInArc :: Arc -> [Arc]
cycleArcsInArc = (Int -> Arc) -> [Int] -> [Arc]
forall a b. (a -> b) -> [a] -> [b]
map (Rational -> Arc
timeToCycleArc (Rational -> Arc) -> (Int -> Rational) -> Int -> Arc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Rational
forall a. Real a => a -> Rational
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 Rational
s Rational
e) | Rational
s Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
>= Rational
e = []
                | Rational -> Rational
sam Rational
s Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational -> Rational
sam Rational
e = [Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc Rational
s Rational
e]
                | Bool
otherwise = Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc Rational
s (Rational -> Rational
nextSam Rational
s) Arc -> [Arc] -> [Arc]
forall a. a -> [a] -> [a]
: Arc -> [Arc]
arcCycles (Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc (Rational -> Rational
nextSam Rational
s) Rational
e)

-- | Like arcCycles, but returns zero-width arcs
arcCyclesZW :: Arc -> [Arc]
arcCyclesZW :: Arc -> [Arc]
arcCyclesZW (Arc Rational
s Rational
e) | Rational
s Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
e = [Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc Rational
s Rational
e]
                  | Bool
otherwise = Arc -> [Arc]
arcCycles (Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc Rational
s Rational
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 :: (Rational -> Rational) -> Arc -> Arc
mapCycle Rational -> Rational
f (Arc Rational
s Rational
e) = Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc (Rational
sam' Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational -> Rational
f (Rational
s Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
sam')) (Rational
sam' Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational -> Rational
f (Rational
e Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
sam'))
         where sam' :: Rational
sam' = Rational -> Rational
sam Rational
s

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