Improve manual optics

Improves manual optic instances by ensuring all fields are used (i.e no wildcards). Moreover, do not attempt to name positional args since it is too hard to maintain and does not give us any additional safety. Also improve yaml format/lint.
tbidne · Nov 6, 2024 · becbb15 · becbb15
1 parent 97c6fea
commit becbb15
Show file tree

Hide file tree

Showing 19 changed files with 276 additions and 704 deletions.
diff --git a/.github/workflows/ci.yaml b/.github/workflows/ci.yaml
@@ -1,6 +1,6 @@
 ---
 name: ci
-on:               # yamllint disable-line rule:truthy
+on: # yamllint disable-line rule:truthy rule:comments
   push:
     branches:
       - main

diff --git a/.hlint.yaml b/.hlint.yaml
@@ -0,0 +1,23 @@
+---
+# Ignoring complaints about e.g. \b -> MkFileLogInitP a1 a2 b
+- ignore:
+    name: "Avoid lambda"
+    within:
+      - "Shrun.Configuration.Args.Parsing"
+      - "Shrun.Configuration.Data.CommandLogging"
+      - "Shrun.Configuration.Data.ConsoleLogging"
+      - "Shrun.Configuration.Data.Core"
+      - "Shrun.Configuration.Data.FileLogging"
+      - "Shrun.Configuration.Data.MergedConfig"
+      - "Shrun.Configuration.Data.Notify"
+      - "Shrun.Configuration.Env.Types"
+      - "Shrun.Configuration.Toml"
+      - "Shrun.Data.Command"
+      - "Shrun.Logging.Types"
+      - "Shrun.Notify.MonadNotify"
+      - "Functional.Prelude"
+      - "Functional.TestArgs"
+      - "Integration.Prelude"
+
+- ignore:
+    name: "Avoid lambda using `infix`"
diff --git a/.yamllint.yaml b/.yamllint.yaml
@@ -1,5 +1,4 @@
 ---
-
 extends: default
 
 ignore-from-file: .gitignore
diff --git a/flake.nix b/flake.nix
@@ -161,7 +161,7 @@
               let
                 drv = pkgs.writeShellApplication {
                   name = "format-yaml";
-                  text = "prettier -w ./*.yaml";
+                  text = "prettier -w -- **/*yaml";
                   runtimeInputs = [ pkgs.nodePackages.prettier ];
                 };
               in

diff --git a/src/Shrun/Configuration/Args/Parsing.hs b/src/Shrun/Configuration/Args/Parsing.hs
@@ -55,24 +55,24 @@ instance
   (k ~ A_Lens, a ~ WithDisabled OsPath, b ~ WithDisabled OsPath) =>
   LabelOptic "configPath" k Args Args a b
   where
