Skip to content
GitLab
Explore
Sign in
Primary navigation
Search or go to…
Project
Q
quasar
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Package Registry
Container Registry
Model registry
Operate
Environments
Terraform modules
Monitor
Incidents
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Jens Nolte
quasar
Commits
2384b110
Commit
2384b110
authored
2 years ago
by
Jens Nolte
Browse files
Options
Downloads
Patches
Plain Diff
Remove IsRetrievable constraint from IsObservable
Co-authored-by:
Jan Beinke
<
git@janbeinke.com
>
parent
2201a532
No related branches found
No related tags found
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
src/Quasar/Observable.hs
+1
-21
1 addition, 21 deletions
src/Quasar/Observable.hs
with
1 addition
and
21 deletions
src/Quasar/Observable.hs
+
1
−
21
View file @
2384b110
...
@@ -44,8 +44,6 @@ import Control.Monad.Trans.Maybe
...
@@ -44,8 +44,6 @@ import Control.Monad.Trans.Maybe
import
Data.HashMap.Strict
qualified
as
HM
import
Data.HashMap.Strict
qualified
as
HM
import
Data.IORef
import
Data.IORef
import
Data.Unique
import
Data.Unique
import
Quasar.Async
import
Quasar.Future
import
Quasar.Prelude
import
Quasar.Prelude
import
Quasar.MonadQuasar
import
Quasar.MonadQuasar
import
Quasar.MonadQuasar.Misc
import
Quasar.MonadQuasar.Misc
...
@@ -79,7 +77,7 @@ instance Monad ObservableState where
...
@@ -79,7 +77,7 @@ instance Monad ObservableState where
class
IsRetrievable
r
a
|
a
->
r
where
class
IsRetrievable
r
a
|
a
->
r
where
retrieve
::
(
MonadQuasar
m
,
MonadIO
m
)
=>
a
->
m
r
retrieve
::
(
MonadQuasar
m
,
MonadIO
m
)
=>
a
->
m
r
class
IsRetrievable
r
a
=>
IsObservable
r
a
|
a
->
r
where
class
IsObservable
r
a
|
a
->
r
where
-- | Register a callback to observe changes. The callback is called when the value changes, but depending on the
-- | Register a callback to observe changes. The callback is called when the value changes, but depending on the
-- delivery method (e.g. network) intermediate values may be skipped.
-- delivery method (e.g. network) intermediate values may be skipped.
--
--
...
@@ -132,8 +130,6 @@ type ObservableCallback a = ObservableState a -> QuasarSTM ()
...
@@ -132,8 +130,6 @@ type ObservableCallback a = ObservableState a -> QuasarSTM ()
-- | Existential quantification wrapper for the IsObservable type class.
-- | Existential quantification wrapper for the IsObservable type class.
data
Observable
r
=
forall
a
.
IsObservable
r
a
=>
Observable
a
data
Observable
r
=
forall
a
.
IsObservable
r
a
=>
Observable
a
instance
IsRetrievable
r
(
Observable
r
)
where
retrieve
(
Observable
o
)
=
retrieve
o
instance
IsObservable
r
(
Observable
r
)
where
instance
IsObservable
r
(
Observable
r
)
where
observe
(
Observable
o
)
=
observe
o
observe
(
Observable
o
)
=
observe
o
toObservable
=
id
toObservable
=
id
...
@@ -256,8 +252,6 @@ instance IsObservable a (ThrowObservable a) where
...
@@ -256,8 +252,6 @@ instance IsObservable a (ThrowObservable a) where
data
MappedObservable
a
=
forall
b
.
MappedObservable
(
b
->
a
)
(
Observable
b
)
data
MappedObservable
a
=
forall
b
.
MappedObservable
(
b
->
a
)
(
Observable
b
)
instance
IsRetrievable
a
(
MappedObservable
a
)
where
retrieve
(
MappedObservable
f
observable
)
=
f
<$>
retrieve
observable
instance
IsObservable
a
(
MappedObservable
a
)
where
instance
IsObservable
a
(
MappedObservable
a
)
where
observe
(
MappedObservable
fn
observable
)
callback
=
observe
observable
(
callback
.
fmap
fn
)
observe
(
MappedObservable
fn
observable
)
callback
=
observe
observable
(
callback
.
fmap
fn
)
mapObservable
f1
(
MappedObservable
f2
upstream
)
=
toObservable
$
MappedObservable
(
f1
.
f2
)
upstream
mapObservable
f1
(
MappedObservable
f2
upstream
)
=
toObservable
$
MappedObservable
(
f1
.
f2
)
upstream
...
@@ -269,12 +263,6 @@ instance IsObservable a (MappedObservable a) where
...
@@ -269,12 +263,6 @@ instance IsObservable a (MappedObservable a) where
-- There is no caching involed, every subscriber effectively subscribes to both input observables.
-- There is no caching involed, every subscriber effectively subscribes to both input observables.
data
LiftA2Observable
r
=
forall
a
b
.
LiftA2Observable
(
a
->
b
->
r
)
(
Observable
a
)
(
Observable
b
)
data
LiftA2Observable
r
=
forall
a
b
.
LiftA2Observable
(
a
->
b
->
r
)
(
Observable
a
)
(
Observable
b
)
instance
IsRetrievable
a
(
LiftA2Observable
a
)
where
retrieve
(
LiftA2Observable
fn
fx
fy
)
=
liftQuasarIO
do
-- TODO LATER: keep backpressure for parallel network requests
future
<-
async
$
retrieve
fy
liftA2
fn
(
retrieve
fx
)
(
await
future
)
instance
IsObservable
a
(
LiftA2Observable
a
)
where
instance
IsObservable
a
(
LiftA2Observable
a
)
where
observe
(
LiftA2Observable
fn
fx
fy
)
callback
=
liftQuasarSTM
do
observe
(
LiftA2Observable
fn
fx
fy
)
callback
=
liftQuasarSTM
do
var0
<-
newTVar
Nothing
var0
<-
newTVar
Nothing
...
@@ -292,11 +280,6 @@ instance IsObservable a (LiftA2Observable a) where
...
@@ -292,11 +280,6 @@ instance IsObservable a (LiftA2Observable a) where
data
BindObservable
a
=
forall
b
.
BindObservable
(
Observable
b
)
(
b
->
Observable
a
)
data
BindObservable
a
=
forall
b
.
BindObservable
(
Observable
b
)
(
b
->
Observable
a
)
instance
IsRetrievable
a
(
BindObservable
a
)
where
retrieve
(
BindObservable
fx
fn
)
=
do
x
<-
retrieve
fx
retrieve
$
fn
x
instance
IsObservable
a
(
BindObservable
a
)
where
instance
IsObservable
a
(
BindObservable
a
)
where
observe
(
BindObservable
fx
fn
)
callback
=
liftQuasarSTM
do
observe
(
BindObservable
fx
fn
)
callback
=
liftQuasarSTM
do
-- TODO Dispose in STM to remove potential extraneous (/invalid?) updates while disposing
-- TODO Dispose in STM to remove potential extraneous (/invalid?) updates while disposing
...
@@ -331,9 +314,6 @@ instance IsObservable a (BindObservable a) where
...
@@ -331,9 +314,6 @@ instance IsObservable a (BindObservable a) where
data
CatchObservable
e
a
=
Exception
e
=>
CatchObservable
(
Observable
a
)
(
e
->
Observable
a
)
data
CatchObservable
e
a
=
Exception
e
=>
CatchObservable
(
Observable
a
)
(
e
->
Observable
a
)
instance
IsRetrievable
a
(
CatchObservable
e
a
)
where
retrieve
(
CatchObservable
fx
fn
)
=
retrieve
fx
`
catch
`
\
ex
->
retrieve
(
fn
ex
)
instance
IsObservable
a
(
CatchObservable
e
a
)
where
instance
IsObservable
a
(
CatchObservable
e
a
)
where
observe
(
CatchObservable
fx
fn
)
callback
=
liftQuasarSTM
do
observe
(
CatchObservable
fx
fn
)
callback
=
liftQuasarSTM
do
callback
ObservableLoading
callback
ObservableLoading
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment