From 2dd3856389f9080e122f3a76ceda9c64146eb262 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Sat, 22 Feb 2025 21:30:29 +0100 Subject: tea-cleaner: Configure word lists --- tea-cleaner/TeaCleaner/Configuration.hs | 27 ++++++++++++++++++--------- 1 file changed, 18 insertions(+), 9 deletions(-) (limited to 'tea-cleaner/TeaCleaner/Configuration.hs') diff --git a/tea-cleaner/TeaCleaner/Configuration.hs b/tea-cleaner/TeaCleaner/Configuration.hs index a7342d3..1d2db32 100644 --- a/tea-cleaner/TeaCleaner/Configuration.hs +++ b/tea-cleaner/TeaCleaner/Configuration.hs @@ -26,35 +26,44 @@ import Options.Applicative import Text.URI (URI) import qualified Text.URI as URI import Data.Time (UTCTime(..), getCurrentTime) +import Data.IORef (IORef, newIORef) data ConfigFile = ConfigFile { token :: StrictText , server :: StrictText + , spamWords :: [StrictText] + , mailDomains :: [StrictText] } deriving (Eq, Show) configFileCodec :: Toml.TomlCodec ConfigFile configFileCodec = ConfigFile <$> Toml.text "token" .= getField @"token" <*> Toml.text "server" .= getField @"server" + <*> Toml.arrayOf Toml._Text "spam_words" .= getField @"spamWords" + <*> Toml.arrayOf Toml._Text "mail_domains" .= getField @"mailDomains" data Settings = Settings { token :: StrictText , server :: URI , now :: UTCTime - } deriving (Eq, Show) + , spamWords :: [StrictText] + , mailDomains :: [StrictText] + , statistics :: IORef Int + } deriving Eq decodeSettingsFile :: FilePath -> IO Settings -decodeSettingsFile configPath = Toml.decodeFile configFileCodec configPath - >>= withConfiguration - where - withConfiguration configFile@ConfigFile{ server } = URI.mkURI server - >>= withServer configFile - withServer configFile parsedServer = getCurrentTime - >>= withTime configFile parsedServer - withTime ConfigFile{..} parsedServer now = pure $ Settings +decodeSettingsFile configPath = do + ConfigFile{..} <- Toml.decodeFile configFileCodec configPath + parsedServer <- URI.mkURI server + now <- getCurrentTime + ioRef <- newIORef 0 + pure $ Settings { token = token , server = parsedServer , now = now + , spamWords = spamWords + , mailDomains = mailDomains + , statistics = ioRef } newtype ProgramOptions = ProgramOptions -- cgit v1.2.3