{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

{-
    Pattern.hs - core representation of Tidal patterns
    Copyright (C) 2020 Alex McLean and contributors

    This library is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this library.  If not, see <http://www.gnu.org/licenses/>.
-}

module Sound.Tidal.Pattern (module Sound.Tidal.Pattern,
                            module Sound.Tidal.Time
                           )
where

import           Prelude hiding ((<*), (*>))

import           Control.Applicative (liftA2)
import           GHC.Generics
import           Control.DeepSeq (NFData)
import           Control.Monad ((>=>))
import qualified Data.Map.Strict as Map
import           Data.Maybe (isJust, fromJust, catMaybes, mapMaybe)
import           Data.List (delete, findIndex, (\\))
import           Data.Word (Word8)
import           Data.Data (Data) -- toConstr
import           Data.Typeable (Typeable)
import           Data.Fixed (mod')

import           Sound.Tidal.Time

------------------------------------------------------------------------
-- * Types

-- | an Arc and some named control values
data State = State {State -> Arc
arc :: Arc,
                    State -> ValueMap
controls :: ValueMap
                   }

-- | A datatype representing events taking place over time
data Pattern a = Pattern {forall a. Pattern a -> State -> [Event a]
query :: State -> [Event a]}
  deriving ((forall x. Pattern a -> Rep (Pattern a) x)
-> (forall x. Rep (Pattern a) x -> Pattern a)
-> Generic (Pattern a)
forall x. Rep (Pattern a) x -> Pattern a
forall x. Pattern a -> Rep (Pattern a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Pattern a) x -> Pattern a
forall a x. Pattern a -> Rep (Pattern a) x
$cfrom :: forall a x. Pattern a -> Rep (Pattern a) x
from :: forall x. Pattern a -> Rep (Pattern a) x
$cto :: forall a x. Rep (Pattern a) x -> Pattern a
to :: forall x. Rep (Pattern a) x -> Pattern a
Generic, (forall a b. (a -> b) -> Pattern a -> Pattern b)
-> (forall a b. a -> Pattern b -> Pattern a) -> Functor Pattern
forall a b. a -> Pattern b -> Pattern a
forall a b. (a -> b) -> Pattern a -> Pattern 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) -> Pattern a -> Pattern b
fmap :: forall a b. (a -> b) -> Pattern a -> Pattern b
$c<$ :: forall a b. a -> Pattern b -> Pattern a
<$ :: forall a b. a -> Pattern b -> Pattern a
Functor)

instance NFData a => NFData (Pattern a)

-- type StateMap = Map.Map String (Pattern Value)
type ControlPattern = Pattern ValueMap

-- * Applicative and friends

instance Applicative Pattern where
  -- | Repeat the given value once per cycle, forever
  pure :: forall a. a -> Pattern a
pure a
v = (State -> [Event a]) -> Pattern a
forall a. (State -> [Event a]) -> Pattern a
Pattern ((State -> [Event a]) -> Pattern a)
-> (State -> [Event a]) -> Pattern a
forall a b. (a -> b) -> a -> b
$ \(State Arc
a ValueMap
_) ->
    (Arc -> Event a) -> [Arc] -> [Event a]
forall a b. (a -> b) -> [a] -> [b]
map (\Arc
a' -> Context -> Maybe Arc -> Arc -> a -> Event a
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event
                ([((Int, Int), (Int, Int))] -> Context
Context [])
                (Arc -> Maybe Arc
forall a. a -> Maybe a
Just Arc
a')
                (Arc -> Arc -> Arc
sect Arc
a Arc
a')
                a
v)
    ([Arc] -> [Event a]) -> [Arc] -> [Event a]
forall a b. (a -> b) -> a -> b
$ Arc -> [Arc]
cycleArcsInArc Arc
a

  -- | In each of @a <*> b@, @a <* b@ and @a *> b@
  -- (using the definitions from this module, not the Prelude),
  -- the time structure of the result
  -- depends on the structures of both @a@ and @b@.
  -- They all result in @Event@s with identical @part@s and @value@s.
  -- However, their @whole@s are different.
  --
  -- For instance, @listToPat [(+1), (+2)] <*> "0 10 100"@
  -- gives the following 4-@Event@ cycle:
  -- > (0>⅓)|1
  -- > (⅓>½)|11
  -- > (½>⅔)|12
  -- > (⅔>1)|102
  -- If we use @<*@ instead, we get this:
  -- > (0>⅓)-½|1
  -- > 0-(⅓>½)|11
  -- > (½>⅔)-1|12
  -- > ½-(⅔>1)|102
  -- And if we use @*>@, we get this:
  -- >   (0>⅓)|1
  -- > (⅓>½)-⅔|11
  -- > ⅓-(½>⅔)|12
  -- >   (⅔>1)|102
  <*> :: forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
(<*>) = Pattern (a -> b) -> Pattern a -> Pattern b
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
applyPatToPatBoth

-- | Like @<*>@, but the "wholes" come from the left
(<*) :: Pattern (a -> b) -> Pattern a -> Pattern b
<* :: forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
(<*) = Pattern (a -> b) -> Pattern a -> Pattern b
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
applyPatToPatLeft

-- | Like @<*>@, but the "wholes" come from the right
(*>) :: Pattern (a -> b) -> Pattern a -> Pattern b
*> :: forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
(*>) = Pattern (a -> b) -> Pattern a -> Pattern b
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
applyPatToPatRight

-- | Like @<*>@, but the "wholes" come from the left
(<<*) :: Pattern (a -> b) -> Pattern a -> Pattern b
<<* :: forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
(<<*) = Pattern (a -> b) -> Pattern a -> Pattern b
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
applyPatToPatSqueeze

infixl 4 <*, *>, <<*
applyPatToPat :: (Maybe Arc -> Maybe Arc -> Maybe (Maybe Arc)) -> Pattern (a -> b) -> Pattern a -> Pattern b
applyPatToPat :: forall a b.
(Maybe Arc -> Maybe Arc -> Maybe (Maybe Arc))
-> Pattern (a -> b) -> Pattern a -> Pattern b
applyPatToPat Maybe Arc -> Maybe Arc -> Maybe (Maybe Arc)
combineWholes Pattern (a -> b)
pf Pattern a
px = (State -> [Event b]) -> Pattern b
forall a. (State -> [Event a]) -> Pattern a
Pattern State -> [Event b]
q
    where q :: State -> [Event b]
q State
st = [Maybe (Event b)] -> [Event b]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Event b)] -> [Event b]) -> [Maybe (Event b)] -> [Event b]
forall a b. (a -> b) -> a -> b
$ (EventF Arc (a -> b) -> [Maybe (Event b)])
-> [EventF Arc (a -> b)] -> [Maybe (Event b)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap EventF Arc (a -> b) -> [Maybe (Event b)]
forall {b}. EventF Arc (a -> b) -> [Maybe (EventF Arc b)]
match ([EventF Arc (a -> b)] -> [Maybe (Event b)])
-> [EventF Arc (a -> b)] -> [Maybe (Event b)]
forall a b. (a -> b) -> a -> b
$ Pattern (a -> b) -> State -> [EventF Arc (a -> b)]
forall a. Pattern a -> State -> [Event a]
query Pattern (a -> b)
pf State
st
            where
              match :: EventF Arc (a -> b) -> [Maybe (EventF Arc b)]
match ef :: EventF Arc (a -> b)
ef@(Event (Context [((Int, Int), (Int, Int))]
c) Maybe Arc
_ Arc
fPart a -> b
f) =
                (EventF Arc a -> Maybe (EventF Arc b))
-> [EventF Arc a] -> [Maybe (EventF Arc b)]
forall a b. (a -> b) -> [a] -> [b]
map
                (\ex :: EventF Arc a
ex@(Event (Context [((Int, Int), (Int, Int))]
c') Maybe Arc
_ Arc
xPart a
x) ->
                  do Maybe Arc
whole' <- Maybe Arc -> Maybe Arc -> Maybe (Maybe Arc)
combineWholes (EventF Arc (a -> b) -> Maybe Arc
forall a b. EventF a b -> Maybe a
whole EventF Arc (a -> b)
ef) (EventF Arc a -> Maybe Arc
forall a b. EventF a b -> Maybe a
whole EventF Arc a
ex)
                     Arc
part' <- Arc -> Arc -> Maybe Arc
subArc Arc
fPart Arc
xPart
                     EventF Arc b -> Maybe (EventF Arc b)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Context -> Maybe Arc -> Arc -> b -> EventF Arc b
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event ([((Int, Int), (Int, Int))] -> Context
Context ([((Int, Int), (Int, Int))] -> Context)
-> [((Int, Int), (Int, Int))] -> Context
forall a b. (a -> b) -> a -> b
$ [((Int, Int), (Int, Int))]
c [((Int, Int), (Int, Int))]
-> [((Int, Int), (Int, Int))] -> [((Int, Int), (Int, Int))]
forall a. [a] -> [a] -> [a]
++ [((Int, Int), (Int, Int))]
c') Maybe Arc
whole' Arc
part' (a -> b
f a
x))
                )
                (Pattern a -> State -> [EventF Arc a]
forall a. Pattern a -> State -> [Event a]
query Pattern a
px (State -> [EventF Arc a]) -> State -> [EventF Arc a]
forall a b. (a -> b) -> a -> b
$ State
st {arc = wholeOrPart ef})

applyPatToPatBoth :: Pattern (a -> b) -> Pattern a -> Pattern b
applyPatToPatBoth :: forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
applyPatToPatBoth Pattern (a -> b)
pf Pattern a
px = (State -> [Event b]) -> Pattern b
forall a. (State -> [Event a]) -> Pattern a
Pattern State -> [Event b]
q
    where q :: State -> [Event b]
q State
st = [Maybe (Event b)] -> [Event b]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Event b)] -> [Event b]) -> [Maybe (Event b)] -> [Event b]
forall a b. (a -> b) -> a -> b
$ ((EventF Arc (a -> b) -> [Maybe (Event b)])
-> [EventF Arc (a -> b)] -> [Maybe (Event b)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap EventF Arc (a -> b) -> [Maybe (Event b)]
forall {b}. EventF Arc (a -> b) -> [Maybe (EventF Arc b)]
match ([EventF Arc (a -> b)] -> [Maybe (Event b)])
-> [EventF Arc (a -> b)] -> [Maybe (Event b)]
forall a b. (a -> b) -> a -> b
$ Pattern (a -> b) -> State -> [EventF Arc (a -> b)]
forall a. Pattern a -> State -> [Event a]
query Pattern (a -> b)
pf State
st) [Maybe (Event b)] -> [Maybe (Event b)] -> [Maybe (Event b)]
forall a. [a] -> [a] -> [a]
++ ((EventF Arc a -> [Maybe (Event b)])
-> [EventF Arc a] -> [Maybe (Event b)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap EventF Arc a -> [Maybe (Event b)]
matchX ([EventF Arc a] -> [Maybe (Event b)])
-> [EventF Arc a] -> [Maybe (Event b)]
forall a b. (a -> b) -> a -> b
$ Pattern a -> State -> [EventF Arc a]
forall a. Pattern a -> State -> [Event a]
query (Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
filterAnalog Pattern a
px) State
st)
            where
              -- match analog events from pf with all events from px
              match :: EventF Arc (a -> b) -> [Maybe (EventF Arc b)]
match ef :: EventF Arc (a -> b)
ef@(Event Context
_ Maybe Arc
Nothing Arc
fPart a -> b
_)   = (EventF Arc a -> Maybe (EventF Arc b))
-> [EventF Arc a] -> [Maybe (EventF Arc b)]
forall a b. (a -> b) -> [a] -> [b]
map (EventF Arc (a -> b) -> EventF Arc a -> Maybe (EventF Arc b)
forall {a} {b}.
EventF Arc (a -> b) -> EventF Arc a -> Maybe (EventF Arc b)
withFX EventF Arc (a -> b)
ef) (Pattern a -> State -> [EventF Arc a]
forall a. Pattern a -> State -> [Event a]
query Pattern a
px (State -> [EventF Arc a]) -> State -> [EventF Arc a]
forall a b. (a -> b) -> a -> b
$ State
st {arc = fPart}) -- analog
              -- match digital events from pf with digital events from px
              match ef :: EventF Arc (a -> b)
ef@(Event Context
_ (Just Arc
fWhole) Arc
_ a -> b
_) = (EventF Arc a -> Maybe (EventF Arc b))
-> [EventF Arc a] -> [Maybe (EventF Arc b)]
forall a b. (a -> b) -> [a] -> [b]
map (EventF Arc (a -> b) -> EventF Arc a -> Maybe (EventF Arc b)
forall {a} {b}.
EventF Arc (a -> b) -> EventF Arc a -> Maybe (EventF Arc b)
withFX EventF Arc (a -> b)
ef) (Pattern a -> State -> [EventF Arc a]
forall a. Pattern a -> State -> [Event a]
query (Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
filterDigital Pattern a
px) (State -> [EventF Arc a]) -> State -> [EventF Arc a]
forall a b. (a -> b) -> a -> b
$ State
st {arc = fWhole}) -- digital
              -- match analog events from px (constrained above) with digital events from px
              matchX :: EventF Arc a -> [Maybe (Event b)]
matchX ex :: EventF Arc a
ex@(Event Context
_ Maybe Arc
Nothing Arc
fPart a
_)  = (EventF Arc (a -> b) -> Maybe (Event b))
-> [EventF Arc (a -> b)] -> [Maybe (Event b)]
forall a b. (a -> b) -> [a] -> [b]
map (EventF Arc (a -> b) -> EventF Arc a -> Maybe (Event b)
forall {a} {b}.
EventF Arc (a -> b) -> EventF Arc a -> Maybe (EventF Arc b)
`withFX` EventF Arc a
ex) (Pattern (a -> b) -> State -> [EventF Arc (a -> b)]
forall a. Pattern a -> State -> [Event a]
query (Pattern (a -> b) -> Pattern (a -> b)
forall a. Pattern a -> Pattern a
filterDigital Pattern (a -> b)
pf) (State -> [EventF Arc (a -> b)]) -> State -> [EventF Arc (a -> b)]
forall a b. (a -> b) -> a -> b
$ State
st {arc = fPart}) -- digital
              matchX EventF Arc a
_ = [Char] -> [Maybe (Event b)]
forall a. HasCallStack => [Char] -> a
error [Char]
"can't happen"
              withFX :: EventF Arc (a -> b) -> EventF Arc a -> Maybe (EventF Arc b)
withFX EventF Arc (a -> b)
ef EventF Arc a
ex = do Maybe Arc
whole' <- Maybe Arc -> Maybe Arc -> Maybe (Maybe Arc)
subMaybeArc (EventF Arc (a -> b) -> Maybe Arc
forall a b. EventF a b -> Maybe a
whole EventF Arc (a -> b)
ef) (EventF Arc a -> Maybe Arc
forall a b. EventF a b -> Maybe a
whole EventF Arc a
ex)
                                Arc
part' <- Arc -> Arc -> Maybe Arc
subArc (EventF Arc (a -> b) -> Arc
forall a b. EventF a b -> a
part EventF Arc (a -> b)
ef) (EventF Arc a -> Arc
forall a b. EventF a b -> a
part EventF Arc a
ex)
                                EventF Arc b -> Maybe (EventF Arc b)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Context -> Maybe Arc -> Arc -> b -> EventF Arc b
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event ([Context] -> Context
combineContexts [EventF Arc (a -> b) -> Context
forall a b. EventF a b -> Context
context EventF Arc (a -> b)
ef, EventF Arc a -> Context
forall a b. EventF a b -> Context
context EventF Arc a
ex]) Maybe Arc
whole' Arc
part' (EventF Arc (a -> b) -> a -> b
forall a b. EventF a b -> b
value EventF Arc (a -> b)
ef (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ EventF Arc a -> a
forall a b. EventF a b -> b
value EventF Arc a
ex))

applyPatToPatLeft :: Pattern (a -> b) -> Pattern a -> Pattern b
applyPatToPatLeft :: forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
applyPatToPatLeft Pattern (a -> b)
pf Pattern a
px = (State -> [Event b]) -> Pattern b
forall a. (State -> [Event a]) -> Pattern a
Pattern State -> [Event b]
q
    where q :: State -> [Event b]
q State
st = [Maybe (Event b)] -> [Event b]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Event b)] -> [Event b]) -> [Maybe (Event b)] -> [Event b]
forall a b. (a -> b) -> a -> b
$ (EventF Arc (a -> b) -> [Maybe (Event b)])
-> [EventF Arc (a -> b)] -> [Maybe (Event b)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap EventF Arc (a -> b) -> [Maybe (Event b)]
forall {b}. EventF Arc (a -> b) -> [Maybe (EventF Arc b)]
match ([EventF Arc (a -> b)] -> [Maybe (Event b)])
-> [EventF Arc (a -> b)] -> [Maybe (Event b)]
forall a b. (a -> b) -> a -> b
$ Pattern (a -> b) -> State -> [EventF Arc (a -> b)]
forall a. Pattern a -> State -> [Event a]
query Pattern (a -> b)
pf State
st
            where
              match :: EventF Arc (a -> b) -> [Maybe (EventF Arc b)]
match EventF Arc (a -> b)
ef = (EventF Arc a -> Maybe (EventF Arc b))
-> [EventF Arc a] -> [Maybe (EventF Arc b)]
forall a b. (a -> b) -> [a] -> [b]
map (EventF Arc (a -> b) -> EventF Arc a -> Maybe (EventF Arc b)
forall {a} {b}.
EventF Arc (a -> b) -> EventF Arc a -> Maybe (EventF Arc b)
withFX EventF Arc (a -> b)
ef) (Pattern a -> State -> [EventF Arc a]
forall a. Pattern a -> State -> [Event a]
query Pattern a
px (State -> [EventF Arc a]) -> State -> [EventF Arc a]
forall a b. (a -> b) -> a -> b
$ State
st {arc = wholeOrPart ef})
              withFX :: EventF Arc (a -> b) -> EventF Arc a -> Maybe (EventF Arc b)
withFX EventF Arc (a -> b)
ef EventF Arc a
ex = do let whole' :: Maybe Arc
whole' = EventF Arc (a -> b) -> Maybe Arc
forall a b. EventF a b -> Maybe a
whole EventF Arc (a -> b)
ef
                                Arc
part' <- Arc -> Arc -> Maybe Arc
subArc (EventF Arc (a -> b) -> Arc
forall a b. EventF a b -> a
part EventF Arc (a -> b)
ef) (EventF Arc a -> Arc
forall a b. EventF a b -> a
part EventF Arc a
ex)
                                EventF Arc b -> Maybe (EventF Arc b)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Context -> Maybe Arc -> Arc -> b -> EventF Arc b
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event ([Context] -> Context
combineContexts [EventF Arc (a -> b) -> Context
forall a b. EventF a b -> Context
context EventF Arc (a -> b)
ef, EventF Arc a -> Context
forall a b. EventF a b -> Context
context EventF Arc a
ex]) Maybe Arc
whole' Arc
part' (EventF Arc (a -> b) -> a -> b
forall a b. EventF a b -> b
value EventF Arc (a -> b)
ef (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ EventF Arc a -> a
forall a b. EventF a b -> b
value EventF Arc a
ex))

