{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{-# HLINT ignore "Use lambda-case" #-}

module HWM.Domain.ConfigT
  ( ConfigT (..),
    runConfigT,
    VersionMap,
    updateConfig,
    Env (..),
    unpackConfigT,
    askCache,
    askMatrix,
    askPackages,
    askWorkspaceGroups,
    askVersion,
    saveConfig,
    resolveResultUI,
  )
where

import Control.Monad.Error.Class
import qualified Crypto.Hash.SHA256 as SHA256
import qualified Data.ByteString.Base16 as Base16
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import HWM.Core.Common (Check (..))
import HWM.Core.Formatting (Format (..))
import HWM.Core.Has (Has (..))
import HWM.Core.Options (Options (..))
import HWM.Core.Pkg (Pkg)
import HWM.Core.Result (Issue (..), MonadIssue (..), Result (..), ResultT, runResultT)
import HWM.Core.Version (Version, askVersion)
import HWM.Domain.Config (Config (..))
import HWM.Domain.Matrix (Matrix (..))
import HWM.Domain.Workspace (PkgRegistry, WorkspaceGroup, memberPkgs, pkgRegistry)
import HWM.Runtime.Cache (Cache, VersionMap, loadCache, saveCache)
import HWM.Runtime.Files (addHash, readYaml, rewrite_)
import HWM.Runtime.UI (MonadUI (..), UIT, printSummary, runUI)
import Relude

data Env (m :: Type -> Type) = Env
  { forall (m :: * -> *). Env m -> Options
options :: Options,
    forall (m :: * -> *). Env m -> Config
config :: Config,
    forall (m :: * -> *). Env m -> Cache
cache :: Cache,
    forall (m :: * -> *). Env m -> PkgRegistry
pkgs :: PkgRegistry
  }

type ConfigEnv = Env IO

newtype ConfigT (a :: Type) = ConfigT
  { forall a. ConfigT a -> ReaderT (Env IO) (ResultT (UIT IO)) a
_runConfigT :: ReaderT ConfigEnv (ResultT (UIT IO)) a
  }
  deriving
    ( (forall a b. (a -> b) -> ConfigT a -> ConfigT b)
-> (forall a b. a -> ConfigT b -> ConfigT a) -> Functor ConfigT
forall a b. a -> ConfigT b -> ConfigT a
forall a b. (a -> b) -> ConfigT a -> ConfigT b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ConfigT a -> ConfigT b
fmap :: forall a b. (a -> b) -> ConfigT a -> ConfigT b
$c<$ :: forall a b. a -> ConfigT b -> ConfigT a
<$ :: forall a b. a -> ConfigT b -> ConfigT a
Functor,
      Functor ConfigT
Functor ConfigT =>
(forall a. a -> ConfigT a)
-> (forall a b. ConfigT (a -> b) -> ConfigT a -> ConfigT b)
-> (forall a b c.
    (a -> b -> c) -> ConfigT a -> ConfigT b -> ConfigT c)
-> (forall a b. ConfigT a -> ConfigT b -> ConfigT b)
-> (forall a b. ConfigT a -> ConfigT b -> ConfigT a)
-> Applicative ConfigT
forall a. a -> ConfigT a
forall a b. ConfigT a -> ConfigT b -> ConfigT a
forall a b. ConfigT a -> ConfigT b -> ConfigT b
forall a b. ConfigT (a -> b) -> ConfigT a -> ConfigT b
forall a b c. (a -> b -> c) -> ConfigT a -> ConfigT b -> ConfigT c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> ConfigT a
pure :: forall a. a -> ConfigT a
$c<*> :: forall a b. ConfigT (a -> b) -> ConfigT a -> ConfigT b
<*> :: forall a b. ConfigT (a -> b) -> ConfigT a -> ConfigT b
$cliftA2 :: forall a b c. (a -> b -> c) -> ConfigT a -> ConfigT b -> ConfigT c
liftA2 :: forall a b c. (a -> b -> c) -> ConfigT a -> ConfigT b -> ConfigT c
$c*> :: forall a b. ConfigT a -> ConfigT b -> ConfigT b
*> :: forall a b. ConfigT a -> ConfigT b -> ConfigT b
$c<* :: forall a b. ConfigT a -> ConfigT b -> ConfigT a
<* :: forall a b. ConfigT a -> ConfigT b -> ConfigT a
Applicative,
      Applicative ConfigT
Applicative ConfigT =>
(forall a b. ConfigT a -> (a -> ConfigT b) -> ConfigT b)
-> (forall a b. ConfigT a -> ConfigT b -> ConfigT b)
-> (forall a. a -> ConfigT a)
-> Monad ConfigT
forall a. a -> ConfigT a
forall a b. ConfigT a -> ConfigT b -> ConfigT b
forall a b. ConfigT a -> (a -> ConfigT b) -> ConfigT b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. ConfigT a -> (a -> ConfigT b) -> ConfigT b
>>= :: forall a b. ConfigT a -> (a -> ConfigT b) -> ConfigT b
$c>> :: forall a b. ConfigT a -> ConfigT b -> ConfigT b
>> :: forall a b. ConfigT a -> ConfigT b -> ConfigT b
$creturn :: forall a. a -> ConfigT a
return :: forall a. a -> ConfigT a
Monad,
      MonadReader ConfigEnv,
      MonadError Issue,
      Monad ConfigT
Monad ConfigT => (forall a. IO a -> ConfigT a) -> MonadIO ConfigT
forall a. IO a -> ConfigT a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> ConfigT a
liftIO :: forall a. IO a -> ConfigT a
MonadIO
    )

instance Has (Env m) Options where
  obtain :: Env m -> Options
obtain = Env m -> Options
forall (m :: * -> *). Env m -> Options
options

instance Has (Env m) Cache where
  obtain :: Env m -> Cache
obtain = Env m -> Cache
forall (m :: * -> *). Env m -> Cache
cache

instance Has (Env m) Config where
  obtain :: Env m -> Config
obtain = Env m -> Config
forall (m :: * -> *). Env m -> Config
config

instance Has (Env m) [WorkspaceGroup] where
  obtain :: Env m -> [WorkspaceGroup]
obtain Env {Config
config :: forall (m :: * -> *). Env m -> Config
config :: Config
config} = Config -> [WorkspaceGroup]
workspace Config
config

instance Has (Env m) Matrix where
  obtain :: Env m -> Matrix
obtain Env {Config
config :: forall (m :: * -> *). Env m -> Config
config :: Config
config} = Config -> Matrix
matrix Config
config

instance Has (Env m) Version where
  obtain :: Env m -> Version
obtain Env {Config
config :: forall (m :: * -> *). Env m -> Config
config :: Config
config} = Config -> Version
version Config
config

instance Has (Env m) PkgRegistry where
  obtain :: Env m -> PkgRegistry
obtain = Env m -> PkgRegistry
forall (m :: * -> *). Env m -> PkgRegistry
pkgs

instance MonadUI ConfigT where
  uiWrite :: Text -> ConfigT ()
uiWrite Text
txt = do
    Options {Bool
quiet :: Bool
quiet :: Options -> Bool
quiet} <- (Env IO -> Options) -> ConfigT Options
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env IO -> Options
forall (m :: * -> *). Env m -> Options
options
    Bool -> ConfigT () -> ConfigT ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
quiet (ConfigT () -> ConfigT ()) -> ConfigT () -> ConfigT ()
forall a b. (a -> b) -> a -> b
$ IO () -> ConfigT ()
forall a. IO a -> ConfigT a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ConfigT ()) -> IO () -> ConfigT ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStr (Text -> String
forall a. ToString a => a -> String
toString Text
txt)
  uiIndentLevel :: ConfigT Int
uiIndentLevel = ReaderT (Env IO) (ResultT (UIT IO)) Int -> ConfigT Int
forall a. ReaderT (Env IO) (ResultT (UIT IO)) a -> ConfigT a
ConfigT (ReaderT (Env IO) (ResultT (UIT IO)) Int -> ConfigT Int)
-> ReaderT (Env IO) (ResultT (UIT IO)) Int -> ConfigT Int
forall a b. (a -> b) -> a -> b
$ ResultT (UIT IO) Int -> ReaderT (Env IO) (ResultT (UIT IO)) Int
forall (m :: * -> *) a. Monad m => m a -> ReaderT (Env IO) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ResultT (UIT IO) Int
forall (m :: * -> *). MonadUI m => m Int
uiIndentLevel
  uiWithIndent :: forall a. (Int -> Int) -> ConfigT a -> ConfigT a
uiWithIndent Int -> Int
f (ConfigT (ReaderT Env IO -> ResultT (UIT IO) a
action)) = ReaderT (Env IO) (ResultT (UIT IO)) a -> ConfigT a
forall a. ReaderT (Env IO) (ResultT (UIT IO)) a -> ConfigT a
ConfigT (ReaderT (Env IO) (ResultT (UIT IO)) a -> ConfigT a)
-> ReaderT (Env IO) (ResultT (UIT IO)) a -> ConfigT a
forall a b. (a -> b) -> a -> b
$ (Env IO -> ResultT (UIT IO) a)
-> ReaderT (Env IO) (ResultT (UIT IO)) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Int -> Int) -> ResultT (UIT IO) a -> ResultT (UIT IO) a
forall a. (Int -> Int) -> ResultT (UIT IO) a -> ResultT (UIT IO) a
forall (m :: * -> *) a. MonadUI m => (Int -> Int) -> m a -> m a
uiWithIndent Int -> Int
f (ResultT (UIT IO) a -> ResultT (UIT IO) a)
-> (Env IO -> ResultT (UIT IO) a) -> Env IO -> ResultT (UIT IO) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env IO -> ResultT (UIT IO) a
action)

