module Hix.Managed.Handlers.Report.Prod where

import qualified Data.Text as Text
import Data.These (These (..))
import Data.These.Combinators (justHere, justThere)
import Exon (exon)

import qualified Hix.Console
import Hix.Console (color, colors)
import Hix.Data.Monad (M)
import Hix.Data.Version (Version)
import qualified Hix.Data.VersionBounds
import Hix.Data.VersionBounds (VersionBounds (VersionBounds))
import qualified Hix.Log as Log
import qualified Hix.Managed.Data.EnvResult
import Hix.Managed.Data.EnvResult (EnvResult (EnvResult))
import Hix.Managed.Data.Mutable (MutableDep)
import qualified Hix.Managed.Data.MutableId
import Hix.Managed.Data.MutableId (MutableId (MutableId))
import qualified Hix.Managed.Data.Mutation
import Hix.Managed.Data.Mutation (FailedMutation)
import qualified Hix.Managed.Data.ProjectResult as ProjectResult
import Hix.Managed.Data.ProjectResult (ProjectResult)
import Hix.Managed.Data.StageResult (StageFailure (FailedMutations, FailedPrecondition), StageSummary (..))
import qualified Hix.Managed.EnvResult
import qualified Hix.Managed.EnvResult as EnvResult
import Hix.Managed.EnvResult (
  BoundsModification (BoundsModification),
  DepModification (DepAdded, DepUpdated),
  DepResult (DepResult),
  DepResultDetail (..),
  DepResults (DepResults),
  )
import qualified Hix.Managed.Handlers.Report
import Hix.Managed.Handlers.Report (ReportHandlers (ReportHandlers))
import Hix.Pretty (showP)

blankLine :: M ()
blankLine :: M ()
blankLine = Text -> M ()
Log.infoPlain Text
""

listFailed ::
  FailedMutation ->
  Text
