From 8aec21813367b209d06e358a87de0dad687a519e Mon Sep 17 00:00:00 2001
From: Jens Nolte <git@queezle.net>
Date: Wed, 11 Aug 2021 02:57:57 +0200
Subject: [PATCH] Implement unsafeObservableIO

---
 src/Quasar/Observable.hs | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)

diff --git a/src/Quasar/Observable.hs b/src/Quasar/Observable.hs
index 939002f..549b838 100644
--- a/src/Quasar/Observable.hs
+++ b/src/Quasar/Observable.hs
@@ -22,6 +22,7 @@ module Quasar.Observable (
   mergeObservable,
   joinObservable,
   bindObservable,
+  unsafeObservableIO,
 
   -- * Helper types
   ObservableCallback,
@@ -303,6 +304,21 @@ constObservable :: v -> Observable v
 constObservable = Observable . ConstObservable
 
 
+-- | Create an observable by simply running an IO action whenever a value is requested or a callback is registered.
+--
+-- There is no mechanism to send more than one update, so the resulting `Observable` will only be correct in specific
+-- situations.
+unsafeObservableIO :: forall v. IO v -> Observable v
+unsafeObservableIO action = synchronousFnObservable observeFn action
+  where
+    observeFn :: (ObservableMessage v -> IO ()) -> IO Disposable
+    observeFn callback = do
+      callback ObservableLoading
+      value <- (ObservableUpdate <$> action) `catchAll` (pure . ObservableNotAvailable @v)
+      callback value
+      pure noDisposable
+
+
 -- TODO implement
 --cacheObservable :: IsObservable v o => o -> Observable v
 --cacheObservable = undefined
-- 
GitLab