<commit_before>{-# LANGUAGE Rank2Types #-}
module UI.Run (
  runGuiInSubprocess
  ) where

import Control.Monad
import Control.Concurrent
import Control.Exception

import Reactive.Banana

import System.IO
import System.Process

import UI.TclTk.Builder
import UI.Dispatch
import UI.Log

import Text.PrettyPrint.ANSI.Leijen


-- | Run GUI. Tcl interpreter will be executed in subprocess
runGuiInSubprocess :: (forall t. GUI t () ()) -> IO ()
runGuiInSubprocess ui
  = bracket
      (runInteractiveProcess "wish" [] Nothing Nothing)
      finalize
      run
  where
    -- Output function
    output h strs = do
        mapM_ (hPutStrLn h) strs
        hFlush h
        forM_ strs $ \s -> do 
          logDoc $ green $ text s
    -- Create and execute event network
    run (inp, out, err, pid) = do
      (dispatch, network, tcl) <- runGUI (output inp) ui
      writeRenderedTcl dispatch tcl
      forkIO $
        mapM_ (pushMessage dispatch . words) . lines =<< hGetContents out
      -- Send stderr to logger
      forkIO $
        mapM_ logStr . lines =<< hGetContents err
      -- Start event loop
      actuate network
      pushInitEvent dispatch
      void $ waitForProcess pid

    -- Wait for subprocess
    finalize (_,_,_, pid) = do
      c <- getProcessExitCode pid
      case c of
        Nothing -> void $ forkIO $ void $ waitForProcess pid
        _       -> return ()<commit_msg>Reorder main loop a bit<commit_after>{-# LANGUAGE Rank2Types #-}
module UI.Run (
  runGuiInSubprocess
  ) where

import Control.Monad
import Control.Concurrent
import Control.Exception

import Reactive.Banana

import System.IO
import System.Process

import UI.TclTk.Builder
import UI.Dispatch
import UI.Log

import Text.PrettyPrint.ANSI.Leijen


-- | Run GUI. Tcl interpreter will be executed in subprocess
runGuiInSubprocess :: (forall t. GUI t () ()) -> IO ()
runGuiInSubprocess ui
  = bracket
      (runInteractiveProcess "wish" [] Nothing Nothing)
      finalize
      run
  where
    -- Output function
    output h strs = do
        mapM_ (hPutStrLn h) strs
        hFlush h
        forM_ strs $ \s -> do
          logDoc $ green $ text s
    -- Create and execute event network
    run (inp, out, err, pid) = do
      (dispatch, network, tcl) <- runGUI (output inp) ui
      -- Dispatch incoming messages
      forkIO $
        mapM_ (pushMessage dispatch . words) . lines =<< hGetContents out
      -- Send stderr to logger
      forkIO $
        mapM_ logStr . lines =<< hGetContents err
      -- Start event loop
      writeRenderedTcl dispatch tcl
      actuate network
      pushInitEvent dispatch
      -- Wait for child process and kill it forcefully if exception is
      -- raised
      void $ waitForProcess pid
    -- Wait for subprocess
    finalize (_,_,_, pid) = do
      c <- getProcessExitCode pid
      print c
      case c of
        Nothing -> do terminateProcess pid
                      void $ forkIO $ void $ waitForProcess pid
        _       -> return ()
{'fraction_non_alphanumeric': 0.07782623280778263, 'fraction_numerical': 0.0006709158000670916, 'mean_word_length': 2.262582056892779, 'pattern_counts': {'":': 0, '<': 15, '<?xml version=': 0, '>': 11, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '278577', 'n_tokens_mistral': 904, 'n_tokens_neox': 881, 'n_words': 304}