getFileHash :: FilePath -> IO (Maybe Text)
getFileHash :: String -> IO (Maybe Text)
getFileHash String
filePath = do
  Text
content <- ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
forall (m :: * -> *). MonadIO m => String -> m ByteString
readFileBS String
filePath
  case Text -> [Text]
T.lines Text
content of
    (Text
firstLine : [Text]
_) ->
      case Text -> Text -> Maybe Text
T.stripPrefix Text
"# hash: " Text
firstLine of
        Just Text
hash -> Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
hash)
        Maybe Text
Nothing -> Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
    [] -> Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing

debug :: Text -> ConfigT ()
debug :: Text -> ConfigT ()
debug Text
_ = () -> ConfigT ()
forall a. a -> ConfigT a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance MonadIssue ConfigT where
  injectIssue :: Issue -> ConfigT ()
injectIssue = ReaderT (Env IO) (ResultT (UIT IO)) () -> ConfigT ()
forall a. ReaderT (Env IO) (ResultT (UIT IO)) a -> ConfigT a
ConfigT (ReaderT (Env IO) (ResultT (UIT IO)) () -> ConfigT ())
-> (Issue -> ReaderT (Env IO) (ResultT (UIT IO)) ())
-> Issue
-> ConfigT ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResultT (UIT IO) () -> ReaderT (Env IO) (ResultT (UIT IO)) ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT (Env IO) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResultT (UIT IO) () -> ReaderT (Env IO) (ResultT (UIT IO)) ())
-> (Issue -> ResultT (UIT IO) ())
-> Issue
-> ReaderT (Env IO) (ResultT (UIT IO)) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Issue -> ResultT (UIT IO) ()
forall (m :: * -> *). MonadIssue m => Issue -> m ()
injectIssue
  catchIssues :: forall a. ConfigT a -> ConfigT (Maybe Severity, a)
