module Language.PureScript.Publish.ErrorsWarnings
  ( PackageError(..)
  , PackageWarning(..)
  , UserError(..)
  , InternalError(..)
  , OtherError(..)
  , RepositoryFieldError(..)
  , JSONSource(..)
  , printError
  , renderError
  , printWarnings
  , renderWarnings
  ) where

import Prelude

import Control.Exception (IOException)

import Data.Aeson.BetterErrors (ParseError, displayError)
import Data.List (intersperse)
import Data.List.NonEmpty (NonEmpty(..))
import Data.Maybe (catMaybes, fromMaybe)
import Data.Monoid (Any(..))
import Data.Version (Version, showVersion)
import Data.List.NonEmpty qualified as NonEmpty
import Data.Text (Text)
import Data.Text qualified as T

import Language.PureScript.Docs.Types qualified as D
import Language.PureScript qualified as P
import Language.PureScript.Publish.BoxesHelpers (Box, bulletedList, bulletedListT, indented, nullBox, para, printToStderr, spacer, successivelyIndented, vcat)

import Web.Bower.PackageMeta (PackageName, runPackageName, showBowerError)
import Web.Bower.PackageMeta qualified as Bower
import Language.PureScript.Docs.Types (showManifestError)

-- | An error which meant that it was not possible to retrieve metadata for a
-- package.
data PackageError
  = UserError UserError
  | InternalError InternalError
  | OtherError OtherError
  deriving (Int -> PackageError -> ShowS
[PackageError] -> ShowS
PackageError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PackageError] -> ShowS
$cshowList :: [PackageError] -> ShowS
show :: PackageError -> [Char]
$cshow :: PackageError -> [Char]
showsPrec :: Int -> PackageError -> ShowS
$cshowsPrec :: Int -> PackageError -> ShowS
Show)

data PackageWarning
  = NoResolvedVersion PackageName
  | UnacceptableVersion (PackageName, Text)
  | DirtyWorkingTreeWarn
  deriving (Int -> PackageWarning -> ShowS
[PackageWarning] -> ShowS
PackageWarning -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PackageWarning] -> ShowS
$cshowList :: [PackageWarning] -> ShowS
show :: PackageWarning -> [Char]
$cshow :: PackageWarning -> [Char]
showsPrec :: Int -> PackageWarning -> ShowS
$cshowsPrec :: Int -> PackageWarning -> ShowS
Show)

-- | An error that should be fixed by the user.
data UserError
  = PackageManifestNotFound FilePath
  | ResolutionsFileNotFound
  | CouldntConvertPackageManifest Bower.BowerError
  | CouldntDecodePackageManifest (ParseError D.ManifestError)
  | TagMustBeCheckedOut
  | AmbiguousVersions [Version] -- Invariant: should contain at least two elements
  | BadRepositoryField RepositoryFieldError
  | NoLicenseSpecified
  | InvalidLicense
  | MissingDependencies (NonEmpty PackageName)
  | CompileError P.MultipleErrors
  | DirtyWorkingTree
  | ResolutionsFileError FilePath (ParseError D.PackageError)
  deriving (Int -> UserError -> ShowS
[UserError] -> ShowS
UserError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [UserError] -> ShowS
$cshowList :: [UserError] -> ShowS
show :: UserError -> [Char]
$cshow :: UserError -> [Char]
showsPrec :: Int -> UserError -> ShowS
$cshowsPrec :: Int -> UserError -> ShowS
Show)

data RepositoryFieldError
  = RepositoryFieldMissing (Maybe Text)
  | BadRepositoryType Text
  | NotOnGithub
  deriving (Int -> RepositoryFieldError -> ShowS
[RepositoryFieldError] -> ShowS
RepositoryFieldError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [RepositoryFieldError] -> ShowS
$cshowList :: [RepositoryFieldError] -> ShowS
show :: RepositoryFieldError -> [Char]
$cshow :: RepositoryFieldError -> [Char]
showsPrec :: Int -> RepositoryFieldError -> ShowS
$cshowsPrec :: Int -> RepositoryFieldError -> ShowS
Show)

-- | An error that probably indicates a bug in this module.
data InternalError
  = CouldntParseGitTagDate Text
  deriving (Int -> InternalError -> ShowS
[InternalError] -> ShowS
InternalError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [InternalError] -> ShowS
$cshowList :: [InternalError] -> ShowS
show :: InternalError -> [Char]
$cshow :: InternalError -> [Char]
showsPrec :: Int -> InternalError -> ShowS
$cshowsPrec :: Int -> InternalError -> ShowS
Show)

