{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
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, sort)
import Data.Word (Word8)
import Data.Data (Data)
import Data.Typeable (Typeable)
import Data.Fixed (mod')
import Sound.Tidal.Time
data State = State {State -> Arc
arc :: Arc,
State -> ValueMap
controls :: ValueMap
}
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
$cto :: forall a x. Rep (Pattern a) x -> Pattern a
$cfrom :: forall a x. Pattern a -> Rep (Pattern a) x
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
<$ :: forall a b. a -> Pattern b -> Pattern a
$c<$ :: forall a b. a -> Pattern b -> Pattern a
fmap :: forall a b. (a -> b) -> Pattern a -> Pattern b
$cfmap :: forall a b. (a -> b) -> Pattern a -> Pattern b
Functor)
instance NFData a => NFData (Pattern a)
type ControlPattern = Pattern ValueMap
instance Applicative Pattern where
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
<*> :: 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
(<*) :: 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
(*>) :: 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
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 (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 :: 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 {t} {b}.
EventF Arc (t -> b) -> EventF Arc t -> 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})
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 {t} {b}.
EventF Arc (t -> b) -> EventF Arc t -> 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})
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 {t} {b}.
EventF Arc (t -> b) -> EventF Arc t -> 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})
matchX EventF Arc a
_ = String -> [Maybe (Event b)]
forall a. HasCallStack => String -> a
error String
"can't happen"
withFX :: EventF Arc (t -> b) -> EventF Arc t -> Maybe (EventF Arc b)
withFX EventF Arc (t -> b)
ef EventF Arc t
ex = do Maybe Arc
whole' <- Maybe Arc -> Maybe Arc -> Maybe (Maybe Arc)
subMaybeArc (EventF Arc (t -> b) -> Maybe Arc
forall a b. EventF a b -> Maybe a
whole EventF Arc (t -> b)
ef) (EventF Arc t -> Maybe Arc
forall a b. EventF a b -> Maybe a
whole EventF Arc t
ex)
Arc
part' <- Arc -> Arc -> Maybe Arc
subArc (EventF Arc (t -> b) -> Arc
forall a b. EventF a b -> a
part EventF Arc (t -> b)
ef) (EventF Arc t -> Arc
forall a b. EventF a b -> a
part EventF Arc t
ex)
EventF Arc b -> Maybe (EventF Arc b)
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 (t -> b) -> Context
forall a b. EventF a b -> Context
context EventF Arc (t -> b)
ef, EventF Arc t -> Context
forall a b. EventF a b -> Context
context EventF Arc t
ex]) Maybe Arc
whole' Arc
part' (EventF Arc (t -> b) -> t -> b
forall a b. EventF a b -> b
value EventF Arc (t -> b)
ef (t -> b) -> t -> b
forall a b. (a -> b) -> a -> b
$ EventF Arc t -> t
forall a b. EventF a b -> b
value EventF Arc t
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 {t} {b}.
EventF Arc (t -> b) -> EventF Arc t -> 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 (t -> b) -> EventF Arc t -> Maybe (EventF Arc b)
withFX EventF Arc (t -> b)
ef EventF Arc t
ex = do let whole' :: Maybe Arc
whole' = EventF Arc (t -> b) -> Maybe Arc
forall a b. EventF a b -> Maybe a
whole EventF Arc (t -> b)
ef
Arc
part' <- Arc -> Arc -> Maybe Arc
subArc (EventF Arc (t -> b) -> Arc
forall a b. EventF a b -> a
part EventF Arc (t -> b)
ef) (EventF Arc t -> Arc
forall a b. EventF a b -> a
part EventF Arc t
ex)
EventF Arc b -> Maybe (EventF Arc b)
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 (t -> b) -> Context
forall a b. EventF a b -> Context
context EventF Arc (t -> b)
ef, EventF Arc t -> Context
forall a b. EventF a b -> Context
context EventF Arc t
ex]) Maybe Arc
whole' Arc
part' (EventF Arc (t -> b) -> t -> b
forall a b. EventF a b -> b
value EventF Arc (t -> b)
ef (t -> b) -> t -> b
forall a b. (a -> b) -> a -> b
$ EventF Arc t -> t
forall a b. EventF a b -> b
value EventF Arc t
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 {t} {b}.
EventF Arc (t -> b) -> EventF Arc t -> 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 (t -> b) -> EventF Arc t -> Maybe (EventF Arc b)
withFX EventF Arc (t -> b)
ef EventF Arc t
ex = do let whole' :: Maybe Arc
whole' = EventF Arc t -> Maybe Arc
forall a b. EventF a b -> Maybe a
whole EventF Arc t
ex
Arc
part' <- Arc -> Arc -> Maybe Arc
subArc (EventF Arc (t -> b) -> Arc
forall a b. EventF a b -> a
part EventF Arc (t -> b)
ef) (EventF Arc t -> Arc
forall a b. EventF a b -> a
part EventF Arc t
ex)
EventF Arc b -> Maybe (EventF Arc b)
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 (t -> b) -> Context
forall a b. EventF a b -> Context
context EventF Arc (t -> b)
ef, EventF Arc t -> Context
forall a b. EventF a b -> Context
context EventF Arc t
ex]) Maybe Arc
whole' Arc
part' (EventF Arc (t -> b) -> t -> b
forall a b. EventF a b -> b
value EventF Arc (t -> b)
ef (t -> b) -> t -> b
forall a b. (a -> b) -> a -> b
$ EventF Arc t -> t
forall a b. EventF a b -> b
value EventF Arc t
ex))
instance Monad Pattern where
return :: forall a. a -> Pattern a
return = 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)
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 (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')
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 (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)
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 (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 (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')
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
compressArc (Arc -> Arc
cycleArc (Arc -> Arc) -> Arc -> Arc
forall a b. (a -> b) -> a -> b
$ 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 (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)
noOv :: String -> a
noOv :: forall a. String -> a
noOv String
meth = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
meth String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": not supported for patterns"
instance Eq (Pattern a) where
== :: Pattern a -> Pattern a -> Bool
(==) = String -> Pattern a -> Pattern a -> Bool
forall a. String -> a
noOv String
"(==)"
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 (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 (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 = String -> Pattern a -> Pattern a -> Ordering
forall a. String -> a
noOv String
"compare"
<= :: Pattern a -> Pattern a -> Bool
(<=) = String -> Pattern a -> Pattern a -> Bool
forall a. String -> a
noOv String
"(<=)"
instance Num a => Num (Pattern a) where
negate :: Pattern a -> Pattern a
negate = (a -> a) -> Pattern a -> Pattern a
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 (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 (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 (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 (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 (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 (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 (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 (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 = String -> Pattern a -> Int
forall a. String -> a
noOv String
"fromEnum"
enumFrom :: Pattern a -> [Pattern a]
enumFrom = String -> Pattern a -> [Pattern a]
forall a. String -> a
noOv String
"enumFrom"
enumFromThen :: Pattern a -> Pattern a -> [Pattern a]
enumFromThen = String -> Pattern a -> Pattern a -> [Pattern a]
forall a. String -> a
noOv String
"enumFromThen"
enumFromTo :: Pattern a -> Pattern a -> [Pattern a]
enumFromTo = String -> Pattern a -> Pattern a -> [Pattern a]
forall a. String -> a
noOv String
"enumFromTo"
enumFromThenTo :: Pattern a -> Pattern a -> Pattern a -> [Pattern a]
enumFromThenTo = String -> Pattern a -> Pattern a -> Pattern a -> [Pattern a]
forall a. String -> a
noOv String
"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 = String -> Pattern a -> Rational
forall a. String -> a
noOv String
"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 (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 (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 (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 (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 = String -> Pattern a -> Integer
forall a. String -> a
noOv String
"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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 (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 = String -> Pattern a -> (b, Pattern a)
forall a. String -> a
noOv String
"properFraction"
truncate :: forall b. Integral b => Pattern a -> b
truncate = String -> Pattern a -> b
forall a. String -> a
noOv String
"truncate"
round :: forall b. Integral b => Pattern a -> b
round = String -> Pattern a -> b
forall a. String -> a
noOv String
"round"
ceiling :: forall b. Integral b => Pattern a -> b
ceiling = String -> Pattern a -> b
forall a. String -> a
noOv String
"ceiling"
floor :: forall b. Integral b => Pattern a -> b
floor = String -> Pattern a -> b
forall a. String -> a
noOv String
"floor"
instance (RealFloat a) => RealFloat (Pattern a) where
floatRadix :: Pattern a -> Integer
floatRadix = String -> Pattern a -> Integer
forall a. String -> a
noOv String
"floatRadix"
floatDigits :: Pattern a -> Int
floatDigits = String -> Pattern a -> Int
forall a. String -> a
noOv String
"floatDigits"
floatRange :: Pattern a -> (Int, Int)
floatRange = String -> Pattern a -> (Int, Int)
forall a. String -> a
noOv String
"floatRange"
decodeFloat :: Pattern a -> (Integer, Int)
decodeFloat = String -> Pattern a -> (Integer, Int)
forall a. String -> a
noOv String
"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 (f :: * -> *) a. Applicative f => a -> f a
pure Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat
exponent :: Pattern a -> Int
exponent = String -> Pattern a -> Int
forall a. String -> a
noOv String
"exponent"
significand :: Pattern a -> Pattern a
significand = String -> Pattern a -> Pattern a
forall a. String -> a
noOv String
"significand"
scaleFloat :: Int -> Pattern a -> Pattern a
scaleFloat Int
n = (a -> a) -> Pattern a -> Pattern a
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 = String -> Pattern a -> Bool
forall a. String -> a
noOv String
"isNaN"
isInfinite :: Pattern a -> Bool
isInfinite = String -> Pattern a -> Bool
forall a. String -> a
noOv String
"isInfinite"
isDenormalized :: Pattern a -> Bool
isDenormalized = String -> Pattern a -> Bool
forall a. String -> a
noOv String
"isDenormalized"
isNegativeZero :: Pattern a -> Bool
isNegativeZero = String -> Pattern a -> Bool
forall a. String -> a
noOv String
"isNegativeZero"
isIEEE :: Pattern a -> Bool
isIEEE = String -> Pattern a -> Bool
forall a. String -> a
noOv String
"isIEEE"
atan2 :: Pattern a -> Pattern a -> Pattern a
atan2 = (a -> a -> a) -> Pattern a -> Pattern a -> Pattern a
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) -> (String -> String) -> Value -> Value
applyFIS Double -> Double
forall a. Num a => a -> a
negate Int -> Int
forall a. Num a => a -> a
negate String -> String
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 = String -> Value -> ValueMap
forall k a. k -> a -> Map k a
Map.singleton String
"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) -> (String -> String) -> Value -> Value
applyFIS Double -> Double
forall a. Num a => a -> a
signum Int -> Int
forall a. Num a => a -> a
signum String -> String
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) -> (String -> String) -> Value -> Value
applyFIS Double -> Double
forall a. Num a => a -> a
abs Int -> Int
forall a. Num a => a -> a
abs String -> String
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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Double -> Double)
-> (Int -> Int) -> (String -> String) -> Value -> Value
applyFIS Double -> Double
forall a. Fractional a => a -> a
recip Int -> Int
forall a. a -> a
id String -> String
forall a. a -> a
id)
fromRational :: Rational -> ValueMap
fromRational Rational
r = String -> Value -> ValueMap
forall k a. k -> a -> Map k a
Map.singleton String
"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 = String -> ValueMap
forall a. String -> a
noOv String
"pi"
exp :: ValueMap -> ValueMap
exp ValueMap
_ = String -> ValueMap
forall a. String -> a
noOv String
"exp"
log :: ValueMap -> ValueMap
log ValueMap
_ = String -> ValueMap
forall a. String -> a
noOv String
"log"
sin :: ValueMap -> ValueMap
sin ValueMap
_ = String -> ValueMap
forall a. String -> a
noOv String
"sin"
cos :: ValueMap -> ValueMap
cos ValueMap
_ = String -> ValueMap
forall a. String -> a
noOv String
"cos"
asin :: ValueMap -> ValueMap
asin ValueMap
_ = String -> ValueMap
forall a. String -> a
noOv String
"asin"
acos :: ValueMap -> ValueMap
acos ValueMap
_ = String -> ValueMap
forall a. String -> a
noOv String
"acos"
atan :: ValueMap -> ValueMap
atan ValueMap
_ = String -> ValueMap
forall a. String -> a
noOv String
"atan"
sinh :: ValueMap -> ValueMap
sinh ValueMap
_ = String -> ValueMap
forall a. String -> a
noOv String
"sinh"
cosh :: ValueMap -> ValueMap
cosh ValueMap
_ = String -> ValueMap
forall a. String -> a
noOv String
"cosh"
asinh :: ValueMap -> ValueMap
asinh ValueMap
_ = String -> ValueMap
forall a. String -> a
noOv String
"asinh"
acosh :: ValueMap -> ValueMap
acosh ValueMap
_ = String -> ValueMap
forall a. String -> a
noOv String
"acosh"
atanh :: ValueMap -> ValueMap
atanh ValueMap
_ = String -> ValueMap
forall a. String -> a
noOv String
"atanh"
empty :: Pattern a
empty :: forall a. Pattern a
empty = Pattern :: forall a. (State -> [Event a]) -> Pattern a
Pattern {query :: State -> [Event a]
query = [Event a] -> State -> [Event a]
forall a b. a -> b -> a
const []}
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
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)}
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}
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))
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)}
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
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}
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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) Pattern a
pat
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 :: (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
Value -> Maybe a
f String
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 (String -> ValueMap -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
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
extractI :: String -> ControlPattern -> Pattern Int
= (Value -> Maybe Int) -> String -> ControlPattern -> Pattern Int
forall a.
(Value -> Maybe a) -> String -> ControlPattern -> Pattern a
_extract Value -> Maybe Int
getI
extractF :: String -> ControlPattern -> Pattern Double
= (Value -> Maybe Double)
-> String -> ControlPattern -> Pattern Double
forall a.
(Value -> Maybe a) -> String -> ControlPattern -> Pattern a
_extract Value -> Maybe Double
getF
extractS :: String -> ControlPattern -> Pattern String
= (Value -> Maybe String)
-> String -> ControlPattern -> Pattern String
forall a.
(Value -> Maybe a) -> String -> ControlPattern -> Pattern a
_extract Value -> Maybe String
getS
extractB :: String -> ControlPattern -> Pattern Bool
= (Value -> Maybe Bool) -> String -> ControlPattern -> Pattern Bool
forall a.
(Value -> Maybe a) -> String -> ControlPattern -> Pattern a
_extract Value -> Maybe Bool
getB
extractR :: String -> ControlPattern -> Pattern Rational
= (Value -> Maybe Rational)
-> String -> ControlPattern -> Pattern Rational
forall a.
(Value -> Maybe a) -> String -> ControlPattern -> Pattern a
_extract Value -> Maybe Rational
getR
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))
_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
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
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
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)
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}
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}
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)
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 (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 (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 (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
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
deltaMini :: String -> String
deltaMini :: String -> String
deltaMini = Int -> Int -> String -> String
outside Int
0 Int
0
where outside :: Int -> Int -> String -> String
outside :: Int -> Int -> String -> String
outside Int
_ Int
_ [] = []
outside Int
column Int
line (Char
'"':String
xs) = String
"(deltaContext "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
column
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
line
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" \""
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Int -> String -> String
inside (Int
columnInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
line String
xs
outside Int
_ Int
line (Char
'\n':String
xs) = Char
'\n'Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> Int -> String -> String
outside Int
0 (Int
lineInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) String
xs
outside Int
column Int
line (Char
x:String
xs) = Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:Int -> Int -> String -> String
outside (Int
columnInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
line String
xs
inside :: Int -> Int -> String -> String
inside :: Int -> Int -> String -> String
inside Int
_ Int
_ [] = []
inside Int
column Int
line (Char
'"':String
xs) = Char
'"'Char -> String -> String
forall a. a -> [a] -> [a]
:Char
')'Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> Int -> String -> String
outside (Int
columnInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
line String
xs
inside Int
_ Int
line (Char
'\n':String
xs) = Char
'\n'Char -> String -> String
forall a. a -> [a] -> [a]
:Int -> Int -> String -> String
inside Int
0 (Int
lineInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) String
xs
inside Int
column Int
line (Char
x:String
xs) = Char
xChar -> String -> String
forall a. a -> [a] -> [a]
:Int -> Int -> String -> String
inside (Int
columnInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
line String
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
instance Stringy String where
deltaContext :: Int -> Int -> String -> String
deltaContext Int
_ Int
_ = String -> String
forall a. a -> a
id
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
/= :: Context -> Context -> Bool
$c/= :: Context -> Context -> Bool
== :: Context -> Context -> Bool
$c== :: 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
min :: Context -> Context -> Context
$cmin :: Context -> Context -> Context
max :: Context -> Context -> Context
$cmax :: Context -> Context -> Context
>= :: Context -> Context -> Bool
$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
compare :: Context -> Context -> Ordering
$ccompare :: Context -> Context -> Ordering
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
$cto :: forall x. Rep Context x -> Context
$cfrom :: forall x. Context -> Rep Context x
Generic)
instance NFData Context
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
/= :: 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
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
min :: 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
max :: EventF a b -> EventF a b -> EventF a b
$cmax :: forall a b.
(Ord a, Ord b) =>
EventF a b -> EventF a b -> EventF a b
>= :: 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
$c< :: forall a b. (Ord a, Ord b) => EventF a b -> EventF a b -> Bool
compare :: EventF a b -> EventF a b -> Ordering
$ccompare :: forall a b. (Ord a, Ord b) => EventF a b -> EventF a b -> Ordering
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
<$ :: forall a b. a -> EventF a b -> EventF a a
$c<$ :: forall a a b. a -> EventF a b -> EventF a a
fmap :: forall a b. (a -> b) -> EventF a a -> EventF a b
$cfmap :: forall a a b. (a -> b) -> EventF a a -> EventF a b
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
$cto :: forall a b x. Rep (EventF a b) x -> EventF a b
$cfrom :: forall a b x. EventF a b -> Rep (EventF a b) x
Generic)
instance (NFData a, NFData b) => NFData (EventF a b)
type Event a = EventF (ArcF Time) a
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
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)
compareDefrag :: (Ord a) => [Event a] -> [Event a] -> Bool
compareDefrag :: forall a. Ord a => [Event a] -> [Event a] -> Bool
compareDefrag [Event a]
as [Event a]
bs = [Event a] -> [Event a]
forall a. Ord a => [a] -> [a]
sort ([Event a] -> [Event a]
forall a. Eq a => [Event a] -> [Event a]
defragParts [Event a]
as) [Event a] -> [Event a] -> Bool
forall a. Eq a => a -> a -> Bool
== [Event a] -> [Event a]
forall a. Ord a => [a] -> [a]
sort ([Event a] -> [Event a]
forall a. Eq a => [Event a] -> [Event a]
defragParts [Event a]
bs)
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. [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')
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
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
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
eventPartStart :: Event a -> Time
eventPartStart :: forall a. Event a -> Rational
eventPartStart = Arc -> Rational
forall a. ArcF a -> a
start (Arc -> Rational)
-> (EventF Arc a -> Arc) -> EventF Arc a -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventF Arc a -> Arc
forall a b. EventF a b -> a
part
eventPartStop :: Event a -> Time
eventPartStop :: forall a. Event a -> Rational
eventPartStop = Arc -> Rational
forall a. ArcF a -> a
stop (Arc -> Rational)
-> (EventF Arc a -> Arc) -> EventF Arc a -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventF Arc a -> Arc
forall a b. EventF a b -> a
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)
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
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)
| 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)
(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
data Value = VS { Value -> String
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] }
| 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
$cto :: forall x. Rep Value x -> Value
$cfrom :: forall x. Value -> Rep Value x
Generic)
class Valuable a where
toValue :: a -> Value
instance NFData Value
type ValueMap = Map.Map String Value
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 -> DataType
Note -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Note -> m Note
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Note -> m Note
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Note -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Note -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Note -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Note -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Note -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Note -> r
gmapT :: (forall b. Data b => b -> b) -> Note -> Note
$cgmapT :: (forall b. Data b => b -> b) -> Note -> Note
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Note)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Note)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Note)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Note)
dataTypeOf :: Note -> DataType
$cdataTypeOf :: Note -> DataType
toConstr :: Note -> Constr
$ctoConstr :: Note -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Note
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Note
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Note -> c Note
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Note -> c 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
$cto :: forall x. Rep Note x -> Note
$cfrom :: forall x. Note -> Rep Note x
Generic, Note -> Note -> Bool
(Note -> Note -> Bool) -> (Note -> Note -> Bool) -> Eq Note
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Note -> Note -> Bool
$c/= :: Note -> Note -> Bool
== :: Note -> Note -> Bool
$c== :: 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
min :: Note -> Note -> Note
$cmin :: Note -> Note -> Note
max :: Note -> Note -> Note
$cmax :: Note -> Note -> Note
>= :: Note -> Note -> Bool
$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
compare :: Note -> Note -> Ordering
$ccompare :: Note -> Note -> Ordering
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
enumFromThenTo :: Note -> Note -> Note -> [Note]
$cenumFromThenTo :: Note -> Note -> Note -> [Note]
enumFromTo :: Note -> Note -> [Note]
$cenumFromTo :: Note -> Note -> [Note]
enumFromThen :: Note -> Note -> [Note]
$cenumFromThen :: Note -> Note -> [Note]
enumFrom :: Note -> [Note]
$cenumFrom :: Note -> [Note]
fromEnum :: Note -> Int
$cfromEnum :: Note -> Int
toEnum :: Int -> Note
$ctoEnum :: Int -> Note
pred :: Note -> Note
$cpred :: Note -> Note
succ :: Note -> Note
$csucc :: 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
fromInteger :: Integer -> Note
$cfromInteger :: Integer -> Note
signum :: Note -> Note
$csignum :: Note -> Note
abs :: Note -> Note
$cabs :: Note -> Note
negate :: Note -> Note
$cnegate :: Note -> Note
* :: Note -> Note -> Note
$c* :: Note -> Note -> Note
- :: Note -> Note -> Note
$c- :: Note -> Note -> Note
+ :: Note -> Note -> Note
$c+ :: Note -> Note -> 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
fromRational :: Rational -> Note
$cfromRational :: Rational -> Note
recip :: Note -> Note
$crecip :: Note -> Note
/ :: Note -> Note -> Note
$c/ :: Note -> Note -> 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
log1mexp :: Note -> Note
$clog1mexp :: Note -> Note
log1pexp :: Note -> Note
$clog1pexp :: Note -> Note
expm1 :: Note -> Note
$cexpm1 :: Note -> Note
log1p :: Note -> Note
$clog1p :: Note -> Note
atanh :: Note -> Note
$catanh :: Note -> Note
acosh :: Note -> Note
$cacosh :: Note -> Note
asinh :: Note -> Note
$casinh :: Note -> Note
tanh :: Note -> Note
$ctanh :: Note -> Note
cosh :: Note -> Note
$ccosh :: Note -> Note
sinh :: Note -> Note
$csinh :: Note -> Note
atan :: Note -> Note
$catan :: Note -> Note
acos :: Note -> Note
$cacos :: Note -> Note
asin :: Note -> Note
$casin :: Note -> Note
tan :: Note -> Note
$ctan :: Note -> Note
cos :: Note -> Note
$ccos :: Note -> Note
sin :: Note -> Note
$csin :: Note -> Note
logBase :: Note -> Note -> Note
$clogBase :: Note -> Note -> Note
** :: Note -> Note -> Note
$c** :: Note -> Note -> Note
sqrt :: Note -> Note
$csqrt :: Note -> Note
log :: Note -> Note
$clog :: Note -> Note
exp :: Note -> Note
$cexp :: Note -> Note
pi :: Note
$cpi :: 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
toRational :: Note -> Rational
$ctoRational :: 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
floor :: forall b. Integral b => Note -> b
$cfloor :: forall b. Integral b => Note -> b
ceiling :: forall b. Integral b => Note -> b
$cceiling :: forall b. Integral b => Note -> b
round :: forall b. Integral b => Note -> b
$cround :: forall b. Integral b => Note -> b
truncate :: forall b. Integral b => Note -> b
$ctruncate :: forall b. Integral b => Note -> b
properFraction :: forall b. Integral b => Note -> (b, Note)
$cproperFraction :: forall b. Integral b => Note -> (b, Note)
RealFrac)
instance NFData Note
instance Show Note where
show :: Note -> String
show Note
n = (Double -> String
forall a. Show a => a -> String
show (Double -> String) -> (Note -> Double) -> Note -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note -> Double
unNote (Note -> String) -> Note -> String
forall a b. (a -> b) -> a -> b
$ Note
n) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"n (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
pitchClass String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
octave String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
where
pitchClass :: String
pitchClass = [String]
pcs [String] -> Int -> String
forall a. [a] -> Int -> a
!! Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
noteInt Int
12
octave :: String
octave = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
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 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 :: [String]
pcs = [String
"c", String
"cs", String
"d", String
"ds", String
"e", String
"f", String
"fs", String
"g", String
"gs", String
"a", String
"as", String
"b"]
instance Valuable String where
toValue :: String -> Value
toValue String
a = String -> Value
VS String
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 [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 String
x) == :: Value -> Value -> Bool
== (VS String
y) = String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
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 String
x) (VS String
y) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
x String
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 String
_) Value
_ = Ordering
LT
compare Value
_ (VS String
_) = 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
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
applyFIS :: (Double -> Double) -> (Int -> Int) -> (String -> String) -> Value -> Value
applyFIS :: (Double -> Double)
-> (Int -> Int) -> (String -> String) -> Value -> Value
applyFIS Double -> Double
f Int -> Int
_ String -> String
_ (VF Double
f') = Double -> Value
VF (Double -> Double
f Double
f')
applyFIS Double -> Double
f Int -> Int
_ String -> String
_ (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 String -> String
_ (VI Int
i) = Int -> Value
VI (Int -> Int
f Int
i)
applyFIS Double -> Double
_ Int -> Int
_ String -> String
f (VS String
s) = String -> Value
VS (String -> String
f String
s)
applyFIS Double -> Double
f Int -> Int
f' String -> String
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) -> (String -> String) -> Value -> Value
applyFIS Double -> Double
f Int -> Int
f' String -> String
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
_ String -> String
_ Value
v = Value
v
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 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 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 (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 String
getS (VS String
s) = String -> Maybe String
forall a. a -> Maybe a
Just String
s
getS Value
_ = Maybe String
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 (f :: * -> *) a. Applicative f => a -> f a
pure Value
v