listFailed :: FailedMutation -> Text
listFailed FailedMutation
mutation = [exon|📦 #{showP mutation.package}|]

reportFailed ::
  NonEmpty FailedMutation ->
  M ()
reportFailed :: NonEmpty FailedMutation -> M ()
reportFailed =
  (FailedMutation -> M ()) -> NonEmpty FailedMutation -> M ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ \ FailedMutation
mut -> Text -> M ()
Log.infoCont (FailedMutation -> Text
listFailed FailedMutation
mut)

reportNewVersions ::
  NonEmpty MutableId ->
  M ()
reportNewVersions :: NonEmpty MutableId -> M ()
reportNewVersions =
  (MutableId -> M ()) -> NonEmpty MutableId -> M ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ \ MutableId {MutableDep
name :: MutableDep
$sel:name:MutableId :: MutableId -> MutableDep
name, Version
version :: Version
$sel:version:MutableId :: MutableId -> Version
version} ->
    Text -> M ()
Log.infoCont [exon|📦 '##{name}': #{showP version}|]

printSummary :: StageSummary -> M ()
printSummary :: StageSummary -> M ()
printSummary = \case
  StageSuccess Text
msg -> Text -> M ()
Log.info Text
msg
  StageFailure (FailedMutations Text
msg NonEmpty FailedMutation
failed) -> do
    Text -> M ()
Log.info Text
msg
    NonEmpty FailedMutation -> M ()
reportFailed NonEmpty FailedMutation
failed
  StageFailure (FailedPrecondition NonEmpty Text
msg) ->
    (Text -> M ()) -> NonEmpty Text -> M ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Text -> M ()
Log.info NonEmpty Text
msg
  StageNoAction Maybe Text
msg -> (Text -> M ()) -> Maybe Text -> M ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Text -> M ()
Log.info Maybe Text
msg
  StageReport Text
msg NonEmpty MutableId
versions -> do
    Text -> M ()
Log.info Text
msg
    NonEmpty MutableId -> M ()
reportNewVersions NonEmpty MutableId
versions

printBounds ::
  (Version -> Text) ->
  (Version -> Text) ->
  Maybe Version ->
  Maybe Version ->
  Text
printBounds :: (Version -> Text)
-> (Version -> Text) -> Maybe Version -> Maybe Version -> Text
printBounds Version -> Text
printL Version -> Text
printU Maybe Version
lower Maybe Version
upper =
  case (Maybe Version
lower, Maybe Version
upper) of
    (Just Version
l, Just Version
u) -> [exon|[#{printL l}, #{printU u}]|]
    (Just Version
l, Maybe Version
Nothing) -> [exon|>=#{printL l}|]
    (Maybe Version
Nothing, Just Version
u) -> [exon|<#{printU u}|]
    (Maybe Version
Nothing, Maybe Version
Nothing) -> Text
"[no bounds]"

formatDepLine :: MutableDep -> Text -> Text -> (Text, Text, Text)
formatDepLine :: MutableDep -> Text -> Text -> (Text, Text, Text)
formatDepLine MutableDep
package Text
version Text
bounds =
  ([exon|📦 #{color colors.blue (showP package)}|], Text
version, [exon|↕ #{bounds}|])

formatBoundsModification :: VersionBounds -> BoundsModification -> Text
formatBoundsModification :: VersionBounds -> BoundsModification -> Text
formatBoundsModification VersionBounds {$sel:lower:VersionBounds :: VersionBounds -> Maybe Version
lower = Maybe Version
lowerNew, $sel:upper:VersionBounds :: VersionBounds -> Maybe Version
upper = Maybe Version
upperNew} (BoundsModification These (Maybe Version) (Maybe Version)
bm) =
  [exon|#{original} -> #{new}|]
  where

    original :: Text
original = Maybe Version -> Maybe Version -> Int -> Bool -> Bool -> Text
interval Maybe Version
lowerOriginal Maybe Version
upperOriginal ColorOffsets
colors.red Bool
lowerChanged Bool
upperChanged
    new :: Text
new = Maybe Version -> Maybe Version -> Int -> Bool -> Bool -> Text
interval Maybe Version
lowerNew Maybe Version
upperNew ColorOffsets
colors.green Bool
lowerChanged Bool
upperChanged

    lowerOriginal :: Maybe Version
lowerOriginal = Maybe Version -> Maybe (Maybe Version) -> Maybe Version
forall a. a -> Maybe a -> a
fromMaybe Maybe Version
lowerNew Maybe (Maybe Version)
lowerDiff
    upperOriginal :: Maybe Version
upperOriginal = Maybe Version -> Maybe (Maybe Version) -> Maybe Version
forall a. a -> Maybe a -> a
fromMaybe Maybe Version
upperNew Maybe (Maybe Version)
upperDiff

    lowerChanged :: Bool
lowerChanged = Maybe (Maybe Version) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Maybe Version)
lowerDiff
    upperChanged :: Bool
upperChanged = Maybe (Maybe Version) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (Maybe Version)
upperDiff

    lowerDiff :: Maybe (Maybe Version)
lowerDiff = These (Maybe Version) (Maybe Version) -> Maybe (Maybe Version)
forall a b. These a b -> Maybe a
justHere These (Maybe Version) (Maybe Version)
bm
    upperDiff :: Maybe (Maybe Version)
upperDiff = These (Maybe Version) (Maybe Version) -> Maybe (Maybe Version)
forall a b. These a b -> Maybe b
justThere These (Maybe Version) (Maybe Version)
bm

    interval :: Maybe Version -> Maybe Version -> Int -> Bool -> Bool -> Text
interval Maybe Version
l Maybe Version
u Int
col Bool
colL Bool
colU =
      (Version -> Text)
-> (Version -> Text) -> Maybe Version -> Maybe Version -> Text
printBounds (Int -> Bool -> Version -> Text
forall {a}. Pretty a => Int -> Bool -> a -> Text
bound Int
col Bool
colL) (Int -> Bool -> Version -> Text
forall {a}. Pretty a => Int -> Bool -> a -> Text
bound Int
col Bool
colU) Maybe Version
l Maybe Version
u

    bound :: Int -> Bool -> a -> Text
bound Int
col Bool
useCol a
v
      | Bool
useCol
      = Int -> Text -> Text
color Int
col (a -> Text
forall b a. (Pretty a, IsString b) => a -> b
showP a
v)
      | Bool
otherwise
      = a -> Text
forall b a. (Pretty a, IsString b) => a -> b
showP a
v

formatDep :: MutableDep -> Version -> VersionBounds -> Maybe BoundsModification -> (Text, Text, Text)
formatDep :: MutableDep
-> Version
-> VersionBounds
-> Maybe BoundsModification
-> (Text, Text, Text)
formatDep MutableDep
package Version
version VersionBounds
bounds Maybe BoundsModification
boundsMod =
  MutableDep -> Text -> Text -> (Text, Text, Text)
formatDepLine MutableDep
package (Version -> Text
forall b a. (Pretty a, IsString b) => a -> b
showP Version
version) (Text
-> (BoundsModification -> Text) -> Maybe BoundsModification -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
unchangedBounds BoundsModification -> Text
changedBounds Maybe BoundsModification
boundsMod)
  where
    changedBounds :: BoundsModification -> Text
changedBounds = VersionBounds -> BoundsModification -> Text
formatBoundsModification VersionBounds
bounds
    unchangedBounds :: Text
unchangedBounds = (Version -> Text)
-> (Version -> Text) -> Maybe Version -> Maybe Version -> Text
printBounds Version -> Text
forall b a. (Pretty a, IsString b) => a -> b
showP Version -> Text
forall b a. (Pretty a, IsString b) => a -> b
showP VersionBounds
bounds.lower VersionBounds
bounds.upper

formatDepUpdate ::
  MutableDep ->
  Version ->
  VersionBounds ->
  These Version BoundsModification ->
  (Text, Text, Text)
formatDepUpdate :: MutableDep
-> Version
-> VersionBounds
-> These Version BoundsModification
-> (Text, Text, Text)
formatDepUpdate MutableDep
package Version
version VersionBounds
bounds These Version BoundsModification
update =
  MutableDep -> Text -> Text -> (Text, Text, Text)
formatDepLine MutableDep
package Text
versionDesc Text
boundsDesc
  where
    versionDesc :: Text
versionDesc = case These Version BoundsModification -> Maybe Version
forall a b. These a b -> Maybe a
justHere These Version BoundsModification
update of
      Just Version
original -> Version -> Version -> Text
forall {a} {a}. (Pretty a, Pretty a) => a -> a -> Text
versionUpdate Version
original Version
version
      Maybe Version
Nothing -> Version -> Text
forall b a. (Pretty a, IsString b) => a -> b
showP Version
version

    versionUpdate :: a -> a -> Text
versionUpdate a
original a
new =
      [exon|#{color colors.red (showP original)} -> #{color colors.green (showP new)}|]

    boundsDesc :: Text
boundsDesc = case These Version BoundsModification -> Maybe BoundsModification
forall a b. These a b -> Maybe b
justThere These Version BoundsModification
update of
      Just BoundsModification
boundsMod -> VersionBounds -> BoundsModification -> Text
formatBoundsModification VersionBounds
bounds BoundsModification
boundsMod
      Maybe BoundsModification
Nothing -> VersionBounds -> Text
forall b a. (Pretty a, IsString b) => a -> b
showP VersionBounds
bounds

printAligned :: [(Text, Text, Text)] -> M ()
printAligned :: [(Text, Text, Text)] -> M ()
printAligned [(Text, Text, Text)]
deps =
  ((Text, Text, Text) -> M ()) -> [(Text, Text, Text)] -> M ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Text, Text, Text) -> M ()
printLine [(Text, Text, Text)]
deps
  where
    printLine :: (Text, Text, Text) -> M ()
printLine (Text
p, Text
v, Text
b) = Text -> M ()
Log.infoCont (Text -> Int -> Text
padded Text
p Int
maxP Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Int -> Text
padded Text
v Int
maxV Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
b)
    padded :: Text -> Int -> Text
padded Text
s Int
maxlen = Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.replicate (Int
maxlen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Text -> Int
Text.length Text
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3) Text
" "
    maxP :: Int
maxP = [Text] -> Int
maxi [Text]
ps
    maxV :: Int
maxV = [Text] -> Int
maxi [Text]
vs
    maxi :: [Text] -> Int
maxi = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> ([Text] -> Maybe Int) -> [Text] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Maybe Int
forall (t :: * -> *) a. (Ord a, Foldable t) => t a -> Maybe a
maximum ([Int] -> Maybe Int) -> ([Text] -> [Int]) -> [Text] -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Int) -> [Text] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Int
Text.length
    ([Text]
ps, [Text]
vs, [Text]
_) = [(Text, Text, Text)] -> ([Text], [Text], [Text])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 [(Text, Text, Text)]
deps

formatDepResult :: DepResult -> Maybe (Text, Text, Text)
formatDepResult :: DepResult -> Maybe (Text, Text, Text)
formatDepResult DepResult {Version
VersionBounds
MutableDep
DepResultDetail
package :: MutableDep
version :: Version
bounds :: VersionBounds
detail :: DepResultDetail
$sel:package:DepResult :: DepResult -> MutableDep
$sel:version:DepResult :: DepResult -> Version
$sel:bounds:DepResult :: DepResult -> VersionBounds
$sel:detail:DepResult :: DepResult -> DepResultDetail
..} =
  case DepResultDetail
detail of
    DepModified (DepAdded Maybe BoundsModification
boundsMod) -> (Text, Text, Text) -> Maybe (Text, Text, Text)
forall a. a -> Maybe a
Just (MutableDep
-> Version
-> VersionBounds
-> Maybe BoundsModification
-> (Text, Text, Text)
formatDep MutableDep
package Version
version VersionBounds
bounds Maybe BoundsModification
boundsMod)
    DepModified (DepUpdated These Version BoundsModification
update) -> (Text, Text, Text) -> Maybe (Text, Text, Text)
forall a. a -> Maybe a
Just (MutableDep
-> Version
-> VersionBounds
-> These Version BoundsModification
-> (Text, Text, Text)
formatDepUpdate MutableDep
package Version
version VersionBounds
bounds These Version BoundsModification
update)
    DepResultDetail
DepUnmodified -> Maybe (Text, Text, Text)
forall a. Maybe a
Nothing

-- TODO don't print the env name when using @sets = "all"@ (or even when only one env is processed?)
envResult ::
  EnvResult ->
  M ()
envResult :: EnvResult -> M ()
envResult result :: EnvResult
result@EnvResult {EnvName
env :: EnvName
$sel:env:EnvResult :: EnvResult -> EnvName
env, NonEmpty StageSummary
summaries :: NonEmpty StageSummary
$sel:summaries:EnvResult :: EnvResult -> NonEmpty StageSummary
summaries} = do
  Text -> M ()
Log.info Text
envLabel
  (StageSummary -> M ()) -> NonEmpty StageSummary -> M ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ StageSummary -> M ()
printSummary NonEmpty StageSummary
summaries
  Maybe (NonEmpty DepResult) -> (NonEmpty DepResult -> M ()) -> M ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([DepResult] -> Maybe (NonEmpty DepResult)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [DepResult]
added) \ NonEmpty DepResult
deps -> do
    Text -> M ()
Log.info Text
"Added new versions:"
    [(Text, Text, Text)] -> M ()
printAligned ((DepResult -> Maybe (Text, Text, Text))
-> [DepResult] -> [(Text, Text, Text)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DepResult -> Maybe (Text, Text, Text)
formatDepResult (NonEmpty DepResult -> [DepResult]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty DepResult
deps))
  Maybe (NonEmpty DepResult) -> (NonEmpty DepResult -> M ()) -> M ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([DepResult] -> Maybe (NonEmpty DepResult)
forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [DepResult]
updated) \ NonEmpty DepResult
deps -> do
    Text -> M ()
Log.info Text
"Updated versions:"
    [(Text, Text, Text)] -> M ()
printAligned ((DepResult -> Maybe (Text, Text, Text))
-> [DepResult] -> [(Text, Text, Text)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe DepResult -> Maybe (Text, Text, Text)
formatDepResult (NonEmpty DepResult -> [DepResult]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList NonEmpty DepResult
deps))
  where
    DepResults {[DepResult]
added :: [DepResult]
updated :: [DepResult]
unmodified :: [DepResult]
$sel:added:DepResults :: DepResults -> [DepResult]
$sel:updated:DepResults :: DepResults -> [DepResult]
$sel:unmodified:DepResults :: DepResults -> [DepResult]
..} = EnvResult -> DepResults
EnvResult.grouped EnvResult
result
    envLabel :: Text
envLabel = Int -> Text -> Text
color ColorOffsets
colors.yellow (EnvName -> Text
forall b a. (Pretty a, IsString b) => a -> b
showP EnvName
env)

mutations ::
  ProjectResult ->
  M ()
mutations :: ProjectResult -> M ()
mutations ProjectResult
results = do
  M ()
blankLine
  [M ()] -> M ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (M () -> [M ()] -> [M ()]
forall a. a -> [a] -> [a]
intersperse M ()
blankLine (EnvResult -> M ()
envResult (EnvResult -> M ()) -> [EnvResult] -> [M ()]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty EnvResult -> [EnvResult]
forall a. NonEmpty a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList ProjectResult
results.envs))

handlersProd :: ReportHandlers
handlersProd :: ReportHandlers
handlersProd =
  ReportHandlers {ProjectResult -> M ()
mutations :: ProjectResult -> M ()
$sel:mutations:ReportHandlers :: ProjectResult -> M ()
mutations}