data JSONSource
  = FromFile FilePath
  | FromResolutions
  deriving (Int -> JSONSource -> ShowS
[JSONSource] -> ShowS
JSONSource -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [JSONSource] -> ShowS
$cshowList :: [JSONSource] -> ShowS
show :: JSONSource -> [Char]
$cshow :: JSONSource -> [Char]
showsPrec :: Int -> JSONSource -> ShowS
$cshowsPrec :: Int -> JSONSource -> ShowS
Show)

data OtherError
  = ProcessFailed String [String] IOException
  | IOExceptionThrown IOException
  deriving (Int -> OtherError -> ShowS
[OtherError] -> ShowS
OtherError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [OtherError] -> ShowS
$cshowList :: [OtherError] -> ShowS
show :: OtherError -> [Char]
$cshow :: OtherError -> [Char]
showsPrec :: Int -> OtherError -> ShowS
$cshowsPrec :: Int -> OtherError -> ShowS
Show)

printError :: PackageError -> IO ()
printError :: PackageError -> IO ()
printError = Box -> IO ()
printToStderr forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageError -> Box
renderError

renderError :: PackageError -> Box
renderError :: PackageError -> Box
renderError PackageError
err =
  case PackageError
err of
    UserError UserError
e ->
      [Box] -> Box
vcat
        [ [Char] -> Box
para (
          [Char]
"There is a problem with your package, which meant that " forall a. [a] -> [a] -> [a]
++
          [Char]
"it could not be published."
          )
        , [Char] -> Box
para [Char]
"Details:"
        , Box -> Box
indented (UserError -> Box
displayUserError UserError
e)
        ]
    InternalError InternalError
e ->
      [Box] -> Box
vcat
        [ [Char] -> Box
para [Char]
"Internal error: this is probably a bug. Please report it:"
        , Box -> Box
indented ([Char] -> Box
para [Char]
"https://github.com/purescript/purescript/issues/new")
        , Box
spacer
        , [Char] -> Box
para [Char]
"Details:"
        , [[Char]] -> Box
successivelyIndented (InternalError -> [[Char]]
displayInternalError InternalError
e)
        ]
    OtherError OtherError
e ->
      [Box] -> Box
vcat
        [ [Char] -> Box
para [Char]
"An error occurred, and your package could not be published."
        , [Char] -> Box
para [Char]
"Details:"
        , Box -> Box
indented (OtherError -> Box
displayOtherError OtherError
e)
        ]

displayUserError :: UserError -> Box
displayUserError :: UserError -> Box
displayUserError UserError
e = case UserError
e of
  PackageManifestNotFound [Char]
path -> do
    [Box] -> Box
vcat
      [ [Char] -> Box
para [Char]
"The package manifest file was not found:"
      , Box -> Box
indented ([Char] -> Box
para [Char]
path)
      , Box
spacer
      , [Char] -> Box
para [Char]
"Please create either a bower.json or purs.json manifest file."
      ]
  UserError
ResolutionsFileNotFound ->
    [Char] -> Box
para [Char]
"The resolutions file was not found."
  CouldntConvertPackageManifest BowerError
err ->
    [Box] -> Box
vcat
      [ [Char] -> Box
para [Char]
"Unable to convert your package manifest file to the Bower format:"
      , Box -> Box
indented (([Char] -> Box
para forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack) (BowerError -> Text
showBowerError BowerError
err))
      , Box
spacer
      , [Char] -> Box
para [Char]
"Please ensure that your package manifest file is valid."
      ]
  CouldntDecodePackageManifest ParseError ManifestError
err ->
    [Box] -> Box
vcat
      [ [Char] -> Box
para [Char]
"There was a problem with your package manifest file:"
      , Box -> Box
indented ([Box] -> Box
vcat (forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> Box
para forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack) (forall err. (err -> Text) -> ParseError err -> [Text]
displayError ManifestError -> Text
showManifestError ParseError ManifestError
err)))
      , Box
spacer
      , [Char] -> Box
para [Char]
"Please ensure that your package manifest file is valid."
      ]
  UserError
TagMustBeCheckedOut ->
      [Box] -> Box
