Skip to content

Commit 785324a

Browse files
hdgarroodhdgarrood
committed
Add new executable psc-publish
Adds a new program which collects all information necessary for publishing a version of a package on pursuit, and dumps it to stdout as JSON. Included changes: * expand rendered docs types (Language.PureScript.Docs.Types) * add ToJSON instances and aeson-better-errors parsers * add ToJSON/FromJSON tests for UploadedPackage * look through devDependencies as well as normal dependencies in order to decide which dependencies are undeclared * make undeclared dependencies a warning, not an error It turns out making undeclared dependencies an error can be quite annoying - for example, when trying to run psc-publish on purescript-prelude, I had purescript-eff installed and undeclared (for testing), and it was failing because of this. Arguably, this should have been an error, and I should have added purescript-eff to devDependencies. But, I didn't want to do that, because there's no suitable version of purescript-eff to use yet. There are probably other situations where it would make sense to install packages for development locally and not add them to devDependencies too, which just haven't occurred to me. Given this, I think emitting warnings is enough; I think the strategy of throwing errors would carry a much higher risk of just being annoying than actually preventing errors.
1 parent 783061d commit 785324a

17 files changed

Lines changed: 1441 additions & 43 deletions

File tree

‎.gitignore‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -9,3 +9,4 @@ cabal.sandbox.config
99
*.lksh*
1010
.virthualenv
1111
.psci_modules/
12+
tmp/

‎psc-publish/BoxesHelpers.hs‎

Lines changed: 38 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,38 @@
1+
module BoxesHelpers
2+
( Boxes.Box
3+
, Boxes.nullBox
4+
, module BoxesHelpers
5+
) where
6+
7+
import System.IO (hPutStr, stderr)
8+
import qualified Text.PrettyPrint.Boxes as Boxes
9+
10+
width :: Int
11+
width = 79
12+
13+
indentWidth :: Int
14+
indentWidth = 2
15+
16+
para :: String -> Boxes.Box
17+
para = Boxes.para Boxes.left width
18+
19+
indented :: Boxes.Box -> Boxes.Box
20+
indented b = Boxes.hcat Boxes.left [Boxes.emptyBox 1 indentWidth, b]
21+
22+
successivelyIndented :: [String] -> Boxes.Box
23+
successivelyIndented [] =
24+
Boxes.nullBox
25+
successivelyIndented (x:xs) =
26+
Boxes.vcat Boxes.left [para x, indented (successivelyIndented xs)]
27+
28+
vcat :: [Boxes.Box] -> Boxes.Box
29+
vcat = Boxes.vcat Boxes.left
30+
31+
spacer :: Boxes.Box
32+
spacer = Boxes.emptyBox 1 1
33+
34+
bulletedList :: (a -> String) -> [a] -> [Boxes.Box]
35+
bulletedList f = map (indented . para . ("* " ++) . f)
36+
37+
printToStderr :: Boxes.Box -> IO ()
38+
printToStderr = hPutStr stderr . Boxes.render

‎psc-publish/ErrorsWarnings.hs‎

