{-# 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 :: Arc
arc = EventF Arc (a -> b) -> Arc
forall a. Event a -> Arc
wholeOrPart EventF Arc (a -> b)
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 :: Arc
arc = 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 :: Arc
arc = 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 :: Arc
arc = 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 :: Arc
arc = EventF Arc (a -> b) -> Arc
forall a. Event a -> Arc
wholeOrPart EventF Arc (a -> b)
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 :: Arc
arc = EventF Arc a -> Arc
forall a. Event a -> Arc
wholeOrPart EventF Arc a
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

-- 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 :: State -> [Event a]
query = State -> [Event a]
q}
  where q :: State -> [Event a]
q State
st = (EventF Arc (Pattern a) -> [Event a])
-> [EventF Arc (Pattern a)] -> [Event a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
          (\(Event Context
c Maybe Arc
w Arc
p Pattern a
v) ->
             (Event a -> Maybe (Event a)) -> [Event a] -> [Event a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Context -> Maybe Arc -> Arc -> Event a -> Maybe (Event a)
forall {b}.
Context -> Maybe Arc -> Arc -> EventF Arc b -> Maybe (EventF Arc b)
munge Context
c Maybe Arc
w Arc
p) ([Event a] -> [Event a]) -> [Event a] -> [Event a]
forall a b. (a -> b) -> a -> b
$ Pattern a -> State -> [Event a]
forall a. Pattern a -> State -> [Event a]
query Pattern a
v State
st {arc :: Arc
arc = 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 :: State -> [Event a]
query = State -> [Event a]
q}
  where q :: State -> [Event a]
q State
st = (EventF Arc (Pattern a) -> [Event a])
-> [EventF Arc (Pattern a)] -> [Event a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
               (\(Event Context
oc Maybe Arc
_ Arc
op Pattern a
v) -> (Event a -> Maybe (Event a)) -> [Event a] -> [Event a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Context -> Event a -> Maybe (Event a)
forall {b}. Context -> EventF Arc b -> Maybe (EventF Arc b)
munge Context
oc) ([Event a] -> [Event a]) -> [Event a] -> [Event a]
forall a b. (a -> b) -> a -> b
$ Pattern a -> State -> [Event a]
forall a. Pattern a -> State -> [Event a]
query Pattern a
v State
st {arc :: Arc
arc = 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 :: State -> [Event a]
query = State -> [Event a]
q}
  where q :: State -> [Event a]
q State
st = (EventF Arc (Pattern a) -> [Event a])
-> [EventF Arc (Pattern a)] -> [Event a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
          (\EventF Arc (Pattern a)
e ->
             (Event a -> Maybe (Event a)) -> [Event a] -> [Event a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Context -> Maybe Arc -> Arc -> Event a -> Maybe (Event 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)) ([Event a] -> [Event a]) -> [Event a] -> [Event a]
forall a b. (a -> b) -> a -> b
$ Pattern a -> State -> [Event 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 :: Arc
arc = Rational -> Arc
forall a. a -> ArcF a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Arc -> Rational
forall a. ArcF a -> a
start (Arc -> Rational) -> Arc -> Rational
forall a b. (a -> b) -> a -> b
$ EventF Arc (Pattern a) -> Arc
forall a. Event a -> Arc
wholeOrPart EventF Arc (Pattern a)
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 :: State -> [Event a]
query = State -> [Event a]
q}
  where q :: State -> [Event a]
q State
st = (EventF Arc (Pattern a) -> [Event a])
-> [EventF Arc (Pattern a)] -> [Event 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) ->
             (Event a -> Maybe (Event a)) -> [Event a] -> [Event a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Context -> Maybe Arc -> Arc -> Event a -> Maybe (Event a)
forall {b}.
Context -> Maybe Arc -> Arc -> EventF Arc b -> Maybe (EventF Arc b)
munge Context
c Maybe Arc
w Arc
p) ([Event a] -> [Event a]) -> [Event a] -> [Event a]
forall a b. (a -> b) -> a -> b
$ Pattern a -> State -> [Event 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 :: Arc
arc = 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 -> [Event a]
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 :: Arc
arc = 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 :: State -> [Event a]
query = (Event a -> Event a) -> [Event a] -> [Event a]
forall a b. (a -> b) -> [a] -> [b]
map (\(Event Context
c Maybe Arc
w Arc
p a
e) -> Context -> Maybe Arc -> Arc -> a -> Event 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) ([Event a] -> [Event a])
-> (State -> [Event a]) -> State -> [Event a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern a -> State -> [Event a]
forall a. Pattern a -> State -> [Event a]
query Pattern a
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 :: State -> [Event a]
query = Pattern a -> State -> [Event a]
forall a. Pattern a -> State -> [Event a]
query Pattern a
pat (State -> [Event a]) -> (State -> State) -> State -> [Event a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(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 :: State -> [Event a]
query = Pattern a -> State -> [Event a]
forall a. Pattern a -> State -> [Event a]
query Pattern a
pat (State -> [Event a]) -> (State -> State) -> State -> [Event a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(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 :: State -> [Event b]
query = (Event a -> Event b) -> [Event a] -> [Event b]
forall a b. (a -> b) -> [a] -> [b]
map Event a -> Event b
f ([Event a] -> [Event b])
-> (State -> [Event a]) -> State -> [Event b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern a -> State -> [Event a]
forall a. Pattern a -> State -> [Event a]
query Pattern a
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 :: State -> [Event b]
query = [Event a] -> [Event b]
f ([Event a] -> [Event b])
-> (State -> [Event a]) -> State -> [Event b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern a -> State -> [Event a]
forall a. Pattern a -> State -> [Event a]
query Pattern a
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
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

-- | Slow down a pattern by the factors in the given time pattern, 'squeezing'
-- the pattern to fit the slot given in the time pattern
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
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 :: State -> [Event a]
query = State -> [Event a]
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 :: Arc
arc = 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
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
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).
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 -> [Event a]
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 :: Arc
arc = Rational -> Arc -> Arc
mirrorArc (Arc -> Rational
midCycle (Arc -> Rational) -> Arc -> Rational
forall a b. (a -> b) -> a -> b
$ State -> Arc
arc State
st) (State -> Arc
arc State
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 :: State -> [Event (Bool, b)]
query = State -> [Event (Bool, b)]
q}
  where q :: State -> [Event (Bool, b)]
q State
st = (EventF Arc b -> Event (Bool, b))
-> [EventF Arc b] -> [Event (Bool, b)]
forall a b. (a -> b) -> [a] -> [b]
map EventF Arc b -> Event (Bool, b)
match ([EventF Arc b] -> [Event (Bool, b)])
-> [EventF Arc b] -> [Event (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 -> Event (Bool, b)
match ex :: EventF Arc b
ex@(Event Context
xContext Maybe Arc
xWhole Arc
xPart b
x) =
              Context -> Maybe Arc -> Arc -> (Bool, b) -> Event (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
arc = Rational -> Rational -> Arc
forall a. a -> a -> ArcF a
Arc Rational
s Rational
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 :: State -> [Event a]
query = (Event a -> Bool) -> [Event a] -> [Event a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> Bool
f (a -> Bool) -> (Event a -> a) -> Event a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event a -> a
forall a b. EventF a b -> b
value) ([Event a] -> [Event a])
-> (State -> [Event a]) -> State -> [Event a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern a -> State -> [Event a]
forall a. Pattern a -> State -> [Event a]
query Pattern a
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 :: State -> [Event a]
query = (Event a -> Bool) -> [Event a] -> [Event a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Rational -> Bool
test (Rational -> Bool) -> (Event a -> Rational) -> Event a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event a -> Rational
forall a. Event a -> Rational
wholeStart) ([Event a] -> [Event a])
-> (State -> [Event a]) -> State -> [Event a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern a -> State -> [Event a]
forall a. Pattern a -> State -> [Event a]
query Pattern a
p}

filterOnsets :: Pattern a -> Pattern a
filterOnsets :: forall a. Pattern a -> Pattern a
filterOnsets Pattern a
p = Pattern a
p {query :: State -> [Event a]
query = (Event a -> Bool) -> [Event a] -> [Event a]
forall a. (a -> Bool) -> [a] -> [a]
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) ([Event a] -> [Event a])
-> (State -> [Event a]) -> State -> [Event a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern a -> State -> [Event a]
forall a. Pattern a -> State -> [Event a]
query (Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
filterDigital Pattern a
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 :: State -> [Event a]
query = (Event a -> Bool) -> [Event a] -> [Event a]
forall a. (a -> Bool) -> [a] -> [a]
filter Event a -> Bool
f ([Event a] -> [Event a])
-> (State -> [Event a]) -> State -> [Event a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern a -> State -> [Event a]
forall a. Pattern a -> State -> [Event a]
query Pattern a
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 :: Arc
arc = 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 :: Context
context = 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 :: Context
context = Context -> Context
f (Context -> Context) -> Context -> Context
forall a b. (a -> b) -> a -> b
$ Event a -> Context
forall a b. EventF a b -> Context
context Event a
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 :: Context
context = Context -> Context
f (Context -> Context) -> Context -> Context
forall a b. (a -> b) -> a -> b
$ Event a -> Context
forall a b. EventF a b -> Context
context Event a
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 :: ValueMap
value = ValueMap
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 :: Context
context = Context
con, value :: [a]
value = [a]
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 :: a
value = (Event [a] -> [a]
forall a b. EventF a b -> b
value Event [a]
e)[a] -> Int -> a
forall a. HasCallStack => [a] -> Int -> a
!!Int
i, context :: Context
context = Int -> Context -> Context
resolveContext Int
i (Event [a] -> Context
forall a b. EventF a b -> Context
context Event [a]
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