gi-gtk and hint threads

main.hs

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}
module Main (main) where

import qualified GI.Gdk as Gdk
import qualified GI.Gtk as Gtk
import Reactive.Banana.Frameworks

import Data.GI.Base (on)
import Language.Haskell.Interpreter as Hint
import Control.Concurrent
import System.FSNotify
import Control.Monad
import Language.Haskell.Interpreter.Unsafe (unsafeRunInterpreterWithArgs)
import Data.IORef
import GI.GLib (idleAdd)
import GI.GLib.Constants

main = do
  reloadNetworkHS <- newChan
  withManager \mgr -> do
    let p = \case
          Modified "Network.hs" _ IsFile -> True
          _ -> False
    watchDir mgr "." p \case
          Modified f _ _ -> do
                  writeChan reloadNetworkHS ()
          _ -> return ()

  writeChan reloadNetworkHS ()
  ndChan <- newChan

  forkIO $ forever do
     readChan reloadNetworkHS
     putStrLn "wrote"

     -- XXX get $arch-$os-$version
     -- require write-ghc-environment-files: true
     net <- unsafeRunInterpreterWithArgs ["-package-conf", ".ghc.environment.x86_64-linux-8.10.7"] $ do
          liftIO $ putStrLn "interpreter started now trying to load files"
          loadModules ["Network.hs"]
          setImports ["Network", "Prelude"]
          Hint.interpret "networkDescription" (as :: IO EventNetwork)
     case net of
       Right x -> writeChan ndChan x
       Left m -> print m

  forkIO $ forever $ do
          getLine
          writeChan reloadNetworkHS ()

  Gtk.init Nothing

  firstActuation <- newEmptyMVar
  forkIO $ do
          putStrLn "waiting for first network"
          ndOld <- newIORef =<< join (readChan ndChan)
          print "actuating first network"

          let actuation = idleAdd PRIORITY_HIGH_IDLE do
                          actuate =<< readIORef ndOld
                          return False
          actuation
          putMVar firstActuation ()

          forever $ do
                  print "waiting for n'th network"
                  nd <- readChan ndChan
                  print "pausing previous network"
                  idleAdd PRIORITY_HIGH do
                          pause =<< readIORef ndOld
                          return False
                  writeIORef ndOld =<< nd
                  print "actuating new network"
                  actuation
  -- "pausing previous network"
  -- [xcb] Unknown sequence number while processing reply
  -- [xcb] Most likely this is a multi-threaded client and XInitThreads has not been called
  -- [xcb] Aborting, sorry about that.
  -- gregg-render: ../../src/xcb_io.c:641: _XReply: Assertion `!xcb_xlib_threads_sequence_lost' failed.
  
                  
  takeMVar firstActuation
  Gtk.main