paul/yore
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Make gFromEnv return Either String (...)

Browse Source
This commit is contained in:
Paul Brinkmeier 2025-09-17 19:57:25 +02:00
parent cf57a24497
commit 78d317c7bd
2 changed files with 19 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
app/Main.hs
View File

@ -37,6 +37,7 @@ import Servant
, (:>)
, pattern MkHandler
)
import System.Exit (exitFailure)
import System.FilePath ((</>))
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
import Text.Blaze.Html5 ((!))
@ -80,8 +81,13 @@ deriving instance Show Config
main :: IO ()
main = do
cfg <- Envy.load @ConfigT
-- _ <- exitSuccess
cfg <-
Envy.load @ConfigT >>= \case
Left err -> do
Log.error $ printf "failed to read config: %s" err
exitFailure
Right c ->
pure c
let
settings =
@ -95,7 +101,7 @@ main = do
]
db <- DB.initDB cfg.yoreDb
Warp.runSettings settings $ serve (Proxy :: Proxy API) $ hoistServer (Proxy :: Proxy API) nt $ server cfg db
Warp.runSettings settings $ serve (Proxy @API) $ hoistServer (Proxy @API) nt $ server cfg db
where
logger req status _ = do
Log.info $

19
src/Envy.hs
View File

@ -54,28 +54,30 @@ type v =@? t = v =@@ OptionalMaybe t
type t ? d = Optional t d
load
:: forall (m :: ConfigVariant -> Type). (Generic (m Value), GFromEnv (Rep (m Spec)) (Rep (m Value))) => IO (m Value)
:: forall (m :: ConfigVariant -> Type)
. (Generic (m Value), GFromEnv (Rep (m Spec)) (Rep (m Value)))
=> IO (Either String (m Value))
load = do
env <- getEnvironment
pure $ to $ gFromEnv @(Rep (m Spec)) @(Rep (m Value)) Proxy env
pure $ to <$> gFromEnv @(Rep (m Spec)) @(Rep (m Value)) Proxy env
class GFromEnv spec value where
gFromEnv :: Proxy (spec c) -> [(String, String)] -> value c
gFromEnv :: Proxy (spec c) -> [(String, String)] -> Either String (value c)
instance
(GFromEnv i o)
=> GFromEnv (M1 D b i) (M1 D d o)
where
gFromEnv Proxy env = M1 $ gFromEnv @i @o Proxy env
gFromEnv Proxy env = M1 <$> gFromEnv @i @o Proxy env
instance
(GFromEnv i o)
=> GFromEnv (M1 C b i) (M1 C d o)
where
gFromEnv Proxy env = M1 $ gFromEnv @i @o Proxy env
gFromEnv Proxy env = M1 <$> gFromEnv @i @o Proxy env
instance (GFromEnv i1 o1, GFromEnv i2 o2) => GFromEnv (i1 :*: i2) (o1 :*: o2) where
gFromEnv Proxy env = gFromEnv @i1 @o1 Proxy env :*: gFromEnv @i2 @o2 Proxy env
gFromEnv Proxy env = (:*:) <$> gFromEnv @i1 @o1 Proxy env <*> gFromEnv @i2 @o2 Proxy env
instance
(KnownSymbol sym, EnvVarSpec s t)
@ -83,9 +85,8 @@ instance
(M1 S (MetaSel (Just sym) su ss lz) (Rec0 s))
(M1 S meta2 (Rec0 t))
where
gFromEnv Proxy env = case decodeEnvVar @s @t Proxy varName $ lookup varName env of
Left err -> error err
Right value -> M1 $ K1 value
gFromEnv Proxy env =
M1 . K1 <$> decodeEnvVar @s @t Proxy varName (lookup varName env)
where
varName = selectorNameToEnvVarName $ symbolVal $ Proxy @sym