catchIssues (ConfigT ReaderT (Env IO) (ResultT (UIT IO)) a
action) = ReaderT (Env IO) (ResultT (UIT IO)) (Maybe Severity, a)
-> ConfigT (Maybe Severity, a)
forall a. ReaderT (Env IO) (ResultT (UIT IO)) a -> ConfigT a
ConfigT (ReaderT (Env IO) (ResultT (UIT IO)) (Maybe Severity, a)
 -> ConfigT (Maybe Severity, a))
-> ReaderT (Env IO) (ResultT (UIT IO)) (Maybe Severity, a)
-> ConfigT (Maybe Severity, a)
forall a b. (a -> b) -> a -> b
$ (Env IO -> ResultT (UIT IO) (Maybe Severity, a))
-> ReaderT (Env IO) (ResultT (UIT IO)) (Maybe Severity, a)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT (ResultT (UIT IO) a -> ResultT (UIT IO) (Maybe Severity, a)
forall a.
ResultT (UIT IO) a -> ResultT (UIT IO) (Maybe Severity, a)
forall (m :: * -> *) a.
MonadIssue m =>
m a -> m (Maybe Severity, a)
catchIssues (ResultT (UIT IO) a -> ResultT (UIT IO) (Maybe Severity, a))
-> (Env IO -> ResultT (UIT IO) a)
-> Env IO
-> ResultT (UIT IO) (Maybe Severity, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT (Env IO) (ResultT (UIT IO)) a
-> Env IO -> ResultT (UIT IO) a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (Env IO) (ResultT (UIT IO)) a
action)
  mapIssue :: forall a. (Issue -> Issue) -> ConfigT a -> ConfigT a
mapIssue Issue -> Issue
f (ConfigT ReaderT (Env IO) (ResultT (UIT IO)) a
action) = ReaderT (Env IO) (ResultT (UIT IO)) a -> ConfigT a
forall a. ReaderT (Env IO) (ResultT (UIT IO)) a -> ConfigT a
ConfigT (ReaderT (Env IO) (ResultT (UIT IO)) a -> ConfigT a)
-> ReaderT (Env IO) (ResultT (UIT IO)) a -> ConfigT a
forall a b. (a -> b) -> a -> b
$ (Env IO -> ResultT (UIT IO) a)
-> ReaderT (Env IO) (ResultT (UIT IO)) a
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Env IO -> ResultT (UIT IO) a)
 -> ReaderT (Env IO) (ResultT (UIT IO)) a)
