Global logging

atrade-monitor.cabal

@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 7b4bb6b075db02fa61f90c38b7c14b013926cce4ef1591667dd98ba4fdc483c1
+-- hash: a9a6073782b8b53d54331257ae4de0e9cdd1f47b1c1f1e95cdde7654134f1b22
 
 name:           atrade-monitor
 version:        0.1.0.0
@@ -31,5 +31,6 @@ executable atrade-monitor
     , process
     , safe
     , text
+    , unagi-chan
     , unordered-containers
   default-language: Haskell2010

package.yaml

@@ -18,6 +18,7 @@ dependencies:
   - unordered-containers
   - text
   - safe
+  - unagi-chan
 
 default-extensions:
   - OverloadedStrings

src/Main.hs

@@ -1,12 +1,16 @@
 module Main where
 
-import           Control.Concurrent
+import           Control.Concurrent            hiding (newChan, readChan,
+                                                writeChan)
+import           Control.Concurrent.Chan.Unagi
 import           Control.Monad
 import           Data.Aeson
 import qualified Data.HashMap.Strict           as HM
 import qualified Data.Text                     as T
+import qualified Data.Text.IO                  as TIO
 import           Safe
 import           System.Environment
+import           System.IO
 import           System.Process
 
 newtype ArgsMap = ArgsMap { unArgsMap :: HM.HashMap T.Text T.Text }
@@ -69,17 +73,26 @@ main = do
 
 runWithConfig :: Config -> IO ()
 runWithConfig config = do
+  (inChan, outChan) <- newChan
   threadIds <- forM (zip [0..] (cExecutables config)) $ \(i, execcfg) -> do
     threadDelay (1000000 * i * cDelay config)
-    (mbStdIn, mbStdOut, mbStdErr, ph) <- createProcess $ proc (cExecutablePath execcfg) (makeArgs (cGlobalArgs config) (cArgs execcfg))
+    (_, Just stdOut, Just stdErr, ph) <- createProcess $ (proc (cExecutablePath execcfg) (makeArgs (cGlobalArgs config) (cArgs execcfg))) { std_out = CreatePipe, std_err = CreatePipe }
-    undefined
+    withFile (cLogPath execcfg) WriteMode $ \log -> do
-  forever $ threadDelay 1000000
+      stdErrLogThread <- forkIO $ forever $ do
-
+        line <- TIO.hGetLine stdErr
+        TIO.hPutStrLn log line
+        writeChan inChan line
+      forever $ do
+        line <- TIO.hGetLine stdOut
+        TIO.hPutStrLn log line
+        writeChan inChan line
+
+  globalLogger outChan
 
   where
     makeArgs globalArgs localArgs = fmap makeArg (HM.toList . unArgsMap $ globalArgs) ++ fmap makeArg (HM.toList . unArgsMap $ localArgs)
     makeArg (k, v) = T.unpack $ if v /= "" then "--" <> k <> "=" <> v else "--" <> k
-
+    globalLogger chan = withFile (cGlobalLog config) WriteMode $ \log -> do
-
+      line <- readChan chan
-
+      TIO.hPutStrLn log line
-
+      TIO.putStrLn line

stack.yaml

@@ -38,7 +38,8 @@ packages:
 # Dependency packages to be pulled from upstream that are not in the resolver
 # using the same syntax as the packages field.
 # (e.g., acme-missiles-0.3)
-# extra-deps: []
+extra-deps:
+  - unagi-chan-0.4.1.0
 
 # Override default flag values for local packages and extra-deps
 # flags: {}