commit
53a0833e10
8 changed files with 248 additions and 0 deletions
@ -0,0 +1,30 @@
@@ -0,0 +1,30 @@
|
||||
Copyright Author name here (c) 2019 |
||||
|
||||
All rights reserved. |
||||
|
||||
Redistribution and use in source and binary forms, with or without |
||||
modification, are permitted provided that the following conditions are met: |
||||
|
||||
* Redistributions of source code must retain the above copyright |
||||
notice, this list of conditions and the following disclaimer. |
||||
|
||||
* Redistributions in binary form must reproduce the above |
||||
copyright notice, this list of conditions and the following |
||||
disclaimer in the documentation and/or other materials provided |
||||
with the distribution. |
||||
|
||||
* Neither the name of Author name here nor the names of other |
||||
contributors may be used to endorse or promote products derived |
||||
from this software without specific prior written permission. |
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS |
||||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT |
||||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR |
||||
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT |
||||
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, |
||||
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT |
||||
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, |
||||
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY |
||||
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT |
||||
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE |
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
||||
@ -0,0 +1,2 @@
@@ -0,0 +1,2 @@
|
||||
import Distribution.Simple |
||||
main = defaultMain |
||||
@ -0,0 +1,35 @@
@@ -0,0 +1,35 @@
|
||||
-- This file has been generated from package.yaml by hpack version 0.28.2. |
||||
-- |
||||
-- see: https://github.com/sol/hpack |
||||
-- |
||||
-- hash: 7b4bb6b075db02fa61f90c38b7c14b013926cce4ef1591667dd98ba4fdc483c1 |
||||
|
||||
name: atrade-monitor |
||||
version: 0.1.0.0 |
||||
category: Web |
||||
homepage: https://github.com/githubuser/atrade-monitor#readme |
||||
author: Denis Tereshkin |
||||
maintainer: denis@kasan.ws |
||||
copyright: 2019 Denis Tereshkin |
||||
license: BSD3 |
||||
license-file: LICENSE |
||||
build-type: Simple |
||||
cabal-version: >= 1.10 |
||||
extra-source-files: |
||||
README.md |
||||
|
||||
executable atrade-monitor |
||||
main-is: Main.hs |
||||
other-modules: |
||||
Paths_atrade_monitor |
||||
hs-source-dirs: |
||||
src |
||||
default-extensions: OverloadedStrings |
||||
build-depends: |
||||
aeson |
||||
, base >=4.7 && <5 |
||||
, process |
||||
, safe |
||||
, text |
||||
, unordered-containers |
||||
default-language: Haskell2010 |
||||
@ -0,0 +1,28 @@
@@ -0,0 +1,28 @@
|
||||
name: atrade-monitor |
||||
version: 0.1.0.0 |
||||
#synopsis: |
||||
#description: |
||||
homepage: https://github.com/githubuser/atrade-monitor#readme |
||||
license: BSD3 |
||||
author: Denis Tereshkin |
||||
maintainer: denis@kasan.ws |
||||
copyright: 2019 Denis Tereshkin |
||||
category: Web |
||||
extra-source-files: |
||||
- README.md |
||||
|
||||
dependencies: |
||||
- base >= 4.7 && < 5 |
||||
- process |
||||
- aeson |
||||
- unordered-containers |
||||
- text |
||||
- safe |
||||
|
||||
default-extensions: |
||||
- OverloadedStrings |
||||
|
||||
executables: |
||||
atrade-monitor: |
||||
source-dirs: src |
||||
main: Main.hs |
||||
@ -0,0 +1,85 @@
@@ -0,0 +1,85 @@
|
||||
module Main where |
||||
|
||||
import Control.Concurrent |
||||
import Control.Monad |
||||
import Data.Aeson |
||||
import qualified Data.HashMap.Strict as HM |
||||
import qualified Data.Text as T |
||||
import Safe |
||||
import System.Environment |
||||
import System.Process |
||||
|
||||
newtype ArgsMap = ArgsMap { unArgsMap :: HM.HashMap T.Text T.Text } |
||||
deriving (Show, Eq) |
||||
|
||||
data Config = Config |
||||
{ |
||||
cGlobalLog :: FilePath, |
||||
cDelay :: Int, |
||||
cGlobalArgs :: ArgsMap, |
||||
cExecutables :: [ExecConfig] |
||||
} deriving (Show, Eq) |
||||
|
||||
data ExecConfig = ExecConfig |
||||
{ |
||||
cExecutablePath :: FilePath, |
||||
cLogPath :: FilePath, |
||||
cArgs :: ArgsMap |
||||
} deriving (Show, Eq) |
||||
|
||||
instance FromJSON ArgsMap where |
||||
parseJSON = withObject "ArgsMap" $ \o -> |
||||
case HM.traverseWithKey tryConvert o of |
||||
Just converted -> return $ ArgsMap converted |
||||
Nothing -> fail "Unable to parse argsmap" |
||||
where |
||||
tryConvert k (Object _) = Nothing |
||||
tryConvert k (Array _) = Nothing |
||||
tryConvert k (String t) = Just t |
||||
tryConvert k (Number n) = Just (T.pack $ show n) |
||||
tryConvert k (Bool b) = Just (T.pack $ show b) |
||||
tryConvert k Null = Just T.empty |
||||
|
||||
|
||||
instance FromJSON ExecConfig where |
||||
parseJSON = withObject "ExecConfig" $ \o -> |
||||
ExecConfig <$> |
||||
o .: "path" <*> |
||||
o .: "log" <*> |
||||
o .: "config" |
||||
|
||||
instance FromJSON Config where |
||||
parseJSON = withObject "Config" $ \o -> |
||||
Config <$> |
||||
o .: "global_log" <*> |
||||
o .: "delay" <*> |
||||
o .: "global_args" <*> |
||||
o .: "executables" |
||||
|
||||
main :: IO () |
||||
main = do |
||||
args <- getArgs |
||||
case headMay args of |
||||
Just configPath -> do |
||||
eResult <- eitherDecodeFileStrict' configPath |
||||
case eResult of |
||||
Right config -> runWithConfig config |
||||
Left err -> print $ "Can't read config:" ++ err |
||||
Nothing -> print $ "Usage: atrade-monitor <config-path>" |
||||
|
||||
runWithConfig :: Config -> IO () |
||||
runWithConfig config = do |
||||
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 |
||||
|
||||
|
||||
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 |
||||
|
||||
|
||||
|
||||
|
||||
@ -0,0 +1,65 @@
@@ -0,0 +1,65 @@
|
||||
# This file was automatically generated by 'stack init' |
||||
# |
||||
# Some commonly used options have been documented as comments in this file. |
||||
# For advanced use and comprehensive documentation of the format, please see: |
||||
# https://docs.haskellstack.org/en/stable/yaml_configuration/ |
||||
|
||||
# Resolver to choose a 'specific' stackage snapshot or a compiler version. |
||||
# A snapshot resolver dictates the compiler version and the set of packages |
||||
# to be used for project dependencies. For example: |
||||
# |
||||
# resolver: lts-3.5 |
||||
# resolver: nightly-2015-09-21 |
||||
# resolver: ghc-7.10.2 |
||||
# resolver: ghcjs-0.1.0_ghc-7.10.2 |
||||
# |
||||
# The location of a snapshot can be provided as a file or url. Stack assumes |
||||
# a snapshot provided as a file might change, whereas a url resource does not. |
||||
# |
||||
# resolver: ./custom-snapshot.yaml |
||||
# resolver: https://example.com/snapshots/2018-01-01.yaml |
||||
resolver: lts-12.9 |
||||
|
||||
# User packages to be built. |
||||
# Various formats can be used as shown in the example below. |
||||
# |
||||
# packages: |
||||
# - some-directory |
||||
# - https://example.com/foo/bar/baz-0.0.2.tar.gz |
||||
# - location: |
||||
# git: https://github.com/commercialhaskell/stack.git |
||||
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a |
||||
# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a |
||||
# subdirs: |
||||
# - auto-update |
||||
# - wai |
||||
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: [] |
||||
|
||||
# Override default flag values for local packages and extra-deps |
||||
# flags: {} |
||||
|
||||
# Extra package databases containing global packages |
||||
# extra-package-dbs: [] |
||||
|
||||
# Control whether we use the GHC we find on the path |
||||
# system-ghc: true |
||||
# |
||||
# Require a specific version of stack, using version ranges |
||||
# require-stack-version: -any # Default |
||||
# require-stack-version: ">=1.7" |
||||
# |
||||
# Override the architecture used by stack, especially useful on Windows |
||||
# arch: i386 |
||||
# arch: x86_64 |
||||
# |
||||
# Extra directories used by stack for building |
||||
# extra-include-dirs: [/path/to/dir] |
||||
# extra-lib-dirs: [/path/to/dir] |
||||
# |
||||
# Allow a newer minor version of GHC than the snapshot specifies |
||||
# compiler-check: newer-minor |
||||
Loading…
Reference in new issue