-> (Env IO -> ResultT (UIT IO) a)
-> ReaderT (Env IO) (ResultT (UIT IO)) a
forall a b. (a -> b) -> a -> b
$ \Env IO
env -> (Issue -> Issue) -> ResultT (UIT IO) a -> ResultT (UIT IO) a
forall a.
(Issue -> Issue) -> ResultT (UIT IO) a -> ResultT (UIT IO) a
forall (m :: * -> *) a.
MonadIssue m =>
(Issue -> Issue) -> m a -> m a
mapIssue Issue -> Issue
f (ReaderT (Env IO) (ResultT (UIT IO)) a
-> Env IO -> ResultT (UIT IO) a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (Env IO) (ResultT (UIT IO)) a
action Env IO
env)

computeHash :: Config -> Text
computeHash :: Config -> Text
computeHash Config
cfg =
  let hashInput :: ByteString
hashInput = Text -> ByteString
T.encodeUtf8 (String -> Text
T.pack ([BuildEnv] -> String
forall b a. (Show a, IsString b) => a -> b
show (Matrix -> [BuildEnv]
environments (Matrix -> [BuildEnv]) -> Matrix -> [BuildEnv]
forall a b. (a -> b) -> a -> b
$ Config -> Matrix
matrix Config
cfg)))
      hashBytes :: ByteString
hashBytes = ByteString -> ByteString
SHA256.hash ByteString
hashInput
   in ByteString -> Text
T.decodeUtf8 (ByteString -> ByteString
Base16.encode ByteString
hashBytes)

hasHashChanged :: Config -> Maybe Text -> Bool
hasHashChanged :: Config -> Maybe Text -> Bool
hasHashChanged Config
_ Maybe Text
Nothing = Bool
True
hasHashChanged Config
cfg (Just Text
storedHash) = Text
storedHash Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Config -> Text
computeHash Config
cfg