-  labelOptic = lensVL $ \f (MkArgs _configPath _coreConfig _commands) ->
-    fmap (\configPath' -> MkArgs configPath' _coreConfig _commands) (f _configPath)
+  labelOptic = lensVL $ \f (MkArgs a1 a2 a3) ->
+    fmap (\b -> MkArgs b a2 a3) (f a1)
   {-# INLINE labelOptic #-}
 
 instance
   (k ~ A_Lens, a ~ CoreConfigArgs, b ~ CoreConfigArgs) =>
   LabelOptic "coreConfig" k Args Args a b
   where
-  labelOptic = lensVL $ \f (MkArgs _configPath _coreConfig _commands) ->
-    fmap (\coreConfig' -> MkArgs _configPath coreConfig' _commands) (f _coreConfig)
+  labelOptic = lensVL $ \f (MkArgs a1 a2 a3) ->
+    fmap (\b -> MkArgs a1 b a3) (f a2)
   {-# INLINE labelOptic #-}
 
 instance
   (k ~ A_Lens, a ~ NESeq Text, b ~ NESeq Text) =>
   LabelOptic "commands" k Args Args a b
   where
-  labelOptic = lensVL $ \f (MkArgs _configPath _coreConfig _commands) ->
-    fmap (MkArgs _configPath _coreConfig) (f _commands)
+  labelOptic = lensVL $ \f (MkArgs a1 a2 a3) ->
+    fmap (\b -> MkArgs a1 a2 b) (f a3)
   {-# INLINE labelOptic #-}
 
 -- | 'ParserInfo' type for parsing 'Args'.

diff --git a/src/Shrun/Configuration/Data/CommandLogging.hs b/src/Shrun/Configuration/Data/CommandLogging.hs
@@ -163,26 +163,10 @@ instance
   where
   labelOptic =
     lensVL
-      $ \f
-         ( MkCommandLoggingP
-             _bufferLength
-             _bufferTimeout
-             _pollInterval
-             _readSize
-             _readStrategy
-             _reportReadErrors
-           ) ->
-          fmap
-            ( \bufferLength' ->
-                MkCommandLoggingP
-                  bufferLength'
-                  _bufferTimeout
-                  _pollInterval
-                  _readSize
-                  _readStrategy
-                  _reportReadErrors
-            )
-            (f _bufferLength)
+      $ \f (MkCommandLoggingP a1 a2 a3 a4 a5 a6) ->
+        fmap
+          (\b -> MkCommandLoggingP b a2 a3 a4 a5 a6)
+          (f a1)
   {-# INLINE labelOptic #-}
 
 instance
@@ -191,26 +175,10 @@ instance
   where
   labelOptic =
     lensVL
-      $ \f
-         ( MkCommandLoggingP
-             _bufferLength
-             _bufferTimeout
-             _pollInterval
-             _readSize
-             _readStrategy
-             _reportReadErrors
-           ) ->
-          fmap
-            ( \bufferTimeout' ->
-                MkCommandLoggingP
-                  _bufferLength
-                  bufferTimeout'
-                  _pollInterval
-                  _readSize
-                  _readStrategy
-                  _reportReadErrors
-            )
-            (f _bufferTimeout)
+      $ \f (MkCommandLoggingP a1 a2 a3 a4 a5 a6) ->
+        fmap
+          (\b -> MkCommandLoggingP a1 b a3 a4 a5 a6)
+          (f a2)
   {-# INLINE labelOptic #-}
 
 instance
@@ -219,26 +187,10 @@ instance
   where
   labelOptic =
     lensVL
-      $ \f
-         ( MkCommandLoggingP
-             _bufferLength
-             _bufferTimeout
-             _pollInterval
-             _readSize
-             _readStrategy
-             _reportReadErrors
-           ) ->
-          fmap
-            ( \pollInterval' ->
-                MkCommandLoggingP
-                  _bufferLength
-                  _bufferTimeout
-                  pollInterval'
-                  _readSize
-                  _readStrategy
-                  _reportReadErrors
-            )
-            (f _pollInterval)
+      $ \f (MkCommandLoggingP a1 a2 a3 a4 a5 a6) ->
+        fmap
+          (\b -> MkCommandLoggingP a1 a2 b a4 a5 a6)
+          (f a3)
   {-# INLINE labelOptic #-}
 
 instance
@@ -247,26 +199,10 @@ instance
   where
   labelOptic =
     lensVL
-      $ \f
-         ( MkCommandLoggingP
-             _bufferLength
-             _bufferTimeout
-             _pollInterval
-             _readSize
-             _readStrategy
-             _reportReadErrors
-           ) ->
-          fmap
-            ( \readSize' ->
-                MkCommandLoggingP
-                  _bufferLength
-                  _bufferTimeout
-                  _pollInterval
-                  readSize'
-                  _readStrategy
-                  _reportReadErrors
-            )
-            (f _readSize)
+      $ \f (MkCommandLoggingP a1 a2 a3 a4 a5 a6) ->
+        fmap
+          (\b -> MkCommandLoggingP a1 a2 a3 b a5 a6)
+          (f a4)
   {-# INLINE labelOptic #-}
 
 instance
@@ -275,26 +211,10 @@ instance
   where
   labelOptic =
     lensVL
-      $ \f
-         ( MkCommandLoggingP
-             _bufferLength
-             _bufferTimeout
-             _pollInterval
-             _readSize
-             _readStrategy
-             _reportReadErrors
-           ) ->
-          fmap
-            ( \readStrategy' ->
-                MkCommandLoggingP
-                  _bufferLength
-                  _bufferTimeout
-                  _pollInterval
-                  _readSize
-                  readStrategy'
-                  _reportReadErrors
-            )
-            (f _readStrategy)
+      $ \f (MkCommandLoggingP a1 a2 a3 a4 a5 a6) ->
+        fmap
+          (\b -> MkCommandLoggingP a1 a2 a3 a4 b a6)
+          (f a5)
   {-# INLINE labelOptic #-}
 
 instance
@@ -303,24 +223,10 @@ instance
   where
   labelOptic =
     lensVL
-      $ \f
-         ( MkCommandLoggingP
-             _bufferLength
-             _bufferTimeout
-             _pollInterval
-             _readSize
-             _readStrategy
-             _reportReadErrors
-           ) ->
-          fmap
-            ( MkCommandLoggingP
-                _bufferLength
-                _bufferTimeout
-                _pollInterval
-                _readSize
-                _readStrategy
-            )
-            (f _reportReadErrors)
+      $ \f (MkCommandLoggingP a1 a2 a3 a4 a5 a6) ->
+        fmap
+          (\b -> MkCommandLoggingP a1 a2 a3 a4 a5 b)
+          (f a6)
   {-# INLINE labelOptic #-}
 
 type CommandLoggingArgs = CommandLoggingP ConfigPhaseArgs