diff options
| -rw-r--r-- | src/Conftrack/Pretty.hs | 46 |
1 files 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) |