checkConfig :: ConfigT ()
checkConfig :: ConfigT ()
checkConfig = do
  Config
cfg <- (Env IO -> Config) -> ConfigT Config
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env IO -> Config
forall (m :: * -> *). Env m -> Config
config
  Options
ops <- (Env IO -> Options) -> ConfigT Options
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env IO -> Options
forall (m :: * -> *). Env m -> Options
options
  Config -> ConfigT ()
forall (m :: * -> *) a. Check m a => a -> m ()
check Config
cfg
  Text -> ConfigT ()
debug (Text -> ConfigT ()) -> Text -> ConfigT ()
forall a b. (a -> b) -> a -> b
$ Text
"save " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. Format a => a -> Text
format (Options -> String
hwm Options
ops)
  Config -> Options -> ConfigT ()
forall (m :: * -> *).
(MonadError Issue m, MonadIO m) =>
Config -> Options -> m ()
saveConfig Config
cfg Options
ops

saveConfig :: (MonadError Issue m, MonadIO m) => Config -> Options -> m ()
saveConfig :: forall (m :: * -> *).
(MonadError Issue m, MonadIO m) =>
Config -> Options -> m ()
saveConfig Config
config Options
ops = do
  let file :: String
file = Options -> String
hwm Options
ops
  String -> (Maybe Config -> m Config) -> m ()
forall (m :: * -> *) t.
(MonadError Issue m, MonadIO m, FromJSON t, ToJSON t) =>
String -> (Maybe t -> m t) -> m ()
rewrite_ String
file (m Config -> Maybe Config -> m Config
forall a b. a -> b -> a
const (m Config -> Maybe Config -> m Config)
-> m Config -> Maybe Config -> m Config
forall a b. (a -> b) -> a -> b
$ Config -> m Config
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
config)
  String -> Text -> m ()
forall (m :: * -> *). MonadIO m => String -> Text -> m ()
addHash String
file (Config -> Text
computeHash Config
config)

updateConfig :: (Config -> ConfigT Config) -> ConfigT b -> ConfigT b
updateConfig :: forall b. (Config -> ConfigT Config) -> ConfigT b -> ConfigT b
updateConfig Config -> ConfigT Config
f ConfigT b
m = do
  Config
config' <- (Env IO -> Config) -> ConfigT Config
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env IO -> Config
forall (m :: * -> *). Env m -> Config
config ConfigT Config -> (Config -> ConfigT Config) -> ConfigT Config
forall a b. ConfigT a -> (a -> ConfigT b) -> ConfigT b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Config -> ConfigT Config
f
  (Env IO -> Env IO) -> ConfigT b -> ConfigT b
forall a. (Env IO -> Env IO) -> ConfigT a -> ConfigT a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\Env IO
e -> Env IO
e {config = config'}) (ConfigT ()
checkConfig ConfigT () -> ConfigT b -> ConfigT b
forall a b. ConfigT a -> ConfigT b -> ConfigT b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConfigT b
m)

runConfigT :: ConfigT () -> Options -> IO ()
runConfigT :: ConfigT () -> Options -> IO ()
runConfigT ConfigT ()
m opts :: Options
opts@Options {Bool
String
quiet :: Options -> Bool
hwm :: Options -> String
hie :: String
hwm :: String
stack :: String
quiet :: Bool
stack :: Options -> String
hie :: Options -> String
..} = do
  Config
config <- ResultT IO Config -> IO Config
forall a. ResultT IO a -> IO a
resolveResultTSilent (String -> ResultT IO Config
forall (m :: * -> *) a.
(MonadError Issue m, MonadIO m, FromJSON a) =>
String -> m a
readYaml String
hwm)
  Cache
cache <- Text -> IO Cache
loadCache (Matrix -> Text
defaultEnvironment (Config -> Matrix
matrix Config
config))
  Bool
