module Hix.Managed.BuildOutput.CommitMsg where

import qualified Data.Text as Text
import Exon (exon)

import qualified Hix.Managed.Data.BuildOutput
import Hix.Managed.Data.BuildOutput (BuildOutput, ModifiedId)
import Hix.Pretty (showP)

commitMessage :: Int -> Text -> Text
commitMessage :: Int -> Text -> Text
commitMessage Int
num Text
names
  | Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
3
  = [exon|Bump #{names}|]
  | Bool
otherwise
  = [exon|Bump #{show num} dependencies|]

candidateList :: [ModifiedId] -> [Text]
candidateList :: [ModifiedId] -> [Text]
candidateList = (ModifiedId -> Text) -> [ModifiedId] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap \ ModifiedId
c -> [exon|* #{showP c}|]

commitBody :: [ModifiedId] -> [Text]
commitBody :: [ModifiedId] -> [Text]
commitBody [ModifiedId]
candidates =
  [Text
Item [Text]
"New versions:", Text
Item [Text]
""] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ModifiedId] -> [Text]
candidateList [ModifiedId]
candidates

commit :: BuildOutput -> Maybe (Text, [Text])
commit :: BuildOutput -> Maybe (Text, [Text])
commit BuildOutput
output =
  BuildOutput
output.modifiedNames Maybe Text -> (Text -> (Text, [Text])) -> Maybe (Text, [Text])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ Text
names ->
    (Int -> Text -> Text
commitMessage ([ModifiedId] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length BuildOutput
output.modified) Text
names, [ModifiedId] -> [Text]
commitBody BuildOutput
output.modified)

formatCommit :: BuildOutput -> Maybe Text
formatCommit :: BuildOutput -> Maybe Text
formatCommit BuildOutput
output =
  BuildOutput -> Maybe (Text, [Text])
commit BuildOutput
output Maybe (Text, [Text]) -> ((Text, [Text]) -> Text) -> Maybe Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \ (Text
msg, [Text]
body) ->
    Text -> [Text] -> Text
Text.intercalate Text
"\n" ([Text
Item [Text]
msg, Text
Item [Text]
""] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
body)