vcat
        [ [Char] -> Box
para (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ [Char]
"purs publish requires a tagged version to be checked out in "
            , [Char]
"order to build documentation, and no suitable tag was found. "
            , [Char]
"Please check out a previously tagged version, or tag a new "
            , [Char]
"version."
            ])
        , Box
spacer
        , [Char] -> Box
para [Char]
"Note: tagged versions must be in the form"
        , Box -> Box
indented ([Char] -> Box
para [Char]
"v{MAJOR}.{MINOR}.{PATCH} (example: \"v1.6.2\")")
        , Box
spacer
        , [Char] -> Box
para (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
           [ [Char]
"If the version you are publishing is not yet tagged, you might "
           , [Char]
"want to use the --dry-run flag instead, which removes this "
           , [Char]
"requirement. Run `purs publish --help` for more details."
           ])
        ]
  AmbiguousVersions [Version]
vs ->
    [Box] -> Box
vcat forall a b. (a -> b) -> a -> b
$
      [ [Char] -> Box
para (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ [Char]
"The currently checked out commit seems to have been tagged with "
          , [Char]
"more than 1 version, and I don't know which one should be used. "
          , [Char]
"Please either delete some of the tags, or create a new commit "
          , [Char]
"to tag the desired version with."
          ])
      , Box
spacer
      , [Char] -> Box
para [Char]
"Tags for the currently checked out commit:"
      ] forall a. [a] -> [a] -> [a]
++ forall a. (a -> [Char]) -> [a] -> [Box]
bulletedList Version -> [Char]
showVersion [Version]
vs
  BadRepositoryField RepositoryFieldError
err ->
    RepositoryFieldError -> Box
displayRepositoryError RepositoryFieldError
err
  UserError
NoLicenseSpecified ->
    [Box] -> Box
vcat forall a b. (a -> b) -> a -> b
$
      [ [Char] -> Box
para forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ [Char]
"No license is specified in package manifest. Please add a "
          , [Char]
"\"license\" property with a SPDX license expression. For example, "
          , [Char]
"any of the following would be acceptable:"
          ]
      , Box
spacer
      ] forall a. [a] -> [a] -> [a]
++ [Box]
spdxExamples forall a. [a] -> [a] -> [a]
++
      [ Box
spacer
      , [Char] -> Box
para forall a b. (a -> b) -> a -> b
$
          [Char]
"See https://spdx.org/licenses/ for a full list of licenses. For more " forall a. [a] -> [a] -> [a]
++
          [Char]
"information on SPDX license expressions, see https://spdx.org/ids-how"
      , Box
spacer
      , [Char] -> Box
para forall a b. (a -> b) -> a -> b
$
          [Char]
"Note that distributing code without a license means that nobody will " forall a. [a] -> [a] -> [a]
++
          [Char]
"(legally) be able to use it."
      , Box
spacer
      , [Char] -> Box
para forall a b. (a -> b) -> a -> b
$
          [Char]
"It is also recommended to add a LICENSE file to the repository, " forall a. [a] -> [a] -> [a]
++
          [Char]
"including your name and the current year, although this is not necessary."
      ]
  UserError
InvalidLicense ->
    [Box] -> Box
vcat forall a b. (a -> b) -> a -> b
$
      [ [Char] -> Box
para forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ [Char]
"The license specified in package manifest is not a valid SPDX "
          , [Char]
"license expression. Please update the \"license\" property so that "
          , [Char]
"it is a valid SPDX license expression. For example, any of the "
          , [Char]
"following would be acceptable:"
          ]
      , Box
spacer
      ] forall a. [a] -> [a] -> [a]
++
      [Box]
spdxExamples
  MissingDependencies NonEmpty PackageName
pkgs ->
    let singular :: Bool
singular = forall a. NonEmpty a -> Int
NonEmpty.length NonEmpty PackageName
pkgs forall a. Eq a => a -> a -> Bool
== Int
1
        pl :: [Char] -> ShowS
pl [Char]
a [Char]
b = if Bool
singular then [Char]
b else [Char]
a
        do_ :: [Char]
do_          = [Char] -> ShowS
pl [Char]
"do" [Char]
"does"
        dependencies :: [Char]
dependencies = [Char] -> ShowS
pl [Char]
"dependencies" [Char]
"dependency"
    in [Box] -> Box
vcat forall a b. (a -> b) -> a -> b
$
      [Char] -> Box
