From e3c8479127589b05719567f6821383ad0d9f5b27 Mon Sep 17 00:00:00 2001
From: tv <tv@shackspace.de>
Date: Mon, 28 Jul 2014 14:18:39 +0200
Subject: move source to src/

---
 Process.hs | 98 --------------------------------------------------------------
 1 file changed, 98 deletions(-)
 delete mode 100644 Process.hs

(limited to 'Process.hs')

diff --git a/Process.hs b/Process.hs
deleted file mode 100644
index 5c53681..0000000
--- a/Process.hs
+++ /dev/null
@@ -1,98 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-module Process
-    ( spawn
-    , module System.Process
-    ) where
-
-import Control.Monad (unless, when)
-import System.IO
-import System.Process
-import Control.Concurrent
-
-type OutputWrapper = IO () -> IO ()
-
-data OutStreamType = Stderr | Stdout
-
-color :: OutStreamType -> String
-color Stderr = "31"
-color Stdout = "32"
-
-data ReaperConfig = ReaperConfig
-    { withOutput :: OutputWrapper
-    , jobName :: String
-    , openFdsRef :: MVar Int
-    , processHandle :: ProcessHandle
-    , streamHandle :: Handle
-    , streamType :: OutStreamType
-    }
-
-
-spawn :: Int -> OutputWrapper -> String -> IO ()
-spawn jobId _withOutput cmdline = do
-
-    -- TODO stdin
-    (Nothing, Just hOut, Just hErr, ph) <-
-        createProcess (shell cmdline)
-            { std_in = Inherit -- TODO close
-            , std_out = CreatePipe
-            , std_err = CreatePipe
-            }
-
-    _openFdsRef <- newMVar 2
-
-    let rcOut = ReaperConfig
-          { streamType = Stdout
-          , streamHandle = hOut
-          , withOutput = _withOutput
-          , jobName = '&' : show jobId
-          , openFdsRef = _openFdsRef
-          , processHandle = ph
-          }
-        rcErr = rcOut
-          { streamType = Stderr
-          , streamHandle = hErr
-          } 
-
-    forkIO $ reap rcOut
-    reap rcErr
-
-
-reap :: ReaperConfig -> IO ()
-reap rc@ReaperConfig{..} = do
-    forLines_ streamHandle $ \line ->
-        withOutput $ do
-            putStrLn $
-              "\x1b[35m" ++ jobName ++ "\x1b[m " ++
-              "\x1b[" ++ (color streamType) ++ "m" ++ line ++ "\x1b[m"
-
-    i <- decMVar openFdsRef
-
-    --withOutput $
-    --    putStrLn $ "\x1b[35m" ++ name ++ "\x1b[m eof"
-
-    when (i == 0) $ finish rc
-
-    hClose streamHandle
-    myThreadId >>= killThread
-
-
-finish :: ReaperConfig -> IO ()
-finish ReaperConfig{..} = do
-    exitCode <- waitForProcess processHandle
-    withOutput $
-        putStrLn $ "\x1b[35m" ++ jobName ++ "\x1b[m exit: " ++ show exitCode
-
-
-decMVar :: MVar Int -> IO Int
-decMVar =
-    flip modifyMVar dec
-  where
-    dec i = let i' = i - 1 in return (i', i')
- 
-
-
--- TODO move utilities somewhere else
-forLines_ :: Handle -> (String -> IO ()) -> IO ()
-forLines_ h f = rec
-  where
-    rec = hIsEOF h >>= flip unless (hGetLine h >>= f >> rec)
-- 
cgit v1.2.3