From 65e4ac6ff7466436de7ce48270e2403fac99684e Mon Sep 17 00:00:00 2001
From: Denis Tereshkin <denis@kasan.ws>
Date: Tue, 26 Mar 2019 09:27:16 +0700
Subject: [PATCH] Global logging

---
 atrade-monitor.cabal |  3 ++-
 package.yaml         |  1 +
 src/Main.hs          | 35 ++++++++++++++++++++++++-----------
 stack.yaml           |  3 ++-
 4 files changed, 29 insertions(+), 13 deletions(-)

diff --git a/atrade-monitor.cabal b/atrade-monitor.cabal
index cf5318a..0fe73a7 100644
--- a/atrade-monitor.cabal
+++ b/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
diff --git a/package.yaml b/package.yaml
index 50d7b22..95eb853 100644
--- a/package.yaml
+++ b/package.yaml
@@ -18,6 +18,7 @@ dependencies:
   - unordered-containers
   - text
   - safe
+  - unagi-chan
 
 default-extensions:
   - OverloadedStrings
diff --git a/src/Main.hs b/src/Main.hs
index be78c2e..8ee9d36 100644
--- a/src/Main.hs
+++ b/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.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))
-    undefined
-  forever $ threadDelay 1000000
-
+    (_, Just stdOut, Just stdErr, ph) <- createProcess $ (proc (cExecutablePath execcfg) (makeArgs (cGlobalArgs config) (cArgs execcfg))) { std_out = CreatePipe, std_err = CreatePipe }
+    withFile (cLogPath execcfg) WriteMode $ \log -> do
+      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
diff --git a/stack.yaml b/stack.yaml
index b543970..a946696 100644
--- a/stack.yaml
+++ b/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: {}