More failed attempts.

app/Hydra/Main.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
 
 module Main where
 
@@ -7,12 +8,10 @@ import qualified Data.Set             as Set
 
 import qualified Hydra.Domain         as D
 import qualified Hydra.FTL            as L
-import qualified Hydra.FTLI           ()
--- import qualified Hydra.Language as L
 import           Hydra.Prelude
 import qualified Hydra.Runtime        as R
 
-import           Hydra.Core.Evaluable
+import Hydra.FTLI ()
 
 type MTime = Int
 
@@ -36,7 +35,9 @@ data AppState = AppState
   { catalogue :: D.StateVar Catalogue
   }
 
-initState :: L.LangL m => m AppState
+type AppType m a = ReaderT R.CoreRuntime m a
+
+initState :: (MonadIO m, L.LangL m) => AppType m AppState
 initState = L.atomically $ do
   ne <- L.newVar Map.empty
   nw <- L.newVar Map.empty
@@ -51,38 +52,40 @@ initState = L.atomically $ do
   catalogue <- L.newVar catalogueMap
   pure $ AppState catalogue
 
-meteorCounter :: L.LangL m => AppState -> m ()
+meteorCounter :: (L.LangL m, MonadIO m) => AppState -> AppType m ()
-meteorCounter st = pure ()
+meteorCounter st = do
+  void $ readFile "abc"
+  pure ()
 
-getRandomMeteor :: L.RandomL m => m Meteor
+getRandomMeteor :: (MonadIO m, L.RandomL m) => AppType m Meteor
 getRandomMeteor = Meteor <$> L.getRandomInt (1, 100)
 
-getRandomMilliseconds :: L.RandomL m => m MTime
+getRandomMilliseconds :: (MonadIO m, L.RandomL m) => AppType m MTime
 getRandomMilliseconds = (* 1000) <$> L.getRandomInt (0, 3000)
 
-meteorShower :: L.LangL m => AppState -> Region -> m ()
+meteorShower :: (MonadIO m, L.LangL m) => AppState -> Region -> AppType m ()
 meteorShower st region = do
   getRandomMilliseconds >>= L.delay
   meteor <- getRandomMeteor
   L.logInfo $ "[MS] " <> " a new meteor appeared at " <> show region <> ": " <> show meteor
   meteorShower st region
 
-meteorsMonitoring :: (L.ProcessL m, L.LangL m) => m ()
+meteorsMonitoring :: (MonadIO m, L.LangL m) => AppType m ()
 meteorsMonitoring = do
   L.logInfo "Starting app..."
   L.logInfo "Delaying..."
   L.delay 10000
   L.logInfo "Done."
   st <- initState
-  L.forkProcess $ cnt st
+  -- liftIO $ forkIO $ meteorCounter st
+
+  -- liftIO $ forkIO $ meteorCounter st
   -- L.forkProcess $ meteorShower st NorthEast
   -- L.forkProcess $ meteorShower st NorthWest
   -- L.forkProcess $ meteorShower st SouthEast
   -- L.forkProcess $ meteorShower st SouthWest
   pure ()
-  where
+
-    cnt :: (L.LangL m, Evaluable m) => AppState -> m ()
-    cnt st = meteorCounter st
 
 loggerCfg :: D.LoggerConfig
 loggerCfg = D.LoggerConfig
@@ -100,7 +103,7 @@ loggerCfg = D.LoggerConfig
 --   -- R.startApp appRt $ L.foreverApp meteorsMonitoring
 --   runReaderT (L.foreverApp meteorsMonitoring) appRt
 
-delayAction :: L.ControlFlowL m => Int -> m ()
+delayAction :: (MonadIO m, L.ControlFlowL m) => Int -> AppType m ()
 delayAction = L.delay
 
 

src/Hydra/Core/ControlFlow/FTLI.hs

@@ -6,5 +6,5 @@ import qualified Hydra.Core.FTL     as L
 import qualified Hydra.Core.RLens   as RLens
 import qualified Hydra.Core.Runtime as R
 
-instance L.ControlFlowL (ReaderT R.CoreRuntime IO) where
+instance MonadIO m => L.ControlFlowL (ReaderT R.CoreRuntime m) where
     delay = liftIO . threadDelay

src/Hydra/Core/Evaluable.hs

@@ -1,13 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes   #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies          #-}
-
-module Hydra.Core.Evaluable where
-
-import           Hydra.Prelude
-
-import qualified Hydra.Core.Runtime as R
-
-class Evaluable m where
-  data EvalM m :: * -> *
-  evaluate :: EvalM m a -> R.CoreRuntime -> IO a

