Split WithDisable into separate module

Also generalize some of its functions and test laws as a sanity check
that we're behaving sensibly.

shrun.cabal

@@ -65,6 +65,7 @@ library
     Shrun.Configuration.Data.FileLogging
     Shrun.Configuration.Data.MergedConfig
     Shrun.Configuration.Data.Notify
+    Shrun.Configuration.Data.WithDisable
     Shrun.Configuration.Legend
     Shrun.Configuration.Toml
     Shrun.Data.Command
@@ -166,6 +167,7 @@ test-suite unit
     Unit.Generators
     Unit.Prelude
     Unit.Shrun.Configuration.Args
+    Unit.Shrun.Configuration.Data.WithDisable
     Unit.Shrun.Configuration.Legend
     Unit.Shrun.Logging.Formatting
     Unit.Shrun.Logging.Generators

src/Shrun/Configuration.hs

@@ -5,13 +5,6 @@ where
 
 import Shrun.Configuration.Args (Args)
 import Shrun.Configuration.Data.CmdLogging (mergeCmdLogging)
-import Shrun.Configuration.Data.ConfigPhase
-  ( WithDisable,
-    altDefault,
-    altNothing,
-    defaultIfDisabled,
-    nothingIfDisabled,
-  )
 import Shrun.Configuration.Data.Core
   ( CoreConfigArgs,
     CoreConfigP
@@ -37,6 +30,13 @@ import Shrun.Configuration.Data.MergedConfig
       ),
   )
 import Shrun.Configuration.Data.Notify (mergeNotifyLogging)
+import Shrun.Configuration.Data.WithDisable
+  ( WithDisable,
+    alternativeDefault,
+    alternativeEmpty,
+    defaultIfDisabled,
+    emptyIfDisabled,
+  )
 import Shrun.Configuration.Legend qualified as Legend
 import Shrun.Configuration.Toml (Toml)
 import Shrun.Data.Command (Command (MkCommand))