para (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [Char]
"The following ", [Char]
dependencies, [Char]
" ", [Char]
do_, [Char]
" not appear to be "
        , [Char]
"installed:"
        ]) forall a. a -> [a] -> [a]
:
      forall a. (a -> Text) -> [a] -> [Box]
bulletedListT PackageName -> Text
runPackageName (forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty PackageName
pkgs)
  CompileError MultipleErrors
err ->
    [Box] -> Box
vcat
      [ [Char] -> Box
para [Char]
"Compile error:"
      , Box -> Box
indented ([Box] -> Box
vcat (PPEOptions -> MultipleErrors -> [Box]
P.prettyPrintMultipleErrorsBox PPEOptions
P.defaultPPEOptions MultipleErrors
err))
      ]
  UserError
DirtyWorkingTree ->
    [Char] -> Box
para (
        [Char]
"Your git working tree is dirty. Please commit, discard, or stash " forall a. [a] -> [a] -> [a]
++
        [Char]
"your changes first."
        )
  ResolutionsFileError [Char]
path ParseError PackageError
err ->
    [[Char]] -> Box
successivelyIndented forall a b. (a -> b) -> a -> b
$
      ([Char]
"Error in resolutions file (" forall a. [a] -> [a] -> [a]
++ [Char]
path forall a. [a] -> [a] -> [a]
++ [Char]
"):") forall a. a -> [a] -> [a]
:
      forall a b. (a -> b) -> [a] -> [b]
map Text -> [Char]
T.unpack (forall err. (err -> Text) -> ParseError err -> [Text]
displayError PackageError -> Text
D.displayPackageError ParseError PackageError
err)

spdxExamples :: [Box]
spdxExamples :: [Box]
spdxExamples =
  forall a b. (a -> b) -> [a] -> [b]
map (Box -> Box
indented forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Box
para)
    [ [Char]
"* \"MIT\""
    , [Char]
"* \"Apache-2.0\""
    , [Char]
"* \"BSD-2-Clause\""
    , [Char]
"* \"GPL-2.0-or-later\""
    , [Char]
"* \"(GPL-3.0-only OR MIT)\""
    ]

displayRepositoryError :: RepositoryFieldError -> Box
displayRepositoryError :: RepositoryFieldError -> Box
displayRepositoryError RepositoryFieldError
err = case RepositoryFieldError
err of
  RepositoryFieldMissing Maybe Text
giturl ->
    [Box] -> Box
vcat
      [ [Char] -> Box
para (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
         [ [Char]
"The 'repository' or 'location' field is not present in your package manifest file. "
         , [Char]
"Without this information, Pursuit would not be able to generate "
         , [Char]
"source links in your package's documentation. Please add one - like "
         , [Char]
"this, if you are using the bower.json format:"
         ])
      , Box
spacer
      , Box -> Box
indented ([Box] -> Box
vcat
          [ [Char] -> Box
para [Char]
"\"repository\": {"
          , Box -> Box
indented ([Char] -> Box
para [Char]
"\"type\": \"git\",")
          , Box -> Box
indented ([Char] -> Box
para ([Char]
"\"url\": \"" forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack (forall a. a -> Maybe a -> a
fromMaybe Text
"https://github.com/USER/REPO.git" Maybe Text
giturl) forall a. [a] -> [a] -> [a]
++ [Char]
"\""))
          , [Char] -> Box
para [Char]
"}"
          ]
        )
      , [Char] -> Box
para [Char]
"or like this, if you are using the purs.json format:"
      , Box
spacer
      , Box -> Box
indented ([Box] -> Box
vcat
          [ [Char] -> Box
para [Char]
"\"location\": {"
          , Box -> Box
indented ([Char] -> Box
para [Char]
"\"githubOwner\": \"USER\",")
          , Box -> Box
indented ([Char] -> Box
para [Char]
"\"githubRepo\": \"REPO\",")
          , [Char] -> Box
para [Char]
"}"
          ]
        )
      ]
  BadRepositoryType Text
ty ->
    [Char] -> Box
para (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ [Char]
"In your package manifest file, the repository type is currently listed as "
      , [Char]
"\"" forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
ty forall a. [a] -> [a] -> [a]
++ [Char]
"\". Currently, only git repositories are supported. "
      , [Char]
"Please publish your code in a git repository, and then update the "
      , [Char]
"repository type in your package manifest file to \"git\"."
      ])
  RepositoryFieldError
