From 308da71afbbc579aa26b97d62b0a1eb8f6829fec Mon Sep 17 00:00:00 2001 From: d-dorazio Date: Sun, 1 Oct 2017 13:03:49 +0200 Subject: [PATCH 1/3] support multiple inputs and outputs --- src-brittany/Main.hs | 44 ++++++++++++++++++++++++-------------------- 1 file changed, 24 insertions(+), 20 deletions(-) diff --git a/src-brittany/Main.hs b/src-brittany/Main.hs index 129ee50..a88e1e3 100644 --- a/src-brittany/Main.hs +++ b/src-brittany/Main.hs @@ -14,6 +14,7 @@ import qualified Data.Map as Map import qualified Data.Text.Lazy.Builder as Text.Builder +import Control.Monad (foldM) import Data.CZipWith import qualified Debug.Trace as Trace @@ -103,8 +104,8 @@ mainCmdParser helpDesc = do printHelp <- addSimpleBoolFlag "h" ["help"] mempty printVersion <- addSimpleBoolFlag "" ["version"] mempty printLicense <- addSimpleBoolFlag "" ["license"] mempty - inputPaths <- addFlagStringParams "i" ["input"] "PATH" (flagHelpStr "path to input haskell source file") - outputPaths <- addFlagStringParams "o" ["output"] "PATH" (flagHelpStr "output file path") + inputPaths <- addFlagStringParams "i" ["input"] "PATH" (flagHelpStr "paths to input haskell source files") + outputPaths <- addFlagStringParams "o" ["output"] "PATH" (flagHelpStr "output file paths") configPaths <- addFlagStringParams "" ["config-file"] "PATH" (flagHelpStr "path to config file") -- TODO: allow default on addFlagStringParam ? cmdlineConfig <- configParser suppressOutput <- addSimpleBoolFlag @@ -128,29 +129,32 @@ mainCmdParser helpDesc = do when printHelp $ do liftIO $ print $ ppHelpShallow desc System.Exit.exitSuccess - inputPathM <- case maybeToList inputParam ++ inputPaths of - [] -> do - return Nothing - [x] -> return $ Just x - _ -> do - putStrErrLn $ "more than one input, aborting" - System.Exit.exitWith (System.Exit.ExitFailure 51) - outputPathM <- case outputPaths of - [] -> do - return Nothing - [x] -> return $ Just x - _ -> do - putStrErrLn $ "more than one output, aborting" - System.Exit.exitWith (System.Exit.ExitFailure 52) + let inputPaths' = nonEmptyList Nothing . map Just $ maybeToList inputParam ++ inputPaths + let outputPaths' = nonEmptyList Nothing . map Just $ outputPaths + when (length inputPaths' /= length outputPaths') $ do + putStrErrLn "the number of inputs must match ther number of outputs" + System.Exit.exitWith (System.Exit.ExitFailure 51) + config <- runMaybeT (readConfigs cmdlineConfig configPaths) >>= \case Nothing -> System.Exit.exitWith (System.Exit.ExitFailure 53) Just x -> return x when (confUnpack $ _dconf_dump_config $ _conf_debug $ config) $ do trace (showConfigYaml config) $ return () - eitherErrSucc <- coreIO putStrErrLn config suppressOutput inputPathM outputPathM - case eitherErrSucc of - Left errNo -> System.Exit.exitWith (System.Exit.ExitFailure errNo) - Right () -> pure () + + let ios = zipWith (coreIO putStrErrLn config suppressOutput) inputPaths' outputPaths' + errNoM <- foldM run Nothing ios + case errNoM of + Just errNo -> System.Exit.exitWith (System.Exit.ExitFailure errNo) + Nothing -> pure () + where + run acc io = do + res <- io + case res of + Left _ -> return (Just 1) + Right () -> return acc + + nonEmptyList def [] = [def] + nonEmptyList _ x = x -- | The main IO parts for the default mode of operation, and after commandline From 36af16f881f489f7b59268146c401dd42fae1945 Mon Sep 17 00:00:00 2001 From: d-dorazio Date: Sun, 1 Oct 2017 15:04:27 +0200 Subject: [PATCH 2/3] add inplace flag --- src-brittany/Main.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src-brittany/Main.hs b/src-brittany/Main.hs index a88e1e3..ed21e50 100644 --- a/src-brittany/Main.hs +++ b/src-brittany/Main.hs @@ -113,6 +113,7 @@ mainCmdParser helpDesc = do ["suppress-output"] (flagHelp $ parDoc "suppress the regular output, i.e. the transformed haskell source") _verbosity <- addSimpleCountFlag "v" ["verbose"] (flagHelp $ parDoc "[currently without effect; TODO]") + inplace <- addSimpleBoolFlag "" ["inplace"] (flagHelp $ parDoc "overwrite the input files") reorderStop inputParam <- addStringParamOpt "PATH" (paramHelpStr "path to input haskell source file") desc <- peekCmdDesc @@ -129,8 +130,12 @@ mainCmdParser helpDesc = do when printHelp $ do liftIO $ print $ ppHelpShallow desc System.Exit.exitSuccess + when (length outputPaths > 0 && inplace) $ do + putStrErrLn "cannot specify output files and inplace at the same time" + System.Exit.exitWith (System.Exit.ExitFailure 52) + let inputPaths' = nonEmptyList Nothing . map Just $ maybeToList inputParam ++ inputPaths - let outputPaths' = nonEmptyList Nothing . map Just $ outputPaths + let outputPaths' = if inplace then inputPaths' else nonEmptyList Nothing . map Just $ outputPaths when (length inputPaths' /= length outputPaths') $ do putStrErrLn "the number of inputs must match ther number of outputs" System.Exit.exitWith (System.Exit.ExitFailure 51) From 95c40f2b1e2418945761b9a590db005e39c5b33b Mon Sep 17 00:00:00 2001 From: d-dorazio Date: Mon, 2 Oct 2017 13:51:31 +0200 Subject: [PATCH 3/3] address review comments --- src-brittany/Main.hs | 35 ++++++++++++++++------------------- 1 file changed, 16 insertions(+), 19 deletions(-) diff --git a/src-brittany/Main.hs b/src-brittany/Main.hs index ed21e50..6f2d4d8 100644 --- a/src-brittany/Main.hs +++ b/src-brittany/Main.hs @@ -14,7 +14,6 @@ import qualified Data.Map as Map import qualified Data.Text.Lazy.Builder as Text.Builder -import Control.Monad (foldM) import Data.CZipWith import qualified Debug.Trace as Trace @@ -130,15 +129,22 @@ mainCmdParser helpDesc = do when printHelp $ do liftIO $ print $ ppHelpShallow desc System.Exit.exitSuccess - when (length outputPaths > 0 && inplace) $ do - putStrErrLn "cannot specify output files and inplace at the same time" - System.Exit.exitWith (System.Exit.ExitFailure 52) - let inputPaths' = nonEmptyList Nothing . map Just $ maybeToList inputParam ++ inputPaths - let outputPaths' = if inplace then inputPaths' else nonEmptyList Nothing . map Just $ outputPaths + let inputPaths' = case maybeToList inputParam ++ inputPaths of + [] -> [Nothing] + ps -> map Just ps + + outputPaths' <- case outputPaths of + [] | not inplace -> return [Nothing] + [] -> return inputPaths' + ps | not inplace -> return . map Just $ ps + _ -> do + putStrErrLn "cannot specify output files and inplace at the same time" + System.Exit.exitWith (System.Exit.ExitFailure 51) + when (length inputPaths' /= length outputPaths') $ do putStrErrLn "the number of inputs must match ther number of outputs" - System.Exit.exitWith (System.Exit.ExitFailure 51) + System.Exit.exitWith (System.Exit.ExitFailure 52) config <- runMaybeT (readConfigs cmdlineConfig configPaths) >>= \case Nothing -> System.Exit.exitWith (System.Exit.ExitFailure 53) @@ -147,19 +153,10 @@ mainCmdParser helpDesc = do trace (showConfigYaml config) $ return () let ios = zipWith (coreIO putStrErrLn config suppressOutput) inputPaths' outputPaths' - errNoM <- foldM run Nothing ios - case errNoM of - Just errNo -> System.Exit.exitWith (System.Exit.ExitFailure errNo) - Nothing -> pure () - where - run acc io = do - res <- io + res <- fmap sequence_ $ sequence ios case res of - Left _ -> return (Just 1) - Right () -> return acc - - nonEmptyList def [] = [def] - nonEmptyList _ x = x + Left _ -> System.Exit.exitWith (System.Exit.ExitFailure 1) + Right _ -> pure () -- | The main IO parts for the default mode of operation, and after commandline