@@ -78,8 +78,8 @@ mergeConfig args mToml = do
         $ MkMergedConfig
           { coreConfig =
               MkCoreConfigP
-                { timeout = nothingIfDisabled (args ^. (#coreConfig % #timeout)),
-                  init = nothingIfDisabled (args ^. (#coreConfig % #init)),
+                { timeout = emptyIfDisabled (args ^. (#coreConfig % #timeout)),
+                  init = emptyIfDisabled (args ^. (#coreConfig % #init)),
                   keyHide =
                     defaultIfDisabled KeyHideOff (args ^. (#coreConfig % #keyHide)),
                   pollInterval =
@@ -95,7 +95,7 @@ mergeConfig args mToml = do
                       defaultTimerFormat
                       (args ^. (#coreConfig % #timerFormat)),
                   cmdNameTrunc =
-                    nothingIfDisabled (args ^. (#coreConfig % #cmdNameTrunc)),
+                    emptyIfDisabled (args ^. (#coreConfig % #cmdNameTrunc)),
                   cmdLogging,
                   fileLogging =
                     mergeFileLogging
@@ -128,31 +128,31 @@ mergeConfig args mToml = do
           { coreConfig =
               MkCoreConfigP
                 { timeout =
-                    altNothing' #timeout (toml ^. (#coreConfig % #timeout)),
+                    altNothing #timeout (toml ^. (#coreConfig % #timeout)),
                   init =
-                    altNothing' #init (toml ^. (#coreConfig % #init)),
+                    altNothing #init (toml ^. (#coreConfig % #init)),
                   keyHide =
-                    altDefault'
+                    altDefault
                       KeyHideOff
                       #keyHide
                       (toml ^. (#coreConfig % #keyHide)),
                   pollInterval =
-                    altDefault'
+                    altDefault
                       defaultPollInterval
                       #pollInterval
                       (toml ^. (#coreConfig % #pollInterval)),
                   cmdLogSize =
-                    altDefault'
+                    altDefault
                       defaultCmdLogSize
                       #cmdLogSize
                       (toml ^. (#coreConfig % #cmdLogSize)),
                   timerFormat =
-                    altDefault'
+                    altDefault
                       defaultTimerFormat
                       #timerFormat
                       (toml ^. (#coreConfig % #timerFormat)),
                   cmdNameTrunc =
-                    altNothing'
+                    altNothing
                       #cmdNameTrunc
                       (toml ^. (#coreConfig % #cmdNameTrunc)),
                   cmdLogging,
@@ -170,8 +170,8 @@ mergeConfig args mToml = do
   where
     cmdsText = args ^. #commands
 
-    altDefault' :: a -> Lens' CoreConfigArgs (WithDisable (Maybe a)) -> Maybe a -> a
-    altDefault' defA l = altDefault defA args (#coreConfig % l)
+    altDefault :: a -> Lens' CoreConfigArgs (WithDisable (Maybe a)) -> Maybe a -> a
+    altDefault defA l = alternativeDefault defA (args ^. (#coreConfig % l))
 
-    altNothing' :: Lens' CoreConfigArgs (WithDisable (Maybe a)) -> Maybe a -> Maybe a
-    altNothing' l = altNothing args (#coreConfig % l)
+    altNothing :: Lens' CoreConfigArgs (WithDisable (Maybe a)) -> Maybe a -> Maybe a
+    altNothing l = alternativeEmpty (args ^. (#coreConfig % l))

src/Shrun/Configuration/Args.hs

@@ -16,10 +16,6 @@ import Shrun.Configuration.Args.Parsing
 import Shrun.Configuration.Data.CmdLogging
   ( CmdLoggingP (MkCmdLoggingP, lineTrunc, stripControl),
   )
-import Shrun.Configuration.Data.ConfigPhase
-  ( WithDisable (With),
-    emptyWithDisable,
-  )
 import Shrun.Configuration.Data.Core
   ( CoreConfigP
       ( MkCoreConfigP,
@@ -47,39 +43,40 @@ import Shrun.Configuration.Data.FileLogging
 import Shrun.Configuration.Data.Notify
   ( NotifyP (MkNotifyP, action, system, timeout),
   )
+import Shrun.Configuration.Data.WithDisable (WithDisable (With))
 import Shrun.Prelude
 
 defaultArgs :: NESeq Text -> Args
 defaultArgs commands =
   MkArgs
-    { configPath = emptyWithDisable,
+    { configPath = mempty,
       cmdLog = With False,
       coreConfig =
         MkCoreConfigP
-          { timeout = emptyWithDisable,
-            init = emptyWithDisable,
-            keyHide = emptyWithDisable,
-            pollInterval = emptyWithDisable,
-            cmdLogSize = emptyWithDisable,
-            timerFormat = emptyWithDisable,
-            cmdNameTrunc = emptyWithDisable,
+          { timeout = mempty,
+            init = mempty,
+            keyHide = mempty,
+            pollInterval = mempty,
+            cmdLogSize = mempty,
+            timerFormat = mempty,
+            cmdNameTrunc = mempty,
             cmdLogging =
               MkCmdLoggingP
-                { stripControl = emptyWithDisable,
-                  lineTrunc = emptyWithDisable
+                { stripControl = mempty,
+                  lineTrunc = mempty
                 },
             fileLogging =
               MkFileLoggingP
-                { path = emptyWithDisable,
-                  stripControl = emptyWithDisable,
-                  mode = emptyWithDisable,
-                  sizeMode = emptyWithDisable
+                { path = mempty,
+                  stripControl = mempty,
+                  mode = mempty,
+                  sizeMode = mempty
                 },
             notify =
               MkNotifyP
-                { action = emptyWithDisable,
-                  system = emptyWithDisable,
-                  timeout = emptyWithDisable
+                { action = mempty,
+                  system = mempty,
+                  timeout = mempty
                 }
           },
       commands

src/Shrun/Configuration/Args/Parsing.hs

@@ -37,8 +37,8 @@ import Paths_shrun qualified as Paths
 import Shrun.Configuration.Args.Parsing.Core qualified as Core
 import Shrun.Configuration.Args.Parsing.Utils qualified as Utils
 import Shrun.Configuration.Args.TH (getDefaultConfigTH)
-import Shrun.Configuration.Data.ConfigPhase (WithDisable)
 import Shrun.Configuration.Data.Core (CoreConfigArgs)
+import Shrun.Configuration.Data.WithDisable (WithDisable)
 import Shrun.Prelude
 import Shrun.Utils qualified as U
 

src/Shrun/Configuration/Args/Parsing/CmdLogging.hs

@@ -15,7 +15,7 @@ import Shrun.Configuration.Data.CmdLogging
         stripControl
       ),
   )
-import Shrun.Configuration.Data.ConfigPhase (WithDisable)
+import Shrun.Configuration.Data.WithDisable (WithDisable)
 import Shrun.Data.StripControl (StripControl)
 import Shrun.Data.StripControl qualified as StripControl
 import Shrun.Data.Truncation (LineTruncation)

src/Shrun/Configuration/Args/Parsing/Core.hs

@@ -11,7 +11,6 @@ import Shrun.Configuration.Args.Parsing.CmdLogging qualified as CmdLogging
 import Shrun.Configuration.Args.Parsing.FileLogging qualified as FileLogging
 import Shrun.Configuration.Args.Parsing.Notify qualified as Notify
 import Shrun.Configuration.Args.Parsing.Utils qualified as Utils
-import Shrun.Configuration.Data.ConfigPhase (WithDisable)
 import Shrun.Configuration.Data.Core
   ( CoreConfigArgs,
     CoreConfigP
@@ -28,6 +27,7 @@ import Shrun.Configuration.Data.Core
         timerFormat
       ),
   )
+import Shrun.Configuration.Data.WithDisable (WithDisable)
 import Shrun.Data.KeyHide (KeyHide (KeyHideOn))
 import Shrun.Data.PollInterval
   ( PollInterval,

src/Shrun/Configuration/Args/Parsing/FileLogging.hs

@@ -7,11 +7,11 @@ where
 import Options.Applicative (Parser)
 import Options.Applicative qualified as OA
 import Shrun.Configuration.Args.Parsing.Utils qualified as Utils
-import Shrun.Configuration.Data.ConfigPhase (WithDisable)
 import Shrun.Configuration.Data.FileLogging
   ( FileLoggingArgs,
     FileLoggingP (MkFileLoggingP, mode, path, sizeMode, stripControl),
   )
+import Shrun.Configuration.Data.WithDisable (WithDisable)
 import Shrun.Data.FileMode (FileMode)
 import Shrun.Data.FileMode qualified as FileMode
 import Shrun.Data.FilePathDefault (FilePathDefault)

src/Shrun/Configuration/Args/Parsing/Notify.hs

@@ -7,11 +7,11 @@ where
 import Options.Applicative (Parser)
 import Options.Applicative qualified as OA
 import Shrun.Configuration.Args.Parsing.Utils qualified as Utils
-import Shrun.Configuration.Data.ConfigPhase (WithDisable)
 import Shrun.Configuration.Data.Notify
   ( NotifyArgs,
     NotifyP (MkNotifyP, action, system, timeout),
   )
+import Shrun.Configuration.Data.WithDisable (WithDisable)
 import Shrun.Notify.Types (NotifyAction, NotifySystemP1, NotifyTimeout)
 import Shrun.Notify.Types qualified as Notify
 import Shrun.Prelude

src/Shrun/Configuration/Args/Parsing/Utils.hs

@@ -9,7 +9,7 @@ import Options.Applicative (Parser)
 import Options.Applicative qualified as OA
 import Options.Applicative.Help.Chunk qualified as Chunk
 import Options.Applicative.Help.Pretty qualified as Pretty
-import Shrun.Configuration.Data.ConfigPhase (WithDisable (Disabled, With))
+import Shrun.Configuration.Data.WithDisable (WithDisable (Disabled, With))
 import Shrun.Prelude
 
 withDisableParser :: Parser a -> String -> Parser (WithDisable a)

src/Shrun/Configuration/Data/CmdLogging.hs

@@ -14,11 +14,13 @@ import Effects.System.Terminal (getTerminalWidth)
 import Shrun.Configuration.Data.ConfigPhase
   ( ConfigPhase (ConfigPhaseArgs, ConfigPhaseMerged, ConfigPhaseToml),
     ConfigPhaseF,
-    WithDisable (Disabled, With),
-    altDefault,
-    altNothing,
+  )
+import Shrun.Configuration.Data.WithDisable
+  ( WithDisable (Disabled, With),
+    alternativeDefault,
+    alternativeEmpty,
     defaultIfDisabled,
-    nothingIfDisabled,
+    emptyIfDisabled,
   )
 import Shrun.Data.StripControl (StripControl (StripControlSmart))
 import Shrun.Data.Truncation
@@ -79,7 +81,7 @@ mergeCmdLogging withDisable args mToml =
       (False, Nothing) -> pure Nothing
       -- 3. Args but no Toml -> Use Args
       (True, Nothing) -> do
-        cmdLogLineTrunc <- case nothingIfDisabled (args ^. #lineTrunc) of
+        cmdLogLineTrunc <- case emptyIfDisabled (args ^. #lineTrunc) of
           Just Detected -> Just . MkTruncation <$> getTerminalWidth
           Just (Undetected x) -> pure $ Just x
           Nothing -> pure Nothing
@@ -95,7 +97,7 @@ mergeCmdLogging withDisable args mToml =
       --
       --    We combine toml w/ Args' config in altNothing/Default below.
       (_, Just toml) -> do
-        cmdLogLineTrunc <- case altNothing' #lineTrunc (toml ^. #lineTrunc) of
+        cmdLogLineTrunc <- case altNothing #lineTrunc (toml ^. #lineTrunc) of
           Just Detected -> Just . MkTruncation <$> getTerminalWidth
           Just (Undetected x) -> pure $ Just x
           Nothing -> pure Nothing
@@ -104,18 +106,18 @@ mergeCmdLogging withDisable args mToml =
           $ Just
           $ MkCmdLoggingP
             { stripControl =
-                altDefault'
+                altDefault
                   StripControlSmart
                   #stripControl
                   (toml ^. #stripControl),
               lineTrunc = cmdLogLineTrunc
             }
   where
-    altDefault' :: a -> Lens' CmdLoggingArgs (WithDisable (Maybe a)) -> Maybe a -> a
-    altDefault' defA = altDefault defA args
+    altDefault :: a -> Lens' CmdLoggingArgs (WithDisable (Maybe a)) -> Maybe a -> a
+    altDefault defA l = alternativeDefault defA (args ^. l)
 
-    altNothing' :: Lens' CmdLoggingArgs (WithDisable (Maybe a)) -> Maybe a -> Maybe a
-    altNothing' = altNothing args
+    altNothing :: Lens' CmdLoggingArgs (WithDisable (Maybe a)) -> Maybe a -> Maybe a
+    altNothing l = alternativeEmpty (args ^. l)
 
 instance DecodeTOML CmdLoggingToml where
   tomlDecoder =

src/Shrun/Configuration/Data/ConfigPhase.hs

@@ -1,27 +1,13 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE UndecidableInstances #-}
-
 -- | Higher-Kinded data with type families for "phased-data" approach.
 module Shrun.Configuration.Data.ConfigPhase
   ( -- * Types
     ConfigPhase (..),
     ConfigPhaseF,
     ConfigPhaseMaybeF,
-    WithDisable (..),
-    emptyWithDisable,
-
-    -- * Functions
-    defaultIfDisabled,
-    nothingIfDisabled,
-    altDefault,
-    altNothing,
-
-    -- * Optics
-    _With,
-    _Disabled,
   )
 where
 
+import Shrun.Configuration.Data.WithDisable (WithDisable)
 import Shrun.Prelude
 
 -- | Data "phases" related to configuration.
@@ -54,42 +40,3 @@ type family ConfigPhaseMaybeF p a where
   ConfigPhaseMaybeF ConfigPhaseArgs a = WithDisable (Maybe a)
   ConfigPhaseMaybeF ConfigPhaseToml a = Maybe a
   ConfigPhaseMaybeF ConfigPhaseMerged a = Maybe a
-
--- | Adds a "disable" flag to some data. Though this is isomorphic to
--- Maybe, we create a new type to be clearer about provenance. For instance,
--- WithDisable (Maybe a) has much clearer meaning than Maybe (Maybe a)
--- ("which level means what?").
-data WithDisable a
-  = -- | The field.
-    With a
-  | -- | Disabled.
-    Disabled
-  deriving stock (Eq, Functor, Show)
-
-makePrisms ''WithDisable
-
--- | Initial WithDisable i.e. empty but not disabled.
-emptyWithDisable :: (Alternative f) => WithDisable (f a)
-emptyWithDisable = With empty
-
--- | Returns the data if it exists and is not disabled, otherwise returns
--- the default.
-defaultIfDisabled :: a -> WithDisable (Maybe a) -> a
-defaultIfDisabled x = fromMaybe x . nothingIfDisabled
-
--- | Returns nothing if the data is disabled or it does not exist.
-nothingIfDisabled :: WithDisable (Maybe a) -> Maybe a
-nothingIfDisabled = preview (_With % _Just)
-
--- | Morally returns @l <|> r@, if one exists and the disable flag is not
--- active. Otherwise returns the default.
-altDefault :: a -> args -> Lens' args (WithDisable (Maybe a)) -> Maybe a -> a
-altDefault defA args l = fromMaybe defA . altNothing args l
-
--- | Morally returns @l <|> r@, if one exists and the disable flag is not
--- active.
-altNothing :: args -> Lens' args (WithDisable (Maybe a)) -> Maybe a -> Maybe a
-altNothing args l r =
-  case args ^. l of
-    Disabled -> Nothing
-    With x -> x <|> r