[#78] Replace 'Has' with 'HasRIO' where possible

vaclavsvejcar · Sep 18, 2021 · 2981afe · 2981afe
1 parent 5e74b52
commit 2981afe
Show file tree

Hide file tree

Showing 5 changed files with 41 additions and 21 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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