Last active
October 19, 2018 17:34
-
-
Save jmackie/bdc140466c7802ac146600161600222b to your computer and use it in GitHub Desktop.
Haskell App Configuration
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/env stack | |
-- stack --resolver lts-12.12 script --package aeson --package mtl | |
{-# LANGUAGE DeriveAnyClass #-} | |
{-# LANGUAGE DeriveGeneric #-} | |
{-# LANGUAGE FlexibleContexts #-} | |
{-# LANGUAGE FlexibleInstances #-} | |
{-# LANGUAGE KindSignatures #-} | |
{-# LANGUAGE LambdaCase #-} | |
{-# LANGUAGE NamedFieldPuns #-} | |
{-# LANGUAGE ScopedTypeVariables #-} | |
{-# LANGUAGE StandaloneDeriving #-} | |
{-# LANGUAGE TypeFamilies #-} | |
module Config | |
( Config | |
, Config'(..) | |
, resolve | |
) | |
where | |
import Control.Applicative ((<|>)) | |
import Control.Monad.Error.Class (MonadError, liftEither, throwError) | |
import Control.Monad.Except (runExceptT) | |
import Control.Monad.IO.Class (MonadIO, liftIO) | |
import qualified Data.Aeson as Aeson | |
import Data.Functor.Identity (Identity) | |
import GHC.Generics (Generic) | |
import System.Environment (lookupEnv) | |
type family Setting (f :: * -> *) a where | |
Setting Identity a = a | |
Setting Maybe a = Maybe a | |
data Config' f = Config | |
{ foo :: Setting f String | |
, bar :: Setting f String | |
} deriving Generic | |
type Config = Config' Identity | |
deriving instance Show Config | |
type PartialConfig = Config' Maybe | |
deriving instance Show PartialConfig | |
deriving instance Aeson.FromJSON PartialConfig | |
instance Semigroup PartialConfig where | |
c1 <> c2 = Config | |
{ foo = foo c1 <|> foo c2 | |
, bar = bar c1 <|> bar c2 | |
} | |
instance Monoid PartialConfig where | |
mempty = Config mempty mempty | |
-- | Get configuration options from the environment. | |
fromEnv :: forall m . (MonadIO m, MonadError String m) => m PartialConfig | |
fromEnv = do | |
foo <- lookup "FOO" | |
bar <- lookup "BAR" | |
pure Config {foo , bar } | |
where | |
lookup :: String -> m (Maybe String) | |
lookup = liftIO . lookupEnv | |
-- | Get configuration options from a (json) config file. | |
fromFile :: (MonadIO m, MonadError String m) => FilePath -> m PartialConfig | |
fromFile configFilePath = do | |
result <- liftIO (Aeson.eitherDecodeFileStrict configFilePath) | |
liftEither result | |
-- | Fill in a partial config, maybe throwing errors. | |
finalize :: forall m . MonadError String m => PartialConfig -> m Config | |
finalize partial = do | |
foo <- withDefault "default" (foo partial) | |
bar <- withDefault "default" (bar partial) | |
pure Config {foo , bar } | |
where | |
withDefault :: a -> Maybe a -> m a | |
withDefault def = liftEither . maybe (Right def) Right | |
-- | Run the whole config resolution dance. | |
resolve :: (MonadIO m, MonadError String m) => Maybe FilePath -> m Config | |
resolve configFilePath = do | |
configEnv <- fromEnv | |
configFile <- maybe (pure mempty) fromFile configFilePath | |
finalize (configFile <> configEnv) | |
main :: IO () | |
main = runExceptT (resolve $ Just "config.json") >>= print |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{ | |
"foo": "FILE" | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment