{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}

module HWM.CLI.Command.Outdated (runOutdated) where

import HWM.Core.Formatting (Color (..), Format (..), chalk, genMaxLen, padDots)
import HWM.Core.Result (Issue (..), MonadIssue (..), Severity (SeverityWarning))
import HWM.Domain.Bounds (printUpperBound, updateDepBounds)
import HWM.Domain.Config (Config (registry))
import HWM.Domain.ConfigT (ConfigT, config, updateConfig)
import HWM.Domain.Dependencies (Dependency (..), toDependencyList, traverseDeps)
import HWM.Integrations.Toolchain.Package (syncPackages)
import HWM.Runtime.Cache (clearVersions)
import HWM.Runtime.UI (indent, putLine, section, sectionConfig, sectionTableM)
import Relude

runOutdated :: Bool -> ConfigT ()
runOutdated :: Bool -> ConfigT ()
runOutdated Bool
autoFix = do
  Int -> Text -> [(Text, ConfigT Text)] -> ConfigT ()
forall (m :: * -> *).
MonadUI m =>
Int -> Text -> [(Text, m Text)] -> m ()
sectionTableM Int
0 Text
"update dependencies" [(Text
"mode", Text -> ConfigT Text
forall a. a -> ConfigT a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ConfigT Text) -> Text -> ConfigT Text
forall a b. (a -> b) -> a -> b
$ Color -> Text -> Text
chalk Color
Cyan (if Bool
autoFix then Text
"auto-fix" else Text
"check"))]

  ConfigT ()
forall env (m :: * -> *).
(MonadReader env m, Has env Cache, MonadIO m) =>
m ()
clearVersions
  Dependencies
originalRegistry <- (ConfigEnv -> Dependencies) -> ConfigT Dependencies
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Config -> Dependencies
registry (Config -> Dependencies)
-> (ConfigEnv -> Config) -> ConfigEnv -> Dependencies
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigEnv -> Config
forall (m :: * -> *). Env m -> Config
config)
  Text -> ConfigT () -> ConfigT ()
forall (m :: * -> *) a. MonadUI m => Text -> m a -> m ()
section Text
"registry" (ConfigT () -> ConfigT ()) -> ConfigT () -> ConfigT ()
forall a b. (a -> b) -> a -> b
$ () -> ConfigT ()
forall a. a -> ConfigT a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  Dependencies
registry' <- (PkgName -> Bounds -> ConfigT Bounds)
-> Dependencies -> ConfigT Dependencies
forall (f :: * -> *).
Applicative f =>
(PkgName -> Bounds -> f Bounds) -> Dependencies -> f Dependencies
traverseDeps PkgName -> Bounds -> ConfigT Bounds
forall (m :: * -> *) env.
(MonadIO m, MonadError Issue m, MonadReader env m,
 Has env Cache) =>
PkgName -> Bounds -> m Bounds
updateDepBounds Dependencies
originalRegistry

  let updates :: [Dependency]
updates = ((Dependency, Dependency) -> Dependency)
-> [(Dependency, Dependency)] -> [Dependency]
forall a b. (a -> b) -> [a] -> [b]
map (Dependency, Dependency) -> Dependency
forall a b. (a, b) -> b
snd ([(Dependency, Dependency)] -> [Dependency])
-> [(Dependency, Dependency)] -> [Dependency]
forall a b. (a -> b) -> a -> b
$ ((Dependency, Dependency) -> Bool)
-> [(Dependency, Dependency)] -> [(Dependency, Dependency)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Dependency -> Dependency -> Bool)
-> (Dependency, Dependency) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Dependency -> Dependency -> Bool
forall a. Eq a => a -> a -> Bool
(/=)) ([Dependency] -> [Dependency] -> [(Dependency, Dependency)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Dependencies -> [Dependency]
toDependencyList Dependencies
originalRegistry) (Dependencies -> [Dependency]
toDependencyList Dependencies
registry'))
  let maxLen :: Int
maxLen = [Text] -> Int
genMaxLen ((Dependency -> Text) -> [Dependency] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (PkgName -> Text
forall a. Format a => a -> Text
format (PkgName -> Text) -> (Dependency -> PkgName) -> Dependency -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependency -> PkgName
name) [Dependency]
updates)

  if [Dependency] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Dependency]
updates
    then do
      Int -> ConfigT () -> ConfigT ()
forall (m :: * -> *) a. MonadUI m => Int -> m a -> m a
indent Int
1 (ConfigT () -> ConfigT ()) -> ConfigT () -> ConfigT ()
forall a b. (a -> b) -> a -> b
$ Text -> ConfigT ()
forall (m :: * -> *). MonadUI m => Text -> m ()
putLine Text
"all dependencies are up to date."
    else do
      Int -> ConfigT () -> ConfigT ()
forall (m :: * -> *) a. MonadUI m => Int -> m a -> m a
indent Int
1 (ConfigT () -> ConfigT ()) -> ConfigT () -> ConfigT ()
forall a b. (a -> b) -> a -> b
$ [Dependency] -> (Dependency -> ConfigT ()) -> ConfigT ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Dependency]
updates ((Dependency -> ConfigT ()) -> ConfigT ())
-> (Dependency -> ConfigT ()) -> ConfigT ()
forall a b. (a -> b) -> a -> b
$ \Dependency {PkgName
Bounds
name :: Dependency -> PkgName
name :: PkgName
bounds :: Bounds
bounds :: Dependency -> Bounds
..} -> Text -> ConfigT ()
forall (m :: * -> *). MonadUI m => Text -> m ()
putLine (Text -> ConfigT ()) -> Text -> ConfigT ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
padDots Int
maxLen (PkgName -> Text
forall a. Format a => a -> Text
format PkgName
name) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"↑ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Bounds -> Text
printUpperBound Bounds
bounds

      if Bool
autoFix
        then ((\Config
cf -> Config -> ConfigT Config
forall a. a -> ConfigT a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Config -> ConfigT Config) -> Config -> ConfigT Config
forall a b. (a -> b) -> a -> b
$ Config
cf {registry = registry'}) (Config -> ConfigT Config) -> ConfigT () -> ConfigT ()
forall b. (Config -> ConfigT Config) -> ConfigT b -> ConfigT b
`updateConfig`) (ConfigT () -> ConfigT ()) -> ConfigT () -> ConfigT ()
forall a b. (a -> b) -> a -> b
$ do
          Int -> [(Text, ConfigT Text)] -> ConfigT ()
forall (m :: * -> *). MonadUI m => Int -> [(Text, m Text)] -> m ()
sectionConfig Int
0 [(Text
"hwm.yaml", Text -> ConfigT Text
forall a. a -> ConfigT a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ConfigT Text) -> Text -> ConfigT Text
forall a b. (a -> b) -> a -> b
$ Color -> Text -> Text
chalk Color
Green Text
"✓")]
          ConfigT ()
syncPackages
        else
          Issue -> ConfigT ()
forall (m :: * -> *). MonadIssue m => Issue -> m ()
injectIssue
            ( Issue
                { issueDetails :: Maybe IssueDetails
issueDetails = Maybe IssueDetails
forall a. Maybe a
Nothing,
                  issueMessage :: Text
issueMessage = Text
"Found " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall b a. (Show a, IsString b) => a -> b
show ([Dependency] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Dependency]
updates) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" outdated dependencies: Run 'hwm outdated --fix' to update.",
                  issueTopic :: Text
issueTopic = Text
"registry",
                  issueSeverity :: Severity
issueSeverity = Severity
SeverityWarning
                }
            )