dev: setup: refactor output helpers

hledger/Hledger/Cli/Commands/Setup.hs

@@ -61,42 +61,16 @@ setup :: CliOpts -> Journal -> IO ()
 setup _opts@CliOpts{rawopts_=_rawopts, reportspec_=_rspec} _ignoredj = do
   -- This command is not given a journal and should not use _ignoredj;
   -- instead detect it ourselves when we are ready.
-  putStrLn "checking setup..."
+  putStrLn "checking..."
   setupHledger
   setupConfig
   setupFiles
   -- setupAccounts
   -- setupCommodities
   -- setupTags
+  putStr "\n"
 
-
+-- | Print a setup test groups heading.
--- | Print a test's pass or fail status, in green/red if supported, and optional messages if it's ok or not ok.
-p :: Bool -> String -> String -> IO ()
-p ok ymsg nmsg =
-  putStrLn $ unwords $ if ok then ["", y, "", ymsg] else ["", n, "", nmsg]
-  where
-    y = bold' $ brightGreen' "yes" -- ✅ apple emojis - won't work everywhere
-    n = bold' $ brightRed'   "no " -- ❌
-
--- | Like p, but display both statuses as a warning message, in yellow if supported.
-w :: Bool -> String -> String -> IO ()
-w ok ymsg nmsg =
-  putStrLn $ unwords $ if ok then ["", y, "", ymsg] else ["", n, "", nmsg]
-  where
-    y = bold' $ brightYellow' "yes" -- ⚠️
-    n = bold' $ brightYellow' "no " -- ⚠️
-
--- | Like p, but display both statuses as an info message, in blue if supported.
-i :: Bool -> String -> String -> IO ()
-i ok ymsg nmsg =
-  putStrLn $ unwords $ if ok then ["", y, "", ymsg] else ["", n, "", nmsg]
-  where
-    y = bold' $ brightBlue' "yes" -- ℹ️
-    n = bold' $ brightBlue' "no " -- ℹ️
-
-
-
--- | Print a setup test group's heading.
 pgroup :: String -> IO ()
 pgroup s = putStr $ bold' $ "\n" <> s <> ":\n"
 
@@ -120,12 +94,12 @@ showInfo U = bold' (brightYellow' " ? ")
 
 -- | Print a test's pass or fail status, as "yes" or "no" or "",
 -- in green/red if supported, and the (possibly empty) provided message.
-p' :: YNU -> String -> IO ()
+p :: YNU -> String -> IO ()
-p' ok msg = putStrLn $ unwords ["", show ok, "", msg]
+p ok msg = putStrLn $ unwords ["", show ok, "", msg]
 
 -- | Like p, but display the status as info, in neutral blue.
-i' :: YNU -> String -> IO ()
+i :: YNU -> String -> IO ()
-i' ok msg = putStrLn $ unwords ["", showInfo ok, "", msg]
+i ok msg = putStrLn $ unwords ["", showInfo ok, "", msg]
 
 
 setupHledger :: IO ()
@@ -147,33 +121,34 @@ setupHledger = do
     ++ [appdata </> "local/bin" | os == "mingw32"]
     ++ [appdata </> "cabal/bin" | os == "mingw32"]
   let
