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

19
src/Envy.hs
View File

@ -54,28 +54,30 @@ type v =@? t = v =@@ OptionalMaybe t
type t ? d = Optional t d type t ? d = Optional t d
load 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 load = do
env <- getEnvironment 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 class GFromEnv spec value where
gFromEnv :: Proxy (spec c) -> [(String, String)] -> value c gFromEnv :: Proxy (spec c) -> [(String, String)] -> Either String (value c)
instance instance
(GFromEnv i o) (GFromEnv i o)
=> GFromEnv (M1 D b i) (M1 D d o) => GFromEnv (M1 D b i) (M1 D d o)
where where
gFromEnv Proxy env = M1 $ gFromEnv @i @o Proxy env gFromEnv Proxy env = M1 <$> gFromEnv @i @o Proxy env
instance instance
(GFromEnv i o) (GFromEnv i o)
=> GFromEnv (M1 C b i) (M1 C d o) => GFromEnv (M1 C b i) (M1 C d o)
where 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 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 instance
(KnownSymbol sym, EnvVarSpec s t) (KnownSymbol sym, EnvVarSpec s t)
@ -83,9 +85,8 @@ instance
(M1 S (MetaSel (Just sym) su ss lz) (Rec0 s)) (M1 S (MetaSel (Just sym) su ss lz) (Rec0 s))
(M1 S meta2 (Rec0 t)) (M1 S meta2 (Rec0 t))
where where
gFromEnv Proxy env = case decodeEnvVar @s @t Proxy varName $ lookup varName env of gFromEnv Proxy env =
Left err -> error err M1 . K1 <$> decodeEnvVar @s @t Proxy varName (lookup varName env)
Right value -> M1 $ K1 value
where where
varName = selectorNameToEnvVarName $ symbolVal $ Proxy @sym varName = selectorNameToEnvVarName $ symbolVal $ Proxy @sym