Commit 500253b9 authored by Valentin Reis's avatar Valentin Reis

refactor (argument split)

parent 8a0610ca
Pipeline #5932 failed with stages
in 1 minute and 20 seconds
.PHONY: ghcid-tests ghcid-lib
ghcid-lib:
sh -c "while true; do \
nix-shell \
--run 'ghcid \
--command \"cabal new-repl argonix\" \
--restart=argonix.cabal \
--restart=default.nix\
--restart=shell.nix'\
; done"
......@@ -12,36 +12,29 @@ executable argonix
hs-source-dirs: src
build-depends:
base,
turtle,
protolude,
data-default,
optparse-applicative,
unix,
text,
ansi-terminal,
neat-interpolation,
typed-process,
bytestring,
directory,
filepath,
hscolour,
foldl,
system-filepath,
protolude
typed-process
default-language: Haskell2010
ghc-options:
-threaded
-fwarn-wrong-do-bind
-Wall
-Wincomplete-uni-patterns
-Wincomplete-record-updates
-Wmissing-home-modules
-Widentities
-Wredundant-constraints
-Wmissing-export-lists
-Wcpp-undef
-fwarn-tabs
-fwarn-unused-imports
-fwarn-unused-do-bind
-fwarn-missing-signatures
-fwarn-name-shadowing
-fprint-potential-instances
-Wmissing-export-lists
-fwarn-unused-do-bind
-fwarn-incomplete-patterns
{-# language RecordWildCards #-}
{-# language ApplicativeDo #-}
{-# language NoImplicitPrelude #-}
{-# language LambdaCase #-}
{-# language OverloadedStrings #-}
{-|
Module : Main
Module : Argonix
Description : argonix
Copyright : (c) Valentin Reis, 2018
License : MIT
Maintainer : fre@freux.fr
-}
module Main
module Argonix
( main
)
where
import Data.Default
import Args
import Protolude
import Options.Applicative
import qualified Data.Text as T
( lines
, isInfixOf
, unwords
)
import Options.Applicative
import System.Console.ANSI
import System.Console.ANSI.Types ( Color )
import System.Posix.Process
......@@ -91,110 +90,10 @@ main = SIO.hSetBuffering SIO.stdout SIO.NoBuffering
<> help "Type of operation to run."
)
data ArgsCommon = ArgsCommon
{ argopkgs :: Text
, verbosity :: Verbosity
, run :: Maybe Text
, overrides :: [(Text, Text)]
, grafting :: Grafting
, sandboxing :: Sandboxing
} deriving (Show)
data Verbosity = Verbose | Normal deriving (Show, Eq)
data Sandboxing = Sandbox | NoSandbox deriving (Show, Eq)
data Grafting = Libnrm | NoGraft deriving (Show, Eq)
data NixStaticInOut = Both Text
| Src Text
| SimpleTarget Text
| Target Text deriving (Eq)
data NixCommand = NixBuild | NixShell
data ArgsRemote = ArgsRemote
{ targetMachine
, retreive
, retreiveAs :: Maybe Text
} deriving (Show)
toCommand :: NixCommand -> Text
toCommand NixBuild = "nix-build"
toCommand NixShell = "nix-shell"
instance Default ArgsCommon where
def = ArgsCommon
{ verbosity = Normal,
argopkgs = "<argopkgs>",
run = Nothing,
overrides = [],
grafting = NoGraft,
sandboxing = NoSandbox
}
instance Default ArgsRemote where
def = ArgsRemote
{ targetMachine = Nothing,
retreive = Nothing,
retreiveAs = Nothing
}
targets :: [Text]
targets = mapMaybe toTarget nixStatic
where
toTarget (Target t) = Just t
toTarget (SimpleTarget t) = Just t
toTarget (Both t) = Just t
toTarget _ = Nothing
sources :: [Text]
sources = mapMaybe toSrc nixStatic
where
toSrc (Src t) = Just t
toSrc (Both t) = Just t
toSrc _ = Nothing
isTarget :: Text -> Bool
isTarget x = Target x `elem` nixStatic
nixStatic :: [NixStaticInOut]
nixStatic = src <> both <> simpletarget <> target
where
src = [Src "experiments"]
both =
Both
<$> [ "aml"
, "libnrm"
, "numabench"
, "repoquality"
, "excit"
, "nrm"
, "containers"
, "argotk"
, "amg"
, "lammps"
, "qmcpack"
, "stream"
, "openmc"
, "argonix"
]
simpletarget = SimpleTarget <$> ["numabench-check", "excit-check"]
target =
Target
<$> [ "powerexpe"
, "test"
, "report"
, "testHello"
, "testListen"
, "testListen"
, "testHello"
, "testListen"
, "testPerfwrapper"
, "testPower"
, "testSTREAM"
, "testAMG"
, "testOpenMC"
, "testLAMMPS"
, "testQMCPack"
, "testAll"
]
targetParser :: Parser Text
targetParser = strArgument
......@@ -203,66 +102,6 @@ targetParser = strArgument
)
where ts = intersperse " " targets
remoteParser :: Parser ArgsRemote
remoteParser = do
retreive <- optional $ strOption
(long "retreive" <> metavar "RELATIVE_PATH" <> help
"File/Folder to retreive from the remote machine."
)
retreiveAs <- optional $ strOption
(long "retreiveAs" <> metavar "LOCAL_PATH" <> help
"File/Folder to save retreived data as (locally)."
)
targetMachine <- optional $ strOption
(long "target_machine" <> metavar "USER@HOST" <> help
"Target machine. defaults to localhost via forking."
)
pure ArgsRemote {..}
commonParser :: Parser ArgsCommon
commonParser = do
argopkgs <- strOption
( long "argopkgs"
<> metavar "ARGOPKGS"
<> showDefault
<> value (argopkgs def)
<> help "Nix expression that produces the argopkgs source path."
)
verbosity <- flag
Normal
Verbose
(long "verbose" <> short 'v' <> help "Enable verbose mode")
sandboxing <- flag
NoSandbox
Sandbox
(long "sandboxing" <> short 's' <> help "Enable nix sandboxing.")
grafting <- flag
NoGraft
Libnrm
(long "grafting" <> short 'g' <> help
"Enable libnrm grafting to avoid rebuilding applications."
)
overrides <- catMaybes <$> ts
run <- optional $ strOption
(long "run" <> metavar "COMMAND" <> help
"Command to run the environment instead of an interactive shell"
)
pure ArgsCommon {..}
where
ts :: Parser [Maybe (Text, Text)]
ts = traverse optSrc sources
optSrc :: Text -> Parser (Maybe (Text, Text))
optSrc longform = do
parsed <- optional $ strOption
(long (toS longform) <> metavar "PATH" <> help
(toS longform <> " source folder override.")
)
pure $ mapT longform parsed
mapT :: Text -> Maybe Text -> Maybe (Text, Text)
mapT longform thePath = case thePath of
Nothing -> Nothing
Just p -> Just (longform, p)
sudoRemoveFile :: Text -> FilePath -> IO ()
sudoRemoveFile desc filePath = do
P.runProcess_ (P.shell $ "test " <> filePath)
......@@ -348,7 +187,9 @@ setupSystem target sa = do
[]
varTMPDIR <- rpVerbose "mktemp" ["-d", "/tmp/tmpdir-XXXX"] []
sVerbose $ "chmod 777 " <> varTMPDIR
sVerbose ("chmod 777 " <> varTMPDIR) >>= \case
ExitFailure _ -> die "chmod failed for tmpdir"
ExitSuccess -> return ()
passVars <- getVars ["PATH", "NIX_PATH", "NIX_SSL_CERT_FILE"]
......@@ -361,7 +202,7 @@ setupSystem target sa = do
return (envVars, varTMPDIR)
where
getVars :: [Text] -> IO [(Text, Text)]
getVars vars = catMaybes <$> mapM maybeGet vars
getVars vars = catMaybes <$> for vars maybeGet
maybeGet :: Text -> IO (Maybe (Text, Text))
maybeGet var = SE.lookupEnv (toS var) >>= \case
......@@ -376,11 +217,17 @@ setupSystem target sa = do
"nix-build"
(fmap toS (nixArguments "containers" sa) ++ ["--no-out-link"])
env
sVerbose "sudo rm -rf /tmp/argo_nodeos_config"
sVerbose "sudo rm -rf /tmp/argo_nodeos_config" >>= \case
ExitSuccess -> return ()
ExitFailure n ->
die ("Failed to remove /tmp/argo_nodeos_config" <> show n)
sVerbose
$ "cp "
( "cp "
<> toS nodeos_config
<> "/bin/argo_nodeos_config /tmp/argo_nodeos_config"
<> "/bin/argo_nodeos_config /tmp/argo_nodeos_config") >>= \case
ExitSuccess -> return ()
ExitFailure n ->
die ("Failed to copy argo_nodeos_config" <> show n)
sVerbose "sudo chown root:root /tmp/argo_nodeos_config" >>= \case
ExitSuccess -> return ()
ExitFailure n ->
......@@ -423,11 +270,11 @@ wrap nixCommand target sa@ArgsCommon {..} = do
ExitFailure _ -> copyFailure (toS tmpDir) >> die "build failed."
where
copySuccess source = do
runProcessVerbose verbosity "cp" ["-Lr", source, "./result"] []
runProcessVerbose verbosity "chmod" ["-R", "+w", "./result"] []
runProcessVerbose verbosity "cp" ["-Lr", source, "./result"] []
runProcessVerbose verbosity "chmod" ["-R", "+w", "./result"] []
copyFailure source = do
runProcessVerbose verbosity "cp" ["-Lr", source, "./nixtmpdir"] []
runProcessVerbose verbosity "chmod" ["-R", "+w", "./nixtmpdir"] []
runProcessVerbose verbosity "cp" ["-Lr", source, "./nixtmpdir"] []
runProcessVerbose verbosity "chmod" ["-R", "+w", "./nixtmpdir"] []
nixc = toCommand nixCommand
arglist =
......
{-# language ApplicativeDo #-}
{-# language OverloadedStrings #-}
{-# language RecordWildCards #-}
module Args
( ArgsCommon(..)
, ArgsRemote(..)
, Verbosity(..)
, NixCommand(..)
, Grafting(..)
, Sandboxing(..)
, commonParser
, remoteParser
, targets
, isTarget
)
where
import Data.Default
import Protolude
import Options.Applicative
data ArgsRemote = ArgsRemote
{ targetMachine
, retreive
, retreiveAs :: Maybe Text
} deriving (Show)
data ArgsCommon = ArgsCommon
{ argopkgs :: Text
, verbosity :: Verbosity
, run :: Maybe Text
, overrides :: [(Text, Text)]
, grafting :: Grafting
, sandboxing :: Sandboxing
} deriving (Show)
data Verbosity = Verbose | Normal deriving (Show, Eq)
data Sandboxing = Sandbox | NoSandbox deriving (Show, Eq)
data Grafting = Libnrm | NoGraft deriving (Show, Eq)
data NixStaticInOut = Both Text
| Src Text
| SimpleTarget Text
| Target Text deriving (Eq)
data NixCommand = NixBuild | NixShell
instance Default ArgsCommon where
def = ArgsCommon
{ verbosity = Normal,
argopkgs = "<argopkgs>",
run = Nothing,
overrides = [],
grafting = NoGraft,
sandboxing = NoSandbox
}
instance Default ArgsRemote where
def = ArgsRemote
{ targetMachine = Nothing,
retreive = Nothing,
retreiveAs = Nothing
}
remoteParser :: Parser ArgsRemote
remoteParser = do
retreive <- optional $ strOption
(long "retreive" <> metavar "RELATIVE_PATH" <> help
"File/Folder to retreive from the remote machine."
)
retreiveAs <- optional $ strOption
(long "retreiveAs" <> metavar "LOCAL_PATH" <> help
"File/Folder to save retreived data as (locally)."
)
targetMachine <- optional $ strOption
(long "target_machine" <> metavar "USER@HOST" <> help
"Target machine. defaults to localhost via forking."
)
pure ArgsRemote {..}
commonParser :: Parser ArgsCommon
commonParser = do
argopkgs <- strOption
( long "argopkgs"
<> metavar "ARGOPKGS"
<> showDefault
<> value (argopkgs def)
<> help "Nix expression that produces the argopkgs source path."
)
verbosity <- flag
Normal
Verbose
(long "verbose" <> short 'v' <> help "Enable verbose mode")
sandboxing <- flag
NoSandbox
Sandbox
(long "sandboxing" <> short 's' <> help "Enable nix sandboxing.")
grafting <- flag
NoGraft
Libnrm
(long "grafting" <> short 'g' <> help
"Enable libnrm grafting to avoid rebuilding applications."
)
overrides <- catMaybes <$> ts
run <- optional $ strOption
(long "run" <> metavar "COMMAND" <> help
"Command to run the environment instead of an interactive shell"
)
pure ArgsCommon {..}
where
ts :: Parser [Maybe (Text, Text)]
ts = traverse optSrc sources
optSrc :: Text -> Parser (Maybe (Text, Text))
optSrc longform = do
parsed <- optional $ strOption
(long (toS longform) <> metavar "PATH" <> help
(toS longform <> " source folder override.")
)
pure $ mapT longform parsed
mapT :: Text -> Maybe Text -> Maybe (Text, Text)
mapT longform thePath = case thePath of
Nothing -> Nothing
Just p -> Just (longform, p)
targets :: [Text]
targets = mapMaybe toTarget nixStatic
where
toTarget (Target t) = Just t
toTarget (SimpleTarget t) = Just t
toTarget (Both t) = Just t
toTarget _ = Nothing
sources :: [Text]
sources = mapMaybe toSrc nixStatic
where
toSrc (Src t) = Just t
toSrc (Both t) = Just t
toSrc _ = Nothing
isTarget :: Text -> Bool
isTarget x = Target x `elem` nixStatic
nixStatic :: [NixStaticInOut]
nixStatic = src <> both <> simpletarget <> target
where
src = [Src "experiments"]
both =
Both
<$> [ "aml"
, "libnrm"
, "numabench"
, "repoquality"
, "excit"
, "nrm"
, "containers"
, "argotk"
, "amg"
, "lammps"
, "qmcpack"
, "stream"
, "openmc"
, "argonix"
]
simpletarget = SimpleTarget <$> ["numabench-check", "excit-check"]
target =
Target
<$> [ "powerexpe"
, "test"
, "report"
, "testHello"
, "testListen"
, "testListen"
, "testHello"
, "testListen"
, "testPerfwrapper"
, "testPower"
, "testSTREAM"
, "testAMG"
, "testOpenMC"
, "testLAMMPS"
, "testQMCPack"
, "testAll"
]
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