{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Provides functions for creating 'Env' from CLI/Toml configuration.
module Shrun.Configuration.Env
  ( -- * Running with Env
    withEnv,
    makeEnvAndShrun,

    -- * Misc
    TomlPathError (..),
    getMergedConfig,
  )
where

import Data.HashMap.Strict qualified as Map
import Data.HashSet qualified as Set
import Data.List qualified as L
import Data.Sequence qualified as Seq
import Data.Text qualified as T
import Effects.FileSystem.PathReader qualified as PR
import Effects.FileSystem.PathWriter qualified as PW
import Shrun (runShellT, shrun)
import Shrun.Command.Types
  ( CommandStatus (CommandWaiting),
    CommandStatusMapP (MkCommandStatusMapP),
  )
import Shrun.Configuration (mergeConfig)
import Shrun.Configuration.Args.Parsing qualified as P
import Shrun.Configuration.Data.Core qualified as CoreConfig
import Shrun.Configuration.Data.LegendKeysCache
  ( LegendKeysCache
      ( LegendKeysAdd,
        LegendKeysClear,
        LegendKeysOff,
        LegendKeysWrite
      ),
  )
import Shrun.Configuration.Data.MergedConfig (MergedConfig)
import Shrun.Configuration.Data.WithDisabled (WithDisabled (Disabled, With))
import Shrun.Configuration.Env.Types
  ( CommandCleanup
      ( MkCommandCleanup,
        findPidsExe,
        killPidsExe
      ),
    Env
      ( MkEnv,
        anyError,
        commandCleanup,
        commandGraph,
        commandStatusMap,
        commands,
        config,
        consoleLogQueue,
        hasTimedOut,
        timerRegion
      ),
    HasConsoleLogging,
  )
import Shrun.Configuration.Toml (Toml)
import Shrun.Configuration.Toml qualified as Toml
import Shrun.Logging.MonadRegionLogger (MonadRegionLogger (Region))
import Shrun.Prelude
import Shrun.ShellT (ShellT)

-- | 'withEnv' with 'shrun'.
makeEnvAndShrun ::
  forall m notifyEnv r.
  ( HasCallStack,
    HasConsoleLogging (Env notifyEnv r) (Region (ShellT (Env notifyEnv r) m)),
    MonadAsync m,
    MonadAtomic m,
    MonadEvaluate m,
    MonadFileReader m,
    MonadFileWriter m,
    MonadHandleReader m,
    MonadHandleWriter m,
    MonadIORef m,
    MonadMask m,
    MonadMVar m,
    MonadNotify m,
    MonadOptparse m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadPosixFiles m,
    MonadPosixSignals m,
    MonadProcess m,
    MonadRegionLogger m,
    MonadTerminal m,
    MonadThread m,
    MonadTime m,
    NotifyEnvF m ~ notifyEnv
  ) =>
  m ()
makeEnvAndShrun :: forall (m :: Type -> Type) notifyEnv r.
(HasCallStack,
 HasConsoleLogging
   (Env notifyEnv r) (Region (ShellT (Env notifyEnv r) m)),
 MonadAsync m, MonadAtomic m, MonadEvaluate m, MonadFileReader m,
 MonadFileWriter m, MonadHandleReader m, MonadHandleWriter m,
 MonadIORef m, MonadMask m, MonadMVar m, MonadNotify m,
 MonadOptparse m, MonadPathReader m, MonadPathWriter m,
 MonadPosixFiles m, MonadPosixSignals m, MonadProcess m,
 MonadRegionLogger m, MonadTerminal m, MonadThread m, MonadTime m,
 NotifyEnvF m ~ notifyEnv) =>
m ()
makeEnvAndShrun = forall (m :: Type -> Type) notifyEnv r a.
(HasCallStack, MonadAtomic m, MonadFileReader m, MonadFileWriter m,
 MonadHandleWriter m, MonadIORef m, MonadMask m, MonadNotify m,
 MonadOptparse m, MonadPathReader m, MonadPathWriter m,
 MonadPosixFiles m, MonadTerminal m, NotifyEnvF m ~ notifyEnv) =>
(Env notifyEnv r -> m a) -> m a
withEnv @m @notifyEnv @r (ShellT (Env notifyEnv r) m () -> Env notifyEnv r -> m ()
forall (m :: Type -> Type) env a. ShellT env m a -> env -> m a
runShellT ShellT (Env notifyEnv r) m ()
forall (m :: Type -> Type) env notifyEnv.
(HasAnyError env, HasCallStack, HasCommands env, HasInit env,
 HasLogging env m, HasNotifyConfig env notifyEnv, HasTimeout env,
 MonadAsync m, MonadAtomic m, MonadEvaluate m, MonadHandleReader m,
 MonadHandleWriter m, MonadIORef m, MonadMask m, MonadNotify m,
 MonadPathReader m, MonadPathWriter m, MonadPosixFiles m,
 MonadPosixSignals m, MonadProcess m, MonadMVar m,
 MonadReader env m, MonadRegionLogger m, MonadThread m, MonadTime m,
 NotifyEnvF m ~ notifyEnv) =>
m ()
shrun)
{-# INLINEABLE makeEnvAndShrun #-}

-- | Creates an 'Env' from CLI args and TOML config to run with a monadic
-- action.
withEnv ::
  forall m notifyEnv r a.
  ( HasCallStack,
    MonadAtomic m,
    MonadFileReader m,
    MonadFileWriter m,
    MonadHandleWriter m,
    MonadIORef m,
    MonadMask m,
    MonadNotify m,
    MonadOptparse m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadPosixFiles m,
    MonadTerminal m,
    NotifyEnvF m ~ notifyEnv
  ) =>
  (Env notifyEnv r -> m a) ->
  m a
withEnv :: forall (m :: Type -> Type) notifyEnv r a.
(HasCallStack, MonadAtomic m, MonadFileReader m, MonadFileWriter m,
 MonadHandleWriter m, MonadIORef m, MonadMask m, MonadNotify m,
 MonadOptparse m, MonadPathReader m, MonadPathWriter m,
 MonadPosixFiles m, MonadTerminal m, NotifyEnvF m ~ notifyEnv) =>
(Env notifyEnv r -> m a) -> m a
withEnv Env notifyEnv r -> m a
onEnv = m (MergedConfig notifyEnv)
forall (m :: Type -> Type) r.
(HasCallStack, MonadCatch m, MonadFileReader m, MonadFileWriter m,
 MonadIORef m, MonadOptparse m, MonadPathReader m,
 MonadPathWriter m, MonadTerminal m) =>
m (MergedConfig r)
getMergedConfig m (MergedConfig notifyEnv)
-> (MergedConfig notifyEnv -> m a) -> m a
forall a b. m a -> (a -> m b) -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= (MergedConfig notifyEnv -> (Env notifyEnv r -> m a) -> m a)
-> (Env notifyEnv r -> m a) -> MergedConfig notifyEnv -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip MergedConfig notifyEnv -> (Env notifyEnv r -> m a) -> m a
forall (m :: Type -> Type) notifyEnv r a.
(HasCallStack, MonadAtomic m, MonadFileWriter m,
 MonadHandleWriter m, MonadIORef m, MonadMask m, MonadNotify m,
 MonadPathReader m, MonadPathWriter m, MonadPosixFiles m,
 MonadTerminal m, NotifyEnvF m ~ notifyEnv) =>
MergedConfig notifyEnv -> (Env notifyEnv r -> m a) -> m a
fromMergedConfig Env notifyEnv r -> m a
onEnv
{-# INLINEABLE withEnv #-}

-- | Creates a 'MergedConfig' from CLI args and TOML config.
getMergedConfig ::
  ( HasCallStack,
    MonadCatch m,
    MonadFileReader m,
    MonadFileWriter m,
    MonadIORef m,
    MonadOptparse m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadTerminal m
  ) =>
  m (MergedConfig r)
getMergedConfig :: forall (m :: Type -> Type) r.
(HasCallStack, MonadCatch m, MonadFileReader m, MonadFileWriter m,
 MonadIORef m, MonadOptparse m, MonadPathReader m,
 MonadPathWriter m, MonadTerminal m) =>
m (MergedConfig r)
getMergedConfig = do
  OsPath
xdgState <- m OsPath
forall (m :: Type -> Type).
(HasCallStack, MonadPathReader m) =>
m OsPath
getShrunXdgState

  -- Read legend keys from last run, if they exist. We then pass them into
  -- the parser so we get completions.
  [Text]
prevKeys <- OsPath -> m [Text]
forall (m :: Type -> Type).
(HasCallStack, MonadCatch m, MonadFileReader m, MonadPathReader m,
 MonadPathWriter m, MonadTerminal m) =>
OsPath -> m [Text]
readPreviousLegendKeys OsPath
xdgState

  Args r
args <- ParserPrefs -> ParserInfo (Args r) -> m (Args r)
forall a. HasCallStack => ParserPrefs -> ParserInfo a -> m a
forall (m :: Type -> Type) a.
(MonadOptparse m, HasCallStack) =>
ParserPrefs -> ParserInfo a -> m a
customExecParser ParserPrefs
P.parserPrefs ([String] -> ParserInfo (Args r)
forall m. [String] -> ParserInfo (Args m)
P.parserInfoArgs ([String] -> ParserInfo (Args r))
-> [String] -> ParserInfo (Args r)
forall a b. (a -> b) -> a -> b
$ Text -> String
unpack (Text -> String) -> [Text] -> [String]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
prevKeys)

  let configPaths :: Seq (WithDisabled OsPath)
configPaths = Args r
args Args r
-> Optic' A_Lens NoIx (Args r) (Seq (WithDisabled OsPath))
-> Seq (WithDisabled OsPath)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (Args r) (Seq (WithDisabled OsPath))
#configPaths

  Seq (WithDisabled OsPath)
tomls <- do
    -- If our configs list contains /any/ Disabled, then the implicit configs
    -- will be ignored, as they are the implicit first elements. Hence we guard
    -- against it to save unnecessary lookups.
    if Seq (WithDisabled OsPath) -> Bool
containsDisabled Seq (WithDisabled OsPath)
configPaths
      then Seq (WithDisabled OsPath) -> m (Seq (WithDisabled OsPath))
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Seq (WithDisabled OsPath)
configPaths
      else (\Seq OsPath
ps -> (OsPath -> WithDisabled OsPath
forall a. a -> WithDisabled a
With (OsPath -> WithDisabled OsPath)
-> Seq OsPath -> Seq (WithDisabled OsPath)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Seq OsPath
ps) Seq (WithDisabled OsPath)
-> Seq (WithDisabled OsPath) -> Seq (WithDisabled OsPath)
forall a. Semigroup a => a -> a -> a
<> Seq (WithDisabled OsPath)
configPaths) (Seq OsPath -> Seq (WithDisabled OsPath))
-> m (Seq OsPath) -> m (Seq (WithDisabled OsPath))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Seq OsPath)
forall (m :: Type -> Type).
(HasCallStack, MonadPathReader m) =>
m (Seq OsPath)
findImplicitConfigs

  (Seq OsPath
tomlPaths, Toml r
finalToml) <- Seq (WithDisabled OsPath) -> m (Seq OsPath, Toml r)
forall (m :: Type -> Type) notifyEnv.
(HasCallStack, MonadFileReader m, MonadThrow m) =>
Seq (WithDisabled OsPath) -> m (Seq OsPath, Toml notifyEnv)
mergeTomls Seq (WithDisabled OsPath)
tomls

  MergedConfig r
merged <- Args r -> Toml r -> Seq OsPath -> m (MergedConfig r)
forall (m :: Type -> Type) notifyEnv.
(HasCallStack, MonadCatch m, MonadIORef m, MonadTerminal m) =>
Args notifyEnv
-> Toml notifyEnv -> Seq OsPath -> m (MergedConfig notifyEnv)
mergeConfig Args r
args Toml r
finalToml Seq OsPath
tomlPaths

  OsPath -> LegendKeysCache -> [Text] -> Toml r -> m ()
forall (m :: Type -> Type) notifyEnv.
(HasCallStack, MonadFileWriter m, MonadPathReader m,
 MonadPathWriter m) =>
OsPath -> LegendKeysCache -> [Text] -> Toml notifyEnv -> m ()
saveLegendKeys OsPath
xdgState (MergedConfig r
merged MergedConfig r
-> Optic' A_Lens NoIx (MergedConfig r) LegendKeysCache
-> LegendKeysCache
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic
  A_Lens
  NoIx
  (MergedConfig r)
  (MergedConfig r)
  (CoreConfigMerged r)
  (CoreConfigMerged r)
#coreConfig Optic
  A_Lens
  NoIx
  (MergedConfig r)
  (MergedConfig r)
  (CoreConfigMerged r)
  (CoreConfigMerged r)
-> Optic
     A_Lens
     NoIx
     (CoreConfigMerged r)
     (CoreConfigMerged r)
     LegendKeysCache
     LegendKeysCache
-> Optic' A_Lens NoIx (MergedConfig r) LegendKeysCache
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
  A_Lens
  NoIx
  (CoreConfigMerged r)
  (CoreConfigMerged r)
  LegendKeysCache
  LegendKeysCache
#legendKeysCache) [Text]
prevKeys Toml r
finalToml

  pure MergedConfig r
merged
  where
    containsDisabled :: Seq (WithDisabled OsPath) -> Bool
containsDisabled = WithDisabled OsPath -> Seq (WithDisabled OsPath) -> Bool
forall a. Eq a => a -> Seq a -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
L.elem WithDisabled OsPath
forall a. WithDisabled a
Disabled
{-# INLINEABLE getMergedConfig #-}

-- | Searches for implicit configs. The list of searched paths are:
--
-- - xdg_config/config.toml
-- - cwd/.shrun.toml
-- - cwd/shrun.toml
findImplicitConfigs ::
  ( HasCallStack,
    MonadPathReader m
  ) =>
  m (Seq OsPath)
findImplicitConfigs :: forall (m :: Type -> Type).
(HasCallStack, MonadPathReader m) =>
m (Seq OsPath)
findImplicitConfigs = do
  OsPath
xdgConfig <- m OsPath
forall (m :: Type -> Type).
(HasCallStack, MonadPathReader m) =>
m OsPath
getShrunXdgConfig
  OsPath
cwd <- m OsPath
forall (m :: Type -> Type).
(MonadPathReader m, HasCallStack) =>
m OsPath
PR.getCurrentDirectory
  let paths :: Seq OsPath
paths =
        (OsPath
xdgConfig OsPath -> OsPath -> OsPath
</> [osp|config.toml|])
          OsPath -> Seq OsPath -> Seq OsPath
forall a. a -> Seq a -> Seq a
:<| OsPath -> Seq OsPath
forall {l}. (Item l ~ OsPath, IsList l) => OsPath -> l
mkPaths OsPath
xdgConfig
          Seq OsPath -> Seq OsPath -> Seq OsPath
forall a. Semigroup a => a -> a -> a
<> OsPath -> Seq OsPath
forall {l}. (Item l ~ OsPath, IsList l) => OsPath -> l
mkPaths OsPath
cwd

  Seq (Maybe OsPath)
xs <- (OsPath -> m (Maybe OsPath))
-> Seq OsPath -> m (Seq (Maybe OsPath))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse OsPath -> m (Maybe OsPath)
forall (m :: Type -> Type).
(HasCallStack, MonadPathReader m) =>
OsPath -> m (Maybe OsPath)
configExists Seq OsPath
paths
  pure $ Seq (Maybe OsPath) -> Seq OsPath
forall a. Seq (Maybe a) -> Seq a
catSeqMaybes Seq (Maybe OsPath)
xs
  where
    mkPaths :: OsPath -> l
mkPaths OsPath
d =
      [ OsPath
d OsPath -> OsPath -> OsPath
</> [osp|.shrun.toml|],
        OsPath
d OsPath -> OsPath -> OsPath
</> [osp|shrun.toml|]
      ]
{-# INLINEABLE findImplicitConfigs #-}

configExists :: (HasCallStack, MonadPathReader m) => OsPath -> m (Maybe OsPath)
configExists :: forall (m :: Type -> Type).
(HasCallStack, MonadPathReader m) =>
OsPath -> m (Maybe OsPath)
configExists OsPath
p = do
  Bool
exists <- OsPath -> m Bool
forall (m :: Type -> Type).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesFileExist OsPath
p
  pure
    $ if Bool
exists
      then OsPath -> Maybe OsPath
forall a. a -> Maybe a
Just OsPath
p
      else Maybe OsPath
forall a. Maybe a
Nothing
{-# INLINEABLE configExists #-}

-- | Merges several toml files together.
--
-- NOTE: [Toml order]
--
-- @
--   xdg, t1, t2, ..., tn
-- @
--
-- Where the xdg is the first toml (if it exists), and the rest are given
-- on the CLI. We want the semantics to favor the RHS when there are conflicts.
-- In particular, if some @tk == disabled@, we want all @ti, i < k@ to be
-- disabled.
--
-- Hence we reverse the list to
--
-- @
-- tn, ..., t2, t1, xdg
-- @
--
-- Then drop everything after finding a disabled config. Note that we do
-- /not/ restore the original order (i.e. reverse again). Why? Because our
-- semigroups are left-biased, and we want @tk@ to override @ti@ whenever
-- @i < k@. Hence we can leave the reverse order and foldr.
mergeTomls ::
  forall m notifyEnv.
  ( HasCallStack,
    MonadFileReader m,
    MonadThrow m
  ) =>
  Seq (WithDisabled OsPath) ->
  m (Tuple2 (Seq OsPath) (Toml notifyEnv))
mergeTomls :: forall (m :: Type -> Type) notifyEnv.
(HasCallStack, MonadFileReader m, MonadThrow m) =>
Seq (WithDisabled OsPath) -> m (Seq OsPath, Toml notifyEnv)
mergeTomls =
  -- Reverse toml paths so they are in the original order. No need to reverse
  -- actual Toml files because mergeTomls expects the inverse order.
  (Seq (OsPath, Toml notifyEnv) -> (Seq OsPath, Toml notifyEnv))
-> m (Seq (OsPath, Toml notifyEnv))
-> m (Seq OsPath, Toml notifyEnv)
forall a b. (a -> b) -> m a -> m b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Seq OsPath -> Seq OsPath)
-> (Seq (Toml notifyEnv) -> Toml notifyEnv)
-> (Seq OsPath, Seq (Toml notifyEnv))
-> (Seq OsPath, Toml notifyEnv)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: Type -> Type -> Type) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Seq OsPath -> Seq OsPath
forall a. Seq a -> Seq a
Seq.reverse Seq (Toml notifyEnv) -> Toml notifyEnv
forall notifyEnv. Seq (Toml notifyEnv) -> Toml notifyEnv
Toml.mergeTomls ((Seq OsPath, Seq (Toml notifyEnv))
 -> (Seq OsPath, Toml notifyEnv))
-> (Seq (OsPath, Toml notifyEnv)
    -> (Seq OsPath, Seq (Toml notifyEnv)))
-> Seq (OsPath, Toml notifyEnv)
-> (Seq OsPath, Toml notifyEnv)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Seq (OsPath, Toml notifyEnv) -> (Seq OsPath, Seq (Toml notifyEnv))
forall a b. Seq (a, b) -> (Seq a, Seq b)
Seq.unzip)
    (m (Seq (OsPath, Toml notifyEnv))
 -> m (Seq OsPath, Toml notifyEnv))
-> (Seq (WithDisabled OsPath) -> m (Seq (OsPath, Toml notifyEnv)))
-> Seq (WithDisabled OsPath)
-> m (Seq OsPath, Toml notifyEnv)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (OsPath -> m (OsPath, Toml notifyEnv))
-> Seq OsPath -> m (Seq (OsPath, Toml notifyEnv))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: Type -> Type) a b.
Applicative f =>
(a -> f b) -> Seq a -> f (Seq b)
traverse (\OsPath
t -> (OsPath
t,) (Toml notifyEnv -> (OsPath, Toml notifyEnv))
-> m (Toml notifyEnv) -> m (OsPath, Toml notifyEnv)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> OsPath -> m (Toml notifyEnv)
forall (m :: Type -> Type) notifyEnv.
(HasCallStack, MonadFileReader m, MonadThrow m) =>
OsPath -> m (Toml notifyEnv)
readConfig OsPath
t)
    (Seq OsPath -> m (Seq (OsPath, Toml notifyEnv)))
-> (Seq (WithDisabled OsPath) -> Seq OsPath)
-> Seq (WithDisabled OsPath)
-> m (Seq (OsPath, Toml notifyEnv))
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Seq (WithDisabled OsPath) -> Seq OsPath
forall {a}. Seq (WithDisabled a) -> Seq a
dropAfterDisabled
    (Seq (WithDisabled OsPath) -> Seq OsPath)
-> (Seq (WithDisabled OsPath) -> Seq (WithDisabled OsPath))
-> Seq (WithDisabled OsPath)
-> Seq OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Seq (WithDisabled OsPath) -> Seq (WithDisabled OsPath)
forall a. Seq a -> Seq a
Seq.reverse
  where
    dropAfterDisabled :: Seq (WithDisabled a) -> Seq a
dropAfterDisabled Seq (WithDisabled a)
Empty = Seq a
forall a. Seq a
Empty
    dropAfterDisabled (WithDisabled a
Disabled :<| Seq (WithDisabled a)
_) = Seq a
forall a. Seq a
Empty
    dropAfterDisabled (With a
f :<| Seq (WithDisabled a)
fs) = a
f a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| Seq (WithDisabled a) -> Seq a
dropAfterDisabled Seq (WithDisabled a)
fs

data TomlPathError = MkTomlPathError OsPath TOMLError
  deriving stock (Int -> TomlPathError -> ShowS
[TomlPathError] -> ShowS
TomlPathError -> String
(Int -> TomlPathError -> ShowS)
-> (TomlPathError -> String)
-> ([TomlPathError] -> ShowS)
-> Show TomlPathError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TomlPathError -> ShowS
showsPrec :: Int -> TomlPathError -> ShowS
$cshow :: TomlPathError -> String
show :: TomlPathError -> String
$cshowList :: [TomlPathError] -> ShowS
showList :: [TomlPathError] -> ShowS
Show)

instance Exception TomlPathError where
  displayException :: TomlPathError -> String
displayException (MkTomlPathError OsPath
p TOMLError
err) =
    [String] -> String
forall a. Monoid a => [a] -> a
mconcat
      [ String
Item [String]
"Toml error in '",
        OsPath -> String
decodeLenient OsPath
p,
        String
Item [String]
"': ",
        TOMLError -> String
forall e. Exception e => e -> String
displayException TOMLError
err
      ]

readConfig ::
  ( HasCallStack,
    MonadFileReader m,
    MonadThrow m
  ) =>
  OsPath ->
  m (Toml notifyEnv)
readConfig :: forall (m :: Type -> Type) notifyEnv.
(HasCallStack, MonadFileReader m, MonadThrow m) =>
OsPath -> m (Toml notifyEnv)
readConfig OsPath
fp = do
  Text
contents <- OsPath -> m Text
forall (m :: Type -> Type).
(HasCallStack, MonadFileReader m, MonadThrow m) =>
OsPath -> m Text
readFileUtf8ThrowM OsPath
fp
  case Text -> Either TOMLError (Toml notifyEnv)
forall a. DecodeTOML a => Text -> Either TOMLError a
decode Text
contents of
    Right Toml notifyEnv
cfg -> Toml notifyEnv -> m (Toml notifyEnv)
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Toml notifyEnv
cfg
    Left TOMLError
tomlErr -> TomlPathError -> m (Toml notifyEnv)
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: Type -> Type) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM (TomlPathError -> m (Toml notifyEnv))
-> TomlPathError -> m (Toml notifyEnv)
forall a b. (a -> b) -> a -> b
$ OsPath -> TOMLError -> TomlPathError
MkTomlPathError OsPath
fp TOMLError
tomlErr

fromMergedConfig ::
  ( HasCallStack,
    MonadAtomic m,
    MonadFileWriter m,
    MonadHandleWriter m,
    MonadIORef m,
    MonadMask m,
    MonadNotify m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadPosixFiles m,
    MonadTerminal m,
    NotifyEnvF m ~ notifyEnv
  ) =>
  MergedConfig notifyEnv ->
  (Env notifyEnv r -> m a) ->
  m a
fromMergedConfig :: forall (m :: Type -> Type) notifyEnv r a.
(HasCallStack, MonadAtomic m, MonadFileWriter m,
 MonadHandleWriter m, MonadIORef m, MonadMask m, MonadNotify m,
 MonadPathReader m, MonadPathWriter m, MonadPosixFiles m,
 MonadTerminal m, NotifyEnvF m ~ notifyEnv) =>
MergedConfig notifyEnv -> (Env notifyEnv r -> m a) -> m a
fromMergedConfig MergedConfig notifyEnv
cfg Env notifyEnv r -> m a
onEnv = do
  Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when (MergedConfig notifyEnv
cfg MergedConfig notifyEnv
-> Optic' A_Lens NoIx (MergedConfig notifyEnv) Bool -> Bool
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (MergedConfig notifyEnv) Bool
#dryRun) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Text -> m ()
forall (m :: Type -> Type).
(HasCallStack, MonadTerminal m) =>
Text -> m ()
putTextLn
      (Text -> m ())
-> (MergedConfig notifyEnv -> Text)
-> MergedConfig notifyEnv
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. MergedConfig notifyEnv -> Text
forall a. Pretty a => a -> Text
prettyToText
      (MergedConfig notifyEnv -> m ()) -> MergedConfig notifyEnv -> m ()
forall a b. (a -> b) -> a -> b
$ MergedConfig notifyEnv
cfg
    ExitCode -> m ()
forall e a. (HasCallStack, Exception e) => e -> m a
forall (m :: Type -> Type) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> m a
throwM ExitCode
ExitSuccess

  CommandStatusMapP 'CommandStatusMapStm
commandStatusMap <- STM (CommandStatusMapP 'CommandStatusMapStm)
-> m (CommandStatusMapP 'CommandStatusMapStm)
forall a. HasCallStack => STM a -> m a
forall (m :: Type -> Type) a.
(MonadAtomic m, HasCallStack) =>
STM a -> m a
atomically (STM (CommandStatusMapP 'CommandStatusMapStm)
 -> m (CommandStatusMapP 'CommandStatusMapStm))
-> STM (CommandStatusMapP 'CommandStatusMapStm)
-> m (CommandStatusMapP 'CommandStatusMapStm)
forall a b. (a -> b) -> a -> b
$ do
    NESeq (CommandIndex, (CommandP1, TVar CommandStatus))
kvs <- NESeq CommandP1
-> (CommandP1
    -> STM (CommandIndex, (CommandP1, TVar CommandStatus)))
-> STM (NESeq (CommandIndex, (CommandP1, TVar CommandStatus)))
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for NESeq CommandP1
commands ((CommandP1 -> STM (CommandIndex, (CommandP1, TVar CommandStatus)))
 -> STM (NESeq (CommandIndex, (CommandP1, TVar CommandStatus))))
-> (CommandP1
    -> STM (CommandIndex, (CommandP1, TVar CommandStatus)))
-> STM (NESeq (CommandIndex, (CommandP1, TVar CommandStatus)))
forall a b. (a -> b) -> a -> b
$ \CommandP1
cmd -> do
      TVar CommandStatus
statusVar <- CommandStatus -> STM (TVar CommandStatus)
forall a. a -> STM (TVar a)
newTVar' CommandStatus
CommandWaiting
      pure (CommandP1
cmd CommandP1
-> Optic' A_Lens NoIx CommandP1 CommandIndex -> CommandIndex
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx CommandP1 CommandIndex
#index, (CommandP1
cmd, TVar CommandStatus
statusVar))
    pure $ CommandStatusMapIndexF 'CommandStatusMapStm
-> CommandStatusMapP 'CommandStatusMapStm
forall (p :: CommandStatusMapIndex).
CommandStatusMapIndexF p -> CommandStatusMapP p
MkCommandStatusMapP (CommandStatusMapIndexF 'CommandStatusMapStm
 -> CommandStatusMapP 'CommandStatusMapStm)
-> CommandStatusMapIndexF 'CommandStatusMapStm
-> CommandStatusMapP 'CommandStatusMapStm
forall a b. (a -> b) -> a -> b
$ [(CommandIndex, (CommandP1, TVar CommandStatus))]
-> HashMap CommandIndex (CommandP1, TVar CommandStatus)
forall k v. Hashable k => [(k, v)] -> HashMap k v
Map.fromList ([(CommandIndex, (CommandP1, TVar CommandStatus))]
 -> HashMap CommandIndex (CommandP1, TVar CommandStatus))
-> [(CommandIndex, (CommandP1, TVar CommandStatus))]
-> HashMap CommandIndex (CommandP1, TVar CommandStatus)
forall a b. (a -> b) -> a -> b
$ NESeq (CommandIndex, (CommandP1, TVar CommandStatus))
-> [(CommandIndex, (CommandP1, TVar CommandStatus))]
forall a. NESeq a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList NESeq (CommandIndex, (CommandP1, TVar CommandStatus))
kvs

  TVar Bool
anyError <- Bool -> m (TVar Bool)
forall (m :: Type -> Type) a.
(HasCallStack, MonadAtomic m) =>
a -> m (TVar a)
newTVarA' Bool
False
  TBQueue (LogRegion r)
consoleLogQueue <- Natural -> m (TBQueue (LogRegion r))
forall (m :: Type -> Type) a.
(HasCallStack, MonadAtomic m) =>
Natural -> m (TBQueue a)
newTBQueueA Natural
1_000
  TVar Bool
hasTimedOut <- Bool -> m (TVar Bool)
forall (m :: Type -> Type) a.
(HasCallStack, MonadAtomic m) =>
a -> m (TVar a)
newTVarA' Bool
False
  IORef (Maybe r)
timerRegion <- Maybe r -> m (IORef (Maybe r))
forall a. HasCallStack => a -> m (IORef a)
forall (m :: Type -> Type) a.
(MonadIORef m, HasCallStack) =>
a -> m (IORef a)
newIORef' Maybe r
forall a. Maybe a
Nothing

  Maybe String
mKillExe <- OsPath -> m (Maybe String)
forall {f :: Type -> Type}.
(MonadCatch f, MonadPathReader f) =>
OsPath -> f (Maybe String)
mFindExe [osp|kill|]
  Maybe String
mPGrepExe <- OsPath -> m (Maybe String)
forall {f :: Type -> Type}.
(MonadCatch f, MonadPathReader f) =>
OsPath -> f (Maybe String)
mFindExe [osp|pgrep|]

  let commandCleanup :: Maybe CommandCleanup
commandCleanup = do
        String
findPidsExe <- Maybe String
mPGrepExe
        String
killPidsExe <- Maybe String
mKillExe
        pure
          $ MkCommandCleanup
            { String
findPidsExe :: String
findPidsExe :: String
findPidsExe,
              String
killPidsExe :: String
killPidsExe :: String
killPidsExe
            }

  CoreConfigMerged notifyEnv
-> (CoreConfigEnv notifyEnv -> m a) -> m a
forall (m :: Type -> Type) r a.
(HasCallStack, MonadAtomic m, MonadFileWriter m,
 MonadHandleWriter m, MonadMask m, MonadNotify m, MonadPathReader m,
 MonadPathWriter m, MonadPosixFiles m, MonadTerminal m,
 NotifyEnvF m ~ r) =>
CoreConfigMerged r -> (CoreConfigEnv r -> m a) -> m a
CoreConfig.withCoreEnv (MergedConfig notifyEnv
cfg MergedConfig notifyEnv
-> Optic'
     A_Lens NoIx (MergedConfig notifyEnv) (CoreConfigMerged notifyEnv)
-> CoreConfigMerged notifyEnv
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic'
  A_Lens NoIx (MergedConfig notifyEnv) (CoreConfigMerged notifyEnv)
#coreConfig) ((CoreConfigEnv notifyEnv -> m a) -> m a)
-> (CoreConfigEnv notifyEnv -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \CoreConfigEnv notifyEnv
coreConfigEnv -> do
    let env :: Env notifyEnv r
env =
          MkEnv
            { config :: CoreConfigEnv notifyEnv
config = CoreConfigEnv notifyEnv
coreConfigEnv,
              TVar Bool
anyError :: TVar Bool
anyError :: TVar Bool
anyError,
              CommandStatusMapP 'CommandStatusMapStm
commandStatusMap :: CommandStatusMapP 'CommandStatusMapStm
commandStatusMap :: CommandStatusMapP 'CommandStatusMapStm
commandStatusMap,
              TBQueue (LogRegion r)
consoleLogQueue :: TBQueue (LogRegion r)
consoleLogQueue :: TBQueue (LogRegion r)
consoleLogQueue,
              CommandGraph
commandGraph :: CommandGraph
commandGraph :: CommandGraph
commandGraph,
              NESeq CommandP1
commands :: NESeq CommandP1
commands :: NESeq CommandP1
commands,
              Maybe CommandCleanup
commandCleanup :: Maybe CommandCleanup
commandCleanup :: Maybe CommandCleanup
commandCleanup,
              TVar Bool
hasTimedOut :: TVar Bool
hasTimedOut :: TVar Bool
hasTimedOut,
              IORef (Maybe r)
timerRegion :: IORef (Maybe r)
timerRegion :: IORef (Maybe r)
timerRegion
            }

    Env notifyEnv r -> m a
onEnv Env notifyEnv r
env
  where
    commands :: NESeq CommandP1
commands = MergedConfig notifyEnv
cfg MergedConfig notifyEnv
-> Optic' A_Lens NoIx (MergedConfig notifyEnv) (NESeq CommandP1)
-> NESeq CommandP1
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (MergedConfig notifyEnv) (NESeq CommandP1)
#commands
    commandGraph :: CommandGraph
commandGraph = MergedConfig notifyEnv
cfg MergedConfig notifyEnv
-> Optic' A_Lens NoIx (MergedConfig notifyEnv) CommandGraph
-> CommandGraph
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (MergedConfig notifyEnv) CommandGraph
#commandGraph

    mFindExe :: OsPath -> f (Maybe String)
mFindExe OsPath
p = do
      f (Maybe OsPath) -> f (Either SomeException (Maybe OsPath))
forall (m :: Type -> Type) a.
(HasCallStack, MonadCatch m) =>
m a -> m (Either SomeException a)
tryMySync (OsPath -> f (Maybe OsPath)
forall (m :: Type -> Type).
(MonadPathReader m, HasCallStack) =>
OsPath -> m (Maybe OsPath)
PR.findExecutable OsPath
p) f (Either SomeException (Maybe OsPath))
-> (Either SomeException (Maybe OsPath) -> Maybe String)
-> f (Maybe String)
forall (f :: Type -> Type) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        Left SomeException
_ -> Maybe String
forall a. Maybe a
Nothing
        Right Maybe OsPath
mPath -> Maybe OsPath
mPath Maybe OsPath -> (OsPath -> Maybe String) -> Maybe String
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= OsPath -> Maybe String
forall (m :: Type -> Type).
(HasCallStack, MonadThrow m) =>
OsPath -> m String
decodeThrowM
{-# INLINEABLE fromMergedConfig #-}

getShrunXdgConfig :: (HasCallStack, MonadPathReader m) => m OsPath
getShrunXdgConfig :: forall (m :: Type -> Type).
(HasCallStack, MonadPathReader m) =>
m OsPath
getShrunXdgConfig = OsPath -> m OsPath
forall (m :: Type -> Type).
(HasCallStack, MonadPathReader m) =>
OsPath -> m OsPath
getXdgConfig [osp|shrun|]
{-# INLINEABLE getShrunXdgConfig #-}

-- | Given the xdg state dir, reads the legend key cache, if it exists.
readPreviousLegendKeys ::
  ( HasCallStack,
    MonadCatch m,
    MonadFileReader m,
    MonadPathReader m,
    MonadPathWriter m,
    MonadTerminal m
  ) =>
  OsPath ->
  m (List Text)
readPreviousLegendKeys :: forall (m :: Type -> Type).
(HasCallStack, MonadCatch m, MonadFileReader m, MonadPathReader m,
 MonadPathWriter m, MonadTerminal m) =>
OsPath -> m [Text]
readPreviousLegendKeys OsPath
xdgState = do
  Bool
exists <- OsPath -> m Bool
forall (m :: Type -> Type).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
PR.doesFileExist OsPath
keysPath
  if Bool
exists
    then do
      -- Don't let a read keys error take down shrun.
      m Text -> m (Either SomeException Text)
forall (m :: Type -> Type) a.
(HasCallStack, MonadCatch m) =>
m a -> m (Either SomeException a)
tryMySync (OsPath -> m Text
forall (m :: Type -> Type).
(HasCallStack, MonadFileReader m, MonadThrow m) =>
OsPath -> m Text
readFileUtf8ThrowM OsPath
keysPath) m (Either SomeException Text)
-> (Either SomeException Text -> m [Text]) -> m [Text]
forall a b. m a -> (a -> m b) -> m b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left SomeException
err -> do
          String -> m ()
forall (m :: Type -> Type).
(MonadTerminal m, HasCallStack) =>
String -> m ()
putStrLn (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Error reading legend keys cache: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
err
          m (Either SomeException ()) -> m ()
forall (f :: Type -> Type) a. Functor f => f a -> f ()
void (m (Either SomeException ()) -> m ())
-> m (Either SomeException ()) -> m ()
forall a b. (a -> b) -> a -> b
$ m () -> m (Either SomeException ())
forall (m :: Type -> Type) a.
(HasCallStack, MonadCatch m) =>
m a -> m (Either SomeException a)
tryMySync (m () -> m (Either SomeException ()))
-> m () -> m (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ OsPath -> m ()
forall (m :: Type -> Type).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
PW.removePathForcibly OsPath
keysPath
          pure []
        Right Text
contents -> [Text] -> m [Text]
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ([Text] -> m [Text]) -> [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.strip Text
contents
    else [Text] -> m [Text]
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure []
  where
    keysPath :: OsPath
keysPath = OsPath -> OsPath
mkLegendKeysPath OsPath
xdgState
{-# INLINEABLE readPreviousLegendKeys #-}

-- | Saves the legend keys from the currently loaded legend file, depending on
-- the 'LegendKeysCache' parameter.
saveLegendKeys ::
  ( HasCallStack,
    MonadFileWriter m,
    MonadPathReader m,
    MonadPathWriter m
  ) =>
  -- | Shrun xdg state.
  OsPath ->
  -- | Key action.
  LegendKeysCache ->
  -- | Keys from last run.
  List Text ->
  -- | Toml from this run.
  Toml notifyEnv ->
  m ()
saveLegendKeys :: forall (m :: Type -> Type) notifyEnv.
(HasCallStack, MonadFileWriter m, MonadPathReader m,
 MonadPathWriter m) =>
OsPath -> LegendKeysCache -> [Text] -> Toml notifyEnv -> m ()
saveLegendKeys OsPath
xdgState LegendKeysCache
cache [Text]
prevKeysList Toml notifyEnv
toml =
  case LegendKeysCache
cache of
    -- 1. Do nothing.
    LegendKeysCache
LegendKeysOff -> () -> m ()
forall a. a -> m a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
    -- 2. Delete file.
    LegendKeysCache
LegendKeysClear -> OsPath -> m ()
forall (m :: Type -> Type).
(HasCallStack, MonadPathReader m, MonadPathWriter m) =>
OsPath -> m ()
PW.removeFileIfExists_ OsPath
keysPath
    -- 3. Overwrite the previous key file, if it exists. If the current keys are
    --    /not/ equal to the old keys, write them.
    LegendKeysCache
LegendKeysWrite ->
      Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless (HashSet Text
prevKeySet HashSet Text -> HashSet Text -> Bool
forall a. Eq a => a -> a -> Bool
== HashSet Text
currKeySet) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ HashSet Text -> m ()
writeKeys HashSet Text
currKeySet
    -- 4. Union the previous and new keys. If the current keys are /not/ a
    --    subset of the previous keys, write the union.
    LegendKeysCache
LegendKeysAdd ->
      Bool -> m () -> m ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
unless Bool
currIsSubset (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ HashSet Text -> m ()
writeKeys (HashSet Text -> HashSet Text -> HashSet Text
forall a. Eq a => HashSet a -> HashSet a -> HashSet a
Set.union HashSet Text
prevKeySet HashSet Text
currKeySet)
  where
    toKeyList :: Seq KeyVal -> [Text]
toKeyList = Seq Text -> [Text]
forall a. Seq a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList (Seq Text -> [Text])
-> (Seq KeyVal -> Seq Text) -> Seq KeyVal -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (KeyVal -> Text) -> Seq KeyVal -> Seq Text
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (Optic' A_Getter NoIx KeyVal Text -> KeyVal -> Text
forall k (is :: IxList) s a.
Is k A_Getter =>
Optic' k is s a -> s -> a
view Optic' A_Getter NoIx KeyVal Text
#key)
    prevKeySet :: HashSet Text
prevKeySet = [Text] -> HashSet Text
forall a. Hashable a => [a] -> HashSet a
Set.fromList [Text]
prevKeysList
    currKeySet :: HashSet Text
currKeySet = HashSet Text
-> (Seq KeyVal -> HashSet Text)
-> Maybe (Seq KeyVal)
-> HashSet Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe HashSet Text
forall a. HashSet a
Set.empty ([Text] -> HashSet Text
forall a. Hashable a => [a] -> HashSet a
Set.fromList ([Text] -> HashSet Text)
-> (Seq KeyVal -> [Text]) -> Seq KeyVal -> HashSet Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> Type) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Seq KeyVal -> [Text]
toKeyList) (Toml notifyEnv
toml Toml notifyEnv
-> Optic' A_Lens NoIx (Toml notifyEnv) (Maybe (Seq KeyVal))
-> Maybe (Seq KeyVal)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx (Toml notifyEnv) (Maybe (Seq KeyVal))
#legend)

    currIsSubset :: Bool
currIsSubset = HashSet Text
currKeySet HashSet Text -> HashSet Text -> Bool
forall a. Hashable a => HashSet a -> HashSet a -> Bool
`Set.isSubsetOf` HashSet Text
prevKeySet

    writeKeys :: HashSet Text -> m ()
writeKeys HashSet Text
newKeys = do
      let allKeys :: [Text]
allKeys = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
L.sort ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ HashSet Text -> [Text]
forall a. HashSet a -> [a]
forall (t :: Type -> Type) a. Foldable t => t a -> [a]
toList HashSet Text
newKeys
      -- Ensure directory exists.
      Bool -> OsPath -> m ()
forall (m :: Type -> Type).
(MonadPathWriter m, HasCallStack) =>
Bool -> OsPath -> m ()
PW.createDirectoryIfMissing Bool
True OsPath
xdgState
      OsPath -> Text -> m ()
forall (m :: Type -> Type).
(HasCallStack, MonadFileWriter m) =>
OsPath -> Text -> m ()
writeFileUtf8 OsPath
keysPath (Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
allKeys)

    keysPath :: OsPath
keysPath = OsPath -> OsPath
mkLegendKeysPath OsPath
xdgState
{-# INLINEABLE saveLegendKeys #-}

mkLegendKeysPath :: OsPath -> OsPath
mkLegendKeysPath :: OsPath -> OsPath
mkLegendKeysPath OsPath
xdgState = OsPath
xdgState OsPath -> OsPath -> OsPath
</> [osp|legend-keys.txt|]

getShrunXdgState :: (HasCallStack, MonadPathReader m) => m OsPath
getShrunXdgState :: forall (m :: Type -> Type).
(HasCallStack, MonadPathReader m) =>
m OsPath
getShrunXdgState = OsPath -> m OsPath
forall (m :: Type -> Type).
(HasCallStack, MonadPathReader m) =>
OsPath -> m OsPath
PR.getXdgState [osp|shrun|]