src/Hydra/Core/Lang/FTL.hs

@@ -7,7 +7,6 @@ module Hydra.Core.Lang.FTL where
 import           Hydra.Prelude
 
 import           Hydra.Core.ControlFlow.FTL as L
-import           Hydra.Core.Evaluable
 import           Hydra.Core.Logger.FTL      as L
 import           Hydra.Core.Random.FTL      as L
 import qualified Hydra.Core.State.Language  as L

src/Hydra/Core/Lang/FTLI.hs

@@ -12,6 +12,7 @@ import qualified Hydra.Core.State.Interpreter as Impl
 import qualified Hydra.Core.State.Language    as L
 
 instance L.LangL (ReaderT R.CoreRuntime IO) where
+-- instance MonadIO m => L.LangL (ReaderT R.CoreRuntime m) where
   evalStateAtomically action = do
     coreRt <- ask
     let stateRt  = coreRt ^. RLens.stateRuntime

src/Hydra/Core/Logger/FTLI.hs

@@ -11,7 +11,7 @@ import qualified Hydra.Core.Logger.Impl.HsLogger as Hs
 import qualified System.Log.Logger               as Hs
 
 -- TODO: hslogger specific is here!
-instance L.LoggerL (ReaderT R.CoreRuntime IO) where
+instance MonadIO m => L.LoggerL (ReaderT R.CoreRuntime m) where
   logMessage lvl msg = do
     coreRt <- ask
     let mbHsRt = coreRt ^. RLens.loggerRuntime ^. RLens.hsLoggerHandle

src/Hydra/Core/Process/FTL.hs

@@ -8,11 +8,11 @@ module Hydra.Core.Process.FTL where
 import           Hydra.Prelude
 
 import qualified Hydra.Core.Domain    as D
-import           Hydra.Core.Evaluable
 
 
-class (Evaluable m', Monad m) => ProcessL m' m where
+
-  forkProcess  :: EvalM m' a -> m (D.ProcessPtr a)
+-- class (Monad m) => ProcessL m where
+--   forkProcess  :: m' a -> m (D.ProcessPtr a)
   -- killProcess  :: D.ProcessPtr a -> m ()
   -- tryGetResult :: D.ProcessPtr a -> m (Maybe a)
   -- awaitResult  :: D.ProcessPtr a -> m a

src/Hydra/Core/Process/FTLI.hs

@@ -11,19 +11,18 @@ import qualified Hydra.Core.Process.Interpreter as Impl
 import qualified Hydra.Core.RLens               as RLens
 import qualified Hydra.Core.Runtime             as R
 
-import           Hydra.Core.Evaluable
-import           Hydra.Core.Lang.FTLI           ()
 
-instance Evaluable m' => L.ProcessL m' (ReaderT R.CoreRuntime IO) where
+-- instance L.ProcessL (ReaderT R.CoreRuntime IO) where
-  forkProcess action = do
+--   forkProcess action = do
-    coreRt <- ask
+--     coreRt <- ask
-    let processRt = coreRt ^. RLens.processRuntime
+--     let processRt = coreRt ^. RLens.processRuntime
-    (pPtr, pVar) <- liftIO (Impl.getNextProcessId processRt >>= D.createProcessPtr)
+--     (pPtr, pVar) <- liftIO (Impl.getNextProcessId processRt >>= D.createProcessPtr)
-    threadId <- liftIO $ forkIO $ do
+--     threadId <- liftIO $ forkIO $ do
-        res <- evaluate action coreRt
+--         res <- evaluate action coreRt
-        atomically $ putTMVar pVar res
+--         atomically $ putTMVar pVar res
-    liftIO $ Impl.addProcess processRt pPtr threadId
+--     liftIO $ Impl.addProcess processRt pPtr threadId
-    pure pPtr
+--     pure pPtr
+
   -- killProcess  :: D.ProcessPtr a -> m ()
   -- tryGetResult :: D.ProcessPtr a -> m (Maybe a)
   -- awaitResult  :: D.ProcessPtr a -> m a

src/Hydra/Core/Random/FTLI.hs

@@ -10,5 +10,5 @@ import qualified Hydra.Core.Runtime           as R
 import qualified Hydra.Core.State.Interpreter as Impl
 import qualified Hydra.Core.State.Language    as L
 
-instance L.RandomL (ReaderT R.CoreRuntime IO) where
+instance MonadIO m => L.RandomL (ReaderT R.CoreRuntime m) where
   getRandomInt range = liftIO $ randomRIO range