From cc639b06c7126fac7b445d8f778455620d7f8f50 Mon Sep 17 00:00:00 2001 From: Paul Oliver Date: Sun, 29 Dec 2024 17:05:34 +0000 Subject: Initial --- hsm-core/Hsm/Core/Env.hs | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) create mode 100644 hsm-core/Hsm/Core/Env.hs (limited to 'hsm-core/Hsm/Core/Env.hs') diff --git a/hsm-core/Hsm/Core/Env.hs b/hsm-core/Hsm/Core/Env.hs new file mode 100644 index 0000000..4e7986f --- /dev/null +++ b/hsm-core/Hsm/Core/Env.hs @@ -0,0 +1,29 @@ +module Hsm.Core.Env + ( environment + , deriveFromYaml + ) where + +import Data.Aeson (FromJSON, Result(Error, Success), Value, fromJSON) +import Data.Aeson.Key (fromText) +import Data.Aeson.KeyMap (KeyMap, (!?)) +import Data.Aeson.TH (defaultOptions, deriveFromJSON, rejectUnknownFields) +import Data.Maybe (fromMaybe) +import Data.Text (Text, unpack) +import Data.Yaml (decodeFileThrow) +import Language.Haskell.TH (Dec, Name, Q) + +environment :: FromJSON env => Text -> Text -> IO env +environment name = fmap (check . fromJSON . load) . decodeFileThrow . unpack + where + load :: KeyMap Value -> Value + load keymap = + fromMaybe + (error $ "Service configuration for " <> unpack name <> " not found)") + $ keymap !? fromText name + -- + check :: Result env -> env + check (Success env) = env + check (Error str) = error str + +deriveFromYaml :: Name -> Q [Dec] +deriveFromYaml = deriveFromJSON defaultOptions {rejectUnknownFields = True} -- cgit v1.2.1