NotOnGithub ->
    [Box] -> Box
vcat
      [ [Char] -> Box
para (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [Char]
"The repository url in your package manifest file does not point to a "
        , [Char]
"GitHub repository. Currently, Pursuit does not support packages "
        , [Char]
"which are not hosted on GitHub."
        ])
      , Box
spacer
      , [Char] -> Box
para (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
        [ [Char]
"Please update your package manifest file to point to a GitHub repository. "
        , [Char]
"Alternatively, if you would prefer not to host your package on "
        , [Char]
"GitHub, please open an issue:"
        ])
      , Box -> Box
indented ([Char] -> Box
para [Char]
"https://github.com/purescript/purescript/issues/new")
      ]

displayInternalError :: InternalError -> [String]
displayInternalError :: InternalError -> [[Char]]
displayInternalError InternalError
e = case InternalError
e of
  CouldntParseGitTagDate Text
tag ->
    [ [Char]
"Unable to parse the date for a git tag: " forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack Text
tag
    ]

displayOtherError :: OtherError -> Box
displayOtherError :: OtherError -> Box
displayOtherError OtherError
e = case OtherError
e of
  ProcessFailed [Char]
prog [[Char]]
args IOException
exc ->
    [[Char]] -> Box
successivelyIndented
      [ [Char]
"While running `" forall a. [a] -> [a] -> [a]
++ [Char]
prog forall a. [a] -> [a] -> [a]
++ [Char]
" " forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
unwords [[Char]]
args forall a. [a] -> [a] -> [a]
++ [Char]
"`:"
      , forall a. Show a => a -> [Char]
show IOException
exc
      ]
  IOExceptionThrown IOException
exc ->
    [[Char]] -> Box
successivelyIndented
      [ [Char]
"An IO exception occurred:", forall a. Show a => a -> [Char]
show IOException
exc ]

data CollectedWarnings = CollectedWarnings
  { CollectedWarnings -> [PackageName]
noResolvedVersions      :: [PackageName]
  , CollectedWarnings -> [(PackageName, Text)]
unacceptableVersions    :: [(PackageName, Text)]
  , CollectedWarnings -> Any
dirtyWorkingTree        :: Any
  }
  deriving (Int -> CollectedWarnings -> ShowS
[CollectedWarnings] -> ShowS
CollectedWarnings -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CollectedWarnings] -> ShowS
$cshowList :: [CollectedWarnings] -> ShowS
show :: CollectedWarnings -> [Char]
$cshow :: CollectedWarnings -> [Char]
showsPrec :: Int -> CollectedWarnings -> ShowS
$cshowsPrec :: Int -> CollectedWarnings -> ShowS
Show, CollectedWarnings -> CollectedWarnings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CollectedWarnings -> CollectedWarnings -> Bool
$c/= :: CollectedWarnings -> CollectedWarnings -> Bool
== :: CollectedWarnings -> CollectedWarnings -> Bool
$c== :: CollectedWarnings -> CollectedWarnings -> Bool
Eq, Eq CollectedWarnings
CollectedWarnings -> CollectedWarnings -> Bool
CollectedWarnings -> CollectedWarnings -> Ordering
CollectedWarnings -> CollectedWarnings -> CollectedWarnings
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CollectedWarnings -> CollectedWarnings -> CollectedWarnings
$cmin :: CollectedWarnings -> CollectedWarnings -> CollectedWarnings
max :: CollectedWarnings -> CollectedWarnings -> CollectedWarnings
$cmax :: CollectedWarnings -> CollectedWarnings -> CollectedWarnings
>= :: CollectedWarnings -> CollectedWarnings -> Bool
$c>= :: CollectedWarnings -> CollectedWarnings -> Bool
> :: CollectedWarnings -> CollectedWarnings -> Bool
$c> :: CollectedWarnings -> CollectedWarnings -> Bool
<= :: CollectedWarnings -> CollectedWarnings -> Bool
$c<= :: CollectedWarnings -> CollectedWarnings -> Bool
< :: CollectedWarnings -> CollectedWarnings -> Bool
$c< :: CollectedWarnings -> CollectedWarnings -> Bool
compare :: CollectedWarnings -> CollectedWarnings -> Ordering
$ccompare :: CollectedWarnings -> CollectedWarnings -> Ordering
Ord)

