81 lines
2.2 KiB
Haskell
81 lines
2.2 KiB
Haskell
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE DerivingVia #-}
|
|
{-# LANGUAGE TypeOperators #-}
|
|
module Data.Config where
|
|
|
|
import Control.Lens
|
|
import Data.Text (Text)
|
|
import Dhall (FromDhall, Generic, ToDhall, auto, inputFile)
|
|
import Dhall.Deriving
|
|
import Numeric.Natural (Natural)
|
|
import Data.SubReddit (SubReddit)
|
|
|
|
data Password
|
|
= Password Text
|
|
| File FilePath
|
|
deriving stock (Generic, Show)
|
|
deriving (FromDhall, ToDhall)
|
|
via (Codec AsIs Password)
|
|
|
|
data AMQP = AMQP
|
|
{ amqpVhost :: Text
|
|
, amqpUsername :: Text
|
|
, amqpPassword :: Password
|
|
, amqpHost :: Text
|
|
}
|
|
deriving stock (Generic, Show)
|
|
deriving (FromDhall, ToDhall)
|
|
via (Codec (Field (CamelCase <<< DropPrefix "amqp"))) AMQP
|
|
|
|
host :: Lens' AMQP Text
|
|
host = lens amqpHost (\ am txt -> am{amqpHost=txt})
|
|
|
|
vhost :: Lens' AMQP Text
|
|
vhost = lens amqpVhost (\ am txt -> am{amqpVhost=txt})
|
|
|
|
username :: Lens' AMQP Text
|
|
username = lens amqpUsername (\ am txt -> am{amqpUsername=txt})
|
|
|
|
password :: Lens' AMQP Password
|
|
password = lens amqpPassword (\ am txt -> am{amqpPassword=txt})
|
|
|
|
data Fetcher = Fetcher
|
|
{ fetcherSubreddit :: SubReddit
|
|
, fetcherEntries :: Natural
|
|
, fetcherQualifier :: Maybe Qualifier
|
|
}
|
|
deriving stock (Show, Generic)
|
|
deriving (FromDhall, ToDhall) via Codec (Field (CamelCase <<< DropPrefix "fetcher")) Fetcher
|
|
|
|
subreddit :: Lens' Fetcher SubReddit
|
|
subreddit = lens fetcherSubreddit (\ fe sr -> fe{fetcherSubreddit=sr})
|
|
|
|
entries :: Lens' Fetcher Natural
|
|
entries = lens fetcherEntries (\ fe nat -> fe{fetcherEntries=nat})
|
|
|
|
data Qualifier = Top | Controversial
|
|
deriving stock (Show, Generic)
|
|
deriving (FromDhall, ToDhall) via Codec (Constructor TitleCase) Qualifier
|
|
|
|
data Config = Config
|
|
{ configAmqp :: AMQP
|
|
, configFetchers :: [Fetcher]
|
|
, configSqlite :: FilePath
|
|
}
|
|
deriving stock (Generic, Show)
|
|
deriving (FromDhall, ToDhall)
|
|
via (Codec (Field (CamelCase <<< DropPrefix "config"))) Config
|
|
|
|
amqp :: Lens' Config AMQP
|
|
amqp = lens configAmqp (\ con am -> con{configAmqp=am})
|
|
|
|
fetchers :: Lens' Config [Fetcher]
|
|
fetchers = lens configFetchers (\ con fes -> con{configFetchers=fes})
|
|
|
|
sqlite :: Lens' Config FilePath
|
|
sqlite = lens configSqlite (\ con s -> con{configSqlite=s})
|
|
|
|
readConfig :: FilePath -> IO Config
|
|
readConfig = inputFile auto
|