-    ok = not $ null pathexes
+    ok = if null pathexes then N else Y
     pathexe  = quoteIfNeeded $ headDef (error' "showing nonexistent executable") pathexes
     otherexe = quoteIfNeeded $ headDef (error' "showing nonexistent executable") otherexes
     otherdir = takeDirectory otherexe
-    hint = if null otherexes
+    msg
-      then ("Add " <> progname <> "'s directory to your shell's PATH.")
+      | ok == Y = pathexe
-      else unlines
+      | null otherexes = "Add " <> progname <> "'s directory to your shell's PATH."
-        ["Add " <> otherdir <> " to PATH in your shell config."
+      | otherwise = unlines
-        ,"  Eg on unix: echo 'export PATH=" <> otherdir <> ":$PATH' >> ~/.profile"
+          ["Add " <> otherdir <> " to PATH in your shell config."
-        ,"  and start a new shell session."
+          ,"  Eg on unix: echo 'export PATH=" <> otherdir <> ":$PATH' >> ~/.profile"
-        ]
+          ,"  and start a new shell session."
-  p ok pathexe hint
+          ]
+  p ok msg
 
   -- If hledger was found in PATH, run more checks
-  when ok $ do
+  when (ok==Y) $ do
 
     pdesc "runs ?"
     let arg = "--version"
     (exit,out,err) <- readProcessWithExitCode progname [arg] ""
     let
-      ok = exit == ExitSuccess
+      ok = if exit == ExitSuccess then Y else N
-      hint = "'" <> progname <> " " <> arg <> "' failed: \n" <> err
+      msg = if ok==Y then "" else "'" <> progname <> " " <> arg <> "' failed: \n" <> err
-    p ok "" hint
+    p ok msg
     let verparts = words out  -- use below
 
     -- If hledger runs, run more checks
-    when ok $ do
+    when (ok==Y) $ do
       pdesc "is a native binary ?"
       let
         exearch = case drop 2 verparts of
@@ -184,14 +159,15 @@ setupHledger = do
           | os == "mingw32" = "windows"
           | otherwise       = os
         sysarch = os' <> "-" <> arch
-        ok = exearch == sysarch
+        (ok, msg)
-        hint = "installed binary is for " <> exearch <> ", system is " <> sysarch
+          | exearch == sysarch = (Y, "")
-      p ok "" hint
+          | otherwise = (N, "installed binary is for " <> exearch <> ", system is " <> sysarch)
+      p ok msg
 
       pdesc "is up to date ?"
       elatestver <- getLatestHledgerVersion
       let
-        (ok,msg) = case elatestver of
+        (ok, msg) = case elatestver of
           Left e -> (U, "could not get " <> latestHledgerVersionUrlStr <> " : " <> e)
           Right latestver ->
             case drop 1 verparts of
@@ -204,7 +180,7 @@ setupHledger = do
                     if exever == latestver 
                     then exever 
                     else exever <> " installed, latest release is " <> latestver
-      p' ok msg
+      p ok msg
 
   -- pdesc "eget installed ?"
 
@@ -215,21 +191,21 @@ setupConfig = do
   muf <- activeUserConfFile
   let
     (ok, msg) = case muf of
-      Just f  -> (True, f)
+      Just f  -> (Y, f)
-      Nothing -> (False, "")
+      Nothing -> (N, "")
-  i ok msg msg
+  i ok msg
 
   pdesc "a local config file exists ?"
   mlf <- activeLocalConfFile
   let
     (ok, msg) = case mlf of
-      Just f  -> (True, f) -- <> if isJust muf then " (masking user config)" else "")
+      Just f  -> (Y, f) -- <> if isJust muf then " (masking user config)" else "")
-      Nothing -> (False, "")
+      Nothing -> (N, "")
-  i ok msg msg
+  i ok msg
 
   when (isJust muf && isJust mlf) $ do
     pdesc "local config is masking user config ?"
-    i True "" ""
+    i Y ""
 
   let mf = mlf <|> muf
   case mf of
@@ -238,8 +214,8 @@ setupConfig = do
       pdesc "config file is readable ?"
       ecs <- readFile f <&> parseConf f . T.pack
       case ecs of
-        Right _ -> p True "" ""
+        Right _ -> p Y ""
-        Left e  -> p False "" (errorBundlePretty e)
+        Left e  -> p N (errorBundlePretty e)
 
   -- pdesc "common general options configured ?"
   -- --pretty --ignore-assertions --infer-costs"
@@ -254,17 +230,17 @@ setupFiles = do
     Just h -> do
       let f = h </> journalDefaultFilename
       e <- doesFileExist f
-      return (e, if e then f else "")
+      return (if e then Y else N, if e then f else "")
-    Nothing -> return (False, "")
+    Nothing -> return (N, "")
-  i ok msg msg
+  i ok msg
 
   pdesc "LEDGER_FILE variable is defined ?"
   mf <- lookupEnv journalEnvVar
   let
-    (ok,msg) = case mf of
+    (ok, msg) = case mf of
-      Just f  -> (True, f)
+      Just f  -> (Y, f)
-      Nothing -> (False, "")
+      Nothing -> (N, "")
-  i ok msg msg
+  i ok msg
 
   -- case mf of
   --   Nothing -> return ()
@@ -280,25 +256,26 @@ setupFiles = do
   pdesc "default journal file exists ?"
   jfile <- defaultJournalPath
   exists <- doesFileExist jfile
-  p exists jfile ""
+  let (ok, msg) = (if exists then Y else N, if exists then jfile else "")
+  p ok msg
 
   when exists $ do
     
     when (os == "mingw32") $ do
       pdesc "default journal file path is safe for Windows ?"
       let
-        (ok,msg) =
+        (ok, msg) =
           -- like ensureJournalFileExists:
           if isWindowsUnsafeDotPath jfile
-          then (False, "the file name ends with a dot, this is unsafe on Windows")
+          then (N, "the file name ends with a dot, this is unsafe on Windows")
-          else (True, "")
+          else (Y, "")
-      p ok msg msg
+      p ok msg
 
     pdesc "default journal file is readable ?"
     ej <- runExceptT $ readJournalFile definputopts jfile  -- like defaultJournal
     case ej of
-      Right _ -> p True "" ""
+      Right _ -> p Y ""
-      Left e -> p False "" e
+      Left  e -> p N e
 
 setupAccounts = do
   pgroup "accounts"