changed <- Config -> Maybe Text -> Bool
hasHashChanged Config
config (Maybe Text -> Bool) -> IO (Maybe Text) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe Text)
getFileHash String
hwm
  PkgRegistry
pkgs <- ResultT IO PkgRegistry -> IO PkgRegistry
forall a. ResultT IO a -> IO a
resolveResultTSilent ([WorkspaceGroup] -> ResultT IO PkgRegistry
forall (m :: * -> *).
(MonadIO m, MonadError Issue m) =>
[WorkspaceGroup] -> m PkgRegistry
pkgRegistry (Config -> [WorkspaceGroup]
workspace Config
config))
  let env :: Env IO
env = Env {options :: Options
options = Options
opts, Config
config :: Config
config :: Config
config, Cache
cache :: Cache
cache :: Cache
cache, PkgRegistry
pkgs :: PkgRegistry
pkgs :: PkgRegistry
pkgs}
      resultT :: ResultT (UIT IO) ()
resultT = ConfigT () -> Env IO -> ResultT (UIT IO) ()
forall a. ConfigT a -> Env IO -> ResultT (UIT IO) a
unpackConfigT (if Bool
changed then ConfigT ()
checkConfig ConfigT () -> ConfigT () -> ConfigT ()
forall a b. ConfigT a -> ConfigT b -> ConfigT b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ConfigT ()
m else ConfigT ()
m) Env IO
env
  ResultT (UIT IO) () -> Cache -> IO ()
forall a. ResultT (UIT IO) a -> Cache -> IO ()
resolveResultT ResultT (UIT IO) ()
resultT Cache
cache

resolveResultT :: ResultT (UIT IO) a -> Cache -> IO ()
resolveResultT :: forall a. ResultT (UIT IO) a -> Cache -> IO ()
resolveResultT ResultT (UIT IO) a
resT Cache
cache =
  UIT IO () -> IO ()
forall a. UIT IO a -> IO a
runUI
    ( ResultT (UIT IO) a -> UIT IO (Result Issue a)
forall (m :: * -> *) a. ResultT m a -> m (Result Issue a)
runResultT ResultT (UIT IO) a
resT UIT IO (Result Issue a)
-> (Result Issue a -> UIT IO ()) -> UIT IO ()
forall a b. UIT IO a -> (a -> UIT IO b) -> UIT IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Result Issue a
r ->
        case Result Issue a
r of
          Success {a
[Issue]
result :: a
issues :: [Issue]
issues :: forall er a. Result er a -> [er]
result :: forall er a. Result er a -> a
..} -> do
            IO () -> UIT IO ()
forall a. IO a -> UIT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> UIT IO ()) -> IO () -> UIT IO ()
forall a b. (a -> b) -> a -> b
$ Cache -> IO ()
saveCache Cache
cache
            [Issue] -> UIT IO ()
forall (m :: * -> *). MonadUI m => [Issue] -> m ()
printSummary [Issue]
issues
          Failure {NonEmpty Issue
failure :: NonEmpty Issue
failure :: forall er a. Result er a -> NonEmpty er
..} -> do
            [Issue] -> UIT IO ()
forall (m :: * -> *). MonadUI m => [Issue] -> m ()
printSummary (NonEmpty Issue -> [Issue]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Issue
failure)
            UIT IO ()
forall (m :: * -> *) a. MonadIO m => m a
exitFailure
    )

resolveResultTSilent :: ResultT IO a -> IO a
resolveResultTSilent :: forall a. ResultT IO a -> IO a
resolveResultTSilent ResultT IO a
m = do
  Result Issue a
r <- ResultT IO a -> IO (Result Issue a)
forall (m :: * -> *) a. ResultT m a -> m (Result Issue a)
runResultT ResultT IO a
m
  case Result Issue a