applyPatToPatRight :: Pattern (a -> b) -> Pattern a -> Pattern b
applyPatToPatRight :: forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
applyPatToPatRight Pattern (a -> b)
pf Pattern a
px = (State -> [Event b]) -> Pattern b
forall a. (State -> [Event a]) -> Pattern a
Pattern State -> [Event b]
q
    where q :: State -> [Event b]
q State
st = [Maybe (Event b)] -> [Event b]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Event b)] -> [Event b]) -> [Maybe (Event b)] -> [Event b]
forall a b. (a -> b) -> a -> b
$ (EventF Arc a -> [Maybe (Event b)])
-> [EventF Arc a] -> [Maybe (Event b)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap EventF Arc a -> [Maybe (Event b)]
match ([EventF Arc a] -> [Maybe (Event b)])
-> [EventF Arc a] -> [Maybe (Event b)]
forall a b. (a -> b) -> a -> b
$ Pattern a -> State -> [EventF Arc a]
forall a. Pattern a -> State -> [Event a]
query Pattern a
px State
st
            where
              match :: EventF Arc a -> [Maybe (Event b)]
match EventF Arc a
ex = (EventF Arc (a -> b) -> Maybe (Event b))
-> [EventF Arc (a -> b)] -> [Maybe (Event b)]
forall a b. (a -> b) -> [a] -> [b]
map (EventF Arc (a -> b) -> EventF Arc a -> Maybe (Event b)
forall {a} {b}.
EventF Arc (a -> b) -> EventF Arc a -> Maybe (EventF Arc b)
`withFX` EventF Arc a
ex) (Pattern (a -> b) -> State -> [EventF Arc (a -> b)]
forall a. Pattern a -> State -> [Event a]
query Pattern (a -> b)
pf (State -> [EventF Arc (a -> b)]) -> State -> [EventF Arc (a -> b)]
forall a b. (a -> b) -> a -> b
$ State
st {arc = wholeOrPart ex})
              withFX :: EventF Arc (a -> b) -> EventF Arc a -> Maybe (EventF Arc b)
withFX EventF Arc (a -> b)
ef EventF Arc a
ex = do let whole' :: Maybe Arc
whole' = EventF Arc a -> Maybe Arc
forall a b. EventF a b -> Maybe a
whole EventF Arc a
ex
                                Arc
part' <- Arc -> Arc -> Maybe Arc
subArc (EventF Arc (a -> b) -> Arc
forall a b. EventF a b -> a
part EventF Arc (a -> b)
ef) (EventF Arc a -> Arc
forall a b. EventF a b -> a
part EventF Arc a
ex)
                                EventF Arc b -> Maybe (EventF Arc b)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Context -> Maybe Arc -> Arc -> b -> EventF Arc b
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event ([Context] -> Context
combineContexts [EventF Arc (a -> b) -> Context
forall a b. EventF a b -> Context
context EventF Arc (a -> b)
ef, EventF Arc a -> Context
forall a b. EventF a b -> Context
context EventF Arc a
ex]) Maybe Arc
whole' Arc
part' (EventF Arc (a -> b) -> a -> b
forall a b. EventF a b -> b
value EventF Arc (a -> b)
ef (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ EventF Arc a -> a
forall a b. EventF a b -> b
value EventF Arc a
ex))

