Commit 6ee0a893 authored by Valentin Reis's avatar Valentin Reis

Refactor with haskell-tools-cli

parent 1b92fba4
.PHONY: ghcid-tests ghcid-lib
.PHONY: ht-refact-core
.PHONY: brittany-core
.PHONY: codequality
ghcid-lib:
sh -c "while true; do \
nix-shell \
--run 'ghcid \
--command \"cabal repl --ghc-options=-fno-code --ghc-options=-fno-break-on-exception --ghc-options=-fno-break-on-error --ghc-options=-v1 --ghc-options=-ferror-spans --ghc-options=-j\" \
--restart=argotk.cabal \
--restart=default.nix\
--restart=shell.nix'\
; done"
codequality : ht-refact brittany
ht-refact:
nix-shell \
--run 'ht-refact \
-w `which hfswatch` \
--project-type cabal \
. \
-e \
"OrganizeExtensions Argo.Stack\
OrganizeExtensions Argo.Args ;\
OrganizeExtensions Argo.Utils ;\
OrganizeExtensions Argo.Types ;\
OrganizeImports Argo.Stack ;\
OrganizeImports Argo.Args ;\
OrganizeImports Argo.Utils ;\
OrganizeImports Argo.Types ;\
GenerateExports Argo.Stack ;\
GenerateExports Argo.Args ;\
GenerateExports Argo.Utils ;\
GenerateExports Argo.Types\
"' || true
brittany:
nix-shell \
--run 'brittany --write-mode inplace src/*.hs src/Argo/*hs'
......@@ -60,16 +60,15 @@ argotk TestHello --help
Output:
``` {.txt}
Usage: argotk TestHello [-v|--verbose] [--app APP]
Usage: argotk TestHello [-v|--verbose] [--app APP] [ENVvar] [ARGS]
[--container_name ARGO_CONTAINER_UUID]
[--output_dir DIR] [--manifest_directory DIR]
[--manifest_name FILENAME] [--prelude_command COMMAND]
[--daemon BEHAVIOR] [--cmd_run BEHAVIOR]
[--cmd_listen BEHAVIOR]
[--cmd_listen BEHAVIOR] [--cmd_listen_progress BEHAVIOR]
[--cmd_listen_performance BEHAVIOR]
[--cmd_listen_progress BEHAVIOR]
[--cmd_listen_power BEHAVIOR] [--threadCount THREADS]
[--powercap POWERCAP] [ARGS]
[--powercap POWERCAP]
Setup stack and check that a hello world app sendsmessage back to cmd's
stdout.
......@@ -77,13 +76,15 @@ Available options:
-v,--verbose Enable verbose mode
--app APP Target application executable name. PATH is
inherited. (default: AppName "echo")
ENVvar Env.Vars. for running app.
ARGS Application arguments.
--container_name ARGO_CONTAINER_UUID
Container
name (default: ContainerName "testContainer")
--output_dir DIR Working
directory. (default: WorkingDirectory (FilePath "_output"))
--manifest_directory DIR Manifest lookup
directory (default: ShareDir (FilePath "/nix/store/mdfc7ipmx44j1ydq3c3gv0h03lmgk9jc-argotk-0.1.0.0/share"))
directory (default: ShareDir (FilePath "/nix/store/w0cji2rimg3g48gfjncmysdbms7mg8ql-argotk-0.1.0.0/share"))
--manifest_name FILENAME Manifest file basename (relative to
--manifest_directory) (default: ManifestName (FilePath "basic.json"))
--prelude_command COMMAND
......@@ -94,12 +95,12 @@ Available options:
--cmd_run BEHAVIOR `cmd run`
behavior (default: Test (TestText (TextBehaviorStdout (WaitFor "someComplexTextMessage12349")) (TextBehaviorStderr ExpectClean)) (StdOutLog "monitored-cmdrun-out.log") (StdErrLog "monitored-cmdrun-err.log"))
--cmd_listen BEHAVIOR `cmd listen` behavior (default: DontRun)
--cmd_listen_performance BEHAVIOR
`cmd listen --filter performance`
behavior (default: DontRun)
--cmd_listen_progress BEHAVIOR
`cmd listen --filter progress`
behavior (default: DontRun)
--cmd_listen_performance BEHAVIOR
`cmd listen --filter performance`
behavior (default: DontRun)
--cmd_listen_power BEHAVIOR
`cmd listen --filter power`
behavior (default: DontRun)
......@@ -107,7 +108,6 @@ Available options:
stack. (default: HwThreadCount 8)
--powercap POWERCAP Powercap strategy: Fixed x | None |
Adaptive (default: None)
ARGS Application arguments.
-h,--help Show this help text
```
......
......@@ -4,16 +4,8 @@
rec {
argotk = pkgs.argotk;
hack = pkgs.argolib.getHackEnv pkgs pkgs.haskellPackages argotk;
shakeEnv = pkgs.stdenv.mkDerivation {
name = "shake";
ARGOTK_SHARE = "${argotk}/share";
buildInputs = [
(pkgs.haskellPackages.ghcWithPackages (p: with p; [
argotk
pkgs.hwloc
shake
panpipe
]))
];
};
post = (pkgs.argolib.getPostEnv pkgs pkgs.haskellPackages argotk).overrideAttrs
(old: {
ARGOTK_SHARE="${argotk}/share";
});
}
#! /usr/bin/env nix-shell
#! nix-shell default.nix -i runhaskell -A shakeEnv
{-|
Module : shake.hs
Description : dev tasks.
Copyright : (c) Valentin Reis, 2018
License : MIT
Maintainer : fre@freux.fr -}
Maintainer : fre@freux.fr
-}
import Development.Shake
import Protolude
import Development.Shake.FilePath
import Control.Monad
refactCommands =
[ "OrganizeExtensions Argo.Args"
, "OrganizeExtensions Argo.Utils"
, "OrganizeExtensions Argo.Types"
, "OrganizeImports Argo.Stack"
, "OrganizeImports Argo.Args"
, "OrganizeImports Argo.Utils"
, "OrganizeImports Argo.Types"
, "GenerateExports Argo.Stack"
, "GenerateExports Argo.Args"
, "GenerateExports Argo.Utils"
, "GenerateExports Argo.Types"
]
main = shakeArgs shakeOptions $ do
phony "clean" $ do
removeFilesAfter "." ["README.md"]
phony "clean" $ removeFilesAfter "." ["README.md"]
phony "ghcid"
$ cmd_ Shell
$ "while true; do "
<> "nix-shell "
<> "--run 'ghcid "
<> "--command \"cabal repl --ghc-options=-fno-code "
<> "--ghc-options=-fno-break-on-exception "
<> "--ghc-options=-fno-break-on-error "
<> "--ghc-options=-v1 --ghc-options=-ferror-spans "
<> "--ghc-options=-j\" "
<> "--restart=argotk.cabal "
<> "--restart=default.nix"
<> "--restart=shell.nix'"
<> "; done"
phony "ht-refact" htRefactAll
phony "brittany" brittany
phony "codequality" $ brittany >> htRefactAll
want ["README.md"]
"README.md" %> \out -> do
let template = ".README.md"
need [template , "src/argotk.hs" , "src/Argo/Stack.hs"]
need [template, "src/argotk.hs", "src/Argo/Stack.hs"]
(Stdout panpipe) <- cmd "which panpipe"
cmd_ "pandoc --filter"
[take (length panpipe - 1) panpipe, template, "-o", out]
where
brittany =
cmd_ Shell $ "brittany --write-mode inplace" <> " src/*.hs src/Argo/*hs"
htRefactAll = for_ refactCommands htRefact
htRefact x =
cmd_ Shell
$ "ht-refact "
<> "-w `which hfswatch` "
<> "--project-type cabal "
<> ". "
<> "-e \""
<> x
<> "\" || true"
{-# language OverloadedStrings #-}
{-# language ApplicativeDo #-}
{-# language RecordWildCards #-}
module Argo.Args
( parseExtendStackArgs
......@@ -27,96 +26,115 @@ behaviorOption :: Mod OptionFields ProcessBehavior -> Parser ProcessBehavior
behaviorOption = option behavior
parseExtendStackArgs :: StackArgs -> Parser StackArgs
parseExtendStackArgs sa = do
verbosity <- flag
parseExtendStackArgs sa =
StackArgs <$>
pverbosity
<*> papp
<*> pvars
<*> pargs
<*> pcontainerName
<*> pworkingDirectory
<*> pshareDir
<*> pmanifestName
<*> ppreludeCommand
<*> pdaemon
<*> pcmdrun
<*> pcmdlisten
<*> pcmdlistenprogress
<*> pcmdlistenperformance
<*> pcmdlistenpower
<*> phwThreadCount
<*> ppowercap
where
pverbosity = flag
Normal
Verbose
(long "verbose" <> short 'v' <> help "Enable verbose mode")
app <- strOption
papp = strOption
( long "app"
<> metavar "APP"
<> help "Target application executable name. PATH is inherited."
<> showDefault
<> value (app sa)
)
containerName <- strOption
pcontainerName = strOption
( long "container_name"
<> metavar "ARGO_CONTAINER_UUID"
<> help "Container name"
<> showDefault
<> value (containerName sa)
)
workingDirectory <- strOption
pworkingDirectory = strOption
( long "output_dir"
<> metavar "DIR"
<> help "Working directory."
<> showDefault
<> value (workingDirectory sa)
)
shareDir <- strOption
pshareDir = strOption
( long "manifest_directory"
<> metavar "DIR"
<> help "Manifest lookup directory"
<> showDefault
<> value (shareDir sa)
)
manifestName <- strOption
pmanifestName = strOption
( long "manifest_name"
<> metavar "FILENAME"
<> help "Manifest file basename (relative to --manifest_directory)"
<> showDefault
<> value (manifestName sa)
)
preludeCommand <- strOption
ppreludeCommand = strOption
( long "prelude_command"
<> metavar "COMMAND"
<> help "Command to run before executing the stack (after stack setup)"
<> showDefault
<> value (preludeCommand sa)
)
daemon <- behaviorOption
pdaemon = behaviorOption
( long "daemon"
<> metavar "BEHAVIOR"
<> help "`daemon` behavior"
<> showDefault
<> value (daemon sa)
)
cmdrun <- behaviorOption
pcmdrun = behaviorOption
( long "cmd_run"
<> metavar "BEHAVIOR"
<> help "`cmd run` behavior"
<> showDefault
<> value (cmdrun sa)
)
cmdlisten <- behaviorOption
pcmdlisten = behaviorOption
( long "cmd_listen"
<> metavar "BEHAVIOR"
<> help "`cmd listen` behavior"
<> showDefault
<> value (cmdlisten sa)
)
cmdlistenperformance <- behaviorOption
pcmdlistenperformance = behaviorOption
( long "cmd_listen_performance"
<> metavar "BEHAVIOR"
<> help "`cmd listen --filter performance` behavior"
<> showDefault
<> value (cmdlistenperformance sa)
)
cmdlistenprogress <- behaviorOption
pcmdlistenprogress = behaviorOption
( long "cmd_listen_progress"
<> metavar "BEHAVIOR"
<> help "`cmd listen --filter progress` behavior"
<> showDefault
<> value (cmdlistenprogress sa)
)
cmdlistenpower <- behaviorOption
pcmdlistenpower = behaviorOption
( long "cmd_listen_power"
<> metavar "BEHAVIOR"
<> help "`cmd listen --filter power` behavior"
<> showDefault
<> value (cmdlistenpower sa)
)
hwThreadCount <- option
phwThreadCount = option
auto
( long "threadCount"
<> metavar "THREADS"
......@@ -124,7 +142,7 @@ parseExtendStackArgs sa = do
<> showDefault
<> value (hwThreadCount sa)
)
powercap <- option
ppowercap = option
auto
( long "powercap"
<> metavar "POWERCAP"
......@@ -132,8 +150,8 @@ parseExtendStackArgs sa = do
<> showDefault
<> value (powercap sa)
)
args <- some (argument str (metavar "ARGS" <> help "Application arguments."))
pargs = some (argument str (metavar "ARGS" <> help "Application arguments."))
<|> pure (args sa)
vars <- some (argument auto (metavar "ENVvar" <> help "Env.Vars. for running app."))
<|> pure (vars sa)
pure StackArgs {..}
pvars =
some (argument auto (metavar "ENVvar" <> help "Env.Vars. for running app."))
<|> pure (vars sa)
......@@ -12,8 +12,18 @@ Maintainer : fre@freux.fr
-}
module Argo.Stack
( StackOutput(..)
, cleanLeftovers
( cleanLeftovers
, prepareDaemon
, cmdRunI
, cmdListenI
, cmdListenProgressI
, cmdListenPerformanceI
, cmdListenPowerI
, StackOutput(..)
, Tracebacks
, TracebackScanOut(..)
, TracebackScanErr(..)
, StackI(..)
, runStack
)
where
......@@ -21,27 +31,27 @@ where
import Argo.Types
import Data.Coerce ( coerce )
import Prelude hiding ( FilePath )
import Turtle
import Turtle.Shell
import Prelude hiding ( FilePath )
import Filesystem.Path ( (</>) )
import Control.Concurrent.Async
import Data.Text as T
hiding ( empty )
import Argo.Utils
import System.Process as P
hiding ( shell )
import Control.Foldl as Fold
( length )
import Control.Monad ( mapM_
, filterM
)
import Data.Foldable ( for_ )
import Data.Traversable ( for )
import Data.Maybe
import Control.Foldl as Fold
( length )
import Data.Text as T
hiding ( empty )
import Data.Traversable ( for )
import System.Process as P
hiding ( shell )
import Text.Show.Pretty
cleanLeftovers :: WorkingDirectory -> Shell () --TODO
......
......@@ -116,4 +116,3 @@ instance Default StackArgs where
, hwThreadCount = HwThreadCount 1
, powercap = None
}
......@@ -32,28 +32,42 @@ module Argo.Utils
where
import Argo.Types
import Turtle
import Data.ByteString as B
hiding ( empty )
import Data.Conduit
import Data.Conduit.Process hiding ( shell )
import Prelude hiding ( FilePath )
import System.Console.ANSI
import System.Console.ANSI.Types ( Color )
import System.Posix.Signals
import System.Process hiding ( shell )
import Data.Conduit
import Data.Conduit.Process hiding ( shell )
import Data.ByteString as B
hiding ( empty )
import System.Posix.Signals ( installHandler
, keyboardSignal
, Handler(..)
)
import Turtle
import System.IO ( BufferMode(NoBuffering)
, hSetBuffering
import Control.Exception.Base ( Exception
, try
, throw
)
import Control.Monad.IO.Unlift ( MonadIO(..)
, withRunInIO
)
import Data.Text.Encoding as TE
import Data.Conduit.Combinators as CC
import Control.Exception.Base
import Data.Typeable
( sinkHandle
, withSinkFile
)
import Data.Text as T
( unpack
, Text
)
import Data.Text.Encoding as TE
( decodeUtf8
, encodeUtf8
)
import Data.Typeable ( Typeable )
import System.IO ( BufferMode(NoBuffering)
, hSetBuffering
)
import qualified System.IO as IO
-- | Miscellaneous printing utilities
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment