From ce3b8ccb04f8f91e3dd1f643375b9ef64fbd61f8 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Fri, 26 Jul 2024 00:38:50 +0200
Subject: Conftrack.Pretty: docs, more usable functions

this module is meant for convenience pretty-printing functions and as an
illustration of how to deal with the more low-level runFetchConfig
---
 src/Conftrack/Pretty.hs | 46 ++++++++++++++++++++++++++++++++++++++--------
 1 file changed, 38 insertions(+), 8 deletions(-)

diff --git a/src/Conftrack/Pretty.hs b/src/Conftrack/Pretty.hs
index cf10b20..df85104 100644
--- a/src/Conftrack/Pretty.hs
+++ b/src/Conftrack/Pretty.hs
@@ -1,19 +1,40 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module Conftrack.Pretty where
+-- | This module contains convenience functions to print the values returned by
+-- 'Conftrack.runFetchConfig'.
+--
+-- These functions can be used as-is in programs using this library, or serve as
+-- examples for people who wish to display the results some another way.
+module Conftrack.Pretty (unwrapConfigResult, printConfigOrigins, printConfigWarnings, printConfigErrors, displayError) where
 
-
-import Conftrack.Value (Origin(..), ConfigError, ConfigValue(..), Key)
-import Conftrack (Warning)
+import Conftrack.Value (Origin(..), ConfigError (..), ConfigValue(..), Key)
+import Conftrack (Warning (..), Config)
 import Data.Map (Map)
 import qualified Data.Map.Strict as M
 import qualified Data.Text.IO as T
 import qualified Data.Text as T
 import GHC.Exts (groupWith)
+import System.Exit (exitFailure)
+import Control.Monad (when)
 
 
-printConfigErrors :: [ConfigError] -> IO ()
-printConfigErrors = mapM_ print
+-- | A convenience function, to be @>>=@'d with 'Conftrack.runFetchConfig'.
+--
+-- It prints any errors in case of failure and then aborts the program, and prints
+-- any warnings (and, if the first argument is @True@, also each value's origin) and
+-- returns the config in case of success.
+unwrapConfigResult
+  :: forall a. Config a
+  => Bool
+  -> Either [ConfigError] (a, Map Key [Origin], [Warning])
+  -> IO a
+unwrapConfigResult _ (Left errors) = do
+  printConfigErrors errors
+  exitFailure
+unwrapConfigResult verbose (Right (config, origins, warnings)) = do
+  when verbose $ printConfigOrigins origins
+  printConfigWarnings warnings
+  pure config
 
 -- TODO: perhaps sort it by source, not by key?
 -- also, shadowed values are currently never read
@@ -32,7 +53,16 @@ printConfigOrigins =
         originSource [] = "default value"
         originSource (Origin _ text:_) = text
 
+printConfigWarnings :: [Warning] -> IO ()
+printConfigWarnings warnings =
+  T.putStrLn $ "Warnings:\n  " <> T.intercalate "\n  " (fmap (\(Warning text) -> text) warnings)
 
+printConfigErrors :: [ConfigError] -> IO ()
+printConfigErrors errors =
+  T.putStrLn $ "Errors while reading configuration:\n  " <> T.intercalate "\n  " (fmap displayError errors)
 
-printConfigWarnings :: [Warning] -> IO ()
-printConfigWarnings = mapM_ print
+displayError :: ConfigError -> T.Text
+displayError (ParseError text) = "Parse Error: " <> text
+displayError (TypeMismatch text val) = "Type Error: got" <> T.pack (show val) <> " but expected " <> text <> "."
+displayError (NotPresent key) = "Required key " <> T.pack (show key) <> " is missing."
+displayError Shadowed = "Shadowed" -- Note: this branch never occurs (for now)
-- 
cgit v1.2.3