Lines changed: 298 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,298 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
3+
module ErrorsWarnings where
4+
5+
import Data.Aeson.BetterErrors
6+
import Data.Version
7+
import Data.Maybe
8+
import Data.List (intersperse)
9+
import Data.List.NonEmpty (NonEmpty(..))
10+
import qualified Data.List.NonEmpty as NonEmpty
11+
12+
import qualified Data.Text as T
13+
14+
import Control.Exception (IOException)
15+
import Web.Bower.PackageMeta (BowerError, PackageName, runPackageName)
16+
import qualified Web.Bower.PackageMeta as Bower
17+
18+
import BoxesHelpers
19+
20+
-- | An error which meant that it was not possible to retrieve metadata for a
21+
-- package.
22+
data PackageError
23+
= UserError UserError
24+
| InternalError InternalError
25+
| OtherError OtherError
26+
deriving (Show)
27+
28+
data PackageWarning
29+
= ResolutionNotVersion PackageName
30+
| UndeclaredDependency PackageName
31+
deriving (Show)
32+
33+
-- | An error that should be fixed by the user.
34+
data UserError
35+
= BowerJSONNotFound
36+
| CouldntParseBowerJSON (ParseError BowerError)
37+
| BowerJSONNameMissing
38+
| TagMustBeCheckedOut
39+
| AmbiguousVersions [Version] -- Invariant: should contain at least two elements
40+
| BadRepositoryField RepositoryFieldError
41+
| MissingDependencies (NonEmpty PackageName)
42+
deriving (Show)
43+
44+
data RepositoryFieldError
45+
= RepositoryFieldMissing
46+
| BadRepositoryType String
47+
| NotOnGithub
48+
deriving (Show)
49+
50+
-- | An error that probably indicates a bug in this module.
51+
data InternalError
52+
= JSONError JSONSource (ParseError BowerError)
53+
deriving (Show)
54+
55+
data JSONSource
56+
= FromFile FilePath
57+
| FromBowerList
58+
deriving (Show)
59+
60+
data OtherError
61+
= ProcessFailed String [String] IOException
62+
| IOExceptionThrown IOException
63+
deriving (Show)
64+
65+
printError :: PackageError -> IO ()
66+
printError = printToStderr . renderError
67+
68+
renderError :: PackageError -> Box
69+
renderError err =
70+
case err of
71+
UserError e ->
72+
vcat
73+
[ para (concat
74+
[ "There is a problem with your package, which meant that "
75+
, "it could not be published."
76+
])
77+
, para "Details:"
78+
, indented (displayUserError e)
79+
]
80+
InternalError e ->
81+
vcat
82+
[ para "Internal error: this is probably a bug. Please report it:"
83+
, indented (para "https://github.com/purescript/purescript/issues/new")
84+
, spacer
85+
, para "Details:"
86+
, successivelyIndented (displayInternalError e)
87+
]
88+
OtherError e ->
89+
vcat
90+
[ para "An error occurred, and your package could not be published."
91+
, para "Details:"
92+
, indented (displayOtherError e)
93+
]
94+
95+
displayUserError :: UserError -> Box
96+
displayUserError e = case e of
97+
BowerJSONNotFound ->
98+
para (concat
99+
[ "The bower.json file was not found. Please create one, or run "
100+
, "`pulp init`."
101+
])
102+
CouldntParseBowerJSON err ->
103+
vcat
104+
[ successivelyIndented
105+
[ "The bower.json file could not be parsed as JSON:"
106+
, "aeson reported: " ++ show err
107+
]
108+
, para "Please ensure that your bower.json file is valid JSON."
109+
]
110+
BowerJSONNameMissing ->
111+
vcat
112+
[ successivelyIndented
113+
[ "In bower.json:"
114+
, "the \"name\" key was not found."
115+
]
116+
, para "Please give your package a name first."
117+
]
118+
TagMustBeCheckedOut ->
119+
vcat
120+
[ para (concat
121+
[ "psc-publish requires a tagged version to be checked out in "
122+
, "order to build documentation, and no suitable tag was found. "
123+
, "Please check out a previously tagged version, or tag a new "
124+
, "version."
125+
])
126+
, spacer
127+
, para "Note: tagged versions must be in one of the following forms:"
128+
, indented (para "* v{MAJOR}.{MINOR}.{PATCH} (example: \"v1.6.2\")")
129+
, indented (para "* {MAJOR}.{MINOR}.{PATCH} (example: \"1.6.2\")")
130+
]
131+
AmbiguousVersions vs ->
132+
vcat $
133+
[ para (concat
134+
[ "The currently checked out commit seems to have been tagged with "
135+
, "more than 1 version, and I don't know which one should be used. "
136+
, "Please either delete some of the tags, or create a new commit "
137+
, "to tag the desired verson with."
138+
])
139+
, spacer
140+
, para "Tags for the currently checked out commit:"
141+
] ++ bulletedList showVersion vs
142+
BadRepositoryField err ->
143+
displayRepositoryError err
144+
MissingDependencies pkgs ->
145+
let singular = NonEmpty.length pkgs == 1
146+
pl a b = if singular then b else a
147+
do_ = pl "do" "does"
148+
dependencies = pl "dependencies" "dependency"
149+
them = pl "them" "it"
150+
in vcat $
151+
[ para (concat
152+
[ "The following Bower ", dependencies, " ", do_, " not appear to be "
153+
, "installed:"
154+
])
155+
] ++
156+
bulletedList runPackageName (NonEmpty.toList pkgs)
157+
++
158+
[ spacer
159+
, para (concat
160+
[ "Please install ", them, " first, by running `bower install`."
161+
])
162+
]
163+
164+
displayRepositoryError :: RepositoryFieldError -> Box
165+
displayRepositoryError err = case err of
166+
RepositoryFieldMissing ->
167+
vcat
168+
[ para (concat
169+
[ "The 'repository' field is not present in your bower.json file. "
170+
, "Without this information, Pursuit would not be able to generate "
171+
, "source links in your package's documentation. Please add one - like "
172+
, "this, for example:"
173+
])
174+
, spacer
175+
, indented (vcat
176+
[ para "\"repository\": {"
177+
, indented (para "\"type\": \"git\",")
178+
, indented (para "\"url\": \"git://github.com/purescript/purescript-prelude.git\"")
179+
, para "}"
180+
]
181+
)
182+
]
183+
BadRepositoryType ty ->
184+
para (concat
185+
[ "In your bower.json file, the repository type is currently listed as "
186+
, "\"" ++ ty ++ "\". Currently, only git repositories are supported. "
187+
, "Please publish your code in a git repository, and then update the "
188+
, "repository type in your bower.json file to \"git\"."
189+
])
190+
NotOnGithub ->
191+
vcat
192+
[ para (concat
193+
[ "The repository url in your bower.json file does not point to a "
194+
, "GitHub repository. Currently, Pursuit does not support packages "
195+
, "which are not hosted on GitHub."
196+
])
197+
, spacer
198+
, para (concat
199+
[ "Please update your bower.json file to point to a GitHub repository. "
200+
, "Alternatively, if you would prefer not to host your package on "
201+
, "GitHub, please open an issue:"
202+
])
203+
, indented (para "https://github.com/purescript/purescript/issues/new")
204+
]
205+
206+
displayInternalError :: InternalError -> [String]
207+
displayInternalError e = case e of
208+
JSONError src r ->
209+
[ "Error in JSON " ++ displayJSONSource src ++ ":"
210+
, T.unpack (Bower.displayError r)
211+
]
212+
213+
displayJSONSource :: JSONSource -> String
214+
displayJSONSource s = case s of
215+
FromFile fp ->
216+
"in file " ++ show fp
217+
FromBowerList ->
218+
"in the output of `bower list --json --offline`"
219+
220+
displayOtherError :: OtherError -> Box
221+
displayOtherError e = case e of
222+
ProcessFailed prog args exc ->
223+
successivelyIndented
224+
[ "While running `" ++ prog ++ " " ++ unwords args ++ "`:"
225+
, show exc
226+
]
227+
IOExceptionThrown exc ->
228+
successivelyIndented
229+
[ "An IO exception occurred:", show exc ]
230+
231+
renderWarnings :: [PackageWarning] -> Box
232+
renderWarnings =
233+
collectWarnings
234+
[ (getResolutionNotVersion, warnResolutionNotVersions)
235+
, (getUndeclaredDependency, warnUndeclaredDependencies)
236+
]
237+
where
238+
collectWarnings patterns warns =
239+
let boxes = mapMaybe (collectWarnings' warns) patterns
240+
in vcat
241+
[ para "Warnings:"
242+
, indented (vcat (intersperse spacer boxes))
243+
]
244+
245+
getResolutionNotVersion (ResolutionNotVersion n) = Just n
246+
getResolutionNotVersion _ = Nothing
247+
248+
getUndeclaredDependency (UndeclaredDependency n) = Just n
249+
getUndeclaredDependency _ = Nothing
250+
251+
collectWarnings' :: [PackageWarning] -> ((PackageWarning -> Maybe a), (NonEmpty a -> Box)) -> Maybe Box
252+
collectWarnings' warns (pattern, render) =
253+
case mapMaybe pattern warns of
254+
[] -> Nothing
255+
(x:xs) -> Just (render (x :| xs))
256+
257+
warnResolutionNotVersions :: NonEmpty PackageName -> Box
258+
warnResolutionNotVersions pkgNames =
259+
let singular = NonEmpty.length pkgNames == 1
260+
pl a b = if singular then b else a
261+
262+
packages = pl "packages" "package"
263+
were = pl "were" "was"
264+
anyOfThese = pl "any of these" "this"
265+
these = pl "these" "this"
266+
in vcat $
267+
[ para (concat
268+
["The following ", packages, " ", were, " not resolved to a version:"])
269+
] ++
270+
bulletedList runPackageName (NonEmpty.toList pkgNames)
271+
++
272+
[ spacer
273+
, para (concat
274+
["Links to types in ", anyOfThese, " ", packages, " will not work. In "
275+
, "order to make links work, edit your bower.json to specify a version"
276+
, " or a version range for ", these, " ", packages, ", and rerun "
277+
, "`bower install`."
278+
])
279+
]
280+
281+
warnUndeclaredDependencies :: NonEmpty PackageName -> Box
282+
warnUndeclaredDependencies pkgNames =
283+
let singular = NonEmpty.length pkgNames == 1
284+
pl a b = if singular then b else a
285+
286+
packages = pl "packages" "package"
287+
are = pl "are" "is"
288+
dependencies = pl "dependencies" "a dependency"
289+
in vcat $
290+
[ para (concat
291+
[ "The following Bower ", packages, " ", are, " installed, but not "
292+
, "declared as ", dependencies, " in your bower.json file:"
293+
])
294+
] ++
295+
bulletedList runPackageName (NonEmpty.toList pkgNames)
296+
297+
printWarnings :: [PackageWarning] -> IO ()
298+
printWarnings = printToStderr . renderWarnings

0 commit comments

Comments
 (0)