{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, TypeSynonymInstances #-}
{-# LANGUAGE DeriveFunctor #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Sound.Tidal.Pattern where
import Prelude hiding ((<*), (*>))
import Control.Applicative (liftA2)
import Data.Data (Data)
import Data.List (delete, findIndex, sort)
import qualified Data.Map.Strict as Map
import Data.Maybe (isJust, fromJust, catMaybes, mapMaybe)
import Data.Typeable (Typeable)
import Control.DeepSeq (NFData(rnf))
import Data.Word (Word8)
type Time = Rational
sam :: Time -> Time
sam :: Time -> Time
sam = Int -> Time
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Time) -> (Time -> Int) -> Time -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Time -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor :: Time -> Int)
toTime :: Real a => a -> Rational
toTime :: a -> Time
toTime = a -> Time
forall a. Real a => a -> Time
toRational
nextSam :: Time -> Time
nextSam :: Time -> Time
nextSam = (1Time -> Time -> Time
forall a. Num a => a -> a -> a
+) (Time -> Time) -> (Time -> Time) -> Time -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Time
sam
cyclePos :: Time -> Time
cyclePos :: Time -> Time
cyclePos t :: Time
t = Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time -> Time
sam Time
t
data ArcF a = Arc
{ ArcF a -> a
start :: a
, ArcF a -> a
stop :: a
} deriving (ArcF a -> ArcF a -> Bool
(ArcF a -> ArcF a -> Bool)
-> (ArcF a -> ArcF a -> Bool) -> Eq (ArcF a)
forall a. Eq a => ArcF a -> ArcF a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArcF a -> ArcF a -> Bool
$c/= :: forall a. Eq a => ArcF a -> ArcF a -> Bool
== :: ArcF a -> ArcF a -> Bool
$c== :: forall a. Eq a => ArcF a -> ArcF a -> Bool
Eq, Eq (ArcF a)
Eq (ArcF a) =>
(ArcF a -> ArcF a -> Ordering)
-> (ArcF a -> ArcF a -> Bool)
-> (ArcF a -> ArcF a -> Bool)
-> (ArcF a -> ArcF a -> Bool)
-> (ArcF a -> ArcF a -> Bool)
-> (ArcF a -> ArcF a -> ArcF a)
-> (ArcF a -> ArcF a -> ArcF a)
-> Ord (ArcF a)
ArcF a -> ArcF a -> Bool
ArcF a -> ArcF a -> Ordering
ArcF a -> ArcF a -> ArcF a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (ArcF a)
forall a. Ord a => ArcF a -> ArcF a -> Bool
forall a. Ord a => ArcF a -> ArcF a -> Ordering
forall a. Ord a => ArcF a -> ArcF a -> ArcF a
min :: ArcF a -> ArcF a -> ArcF a
$cmin :: forall a. Ord a => ArcF a -> ArcF a -> ArcF a
max :: ArcF a -> ArcF a -> ArcF a
$cmax :: forall a. Ord a => ArcF a -> ArcF a -> ArcF a
>= :: ArcF a -> ArcF a -> Bool
$c>= :: forall a. Ord a => ArcF a -> ArcF a -> Bool
> :: ArcF a -> ArcF a -> Bool
$c> :: forall a. Ord a => ArcF a -> ArcF a -> Bool
<= :: ArcF a -> ArcF a -> Bool
$c<= :: forall a. Ord a => ArcF a -> ArcF a -> Bool
< :: ArcF a -> ArcF a -> Bool
$c< :: forall a. Ord a => ArcF a -> ArcF a -> Bool
compare :: ArcF a -> ArcF a -> Ordering
$ccompare :: forall a. Ord a => ArcF a -> ArcF a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (ArcF a)
Ord, a -> ArcF b -> ArcF a
(a -> b) -> ArcF a -> ArcF b
(forall a b. (a -> b) -> ArcF a -> ArcF b)
-> (forall a b. a -> ArcF b -> ArcF a) -> Functor ArcF
forall a b. a -> ArcF b -> ArcF a
forall a b. (a -> b) -> ArcF a -> ArcF b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ArcF b -> ArcF a
$c<$ :: forall a b. a -> ArcF b -> ArcF a
fmap :: (a -> b) -> ArcF a -> ArcF b
$cfmap :: forall a b. (a -> b) -> ArcF a -> ArcF b
Functor)
type Arc = ArcF Time
instance NFData a =>
NFData (ArcF a) where
rnf :: ArcF a -> ()
rnf (Arc s :: a
s e :: a
e) = a -> ()
forall a. NFData a => a -> ()
rnf a
s () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
e
instance Num a => Num (ArcF a) where
negate :: ArcF a -> ArcF a
negate = (a -> a) -> ArcF a -> ArcF a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
negate
+ :: ArcF a -> ArcF a -> ArcF a
(+) = (a -> a -> a) -> ArcF a -> ArcF a -> ArcF a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(+)
* :: ArcF a -> ArcF a -> ArcF a
(*) = (a -> a -> a) -> ArcF a -> ArcF a -> ArcF a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(*)
fromInteger :: Integer -> ArcF a
fromInteger = a -> ArcF a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> ArcF a) -> (Integer -> a) -> Integer -> ArcF a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger
abs :: ArcF a -> ArcF a
abs = (a -> a) -> ArcF a -> ArcF a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
abs
signum :: ArcF a -> ArcF a
signum = (a -> a) -> ArcF a -> ArcF a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
signum
instance (Fractional a) => Fractional (ArcF a) where
recip :: ArcF a -> ArcF a
recip = (a -> a) -> ArcF a -> ArcF a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Fractional a => a -> a
recip
fromRational :: Time -> ArcF a
fromRational = a -> ArcF a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> ArcF a) -> (Time -> a) -> Time -> ArcF a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> a
forall a. Fractional a => Time -> a
fromRational
sect :: Arc -> Arc -> Arc
sect :: Arc -> Arc -> Arc
sect (Arc s :: Time
s e :: Time
e) (Arc s' :: Time
s' e' :: Time
e') = Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc (Time -> Time -> Time
forall a. Ord a => a -> a -> a
max Time
s Time
s') (Time -> Time -> Time
forall a. Ord a => a -> a -> a
min Time
e Time
e')
hull :: Arc -> Arc -> Arc
hull :: Arc -> Arc -> Arc
hull (Arc s :: Time
s e :: Time
e) (Arc s' :: Time
s' e' :: Time
e') = Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc (Time -> Time -> Time
forall a. Ord a => a -> a -> a
min Time
s Time
s') (Time -> Time -> Time
forall a. Ord a => a -> a -> a
max Time
e Time
e')
subArc :: Arc -> Arc -> Maybe Arc
subArc :: Arc -> Arc -> Maybe Arc
subArc a :: Arc
a@(Arc s :: Time
s e :: Time
e) b :: Arc
b@(Arc s' :: Time
s' e' :: Time
e')
| [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Time
s'' Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
e'', Time
s'' Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
e, Time
s Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
e] = Maybe Arc
forall a. Maybe a
Nothing
| [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Time
s'' Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
e'', Time
s'' Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
e', Time
s' Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
e'] = Maybe Arc
forall a. Maybe a
Nothing
| Time
s'' Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= Time
e'' = Arc -> Maybe Arc
forall a. a -> Maybe a
Just (Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc Time
s'' Time
e'')
| Bool
otherwise = Maybe Arc
forall a. Maybe a
Nothing
where (Arc s'' :: Time
s'' e'' :: Time
e'') = Arc -> Arc -> Arc
sect Arc
a Arc
b
subMaybeArc :: Maybe Arc -> Maybe Arc -> Maybe (Maybe Arc)
subMaybeArc :: Maybe Arc -> Maybe Arc -> Maybe (Maybe Arc)
subMaybeArc (Just a :: Arc
a) (Just b :: Arc
b) = do Arc
sa <- Arc -> Arc -> Maybe Arc
subArc Arc
a Arc
b
Maybe Arc -> Maybe (Maybe Arc)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Arc -> Maybe (Maybe Arc)) -> Maybe Arc -> Maybe (Maybe Arc)
forall a b. (a -> b) -> a -> b
$ Arc -> Maybe Arc
forall a. a -> Maybe a
Just Arc
sa
subMaybeArc _ _ = Maybe Arc -> Maybe (Maybe Arc)
forall a. a -> Maybe a
Just Maybe Arc
forall a. Maybe a
Nothing
instance Applicative ArcF where
pure :: a -> ArcF a
pure t :: a
t = a -> a -> ArcF a
forall a. a -> a -> ArcF a
Arc a
t a
t
<*> :: ArcF (a -> b) -> ArcF a -> ArcF b
(<*>) (Arc sf :: a -> b
sf ef :: a -> b
ef) (Arc sx :: a
sx ex :: a
ex) = b -> b -> ArcF b
forall a. a -> a -> ArcF a
Arc (a -> b
sf a
sx) (a -> b
ef a
ex)
timeToCycleArc :: Time -> Arc
timeToCycleArc :: Time -> Arc
timeToCycleArc t :: Time
t = Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc (Time -> Time
sam Time
t) (Time -> Time
sam Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
+ 1)
cycleArc :: Arc -> Arc
cycleArc :: Arc -> Arc
cycleArc (Arc s :: Time
s e :: Time
e) = Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc (Time -> Time
cyclePos Time
s) (Time -> Time
cyclePos Time
s Time -> Time -> Time
forall a. Num a => a -> a -> a
+ (Time
eTime -> Time -> Time
forall a. Num a => a -> a -> a
-Time
s))
cyclesInArc :: Integral a => Arc -> [a]
cyclesInArc :: Arc -> [a]
cyclesInArc (Arc s :: Time
s e :: Time
e)
| Time
s Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
e = []
| Time
s Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
e = [Time -> a
forall a b. (RealFrac a, Integral b) => a -> b
floor Time
s]
| Bool
otherwise = [Time -> a
forall a b. (RealFrac a, Integral b) => a -> b
floor Time
s .. Time -> a
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Time
ea -> a -> a
forall a. Num a => a -> a -> a
-1]
cycleArcsInArc :: Arc -> [Arc]
cycleArcsInArc :: Arc -> [Arc]
cycleArcsInArc = (Int -> Arc) -> [Int] -> [Arc]
forall a b. (a -> b) -> [a] -> [b]
map (Time -> Arc
timeToCycleArc (Time -> Arc) -> (Int -> Time) -> Int -> Arc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Time
forall a. Real a => a -> Time
toTime :: Int -> Time)) ([Int] -> [Arc]) -> (Arc -> [Int]) -> Arc -> [Arc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arc -> [Int]
forall a. Integral a => Arc -> [a]
cyclesInArc
arcCycles :: Arc -> [Arc]
arcCycles :: Arc -> [Arc]
arcCycles (Arc s :: Time
s e :: Time
e) | Time
s Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
>= Time
e = []
| Time -> Time
sam Time
s Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time -> Time
sam Time
e = [Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc Time
s Time
e]
| Bool
otherwise = Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc Time
s (Time -> Time
nextSam Time
s) Arc -> [Arc] -> [Arc]
forall a. a -> [a] -> [a]
: Arc -> [Arc]
arcCycles (Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc (Time -> Time
nextSam Time
s) Time
e)
arcCyclesZW :: Arc -> [Arc]
arcCyclesZW :: Arc -> [Arc]
arcCyclesZW (Arc s :: Time
s e :: Time
e) | Time
s Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
e = [Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc Time
s Time
e]
| Bool
otherwise = Arc -> [Arc]
arcCycles (Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc Time
s Time
e)
mapCycle :: (Time -> Time) -> Arc -> Arc
mapCycle :: (Time -> Time) -> Arc -> Arc
mapCycle f :: Time -> Time
f (Arc s :: Time
s e :: Time
e) = Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc (Time
sam' Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time -> Time
f (Time
s Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
sam')) (Time
sam' Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time -> Time
f (Time
e Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time
sam'))
where sam' :: Time
sam' = Time -> Time
sam Time
s
isIn :: Arc -> Time -> Bool
isIn :: Arc -> Time -> Bool
isIn (Arc s :: Time
s e :: Time
e) t :: Time
t = Time
t Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
>= Time
s Bool -> Bool -> Bool
&& Time
t Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
e
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
$cp1Ord :: Eq Context
Ord)
instance NFData Context where
rnf :: Context -> ()
rnf (Context c :: [((Int, Int), (Int, Int))]
c) = [((Int, Int), (Int, Int))] -> ()
forall a. NFData a => a -> ()
rnf [((Int, Int), (Int, Int))]
c
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 :: Context -> Pattern a -> Pattern a
setContext c :: Context
c pat :: 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 (\e :: Event a
e -> Event a
e {context :: Context
context = Context
c})) Pattern a
pat
withContext :: (Context -> Context) -> Pattern a -> Pattern a
withContext :: (Context -> Context) -> Pattern a -> Pattern a
withContext f :: Context -> Context
f pat :: 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 (\e :: 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
deltaContext :: Int -> Int -> Pattern a -> Pattern a
deltaContext :: Int -> Int -> Pattern a -> Pattern a
deltaContext column :: Int
column line :: Int
line pat :: 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 (\e :: 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 xs :: [((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 (\((bx :: Int
bx,by :: Int
by), (ex :: Int
ex,ey :: 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
data EventF a b = Event
{ EventF a b -> Context
context :: Context
, EventF a b -> Maybe a
whole :: Maybe a
, EventF a b -> a
part :: a
, 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
$cp1Ord :: forall a b. (Ord a, Ord b) => Eq (EventF a b)
Ord, a -> EventF a b -> EventF a a
(a -> b) -> EventF a a -> EventF a b
(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
<$ :: a -> EventF a b -> EventF a a
$c<$ :: forall a a b. a -> EventF a b -> EventF a a
fmap :: (a -> b) -> EventF a a -> EventF a b
$cfmap :: forall a a b. (a -> b) -> EventF a a -> EventF a b
Functor)
type Event a = EventF (ArcF Time) a
instance (NFData a, NFData b) =>
NFData (EventF a b) where
rnf :: EventF a b -> ()
rnf (Event c :: Context
c w :: Maybe a
w p :: a
p v :: b
v) = Context -> ()
forall a. NFData a => a -> ()
rnf Context
c () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe a -> ()
forall a. NFData a => a -> ()
rnf Maybe a
w () -> () -> ()
forall a b. a -> b -> b
`seq` a -> ()
forall a. NFData a => a -> ()
rnf a
p () -> () -> ()
forall a b. a -> b -> b
`seq` b -> ()
forall a. NFData a => a -> ()
rnf b
v
isAnalog :: Event a -> Bool
isAnalog :: Event a -> Bool
isAnalog (Event {whole :: forall a b. EventF a b -> Maybe a
whole = Maybe Arc
Nothing}) = Bool
True
isAnalog _ = Bool
False
isDigital :: Event a -> Bool
isDigital :: 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 :: Arc -> Event a -> Bool
onsetIn a :: Arc
a e :: Event a
e = Arc -> Time -> Bool
isIn Arc
a (Event a -> Time
forall a. Event a -> Time
wholeStart Event a
e)
compareDefrag :: (Ord a) => [Event a] -> [Event a] -> Bool
compareDefrag :: [Event a] -> [Event a] -> Bool
compareDefrag as :: [Event a]
as bs :: [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 :: [Event a] -> [Event a]
defragParts [] = []
defragParts [e :: Event a
e] = [Event a
e]
defragParts (e :: Event a
e:es :: [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 :: Event a -> Event a -> Bool
isAdjacent e :: Event a
e 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 -> Time
forall a. ArcF a -> a
stop (Event a -> Arc
forall a b. EventF a b -> a
part Event a
e) Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Arc -> Time
forall a. ArcF a -> a
start (Event a -> Arc
forall a b. EventF a b -> a
part Event a
e'))
Bool -> Bool -> Bool
||
(Arc -> Time
forall a. ArcF a -> a
stop (Event a -> Arc
forall a b. EventF a b -> a
part Event a
e') Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Arc -> Time
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 :: Event a -> Arc
wholeOrPart (Event {whole :: forall a b. EventF a b -> Maybe a
whole = Just a :: Arc
a}) = Arc
a
wholeOrPart e :: Event a
e = Event a -> Arc
forall a b. EventF a b -> a
part Event a
e
wholeStart :: Event a -> Time
wholeStart :: Event a -> Time
wholeStart = Arc -> Time
forall a. ArcF a -> a
start (Arc -> Time) -> (Event a -> Arc) -> Event a -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event a -> Arc
forall a. Event a -> Arc
wholeOrPart
wholeStop :: Event a -> Time
wholeStop :: Event a -> Time
wholeStop = Arc -> Time
forall a. ArcF a -> a
stop (Arc -> Time) -> (Event a -> Arc) -> Event a -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event a -> Arc
forall a. Event a -> Arc
wholeOrPart
eventPartStart :: Event a -> Time
eventPartStart :: Event a -> Time
eventPartStart = Arc -> Time
forall a. ArcF a -> a
start (Arc -> Time) -> (Event a -> Arc) -> Event a -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event a -> Arc
forall a b. EventF a b -> a
part
eventPartStop :: Event a -> Time
eventPartStop :: Event a -> Time
eventPartStop = Arc -> Time
forall a. ArcF a -> a
stop (Arc -> Time) -> (Event a -> Arc) -> Event a -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event a -> Arc
forall a b. EventF a b -> a
part
eventPart :: Event a -> Arc
eventPart :: Event a -> Arc
eventPart = Event a -> Arc
forall a b. EventF a b -> a
part
eventValue :: Event a -> a
eventValue :: Event a -> a
eventValue = Event a -> a
forall a b. EventF a b -> b
value
eventHasOnset :: Event a -> Bool
eventHasOnset :: Event a -> Bool
eventHasOnset e :: Event a
e | Event a -> Bool
forall a. Event a -> Bool
isAnalog Event a
e = Bool
False
| Bool
otherwise = Arc -> Time
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) Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Arc -> Time
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 :: (((Time, Time), (Time, Time)), a) -> Event a
toEvent (((ws :: Time
ws, we :: Time
we), (ps :: Time
ps, pe :: Time
pe)), v :: a
v) = 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 -> Maybe Arc) -> Arc -> Maybe Arc
forall a b. (a -> b) -> a -> b
$ Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc Time
ws Time
we) (Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc Time
ps Time
pe) a
v
data State = State {State -> Arc
arc :: Arc,
State -> StateMap
controls :: StateMap
}
type Query a = (State -> [Event a])
data Pattern a = Pattern {Pattern a -> Query a
query :: Query a}
data Value = VS { Value -> String
svalue :: String }
| VF { Value -> Double
fvalue :: Double }
| VR { Value -> Time
rvalue :: Rational }
| VI { Value -> Int
ivalue :: Int }
| VB { Value -> Bool
bvalue :: Bool }
| VX { Value -> [Word8]
xvalue :: [Word8] }
deriving (Typeable,Typeable Value
Constr
DataType
Typeable Value =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value -> c Value)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Value)
-> (Value -> Constr)
-> (Value -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Value))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Value))
-> ((forall b. Data b => b -> b) -> Value -> Value)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r)
-> (forall u. (forall d. Data d => d -> u) -> Value -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Value -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Value -> m Value)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value -> m Value)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value -> m Value)
-> Data Value
Value -> Constr
Value -> DataType
(forall b. Data b => b -> b) -> Value -> Value
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value -> c Value
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Value
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) -> Value -> u
forall u. (forall d. Data d => d -> u) -> Value -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Value -> m Value
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value -> m Value
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Value
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value -> c Value
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Value)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Value)
$cVX :: Constr
$cVB :: Constr
$cVI :: Constr
$cVR :: Constr
$cVF :: Constr
$cVS :: Constr
$tValue :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Value -> m Value
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value -> m Value
gmapMp :: (forall d. Data d => d -> m d) -> Value -> m Value
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Value -> m Value
gmapM :: (forall d. Data d => d -> m d) -> Value -> m Value
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Value -> m Value
gmapQi :: Int -> (forall d. Data d => d -> u) -> Value -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Value -> u
gmapQ :: (forall d. Data d => d -> u) -> Value -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Value -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Value -> r
gmapT :: (forall b. Data b => b -> b) -> Value -> Value
$cgmapT :: (forall b. Data b => b -> b) -> Value -> Value
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Value)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Value)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Value)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Value)
dataTypeOf :: Value -> DataType
$cdataTypeOf :: Value -> DataType
toConstr :: Value -> Constr
$ctoConstr :: Value -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Value
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Value
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value -> c Value
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Value -> c Value
$cp1Data :: Typeable Value
Data)
class Valuable a where
toValue :: a -> Value
instance NFData Value where
rnf :: Value -> ()
rnf (VS s :: String
s) = String -> ()
forall a. NFData a => a -> ()
rnf String
s
rnf (VF f :: Double
f) = Double -> ()
forall a. NFData a => a -> ()
rnf Double
f
rnf (VR r :: Time
r) = Time -> ()
forall a. NFData a => a -> ()
rnf Time
r
rnf (VI i :: Int
i) = Int -> ()
forall a. NFData a => a -> ()
rnf Int
i
rnf (VB b :: Bool
b) = Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
b
rnf (VX xs :: [Word8]
xs) = [Word8] -> ()
forall a. NFData a => a -> ()
rnf [Word8]
xs
instance Valuable String where
toValue :: String -> Value
toValue = String -> Value
VS
instance Valuable Double where
toValue :: Double -> Value
toValue a :: Double
a = Double -> Value
VF Double
a
instance Valuable Rational where
toValue :: Time -> Value
toValue a :: Time
a = Time -> Value
VR Time
a
instance Valuable Int where
toValue :: Int -> Value
toValue a :: Int
a = Int -> Value
VI Int
a
instance Valuable Bool where
toValue :: Bool -> Value
toValue a :: Bool
a = Bool -> Value
VB Bool
a
instance Valuable [Word8] where
toValue :: [Word8] -> Value
toValue a :: [Word8]
a = [Word8] -> Value
VX [Word8]
a
instance Eq Value where
(VS x :: String
x) == :: Value -> Value -> Bool
== (VS y :: String
y) = String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
y
(VB x :: Bool
x) == (VB y :: Bool
y) = Bool
x Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
y
(VF x :: Double
x) == (VF y :: Double
y) = Double
x Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
y
(VI x :: Int
x) == (VI y :: Int
y) = Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y
(VR x :: Time
x) == (VR y :: Time
y) = Time
x Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
y
(VX x :: [Word8]
x) == (VX y :: [Word8]
y) = [Word8]
x [Word8] -> [Word8] -> Bool
forall a. Eq a => a -> a -> Bool
== [Word8]
y
(VF x :: Double
x) == (VI y :: 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 y :: Int
y) == (VF x :: 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 x :: Double
x) == (VR y :: Time
y) = (Double -> Time
forall a. Real a => a -> Time
toRational Double
x) Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
y
(VR y :: Time
y) == (VF x :: Double
x) = (Double -> Time
forall a. Real a => a -> Time
toRational Double
x) Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
y
(VI x :: Int
x) == (VR y :: Time
y) = (Int -> Time
forall a. Real a => a -> Time
toRational Int
x) Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
y
(VR y :: Time
y) == (VI x :: Int
x) = (Int -> Time
forall a. Real a => a -> Time
toRational Int
x) Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
y
_ == _ = Bool
False
instance Ord Value where
compare :: Value -> Value -> Ordering
compare (VS x :: String
x) (VS y :: String
y) = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
x String
y
compare (VB x :: Bool
x) (VB y :: Bool
y) = Bool -> Bool -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Bool
x Bool
y
compare (VF x :: Double
x) (VF y :: Double
y) = Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
x Double
y
compare (VI x :: Int
x) (VI y :: Int
y) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
x Int
y
compare (VR x :: Time
x) (VR y :: Time
y) = Time -> Time -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Time
x Time
y
compare (VX x :: [Word8]
x) (VX y :: [Word8]
y) = [Word8] -> [Word8] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [Word8]
x [Word8]
y
compare (VS _) _ = Ordering
LT
compare _ (VS _) = Ordering
GT
compare (VB _) _ = Ordering
LT
compare _ (VB _) = Ordering
GT
compare (VX _) _ = Ordering
LT
compare _ (VX _) = Ordering
GT
compare (VF x :: Double
x) (VI y :: 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 x :: Int
x) (VF y :: 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 x :: Time
x) (VI y :: Int
y) = Time -> Time -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Time
x (Int -> Time
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y)
compare (VI x :: Int
x) (VR y :: Time
y) = Time -> Time -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Time
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x) Time
y
compare (VF x :: Double
x) (VR y :: Time
y) = Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Double
x (Time -> Double
forall a. Fractional a => Time -> a
fromRational Time
y)
compare (VR x :: Time
x) (VF y :: Double
y) = Double -> Double -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Time -> Double
forall a. Fractional a => Time -> a
fromRational Time
x) Double
y
type StateMap = Map.Map String (Pattern Value)
type ControlMap = Map.Map String Value
type ControlPattern = Pattern ControlMap
instance NFData a =>
NFData (Pattern a) where
rnf :: Pattern a -> ()
rnf (Pattern q :: Query a
q) = Query a -> ()
forall a. NFData a => a -> ()
rnf (Query a -> ()) -> Query a -> ()
forall a b. (a -> b) -> a -> b
$ \s :: State
s -> Query a
q State
s
instance Functor Pattern where
fmap :: (a -> b) -> Pattern a -> Pattern b
fmap f :: a -> b
f p :: Pattern a
p = Pattern a
p {query :: Query b
query = (EventF Arc a -> EventF Arc b) -> [EventF Arc a] -> [EventF Arc b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> EventF Arc a -> EventF Arc b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) ([EventF Arc a] -> [EventF Arc b])
-> (State -> [EventF Arc a]) -> Query b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern a -> State -> [EventF Arc a]
forall a. Pattern a -> Query a
query Pattern a
p}
applyPatToPat :: (Maybe Arc -> Maybe Arc -> Maybe (Maybe Arc)) -> Pattern (a -> b) -> Pattern a -> Pattern b
applyPatToPat :: (Maybe Arc -> Maybe Arc -> Maybe (Maybe Arc))
-> Pattern (a -> b) -> Pattern a -> Pattern b
applyPatToPat combineWholes :: Maybe Arc -> Maybe Arc -> Maybe (Maybe Arc)
combineWholes pf :: Pattern (a -> b)
pf px :: Pattern a
px = Query b -> Pattern b
forall a. Query a -> Pattern a
Pattern Query b
q
where q :: Query b
q st :: State
st = [Maybe (EventF Arc b)] -> [EventF Arc b]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (EventF Arc b)] -> [EventF Arc b])
-> [Maybe (EventF Arc b)] -> [EventF Arc b]
forall a b. (a -> b) -> a -> b
$ (EventF Arc (a -> b) -> [Maybe (EventF Arc b)])
-> [EventF Arc (a -> b)] -> [Maybe (EventF Arc b)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap EventF Arc (a -> b) -> [Maybe (EventF Arc b)]
forall b. EventF Arc (a -> b) -> [Maybe (EventF Arc b)]
match ([EventF Arc (a -> b)] -> [Maybe (EventF Arc b)])
-> [EventF Arc (a -> b)] -> [Maybe (EventF Arc b)]
forall a b. (a -> b) -> a -> b
$ Pattern (a -> b) -> Query (a -> b)
forall a. Pattern a -> Query 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 c :: [((Int, Int), (Int, Int))]
c) _ fPart :: Arc
fPart f :: 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 c' :: [((Int, Int), (Int, Int))]
c') _ xPart :: Arc
xPart x :: 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 -> Query a
forall a. Pattern a -> Query a
query Pattern a
px Query a -> Query 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)})
instance Applicative Pattern where
pure :: a -> Pattern a
pure v :: a
v = Query a -> Pattern a
forall a. Query a -> Pattern a
Pattern (Query a -> Pattern a) -> Query a -> Pattern a
forall a b. (a -> b) -> a -> b
$ \(State a :: Arc
a _) ->
(Arc -> EventF Arc a) -> [Arc] -> [EventF Arc a]
forall a b. (a -> b) -> [a] -> [b]
map (\a' :: Arc
a' -> 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
a') (Arc -> Arc -> Arc
sect Arc
a Arc
a') a
v) ([Arc] -> [EventF Arc a]) -> [Arc] -> [EventF Arc a]
forall a b. (a -> b) -> a -> b
$ Arc -> [Arc]
cycleArcsInArc Arc
a
<*> :: 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
applyPatToPatBoth :: Pattern (a -> b) -> Pattern a -> Pattern b
applyPatToPatBoth :: Pattern (a -> b) -> Pattern a -> Pattern b
applyPatToPatBoth pf :: Pattern (a -> b)
pf px :: Pattern a
px = Query b -> Pattern b
forall a. Query a -> Pattern a
Pattern Query b
q
where q :: Query b
q st :: State
st = [Maybe (EventF Arc b)] -> [EventF Arc b]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (EventF Arc b)] -> [EventF Arc b])
-> [Maybe (EventF Arc b)] -> [EventF Arc b]
forall a b. (a -> b) -> a -> b
$ ((EventF Arc (a -> b) -> [Maybe (EventF Arc b)])
-> [EventF Arc (a -> b)] -> [Maybe (EventF Arc b)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap EventF Arc (a -> b) -> [Maybe (EventF Arc b)]
forall b. EventF Arc (a -> b) -> [Maybe (EventF Arc b)]
match ([EventF Arc (a -> b)] -> [Maybe (EventF Arc b)])
-> [EventF Arc (a -> b)] -> [Maybe (EventF Arc b)]
forall a b. (a -> b) -> a -> b
$ Pattern (a -> b) -> Query (a -> b)
forall a. Pattern a -> Query a
query Pattern (a -> b)
pf State
st) [Maybe (EventF Arc b)]
-> [Maybe (EventF Arc b)] -> [Maybe (EventF Arc b)]
forall a. [a] -> [a] -> [a]
++ ((EventF Arc a -> [Maybe (EventF Arc b)])
-> [EventF Arc a] -> [Maybe (EventF Arc b)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap EventF Arc a -> [Maybe (EventF Arc b)]
matchX ([EventF Arc a] -> [Maybe (EventF Arc b)])
-> [EventF Arc a] -> [Maybe (EventF Arc b)]
forall a b. (a -> b) -> a -> b
$ Pattern a -> Query a
forall a. Pattern a -> Query 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 _ Nothing fPart :: Arc
fPart _) = (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 -> Query a
forall a. Pattern a -> Query a
query Pattern a
px Query a -> Query a
forall a b. (a -> b) -> a -> b
$ State
st {arc :: Arc
arc = Arc
fPart})
match ef :: EventF Arc (a -> b)
ef@(Event _ (Just fWhole :: Arc
fWhole) _ _) = (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 -> Query a
forall a. Pattern a -> Query a
query (Pattern a -> Pattern a
forall a. Pattern a -> Pattern a
filterDigital Pattern a
px) Query a -> Query a
forall a b. (a -> b) -> a -> b
$ State
st {arc :: Arc
arc = Arc
fWhole})
matchX :: EventF Arc a -> [Maybe (EventF Arc b)]
matchX ex :: EventF Arc a
ex@(Event _ Nothing fPart :: Arc
fPart _) = (EventF Arc (a -> b) -> Maybe (EventF Arc b))
-> [EventF Arc (a -> b)] -> [Maybe (EventF Arc b)]
forall a b. (a -> b) -> [a] -> [b]
map (\ef :: EventF Arc (a -> b)
ef -> 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 EventF Arc a
ex) (Pattern (a -> b) -> Query (a -> b)
forall a. Pattern a -> Query a
query (Pattern (a -> b) -> Pattern (a -> b)
forall a. Pattern a -> Pattern a
filterDigital Pattern (a -> b)
pf) Query (a -> b) -> Query (a -> b)
forall a b. (a -> b) -> a -> b
$ State
st {arc :: Arc
arc = Arc
fPart})
matchX _ = String -> [Maybe (EventF Arc b)]
forall a. HasCallStack => String -> a
error "can't happen"
withFX :: EventF Arc (t -> b) -> EventF Arc t -> Maybe (EventF Arc b)
withFX ef :: EventF Arc (t -> b)
ef ex :: 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 :: Pattern (a -> b) -> Pattern a -> Pattern b
applyPatToPatLeft pf :: Pattern (a -> b)
pf px :: Pattern a
px = Query b -> Pattern b
forall a. Query a -> Pattern a
Pattern Query b
q
where q :: Query b
q st :: State
st = [Maybe (EventF Arc b)] -> [EventF Arc b]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (EventF Arc b)] -> [EventF Arc b])
-> [Maybe (EventF Arc b)] -> [EventF Arc b]
forall a b. (a -> b) -> a -> b
$ ((EventF Arc (a -> b) -> [Maybe (EventF Arc b)])
-> [EventF Arc (a -> b)] -> [Maybe (EventF Arc b)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap EventF Arc (a -> b) -> [Maybe (EventF Arc b)]
forall b. EventF Arc (a -> b) -> [Maybe (EventF Arc b)]
match ([EventF Arc (a -> b)] -> [Maybe (EventF Arc b)])
-> [EventF Arc (a -> b)] -> [Maybe (EventF Arc b)]
forall a b. (a -> b) -> a -> b
$ Pattern (a -> b) -> Query (a -> b)
forall a. Pattern a -> Query 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 = (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 -> Query a
forall a. Pattern a -> Query a
query Pattern a
px Query a -> Query 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 ef :: EventF Arc (t -> b)
ef ex :: 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 :: Pattern (a -> b) -> Pattern a -> Pattern b
applyPatToPatRight pf :: Pattern (a -> b)
pf px :: Pattern a
px = Query b -> Pattern b
forall a. Query a -> Pattern a
Pattern Query b
q
where q :: Query b
q st :: State
st = [Maybe (EventF Arc b)] -> [EventF Arc b]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (EventF Arc b)] -> [EventF Arc b])
-> [Maybe (EventF Arc b)] -> [EventF Arc b]
forall a b. (a -> b) -> a -> b
$ ((EventF Arc a -> [Maybe (EventF Arc b)])
-> [EventF Arc a] -> [Maybe (EventF Arc b)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap EventF Arc a -> [Maybe (EventF Arc b)]
match ([EventF Arc a] -> [Maybe (EventF Arc b)])
-> [EventF Arc a] -> [Maybe (EventF Arc b)]
forall a b. (a -> b) -> a -> b
$ Pattern a -> Query a
forall a. Pattern a -> Query a
query Pattern a
px State
st)
where
match :: EventF Arc a -> [Maybe (EventF Arc b)]
match ex :: EventF Arc a
ex = (EventF Arc (a -> b) -> Maybe (EventF Arc b))
-> [EventF Arc (a -> b)] -> [Maybe (EventF Arc b)]
forall a b. (a -> b) -> [a] -> [b]
map (\ef :: EventF Arc (a -> b)
ef -> 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 EventF Arc a
ex) (Pattern (a -> b) -> Query (a -> b)
forall a. Pattern a -> Query a
query Pattern (a -> b)
pf Query (a -> b) -> Query (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 (b -> b) -> EventF Arc b -> Maybe (EventF Arc b)
withFX ef :: EventF Arc (b -> b)
ef ex :: EventF Arc b
ex = do let whole' :: Maybe Arc
whole' = EventF Arc b -> Maybe Arc
forall a b. EventF a b -> Maybe a
whole EventF Arc b
ex
Arc
part' <- Arc -> Arc -> Maybe Arc
subArc (EventF Arc (b -> b) -> Arc
forall a b. EventF a b -> a
part EventF Arc (b -> b)
ef) (EventF Arc b -> Arc
forall a b. EventF a b -> a
part EventF Arc b
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 (b -> b) -> Context
forall a b. EventF a b -> Context
context EventF Arc (b -> b)
ef, EventF Arc b -> Context
forall a b. EventF a b -> Context
context EventF Arc b
ex]) Maybe Arc
whole' Arc
part' (EventF Arc (b -> b) -> b -> b
forall a b. EventF a b -> b
value EventF Arc (b -> b)
ef (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ EventF Arc b -> b
forall a b. EventF a b -> b
value EventF Arc b
ex))
(<*) :: Pattern (a -> b) -> Pattern a -> Pattern 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
*> :: 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 <*, *>
instance Monad Pattern where
return :: a -> Pattern a
return = a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
p :: Pattern a
p >>= :: Pattern a -> (a -> Pattern b) -> Pattern b
>>= f :: 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 :: Pattern (Pattern a) -> Pattern a
unwrap pp :: Pattern (Pattern a)
pp = Pattern (Pattern a)
pp {query :: Query a
query = Query a
q}
where q :: Query a
q st :: State
st = (EventF Arc (Pattern a) -> [EventF Arc a])
-> [EventF Arc (Pattern a)] -> [EventF Arc a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
(\(Event c :: Context
c w :: Maybe Arc
w p :: Arc
p v :: Pattern a
v) ->
(EventF Arc a -> Maybe (EventF Arc a))
-> [EventF Arc a] -> [EventF Arc a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Context -> Maybe Arc -> Arc -> EventF Arc a -> Maybe (EventF Arc a)
forall b.
Context -> Maybe Arc -> Arc -> EventF Arc b -> Maybe (EventF Arc b)
munge Context
c Maybe Arc
w Arc
p) ([EventF Arc a] -> [EventF Arc a])
-> [EventF Arc a] -> [EventF Arc a]
forall a b. (a -> b) -> a -> b
$ Pattern a -> Query a
forall a. Pattern a -> Query a
query Pattern a
v State
st {arc :: Arc
arc = Arc
p})
(Pattern (Pattern a) -> Query (Pattern a)
forall a. Pattern a -> Query a
query Pattern (Pattern a)
pp State
st)
munge :: Context -> Maybe Arc -> Arc -> EventF Arc b -> Maybe (EventF Arc b)
munge oc :: Context
oc ow :: Maybe Arc
ow op :: Arc
op (Event ic :: Context
ic iw :: Maybe Arc
iw ip :: Arc
ip v' :: 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 :: Pattern (Pattern a) -> Pattern a
innerJoin pp :: Pattern (Pattern a)
pp = Pattern (Pattern a)
pp {query :: Query a
query = Query a
q}
where q :: Query a
q st :: State
st = (EventF Arc (Pattern a) -> [EventF Arc a])
-> [EventF Arc (Pattern a)] -> [EventF Arc a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
(\(Event oc :: Context
oc _ op :: Arc
op v :: Pattern a
v) -> (EventF Arc a -> Maybe (EventF Arc a))
-> [EventF Arc a] -> [EventF Arc a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Context -> EventF Arc a -> Maybe (EventF Arc a)
forall b. Context -> EventF Arc b -> Maybe (EventF Arc b)
munge Context
oc) ([EventF Arc a] -> [EventF Arc a])
-> [EventF Arc a] -> [EventF Arc a]
forall a b. (a -> b) -> a -> b
$ Pattern a -> Query a
forall a. Pattern a -> Query a
query Pattern a
v State
st {arc :: Arc
arc = Arc
op}
)
(Pattern (Pattern a) -> Query (Pattern a)
forall a. Pattern a -> Query a
query Pattern (Pattern a)
pp State
st)
where munge :: Context -> EventF Arc b -> Maybe (EventF Arc b)
munge oc :: Context
oc (Event ic :: Context
ic iw :: Maybe Arc
iw ip :: Arc
ip v :: 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 :: Pattern (Pattern a) -> Pattern a
outerJoin pp :: Pattern (Pattern a)
pp = Pattern (Pattern a)
pp {query :: Query a
query = Query a
q}
where q :: Query a
q st :: State
st = (EventF Arc (Pattern a) -> [EventF Arc a])
-> [EventF Arc (Pattern a)] -> [EventF Arc a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
(\e :: EventF Arc (Pattern a)
e ->
(EventF Arc a -> Maybe (EventF Arc a))
-> [EventF Arc a] -> [EventF Arc a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Context -> Maybe Arc -> Arc -> EventF Arc a -> Maybe (EventF Arc a)
forall a b.
Context -> Maybe Arc -> Arc -> EventF a b -> Maybe (EventF Arc b)
munge (EventF Arc (Pattern a) -> Context
forall a b. EventF a b -> Context
context EventF Arc (Pattern a)
e) (EventF Arc (Pattern a) -> Maybe Arc
forall a b. EventF a b -> Maybe a
whole EventF Arc (Pattern a)
e) (EventF Arc (Pattern a) -> Arc
forall a b. EventF a b -> a
part EventF Arc (Pattern a)
e)) ([EventF Arc a] -> [EventF Arc a])
-> [EventF Arc a] -> [EventF Arc a]
forall a b. (a -> b) -> a -> b
$ Pattern a -> Query a
forall a. Pattern a -> Query 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 = Time -> Arc
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Arc -> Time
forall a. ArcF a -> a
start (Arc -> Time) -> Arc -> Time
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) -> Query (Pattern a)
forall a. Pattern a -> Query a
query Pattern (Pattern a)
pp State
st)
where munge :: Context -> Maybe Arc -> Arc -> EventF a b -> Maybe (EventF Arc b)
munge oc :: Context
oc ow :: Maybe Arc
ow op :: Arc
op (Event ic :: Context
ic _ _ v' :: 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 :: Pattern (Pattern a) -> Pattern a
squeezeJoin pp :: Pattern (Pattern a)
pp = Pattern (Pattern a)
pp {query :: Query a
query = Query a
q}
where q :: Query a
q st :: State
st = (EventF Arc (Pattern a) -> [EventF Arc a])
-> [EventF Arc (Pattern a)] -> [EventF Arc a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
(\e :: EventF Arc (Pattern a)
e@(Event c :: Context
c w :: Maybe Arc
w p :: Arc
p v :: Pattern a
v) ->
(EventF Arc a -> Maybe (EventF Arc a))
-> [EventF Arc a] -> [EventF Arc a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Context -> Maybe Arc -> Arc -> EventF Arc a -> Maybe (EventF Arc a)
forall b.
Context -> Maybe Arc -> Arc -> EventF Arc b -> Maybe (EventF Arc b)
munge Context
c Maybe Arc
w Arc
p) ([EventF Arc a] -> [EventF Arc a])
-> [EventF Arc a] -> [EventF Arc a]
forall a b. (a -> b) -> a -> b
$ Pattern a -> Query a
forall a. Pattern a -> Query 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) -> Query (Pattern a)
forall a. Pattern a -> Query a
query Pattern (Pattern a)
pp State
st)
munge :: Context -> Maybe Arc -> Arc -> EventF Arc b -> Maybe (EventF Arc b)
munge oContext :: Context
oContext oWhole :: Maybe Arc
oWhole oPart :: Arc
oPart (Event iContext :: Context
iContext iWhole :: Maybe Arc
iWhole iPart :: Arc
iPart v :: 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 :: String -> a
noOv meth :: 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]
++ ": not supported for patterns"
class TolerantEq a where
(~==) :: a -> a -> Bool
instance TolerantEq Value where
(VS a :: String
a) ~== :: Value -> Value -> Bool
~== (VS b :: String
b) = String
a String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
b
(VI a :: Int
a) ~== (VI b :: Int
b) = Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
b
(VR a :: Time
a) ~== (VR b :: Time
b) = Time
a Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time
b
(VF a :: Double
a) ~== (VF b :: Double
b) = Double -> Double
forall a. Num a => a -> a
abs (Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
b) Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< 0.000001
_ ~== _ = Bool
False
instance TolerantEq ControlMap where
a :: ControlMap
a ~== :: ControlMap -> ControlMap -> Bool
~== b :: ControlMap
b = (Value -> Value -> Maybe Value)
-> ControlMap -> ControlMap -> ControlMap
forall k a b.
Ord k =>
(a -> b -> Maybe a) -> Map k a -> Map k b -> Map k a
Map.differenceWith (\a' :: Value
a' b' :: Value
b' -> if Value
a' Value -> Value -> Bool
forall a. TolerantEq a => a -> a -> Bool
~== Value
b' then Maybe Value
forall a. Maybe a
Nothing else Value -> Maybe Value
forall a. a -> Maybe a
Just Value
a') ControlMap
a ControlMap
b ControlMap -> ControlMap -> Bool
forall a. Eq a => a -> a -> Bool
== ControlMap
forall k a. Map k a
Map.empty
instance TolerantEq (Event ControlMap) where
(Event _ w :: Maybe Arc
w p :: Arc
p x :: ControlMap
x) ~== :: Event ControlMap -> Event ControlMap -> Bool
~== (Event _ w' :: Maybe Arc
w' p' :: Arc
p' x' :: ControlMap
x') = Maybe Arc
w Maybe Arc -> Maybe Arc -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Arc
w' Bool -> Bool -> Bool
&& Arc
p Arc -> Arc -> Bool
forall a. Eq a => a -> a -> Bool
== Arc
p' Bool -> Bool -> Bool
&& ControlMap
x ControlMap -> ControlMap -> Bool
forall a. TolerantEq a => a -> a -> Bool
~== ControlMap
x'
instance TolerantEq a => TolerantEq [a] where
as :: [a]
as ~== :: [a] -> [a] -> Bool
~== bs :: [a]
bs = ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
as Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
bs) Bool -> Bool -> Bool
&& ((a, a) -> Bool) -> [(a, a)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((a -> a -> Bool) -> (a, a) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> a -> Bool
forall a. TolerantEq a => a -> a -> Bool
(~==)) ([a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
as [a]
bs)
instance Eq (Pattern a) where
== :: Pattern a -> Pattern a -> Bool
(==) = String -> Pattern a -> Pattern a -> Bool
forall a. String -> a
noOv "(==)"
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 "compare"
<= :: Pattern a -> Pattern a -> Bool
(<=) = String -> Pattern a -> Pattern a -> Bool
forall a. String -> a
noOv "(<=)"
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 "fromEnum"
enumFrom :: Pattern a -> [Pattern a]
enumFrom = String -> Pattern a -> [Pattern a]
forall a. String -> a
noOv "enumFrom"
enumFromThen :: Pattern a -> Pattern a -> [Pattern a]
enumFromThen = String -> Pattern a -> Pattern a -> [Pattern a]
forall a. String -> a
noOv "enumFromThen"
enumFromTo :: Pattern a -> Pattern a -> [Pattern a]
enumFromTo = String -> Pattern a -> Pattern a -> [Pattern a]
forall a. String -> a
noOv "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 "enumFromThenTo"
instance (Num a, Ord a) => Real (Pattern a) where
toRational :: Pattern a -> Time
toRational = String -> Pattern a -> Time
forall a. String -> a
noOv "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 "toInteger"
x :: Pattern a
x quotRem :: Pattern a -> Pattern a -> (Pattern a, Pattern a)
`quotRem` y :: 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)
x :: Pattern a
x divMod :: Pattern a -> Pattern a -> (Pattern a, Pattern a)
`divMod` y :: 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 :: Time -> Pattern a
fromRational = a -> Pattern a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Pattern a) -> (Time -> a) -> Time -> Pattern a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> a
forall a. Fractional a => Time -> 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 :: Pattern a -> (b, Pattern a)
properFraction = String -> Pattern a -> (b, Pattern a)
forall a. String -> a
noOv "properFraction"
truncate :: Pattern a -> b
truncate = String -> Pattern a -> b
forall a. String -> a
noOv "truncate"
round :: Pattern a -> b
round = String -> Pattern a -> b
forall a. String -> a
noOv "round"
ceiling :: Pattern a -> b
ceiling = String -> Pattern a -> b
forall a. String -> a
noOv "ceiling"
floor :: Pattern a -> b
floor = String -> Pattern a -> b
forall a. String -> a
noOv "floor"
instance (RealFloat a) => RealFloat (Pattern a) where
floatRadix :: Pattern a -> Integer
floatRadix = String -> Pattern a -> Integer
forall a. String -> a
noOv "floatRadix"
floatDigits :: Pattern a -> Int
floatDigits = String -> Pattern a -> Int
forall a. String -> a
noOv "floatDigits"
floatRange :: Pattern a -> (Int, Int)
floatRange = String -> Pattern a -> (Int, Int)
forall a. String -> a
noOv "floatRange"
decodeFloat :: Pattern a -> (Integer, Int)
decodeFloat = String -> Pattern a -> (Integer, Int)
forall a. String -> a
noOv "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 "exponent"
significand :: Pattern a -> Pattern a
significand = String -> Pattern a -> Pattern a
forall a. String -> a
noOv "significand"
scaleFloat :: Int -> Pattern a -> Pattern a
scaleFloat n :: 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 "isNaN"
isInfinite :: Pattern a -> Bool
isInfinite = String -> Pattern a -> Bool
forall a. String -> a
noOv "isInfinite"
isDenormalized :: Pattern a -> Bool
isDenormalized = String -> Pattern a -> Bool
forall a. String -> a
noOv "isDenormalized"
isNegativeZero :: Pattern a -> Bool
isNegativeZero = String -> Pattern a -> Bool
forall a. String -> a
noOv "isNegativeZero"
isIEEE :: Pattern a -> Bool
isIEEE = String -> Pattern a -> Bool
forall a. String -> a
noOv "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 ControlMap where
negate :: ControlMap -> ControlMap
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) -> ControlMap -> ControlMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
+ :: ControlMap -> ControlMap -> ControlMap
(+) = (Value -> Value -> Value) -> ControlMap -> ControlMap -> ControlMap
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
(+))
* :: ControlMap -> ControlMap -> ControlMap
(*) = (Value -> Value -> Value) -> ControlMap -> ControlMap -> ControlMap
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 -> ControlMap
fromInteger i :: Integer
i = String -> Value -> ControlMap
forall k a. k -> a -> Map k a
Map.singleton "n" (Value -> ControlMap) -> Value -> ControlMap
forall a b. (a -> b) -> a -> b
$ Int -> Value
VI (Int -> Value) -> Int -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i
signum :: ControlMap -> ControlMap
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) -> ControlMap -> ControlMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
abs :: ControlMap -> ControlMap
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) -> ControlMap -> ControlMap
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
instance Fractional ControlMap where
recip :: ControlMap -> ControlMap
recip = (Value -> Value) -> ControlMap -> ControlMap
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 :: Time -> ControlMap
fromRational = String -> Value -> ControlMap
forall k a. k -> a -> Map k a
Map.singleton "speed" (Value -> ControlMap) -> (Time -> Value) -> Time -> ControlMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Value
VF (Double -> Value) -> (Time -> Double) -> Time -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Double
forall a. Fractional a => Time -> a
fromRational
empty :: Pattern a
empty :: Pattern a
empty = Pattern :: forall a. Query a -> Pattern a
Pattern {query :: Query a
query = [Event a] -> Query a
forall a b. a -> b -> a
const []}
queryArc :: Pattern a -> Arc -> [Event a]
queryArc :: Pattern a -> Arc -> [Event a]
queryArc p :: Pattern a
p a :: Arc
a = Pattern a -> Query a
forall a. Pattern a -> Query a
query Pattern a
p Query a -> Query a
forall a b. (a -> b) -> a -> b
$ Arc -> StateMap -> State
State Arc
a StateMap
forall k a. Map k a
Map.empty
splitQueries :: Pattern a -> Pattern a
splitQueries :: Pattern a -> Pattern a
splitQueries p :: Pattern a
p = Pattern a
p {query :: Query a
query = \st :: State
st -> (Arc -> [Event a]) -> [Arc] -> [Event a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\a :: Arc
a -> Pattern a -> Query a
forall a. Pattern a -> Query 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 :: (Arc -> Arc) -> Pattern a -> Pattern a
withResultArc f :: Arc -> Arc
f pat :: Pattern a
pat = Pattern a
pat
{ query :: Query a
query = (EventF Arc a -> EventF Arc a) -> [EventF Arc a] -> [EventF Arc a]
forall a b. (a -> b) -> [a] -> [b]
map (\(Event c :: Context
c w :: Maybe Arc
w p :: Arc
p e :: a
e) -> Context -> Maybe Arc -> Arc -> a -> EventF Arc a
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event Context
c (Arc -> Arc
f (Arc -> Arc) -> Maybe Arc -> Maybe Arc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Arc
w) (Arc -> Arc
f Arc
p) a
e) ([EventF Arc a] -> [EventF Arc a]) -> Query a -> Query a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern a -> Query a
forall a. Pattern a -> Query a
query Pattern a
pat}
withResultTime :: (Time -> Time) -> Pattern a -> Pattern a
withResultTime :: (Time -> Time) -> Pattern a -> Pattern a
withResultTime f :: Time -> Time
f = (Arc -> Arc) -> Pattern a -> Pattern a
forall a. (Arc -> Arc) -> Pattern a -> Pattern a
withResultArc (\(Arc s :: Time
s e :: Time
e) -> Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc (Time -> Time
f Time
s) (Time -> Time
f Time
e))
withQueryArc :: (Arc -> Arc) -> Pattern a -> Pattern a
withQueryArc :: (Arc -> Arc) -> Pattern a -> Pattern a
withQueryArc f :: Arc -> Arc
f p :: Pattern a
p = Pattern a
p {query :: Query a
query = Pattern a -> Query a
forall a. Pattern a -> Query a
query Pattern a
p Query a -> (State -> State) -> Query a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(State a :: Arc
a m :: StateMap
m) -> Arc -> StateMap -> State
State (Arc -> Arc
f Arc
a) StateMap
m)}
withQueryTime :: (Time -> Time) -> Pattern a -> Pattern a
withQueryTime :: (Time -> Time) -> Pattern a -> Pattern a
withQueryTime f :: Time -> Time
f = (Arc -> Arc) -> Pattern a -> Pattern a
forall a. (Arc -> Arc) -> Pattern a -> Pattern a
withQueryArc (\(Arc s :: Time
s e :: Time
e) -> Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc (Time -> Time
f Time
s) (Time -> Time
f Time
e))
withEvent :: (Event a -> Event b) -> Pattern a -> Pattern b
withEvent :: (Event a -> Event b) -> Pattern a -> Pattern b
withEvent f :: Event a -> Event b
f p :: Pattern a
p = Pattern a
p {query :: Query 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]) -> Query b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern a -> State -> [Event a]
forall a. Pattern a -> Query a
query Pattern a
p}
withEvents :: ([Event a] -> [Event b]) -> Pattern a -> Pattern b
withEvents :: ([Event a] -> [Event b]) -> Pattern a -> Pattern b
withEvents f :: [Event a] -> [Event b]
f p :: Pattern a
p = Pattern a
p {query :: Query b
query = [Event a] -> [Event b]
f ([Event a] -> [Event b]) -> (State -> [Event a]) -> Query b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern a -> State -> [Event a]
forall a. Pattern a -> Query a
query Pattern a
p}
withPart :: (Arc -> Arc) -> Pattern a -> Pattern a
withPart :: (Arc -> Arc) -> Pattern a -> Pattern a
withPart f :: Arc -> Arc
f = (Event a -> Event a) -> Pattern a -> Pattern a
forall a b. (Event a -> Event b) -> Pattern a -> Pattern b
withEvent (\(Event c :: Context
c w :: Maybe Arc
w p :: Arc
p v :: 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)
applyFIS :: (Double -> Double) -> (Int -> Int) -> (String -> String) -> Value -> Value
applyFIS :: (Double -> Double)
-> (Int -> Int) -> (String -> String) -> Value -> Value
applyFIS f :: Double -> Double
f _ _ (VF f' :: Double
f') = Double -> Value
VF (Double -> Value) -> Double -> Value
forall a b. (a -> b) -> a -> b
$ Double -> Double
f Double
f'
applyFIS _ f :: Int -> Int
f _ (VI i :: Int
i ) = Int -> Value
VI (Int -> Value) -> Int -> Value
forall a b. (a -> b) -> a -> b
$ Int -> Int
f Int
i
applyFIS _ _ f :: String -> String
f (VS s :: String
s ) = String -> Value
VS (String -> Value) -> String -> Value
forall a b. (a -> b) -> a -> b
$ String -> String
f String
s
applyFIS _ _ _ v :: 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 fInt :: Int -> Int -> Int
fInt _ (VI a :: Int
a) (VI b :: Int
b) = Int -> Value
VI (Int -> Value) -> Int -> Value
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
fInt Int
a Int
b
fNum2 _ fFloat :: Double -> Double -> Double
fFloat (VF a :: Double
a) (VF b :: Double
b) = Double -> Value
VF (Double -> Value) -> Double -> Value
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
fFloat Double
a Double
b
fNum2 _ fFloat :: Double -> Double -> Double
fFloat (VI a :: Int
a) (VF b :: Double
b) = Double -> Value
VF (Double -> Value) -> Double -> Value
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
fFloat (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a) Double
b
fNum2 _ fFloat :: Double -> Double -> Double
fFloat (VF a :: Double
a) (VI b :: Int
b) = Double -> Value
VF (Double -> Value) -> Double -> Value
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double
fFloat Double
a (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b)
fNum2 _ _ x :: Value
x _ = Value
x
getI :: Value -> Maybe Int
getI :: Value -> Maybe Int
getI (VI i :: Int
i) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
getI (VR x :: Time
x) = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Time -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor Time
x
getI (VF x :: 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 _ = Maybe Int
forall a. Maybe a
Nothing
getF :: Value -> Maybe Double
getF :: Value -> Maybe Double
getF (VF f :: Double
f) = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
f
getF (VR x :: Time
x) = Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Time -> Double
forall a. Fractional a => Time -> a
fromRational Time
x
getF (VI x :: 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 _ = Maybe Double
forall a. Maybe a
Nothing
getS :: Value -> Maybe String
getS :: Value -> Maybe String
getS (VS s :: String
s) = String -> Maybe String
forall a. a -> Maybe a
Just String
s
getS _ = Maybe String
forall a. Maybe a
Nothing
getB :: Value -> Maybe Bool
getB :: Value -> Maybe Bool
getB (VB b :: Bool
b) = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
b
getB _ = Maybe Bool
forall a. Maybe a
Nothing
getR :: Value -> Maybe Rational
getR :: Value -> Maybe Time
getR (VR r :: Time
r) = Time -> Maybe Time
forall a. a -> Maybe a
Just Time
r
getR (VF x :: Double
x) = Time -> Maybe Time
forall a. a -> Maybe a
Just (Time -> Maybe Time) -> Time -> Maybe Time
forall a b. (a -> b) -> a -> b
$ Double -> Time
forall a. Real a => a -> Time
toRational Double
x
getR (VI x :: Int
x) = Time -> Maybe Time
forall a. a -> Maybe a
Just (Time -> Maybe Time) -> Time -> Maybe Time
forall a b. (a -> b) -> a -> b
$ Int -> Time
forall a. Real a => a -> Time
toRational Int
x
getR _ = Maybe Time
forall a. Maybe a
Nothing
getBlob :: Value -> Maybe [Word8]
getBlob :: Value -> Maybe [Word8]
getBlob (VX xs :: [Word8]
xs) = [Word8] -> Maybe [Word8]
forall a. a -> Maybe a
Just [Word8]
xs
getBlob _ = Maybe [Word8]
forall a. Maybe a
Nothing
compressArc :: Arc -> Pattern a -> Pattern a
compressArc :: Arc -> Pattern a -> Pattern a
compressArc (Arc s :: Time
s e :: Time
e) p :: Pattern a
p | Time
s Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
e = Pattern a
forall a. Pattern a
empty
| Time
s Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> 1 Bool -> Bool -> Bool
|| Time
e Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> 1 = Pattern a
forall a. Pattern a
empty
| Time
s Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< 0 Bool -> Bool -> Bool
|| Time
e Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = Pattern a
forall a. Pattern a
empty
| Bool
otherwise = Time
s Time -> Pattern a -> Pattern a
forall a. Time -> Pattern a -> Pattern a
`rotR` Time -> Pattern a -> Pattern a
forall a. Time -> Pattern a -> Pattern a
_fastGap (1Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/(Time
eTime -> Time -> Time
forall a. Num a => a -> a -> a
-Time
s)) Pattern a
p
compressArcTo :: Arc -> Pattern a -> Pattern a
compressArcTo :: Arc -> Pattern a -> Pattern a
compressArcTo (Arc s :: Time
s e :: Time
e) = Arc -> Pattern a -> Pattern a
forall a. Arc -> Pattern a -> Pattern a
compressArc (Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc (Time -> Time
cyclePos Time
s) (Time
e Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time -> Time
sam Time
s))
_fastGap :: Time -> Pattern a -> Pattern a
_fastGap :: Time -> Pattern a -> Pattern a
_fastGap 0 _ = Pattern a
forall a. Pattern a
empty
_fastGap r :: Time
r p :: 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 s :: Time
s e :: Time
e) -> Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc (Time -> Time
sam Time
s Time -> Time -> Time
forall a. Num a => a -> a -> a
+ ((Time
s Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time -> Time
sam Time
s)Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/Time
r'))
(Time -> Time
sam Time
s Time -> Time -> Time
forall a. Num a => a -> a -> a
+ ((Time
e Time -> Time -> Time
forall a. Num a => a -> a -> a
- Time -> Time
sam Time
s)Time -> Time -> Time
forall a. Fractional a => a -> a -> a
/Time
r'))
) (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ Pattern a
p {query :: Query a
query = Query a
f}
where r' :: Time
r' = Time -> Time -> Time
forall a. Ord a => a -> a -> a
max Time
r 1
f :: Query a
f st :: State
st@(State a :: Arc
a _) | Arc -> Time
forall a. ArcF a -> a
start Arc
a' Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Time -> Time
nextSam (Arc -> Time
forall a. ArcF a -> a
start Arc
a) = []
| Bool
otherwise = Pattern a -> Query a
forall a. Pattern a -> Query a
query Pattern a
p State
st {arc :: Arc
arc = Arc
a'}
where mungeQuery :: Time -> Time
mungeQuery t :: Time
t = Time -> Time
sam Time
t Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time -> Time -> Time
forall a. Ord a => a -> a -> a
min 1 (Time
r' Time -> Time -> Time
forall a. Num a => a -> a -> a
* Time -> Time
cyclePos Time
t)
a' :: Arc
a' = (\(Arc s :: Time
s e :: Time
e) -> Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc (Time -> Time
mungeQuery Time
s) (Time -> Time
mungeQuery Time
e)) Arc
a
rotL :: Time -> Pattern a -> Pattern a
rotL :: Time -> Pattern a -> Pattern a
rotL t :: Time
t p :: Pattern a
p = (Time -> Time) -> Pattern a -> Pattern a
forall a. (Time -> Time) -> Pattern a -> Pattern a
withResultTime (Time -> Time -> Time
forall a. Num a => a -> a -> a
subtract Time
t) (Pattern a -> Pattern a) -> Pattern a -> Pattern a
forall a b. (a -> b) -> a -> b
$ (Time -> Time) -> Pattern a -> Pattern a
forall a. (Time -> Time) -> Pattern a -> Pattern a
withQueryTime (Time -> Time -> Time
forall a. Num a => a -> a -> a
+ Time
t) Pattern a
p
rotR :: Time -> Pattern a -> Pattern a
rotR :: Time -> Pattern a -> Pattern a
rotR t :: Time
t = Time -> Pattern a -> Pattern a
forall a. Time -> Pattern a -> Pattern a
rotL (Time -> Time
forall a. Num a => a -> a
negate Time
t)
filterValues :: (a -> Bool) -> Pattern a -> Pattern a
filterValues :: (a -> Bool) -> Pattern a -> Pattern a
filterValues f :: a -> Bool
f p :: Pattern a
p = Pattern a
p {query :: Query a
query = (EventF Arc a -> Bool) -> [EventF Arc a] -> [EventF Arc a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a -> Bool
f (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] -> [EventF Arc a]) -> Query a -> Query a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern a -> Query a
forall a. Pattern a -> Query a
query Pattern a
p}
filterJust :: Pattern (Maybe a) -> Pattern a
filterJust :: Pattern (Maybe a) -> Pattern a
filterJust p :: 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 :: (Time -> Bool) -> Pattern a -> Pattern a
filterWhen test :: Time -> Bool
test p :: Pattern a
p = Pattern a
p {query :: Query a
query = (Event a -> Bool) -> [Event a] -> [Event a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Time -> Bool
test (Time -> Bool) -> (Event a -> Time) -> Event a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event a -> Time
forall a. Event a -> Time
wholeStart) ([Event a] -> [Event a]) -> Query a -> Query a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern a -> Query a
forall a. Pattern a -> Query a
query Pattern a
p}
filterOnsets :: Pattern a -> Pattern a
filterOnsets :: Pattern a -> Pattern a
filterOnsets p :: Pattern a
p = Pattern a
p {query :: Query a
query = (Event a -> Bool) -> [Event a] -> [Event a]
forall a. (a -> Bool) -> [a] -> [a]
filter (\e :: Event a
e -> Event a -> Time
forall a. Event a -> Time
eventPartStart Event a
e Time -> Time -> Bool
forall a. Eq a => a -> a -> Bool
== Event a -> Time
forall a. Event a -> Time
wholeStart Event a
e) ([Event a] -> [Event a]) -> Query a -> Query a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern a -> Query a
forall a. Pattern a -> Query 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 :: (Event a -> Bool) -> Pattern a -> Pattern a
filterEvents f :: Event a -> Bool
f p :: Pattern a
p = Pattern a
p {query :: Query a
query = (Event a -> Bool) -> [Event a] -> [Event a]
forall a. (a -> Bool) -> [a] -> [a]
filter Event a -> Bool
f ([Event a] -> [Event a]) -> Query a -> Query a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern a -> Query a
forall a. Pattern a -> Query a
query Pattern a
p}
filterDigital :: Pattern a -> Pattern a
filterDigital :: 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 :: 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 :: Time -> Time -> Pattern a -> Pattern a
playFor s :: Time
s e :: Time
e = (Time -> Bool) -> Pattern a -> Pattern a
forall a. (Time -> Bool) -> Pattern a -> Pattern a
filterWhen (\t :: Time
t -> (Time
t Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
>= Time
s) Bool -> Bool -> Bool
&& (Time
t Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
< Time
e))
tParam :: (t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam :: (t1 -> t2 -> Pattern a) -> Pattern t1 -> t2 -> Pattern a
tParam f :: t1 -> t2 -> Pattern a
f tv :: Pattern t1
tv p :: 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 :: (a -> b -> c -> Pattern d)
-> Pattern a -> Pattern b -> c -> Pattern d
tParam2 f :: a -> b -> c -> Pattern d
f a :: Pattern a
a b :: Pattern b
b p :: 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
$ (\x :: a
x y :: 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 :: (a -> b -> c -> Pattern d -> Pattern e)
-> Pattern a -> Pattern b -> Pattern c -> Pattern d -> Pattern e
tParam3 f :: a -> b -> c -> Pattern d -> Pattern e
f a :: Pattern a
a b :: Pattern b
b c :: Pattern c
c p :: 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
$ (\x :: a
x y :: b
y z :: 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 :: (a -> Pattern b -> Pattern c)
-> Pattern a -> Pattern b -> Pattern c
tParamSqueeze f :: a -> Pattern b -> Pattern c
f tv :: Pattern a
tv p :: 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
matchManyToOne :: (b -> a -> Bool) -> Pattern a -> Pattern b -> Pattern (Bool, b)
matchManyToOne :: (b -> a -> Bool) -> Pattern a -> Pattern b -> Pattern (Bool, b)
matchManyToOne f :: b -> a -> Bool
f pa :: Pattern a
pa pb :: Pattern b
pb = Pattern a
pa {query :: Query (Bool, b)
query = Query (Bool, b)
q}
where q :: Query (Bool, b)
q st :: State
st = (EventF Arc b -> EventF Arc (Bool, b))
-> [EventF Arc b] -> [EventF Arc (Bool, b)]
forall a b. (a -> b) -> [a] -> [b]
map EventF Arc b -> EventF Arc (Bool, b)
match ([EventF Arc b] -> [EventF Arc (Bool, b)])
-> [EventF Arc b] -> [EventF Arc (Bool, b)]
forall a b. (a -> b) -> a -> b
$ Pattern b -> Query b
forall a. Pattern a -> Query a
query Pattern b
pb State
st
where
match :: EventF Arc b -> EventF Arc (Bool, b)
match (ex :: EventF Arc b
ex@(Event xContext :: Context
xContext xWhole :: Maybe Arc
xWhole xPart :: Arc
xPart x :: b
x)) =
Context -> Maybe Arc -> Arc -> (Bool, b) -> EventF Arc (Bool, b)
forall a b. Context -> Maybe a -> a -> b -> EventF a b
Event ([Context] -> Context
combineContexts ([Context] -> Context) -> [Context] -> Context
forall a b. (a -> b) -> a -> b
$ Context
xContextContext -> [Context] -> [Context]
forall a. a -> [a] -> [a]
:((EventF Arc a -> Context) -> [EventF Arc a] -> [Context]
forall a b. (a -> b) -> [a] -> [b]
map EventF Arc a -> Context
forall a b. EventF a b -> Context
context [EventF Arc a]
as')) Maybe Arc
xWhole Arc
xPart ((a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (b -> a -> Bool
f b
x) ((EventF Arc a -> a) -> [EventF Arc a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map EventF Arc a -> a
forall a b. EventF a b -> b
value ([EventF Arc a] -> [a]) -> [EventF Arc a] -> [a]
forall a b. (a -> b) -> a -> b
$ [EventF Arc a]
as'), b
x)
where as' :: [EventF Arc a]
as' = Time -> [EventF Arc a]
as (Time -> [EventF Arc a]) -> Time -> [EventF Arc a]
forall a b. (a -> b) -> a -> b
$ Arc -> Time
forall a. ArcF a -> a
start (Arc -> Time) -> Arc -> Time
forall a b. (a -> b) -> a -> b
$ EventF Arc b -> Arc
forall a. Event a -> Arc
wholeOrPart EventF Arc b
ex
as :: Time -> [EventF Arc a]
as s :: Time
s = Pattern a -> Query a
forall a. Pattern a -> Query a
query Pattern a
pa Query a -> Query a
forall a b. (a -> b) -> a -> b
$ Time -> State
fQuery Time
s
fQuery :: Time -> State
fQuery s :: Time
s = State
st {arc :: Arc
arc = Time -> Time -> Arc
forall a. a -> a -> ArcF a
Arc Time
s Time
s}