1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
{-# LANGUAGE OverloadedStrings #-}
-- | 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 (..), 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)
-- | 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
printConfigOrigins :: Map Key [Origin] -> IO ()
printConfigOrigins =
mapM_ (T.putStrLn . prettyOrigin)
. groupWith ((\(Origin _ s) -> s) . head . snd)
. filter (not . null . snd)
. M.toList
where prettyOrigin origins =
T.concat $ originSource (snd (head origins)) : fmap prettyKey origins
prettyKey (key, []) = "\n " <> T.pack (show key)
prettyKey (key, (Origin val _):shadowed) = T.concat $
["\n ", T.pack $ show key, " = ", prettyValue val]
<> fmap (\(Origin _ text) -> "\n (occurrance in "<>text<>" shadowed)") shadowed
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)
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)
|
