module Language.PureScript.Publish.ErrorsWarnings
( PackageError(..)
, PackageWarning(..)
, UserError(..)
, InternalError(..)
, OtherError(..)
, RepositoryFieldError(..)
, JSONSource(..)
, printError
, printErrorToStdout
, renderError
, printWarnings
, renderWarnings
) where
import Prelude ()
import Prelude.Compat
import Data.Aeson.BetterErrors
import Data.Version
import Data.Maybe
import Data.Monoid
import Data.List (intersperse, intercalate)
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Text as T
import Control.Exception (IOException)
import Web.Bower.PackageMeta (BowerError, PackageName, runPackageName, showBowerError)
import qualified Web.Bower.PackageMeta as Bower
import qualified Language.PureScript as P
import Language.PureScript.Publish.BoxesHelpers
data PackageError
= UserError UserError
| InternalError InternalError
| OtherError OtherError
deriving (Show)
data PackageWarning
= NoResolvedVersion PackageName
| UndeclaredDependency PackageName
| UnacceptableVersion (PackageName, String)
| DirtyWorkingTree_Warn
deriving (Show)
data UserError
= BowerJSONNotFound
| LicenseNotFound
| BowerExecutableNotFound [String]
| CouldntDecodeBowerJSON (ParseError BowerError)
| TagMustBeCheckedOut
| AmbiguousVersions [Version]
| BadRepositoryField RepositoryFieldError
| NoLicenseSpecified
| MissingDependencies (NonEmpty PackageName)
| CompileError P.MultipleErrors
| DirtyWorkingTree
deriving (Show)
data RepositoryFieldError
= RepositoryFieldMissing
| BadRepositoryType String
| NotOnGithub
deriving (Show)
data InternalError
= JSONError JSONSource (ParseError BowerError)
deriving (Show)
data JSONSource
= FromFile FilePath
| FromBowerList
deriving (Show)
data OtherError
= ProcessFailed String [String] IOException
| IOExceptionThrown IOException
deriving (Show)
printError :: PackageError -> IO ()
printError = printToStderr . renderError
printErrorToStdout :: PackageError -> IO ()
printErrorToStdout = printToStdout . renderError
renderError :: PackageError -> Box
renderError err =
case err of
UserError e ->
vcat
[ para (
"There is a problem with your package, which meant that " ++
"it could not be published."
)
, para "Details:"
, indented (displayUserError e)
]
InternalError e ->
vcat
[ para "Internal error: this is probably a bug. Please report it:"
, indented (para "https://github.com/purescript/purescript/issues/new")
, spacer
, para "Details:"
, successivelyIndented (displayInternalError e)
]
OtherError e ->
vcat
[ para "An error occurred, and your package could not be published."
, para "Details:"
, indented (displayOtherError e)
]
displayUserError :: UserError -> Box
displayUserError e = case e of
BowerJSONNotFound ->
para (
"The bower.json file was not found. Please create one, or run " ++
"`pulp init`."
)
LicenseNotFound ->
para (concat
["No LICENSE file was found. Please create one. ",
"Distributing code without a license means that nobody ",
"will be able to (legally) use it."
])
BowerExecutableNotFound names ->
para (concat
[ "The Bower executable was not found (tried: ", format names, "). Please"
, " ensure that bower is installed and on your PATH."
])
where
format = intercalate ", " . map show
CouldntDecodeBowerJSON err ->
vcat
[ para "There was a problem with your bower.json file:"
, indented (vcat (map (para . T.unpack) (displayError showBowerError err)))
, spacer
, para "Please ensure that your bower.json file is valid."
]
TagMustBeCheckedOut ->
vcat
[ para (concat
[ "psc-publish requires a tagged version to be checked out in "
, "order to build documentation, and no suitable tag was found. "
, "Please check out a previously tagged version, or tag a new "
, "version."
])
, spacer
, para "Note: tagged versions must be in one of the following forms:"
, indented (para "* v{MAJOR}.{MINOR}.{PATCH} (example: \"v1.6.2\")")
, indented (para "* {MAJOR}.{MINOR}.{PATCH} (example: \"1.6.2\")")
, spacer
, para (concat
[ "If the version you are publishing is not yet tagged, you might "
, "want to use the --dry-run flag instead, which removes this "
, "requirement. Run psc-publish --help for more details."
])
]
AmbiguousVersions vs ->
vcat $
[ para (concat
[ "The currently checked out commit seems to have been tagged with "
, "more than 1 version, and I don't know which one should be used. "
, "Please either delete some of the tags, or create a new commit "
, "to tag the desired verson with."
])
, spacer
, para "Tags for the currently checked out commit:"
] ++ bulletedList showVersion vs
BadRepositoryField err ->
displayRepositoryError err
NoLicenseSpecified ->
para (concat
["No license specified in bower.json. Please add one. ",
"Distributing code without a license means that nobody ",
"will be able to (legally) use it."
])
MissingDependencies pkgs ->
let singular = NonEmpty.length pkgs == 1
pl a b = if singular then b else a
do_ = pl "do" "does"
dependencies = pl "dependencies" "dependency"
them = pl "them" "it"
in vcat $
[ para (concat
[ "The following Bower ", dependencies, " ", do_, " not appear to be "
, "installed:"
])
] ++
bulletedList runPackageName (NonEmpty.toList pkgs)
++
[ spacer
, para (concat
[ "Please install ", them, " first, by running `bower install`."
])
]
CompileError err ->
vcat
[ para "Compile error:"
, indented (vcat (P.prettyPrintMultipleErrorsBox False err))
]
DirtyWorkingTree ->
para (
"Your git working tree is dirty. Please commit, discard, or stash " ++
"your changes first."
)
displayRepositoryError :: RepositoryFieldError -> Box
displayRepositoryError err = case err of
RepositoryFieldMissing ->
vcat
[ para (concat
[ "The 'repository' field is not present in your bower.json file. "
, "Without this information, Pursuit would not be able to generate "
, "source links in your package's documentation. Please add one - like "
, "this, for example:"
])
, spacer
, indented (vcat
[ para "\"repository\": {"
, indented (para "\"type\": \"git\",")
, indented (para "\"url\": \"git://github.com/purescript/purescript-prelude.git\"")
, para "}"
]
)
]
BadRepositoryType ty ->
para (concat
[ "In your bower.json file, the repository type is currently listed as "
, "\"" ++ ty ++ "\". Currently, only git repositories are supported. "
, "Please publish your code in a git repository, and then update the "
, "repository type in your bower.json file to \"git\"."
])
NotOnGithub ->
vcat
[ para (concat
[ "The repository url in your bower.json file does not point to a "
, "GitHub repository. Currently, Pursuit does not support packages "
, "which are not hosted on GitHub."
])
, spacer
, para (concat
[ "Please update your bower.json file to point to a GitHub repository. "
, "Alternatively, if you would prefer not to host your package on "
, "GitHub, please open an issue:"
])
, indented (para "https://github.com/purescript/purescript/issues/new")
]
displayInternalError :: InternalError -> [String]
displayInternalError e = case e of
JSONError src r ->
[ "Error in JSON " ++ displayJSONSource src ++ ":"
, T.unpack (Bower.displayError r)
]
displayJSONSource :: JSONSource -> String
displayJSONSource s = case s of
FromFile fp ->
"in file " ++ show fp
FromBowerList ->
"in the output of `bower list --json --offline`"
displayOtherError :: OtherError -> Box
displayOtherError e = case e of
ProcessFailed prog args exc ->
successivelyIndented
[ "While running `" ++ prog ++ " " ++ unwords args ++ "`:"
, show exc
]
IOExceptionThrown exc ->
successivelyIndented
[ "An IO exception occurred:", show exc ]
data CollectedWarnings = CollectedWarnings
{ noResolvedVersions :: [PackageName]
, undeclaredDependencies :: [PackageName]
, unacceptableVersions :: [(PackageName, String)]
, dirtyWorkingTree :: Any
}
deriving (Show, Eq, Ord)
instance Monoid CollectedWarnings where
mempty = CollectedWarnings mempty mempty mempty mempty
mappend (CollectedWarnings as bs cs d)
(CollectedWarnings as' bs' cs' d') =
CollectedWarnings (as <> as') (bs <> bs') (cs <> cs') (d <> d')
collectWarnings :: [PackageWarning] -> CollectedWarnings
collectWarnings = foldMap singular
where
singular w = case w of
NoResolvedVersion pn -> CollectedWarnings [pn] mempty mempty mempty
UndeclaredDependency pn -> CollectedWarnings mempty [pn] mempty mempty
UnacceptableVersion t -> CollectedWarnings mempty mempty [t] mempty
DirtyWorkingTree_Warn -> CollectedWarnings mempty mempty mempty (Any True)
renderWarnings :: [PackageWarning] -> Box
renderWarnings warns =
let CollectedWarnings{..} = collectWarnings warns
go toBox warns' = toBox <$> NonEmpty.nonEmpty warns'
mboxes = [ go warnNoResolvedVersions noResolvedVersions
, go warnUndeclaredDependencies undeclaredDependencies
, go warnUnacceptableVersions unacceptableVersions
, if getAny dirtyWorkingTree
then Just warnDirtyWorkingTree
else Nothing
]
in case catMaybes mboxes of
[] -> nullBox
boxes -> vcat [ para "Warnings:"
, indented (vcat (intersperse spacer boxes))
]
warnNoResolvedVersions :: NonEmpty PackageName -> Box
warnNoResolvedVersions pkgNames =
let singular = NonEmpty.length pkgNames == 1
pl a b = if singular then b else a
packages = pl "packages" "package"
anyOfThese = pl "any of these" "this"
these = pl "these" "this"
in vcat $
[ para (concat
["The following ", packages, " did not appear to have a resolved "
, "version:"])
] ++
bulletedList runPackageName (NonEmpty.toList pkgNames)
++
[ spacer
, para (concat
["Links to types in ", anyOfThese, " ", packages, " will not work. In "
, "order to make links work, edit your bower.json to specify a version"
, " or a version range for ", these, " ", packages, ", and rerun "
, "`bower install`."
])
]
warnUndeclaredDependencies :: NonEmpty PackageName -> Box
warnUndeclaredDependencies pkgNames =
let singular = NonEmpty.length pkgNames == 1
pl a b = if singular then b else a
packages = pl "packages" "package"
are = pl "are" "is"
dependencies = pl "dependencies" "a dependency"
in vcat $
para (concat
[ "The following Bower ", packages, " ", are, " installed, but not "
, "declared as ", dependencies, " in your bower.json file:"
])
: bulletedList runPackageName (NonEmpty.toList pkgNames)
warnUnacceptableVersions :: NonEmpty (PackageName, String) -> Box
warnUnacceptableVersions pkgs =
let singular = NonEmpty.length pkgs == 1
pl a b = if singular then b else a
packages' = pl "packages'" "package's"
packages = pl "packages" "package"
anyOfThese = pl "any of these" "this"
these = pl "these" "this"
versions = pl "versions" "version"
in vcat $
[ para (concat
[ "The following installed Bower ", packages', " ", versions, " could "
, "not be parsed:"
])
] ++
bulletedList showTuple (NonEmpty.toList pkgs)
++
[ spacer
, para (concat
["Links to types in ", anyOfThese, " ", packages, " will not work. In "
, "order to make links work, edit your bower.json to specify an "
, "acceptable version or version range for ", these, " ", packages, ", "
, "and rerun `bower install`."
])
]
where
showTuple (pkgName, tag) = runPackageName pkgName ++ "#" ++ tag
warnDirtyWorkingTree :: Box
warnDirtyWorkingTree =
para (concat
[ "Your working tree is dirty. (Note: this would be an error if it "
, "were not a dry run)"
])
printWarnings :: [PackageWarning] -> IO ()
printWarnings = printToStderr . renderWarnings