commit
53a0833e10
8 changed files with 248 additions and 0 deletions
@ -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,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 @@ |
|||||||
|
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 @@ |
|||||||
|
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 @@ |
|||||||
|
# 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