From 7729e11d64d578e41df0d211bb73b8b5daae4769 Mon Sep 17 00:00:00 2001
From: Denis Tereshkin <denis@kasan.ws>
Date: Thu, 12 Dec 2019 22:44:58 +0700
Subject: [PATCH] Semi-working state

---
 atrade-monitor.cabal | 10 +++++++---
 package.yaml         |  4 ++++
 src/Main.hs          | 40 ++++++++++++++++++++++++++++------------
 stack.yaml           |  1 +
 4 files changed, 40 insertions(+), 15 deletions(-)

diff --git a/atrade-monitor.cabal b/atrade-monitor.cabal
index 0fe73a7..f28e0ef 100644
--- a/atrade-monitor.cabal
+++ b/atrade-monitor.cabal
@@ -1,8 +1,10 @@
--- This file has been generated from package.yaml by hpack version 0.28.2.
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.31.2.
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: a9a6073782b8b53d54331257ae4de0e9cdd1f47b1c1f1e95cdde7654134f1b22
+-- hash: dab67d56afaa7dcc061e0130cc7ad1f8d8d8fc8b43f6d30a8662091a0a8bd9ac
 
 name:           atrade-monitor
 version:        0.1.0.0
@@ -14,7 +16,6 @@ copyright:      2019 Denis Tereshkin
 license:        BSD3
 license-file:   LICENSE
 build-type:     Simple
-cabal-version:  >= 1.10
 extra-source-files:
     README.md
 
@@ -25,12 +26,15 @@ executable atrade-monitor
   hs-source-dirs:
       src
   default-extensions: OverloadedStrings
+  ghc-options: -threaded
   build-depends:
       aeson
     , base >=4.7 && <5
     , process
     , safe
+    , safe-exceptions
     , text
+    , time
     , unagi-chan
     , unordered-containers
   default-language: Haskell2010
diff --git a/package.yaml b/package.yaml
index 95eb853..3ac023e 100644
--- a/package.yaml
+++ b/package.yaml
@@ -19,6 +19,10 @@ dependencies:
   - text
   - safe
   - unagi-chan
+  - safe-exceptions
+  - time
+
+ghc-options: -threaded
 
 default-extensions:
   - OverloadedStrings
diff --git a/src/Main.hs b/src/Main.hs
index 8ee9d36..7ab89d5 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -3,11 +3,14 @@ module Main where
 import           Control.Concurrent            hiding (newChan, readChan,
                                                 writeChan)
 import           Control.Concurrent.Chan.Unagi
+import           Control.Exception.Safe
 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           Data.Time.Clock
+import           Data.Time.Format
 import           Safe
 import           System.Environment
 import           System.IO
@@ -76,23 +79,36 @@ runWithConfig config = do
   (inChan, outChan) <- newChan
   threadIds <- forM (zip [0..] (cExecutables config)) $ \(i, execcfg) -> do
     threadDelay (1000000 * i * cDelay config)
-    (_, 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
+    forkIO $ do
+      putStrLn $ "Creating process: " ++ cExecutablePath execcfg
+      (_, Just stdOut, Just stdErr, ph) <- createProcess $ (proc (cExecutablePath execcfg) (makeArgs (cGlobalArgs config) (cArgs execcfg))) { std_out = CreatePipe, std_err = CreatePipe }
+      withFile (cLogPath execcfg) AppendMode $ \log -> handleIO (exceptionHandler inChan) $ do
+        stdErrLogThread <- forkIO $ forever $ do
+          now <- getCurrentTime
+          line <- lineWithTime now . T.pack <$> hGetLine stdErr
+          TIO.hPutStrLn log line
+          hFlush log
+          writeChan inChan line
+        forever $ do
+          now <- getCurrentTime
+          line <- lineWithTime now . T.pack <$> hGetLine stdOut
+          TIO.hPutStrLn log line
+          hFlush log
+          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
+    globalLogger chan = withFile (cGlobalLog config) AppendMode $ \log -> forever $ do
       line <- readChan chan
       TIO.hPutStrLn log line
-      TIO.putStrLn line
+      putStrLn $ T.unpack line
+      hFlush log
+      hFlush stdout
+      hFlush stderr
+    exceptionHandler inChan exception = do
+      writeChan inChan $ "Exception: " `T.append` (T.pack . show $ exception)
+
+    lineWithTime time line = ("[" `T.append` (T.pack $ formatTime defaultTimeLocale (iso8601DateFormat (Just "%T.%q")) time) `T.append` "] > " `T.append` line)
diff --git a/stack.yaml b/stack.yaml
index a946696..3d4ef20 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -40,6 +40,7 @@ packages:
 # (e.g., acme-missiles-0.3)
 extra-deps:
   - unagi-chan-0.4.1.0
+  - posix-pty-0.2.1.1
 
 # Override default flag values for local packages and extra-deps
 # flags: {}