applyPatToPatSqueeze :: Pattern (a -> b) -> Pattern a -> Pattern b
applyPatToPatSqueeze :: forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
applyPatToPatSqueeze Pattern (a -> b)
pf Pattern a
px = Pattern (Pattern b) -> Pattern b
forall a. Pattern (Pattern a) -> Pattern a
squeezeJoin (Pattern (Pattern b) -> Pattern b)
-> Pattern (Pattern b) -> Pattern b
forall a b. (a -> b) -> a -> b
$ (\a -> b
f -> a -> b
f (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
px) ((a -> b) -> Pattern b) -> Pattern (a -> b) -> Pattern (Pattern b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern (a -> b)
pf

-- * Monad and friends
--
-- $monadAndFriends
--
-- Note there are four ways of joining - the default 'unwrap' used by @>>=@, as well
-- as @innerJoin@, @innerJoin@ and @squeezeJoin@.

instance Monad Pattern where
  return :: forall a. a -> Pattern a
return = a -> Pattern a
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Pattern a
p >>= :: forall a b. Pattern a -> (a -> Pattern b) -> Pattern b
>>= a -> Pattern b
f = Pattern (Pattern b) -> Pattern b
forall a. Pattern (Pattern a) -> Pattern a
unwrap (a -> Pattern b
f (a -> Pattern b) -> Pattern a -> Pattern (Pattern b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
p)

-- | Turns a pattern of patterns into a single pattern.
-- (this is actually 'join')
--
-- 1/ For query 'arc', get the events from the outer pattern @pp@
-- 2/ Query the inner pattern using the 'part' of the outer
-- 3/ For each inner event, set the whole and part to be the intersection
--    of the outer whole and part, respectively
-- 4/ Concatenate all the events together (discarding wholes/parts that didn't intersect)
--
-- TODO - what if a continuous pattern contains a discrete one, or vice-versa?
unwrap :: Pattern (Pattern a) -> Pattern a
unwrap :: forall a. Pattern (Pattern a) -> Pattern a
unwrap Pattern (Pattern a)
pp = Pattern (Pattern a)
pp {query = q}
  where q :: State -> [EventF Arc a]
q State
st = (EventF Arc (Pattern a) -> [EventF Arc a])
-> [EventF Arc (Pattern a)] -> [EventF Arc a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
          (\(Event Context
c Maybe Arc
w Arc
p Pattern a
v) ->
             (EventF Arc a -> Maybe (EventF Arc a))
-> [EventF Arc a] -> [EventF Arc a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Context -> Maybe Arc -> Arc -> EventF Arc a -> Maybe (EventF Arc a)
forall {b}.
Context -> Maybe Arc -> Arc -> EventF Arc b -> Maybe (EventF Arc b)
munge Context
c Maybe Arc
w Arc
p) ([EventF Arc a] -> [EventF Arc a])
-> [EventF Arc a] -> [EventF Arc a]
forall a b. (a -> b) -> a -> b
$ Pattern a -> State -> [EventF Arc a]
forall a. Pattern a -> State -> [Event a]
query Pattern a
v State
st {arc = p})
          (Pattern (Pattern a) -> State -> [EventF Arc (Pattern a)]
forall a. Pattern a -> State -> [Event a]
query Pattern (Pattern a)
pp State
st)
        munge :: Context -> Maybe Arc -> Arc -> EventF Arc b -> Maybe (EventF Arc b)
munge Context
oc Maybe Arc
ow Arc
op (Event Context
ic Maybe Arc
iw Arc
ip b
v') =
          do
            Maybe Arc
w' <- Maybe Arc -> Maybe Arc -> Maybe (Maybe Arc)
subMaybeArc Maybe Arc
ow Maybe Arc
iw
            Arc
p' <- Arc -> Arc -> Maybe Arc
subArc Arc
op Arc
ip
            EventF Arc b -> Maybe (EventF Arc b)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Context -> Maybe Arc -> Arc -> b -> EventF Arc b
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event ([Context] -> Context
combineContexts [Context
ic, Context
oc]) Maybe Arc
w' Arc
p' b
v')

-- | Turns a pattern of patterns into a single pattern. Like @unwrap@,
-- but structure only comes from the inner pattern.
innerJoin :: Pattern (Pattern a) -> Pattern a
innerJoin :: forall a. Pattern (Pattern a) -> Pattern a
innerJoin Pattern (Pattern a)
pp = Pattern (Pattern a)
pp {query = q}
  where q :: State -> [EventF Arc a]
q State
st = (EventF Arc (Pattern a) -> [EventF Arc a])
-> [EventF Arc (Pattern a)] -> [EventF Arc a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
               (\(Event Context
oc Maybe Arc
_ Arc
op Pattern a
v) -> (EventF Arc a -> Maybe (EventF Arc a))
-> [EventF Arc a] -> [EventF Arc a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Context -> EventF Arc a -> Maybe (EventF Arc a)
forall {b}. Context -> EventF Arc b -> Maybe (EventF Arc b)
munge Context
oc) ([EventF Arc a] -> [EventF Arc a])
-> [EventF Arc a] -> [EventF Arc a]
forall a b. (a -> b) -> a -> b
$ Pattern a -> State -> [EventF Arc a]
forall a. Pattern a -> State -> [Event a]
query Pattern a
v State
st {arc = op}
          )
          (Pattern (Pattern a) -> State -> [EventF Arc (Pattern a)]
forall a. Pattern a -> State -> [Event a]
query Pattern (Pattern a)
pp State
st)
          where munge :: Context -> EventF Arc b -> Maybe (EventF Arc b)
munge Context
oc (Event Context
ic Maybe Arc
iw Arc
ip b
v) =
                  do
                    Arc
p <- Arc -> Arc -> Maybe Arc
subArc (State -> Arc
arc State
st) Arc
ip
                    Arc
p' <- Arc -> Arc -> Maybe Arc
subArc Arc
p (State -> Arc
arc State
st)
                    EventF Arc b -> Maybe (EventF Arc b)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Context -> Maybe Arc -> Arc -> b -> EventF Arc b
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event ([Context] -> Context
combineContexts [Context
ic, Context
oc]) Maybe Arc
iw Arc
p' b
v)

-- | Turns a pattern of patterns into a single pattern. Like @unwrap@,
-- but structure only comes from the outer pattern.
outerJoin :: Pattern (Pattern a) -> Pattern a
outerJoin :: forall a. Pattern (Pattern a) -> Pattern a
outerJoin Pattern (Pattern a)
pp = Pattern (Pattern a)
pp {query = q}
  where q :: State -> [EventF Arc a]
q State
st = (EventF Arc (Pattern a) -> [EventF Arc a])
-> [EventF Arc (Pattern a)] -> [EventF Arc a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
          (\EventF Arc (Pattern a)
e ->
             (EventF Arc a -> Maybe (EventF Arc a))
-> [EventF Arc a] -> [EventF Arc a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Context -> Maybe Arc -> Arc -> EventF Arc a -> Maybe (EventF Arc a)
forall {a} {b}.
Context -> Maybe Arc -> Arc -> EventF a b -> Maybe (EventF Arc b)
munge (EventF Arc (Pattern a) -> Context
forall a b. EventF a b -> Context
context EventF Arc (Pattern a)
e) (EventF Arc (Pattern a) -> Maybe Arc
forall a b. EventF a b -> Maybe a
whole EventF Arc (Pattern a)
e) (EventF Arc (Pattern a) -> Arc
forall a b. EventF a b -> a
part EventF Arc (Pattern a)
e)) ([EventF Arc a] -> [EventF Arc a])
-> [EventF Arc a] -> [EventF Arc a]
forall a b. (a -> b) -> a -> b
$ Pattern a -> State -> [EventF Arc a]
forall a. Pattern a -> State -> [Event a]
query (EventF Arc (Pattern a) -> Pattern a
forall a b. EventF a b -> b
value EventF Arc (Pattern a)
e) State
st {arc = pure (start $ wholeOrPart e)}
          )
          (Pattern (Pattern a) -> State -> [EventF Arc (Pattern a)]
forall a. Pattern a -> State -> [Event a]
query Pattern (Pattern a)
pp State
st)
          where munge :: Context -> Maybe Arc -> Arc -> EventF a b -> Maybe (EventF Arc b)
munge Context
oc Maybe Arc
ow Arc
op (Event Context
ic Maybe a
_ a
_ b
v') =
                  do
                    Arc
p' <- Arc -> Arc -> Maybe Arc
subArc (State -> Arc
arc State
st) Arc
op
                    EventF Arc b -> Maybe (EventF Arc b)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Context -> Maybe Arc -> Arc -> b -> EventF Arc b
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event ([Context] -> Context
combineContexts [Context
oc, Context
ic]) Maybe Arc
ow Arc
p' b
v')

-- | Like @unwrap@, but cycles of the inner patterns are compressed to fit the
-- timespan of the outer whole (or the original query if it's a continuous pattern?)
-- TODO - what if a continuous pattern contains a discrete one, or vice-versa?
squeezeJoin :: Pattern (Pattern a) -> Pattern a
squeezeJoin :: forall a. Pattern (Pattern a) -> Pattern a
squeezeJoin Pattern (Pattern a)
pp = Pattern (Pattern a)
pp {query = q}
  where q :: State -> [EventF Arc a]
q State
st = (EventF Arc (Pattern a) -> [EventF Arc a])
-> [EventF Arc (Pattern a)] -> [EventF Arc a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
          (\e :: EventF Arc (Pattern a)
e@(Event Context
c Maybe Arc
w Arc
p Pattern a
v) ->
             (EventF Arc a -> Maybe (EventF Arc a))
-> [EventF Arc a] -> [EventF Arc a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Context -> Maybe Arc -> Arc -> EventF Arc a -> Maybe (EventF Arc a)
forall {b}.
Context -> Maybe Arc -> Arc -> EventF Arc b -> Maybe (EventF Arc b)
munge Context
c Maybe Arc
w Arc
p) ([EventF Arc a] -> [EventF Arc a])
-> [EventF Arc a] -> [EventF Arc a]
forall a b. (a -> b) -> a -> b
$ Pattern a -> State -> [EventF Arc a]
forall a. Pattern a -> State -> [Event a]
query (Arc -> Pattern a -> Pattern a
forall a. Arc -> Pattern a -> Pattern a
focusArc (EventF Arc (Pattern a) -> Arc
forall a. Event a -> Arc
wholeOrPart EventF Arc (Pattern a)
e) Pattern a
v) State
st {arc = p}
          )
          (Pattern (Pattern a) -> State -> [EventF Arc (Pattern a)]
forall a. Pattern a -> State -> [Event a]
query Pattern (Pattern a)
pp State
st)
        munge :: Context -> Maybe Arc -> Arc -> EventF Arc b -> Maybe (EventF Arc b)
munge Context
oContext Maybe Arc
oWhole Arc
oPart (Event Context
iContext Maybe Arc
iWhole Arc
iPart b
v) =
          do Maybe Arc
w' <- Maybe Arc -> Maybe Arc -> Maybe (Maybe Arc)
subMaybeArc Maybe Arc
oWhole Maybe Arc
iWhole
             Arc
p' <- Arc -> Arc -> Maybe Arc
subArc Arc
oPart Arc
iPart
             EventF Arc b -> Maybe (EventF Arc b)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Context -> Maybe Arc -> Arc -> b -> EventF Arc b
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event ([Context] -> Context
combineContexts [Context
iContext, Context
oContext]) Maybe Arc
w' Arc
p' b
v)


_trigJoin :: Bool -> Pattern (Pattern a) -> Pattern a
_trigJoin :: forall a. Bool -> Pattern (Pattern a) -> Pattern a
_trigJoin Bool
cycleZero Pattern (Pattern a)
pat_of_pats = (State -> [Event a]) -> Pattern a
forall a. (State -> [Event a]) -> Pattern a
Pattern State -> [Event a]
q
  where q :: State -> [Event a]
q State
st =
          [Maybe (Event a)] -> [Event a]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Event a)] -> [Event a]) -> [Maybe (Event a)] -> [Event a]
forall a b. (a -> b) -> a -> b
$
          (EventF Arc (Pattern a) -> [Maybe (Event a)])
-> [EventF Arc (Pattern a)] -> [Maybe (Event a)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
          (\oe :: EventF Arc (Pattern a)
oe@(Event Context
oc (Just Arc
jow) Arc
op Pattern a
ov) ->
             (Event a -> Maybe (Event a)) -> [Event a] -> [Maybe (Event a)]
forall a b. (a -> b) -> [a] -> [b]
map (\oe :: Event a
oe@(Event Context
ic (Maybe Arc
iw) Arc
ip a
iv) ->
                    do Maybe Arc
w <- Maybe Arc -> Maybe Arc -> Maybe (Maybe Arc)
subMaybeArc (Arc -> Maybe Arc
forall a. a -> Maybe a
Just Arc
jow) Maybe Arc
iw
                       Arc
p <- Arc -> Arc -> Maybe Arc
subArc Arc
op Arc
ip
                       Event a -> Maybe (Event a)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Event a -> Maybe (Event a)) -> Event a -> Maybe (Event a)
forall a b. (a -> b) -> a -> b
$ Context -> Maybe Arc -> Arc -> a -> Event a
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event ([Context] -> Context
combineContexts [Context
ic, Context
oc]) Maybe Arc
w Arc
p a
iv
                 )
               ([Event a] -> [Maybe (Event a)]) -> [Event a] -> [Maybe (Event a)]
forall a b. (a -> b) -> a -> b
$ Pattern a -> State -> [Event a]
forall a. Pattern a -> State -> [Event a]
query (((if Bool
cycleZero then Rational -> Rational
forall a. a -> a
id else Rational -> Rational
cyclePos) (Rational -> Rational) -> Rational -> Rational
forall a b. (a -> b) -> a -> b
$ Arc -> Rational
forall a. ArcF a -> a
start Arc
jow) Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
`rotR` Pattern a
ov) State
st
          )
          (Pattern (Pattern a) -> State -> [EventF Arc (Pattern a)]
forall a. Pattern a -> State -> [Event a]
query (Pattern (Pattern a) -> Pattern (Pattern a)
forall a. Pattern a -> Pattern a
filterDigital Pattern (Pattern a)
pat_of_pats) State
st)

trigJoin :: Pattern (Pattern a) -> Pattern a
trigJoin :: forall a. Pattern (Pattern a) -> Pattern a
trigJoin = Bool -> Pattern (Pattern a) -> Pattern a
forall a. Bool -> Pattern (Pattern a) -> Pattern a
_trigJoin Bool
False

trigZeroJoin :: Pattern (Pattern a) -> Pattern a
trigZeroJoin :: forall a. Pattern (Pattern a) -> Pattern a
trigZeroJoin = Bool -> Pattern (Pattern a) -> Pattern a
forall a. Bool -> Pattern (Pattern a) -> Pattern a
_trigJoin Bool
True

reset :: Pattern Bool -> Pattern a -> Pattern a
reset :: forall a. Pattern Bool -> Pattern a -> Pattern a
reset Pattern Bool
bp Pattern a
pat = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
trigJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (\Bool
v -> if Bool
v then Pattern a
pat else Pattern a
forall a. Pattern a
silence) (Bool -> Pattern a) -> Pattern Bool -> Pattern (Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Bool
bp

resetTo :: Pattern Rational -> Pattern a -> Pattern a
resetTo :: forall a. Pattern Rational -> Pattern a -> Pattern a
resetTo Pattern Rational
bp Pattern a
pat = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
trigJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (\Rational
v -> Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
rotL Rational
v Pattern a
pat) (Rational -> Pattern a) -> Pattern Rational -> Pattern (Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Rational
bp

restart :: Pattern Bool -> Pattern a -> Pattern a
restart :: forall a. Pattern Bool -> Pattern a -> Pattern a
restart Pattern Bool
bp Pattern a
pat = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
trigZeroJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (\Bool
v -> if Bool
v then Pattern a
pat else Pattern a
forall a. Pattern a
silence) (Bool -> Pattern a) -> Pattern Bool -> Pattern (Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Bool
bp

restartTo :: Pattern Rational -> Pattern a -> Pattern a
restartTo :: forall a. Pattern Rational -> Pattern a -> Pattern a
restartTo Pattern Rational
bp Pattern a
pat = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
trigZeroJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (\Rational
v -> Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
rotL Rational
v Pattern a
pat) (Rational -> Pattern a) -> Pattern Rational -> Pattern (Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern Rational
bp

-- | * Patterns as numbers

noOv :: String -> a
noOv :: forall a. [Char] -> a
noOv [Char]
meth = [Char] -> a
forall a. HasCallStack => [Char] -> a
error ([Char] -> a) -> [Char] -> a
forall a b. (a -> b) -> a -> b
$ [Char]
meth [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": not supported for patterns"

instance Eq (Pattern a) where
  == :: Pattern a -> Pattern a -> Bool
(==) = [Char] -> Pattern a -> Pattern a -> Bool
forall a. [Char] -> a
noOv [Char]
"(==)"

instance Ord a => Ord (Pattern a) where
  min :: Pattern a -> Pattern a -> Pattern a
min = (a -> a -> a) -> Pattern a -> Pattern a -> Pattern a
forall a b c. (a -> b -> c) -> Pattern a -> Pattern b -> Pattern c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Ord a => a -> a -> a
min
  max :: Pattern a -> Pattern a -> Pattern a
max = (a -> a -> a) -> Pattern a -> Pattern a -> Pattern a
forall a b c. (a -> b -> c) -> Pattern a -> Pattern b -> Pattern c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Ord a => a -> a -> a
max
  compare :: Pattern a -> Pattern a -> Ordering
compare = [Char] -> Pattern a -> Pattern a -> Ordering
forall a. [Char] -> a
noOv [Char]
"compare"
  <= :: Pattern a -> Pattern a -> Bool
(<=) = [Char] -> Pattern a -> Pattern a -> Bool
forall a. [Char] -> a
noOv [Char]
"(<=)"

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

instance Enum a => Enum (Pattern a) where
  succ :: Pattern a -> Pattern a
succ           = (a -> a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Enum a => a -> a
succ
  pred :: Pattern a -> Pattern a
pred           = (a -> a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Enum a => a -> a
pred
  toEnum :: Int -> Pattern a
toEnum         = a -> Pattern a
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Pattern a) -> (Int -> a) -> Int -> Pattern a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a
forall a. Enum a => Int -> a
toEnum
  fromEnum :: Pattern a -> Int
fromEnum       = [Char] -> Pattern a -> Int
forall a. [Char] -> a
noOv [Char]
"fromEnum"
  enumFrom :: Pattern a -> [Pattern a]
enumFrom       = [Char] -> Pattern a -> [Pattern a]
forall a. [Char] -> a
noOv [Char]
"enumFrom"
  enumFromThen :: Pattern a -> Pattern a -> [Pattern a]
enumFromThen   = [Char] -> Pattern a -> Pattern a -> [Pattern a]
forall a. [Char] -> a
noOv [Char]
"enumFromThen"
  enumFromTo :: Pattern a -> Pattern a -> [Pattern a]
enumFromTo     = [Char] -> Pattern a -> Pattern a -> [Pattern a]
forall a. [Char] -> a
noOv [Char]
"enumFromTo"
  enumFromThenTo :: Pattern a -> Pattern a -> Pattern a -> [Pattern a]
enumFromThenTo = [Char] -> Pattern a -> Pattern a -> Pattern a -> [Pattern a]
forall a. [Char] -> a
noOv [Char]
"enumFromThenTo"

instance Monoid (Pattern a) where
  mempty :: Pattern a
mempty = Pattern a
forall a. Pattern a
empty

instance Semigroup (Pattern a) where
  <> :: Pattern a -> Pattern a -> Pattern a
(<>) !Pattern a
p !Pattern a
p' = (State -> [Event a]) -> Pattern a
forall a. (State -> [Event a]) -> Pattern a
Pattern ((State -> [Event a]) -> Pattern a)
-> (State -> [Event a]) -> Pattern a
forall a b. (a -> b) -> a -> b
$ \State
st -> Pattern a -> State -> [Event a]
forall a. Pattern a -> State -> [Event a]
query Pattern a
p State
st [Event a] -> [Event a] -> [Event a]
forall a. [a] -> [a] -> [a]
++ Pattern a -> State -> [Event a]
forall a. Pattern a -> State -> [Event a]
query Pattern a
p' State
st

instance (Num a, Ord a) => Real (Pattern a) where
  toRational :: Pattern a -> Rational
toRational = [Char] -> Pattern a -> Rational
forall a. [Char] -> a
noOv [Char]
"toRational"

instance (Integral a) => Integral (Pattern a) where
  quot :: Pattern a -> Pattern a -> Pattern a
quot          = (a -> a -> a) -> Pattern a -> Pattern a -> Pattern a
forall a b c. (a -> b -> c) -> Pattern a -> Pattern b -> Pattern c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Integral a => a -> a -> a
quot
  rem :: Pattern a -> Pattern a -> Pattern a
rem           = (a -> a -> a) -> Pattern a -> Pattern a -> Pattern a
forall a b c. (a -> b -> c) -> Pattern a -> Pattern b -> Pattern c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Integral a => a -> a -> a
rem
  div :: Pattern a -> Pattern a -> Pattern a
div           = (a -> a -> a) -> Pattern a -> Pattern a -> Pattern a
forall a b c. (a -> b -> c) -> Pattern a -> Pattern b -> Pattern c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Integral a => a -> a -> a
div
  mod :: Pattern a -> Pattern a -> Pattern a
mod           = (a -> a -> a) -> Pattern a -> Pattern a -> Pattern a
forall a b c. (a -> b -> c) -> Pattern a -> Pattern b -> Pattern c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Integral a => a -> a -> a
mod
  toInteger :: Pattern a -> Integer
toInteger     = [Char] -> Pattern a -> Integer
forall a. [Char] -> a
noOv [Char]
"toInteger"
  Pattern a
x quotRem :: Pattern a -> Pattern a -> (Pattern a, Pattern a)
`quotRem` Pattern a
y = (Pattern a
x Pattern a -> Pattern a -> Pattern a
forall a. Integral a => a -> a -> a
`quot` Pattern a
y, Pattern a
x Pattern a -> Pattern a -> Pattern a
forall a. Integral a => a -> a -> a
`rem` Pattern a
y)
  Pattern a
x divMod :: Pattern a -> Pattern a -> (Pattern a, Pattern a)
`divMod`  Pattern a
y = (Pattern a
x Pattern a -> Pattern a -> Pattern a
forall a. Integral a => a -> a -> a
`div`  Pattern a
y, Pattern a
x Pattern a -> Pattern a -> Pattern a
forall a. Integral a => a -> a -> a
`mod` Pattern a
y)

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

instance (Floating a) => Floating (Pattern a) where
  pi :: Pattern a
pi    = a -> Pattern a
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Floating a => a
pi
  sqrt :: Pattern a -> Pattern a
sqrt  = (a -> a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
sqrt
  exp :: Pattern a -> Pattern a
exp   = (a -> a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
exp
  log :: Pattern a -> Pattern a
log   = (a -> a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
log
  sin :: Pattern a -> Pattern a
sin   = (a -> a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
sin
  cos :: Pattern a -> Pattern a
cos   = (a -> a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
cos
  asin :: Pattern a -> Pattern a
asin  = (a -> a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
asin
  atan :: Pattern a -> Pattern a
atan  = (a -> a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
atan
  acos :: Pattern a -> Pattern a
acos  = (a -> a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
acos
  sinh :: Pattern a -> Pattern a
sinh  = (a -> a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
sinh
  cosh :: Pattern a -> Pattern a
cosh  = (a -> a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
cosh
  asinh :: Pattern a -> Pattern a
asinh = (a -> a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
asinh
  atanh :: Pattern a -> Pattern a
atanh = (a -> a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
atanh
  acosh :: Pattern a -> Pattern a
acosh = (a -> a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
acosh

instance (RealFrac a) => RealFrac (Pattern a) where
  properFraction :: forall b. Integral b => Pattern a -> (b, Pattern a)
properFraction = [Char] -> Pattern a -> (b, Pattern a)
forall a. [Char] -> a
noOv [Char]
"properFraction"
  truncate :: forall b. Integral b => Pattern a -> b
truncate       = [Char] -> Pattern a -> b
forall a. [Char] -> a
noOv [Char]
"truncate"
  round :: forall b. Integral b => Pattern a -> b
round          = [Char] -> Pattern a -> b
forall a. [Char] -> a
noOv [Char]
"round"
  ceiling :: forall b. Integral b => Pattern a -> b
ceiling        = [Char] -> Pattern a -> b
forall a. [Char] -> a
noOv [Char]
"ceiling"
  floor :: forall b. Integral b => Pattern a -> b
floor          = [Char] -> Pattern a -> b
forall a. [Char] -> a
noOv [Char]
"floor"

instance (RealFloat a) => RealFloat (Pattern a) where
  floatRadix :: Pattern a -> Integer
floatRadix     = [Char] -> Pattern a -> Integer
forall a. [Char] -> a
noOv [Char]
"floatRadix"
  floatDigits :: Pattern a -> Int
floatDigits    = [Char] -> Pattern a -> Int
forall a. [Char] -> a
noOv [Char]
"floatDigits"
  floatRange :: Pattern a -> (Int, Int)
floatRange     = [Char] -> Pattern a -> (Int, Int)
forall a. [Char] -> a
noOv [Char]
"floatRange"
  decodeFloat :: Pattern a -> (Integer, Int)
decodeFloat    = [Char] -> Pattern a -> (Integer, Int)
forall a. [Char] -> a
noOv [Char]
"decodeFloat"
  encodeFloat :: Integer -> Int -> Pattern a
encodeFloat    = (((Int -> a) -> Int -> Pattern a)
-> (Integer -> Int -> a) -> Integer -> Int -> Pattern a
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)(((Int -> a) -> Int -> Pattern a)
 -> (Integer -> Int -> a) -> Integer -> Int -> Pattern a)
-> ((a -> Pattern a) -> (Int -> a) -> Int -> Pattern a)
-> (a -> Pattern a)
-> (Integer -> Int -> a)
-> Integer
-> Int
-> Pattern a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a -> Pattern a) -> (Int -> a) -> Int -> Pattern a
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)) a -> Pattern a
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat
  exponent :: Pattern a -> Int
exponent       = [Char] -> Pattern a -> Int
forall a. [Char] -> a
noOv [Char]
"exponent"
  significand :: Pattern a -> Pattern a
significand    = [Char] -> Pattern a -> Pattern a
forall a. [Char] -> a
noOv [Char]
"significand"
  scaleFloat :: Int -> Pattern a -> Pattern a
scaleFloat Int
n   = (a -> a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> a -> a
forall a. RealFloat a => Int -> a -> a
scaleFloat Int
n)
  isNaN :: Pattern a -> Bool
isNaN          = [Char] -> Pattern a -> Bool
forall a. [Char] -> a
noOv [Char]
"isNaN"
  isInfinite :: Pattern a -> Bool
isInfinite     = [Char] -> Pattern a -> Bool
forall a. [Char] -> a
noOv [Char]
"isInfinite"
  isDenormalized :: Pattern a -> Bool
isDenormalized = [Char] -> Pattern a -> Bool
forall a. [Char] -> a
noOv [Char]
"isDenormalized"
  isNegativeZero :: Pattern a -> Bool
isNegativeZero = [Char] -> Pattern a -> Bool
forall a. [Char] -> a
noOv [Char]
"isNegativeZero"
  isIEEE :: Pattern a -> Bool
isIEEE         = [Char] -> Pattern a -> Bool
forall a. [Char] -> a
noOv [Char]
"isIEEE"
  atan2 :: Pattern a -> Pattern a -> Pattern a
atan2          = (a -> a -> a) -> Pattern a -> Pattern a -> Pattern a
forall a b c. (a -> b -> c) -> Pattern a -> Pattern b -> Pattern c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. RealFloat a => a -> a -> a
atan2

instance Num ValueMap where
  negate :: ValueMap -> ValueMap
negate      = ((Double -> Double)
-> (Int -> Int) -> ([Char] -> [Char]) -> Value -> Value
applyFIS Double -> Double
forall a. Num a => a -> a
negate Int -> Int
forall a. Num a => a -> a
negate [Char] -> [Char]
forall a. a -> a
id (Value -> Value) -> ValueMap -> ValueMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
  + :: ValueMap -> ValueMap -> ValueMap
(+)         = (Value -> Value -> Value) -> ValueMap -> ValueMap -> ValueMap
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith ((Int -> Int -> Int)
-> (Double -> Double -> Double) -> Value -> Value -> Value
fNum2 Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Double -> Double -> Double
forall a. Num a => a -> a -> a
(+))
  * :: ValueMap -> ValueMap -> ValueMap
(*)         = (Value -> Value -> Value) -> ValueMap -> ValueMap -> ValueMap
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith ((Int -> Int -> Int)
-> (Double -> Double -> Double) -> Value -> Value -> Value
fNum2 Int -> Int -> Int
forall a. Num a => a -> a -> a
(*) Double -> Double -> Double
forall a. Num a => a -> a -> a
(*))
  fromInteger :: Integer -> ValueMap
fromInteger Integer
i = [Char] -> Value -> ValueMap
forall k a. k -> a -> Map k a
Map.singleton [Char]
"n" (Value -> ValueMap) -> Value -> ValueMap
forall a b. (a -> b) -> a -> b
$ Int -> Value
VI (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i)
  signum :: ValueMap -> ValueMap
signum      = ((Double -> Double)
-> (Int -> Int) -> ([Char] -> [Char]) -> Value -> Value
applyFIS Double -> Double
forall a. Num a => a -> a
signum Int -> Int
forall a. Num a => a -> a
signum [Char] -> [Char]
forall a. a -> a
id (Value -> Value) -> ValueMap -> ValueMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
  abs :: ValueMap -> ValueMap
abs         = ((Double -> Double)
-> (Int -> Int) -> ([Char] -> [Char]) -> Value -> Value
applyFIS Double -> Double
forall a. Num a => a -> a
abs Int -> Int
forall a. Num a => a -> a
abs [Char] -> [Char]
forall a. a -> a
id (Value -> Value) -> ValueMap -> ValueMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)

instance Fractional ValueMap where
  recip :: ValueMap -> ValueMap
recip        = (Value -> Value) -> ValueMap -> ValueMap
forall a b. (a -> b) -> Map [Char] a -> Map [Char] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> Double)
-> (Int -> Int) -> ([Char] -> [Char]) -> Value -> Value
applyFIS Double -> Double
forall a. Fractional a => a -> a
recip Int -> Int
forall a. a -> a
id [Char] -> [Char]
forall a. a -> a
id)
  fromRational :: Rational -> ValueMap
fromRational Rational
r = [Char] -> Value -> ValueMap
forall k a. k -> a -> Map k a
Map.singleton [Char]
"speed" (Value -> ValueMap) -> Value -> ValueMap
forall a b. (a -> b) -> a -> b
$ Double -> Value
VF (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
r)

class Moddable a where
  gmod :: a -> a -> a

instance Moddable Double where
  gmod :: Double -> Double -> Double
gmod = Double -> Double -> Double
forall a. Real a => a -> a -> a
mod'
instance Moddable Rational where
  gmod :: Rational -> Rational -> Rational
gmod = Rational -> Rational -> Rational
forall a. Real a => a -> a -> a
mod'
instance Moddable Note where
  gmod :: Note -> Note -> Note
gmod (Note Double
a) (Note Double
b) = Double -> Note
Note (Double -> Double -> Double
forall a. Real a => a -> a -> a
mod' Double
a Double
b)
instance Moddable Int where
  gmod :: Int -> Int -> Int
gmod = Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod
instance Moddable ValueMap where
  gmod :: ValueMap -> ValueMap -> ValueMap
gmod = (Value -> Value -> Value) -> ValueMap -> ValueMap -> ValueMap
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith ((Int -> Int -> Int)
-> (Double -> Double -> Double) -> Value -> Value -> Value
fNum2 Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Double -> Double -> Double
forall a. Real a => a -> a -> a
mod')

instance Floating ValueMap
  where pi :: ValueMap
pi = [Char] -> ValueMap
forall a. [Char] -> a
noOv [Char]
"pi"
        exp :: ValueMap -> ValueMap
exp ValueMap
_ = [Char] -> ValueMap
forall a. [Char] -> a
noOv [Char]
"exp"
        log :: ValueMap -> ValueMap
log ValueMap
_ = [Char] -> ValueMap
forall a. [Char] -> a
noOv [Char]
"log"
        sin :: ValueMap -> ValueMap
sin ValueMap
_ = [Char] -> ValueMap
forall a. [Char] -> a
noOv [Char]
"sin"
        cos :: ValueMap -> ValueMap
cos ValueMap
_ = [Char] -> ValueMap
forall a. [Char] -> a
noOv [Char]
"cos"
        asin :: ValueMap -> ValueMap
asin ValueMap
_ = [Char] -> ValueMap
forall a. [Char] -> a
noOv [Char]
"asin"
        acos :: ValueMap -> ValueMap
acos ValueMap
_ = [Char] -> ValueMap
forall a. [Char] -> a
noOv [Char]
"acos"
        atan :: ValueMap -> ValueMap
atan ValueMap
_ = [Char] -> ValueMap
forall a. [Char] -> a
noOv [Char]
"atan"
        sinh :: ValueMap -> ValueMap
sinh ValueMap
_ = [Char] -> ValueMap
forall a. [Char] -> a
noOv [Char]
"sinh"
        cosh :: ValueMap -> ValueMap
cosh ValueMap
_ = [Char] -> ValueMap
forall a. [Char] -> a
noOv [Char]
"cosh"
        asinh :: ValueMap -> ValueMap
asinh ValueMap
_ = [Char] -> ValueMap
forall a. [Char] -> a
noOv [Char]
"asinh"
        acosh :: ValueMap -> ValueMap
acosh ValueMap
_ = [Char] -> ValueMap
forall a. [Char] -> a
noOv [Char]
"acosh"
        atanh :: ValueMap -> ValueMap
atanh ValueMap
_ = [Char] -> ValueMap
forall a. [Char] -> a
noOv [Char]
"atanh"

------------------------------------------------------------------------
-- * Internal/fundamental functions

empty :: Pattern a
empty :: forall a. Pattern a
empty = Pattern {query :: State -> [Event a]
query = [Event a] -> State -> [Event a]
forall a b. a -> b -> a
const []}

silence :: Pattern a
silence :: forall a. Pattern a
silence = Pattern a
forall a. Pattern a
empty

queryArc :: Pattern a -> Arc -> [Event a]
queryArc :: forall a. Pattern a -> Arc -> [Event a]
queryArc Pattern a
p Arc
a = Pattern a -> State -> [Event a]
forall a. Pattern a -> State -> [Event a]
query Pattern a
p (State -> [Event a]) -> State -> [Event a]
forall a b. (a -> b) -> a -> b
$ Arc -> ValueMap -> State
State Arc
a ValueMap
forall k a. Map k a
Map.empty

-- | Splits queries that span cycles. For example `query p (0.5, 1.5)` would be
-- turned into two queries, `(0.5,1)` and `(1,1.5)`, and the results
-- combined. Being able to assume queries don't span cycles often
-- makes transformations easier to specify.
splitQueries :: Pattern a -> Pattern a
splitQueries :: forall a. Pattern a -> Pattern a
splitQueries Pattern a
p = Pattern a
p {query = \State
st -> (Arc -> [Event a]) -> [Arc] -> [Event a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Arc
a -> Pattern a -> State -> [Event a]
forall a. Pattern a -> State -> [Event a]
query Pattern a
p State
st {arc = a}) ([Arc] -> [Event a]) -> [Arc] -> [Event a]
forall a b. (a -> b) -> a -> b
$ Arc -> [Arc]
arcCyclesZW (State -> Arc
arc State
st)}

-- | Apply a function to the arcs/timespans (both whole and parts) of the result
withResultArc :: (Arc -> Arc) -> Pattern a -> Pattern a
withResultArc :: forall a. (Arc -> Arc) -> Pattern a -> Pattern a
withResultArc Arc -> Arc
f Pattern a
pat = Pattern a
pat
  { query = map (\(Event Context
c Maybe Arc
w Arc
p a
e) -> Context -> Maybe Arc -> Arc -> a -> EventF Arc a
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event Context
c (Arc -> Arc
f (Arc -> Arc) -> Maybe Arc -> Maybe Arc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Arc
w) (Arc -> Arc
f Arc
p) a
e) . query pat}

-- | Apply a function to the time (both start and end of the timespans
-- of both whole and parts) of the result
withResultTime :: (Time -> Time) -> Pattern a -> Pattern a
withResultTime :: forall a. (Rational -> Rational) -> Pattern a -> Pattern a
withResultTime Rational -> Rational
f = (Arc -> Arc) -> Pattern a -> Pattern a
forall a. (Arc -> Arc) -> Pattern a -> Pattern a
withResultArc (\(Arc Rational
s Rational
e) -> Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc (Rational -> Rational
f Rational
s) (Rational -> Rational
f Rational
e))

-- | Apply a function to the timespan of the query
withQueryArc :: (Arc -> Arc) -> Pattern a -> Pattern a
withQueryArc :: forall a. (Arc -> Arc) -> Pattern a -> Pattern a
withQueryArc Arc -> Arc
f Pattern a
pat = Pattern a
pat {query = query pat . (\(State Arc
a ValueMap
m) -> Arc -> ValueMap -> State
State (Arc -> Arc
f Arc
a) ValueMap
m)}

-- | Apply a function to the time (both start and end) of the query
withQueryTime :: (Time -> Time) -> Pattern a -> Pattern a
withQueryTime :: forall a. (Rational -> Rational) -> Pattern a -> Pattern a
withQueryTime Rational -> Rational
f Pattern a
pat = (Arc -> Arc) -> Pattern a -> Pattern a
forall a. (Arc -> Arc) -> Pattern a -> Pattern a
withQueryArc (\(Arc Rational
s Rational
e) -> Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc (Rational -> Rational
f Rational
s) (Rational -> Rational
f Rational
e)) Pattern a
pat

-- | Apply a function to the control values of the query
withQueryControls :: (ValueMap -> ValueMap) -> Pattern a -> Pattern a
withQueryControls :: forall a. (ValueMap -> ValueMap) -> Pattern a -> Pattern a
withQueryControls ValueMap -> ValueMap
f Pattern a
pat = Pattern a
pat { query = query pat . (\(State Arc
a ValueMap
m) -> Arc -> ValueMap -> State
State Arc
a (ValueMap -> ValueMap
f ValueMap
m))}

-- | @withEvent f p@ returns a new @Pattern@ with each event mapped over
-- function @f@.
withEvent :: (Event a -> Event b) -> Pattern a -> Pattern b
withEvent :: forall a b. (Event a -> Event b) -> Pattern a -> Pattern b
withEvent Event a -> Event b
f Pattern a
p = Pattern a
p {query = map f . query p}

-- | @withEvent f p@ returns a new @Pattern@ with each value mapped over
-- function @f@.
withValue :: (a -> b) -> Pattern a -> Pattern b
withValue :: forall a b. (a -> b) -> Pattern a -> Pattern b
withValue a -> b
f Pattern a
pat = (Event a -> Event b) -> Pattern a -> Pattern b
forall a b. (Event a -> Event b) -> Pattern a -> Pattern b
withEvent ((a -> b) -> Event a -> Event b
forall a b. (a -> b) -> EventF Arc a -> EventF Arc b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) Pattern a
pat

-- | @withEvent f p@ returns a new @Pattern@ with f applied to the resulting list of events for each query
-- function @f@.
withEvents :: ([Event a] -> [Event b]) -> Pattern a -> Pattern b
withEvents :: forall a b. ([Event a] -> [Event b]) -> Pattern a -> Pattern b
withEvents [Event a] -> [Event b]
f Pattern a
p = Pattern a
p {query = f . query p}

-- | @withPart f p@ returns a new @Pattern@ with function @f@ applied
-- to the part.
withPart :: (Arc -> Arc) -> Pattern a -> Pattern a
withPart :: forall a. (Arc -> Arc) -> Pattern a -> Pattern a
withPart Arc -> Arc
f = (Event a -> Event a) -> Pattern a -> Pattern a
forall a b. (Event a -> Event b) -> Pattern a -> Pattern b
withEvent (\(Event Context
c Maybe Arc
w Arc
p a
v) -> Context -> Maybe Arc -> Arc -> a -> Event a
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event Context
c Maybe Arc
w (Arc -> Arc
f Arc
p) a
v)

_extract :: (Value -> Maybe a) -> String -> ControlPattern -> Pattern a
_extract :: forall a.
(Value -> Maybe a) -> [Char] -> ControlPattern -> Pattern a
_extract Value -> Maybe a
f [Char]
name ControlPattern
pat = Pattern (Maybe a) -> Pattern a
forall a. Pattern (Maybe a) -> Pattern a
filterJust (Pattern (Maybe a) -> Pattern a) -> Pattern (Maybe a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (ValueMap -> Maybe a) -> ControlPattern -> Pattern (Maybe a)
forall a b. (a -> b) -> Pattern a -> Pattern b
withValue ([Char] -> ValueMap -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup [Char]
name (ValueMap -> Maybe Value)
-> (Value -> Maybe a) -> ValueMap -> Maybe a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Value -> Maybe a
f) ControlPattern
pat

-- | Extract a pattern of integer values by from a control pattern, given the name of the control
extractI :: String -> ControlPattern -> Pattern Int
extractI :: [Char] -> ControlPattern -> Pattern Int
extractI = (Value -> Maybe Int) -> [Char] -> ControlPattern -> Pattern Int
forall a.
(Value -> Maybe a) -> [Char] -> ControlPattern -> Pattern a
_extract Value -> Maybe Int
getI

-- | Extract a pattern of floating point values by from a control pattern, given the name of the control
extractF :: String -> ControlPattern -> Pattern Double
extractF :: [Char] -> ControlPattern -> Pattern Double
extractF = (Value -> Maybe Double)
-> [Char] -> ControlPattern -> Pattern Double
forall a.
(Value -> Maybe a) -> [Char] -> ControlPattern -> Pattern a
_extract Value -> Maybe Double
getF

-- | Extract a pattern of string values by from a control pattern, given the name of the control
extractS :: String -> ControlPattern -> Pattern String
extractS :: [Char] -> ControlPattern -> Pattern [Char]
extractS = (Value -> Maybe [Char])
-> [Char] -> ControlPattern -> Pattern [Char]
forall a.
(Value -> Maybe a) -> [Char] -> ControlPattern -> Pattern a
_extract Value -> Maybe [Char]
getS

-- | Extract a pattern of boolean values by from a control pattern, given the name of the control
extractB :: String -> ControlPattern -> Pattern Bool
extractB :: [Char] -> ControlPattern -> Pattern Bool
extractB = (Value -> Maybe Bool) -> [Char] -> ControlPattern -> Pattern Bool
forall a.
(Value -> Maybe a) -> [Char] -> ControlPattern -> Pattern a
_extract Value -> Maybe Bool
getB

-- | Extract a pattern of rational values by from a control pattern, given the name of the control
extractR :: String -> ControlPattern -> Pattern Rational
extractR :: [Char] -> ControlPattern -> Pattern Rational
extractR = (Value -> Maybe Rational)
-> [Char] -> ControlPattern -> Pattern Rational
forall a.
(Value -> Maybe a) -> [Char] -> ControlPattern -> Pattern a
_extract Value -> Maybe Rational
getR

-- | Extract a pattern of note values by from a control pattern, given the name of the control
extractN :: String -> ControlPattern -> Pattern Note 
extractN :: [Char] -> ControlPattern -> Pattern Note
extractN = (Value -> Maybe Note) -> [Char] -> ControlPattern -> Pattern Note
forall a.
(Value -> Maybe a) -> [Char] -> ControlPattern -> Pattern a
_extract Value -> Maybe Note
getN

compressArc :: Arc -> Pattern a -> Pattern a
compressArc :: forall a. Arc -> Pattern a -> Pattern a
compressArc (Arc Rational
s Rational
e) Pattern a
p | Rational
s Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
e = Pattern a
forall a. Pattern a
empty
                        | Rational
s Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
1 Bool -> Bool -> Bool
|| Rational
e Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
> Rational
1 = Pattern a
forall a. Pattern a
empty
                        | Rational
s Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0 Bool -> Bool -> Bool
|| Rational
e Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0 = Pattern a
forall a. Pattern a
empty
                        | Bool
otherwise = Rational
s Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
`rotR` Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_fastGap (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/(Rational
eRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
s)) Pattern a
p

compressArcTo :: Arc -> Pattern a -> Pattern a
compressArcTo :: forall a. Arc -> Pattern a -> Pattern a
compressArcTo (Arc Rational
s Rational
e) = Arc -> Pattern a -> Pattern a
forall a. Arc -> Pattern a -> Pattern a
compressArc (Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc (Rational -> Rational
cyclePos Rational
s) (Rational
e Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational -> Rational
sam Rational
s))

focusArc :: Arc -> Pattern a -> Pattern a
focusArc :: forall a. Arc -> Pattern a -> Pattern a
focusArc (Arc Rational
s Rational
e) Pattern a
p = (Rational -> Rational
cyclePos Rational
s) Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
`rotR` (Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_fast (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/(Rational
eRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
s)) Pattern a
p)


{-| Speed up a pattern by the given time pattern.

For example, the following will play the sound pattern @"bd sn kurt"@ twice as
fast (i.e., so it repeats twice per cycle), and the vowel pattern three times
as fast:

> d1 $ sound (fast 2 "bd sn kurt")
>    # fast 3 (vowel "a e o")

The first parameter can be patterned to, for example, play the pattern at twice
the speed for the first half of each cycle and then four times the speed for the
second half:

> d1 $ fast "2 4" $ sound "bd sn kurt cp"
-}
fast :: Pattern Time -> Pattern a -> Pattern a
fast :: forall a. Pattern Rational -> Pattern a -> Pattern a
fast = (Rational -> Pattern a -> Pattern a)
-> Pattern Rational -> Pattern a -> Pattern a
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_fast

{-| @fastSqueeze@ speeds up a pattern by a time pattern given as input,
  squeezing the resulting pattern inside one cycle and playing the original
  pattern at every repetition.

  To better understand how it works, compare it with 'fast':

  >>> print $ fast "1 2" $ s "bd sn"
  (0>½)|s: "bd"
  (½>¾)|s: "bd"
  (¾>1)|s: "sn"

  This will give @bd@ played in the first half cycle, and @bd sn@ in the second
  half. On the other hand, using fastSqueeze;

  >>> print $ fastSqueeze "1 2" $ s "bd sn"
  (0>¼)|s: "bd"
  (¼>½)|s: "sn"
  (½>⅝)|s: "bd"
  (⅝>¾)|s: "sn"
  (¾>⅞)|s: "bd"
  (⅞>1)|s: "sn"

  The original pattern will play in the first half, and two repetitions of the
  original pattern will play in the second half. That is, every repetition
  contains the whole pattern.

  If the time pattern has a single value, it becomes equivalent to 'fast':

  > d1 $ fastSqueeze 2 $ s "bd sn"
  > d1 $ fast 2 $ s "bd sn"
  > d1 $ s "[bd sn]*2"
-}
fastSqueeze :: Pattern Time -> Pattern a -> Pattern a
fastSqueeze :: forall a. Pattern Rational -> Pattern a -> Pattern a
fastSqueeze = (Rational -> Pattern a -> Pattern a)
-> Pattern Rational -> Pattern a -> Pattern a
forall a b c.
(a -> Pattern b -> Pattern c)
-> Pattern a -> Pattern b -> Pattern c
tParamSqueeze Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_fast

-- | An alias for @fast@
density :: Pattern Time -> Pattern a -> Pattern a
density :: forall a. Pattern Rational -> Pattern a -> Pattern a
density = Pattern Rational -> Pattern a -> Pattern a
forall a. Pattern Rational -> Pattern a -> Pattern a
fast

_fast :: Time -> Pattern a -> Pattern a
_fast :: forall a. Rational -> Pattern a -> Pattern a
_fast Rational
rate Pattern a
pat | Rational
rate Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
0 = Pattern a
forall a. Pattern a
silence
               | Rational
rate Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< Rational
0 = Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
rev (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_fast (Rational -> Rational
forall a. Num a => a -> a
negate Rational
rate) Pattern a
pat
               | Bool
otherwise = (Rational -> Rational) -> Pattern a -> Pattern a
forall a. (Rational -> Rational) -> Pattern a -> Pattern a
withResultTime (Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
rate) (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ (Rational -> Rational) -> Pattern a -> Pattern a
forall a. (Rational -> Rational) -> Pattern a -> Pattern a
withQueryTime (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
rate) Pattern a
pat

{-| Slow down a pattern by the given time pattern.

  For example, the following will play the sound pattern @"bd sn kurt"@ twice as
  slow (i.e., so it repeats once every two cycles), and the vowel pattern three
  times as slow:

  > d1 $ sound (slow 2 "bd sn kurt")
  >    # slow 3 (vowel "a e o")
-}
slow :: Pattern Time -> Pattern a -> Pattern a
slow :: forall a. Pattern Rational -> Pattern a -> Pattern a
slow = (Rational -> Pattern a -> Pattern a)
-> Pattern Rational -> Pattern a -> Pattern a
forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_slow
_slow :: Time -> Pattern a -> Pattern a
_slow :: forall a. Rational -> Pattern a -> Pattern a
_slow Rational
0 Pattern a
_ = Pattern a
forall a. Pattern a
silence
_slow Rational
r Pattern a
p = Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
_fast (Rational
1Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
r) Pattern a
p

_fastGap :: Time -> Pattern a -> Pattern a
_fastGap :: forall a. Rational -> Pattern a -> Pattern a
_fastGap Rational
0 Pattern a
_ = Pattern a
forall a. Pattern a
empty
_fastGap Rational
r Pattern a
p = Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
splitQueries (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$
  (Arc -> Arc) -> Pattern a -> Pattern a
forall a. (Arc -> Arc) -> Pattern a -> Pattern a
withResultArc (\(Arc Rational
s Rational
e) -> Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc (Rational -> Rational
sam Rational
s Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ ((Rational
s Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational -> Rational
sam Rational
s)Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
r'))
                             (Rational -> Rational
sam Rational
s Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ ((Rational
e Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational -> Rational
sam Rational
s)Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/Rational
r'))
                 ) (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ Pattern a
p {query = f}
  where r' :: Rational
r' = Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
max Rational
r Rational
1
        -- zero width queries of the next sam should return zero in this case..
        f :: State -> [Event a]
f st :: State
st@(State Arc
a ValueMap
_) | Arc -> Rational
forall a. ArcF a -> a
start Arc
a' Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational -> Rational
nextSam (Arc -> Rational
forall a. ArcF a -> a
start Arc
a) = []
                         | Bool
otherwise = Pattern a -> State -> [Event a]
forall a. Pattern a -> State -> [Event a]
query Pattern a
p State
st {arc = a'}
          where mungeQuery :: Rational -> Rational
mungeQuery Rational
t = Rational -> Rational
sam Rational
t Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational -> Rational -> Rational
forall a. Ord a => a -> a -> a
min Rational
1 (Rational
r' Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational -> Rational
cyclePos Rational
t)
                a' :: Arc
a' = (\(Arc Rational
s Rational
e) -> Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc (Rational -> Rational
mungeQuery Rational
s) (Rational -> Rational
mungeQuery Rational
e)) Arc
a

{-| Shifts a pattern back in time by the given amount, expressed in cycles.

  This will skip to the fourth cycle:

  > do
  >   resetCycles
  >   d1 $ rotL 4 $ seqP
  >     [ (0, 12, sound "bd bd*2")
  >     , (4, 12, sound "hh*2 [sn cp] cp future*4")
  >     , (8, 12, sound (samples "arpy*8" (run 16)))
  >     ]

  Useful when building and testing out longer sequences.
-}
rotL :: Time -> Pattern a -> Pattern a
rotL :: forall a. Rational -> Pattern a -> Pattern a
rotL Rational
t Pattern a
p = (Rational -> Rational) -> Pattern a -> Pattern a
forall a. (Rational -> Rational) -> Pattern a -> Pattern a
withResultTime (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
subtract Rational
t) (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ (Rational -> Rational) -> Pattern a -> Pattern a
forall a. (Rational -> Rational) -> Pattern a -> Pattern a
withQueryTime (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
t) Pattern a
p

{-| Shifts a pattern forward in time by the given amount, expressed in cycles.
  Opposite of 'rotL'.
-}
rotR :: Time -> Pattern a -> Pattern a
rotR :: forall a. Rational -> Pattern a -> Pattern a
rotR Rational
t = Rational -> Pattern a -> Pattern a
forall a. Rational -> Pattern a -> Pattern a
rotL (Rational -> Rational
forall a. Num a => a -> a
negate Rational
t)

{- | @rev p@ returns @p@ with the event positions in each cycle reversed (or
  mirrored).

  For example rev @"1 [~ 2] ~ 3"@ is equivalent to rev @"3 ~ [2 ~] 1"@.

  Note that @rev@ reverses on a cycle-by-cycle basis. This means that @rev (slow
  2 "1 2 3 4")@ would actually result in @(slow 2 "2 1 4 3")@. This is because the
  @slow 2@ makes the repeating pattern last two cycles, each of which is reversed
  independently.

  In practice rev is generally used with conditionals, for example with every:

  > d1 $ every 3 rev $ n "0 1 [~ 2] 3" # sound "arpy"

  or 'jux':

  > d1 $ jux rev $ n (iter 4 "0 1 [~ 2] 3") # sound "arpy"
-}
rev :: Pattern a -> Pattern a
rev :: forall a. Pattern a -> Pattern a
rev Pattern a
p =
  Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
splitQueries (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ Pattern a
p {
    query = \State
st -> (Event a -> Event a) -> [Event a] -> [Event a]
forall a b. (a -> b) -> [a] -> [b]
map Event a -> Event a
forall a. Event a -> Event a
makeWholeAbsolute ([Event a] -> [Event a]) -> [Event a] -> [Event a]
forall a b. (a -> b) -> a -> b
$
      (Arc -> Arc) -> [Event a] -> [Event a]
forall a. (Arc -> Arc) -> [Event a] -> [Event a]
mapParts (Rational -> Arc -> Arc
mirrorArc (Arc -> Rational
midCycle (Arc -> Rational) -> Arc -> Rational
forall a b. (a -> b) -> a -> b
$ State -> Arc
arc State
st)) ([Event a] -> [Event a]) -> [Event a] -> [Event a]
forall a b. (a -> b) -> a -> b
$
      (Event a -> Event a) -> [Event a] -> [Event a]
forall a b. (a -> b) -> [a] -> [b]
map Event a -> Event a
forall a. Event a -> Event a
makeWholeRelative
      (Pattern a -> State -> [Event a]
forall a. Pattern a -> State -> [Event a]
query Pattern a
p State
st
        {arc = mirrorArc (midCycle $ arc st) (arc st)
        })
    }
  where makeWholeRelative :: Event a -> Event a
        makeWholeRelative :: forall a. Event a -> Event a
makeWholeRelative e :: Event a
e@Event {whole :: forall a b. EventF a b -> Maybe a
whole = Maybe Arc
Nothing} = Event a
e
        makeWholeRelative (Event Context
c (Just (Arc Rational
s Rational
e)) p' :: Arc
p'@(Arc Rational
s' Rational
e') a
v) =
          Context -> Maybe Arc -> Arc -> a -> Event a
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event Context
c (Arc -> Maybe Arc
forall a. a -> Maybe a
Just (Arc -> Maybe Arc) -> Arc -> Maybe Arc
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc (Rational
s'Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
s) (Rational
eRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
e')) Arc
p' a
v
        makeWholeAbsolute :: Event a -> Event a
        makeWholeAbsolute :: forall a. Event a -> Event a
makeWholeAbsolute e :: Event a
e@Event {whole :: forall a b. EventF a b -> Maybe a
whole = Maybe Arc
Nothing} = Event a
e
        makeWholeAbsolute (Event Context
c (Just (Arc Rational
s Rational
e)) p' :: Arc
p'@(Arc Rational
s' Rational
e') a
v) =
          Context -> Maybe Arc -> Arc -> a -> Event a
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event Context
c (Arc -> Maybe Arc
forall a. a -> Maybe a
Just (Arc -> Maybe Arc) -> Arc -> Maybe Arc
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc (Rational
s'Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
e) (Rational
e'Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+Rational
s)) Arc
p' a
v
        midCycle :: Arc -> Time
        midCycle :: Arc -> Rational
midCycle (Arc Rational
s Rational
_) = Rational -> Rational
sam Rational
s Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
0.5
        mapParts :: (Arc -> Arc) -> [Event a] -> [Event a]
        mapParts :: forall a. (Arc -> Arc) -> [Event a] -> [Event a]
mapParts Arc -> Arc
f [Event a]
es = (\(Event Context
c Maybe Arc
w Arc
p' a
v) -> Context -> Maybe Arc -> Arc -> a -> Event a
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event Context
c Maybe Arc
w (Arc -> Arc
f Arc
p') a
v) (Event a -> Event a) -> [Event a] -> [Event a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Event a]
es
        -- | Returns the `mirror image' of a 'Arc' around the given point in time
        mirrorArc :: Time -> Arc -> Arc
        mirrorArc :: Rational -> Arc -> Arc
mirrorArc Rational
mid' (Arc Rational
s Rational
e) = Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc (Rational
mid' Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- (Rational
eRational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
mid')) (Rational
mid'Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+(Rational
mid'Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
-Rational
s))

-- | Mark values in the first pattern which match with at least one
-- value in the second pattern.
matchManyToOne :: (b -> a -> Bool) -> Pattern a -> Pattern b -> Pattern (Bool, b)
matchManyToOne :: forall b a.
(b -> a -> Bool) -> Pattern a -> Pattern b -> Pattern (Bool, b)
matchManyToOne b -> a -> Bool
f Pattern a
pa Pattern b
pb = Pattern a
pa {query = q}
  where q :: State -> [EventF Arc (Bool, b)]
q State
st = (EventF Arc b -> EventF Arc (Bool, b))
-> [EventF Arc b] -> [EventF Arc (Bool, b)]
forall a b. (a -> b) -> [a] -> [b]
map EventF Arc b -> EventF Arc (Bool, b)
match ([EventF Arc b] -> [EventF Arc (Bool, b)])
-> [EventF Arc b] -> [EventF Arc (Bool, b)]
forall a b. (a -> b) -> a -> b
$ Pattern b -> State -> [EventF Arc b]
forall a. Pattern a -> State -> [Event a]
query Pattern b
pb State
st
          where
            match :: EventF Arc b -> EventF Arc (Bool, b)
match ex :: EventF Arc b
ex@(Event Context
xContext Maybe Arc
xWhole Arc
xPart b
x) =
              Context -> Maybe Arc -> Arc -> (Bool, b) -> EventF Arc (Bool, b)
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event ([Context] -> Context
combineContexts ([Context] -> Context) -> [Context] -> Context
forall a b. (a -> b) -> a -> b
$ Context
xContextContext -> [Context] -> [Context]
forall a. a -> [a] -> [a]
:(EventF Arc a -> Context) -> [EventF Arc a] -> [Context]
forall a b. (a -> b) -> [a] -> [b]
map EventF Arc a -> Context
forall a b. EventF a b -> Context
context [EventF Arc a]
as') Maybe Arc
xWhole Arc
xPart ((EventF Arc a -> Bool) -> [EventF Arc a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (b -> a -> Bool
f b
x (a -> Bool) -> (EventF Arc a -> a) -> EventF Arc a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventF Arc a -> a
forall a b. EventF a b -> b
value) [EventF Arc a]
as', b
x)
                where as' :: [EventF Arc a]
as' = Rational -> [EventF Arc a]
as (Rational -> [EventF Arc a]) -> Rational -> [EventF Arc a]
forall a b. (a -> b) -> a -> b
$ Arc -> Rational
forall a. ArcF a -> a
start (Arc -> Rational) -> Arc -> Rational
forall a b. (a -> b) -> a -> b
$ EventF Arc b -> Arc
forall a. Event a -> Arc
wholeOrPart EventF Arc b
ex
            as :: Rational -> [EventF Arc a]
as Rational
s = Pattern a -> State -> [EventF Arc a]
forall a. Pattern a -> State -> [Event a]
query Pattern a
pa (State -> [EventF Arc a]) -> State -> [EventF Arc a]
forall a b. (a -> b) -> a -> b
$ Rational -> State
fQuery Rational
s
            fQuery :: Rational -> State
fQuery Rational
s = State
st {arc = Arc s s}

-- ** Event filters

-- | Remove events from patterns that to not meet the given test
filterValues :: (a -> Bool) -> Pattern a -> Pattern a
filterValues :: forall a. (a -> Bool) -> Pattern a -> Pattern a
filterValues a -> Bool
f Pattern a
p = Pattern a
p {query = filter (f . value) . query p}

-- | Turns a pattern of 'Maybe' values into a pattern of values,
-- dropping the events of 'Nothing'.
filterJust :: Pattern (Maybe a) -> Pattern a
filterJust :: forall a. Pattern (Maybe a) -> Pattern a
filterJust Pattern (Maybe a)
p = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> Pattern (Maybe a) -> Pattern a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe a -> Bool) -> Pattern (Maybe a) -> Pattern (Maybe a)
forall a. (a -> Bool) -> Pattern a -> Pattern a
filterValues Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Pattern (Maybe a)
p

filterWhen :: (Time -> Bool) -> Pattern a -> Pattern a
filterWhen :: forall a. (Rational -> Bool) -> Pattern a -> Pattern a
filterWhen Rational -> Bool
test Pattern a
p = Pattern a
p {query = filter (test . wholeStart) . query p}

filterOnsets :: Pattern a -> Pattern a
filterOnsets :: forall a. Pattern a -> Pattern a
filterOnsets Pattern a
p = Pattern a
p {query = filter (\Event a
e -> Event a -> Rational
forall a. Event a -> Rational
eventPartStart Event a
e Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Event a -> Rational
forall a. Event a -> Rational
wholeStart Event a
e) . query (filterDigital p)}

filterEvents :: (Event a -> Bool) -> Pattern a -> Pattern a
filterEvents :: forall a. (Event a -> Bool) -> Pattern a -> Pattern a
filterEvents Event a -> Bool
f Pattern a
p = Pattern a
p {query = filter f . query p}

filterDigital :: Pattern a -> Pattern a
filterDigital :: forall a. Pattern a -> Pattern a
filterDigital = (Event a -> Bool) -> Pattern a -> Pattern a
forall a. (Event a -> Bool) -> Pattern a -> Pattern a
filterEvents Event a -> Bool
forall a. Event a -> Bool
isDigital

filterAnalog :: Pattern a -> Pattern a
filterAnalog :: forall a. Pattern a -> Pattern a
filterAnalog = (Event a -> Bool) -> Pattern a -> Pattern a
forall a. (Event a -> Bool) -> Pattern a -> Pattern a
filterEvents Event a -> Bool
forall a. Event a -> Bool
isAnalog

playFor :: Time -> Time -> Pattern a -> Pattern a
playFor :: forall a. Rational -> Rational -> Pattern a -> Pattern a
playFor Rational
s Rational
e Pattern a
pat = (State -> [Event a]) -> Pattern a
forall a. (State -> [Event a]) -> Pattern a
Pattern ((State -> [Event a]) -> Pattern a)
-> (State -> [Event a]) -> Pattern a
forall a b. (a -> b) -> a -> b
$ \State
st -> [Event a] -> (Arc -> [Event a]) -> Maybe Arc -> [Event a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Arc
a -> Pattern a -> State -> [Event a]
forall a. Pattern a -> State -> [Event a]
query Pattern a
pat (State
st {arc = a})) (Maybe Arc -> [Event a]) -> Maybe Arc -> [Event a]
forall a b. (a -> b) -> a -> b
$ Arc -> Arc -> Maybe Arc
subArc (Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc Rational
s Rational
e) (State -> Arc
arc State
st)

-- ** Temporal parameter helpers

tParam :: (t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam :: forall t1 t2 a.
(t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam t1 -> t2 -> Pattern a
f Pattern t1
tv t2
p = Pattern (Pattern a) -> Pattern a
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern a) -> Pattern a)
-> Pattern (Pattern a) -> Pattern a
forall a b. (a -> b) -> a -> b
$ (t1 -> t2 -> Pattern a
`f` t2
p) (t1 -> Pattern a) -> Pattern t1 -> Pattern (Pattern a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern t1
tv

tParam2 :: (a -> b -> c -> Pattern d) -> Pattern a -> Pattern b -> c -> Pattern d
tParam2 :: forall a b c d.
(a -> b -> c -> Pattern d)
-> Pattern a -> Pattern b -> c -> Pattern d
tParam2 a -> b -> c -> Pattern d
f Pattern a
a Pattern b
b c
p = Pattern (Pattern d) -> Pattern d
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern d) -> Pattern d)
-> Pattern (Pattern d) -> Pattern d
forall a b. (a -> b) -> a -> b
$ (\a
x b
y -> a -> b -> c -> Pattern d
f a
x b
y c
p) (a -> b -> Pattern d) -> Pattern a -> Pattern (b -> Pattern d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
a Pattern (b -> Pattern d) -> Pattern b -> Pattern (Pattern d)
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern b
b

tParam3 :: (a -> b -> c -> Pattern d -> Pattern e) -> (Pattern a -> Pattern b -> Pattern c -> Pattern d -> Pattern e)
tParam3 :: forall a b c d e.
(a -> b -> c -> Pattern d -> Pattern e)
-> Pattern a -> Pattern b -> Pattern c -> Pattern d -> Pattern e
tParam3 a -> b -> c -> Pattern d -> Pattern e
f Pattern a
a Pattern b
b Pattern c
c Pattern d
p = Pattern (Pattern e) -> Pattern e
forall a. Pattern (Pattern a) -> Pattern a
innerJoin (Pattern (Pattern e) -> Pattern e)
-> Pattern (Pattern e) -> Pattern e
forall a b. (a -> b) -> a -> b
$ (\a
x b
y c
z -> a -> b -> c -> Pattern d -> Pattern e
f a
x b
y c
z Pattern d
p) (a -> b -> c -> Pattern e)
-> Pattern a -> Pattern (b -> c -> Pattern e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
a Pattern (b -> c -> Pattern e)
-> Pattern b -> Pattern (c -> Pattern e)
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern b
b Pattern (c -> Pattern e) -> Pattern c -> Pattern (Pattern e)
forall a b. Pattern (a -> b) -> Pattern a -> Pattern b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Pattern c
c

tParamSqueeze :: (a -> Pattern b -> Pattern c) -> (Pattern a -> Pattern b -> Pattern c)
tParamSqueeze :: forall a b c.
(a -> Pattern b -> Pattern c)
-> Pattern a -> Pattern b -> Pattern c
tParamSqueeze a -> Pattern b -> Pattern c
f Pattern a
tv Pattern b
p = Pattern (Pattern c) -> Pattern c
forall a. Pattern (Pattern a) -> Pattern a
squeezeJoin (Pattern (Pattern c) -> Pattern c)
-> Pattern (Pattern c) -> Pattern c
forall a b. (a -> b) -> a -> b
$ (a -> Pattern b -> Pattern c
`f` Pattern b
p) (a -> Pattern c) -> Pattern a -> Pattern (Pattern c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern a
tv

-- ** Context

combineContexts :: [Context] -> Context
combineContexts :: [Context] -> Context
combineContexts = [((Int, Int), (Int, Int))] -> Context
Context ([((Int, Int), (Int, Int))] -> Context)
-> ([Context] -> [((Int, Int), (Int, Int))])
-> [Context]
-> Context
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context -> [((Int, Int), (Int, Int))])
-> [Context] -> [((Int, Int), (Int, Int))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Context -> [((Int, Int), (Int, Int))]
contextPosition

setContext :: Context -> Pattern a -> Pattern a
setContext :: forall a. Context -> Pattern a -> Pattern a
setContext Context
c Pattern a
pat = ([Event a] -> [Event a]) -> Pattern a -> Pattern a
forall a b. ([Event a] -> [Event b]) -> Pattern a -> Pattern b
withEvents ((Event a -> Event a) -> [Event a] -> [Event a]
forall a b. (a -> b) -> [a] -> [b]
map (\Event a
e -> Event a
e {context = c})) Pattern a
pat

withContext :: (Context -> Context) -> Pattern a -> Pattern a
withContext :: forall a. (Context -> Context) -> Pattern a -> Pattern a
withContext Context -> Context
f Pattern a
pat = ([Event a] -> [Event a]) -> Pattern a -> Pattern a
forall a b. ([Event a] -> [Event b]) -> Pattern a -> Pattern b
withEvents ((Event a -> Event a) -> [Event a] -> [Event a]
forall a b. (a -> b) -> [a] -> [b]
map (\Event a
e -> Event a
e {context = f $ context e})) Pattern a
pat

-- A hack to add to manipulate source code to add calls to
-- 'deltaContext' around strings, so events from mininotation know
-- where they are within a whole tidal pattern
deltaMini :: String -> String
deltaMini :: [Char] -> [Char]
deltaMini = Int -> Int -> [Char] -> [Char]
outside Int
0 Int
0
  where outside :: Int -> Int -> String -> String
        outside :: Int -> Int -> [Char] -> [Char]
outside Int
_ Int
_ [] = []
        outside Int
column Int
line (Char
'"':[Char]
xs) = [Char]
"(deltaContext "
                                         [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
column
                                         [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" "
                                         [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
line
                                         [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" \""
                                         [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> Int -> [Char] -> [Char]
inside (Int
columnInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
line [Char]
xs
        outside Int
_ Int
line (Char
'\n':[Char]
xs) = Char
'\n'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Int -> Int -> [Char] -> [Char]
outside Int
0 (Int
lineInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Char]
xs
        outside Int
column Int
line (Char
x:[Char]
xs) = Char
xChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Int -> Int -> [Char] -> [Char]
outside (Int
columnInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
line [Char]
xs
        inside :: Int -> Int -> String -> String
        inside :: Int -> Int -> [Char] -> [Char]
inside Int
_ Int
_ [] = []
        inside Int
column Int
line (Char
'"':[Char]
xs) = Char
'"'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Char
')'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Int -> Int -> [Char] -> [Char]
outside (Int
columnInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
line [Char]
xs
        inside Int
_ Int
line (Char
'\n':[Char]
xs) = Char
'\n'Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Int -> Int -> [Char] -> [Char]
inside Int
0 (Int
lineInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Char]
xs
        inside Int
column Int
line (Char
x:[Char]
xs) = Char
xChar -> [Char] -> [Char]
forall a. a -> [a] -> [a]
:Int -> Int -> [Char] -> [Char]
inside (Int
columnInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
line [Char]
xs

class Stringy a where
  deltaContext :: Int -> Int -> a -> a

instance Stringy (Pattern a) where
  deltaContext :: Int -> Int -> Pattern a -> Pattern a
deltaContext Int
column Int
line Pattern a
pat = ([Event a] -> [Event a]) -> Pattern a -> Pattern a
forall a b. ([Event a] -> [Event b]) -> Pattern a -> Pattern b
withEvents ((Event a -> Event a) -> [Event a] -> [Event a]
forall a b. (a -> b) -> [a] -> [b]
map (\Event a
e -> Event a
e {context = f $ context e})) Pattern a
pat
    where f :: Context -> Context
          f :: Context -> Context
f (Context [((Int, Int), (Int, Int))]
xs) = [((Int, Int), (Int, Int))] -> Context
Context ([((Int, Int), (Int, Int))] -> Context)
-> [((Int, Int), (Int, Int))] -> Context
forall a b. (a -> b) -> a -> b
$ (((Int, Int), (Int, Int)) -> ((Int, Int), (Int, Int)))
-> [((Int, Int), (Int, Int))] -> [((Int, Int), (Int, Int))]
forall a b. (a -> b) -> [a] -> [b]
map (\((Int
bx,Int
by), (Int
ex,Int
ey)) -> ((Int
bxInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
column,Int
byInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
line), (Int
exInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
column,Int
eyInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
line))) [((Int, Int), (Int, Int))]
xs

-- deltaContext on an actual (non overloaded) string is a no-op
instance Stringy String where
  deltaContext :: Int -> Int -> [Char] -> [Char]
deltaContext Int
_ Int
_ = [Char] -> [Char]
forall a. a -> a
id

-- ** Events

-- | Some context for an event, currently just position within sourcecode
data Context = Context {Context -> [((Int, Int), (Int, Int))]
contextPosition :: [((Int, Int), (Int, Int))]}
  deriving (Context -> Context -> Bool
(Context -> Context -> Bool)
-> (Context -> Context -> Bool) -> Eq Context
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Context -> Context -> Bool
== :: Context -> Context -> Bool
$c/= :: Context -> Context -> Bool
/= :: Context -> Context -> Bool
Eq, Eq Context
Eq Context =>
(Context -> Context -> Ordering)
-> (Context -> Context -> Bool)
-> (Context -> Context -> Bool)
-> (Context -> Context -> Bool)
-> (Context -> Context -> Bool)
-> (Context -> Context -> Context)
-> (Context -> Context -> Context)
-> Ord Context
Context -> Context -> Bool
Context -> Context -> Ordering
Context -> Context -> Context
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
$ccompare :: Context -> Context -> Ordering
compare :: Context -> Context -> Ordering
$c< :: Context -> Context -> Bool
< :: Context -> Context -> Bool
$c<= :: Context -> Context -> Bool
<= :: Context -> Context -> Bool
$c> :: Context -> Context -> Bool
> :: Context -> Context -> Bool
$c>= :: Context -> Context -> Bool
>= :: Context -> Context -> Bool
$cmax :: Context -> Context -> Context
max :: Context -> Context -> Context
$cmin :: Context -> Context -> Context
min :: Context -> Context -> Context
Ord, (forall x. Context -> Rep Context x)
-> (forall x. Rep Context x -> Context) -> Generic Context
forall x. Rep Context x -> Context
forall x. Context -> Rep Context x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Context -> Rep Context x
from :: forall x. Context -> Rep Context x
$cto :: forall x. Rep Context x -> Context
to :: forall x. Rep Context x -> Context
Generic)
instance NFData Context

-- | An event is a value that's active during a timespan. If a whole
-- is present, the part should be equal to or fit inside it.
data EventF a b = Event
  { forall a b. EventF a b -> Context
context :: Context
  , forall a b. EventF a b -> Maybe a
whole :: Maybe a
  , forall a b. EventF a b -> a
part :: a
  , forall a b. EventF a b -> b
value :: b
  } deriving (EventF a b -> EventF a b -> Bool
(EventF a b -> EventF a b -> Bool)
-> (EventF a b -> EventF a b -> Bool) -> Eq (EventF a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b. (Eq a, Eq b) => EventF a b -> EventF a b -> Bool
$c== :: forall a b. (Eq a, Eq b) => EventF a b -> EventF a b -> Bool
== :: EventF a b -> EventF a b -> Bool
$c/= :: forall a b. (Eq a, Eq b) => EventF a b -> EventF a b -> Bool
/= :: EventF a b -> EventF a b -> Bool
Eq, Eq (EventF a b)
Eq (EventF a b) =>
(EventF a b -> EventF a b -> Ordering)
-> (EventF a b -> EventF a b -> Bool)
-> (EventF a b -> EventF a b -> Bool)
-> (EventF a b -> EventF a b -> Bool)
-> (EventF a b -> EventF a b -> Bool)
-> (EventF a b -> EventF a b -> EventF a b)
-> (EventF a b -> EventF a b -> EventF a b)
-> Ord (EventF a b)
EventF a b -> EventF a b -> Bool
EventF a b -> EventF a b -> Ordering
EventF a b -> EventF a b -> EventF a b
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 b. (Ord a, Ord b) => Eq (EventF a b)
forall a b. (Ord a, Ord b) => EventF a b -> EventF a b -> Bool
forall a b. (Ord a, Ord b) => EventF a b -> EventF a b -> Ordering
forall a b.
(Ord a, Ord b) =>
EventF a b -> EventF a b -> EventF a b
$ccompare :: forall a b. (Ord a, Ord b) => EventF a b -> EventF a b -> Ordering
compare :: EventF a b -> EventF a b -> Ordering
$c< :: forall a b. (Ord a, Ord b) => EventF a b -> EventF a b -> Bool
< :: EventF a b -> EventF a b -> Bool
$c<= :: forall a b. (Ord a, Ord b) => EventF a b -> EventF a b -> Bool
<= :: EventF a b -> EventF a b -> Bool
$c> :: forall a b. (Ord a, Ord b) => EventF a b -> EventF a b -> Bool
> :: EventF a b -> EventF a b -> Bool
$c>= :: forall a b. (Ord a, Ord b) => EventF a b -> EventF a b -> Bool
>= :: EventF a b -> EventF a b -> Bool
$cmax :: forall a b.
(Ord a, Ord b) =>
EventF a b -> EventF a b -> EventF a b
max :: EventF a b -> EventF a b -> EventF a b
$cmin :: forall a b.
(Ord a, Ord b) =>
EventF a b -> EventF a b -> EventF a b
min :: EventF a b -> EventF a b -> EventF a b
Ord, (forall a b. (a -> b) -> EventF a a -> EventF a b)
-> (forall a b. a -> EventF a b -> EventF a a)
-> Functor (EventF a)
forall a b. a -> EventF a b -> EventF a a
forall a b. (a -> b) -> EventF a a -> EventF a b
forall a a b. a -> EventF a b -> EventF a a
forall a a b. (a -> b) -> EventF a a -> EventF a 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 a b. (a -> b) -> EventF a a -> EventF a b
fmap :: forall a b. (a -> b) -> EventF a a -> EventF a b
$c<$ :: forall a a b. a -> EventF a b -> EventF a a
<$ :: forall a b. a -> EventF a b -> EventF a a
Functor, (forall x. EventF a b -> Rep (EventF a b) x)
-> (forall x. Rep (EventF a b) x -> EventF a b)
-> Generic (EventF a b)
forall x. Rep (EventF a b) x -> EventF a b
forall x. EventF a b -> Rep (EventF a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a b x. Rep (EventF a b) x -> EventF a b
forall a b x. EventF a b -> Rep (EventF a b) x
$cfrom :: forall a b x. EventF a b -> Rep (EventF a b) x
from :: forall x. EventF a b -> Rep (EventF a b) x
$cto :: forall a b x. Rep (EventF a b) x -> EventF a b
to :: forall x. Rep (EventF a b) x -> EventF a b
Generic)
instance (NFData a, NFData b) => NFData (EventF a b)

type Event a = EventF (ArcF Time) a

-- * Event utilities

isAnalog :: Event a -> Bool
isAnalog :: forall a. Event a -> Bool
isAnalog (Event {whole :: forall a b. EventF a b -> Maybe a
whole = Maybe Arc
Nothing}) = Bool
True
isAnalog EventF Arc a
_ = Bool
False

isDigital :: Event a -> Bool
isDigital :: forall a. Event a -> Bool
isDigital = Bool -> Bool
not (Bool -> Bool) -> (Event a -> Bool) -> Event a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event a -> Bool
forall a. Event a -> Bool
isAnalog

-- | `True` if an `Event`'s starts is within given `Arc`
onsetIn :: Arc -> Event a -> Bool
onsetIn :: forall a. Arc -> Event a -> Bool
onsetIn Arc
a Event a
e = Arc -> Rational -> Bool
isIn Arc
a (Event a -> Rational
forall a. Event a -> Rational
wholeStart Event a
e)

-- | Returns a list of events, with any adjacent parts of the same whole combined
defragParts :: Eq a => [Event a] -> [Event a]
defragParts :: forall a. Eq a => [Event a] -> [Event a]
defragParts [] = []
defragParts [Event a
e] = [Event a
e]
defragParts (Event a
e:[Event a]
es) | Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
i = Event a
defraged Event a -> [Event a] -> [Event a]
forall a. a -> [a] -> [a]
: [Event a] -> [Event a]
forall a. Eq a => [Event a] -> [Event a]
defragParts (Event a -> [Event a] -> [Event a]
forall a. Eq a => a -> [a] -> [a]
delete Event a
e' [Event a]
es)
                   | Bool
otherwise = Event a
e Event a -> [Event a] -> [Event a]
forall a. a -> [a] -> [a]
: [Event a] -> [Event a]
forall a. Eq a => [Event a] -> [Event a]
defragParts [Event a]
es
  where i :: Maybe Int
i = (Event a -> Bool) -> [Event a] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (Event a -> Event a -> Bool
forall a. Eq a => Event a -> Event a -> Bool
isAdjacent Event a
e) [Event a]
es
        e' :: Event a
e' = [Event a]
es [Event a] -> Int -> Event a
forall a. HasCallStack => [a] -> Int -> a
!! Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Int
i
        defraged :: Event a
defraged = Context -> Maybe Arc -> Arc -> a -> Event a
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event (Event a -> Context
forall a b. EventF a b -> Context
context Event a
e) (Event a -> Maybe Arc
forall a b. EventF a b -> Maybe a
whole Event a
e) Arc
u (Event a -> a
forall a b. EventF a b -> b
value Event a
e)
        u :: Arc
u = Arc -> Arc -> Arc
hull (Event a -> Arc
forall a b. EventF a b -> a
part Event a
e) (Event a -> Arc
forall a b. EventF a b -> a
part Event a
e')

-- | Returns 'True' if the two given events are adjacent parts of the same whole
isAdjacent :: Eq a => Event a -> Event a -> Bool
isAdjacent :: forall a. Eq a => Event a -> Event a -> Bool
isAdjacent Event a
e Event a
e' = (Event a -> Maybe Arc
forall a b. EventF a b -> Maybe a
whole Event a
e Maybe Arc -> Maybe Arc -> Bool
forall a. Eq a => a -> a -> Bool
== Event a -> Maybe Arc
forall a b. EventF a b -> Maybe a
whole Event a
e')
                  Bool -> Bool -> Bool
&& (Event a -> a
forall a b. EventF a b -> b
value Event a
e a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Event a -> a
forall a b. EventF a b -> b
value Event a
e')
                  Bool -> Bool -> Bool
&& ((Arc -> Rational
forall a. ArcF a -> a
stop (Event a -> Arc
forall a b. EventF a b -> a
part Event a
e) Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Arc -> Rational
forall a. ArcF a -> a
start (Event a -> Arc
forall a b. EventF a b -> a
part Event a
e'))
                      Bool -> Bool -> Bool
||
                      (Arc -> Rational
forall a. ArcF a -> a
stop (Event a -> Arc
forall a b. EventF a b -> a
part Event a
e') Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Arc -> Rational
forall a. ArcF a -> a
start (Event a -> Arc
forall a b. EventF a b -> a
part Event a
e))
                     )

wholeOrPart :: Event a -> Arc
wholeOrPart :: forall a. Event a -> Arc
wholeOrPart (Event {whole :: forall a b. EventF a b -> Maybe a
whole = Just Arc
a}) = Arc
a
wholeOrPart EventF Arc a
e = EventF Arc a -> Arc
forall a b. EventF a b -> a
part EventF Arc a
e

-- | Get the onset of an event's 'whole'
wholeStart :: Event a -> Time
wholeStart :: forall a. Event a -> Rational
wholeStart = Arc -> Rational
forall a. ArcF a -> a
start (Arc -> Rational) -> (Event a -> Arc) -> Event a -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event a -> Arc
forall a. Event a -> Arc
wholeOrPart

-- | Get the offset of an event's 'whole'
wholeStop :: Event a -> Time
wholeStop :: forall a. Event a -> Rational
wholeStop = Arc -> Rational
forall a. ArcF a -> a
stop (Arc -> Rational) -> (Event a -> Arc) -> Event a -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event a -> Arc
forall a. Event a -> Arc
wholeOrPart

-- | Get the onset of an event's 'whole'
eventPartStart :: Event a -> Time
eventPartStart :: forall a. Event a -> Rational
eventPartStart = Arc -> Rational
forall a. ArcF a -> a
start (Arc -> Rational) -> (Event a -> Arc) -> Event a -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event a -> Arc
forall a b. EventF a b -> a
part

-- | Get the offset of an event's 'part'
eventPartStop :: Event a -> Time
eventPartStop :: forall a. Event a -> Rational
eventPartStop = Arc -> Rational
forall a. ArcF a -> a
stop (Arc -> Rational) -> (Event a -> Arc) -> Event a -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event a -> Arc
forall a b. EventF a b -> a
part

-- | Get the timespan of an event's 'part'
eventPart :: Event a -> Arc
eventPart :: forall a. Event a -> Arc
eventPart = EventF Arc a -> Arc
forall a b. EventF a b -> a
part

eventValue :: Event a -> a
eventValue :: forall a. Event a -> a
eventValue = EventF Arc a -> a
forall a b. EventF a b -> b
value

eventHasOnset :: Event a -> Bool
eventHasOnset :: forall a. Event a -> Bool
eventHasOnset Event a
e | Event a -> Bool
forall a. Event a -> Bool
isAnalog Event a
e = Bool
False
                | Bool
otherwise = Arc -> Rational
forall a. ArcF a -> a
start (Maybe Arc -> Arc
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Arc -> Arc) -> Maybe Arc -> Arc
forall a b. (a -> b) -> a -> b
$ Event a -> Maybe Arc
forall a b. EventF a b -> Maybe a
whole Event a
e) Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Arc -> Rational
forall a. ArcF a -> a
start (Event a -> Arc
forall a b. EventF a b -> a
part Event a
e)

-- TODO - Is this used anywhere? Just tests, it seems
-- TODO - support 'context' field
toEvent :: (((Time, Time), (Time, Time)), a) -> Event a
toEvent :: forall a.
(((Rational, Rational), (Rational, Rational)), a) -> Event a
toEvent (((Rational
ws, Rational
we), (Rational
ps, Rational
pe)), a
v) = Context -> Maybe Arc -> Arc -> a -> EventF Arc a
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event ([((Int, Int), (Int, Int))] -> Context
Context []) (Arc -> Maybe Arc
forall a. a -> Maybe a
Just (Arc -> Maybe Arc) -> Arc -> Maybe Arc
forall a b. (a -> b) -> a -> b
$ Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc Rational
ws Rational
we) (Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc Rational
ps Rational
pe) a
v

 -- Resolves higher order VState values to plain values, by passing through (and changing) state
resolveState :: ValueMap -> [Event ValueMap] -> (ValueMap, [Event ValueMap])
resolveState :: ValueMap -> [Event ValueMap] -> (ValueMap, [Event ValueMap])
resolveState ValueMap
sMap [] = (ValueMap
sMap, [])
resolveState ValueMap
sMap (Event ValueMap
e:[Event ValueMap]
es) = (ValueMap
sMap'', (Event ValueMap
e {value = v'})Event ValueMap -> [Event ValueMap] -> [Event ValueMap]
forall a. a -> [a] -> [a]
:[Event ValueMap]
es')
  where f :: ValueMap -> Value -> (ValueMap, Value)
f ValueMap
sm (VState ValueMap -> (ValueMap, Value)
v) = ValueMap -> (ValueMap, Value)
v ValueMap
sm
        f ValueMap
sm Value
v = (ValueMap
sm, Value
v)
        (ValueMap
sMap', ValueMap
v') | Event ValueMap -> Bool
forall a. Event a -> Bool
eventHasOnset Event ValueMap
e = (ValueMap -> Value -> (ValueMap, Value))
-> ValueMap -> ValueMap -> (ValueMap, ValueMap)
forall a b c k. (a -> b -> (a, c)) -> a -> Map k b -> (a, Map k c)
Map.mapAccum ValueMap -> Value -> (ValueMap, Value)
f ValueMap
sMap (Event ValueMap -> ValueMap
forall a b. EventF a b -> b
value Event ValueMap
e)    -- pass state through VState functions
                    | Bool
otherwise = (ValueMap
sMap, (Value -> Bool) -> ValueMap -> ValueMap
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter Value -> Bool
notVState (ValueMap -> ValueMap) -> ValueMap -> ValueMap
forall a b. (a -> b) -> a -> b
$ Event ValueMap -> ValueMap
forall a b. EventF a b -> b
value Event ValueMap
e) -- filter out VState values without onsets
        (ValueMap
sMap'', [Event ValueMap]
es') = ValueMap -> [Event ValueMap] -> (ValueMap, [Event ValueMap])
resolveState ValueMap
sMap' [Event ValueMap]
es
        notVState :: Value -> Bool
notVState (VState ValueMap -> (ValueMap, Value)
_) = Bool
False
        notVState Value
_ = Bool
True

-- ** Values

-- | Polymorphic values

data Value = VS { Value -> [Char]
svalue :: String   }
           | VF { Value -> Double
fvalue :: Double   }
           | VN { Value -> Note
nvalue :: Note     }
           | VR { Value -> Rational
rvalue :: Rational }
           | VI { Value -> Int
ivalue :: Int      }
           | VB { Value -> Bool
bvalue :: Bool     }
           | VX { Value -> [Word8]
xvalue :: [Word8]  } -- Used for OSC 'blobs'
           | VPattern {Value -> Pattern Value
pvalue :: Pattern Value}
           | VList {Value -> [Value]
lvalue :: [Value]}
           | VState {Value -> ValueMap -> (ValueMap, Value)
statevalue :: ValueMap -> (ValueMap, Value)}
           deriving (Typeable, (forall x. Value -> Rep Value x)
-> (forall x. Rep Value x -> Value) -> Generic Value
forall x. Rep Value x -> Value
forall x. Value -> Rep Value x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Value -> Rep Value x
from :: forall x. Value -> Rep Value x
$cto :: forall x. Rep Value x -> Value
to :: forall x. Rep Value x -> Value
Generic)

class Valuable a where
  toValue :: a -> Value
instance NFData Value

type ValueMap = Map.Map String Value

-- | Note is Double, but with a different parser
newtype Note = Note { Note -> Double
unNote :: Double }
  deriving (Typeable, Typeable Note
Typeable Note =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Note -> c Note)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Note)
-> (Note -> Constr)
-> (Note -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Note))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Note))
-> ((forall b. Data b => b -> b) -> Note -> Note)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Note -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Note -> r)
-> (forall u. (forall d. Data d => d -> u) -> Note -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Note -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Note -> m Note)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Note -> m Note)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Note -> m Note)
-> Data Note
Note -> Constr
Note -> DataType
(forall b. Data b => b -> b) -> Note -> Note
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Note -> u
forall u. (forall d. Data d => d -> u) -> Note -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Note -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Note -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Note -> m Note
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Note -> m Note
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Note
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Note -> c Note
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Note)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Note)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Note -> c Note
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Note -> c Note
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Note
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Note
$ctoConstr :: Note -> Constr
toConstr :: Note -> Constr
$cdataTypeOf :: Note -> DataType
dataTypeOf :: Note -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Note)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Note)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Note)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Note)
$cgmapT :: (forall b. Data b => b -> b) -> Note -> Note
gmapT :: (forall b. Data b => b -> b) -> Note -> Note
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Note -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Note -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Note -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Note -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Note -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Note -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Note -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Note -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Note -> m Note
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Note -> m Note
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Note -> m Note
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Note -> m Note
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Note -> m Note
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Note -> m Note
Data, (forall x. Note -> Rep Note x)
-> (forall x. Rep Note x -> Note) -> Generic Note
forall x. Rep Note x -> Note
forall x. Note -> Rep Note x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Note -> Rep Note x
from :: forall x. Note -> Rep Note x
$cto :: forall x. Rep Note x -> Note
to :: forall x. Rep Note x -> Note
Generic, Note -> Note -> Bool
(Note -> Note -> Bool) -> (Note -> Note -> Bool) -> Eq Note
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Note -> Note -> Bool
== :: Note -> Note -> Bool
$c/= :: Note -> Note -> Bool
/= :: Note -> Note -> Bool
Eq, Eq Note
Eq Note =>
(Note -> Note -> Ordering)
-> (Note -> Note -> Bool)
-> (Note -> Note -> Bool)
-> (Note -> Note -> Bool)
-> (Note -> Note -> Bool)
-> (Note -> Note -> Note)
-> (Note -> Note -> Note)
-> Ord Note
Note -> Note -> Bool
Note -> Note -> Ordering
Note -> Note -> Note
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
$ccompare :: Note -> Note -> Ordering
compare :: Note -> Note -> Ordering
$c< :: Note -> Note -> Bool
< :: Note -> Note -> Bool
$c<= :: Note -> Note -> Bool
<= :: Note -> Note -> Bool
$c> :: Note -> Note -> Bool
> :: Note -> Note -> Bool
$c>= :: Note -> Note -> Bool
>= :: Note -> Note -> Bool
$cmax :: Note -> Note -> Note
max :: Note -> Note -> Note
$cmin :: Note -> Note -> Note
min :: Note -> Note -> Note
Ord, Int -> Note
Note -> Int
Note -> [Note]
Note -> Note
Note -> Note -> [Note]
Note -> Note -> Note -> [Note]
(Note -> Note)
-> (Note -> Note)
-> (Int -> Note)
-> (Note -> Int)
-> (Note -> [Note])
-> (Note -> Note -> [Note])
-> (Note -> Note -> [Note])
-> (Note -> Note -> Note -> [Note])
-> Enum Note
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Note -> Note
succ :: Note -> Note
$cpred :: Note -> Note
pred :: Note -> Note
$ctoEnum :: Int -> Note
toEnum :: Int -> Note
$cfromEnum :: Note -> Int
fromEnum :: Note -> Int
$cenumFrom :: Note -> [Note]
enumFrom :: Note -> [Note]
$cenumFromThen :: Note -> Note -> [Note]
enumFromThen :: Note -> Note -> [Note]
$cenumFromTo :: Note -> Note -> [Note]
enumFromTo :: Note -> Note -> [Note]
$cenumFromThenTo :: Note -> Note -> Note -> [Note]
enumFromThenTo :: Note -> Note -> Note -> [Note]
Enum, Integer -> Note
Note -> Note
Note -> Note -> Note
(Note -> Note -> Note)
-> (Note -> Note -> Note)
-> (Note -> Note -> Note)
-> (Note -> Note)
-> (Note -> Note)
-> (Note -> Note)
-> (Integer -> Note)
-> Num Note
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Note -> Note -> Note
+ :: Note -> Note -> Note
$c- :: Note -> Note -> Note
- :: Note -> Note -> Note
$c* :: Note -> Note -> Note
* :: Note -> Note -> Note
$cnegate :: Note -> Note
negate :: Note -> Note
$cabs :: Note -> Note
abs :: Note -> Note
$csignum :: Note -> Note
signum :: Note -> Note
$cfromInteger :: Integer -> Note
fromInteger :: Integer -> Note
Num, Num Note
Num Note =>
(Note -> Note -> Note)
-> (Note -> Note) -> (Rational -> Note) -> Fractional Note
Rational -> Note
Note -> Note
Note -> Note -> Note
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: Note -> Note -> Note
/ :: Note -> Note -> Note
$crecip :: Note -> Note
recip :: Note -> Note
$cfromRational :: Rational -> Note
fromRational :: Rational -> Note
Fractional, Fractional Note
Note
Fractional Note =>
Note
-> (Note -> Note)
-> (Note -> Note)
-> (Note -> Note)
-> (Note -> Note -> Note)
-> (Note -> Note -> Note)
-> (Note -> Note)
-> (Note -> Note)
-> (Note -> Note)
-> (Note -> Note)
-> (Note -> Note)
-> (Note -> Note)
-> (Note -> Note)
-> (Note -> Note)
-> (Note -> Note)
-> (Note -> Note)
-> (Note -> Note)
-> (Note -> Note)
-> (Note -> Note)
-> (Note -> Note)
-> (Note -> Note)
-> (Note -> Note)
-> Floating Note
Note -> Note
Note -> Note -> Note
forall a.
Fractional a =>
a
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> Floating a
$cpi :: Note
pi :: Note
$cexp :: Note -> Note
exp :: Note -> Note
$clog :: Note -> Note
log :: Note -> Note
$csqrt :: Note -> Note
sqrt :: Note -> Note
$c** :: Note -> Note -> Note
** :: Note -> Note -> Note
$clogBase :: Note -> Note -> Note
logBase :: Note -> Note -> Note
$csin :: Note -> Note
sin :: Note -> Note
$ccos :: Note -> Note
cos :: Note -> Note
$ctan :: Note -> Note
tan :: Note -> Note
$casin :: Note -> Note
asin :: Note -> Note
$cacos :: Note -> Note
acos :: Note -> Note
$catan :: Note -> Note
atan :: Note -> Note
$csinh :: Note -> Note
sinh :: Note -> Note
$ccosh :: Note -> Note
cosh :: Note -> Note
$ctanh :: Note -> Note
tanh :: Note -> Note
$casinh :: Note -> Note
asinh :: Note -> Note
$cacosh :: Note -> Note
acosh :: Note -> Note
$catanh :: Note -> Note
atanh :: Note -> Note
$clog1p :: Note -> Note
log1p :: Note -> Note
$cexpm1 :: Note -> Note
expm1 :: Note -> Note
$clog1pexp :: Note -> Note
log1pexp :: Note -> Note
$clog1mexp :: Note -> Note
log1mexp :: Note -> Note
Floating, Num Note
Ord Note
(Num Note, Ord Note) => (Note -> Rational) -> Real Note
Note -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: Note -> Rational
toRational :: Note -> Rational
Real, Fractional Note
Real Note
(Real Note, Fractional Note) =>
(forall b. Integral b => Note -> (b, Note))
-> (forall b. Integral b => Note -> b)
-> (forall b. Integral b => Note -> b)
-> (forall b. Integral b => Note -> b)
-> (forall b. Integral b => Note -> b)
-> RealFrac Note
forall b. Integral b => Note -> b
forall b. Integral b => Note -> (b, Note)
forall a.
(Real a, Fractional a) =>
(forall b. Integral b => a -> (b, a))
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> (forall b. Integral b => a -> b)
-> RealFrac a
$cproperFraction :: forall b. Integral b => Note -> (b, Note)
properFraction :: forall b. Integral b => Note -> (b, Note)
$ctruncate :: forall b. Integral b => Note -> b
truncate :: forall b. Integral b => Note -> b
$cround :: forall b. Integral b => Note -> b
round :: forall b. Integral b => Note -> b
$cceiling :: forall b. Integral b => Note -> b
ceiling :: forall b. Integral b => Note -> b
$cfloor :: forall b. Integral b => Note -> b
floor :: forall b. Integral b => Note -> b
RealFrac)

instance NFData Note

instance Show Note where
  show :: Note -> [Char]
show Note
n = (Double -> [Char]
forall a. Show a => a -> [Char]
show (Double -> [Char]) -> (Note -> Double) -> Note -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note -> Double
unNote (Note -> [Char]) -> Note -> [Char]
forall a b. (a -> b) -> a -> b
$ Note
n) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"n (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
pitchClass [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
octave [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"
    where
      pitchClass :: [Char]
pitchClass = [[Char]]
pcs [[Char]] -> Int -> [Char]
forall a. HasCallStack => [a] -> Int -> a
!! Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
noteInt Int
12
      octave :: [Char]
octave = Int -> [Char]
forall a. Show a => a -> [Char]
show (Int -> [Char]) -> Int -> [Char]
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
noteInt Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
5
      noteInt :: Int
noteInt = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> (Note -> Double) -> Note -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note -> Double
unNote (Note -> Int) -> Note -> Int
forall a b. (a -> b) -> a -> b
$ Note
n
      pcs :: [[Char]]
pcs = [[Char]
"c", [Char]
"cs", [Char]
"d", [Char]
"ds", [Char]
"e", [Char]
"f", [Char]
"fs", [Char]
"g", [Char]
"gs", [Char]
"a", [Char]
"as", [Char]
"b"]

instance Valuable String where
  toValue :: [Char] -> Value
toValue [Char]
a = [Char] -> Value
VS [Char]
a
instance Valuable Double where
  toValue :: Double -> Value
toValue Double
a = Double -> Value
VF Double
a
instance Valuable Rational where
  toValue :: Rational -> Value
toValue Rational
a = Rational -> Value
VR Rational
a
instance Valuable Int where
  toValue :: Int -> Value
toValue Int
a = Int -> Value
VI Int
a
instance Valuable Bool where
  toValue :: Bool -> Value
toValue Bool
a = Bool -> Value
VB Bool
a
instance Valuable Note where
  toValue :: Note -> Value
toValue Note
a = Note -> Value
VN Note
a
instance Valuable [Word8] where
  toValue :: [Word8] -> Value
toValue [Word8]
a = [Word8] -> Value
VX [Word8]
a
instance Valuable [Value] where
  toValue :: [Value] -> Value
toValue [Value]
a = [Value] -> Value
VList [Value]
a

instance Eq Value where
  (VS [Char]
x) == :: Value -> Value -> Bool
== (VS [Char]
y) = [Char]
x [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
y
  (VB Bool
x) == (VB Bool
y) = Bool
x Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
y
  (VF Double
x) == (VF Double
y) = Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
y
  (VI Int
x) == (VI Int
y) = Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y
  (VN Note
x) == (VN Note
y) = Note
x Note -> Note -> Bool
forall a. Eq a => a -> a -> Bool
== Note
y
  (VR Rational
x) == (VR Rational
y) = Rational
x Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
y
  (VX [Word8]
x) == (VX [Word8]
y) = [Word8]
x [Word8] -> [Word8] -> Bool
forall a. Eq a => a -> a -> Bool
== [Word8]
y

  (VF Double
x) == (VI Int
y) = Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y
  (VI Int
y) == (VF Double
x) = Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y

  (VF Double
x) == (VR Rational
y) = Double -> Rational
forall a. Real a => a -> Rational
toRational Double
x Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
y
  (VR Rational
y) == (VF Double
x) = Double -> Rational
forall a. Real a => a -> Rational
toRational Double
x Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
y
  (VI Int
x) == (VR Rational
y) = Int -> Rational
forall a. Real a => a -> Rational
toRational Int
x Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
y
  (VR Rational
y) == (VI Int
x) = Int -> Rational
forall a. Real a => a -> Rational
toRational Int
x Rational -> Rational -> Bool
forall a. Eq a => a -> a -> Bool
== Rational
y

  Value
_ == Value
_ = Bool
False

instance Ord Value where
  compare :: Value -> Value -> Ordering
compare (VS [Char]
x) (VS [Char]
y) = [Char] -> [Char] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [Char]
x [Char]
y
  compare (VB Bool
x) (VB Bool
y) = Bool -> Bool -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Bool
x Bool
y
  compare (VF Double
x) (VF Double
y) = Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
x Double
y
  compare (VN Note
x) (VN Note
y) = Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Note -> Double
unNote Note
x) (Note -> Double
unNote Note
y)
  compare (VI Int
x) (VI Int
y) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
x Int
y
  compare (VR Rational
x) (VR Rational
y) = Rational -> Rational -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Rational
x Rational
y
  compare (VX [Word8]
x) (VX [Word8]
y) = [Word8] -> [Word8] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [Word8]
x [Word8]
y

  compare (VS [Char]
_) Value
_ = Ordering
LT
  compare Value
_ (VS [Char]
_) = Ordering
GT
  compare (VB Bool
_) Value
_ = Ordering
LT
  compare Value
_ (VB Bool
_) = Ordering
GT
  compare (VX [Word8]
_) Value
_ = Ordering
LT
  compare Value
_ (VX [Word8]
_) = Ordering
GT

  compare (VF Double
x) (VI Int
y) = Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
x (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)
  compare (VI Int
x) (VF Double
y) = Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) Double
y

  compare (VR Rational
x) (VI Int
y) = Rational -> Rational -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Rational
x (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)
  compare (VI Int
x) (VR Rational
y) = Rational -> Rational -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) Rational
y

  compare (VF Double
x) (VR Rational
y) = Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
x (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
y)
  compare (VR Rational
x) (VF Double
y) = Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
x) Double
y

  compare (VN Note
x) (VI Int
y) = Note -> Note -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Note
x (Int -> Note
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)
  compare (VI Int
x) (VN Note
y) = Note -> Note -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Note
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) Note
y

  compare (VN Note
x) (VR Rational
y) = Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Note -> Double
unNote Note
x) (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
y)
  compare (VR Rational
x) (VN Note
y) = Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
x) (Note -> Double
unNote Note
y)

  compare (VF Double
x) (VN Note
y) = Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
x (Note -> Double
unNote Note
y)
  compare (VN Note
x) (VF Double
y) = Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Note -> Double
unNote Note
x) Double
y

  -- you can't really compare patterns, state or lists..
  compare (VPattern Pattern Value
_) (VPattern Pattern Value
_) = Ordering
EQ
  compare (VPattern Pattern Value
_) Value
_ = Ordering
GT
  compare Value
_ (VPattern Pattern Value
_) = Ordering
LT

  compare (VState ValueMap -> (ValueMap, Value)
_) (VState ValueMap -> (ValueMap, Value)
_) = Ordering
EQ
  compare (VState ValueMap -> (ValueMap, Value)
_) Value
_          = Ordering
GT
  compare Value
_ (VState ValueMap -> (ValueMap, Value)
_)          = Ordering
LT

  compare (VList [Value]
_) (VList [Value]
_) = Ordering
EQ
  compare (VList [Value]
_) Value
_          = Ordering
GT
  compare Value
_ (VList [Value]
_)          = Ordering
LT

-- | General utilities..

-- | Apply one of three functions to a Value, depending on its type
applyFIS :: (Double -> Double) -> (Int -> Int) -> (String -> String) -> Value -> Value
applyFIS :: (Double -> Double)
-> (Int -> Int) -> ([Char] -> [Char]) -> Value -> Value
applyFIS Double -> Double
f Int -> Int
_ [Char] -> [Char]
_ (VF Double
f') = Double -> Value
VF (Double -> Double
f Double
f')
applyFIS Double -> Double
f Int -> Int
_ [Char] -> [Char]
_ (VN (Note Double
f')) = Note -> Value
VN (Double -> Note
Note (Double -> Note) -> Double -> Note
forall a b. (a -> b) -> a -> b
$ Double -> Double
f Double
f')
applyFIS Double -> Double
_ Int -> Int
f [Char] -> [Char]
_ (VI Int
i) = Int -> Value
VI (Int -> Int
f Int
i)
applyFIS Double -> Double
_ Int -> Int
_ [Char] -> [Char]
f (VS [Char]
s) = [Char] -> Value
VS ([Char] -> [Char]
f [Char]
s)
applyFIS Double -> Double
f Int -> Int
f' [Char] -> [Char]
f'' (VState ValueMap -> (ValueMap, Value)
x) = (ValueMap -> (ValueMap, Value)) -> Value
VState ((ValueMap -> (ValueMap, Value)) -> Value)
-> (ValueMap -> (ValueMap, Value)) -> Value
forall a b. (a -> b) -> a -> b
$ \ValueMap
cmap -> ((Double -> Double)
-> (Int -> Int) -> ([Char] -> [Char]) -> Value -> Value
applyFIS Double -> Double
f Int -> Int
f' [Char] -> [Char]
f'') (Value -> Value) -> (ValueMap, Value) -> (ValueMap, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ValueMap -> (ValueMap, Value)
x ValueMap
cmap)
applyFIS Double -> Double
_ Int -> Int
_ [Char] -> [Char]
_ Value
v = Value
v

-- | Apply one of two functions to a pair of Values, depending on their types (int
-- or float; strings and rationals are ignored)
fNum2 :: (Int -> Int -> Int) -> (Double -> Double -> Double) -> Value -> Value -> Value
fNum2 :: (Int -> Int -> Int)
-> (Double -> Double -> Double) -> Value -> Value -> Value
fNum2 Int -> Int -> Int
fInt Double -> Double -> Double
_      (VI Int
a) (VI Int
b) = Int -> Value
VI (Int -> Int -> Int
fInt Int
a Int
b)
fNum2 Int -> Int -> Int
_    Double -> Double -> Double
fFloat (VF Double
a) (VF Double
b) = Double -> Value
VF (Double -> Double -> Double
fFloat Double
a Double
b)
fNum2 Int -> Int -> Int
_    Double -> Double -> Double
fFloat (VN (Note Double
a)) (VN (Note Double
b)) = Note -> Value
VN (Double -> Note
Note (Double -> Note) -> Double -> Note
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
fFloat Double
a Double
b)
fNum2 Int -> Int -> Int
_    Double -> Double -> Double
fFloat (VF Double
a) (VN (Note Double
b)) = Note -> Value
VN (Double -> Note
Note (Double -> Note) -> Double -> Note
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
fFloat Double
a Double
b)
fNum2 Int -> Int -> Int
_    Double -> Double -> Double
fFloat (VN (Note Double
a)) (VF Double
b) = Note -> Value
VN (Double -> Note
Note (Double -> Note) -> Double -> Note
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
fFloat Double
a Double
b)
fNum2 Int -> Int -> Int
_    Double -> Double -> Double
fFloat (VI Int
a) (VF Double
b) = Double -> Value
VF (Double -> Double -> Double
fFloat (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a) Double
b)
fNum2 Int -> Int -> Int
_    Double -> Double -> Double
fFloat (VF Double
a) (VI Int
b) = Double -> Value
VF (Double -> Double -> Double
fFloat Double
a (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b))
fNum2 Int -> Int -> Int
fInt Double -> Double -> Double
fFloat (VState ValueMap -> (ValueMap, Value)
a) Value
b = (ValueMap -> (ValueMap, Value)) -> Value
VState ((ValueMap -> (ValueMap, Value)) -> Value)
-> (ValueMap -> (ValueMap, Value)) -> Value
forall a b. (a -> b) -> a -> b
$ \ValueMap
cmap -> ((\Value
a' -> (Int -> Int -> Int)
-> (Double -> Double -> Double) -> Value -> Value -> Value
fNum2 Int -> Int -> Int
fInt Double -> Double -> Double
fFloat Value
a' Value
b) (Value -> Value) -> (ValueMap, Value) -> (ValueMap, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ValueMap -> (ValueMap, Value)
a ValueMap
cmap))
fNum2 Int -> Int -> Int
fInt Double -> Double -> Double
fFloat Value
a (VState ValueMap -> (ValueMap, Value)
b) = (ValueMap -> (ValueMap, Value)) -> Value
VState ((ValueMap -> (ValueMap, Value)) -> Value)
-> (ValueMap -> (ValueMap, Value)) -> Value
forall a b. (a -> b) -> a -> b
$ \ValueMap
cmap -> ((\Value
b' -> (Int -> Int -> Int)
-> (Double -> Double -> Double) -> Value -> Value -> Value
fNum2 Int -> Int -> Int
fInt Double -> Double -> Double
fFloat Value
a Value
b') (Value -> Value) -> (ValueMap, Value) -> (ValueMap, Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ValueMap -> (ValueMap, Value)
b ValueMap
cmap))
fNum2 Int -> Int -> Int
_    Double -> Double -> Double
_      Value
x      Value
_      = Value
x

getI :: Value -> Maybe Int
getI :: Value -> Maybe Int
getI (VI Int
i) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
getI (VR Rational
x) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Rational -> Int
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Rational
x
getI (VF Double
x) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Double
x
getI Value
_  = Maybe Int
forall a. Maybe a
Nothing

getF :: Value -> Maybe Double
getF :: Value -> Maybe Double
getF (VF Double
f) = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
f
getF (VR Rational
x) = Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
x
getF (VI Int
x) = Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x
getF Value
_  = Maybe Double
forall a. Maybe a
Nothing

getN :: Value -> Maybe Note
getN :: Value -> Maybe Note
getN (VN Note
n) = Note -> Maybe Note
forall a. a -> Maybe a
Just Note
n
getN (VF Double
f) = Note -> Maybe Note
forall a. a -> Maybe a
Just (Note -> Maybe Note) -> Note -> Maybe Note
forall a b. (a -> b) -> a -> b
$ Double -> Note
Note Double
f
getN (VR Rational
x) = Note -> Maybe Note
forall a. a -> Maybe a
Just (Note -> Maybe Note) -> Note -> Maybe Note
forall a b. (a -> b) -> a -> b
$ Double -> Note
Note (Double -> Note) -> Double -> Note
forall a b. (a -> b) -> a -> b
$ Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
x
getN (VI Int
x) = Note -> Maybe Note
forall a. a -> Maybe a
Just (Note -> Maybe Note) -> Note -> Maybe Note
forall a b. (a -> b) -> a -> b
$ Double -> Note
Note (Double -> Note) -> Double -> Note
forall a b. (a -> b) -> a -> b
$ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x
getN Value
_  = Maybe Note
forall a. Maybe a
Nothing

getS :: Value -> Maybe String
getS :: Value -> Maybe [Char]
getS (VS [Char]
s) = [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
s
getS Value
_  = Maybe [Char]
forall a. Maybe a
Nothing

getB :: Value -> Maybe Bool
getB :: Value -> Maybe Bool
getB (VB Bool
b) = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
b
getB Value
_  = Maybe Bool
forall a. Maybe a
Nothing

getR :: Value -> Maybe Rational
getR :: Value -> Maybe Rational
getR (VR Rational
r) = Rational -> Maybe Rational
forall a. a -> Maybe a
Just Rational
r
getR (VF Double
x) = Rational -> Maybe Rational
forall a. a -> Maybe a
Just (Rational -> Maybe Rational) -> Rational -> Maybe Rational
forall a b. (a -> b) -> a -> b
$ Double -> Rational
forall a. Real a => a -> Rational
toRational Double
x
getR (VI Int
x) = Rational -> Maybe Rational
forall a. a -> Maybe a
Just (Rational -> Maybe Rational) -> Rational -> Maybe Rational
forall a b. (a -> b) -> a -> b
$ Int -> Rational
forall a. Real a => a -> Rational
toRational Int
x
getR Value
_  = Maybe Rational
forall a. Maybe a
Nothing

getBlob :: Value -> Maybe [Word8]
getBlob :: Value -> Maybe [Word8]
getBlob (VX [Word8]
xs) = [Word8] -> Maybe [Word8]
forall a. a -> Maybe a
Just [Word8]
xs
getBlob Value
_  = Maybe [Word8]
forall a. Maybe a
Nothing

getList :: Value -> Maybe [Value]
getList :: Value -> Maybe [Value]
getList (VList [Value]
vs) = [Value] -> Maybe [Value]
forall a. a -> Maybe a
Just [Value]
vs
getList Value
_  = Maybe [Value]
forall a. Maybe a
Nothing

valueToPattern :: Value -> Pattern Value
valueToPattern :: Value -> Pattern Value
valueToPattern (VPattern Pattern Value
pat) = Pattern Value
pat
valueToPattern Value
v = Value -> Pattern Value
forall a. a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v

--- functions relating to chords/patterns of lists


sameDur :: Event a -> Event a -> Bool
sameDur :: forall a. Event a -> Event a -> Bool
sameDur Event a
e1 Event a
e2 = (Event a -> Maybe Arc
forall a b. EventF a b -> Maybe a
whole Event a
e1 Maybe Arc -> Maybe Arc -> Bool
forall a. Eq a => a -> a -> Bool
== Event a -> Maybe Arc
forall a b. EventF a b -> Maybe a
whole Event a
e2) Bool -> Bool -> Bool
&& (Event a -> Arc
forall a b. EventF a b -> a
part Event a
e1 Arc -> Arc -> Bool
forall a. Eq a => a -> a -> Bool
== Event a -> Arc
forall a b. EventF a b -> a
part Event a
e2)

groupEventsBy :: Eq a => (Event a -> Event a -> Bool) -> [Event a] -> [[Event a]]
groupEventsBy :: forall a.
Eq a =>
(Event a -> Event a -> Bool) -> [Event a] -> [[Event a]]
groupEventsBy Event a -> Event a -> Bool
_ [] = []
groupEventsBy Event a -> Event a -> Bool
f (Event a
e:[Event a]
es) = [Event a]
eqs[Event a] -> [[Event a]] -> [[Event a]]
forall a. a -> [a] -> [a]
:((Event a -> Event a -> Bool) -> [Event a] -> [[Event a]]
forall a.
Eq a =>
(Event a -> Event a -> Bool) -> [Event a] -> [[Event a]]
groupEventsBy Event a -> Event a -> Bool
f ([Event a]
es [Event a] -> [Event a] -> [Event a]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Event a]
eqs))
                   where eqs :: [Event a]
eqs = Event a
eEvent a -> [Event a] -> [Event a]
forall a. a -> [a] -> [a]
:[Event a
x | Event a
x <- [Event a]
es, Event a -> Event a -> Bool
f Event a
e Event a
x]

-- assumes that all events in the list have same whole/part
collectEvent :: [Event a] -> Maybe (Event [a])
collectEvent :: forall a. [Event a] -> Maybe (Event [a])
collectEvent [] = Maybe (Event [a])
forall a. Maybe a
Nothing
collectEvent l :: [Event a]
l@(Event a
e:[Event a]
_) = Event [a] -> Maybe (Event [a])
forall a. a -> Maybe a
Just (Event [a] -> Maybe (Event [a])) -> Event [a] -> Maybe (Event [a])
forall a b. (a -> b) -> a -> b
$ Event a
e {context = con, value = vs}
                      where con :: Context
con = [Context] -> Context
unionC ([Context] -> Context) -> [Context] -> Context
forall a b. (a -> b) -> a -> b
$ (Event a -> Context) -> [Event a] -> [Context]
forall a b. (a -> b) -> [a] -> [b]
map Event a -> Context
forall a b. EventF a b -> Context
context [Event a]
l
                            vs :: [a]
vs = (Event a -> a) -> [Event a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map Event a -> a
forall a b. EventF a b -> b
value [Event a]
l
                            unionC :: [Context] -> Context
unionC [] = [((Int, Int), (Int, Int))] -> Context
Context []
                            unionC ((Context [((Int, Int), (Int, Int))]
is):[Context]
cs) = [((Int, Int), (Int, Int))] -> Context
Context ([((Int, Int), (Int, Int))]
is [((Int, Int), (Int, Int))]
-> [((Int, Int), (Int, Int))] -> [((Int, Int), (Int, Int))]
forall a. [a] -> [a] -> [a]
++ [((Int, Int), (Int, Int))]
iss)
                                                 where Context [((Int, Int), (Int, Int))]
iss = [Context] -> Context
unionC [Context]
cs

collectEventsBy :: Eq a => (Event a -> Event a -> Bool) -> [Event a] -> [Event [a]]
collectEventsBy :: forall a.
Eq a =>
(Event a -> Event a -> Bool) -> [Event a] -> [Event [a]]
collectEventsBy Event a -> Event a -> Bool
f [Event a]
es = [Maybe (Event [a])] -> [Event [a]]
forall a. [Maybe a] -> [a]
remNo ([Maybe (Event [a])] -> [Event [a]])
-> [Maybe (Event [a])] -> [Event [a]]
forall a b. (a -> b) -> a -> b
$ ([Event a] -> Maybe (Event [a]))
-> [[Event a]] -> [Maybe (Event [a])]
forall a b. (a -> b) -> [a] -> [b]
map [Event a] -> Maybe (Event [a])
forall a. [Event a] -> Maybe (Event [a])
collectEvent ((Event a -> Event a -> Bool) -> [Event a] -> [[Event a]]
forall a.
Eq a =>
(Event a -> Event a -> Bool) -> [Event a] -> [[Event a]]
groupEventsBy Event a -> Event a -> Bool
f [Event a]
es)
                     where
                     remNo :: [Maybe a] -> [a]
remNo [] = []
                     remNo (Maybe a
Nothing:[Maybe a]
cs) = [Maybe a] -> [a]
remNo [Maybe a]
cs
                     remNo ((Just a
c):[Maybe a]
cs) = a
c a -> [a] -> [a]
forall a. a -> [a] -> [a]
: ([Maybe a] -> [a]
remNo [Maybe a]
cs)

-- | collects all events satisfying the same constraint into a list
collectBy :: Eq a => (Event a -> Event a -> Bool) -> Pattern a -> Pattern [a]
collectBy :: forall a.
Eq a =>
(Event a -> Event a -> Bool) -> Pattern a -> Pattern [a]
collectBy Event a -> Event a -> Bool
f = ([Event a] -> [Event [a]]) -> Pattern a -> Pattern [a]
forall a b. ([Event a] -> [Event b]) -> Pattern a -> Pattern b
withEvents ((Event a -> Event a -> Bool) -> [Event a] -> [Event [a]]
forall a.
Eq a =>
(Event a -> Event a -> Bool) -> [Event a] -> [Event [a]]
collectEventsBy Event a -> Event a -> Bool
f)

-- | collects all events occuring at the exact same time into a list
collect :: Eq a => Pattern a -> Pattern [a]
collect :: forall a. Eq a => Pattern a -> Pattern [a]
collect = (Event a -> Event a -> Bool) -> Pattern a -> Pattern [a]
forall a.
Eq a =>
(Event a -> Event a -> Bool) -> Pattern a -> Pattern [a]
collectBy Event a -> Event a -> Bool
forall a. Event a -> Event a -> Bool
sameDur

uncollectEvent :: Event [a] -> [Event a]
uncollectEvent :: forall a. Event [a] -> [Event a]
uncollectEvent Event [a]
e = [Event [a]
e {value = (value e)!!i, context = resolveContext i (context e)} | Int
i <-[Int
0..[a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Event [a] -> [a]
forall a b. EventF a b -> b
value Event [a]
e) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]]
               where resolveContext :: Int -> Context -> Context
resolveContext Int
i (Context [((Int, Int), (Int, Int))]
xs) = case [((Int, Int), (Int, Int))] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [((Int, Int), (Int, Int))]
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i of
                                                                  Bool
True -> [((Int, Int), (Int, Int))] -> Context
Context []
                                                                  Bool
False -> [((Int, Int), (Int, Int))] -> Context
Context [[((Int, Int), (Int, Int))]
xs[((Int, Int), (Int, Int))] -> Int -> ((Int, Int), (Int, Int))
forall a. HasCallStack => [a] -> Int -> a
!!Int
i]

uncollectEvents :: [Event [a]] -> [Event a]
uncollectEvents :: forall a. [Event [a]] -> [Event a]
uncollectEvents = (Event [a] -> [Event a]) -> [Event [a]] -> [Event a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Event [a] -> [Event a]
forall a. Event [a] -> [Event a]
uncollectEvent

-- | merges all values in a list into one pattern by stacking the values
uncollect :: Pattern [a] -> Pattern a
uncollect :: forall a. Pattern [a] -> Pattern a
uncollect = ([Event [a]] -> [Event a]) -> Pattern [a] -> Pattern a
forall a b. ([Event a] -> [Event b]) -> Pattern a -> Pattern b
withEvents [Event [a]] -> [Event a]
forall a. [Event [a]] -> [Event a]
uncollectEvents