wip simplify aggregatefeature/mtl

3 files changed, 31 insertions, 4 deletions

diff --git a/default.nix b/default.nix
index 3de5581..102d406 100644
--- a/default.nix
+++ b/default.nix
@@ -2,6 +2,7 @@
   haskellPackages = pkgs.haskellPackages.override {
     overrides = self: super: {
       sensors = self.callCabal2nix "sensors" ./. { };
+      unlift = self.callCabal2nix "unlift" ./unlift { };
     };
   };
   inherit (haskellPackages) sensors;
diff --git a/sensors.cabal b/sensors.cabal
index 844aae2..5a96910 100644
--- a/sensors.cabal
+++ b/sensors.cabal
@@ -24,6 +24,8 @@ library
         hspec,
         mtl,
         stm,
+        transformers-base,
+        unlift,
         unliftio
 
 test-suite sensors-test
diff --git a/src/Data/Sensor.hs b/src/Data/Sensor.hs
index 96c48ed..2cb7eaa 100644
--- a/src/Data/Sensor.hs
+++ b/src/Data/Sensor.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE UndecidableInstances #-}
+
 module Data.Sensor where
 
 import Control.Applicative
@@ -149,7 +151,7 @@ combineStale f a@(Stale _) b@(Input _) = Stale (f a.unwrap b.unwrap)
 combineStale f a b = Fresh (f a.unwrap b.unwrap)
 
 class (MonadIO m, Show s, Typeable a) => Aggregate m s a | s -> a where
-  aggregate :: s -> AggregateT s (SensorT m) ()
+  aggregate :: s -> (a -> m ()) -> m ()
 
 newtype AggregateT s m a = AggregateT {unAggregateT :: ReaderT AggregateE m a}
 
@@ -161,8 +163,7 @@ deriving instance (Monad m) => Monad (AggregateT s m)
 
 deriving instance (MonadIO m) => MonadIO (AggregateT s m)
 
-instance MonadTrans (AggregateT s) where
-  lift = AggregateT . lift
+deriving instance MonadTrans (AggregateT s)
 
 deriving instance (MonadFail m) => MonadFail (AggregateT s m)
 
@@ -366,6 +367,13 @@ data LiveAggregate a = LiveAggregate
     spawnedAt :: Int
   }
 
+runAggregateT :: AggregateT s m a -> AggregateE -> m a
+runAggregateT (AggregateT m) e =
+  runReaderT m e
+
+withRunInBase :: ((forall a. (AggregateT s (SensorT m) a) -> m a) -> m x) -> AggregateT s (SensorT m) x
+withRunInBase = undefined
+
 startAggregate :: (MonadUnliftIO m) => AnyAggregate m -> SensorT m ()
 startAggregate (AnyAggregate s) = do
   let self = show s
@@ -380,7 +388,23 @@ startAggregate (AnyAggregate s) = do
 
       threadId <-
         forkFinally
-          (runReaderT (aggregate s).unAggregateT AggregateE {..})
+          ( do
+              sensorE <- ask
+              (lift :: m a -> SensorT m a)
+                ( runReaderT
+                    ( runAggregateT
+                        (lift (lift (aggregate s undefined)))
+                        {-
+                        ( withRunInBase $ \runInBase ->
+                            (aggregate s (runInBase . yield))
+                        )-}
+                        AggregateE {..} ::
+                        SensorT m ()
+                    ).unSensorT
+                    sensorE ::
+                    m ()
+                )
+          )
           ( either
               ( \e ->
                   if