Skip to content

Instantly share code, notes, and snippets.

@essic
Created June 3, 2020 17:40
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save essic/5ddd9828d65e0770ea19cff3ec7821de to your computer and use it in GitHub Desktop.
Save essic/5ddd9828d65e0770ea19cff3ec7821de to your computer and use it in GitHub Desktop.
Dumb example in haskell
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE OverloadedLabels #-}
module Main where
import Core as C
import Protolude
import Dhall
import System.Environment (getArgs)
import GHC.Natural (naturalToInt)
data Environment = Development | Production
data RawConfig =
RawConfig
{ connectionString :: Text
, isDevelopment :: Bool
, httpPort :: Natural }
deriving(Generic)
instance FromDhall RawConfig
data WakeveConfig =
WakeveConfig
{ conn :: Text
, environment :: Environment
, port :: Int }
deriving (Generic)
make :: RawConfig -> WakeveConfig
make config =
let env =
if isDevelopment config then Development else Production
in WakeveConfig
{ conn = connectionString config
, environment = env
, port = naturalToInt $ httpPort config}
class HasDbInfo a where
getConnStr :: a -> Text
instance HasDbInfo WakeveConfig where
getConnStr = conn
class HasEnvInfo a where
getEnv :: a -> Environment
instance HasEnvInfo WakeveConfig where
getEnv = environment
class HasHttpInfo a where
getPort :: a -> Int
instance HasHttpInfo WakeveConfig where
getPort = port
newtype WakeveAppT env a =
WakeveAppT { unApp :: ReaderT env IO a }
deriving (Functor, Applicative, Monad, MonadReader env, MonadIO)
runApp :: env -> WakeveAppT env a -> IO a
runApp env =
usingReaderT env . unApp
where
usingReaderT :: env -> ReaderT env IO a -> IO a
usingReaderT = flip runReaderT
sayHello :: (MonadReader env m, HasDbInfo env, MonadIO m) => m ()
sayHello = do
env <- ask
liftIO . putText . C.greet . getConnStr $ env
main :: IO ()
main = do
fileConfigPath <- toSL . fromMaybe "" . head <$> getArgs
(dhallConfig :: RawConfig) <- input auto fileConfigPath
runApp (make dhallConfig) sayHello
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment