From 3f1e93d42ee3878c618c3e8a38b6cf8164165a39 Mon Sep 17 00:00:00 2001
From: Sascha Grunert <mail@saschagrunert.de>
Date: Sat, 15 Jun 2019 14:23:35 +0200
Subject: [PATCH] Cleanup enviromnent variable handling

Signed-off-by: Sascha Grunert <mail@saschagrunert.de>
---
 src/Environment.hs     | 35 +++++++++++++++--------------------
 src/cmd/client/Main.hs | 33 ++++++++++++++++++++++-----------
 2 files changed, 37 insertions(+), 31 deletions(-)

diff --git a/src/Environment.hs b/src/Environment.hs
index f4aafca..22fba5e 100644
--- a/src/Environment.hs
+++ b/src/Environment.hs
@@ -1,7 +1,13 @@
 -- | System Environment handling
 --
 -- @since 0.1.0
-module Environment ( fillEnvironment ) where
+module Environment
+    ( branchEnvVars
+    , commitEnvVars
+    , fillEnvironment
+    , pullRequestEnvVars
+    , tokenEnvVars
+    ) where
 
 import           Control.Lens       ( (.~), (^.) )
 import           Control.Monad      ( mapM, msum )
@@ -26,7 +32,7 @@ fillEnvironment e d = do
     b <- getEnv (e ^. environmentBranch) "branch" branchEnvVars
     c <- getEnv (e ^. environmentCommit) "commit" commitEnvVars
     p <- getEnv (e ^. environmentPullRequest) "pull request" pullRequestEnvVars
-    t <- getToken (e ^. environmentToken)
+    t <- getEnv (e ^. environmentToken) "token" tokenEnvVars
     if not d && any T.null [ b, c, p, t ]
         then exitFailure
         else return $ environmentToken .~ t $ environmentPullRequest .~ p $
@@ -37,8 +43,8 @@ prefix :: String -> String
 prefix = (++) "PB_"
 
 -- | Possible token environment variables sorted by priority
-tokenEnvVar :: String
-tokenEnvVar = prefix "TOKEN"
+tokenEnvVars :: [String]
+tokenEnvVars = [ prefix "TOKEN" ]
 
 -- | Possible branch environment variables sorted by priority
 branchEnvVars :: [String]
@@ -53,19 +59,6 @@ pullRequestEnvVars :: [String]
 pullRequestEnvVars =
     [ prefix "PULL_REQUEST", "CIRCLE_PR_NUMBER", "TRAVIS_PULL_REQUEST" ]
 
--- | Retrieve the token environment value
-getToken :: Text -> IO Text
-getToken "" = do
-    e <- lookupEnv tokenEnvVar
-    case e of
-        Just t -> return $ pack t
-        _ -> do
-            err $ printf "No token found via $%s environment variable"
-                         tokenEnvVar
-            return ""
-
-getToken x = return x
-
 -- | Generic environment variable retrieval
 getEnv :: Text -> String -> [String] -> IO Text
 getEnv "" t v = do
@@ -73,9 +66,11 @@ getEnv "" t v = do
     case msum e of
         Just b -> return $ pack b
         _ -> do
-            err . printf ("No %s found via the $%s environment "
-                          ++ "variables or the command line")
-                         t $ intercalate "/$" v
+            err $ printf ("No %s found via the $%s environment "
+                          ++ "variable%s or the command line")
+                         t
+                         (intercalate ", $" v)
+                         (if length v == 1 then "" else "s" :: String)
             return ""
 
 getEnv x _ _ = return x
diff --git a/src/cmd/client/Main.hs b/src/cmd/client/Main.hs
index 3e5ca24..5be04a2 100644
--- a/src/cmd/client/Main.hs
+++ b/src/cmd/client/Main.hs
@@ -6,7 +6,11 @@ module Main ( main ) where
 import           Control.Lens        ( (^.) )
 import           Control.Monad       ( foldM )
 
-import           Environment         ( fillEnvironment )
+import           Data.List           ( intercalate )
+
+import           Environment
+                 ( branchEnvVars, commitEnvVars, fillEnvironment
+                 , pullRequestEnvVars, tokenEnvVars )
 
 import           Log                 as L ( info )
 import           Log                 ( initLogger, notice, warn )
@@ -63,16 +67,22 @@ arguments :: Parser Args
 arguments = Args <$> environment <*> verbosity <*> apiUrl <*> devel
 
 environment :: Parser Environment
-environment = Environment
-    <$> strOption (long "branch" <> short 'b' <> help "Branch name"
-                   <> metavar "BRANCH" <> value "")
-    <*> strOption (long "commit" <> short 'c' <> help "Commit hash"
-                   <> metavar "COMMIT" <> showDefault <> value "")
+environment = Environment <$> strOption (long "branch" <> short 'b'
+                                         <> envHelp "Branch name" branchEnvVars
+                                         <> metavar "BRANCH" <> value "")
+    <*> strOption (long "commit" <> short 'c'
+                   <> envHelp "Commit hash" commitEnvVars <> metavar "COMMIT"
+                   <> value "")
     <*> strOption (long "pull-request" <> short 'p'
-                   <> help "Pull request number" <> metavar "PULL_REQUEST"
-                   <> showDefault <> value "")
-    <*> strOption (long "token" <> short 't' <> help "Token to be used"
-                   <> metavar "TOKEN" <> showDefault <> value "") <**> helper
+                   <> envHelp "Pull request number" pullRequestEnvVars
+                   <> metavar "PULL_REQUEST" <> value "")
+    <*> strOption (long "token" <> short 't' <> envHelp "Token" tokenEnvVars
+                   <> metavar "TOKEN" <> value "") <**> helper
+  where
+    envHelp x y = help $ printf "%s - fallback environment  variable%s: $%s"
+                                (x :: String)
+                                (if length y == 1 then "" else "s" :: String)
+                                (intercalate ", $" y)
 
 verbosity :: Parser Priority
 verbosity = priority . length
@@ -88,7 +98,8 @@ verbosity = priority . length
 
 apiUrl :: Parser String
 apiUrl = strOption (long "url" <> short 'u' <> help "API url for sending data"
-                    <> metavar "URL" <> value "http://localhost:3000/api")
+                    <> metavar "URL" <> showDefault
+                    <> value "http://localhost:3000/api")
 
 devel :: Parser Bool
 devel = switch (internal <> long "devel" <> short 'd')