22 | module Data.MSF.Util
25 | import Data.MSF.Core
31 | export infixr 1 ^>>
, >>^
, >>!
, !>>
, ?>>
, >>-
, ^>-
, !>-
, ?>-
35 | (>>^) : MSF m i o -> (o -> o2) -> MSF m i o2
36 | sf >>^ f = sf >>> arr f
40 | (^>>) : (i -> i2) -> MSF m i2 o -> MSF m i o
41 | f ^>> sf = arr f >>> sf
45 | (>>!) : MSF m i o -> (o -> m o2) -> MSF m i o2
46 | sf >>! f = sf >>> arrM f
50 | (!>>) : (i -> m i2) -> MSF m i2 o -> MSF m i o
51 | f !>> sf = arrM f >>> sf
65 | fan_ : FanList m i os -> MSF m i ()
66 | fan_ sfs = Fan sfs >>> Const ()
70 | (>>-) : MSF m i x -> FanList m x os -> MSF m i ()
71 | sf >>- sfs = sf >>> fan_ sfs
75 | (^>-) : (i -> x) -> FanList m x os -> MSF m i ()
76 | f ^>- sfs = arr f >>> fan_ sfs
80 | (!>-) : (i -> m x) -> FanList m x os -> MSF m i ()
81 | f !>- sfs = arrM f >>> fan_ sfs
86 | firstArg : MSF m (HList [x,i]) o -> x -> MSF m i o
87 | firstArg sf vx = fan [const vx, id] >>> sf
92 | secondArg : MSF m (HList [i,x]) o -> x -> MSF m i o
93 | secondArg sf vx = fan [id, const vx] >>> sf
97 | hd : MSF m (HList (i :: t)) i
98 | hd = arr $
\(h::_) => h
102 | tl : MSF m (HList (i :: t)) (HList t)
103 | tl = arr $
\(_::t) => t
107 | snd : MSF m (HList (i :: i2 :: t)) i2
108 | snd = arr $
\(_ :: v :: _) => v
112 | swap : MSF m (HList [a,b]) (HList [b,a])
113 | swap = arr $
\[va,vb] => [vb,va]
122 | either : MSF m (Either i1 i2) (HSum [i1,i2])
123 | either = arr $
either Here (There . Here)
127 | ifLeft : Monoid o => MSF m i o -> MSF m (Either i a) o
128 | ifLeft sf = either >>> collect [sf, neutral]
132 | ifRight : Monoid o => MSF m i o -> MSF m (Either a i) o
133 | ifRight sf = either >>> collect [neutral, sf]
138 | maybe : MSF m (Maybe i) (HSum [i,()])
139 | maybe = arr $
maybe (There $
Here ()) Here
143 | ifJust : Monoid o => MSF m i o -> MSF m (Maybe i) o
144 | ifJust sf = maybe >>> collect [sf, neutral]
148 | ifNothing : Monoid o => MSF m () o -> MSF m (Maybe i) o
149 | ifNothing sf = maybe >>> collect [neutral, sf]
155 | bool : (f : i -> Bool) -> MSF m i (HSum [i,i])
156 | bool f = arr $
\vi => if f vi then Here vi else (There $
Here vi)
160 | ifTrue : Monoid o => (f : i -> Bool) -> MSF m i o -> MSF m i o
161 | ifTrue f sf = bool f >>> collect [sf, neutral]
165 | ifFalse : Monoid o => (f : i -> Bool) -> MSF m i o -> MSF m i o
166 | ifFalse f sf = bool f >>> collect [neutral, sf]
170 | ifIs : Eq i => Monoid o => (v : i) -> MSF m i o -> MSF m i o
171 | ifIs v = ifTrue (v ==)
175 | ifIsNot : Eq i => Monoid o => (v : i) -> MSF m i o -> MSF m i o
176 | ifIsNot v = ifFalse (v ==)
185 | feedback_ : s -> MSF m (HList [s,i]) s -> MSF m i ()
186 | feedback_ v sf = feedback v $
sf >>^ (:: [()])
190 | iPre : o -> MSF m o o
191 | iPre v = feedback v swap
196 | accumulateWith : (i -> o -> o) -> o -> MSF m i o
197 | accumulateWith f ini = feedback ini (arr g)
200 | g : HList [o,i] -> HList [o,o]
201 | g [acc,inp] = let acc' = f inp acc in [acc',acc']
205 | count : Num n => MSF m i n
206 | count = const 1 >>> accumulateWith (+) 0
210 | appendFrom : Semigroup v => v -> MSF m v v
211 | appendFrom = accumulateWith (<+>)
215 | append : Monoid n => MSF m n n
216 | append = appendFrom neutral
221 | mealy : (i -> s -> HList [s,o]) -> s -> MSF m i o
222 | mealy f s0 = feedback s0 (arr $
\[s,i] => f i s)
227 | unfold : (s -> HList [s,o]) -> s -> MSF m i o
228 | unfold f ini = feedback ini (arr $
\(h::_) => f h)
234 | repeatedly : (o -> o) -> o -> MSF m i o
235 | repeatedly f = unfold $
\vo => let vo2 = f vo in [vo2,vo2]
239 | cycle : (vs : List o) -> {auto 0 prf : NonEmpty vs} -> MSF m i o
240 | cycle (h :: t) = unfold next (h :: t)
243 | next : List o -> HList [List o, o]
245 | next (h' :: t') = [t',h']
253 | observeWith : MSF m i () -> MSF m i i
254 | observeWith sf = fan [id,sf] >>> hd
258 | withEffect : (i -> m ()) -> MSF m i i
259 | withEffect = observeWith . arrM
263 | runEffect : m () -> MSF m i i
264 | runEffect = withEffect . const
272 | never : MSF m i (Event o)
279 | hold : o -> MSF m (Event o) o
280 | hold = accumulateWith (\ev,v => fromEvent v ev)
284 | ntimes : Nat -> o -> MSF m i (Event o)
285 | ntimes n vo = Switch (feedback n $
arr next) (const never)
288 | next : HList [Nat,i] -> HList [Nat,Either () (Event o)]
289 | next [0,_] = [0, Left ()]
290 | next [S k,_] = [k, Right $
Ev vo]
295 | once : o -> MSF m i (Event o)
300 | when : (i -> Bool) -> MSF m i (Event i)
301 | when f = arr $
\vi => toEvent (f vi) vi
305 | when_ : (i -> Bool) -> MSF m i (Event ())
306 | when_ f = arr $
\vi => toEvent (f vi) ()
310 | is : Eq i => i -> MSF m i (Event i)
315 | isNot : Eq i => i -> MSF m i (Event i)
316 | isNot v = when (v /=)
320 | whenLeft : MSF m (Either a b) (Event a)
321 | whenLeft = arr $
either Ev (const NoEv)
325 | whenRight : MSF m (Either a b) (Event b)
326 | whenRight = arr $
either (const NoEv) Ev
330 | whenJust : MSF m (Maybe a) (Event a)
331 | whenJust = arr maybeToEvent
335 | whenNothing : MSF m (Maybe a) (Event ())
336 | whenNothing = arr $
maybe (Ev ()) (const NoEv)
341 | event : MSF m (Event i) (HSum [i,()])
342 | event = arr $
event (There $
Here ()) Here
346 | ifEvent : Monoid o => MSF m i o -> MSF m (Event i) o
347 | ifEvent sf = event >>> collect [sf, const neutral]
351 | (?>-) : MSF m i (Event x) -> FanList m x os -> MSF m i ()
352 | ef ?>- sfs = ef >>> ifEvent (fan_ sfs)
356 | (?>>) : Monoid o => MSF m i (Event x) -> MSF m x o -> MSF m i o
357 | ef ?>> sf = ef >>> ifEvent sf
361 | ifNoEvent : Monoid o => MSF m () o -> MSF m (Event i) o
362 | ifNoEvent sf = event >>> collect [const neutral, sf]
367 | onChange : Eq i => MSF m i (Event i)
368 | onChange = mealy accum NoEv
371 | accum : i -> Event i -> HList [Event i, Event i]
374 | in if ev == old then [ev,NoEv] else [ev,ev]
379 | onEvent : MSF m (HList [a, Event e]) (Event a)
380 | onEvent = arr $
\case [va,e] => e $> va
385 | onEventWith : (a -> e -> b) -> MSF m (HList [a, Event e]) (Event b)
386 | onEventWith f = arr $
\case [va,e] => f va <$> e
392 | leftOnEvent : MSF m (HList [Either a b, Event e]) (Event a)
393 | leftOnEvent = arr $
\case [Left va,e] => e $> va
400 | rightOnEvent : MSF m (HList [Either a b, Event e]) (Event b)
401 | rightOnEvent = arr $
\case [Right vb,e] => e $> vb
408 | justOnEvent : MSF m (HList [Maybe a, Event e]) (Event a)
409 | justOnEvent = arr $
\case [Just va,e] => e $> va
422 | -> MSF m i (Event o)
423 | -> MSF m i (Event o)
424 | -> MSF m i (Event o)
425 | unionWith = elementwise2 . unionWith
434 | unionL : MSF m i (Event o) -> MSF m i (Event o) -> MSF m i (Event o)
435 | unionL = elementwise2 unionL
441 | unionR : MSF m i (Event o) -> MSF m i (Event o) -> MSF m i (Event o)
442 | unionR = elementwise2 unionR
450 | {auto _ : Semigroup o}
451 | -> MSF m i (Event o)
452 | -> MSF m i (Event o)
453 | -> MSF m i (Event o)
457 | (<|>) : Alternative f => MSF m i (f o) -> MSF m i (f o) -> MSF m i (f o)
458 | x <|> y = fan [x,y] >>> arr (\[vx,vy] => vx <|> vy)
467 | filter : (o -> Bool) -> MSF m (Event o) (Event o)
468 | filter = arr . filter
473 | mapMaybe : (i -> Maybe o) -> MSF m (Event i) (Event o)
474 | mapMaybe = arr . mapMaybe
479 | proj : (0 t : k) -> {auto prf : Elem t ks} -> MSF m (Any f ks) (Event $
f t)
480 | proj t = arr (project t)
488 | observeEvent : MSF m i () -> MSF m (Event i) (Event i)
489 | observeEvent = observeWith . ifEvent
499 | accumulateWithE : (i -> o -> o) -> o -> MSF m (Event i) (Event o)
500 | accumulateWithE f ini = feedback ini (arr g)
503 | g : HList [o,Event i] -> HList [o,Event o]
504 | g [acc,NoEv] = [acc,NoEv]
505 | g [acc,Ev vi] = let acc' = f vi acc in [acc',Ev acc']
509 | countE : MSF m (Event i) (Event Nat)
510 | countE = accumulateWithE (\_,n => n + 1) 0
518 | 0 Fun : List Type -> Type -> Type
520 | Fun (t :: ts) r = t -> Fun ts r
525 | uncurryNP : {0 is : _} -> Fun is o -> HList is -> o
527 | uncurryNP f (v :: vs) = uncurryNP (f v) vs
531 | np : {0 is : _} -> Fun is o -> MSF m (HList is) o
532 | np = arr . uncurryNP