r of
    Success {a
[Issue]
issues :: forall er a. Result er a -> [er]
result :: forall er a. Result er a -> a
result :: a
issues :: [Issue]
..} -> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result
    Failure {NonEmpty Issue
failure :: forall er a. Result er a -> NonEmpty er
failure :: NonEmpty Issue
..} -> UIT IO () -> IO ()
forall a. UIT IO a -> IO a
runUI ([Issue] -> UIT IO ()
forall (m :: * -> *). MonadUI m => [Issue] -> m ()
printSummary (NonEmpty Issue -> [Issue]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Issue
failure)) IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
forall (m :: * -> *) a. MonadIO m => m a
exitFailure

resolveResultUI :: ResultT (UIT IO) a -> UIT IO a
resolveResultUI :: forall a. ResultT (UIT IO) a -> UIT IO a
resolveResultUI ResultT (UIT IO) a
m = do
  Result Issue a
r <- ResultT (UIT IO) a -> UIT IO (Result Issue a)
forall (m :: * -> *) a. ResultT m a -> m (Result Issue a)
runResultT ResultT (UIT IO) a
m
  case Result Issue a
r of
    Success {a
[Issue]
issues :: forall er a. Result er a -> [er]
result :: forall er a. Result er a -> a
result :: a
issues :: [Issue]
..} -> a -> UIT IO a
forall a. a -> UIT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result
    Failure {NonEmpty Issue
failure :: forall er a. Result er a -> NonEmpty er
failure :: NonEmpty Issue
..} -> [Issue] -> UIT IO ()
forall (m :: * -> *). MonadUI m => [Issue] -> m ()
printSummary (NonEmpty Issue -> [Issue]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty Issue
failure) UIT IO () -> UIT IO a -> UIT IO a
forall a b. UIT IO a -> UIT IO b -> UIT IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UIT IO a
forall (m :: * -> *) a. MonadIO m => m a
exitFailure

unpackConfigT :: ConfigT a -> ConfigEnv -> ResultT (UIT IO) a
unpackConfigT :: forall a. ConfigT a -> Env IO -> ResultT (UIT IO) a
unpackConfigT (ConfigT ReaderT (Env IO) (ResultT (UIT IO)) a
action) = ReaderT (Env IO) (ResultT (UIT IO)) a
-> Env IO -> ResultT (UIT IO) a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (Env IO) (ResultT (UIT IO)) a
action

askCache :: ConfigT Cache
askCache :: ConfigT Cache
askCache = (Env IO -> Cache) -> ConfigT Cache
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env IO -> Cache
forall (m :: * -> *). Env m -> Cache
cache

askWorkspaceGroups :: ConfigT [WorkspaceGroup]
askWorkspaceGroups :: ConfigT [WorkspaceGroup]
askWorkspaceGroups = (Env IO -> [WorkspaceGroup]) -> ConfigT [WorkspaceGroup]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Config -> [WorkspaceGroup]
workspace (Config -> [WorkspaceGroup])
-> (Env IO -> Config) -> Env IO -> [WorkspaceGroup]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env IO -> Config
forall (m :: * -> *). Env m -> Config
config)

askMatrix :: ConfigT Matrix
askMatrix :: ConfigT Matrix
askMatrix = (Env IO -> Matrix) -> ConfigT Matrix
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Config -> Matrix
matrix (Config -> Matrix) -> (Env IO -> Config) -> Env IO -> Matrix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Env IO -> Config
forall (m :: * -> *). Env m -> Config
config)

askPackages :: ConfigT [Pkg]
askPackages :: ConfigT [Pkg]
askPackages = do
  [WorkspaceGroup]
groups <- ConfigT [WorkspaceGroup]
askWorkspaceGroups
  [[Pkg]] -> [Pkg]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Pkg]] -> [Pkg]) -> ConfigT [[Pkg]] -> ConfigT [Pkg]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WorkspaceGroup -> ConfigT [Pkg])
-> [WorkspaceGroup] -> ConfigT [[Pkg]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse WorkspaceGroup -> ConfigT [Pkg]
forall (m :: * -> *).
(MonadIO m, MonadError Issue m) =>
WorkspaceGroup -> m [Pkg]
memberPkgs [WorkspaceGroup]
groups