Merge pull request #89 from everythingfunctional/MoreArguments

Add ability to specify which test or program to run and their args

3 files changed, 48 insertions, 18 deletions

diff --git a/README.md b/README.md
index ab92fcb..e3e1e1c 100644
--- a/README.md
+++ b/README.md
@@ -24,9 +24,9 @@ git clone https://github.com/fortran-lang/fpm
 cd fpm
 ```
 
-### Build and Test FPM
+### Build and Test fpm
 
-Build FPM using:
+Build fpm using:
 ```
 stack build
 ```
@@ -41,6 +41,17 @@ stack install
 
 On Linux, the above command installs `stack` to `${HOME}/.local/bin`.
 
-### Building your Fortran project with FPM
+### Building your Fortran project with fpm
 
-Please follow the instructions in the [Packaging guide](PACKAGING.md).
+fpm understands the basic commands:
+
+* `fpm build` - build your library, executables and tests
+* `fpm run` - run executables
+* `fpm test`- run tests
+
+The command `fpm run` can optionally accept the name of the specific executable
+to run, as can `fpm test`; like `fpm run specifc_executable`. Command line
+arguments can also be passed to the executable(s) or test(s) with the option
+`--args "some arguments"`.
+
+See additional instructions in the [Packaging guide](PACKAGING.md).
diff --git a/src/Fpm.hs b/src/Fpm.hs
index 3903e5e..e823e7f 100644
--- a/src/Fpm.hs
+++ b/src/Fpm.hs
@@ -13,7 +13,7 @@ import           Build                          ( buildLibrary
                                                 , buildProgram
                                                 )
 import           Control.Monad.Extra            ( concatMapM )
-import           Data.List                      ( nub )
+import           Data.List                      (isSuffixOf,  find, nub )
 import qualified Data.Map                      as Map
 import qualified Data.Text.IO                  as TIO
 import           Development.Shake              ( FilePattern
@@ -35,9 +35,13 @@ import           Options.Applicative            ( Parser
                                                 , helper
                                                 , info
                                                 , long
+                                                , metavar
                                                 , progDesc
+                                                , strArgument
+                                                , strOption
                                                 , subparser
                                                 , switch
+                                                , value
                                                 )
 import           System.Directory               ( doesDirectoryExist
                                                 , doesFileExist
@@ -52,7 +56,7 @@ import           Toml                           ( TomlCodec
                                                 )
 import qualified Toml
 
-data Arguments = Arguments { command' :: Command, release :: Bool }
+data Arguments = Arguments { command' :: Command, release :: Bool, commandArguments :: String }
 
 data TomlSettings = TomlSettings {
       tomlSettingsProjectName :: String
@@ -92,7 +96,7 @@ data GitRef = Tag String | Branch String | Commit String deriving Show
 
 data PathVersionSpec = PathVersionSpec { pathVersionSpecPath :: String } deriving Show
 
-data Command = Run | Test | Build
+data Command = Run String | Test String | Build
 
 data DependencyTree = Dependency {
       dependencyName :: String
@@ -113,8 +117,8 @@ start args = do
 
 app :: Arguments -> AppSettings -> IO ()
 app args settings = case command' args of
-  Build -> build settings
-  Run   -> do
+  Build     -> build settings
+  Run whichOne  -> do
     build settings
     let buildPrefix = appSettingsBuildPrefix settings
     let
@@ -128,8 +132,15 @@ app args settings = case command' args of
     canonicalExecutables <- mapM makeAbsolute executables
     case canonicalExecutables of
       [] -> putStrLn "No Executables Found"
-      _  -> mapM_ system canonicalExecutables
-  Test -> do
+      _  -> case whichOne of
+        "" -> mapM_ system (map (++ " " ++ commandArguments args) canonicalExecutables)
+        name -> do
+            case find (name `isSuffixOf`) canonicalExecutables of
+              Nothing -> putStrLn "Executable Not Found"
+              Just specified -> do
+                  system (specified ++ " " ++ (commandArguments args))
+                  return ()
+  Test whichOne -> do
     build settings
     let buildPrefix = appSettingsBuildPrefix settings
     let
@@ -143,7 +154,14 @@ app args settings = case command' args of
     canonicalExecutables <- mapM makeAbsolute executables
     case canonicalExecutables of
       [] -> putStrLn "No Tests Found"
-      _  -> mapM_ system canonicalExecutables
+      _  -> case whichOne of
+        "" -> mapM_ system (map (++ " " ++ commandArguments args) canonicalExecutables)
+        name -> do
+            case find (name `isSuffixOf`) canonicalExecutables of
+              Nothing -> putStrLn "Test Not Found"
+              Just specified -> do
+                  system (specified ++ " " ++ (commandArguments args))
+                  return ()
 
 build :: AppSettings -> IO ()
 build settings = do
@@ -245,12 +263,13 @@ arguments =
                      (info buildArguments (progDesc "Build the executable"))
           )
     <*> switch (long "release" <> help "Build in release mode")
+    <*> strOption (long "args" <> metavar "ARGS" <> value "" <> help "Arguments to pass to executables/tests")
 
 runArguments :: Parser Command
-runArguments = pure Run
+runArguments = Run <$> strArgument (metavar "EXE" <> value "" <> help "Which executable to run")
 
 testArguments :: Parser Command
-testArguments = pure Test
+testArguments = Test <$> strArgument (metavar "TEST" <> value "" <> help "Which test to run")
 
 buildArguments :: Parser Command
 buildArguments = pure Build
diff --git a/test/Spec.hs b/test/Spec.hs
index 604d8af..18da62f 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -16,16 +16,16 @@ main = do
 
 testHelloWorld :: IO ()
 testHelloWorld =
-  withCurrentDirectory (example_path </> "hello_world") $ start $ Arguments Run False
+  withCurrentDirectory (example_path </> "hello_world") $ start $ Arguments (Run "") False ""
 
 testHelloComplex :: IO ()
 testHelloComplex =
-  withCurrentDirectory (example_path </> "hello_complex") $ start $ Arguments Test False
+  withCurrentDirectory (example_path </> "hello_complex") $ start $ Arguments (Test "") False ""
 
 testHelloFpm :: IO ()
 testHelloFpm =
-    withCurrentDirectory (example_path </> "hello_fpm") $ start $ Arguments Run False
+    withCurrentDirectory (example_path </> "hello_fpm") $ start $ Arguments (Run "") False ""
 
 testCircular :: IO ()
 testCircular =
-    withCurrentDirectory (example_path </> "circular_example") $ start $ Arguments Test False
+    withCurrentDirectory (example_path </> "circular_example") $ start $ Arguments (Test "") False ""