instance Semigroup CollectedWarnings where
  <> :: CollectedWarnings -> CollectedWarnings -> CollectedWarnings
(<>) (CollectedWarnings [PackageName]
a [(PackageName, Text)]
b Any
c) (CollectedWarnings [PackageName]
a' [(PackageName, Text)]
b' Any
c') =
    [PackageName] -> [(PackageName, Text)] -> Any -> CollectedWarnings
CollectedWarnings ([PackageName]
a forall a. Semigroup a => a -> a -> a
<> [PackageName]
a') ([(PackageName, Text)]
b forall a. Semigroup a => a -> a -> a
<> [(PackageName, Text)]
b') (Any
c forall a. Semigroup a => a -> a -> a
<> Any
c')

instance Monoid CollectedWarnings where
  mempty :: CollectedWarnings
mempty = [PackageName] -> [(PackageName, Text)] -> Any -> CollectedWarnings
CollectedWarnings forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

collectWarnings :: [PackageWarning] -> CollectedWarnings
collectWarnings :: [PackageWarning] -> CollectedWarnings
collectWarnings = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap PackageWarning -> CollectedWarnings
singular
  where
  singular :: PackageWarning -> CollectedWarnings
singular PackageWarning
w = case PackageWarning
w of
    NoResolvedVersion PackageName
pn ->
      forall a. Monoid a => a
mempty { noResolvedVersions :: [PackageName]
noResolvedVersions = [PackageName
pn] }
    UnacceptableVersion (PackageName, Text)
t ->
      forall a. Monoid a => a
mempty { unacceptableVersions :: [(PackageName, Text)]
unacceptableVersions = [(PackageName, Text)
t] }
    PackageWarning
DirtyWorkingTreeWarn ->
      forall a. Monoid a => a
mempty { dirtyWorkingTree :: Any
dirtyWorkingTree = Bool -> Any
Any Bool
True }

renderWarnings :: [PackageWarning] -> Box
renderWarnings :: [PackageWarning] -> Box
renderWarnings [PackageWarning]
warns =
  let CollectedWarnings{[(PackageName, Text)]
[PackageName]
Any
dirtyWorkingTree :: Any
unacceptableVersions :: [(PackageName, Text)]
noResolvedVersions :: [PackageName]
dirtyWorkingTree :: CollectedWarnings -> Any
unacceptableVersions :: CollectedWarnings -> [(PackageName, Text)]
noResolvedVersions :: CollectedWarnings -> [PackageName]
..} = [PackageWarning] -> CollectedWarnings
collectWarnings [PackageWarning]
warns
      go :: (NonEmpty a -> b) -> [a] -> Maybe b
go NonEmpty a -> b
toBox [a]
warns' = NonEmpty a -> b
toBox forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Maybe (NonEmpty a)
NonEmpty.nonEmpty [a]
warns'
      mboxes :: [Maybe Box]
mboxes = [ forall {a} {b}. (NonEmpty a -> b) -> [a] -> Maybe b
go NonEmpty PackageName -> Box
warnNoResolvedVersions [PackageName]
noResolvedVersions
               , forall {a} {b}. (NonEmpty a -> b) -> [a] -> Maybe b
go NonEmpty (PackageName, Text) -> Box
warnUnacceptableVersions [(PackageName, Text)]
unacceptableVersions
               , if Any -> Bool
getAny Any
dirtyWorkingTree
                   then forall a. a -> Maybe a
Just Box
warnDirtyWorkingTree
                   else forall a. Maybe a
Nothing
               ]
  in case forall a. [Maybe a] -> [a]
catMaybes [Maybe Box]
mboxes of
       []    -> Box
nullBox
       [Box]
boxes -> [Box] -> Box
vcat [ [Char] -> Box
para [Char]
"Warnings:"
                     , Box -> Box
indented ([Box] -> Box
vcat (forall a. a -> [a] -> [a]
intersperse Box
spacer [Box]
boxes))
                     ]

warnNoResolvedVersions :: NonEmpty PackageName -> Box
warnNoResolvedVersions :: NonEmpty PackageName -> Box
warnNoResolvedVersions NonEmpty PackageName
pkgNames =
  let singular :: Bool
singular = forall a. NonEmpty a -> Int
NonEmpty.length NonEmpty PackageName
pkgNames forall a. Eq a => a -> a -> Bool
== Int
1
      pl :: [Char] -> ShowS
pl [Char]
a [Char]
b = if Bool
singular then [Char]
b else [Char]
a

      packages :: [Char]
packages   = [Char] -> ShowS
pl [Char]
"packages" [Char]
"package"
      anyOfThese :: [Char]
anyOfThese = [Char] -> ShowS
pl [Char]
"any of these" [Char]
"this"
      these :: [Char]
these      = [Char] -> ShowS
pl [Char]
"these" [Char]
"this"
  in [Box] -> Box
vcat forall a b. (a -> b) -> a -> b
$
    [ [Char] -> Box
para (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [[Char]
"The following ", [Char]
packages, [Char]
" did not appear to have a resolved "
      , [Char]
"version:"])
    ] forall a. [a] -> [a] -> [a]
++
      forall a. (a -> Text) -> [a] -> [Box]
bulletedListT PackageName -> Text
runPackageName (forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty PackageName
pkgNames)
      forall a. [a] -> [a] -> [a]
++
    [ Box
spacer
    , [Char] -> Box
para (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [[Char]
"Links to types in ", [Char]
anyOfThese, [Char]
" ", [Char]
packages, [Char]
" will not work. In "
      , [Char]
"order to make links work, edit your package manifest to specify a version"
      , [Char]
" or a version range for ", [Char]
these, [Char]
" ", [Char]
packages, [Char]
"."
      ])
    ]

warnUnacceptableVersions :: NonEmpty (PackageName, Text) -> Box
warnUnacceptableVersions :: NonEmpty (PackageName, Text) -> Box
warnUnacceptableVersions NonEmpty (PackageName, Text)
pkgs =
  let singular :: Bool
singular = forall a. NonEmpty a -> Int
NonEmpty.length NonEmpty (PackageName, Text)
pkgs forall a. Eq a => a -> a -> Bool
== Int
1
      pl :: [Char] -> ShowS
pl [Char]
a [Char]
b = if Bool
singular then [Char]
b else [Char]
a

      packages' :: [Char]
packages'  = [Char] -> ShowS
pl [Char]
"packages'" [Char]
"package's"
      packages :: [Char]
packages   = [Char] -> ShowS
pl [Char]
"packages" [Char]
"package"
      anyOfThese :: [Char]
anyOfThese = [Char] -> ShowS
pl [Char]
"any of these" [Char]
"this"
      these :: [Char]
these      = [Char] -> ShowS
pl [Char]
"these" [Char]
"this"
      versions :: [Char]
versions   = [Char] -> ShowS
pl [Char]
"versions" [Char]
"version"
  in [Box] -> Box
vcat forall a b. (a -> b) -> a -> b
$
    [ [Char] -> Box
para (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ [Char]
"The following installed ", [Char]
packages', [Char]
" ", [Char]
versions, [Char]
" could "
      , [Char]
"not be parsed:"
      ])
    ] forall a. [a] -> [a] -> [a]
++
      forall a. (a -> Text) -> [a] -> [Box]
bulletedListT (PackageName, Text) -> Text
showTuple (forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (PackageName, Text)
pkgs)
      forall a. [a] -> [a] -> [a]
++
    [ Box
spacer
    , [Char] -> Box
para (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [[Char]
"Links to types in ", [Char]
anyOfThese, [Char]
" ", [Char]
packages, [Char]
" will not work. In "
      , [Char]
"order to make links work, edit your package manifest to specify an "
      , [Char]
"acceptable version or version range for ", [Char]
these, [Char]
" ", [Char]
packages, [Char]
"."
      ])
    ]
  where
  showTuple :: (PackageName, Text) -> Text
showTuple (PackageName
pkgName, Text
tag) = PackageName -> Text
runPackageName PackageName
pkgName forall a. Semigroup a => a -> a -> a
<> Text
"#" forall a. Semigroup a => a -> a -> a
<> Text
tag

warnDirtyWorkingTree :: Box
warnDirtyWorkingTree :: Box
warnDirtyWorkingTree =
  [Char] -> Box
para (
    [Char]
"Your working tree is dirty. (Note: this would be an error if it "
    forall a. [a] -> [a] -> [a]
++ [Char]
"were not a dry run)"
    )

printWarnings :: [PackageWarning] -> IO ()
printWarnings :: [PackageWarning] -> IO ()
printWarnings = Box -> IO ()
printToStderr forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PackageWarning] -> Box
renderWarnings