From 2981afe09559950ffec16a202c1b563edddaee99 Mon Sep 17 00:00:00 2001 From: Vaclav Svejcar Date: Sat, 18 Sep 2021 20:32:09 +0200 Subject: [PATCH] [#78] Replace 'Has' with 'HasRIO' where possible --- src/Headroom/Command/Init.hs | 14 +++++--------- src/Headroom/Command/Run.hs | 16 +++++++++------- src/Headroom/Configuration/GlobalConfig.hs | 8 +++++--- src/Headroom/Data/Has.hs | 18 ++++++++++++++++++ src/Headroom/Updater.hs | 6 ++++-- 5 files changed, 41 insertions(+), 21 deletions(-) diff --git a/src/Headroom/Command/Init.hs b/src/Headroom/Command/Init.hs index d626de1..0307261 100644 --- a/src/Headroom/Command/Init.hs +++ b/src/Headroom/Command/Init.hs @@ -48,7 +48,9 @@ import Headroom.Configuration.Enrich ( Enrich(..) import Headroom.Configuration.Types ( Configuration(..) , LicenseType(..) ) -import Headroom.Data.Has ( Has(..) ) +import Headroom.Data.Has ( Has(..) + , HasRIO + ) import Headroom.Data.Lens ( suffixLenses ) import Headroom.Embedded ( configFileStub , defaultConfig @@ -169,10 +171,7 @@ findSupportedFileTypes = do -- | Checks whether application config file already exists. -doesAppConfigExist :: ( HasLogFunc env - , Has (FileSystem (RIO env)) env - , Has Paths env - ) +doesAppConfigExist :: (HasLogFunc env, HasRIO FileSystem env, Has Paths env) => RIO env Bool doesAppConfigExist = do FileSystem {..} <- viewL @@ -223,10 +222,7 @@ createConfigFile = do ] -makeTemplatesDir :: ( HasLogFunc env - , Has (FileSystem (RIO env)) env - , Has Paths env - ) +makeTemplatesDir :: (HasLogFunc env, HasRIO FileSystem env, Has Paths env) => RIO env () makeTemplatesDir = do FileSystem {..} <- viewL diff --git a/src/Headroom/Command/Run.hs b/src/Headroom/Command/Run.hs index 7205d35..d413afe 100644 --- a/src/Headroom/Command/Run.hs +++ b/src/Headroom/Command/Run.hs @@ -67,7 +67,9 @@ import Headroom.Configuration.Types ( Configuration(..) , RunMode(..) ) import Headroom.Data.EnumExtra ( EnumExtra(..) ) -import Headroom.Data.Has ( Has(..) ) +import Headroom.Data.Has ( Has(..) + , HasRIO + ) import Headroom.Data.Lens ( suffixLenses , suffixLensesFor ) @@ -239,7 +241,7 @@ warnOnDryRun = do findSourceFiles :: ( Has CtConfiguration env - , Has (FileSystem (RIO env)) env + , HasRIO FileSystem env , HasLogFunc env ) => [FileType] @@ -259,7 +261,7 @@ findSourceFiles fileTypes = do excludeIgnored :: ( Has CtConfiguration env - , Has (FileSystem (RIO env)) env + , HasRIO FileSystem env , HasLogFunc env ) => [FilePath] @@ -386,8 +388,8 @@ chooseAction info header = do -- of 'TemplateRef' is selected). loadTemplateRefs :: forall a env . ( Template a - , Has (Network (RIO env)) env - , Has (FileSystem (RIO env)) env + , HasRIO Network env + , HasRIO FileSystem env , HasLogFunc env ) => [TemplateRef] -- ^ template references @@ -420,8 +422,8 @@ loadTemplateRefs refs = do loadTemplates :: ( Has CtConfiguration env - , Has (FileSystem (RIO env)) env - , Has (Network (RIO env)) env + , HasRIO Network env + , HasRIO FileSystem env , HasLogFunc env ) => RIO env (Map FileType HeaderTemplate) diff --git a/src/Headroom/Configuration/GlobalConfig.hs b/src/Headroom/Configuration/GlobalConfig.hs index 4ee5ab5..f9653bb 100644 --- a/src/Headroom/Configuration/GlobalConfig.hs +++ b/src/Headroom/Configuration/GlobalConfig.hs @@ -28,7 +28,9 @@ import Data.Aeson ( FromJSON(..) , genericParseJSON ) import qualified Data.Yaml as Y -import Headroom.Data.Has ( Has(..) ) +import Headroom.Data.Has ( Has(..) + , HasRIO + ) import Headroom.Data.Serialization ( aesonOptions ) import Headroom.Embedded ( defaultGlobalConfig ) import Headroom.IO.FileSystem ( FileSystem(..) ) @@ -56,7 +58,7 @@ instance FromJSON GlobalConfig where -- | Checks if global configuration /YAML/ file is already present and if not, -- it creates one with default values. -initGlobalConfigIfNeeded :: (Has (FileSystem (RIO env)) env) => RIO env () +initGlobalConfigIfNeeded :: (HasRIO FileSystem env) => RIO env () initGlobalConfigIfNeeded = do FileSystem {..} <- viewL userDir <- fsGetUserDirectory @@ -66,7 +68,7 @@ initGlobalConfigIfNeeded = do -- | Loads global configuration from /YAML/ file. -loadGlobalConfig :: (Has (FileSystem (RIO env)) env) => RIO env GlobalConfig +loadGlobalConfig :: (HasRIO FileSystem env) => RIO env GlobalConfig loadGlobalConfig = do FileSystem {..} <- viewL userDir <- fsGetUserDirectory diff --git a/src/Headroom/Data/Has.hs b/src/Headroom/Data/Has.hs index 08de157..2acc0b9 100644 --- a/src/Headroom/Data/Has.hs +++ b/src/Headroom/Data/Has.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoImplicitPrelude #-} @@ -16,6 +17,7 @@ application. module Headroom.Data.Has ( Has(..) + , HasRIO ) where @@ -42,3 +44,19 @@ class Has a t where viewL :: MonadReader t m => m a viewL = view hasLens + + +-- | Handy type alias that allows to avoid ugly type singatures. Allows to +-- transform this: +-- +-- @ +-- foo :: (Has (Network (RIO env)) env) => RIO env () +-- @ +-- +-- into +-- +-- @ +-- foo :: (HasRIO Network env) => RIO env () +-- @ +-- +type HasRIO a env = Has (a (RIO env)) env diff --git a/src/Headroom/Updater.hs b/src/Headroom/Updater.hs index 1bc9289..42430b3 100644 --- a/src/Headroom/Updater.hs +++ b/src/Headroom/Updater.hs @@ -32,7 +32,9 @@ where import Data.Aeson ( Value(String) ) import qualified Data.Aeson as A import Data.String.Interpolate ( iii ) -import Headroom.Data.Has ( Has(..) ) +import Headroom.Data.Has ( Has(..) + , HasRIO + ) import Headroom.IO.Network ( Network(..) ) import Headroom.Meta.Version ( Version , parseVersion @@ -49,7 +51,7 @@ import qualified Text.URI as URI -- | Fetches and parses latest version from update server. -fetchLatestVersion :: (Has (Network (RIO env)) env) => RIO env Version +fetchLatestVersion :: (HasRIO Network env) => RIO env Version fetchLatestVersion = do Network {..} <- viewL apiURI <- latestVersionApiURI