From bb32c75bef43c79cb0e47668397a5a224115d2aa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kier=C3=A1n=20Meinhardt?= Date: Tue, 6 Oct 2020 22:32:22 +0200 Subject: State: parametrize ColorConfig over functor --- src/Much/Core.hs | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) (limited to 'src/Much/Core.hs') diff --git a/src/Much/Core.hs b/src/Much/Core.hs index 9fb1ed3..d325959 100644 --- a/src/Much/Core.hs +++ b/src/Much/Core.hs @@ -9,6 +9,7 @@ import Control.Concurrent import Control.Monad import Data.Aeson import Data.Functor +import Data.Functor.Identity import Data.Maybe import Data.Time import Much.API @@ -40,16 +41,18 @@ importConfig config state = state , attachmentDirectory = fromMaybe (attachmentDirectory state) (Config.attachmentDirectory config) , attachmentOverwrite = fromMaybe (attachmentOverwrite state) (Config.attachmentOverwrite config) , colorConfig = - let fromColorConfig key1 key2 = case Config.colorConfig config of - Just colorC -> maybe (key1 (colorConfig state)) SGR (key2 colorC) - Nothing -> key1 (colorConfig state) + let fromColorConfig key1 key2 = + case Config.colorConfig config of + Just colorC -> maybe (key1 (colorConfig state)) Identity (key2 colorC) + Nothing -> key1 (colorConfig state) in ColorConfig { tagMap = - case tagMap <$> Config.colorConfig config of + case tagMap =<< Config.colorConfig config of Just tagMap' -> + Identity $ M.foldlWithKey - (\previous k v -> maybe previous (\code -> M.insert k (SGR code) previous) v) - (tagMap (colorConfig state)) + (\previous k v -> maybe previous (\code -> M.insert k (Identity code) previous) v) + (runIdentity $ tagMap (colorConfig state)) tagMap' Nothing -> tagMap (colorConfig state) , alt = fromColorConfig alt alt -- cgit v1.2.3