Skip to content

Commit e8dbd69

Browse files
mpilgremmpilgrem
authored
Merge pull request commercialhaskell#5961 from commercialhaskell/fix5955c
Fix commercialhaskell#5955 Prettier `stack new` exceptions
2 parents 7ddc767 + f6fda69 commit e8dbd69

File tree

7 files changed

+592
-282
lines changed

7 files changed

+592
-282
lines changed

‎doc/maintainers/stack_errors.md

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -182,18 +182,18 @@ to take stock of the errors that Stack itself can raise, by reference to the
182182
[S-3421] = ParseFailure [Value]
183183
~~~
184184

185-
- `Stack.New.NewException`
185+
- `Stack.New.NewPrettyException`
186186

187187
~~~haskell
188-
[S-3650] = FailedToLoadTemplate TemplateName FilePath
189-
[S-1688] | FailedToDownloadTemplate TemplateName VerifiedDownloadException
190-
[S-2135] | AlreadyExists (Path Abs Dir)
191-
[S-5515] | MissingParameters PackageName TemplateName (Set String) (Path Abs File)
192-
[S-9490] | InvalidTemplate TemplateName String
188+
[S-2135] = ProjectDirAlreadyExists String (Path Abs Dir)
189+
[S-1688] | DownloadTemplateFailed Text String VerifiedDownloadException
190+
[S-3650] | LoadTemplateFailed TemplateName FilePath
191+
[S-9582] | ExtractTemplateFailed TemplateName FilePath String
192+
[S-9490] | TemplateInvalid TemplateName StyleDoc
193+
[S-5682] | MagicPackageNameInvalid String
193194
[S-3113] | AttemptedOverwrites [Path Abs File]
194-
[S-8143] | FailedToDownloadTemplatesHelp HttpException
195-
[S-6670] | BadTemplatesHelpEncoding String UnicodeException
196-
[S-5682] | Can'tUseWiredInName PackageName
195+
[S-8143] | DownloadTemplatesHelpFailed HttpException
196+
[S-6670] | TemplatesHelpEncodingInvalid String UnicodeException
197197
~~~
198198

199199
- `Stack.Nix.NixException`

‎src/Network/HTTP/StackClient.hs

Lines changed: 24 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -30,9 +30,11 @@ module Network.HTTP.StackClient
3030
, applyDigestAuth
3131
, displayDigestAuthException
3232
, Request
33-
, RequestBody(RequestBodyBS, RequestBodyLBS)
34-
, Response
35-
, HttpException
33+
, RequestBody (RequestBodyBS, RequestBodyLBS)
34+
, Response (..)
35+
, HttpException (..)
36+
, HttpExceptionContent (..)
37+
, notFound404
3638
, hAccept
3739
, hContentLength
3840
, hContentMD5
@@ -70,27 +72,30 @@ import qualified Data.Text as T
7072
import Data.Time.Clock
7173
( NominalDiffTime, diffUTCTime, getCurrentTime )
7274
import Network.HTTP.Client
73-
( Request, RequestBody (..), Response, parseRequest, getUri
74-
, path, checkResponse, parseUrlThrow
75+
( HttpException (..), HttpExceptionContent (..), Request
76+
, RequestBody (..), Response (..), checkResponse, getUri
77+
, parseRequest, parseUrlThrow, path
7578
)
76-
import Network.HTTP.Simple
77-
( setRequestCheckStatus, setRequestMethod, setRequestBody
78-
, setRequestHeader, addRequestHeader, HttpException (..)
79-
, getResponseBody, getResponseStatusCode, getResponseHeaders
80-
)
81-
import Network.HTTP.Types
82-
( hAccept, hContentLength, hContentMD5, methodPut )
83-
import Network.HTTP.Conduit ( requestHeaders )
79+
import Network.HTTP.Client.MultipartFormData
80+
( formDataBody, partBS, partFileRequestBody, partLBS )
8481
import Network.HTTP.Client.TLS
85-
( getGlobalManager, applyDigestAuth
86-
, displayDigestAuthException
82+
( applyDigestAuth, displayDigestAuthException
83+
, getGlobalManager
8784
)
85+
import Network.HTTP.Conduit ( requestHeaders )
8886
import Network.HTTP.Download
8987
hiding ( download, redownload, verifiedDownload )
9088
import qualified Network.HTTP.Download as Download
89+
import Network.HTTP.Simple
90+
( addRequestHeader, getResponseBody, getResponseHeaders
91+
, getResponseStatusCode, setRequestBody
92+
, setRequestCheckStatus, setRequestHeader, setRequestMethod
93+
)
9194
import qualified Network.HTTP.Simple
92-
import Network.HTTP.Client.MultipartFormData
93-
( formDataBody, partFileRequestBody, partBS, partLBS )
95+
import Network.HTTP.Types
96+
( hAccept, hContentLength, hContentMD5, methodPut
97+
, notFound404
98+
)
9499
import Path
95100
import Prelude ( until, (!!) )
96101
import RIO
@@ -183,7 +188,8 @@ verifiedDownloadWithProgress
183188
-> Maybe Int
184189
-> RIO env Bool
185190
verifiedDownloadWithProgress req destpath lbl msize =
186-
verifiedDownload req destpath (chattyDownloadProgress lbl msize)
191+
verifiedDownload req destpath (chattyDownloadProgress lbl msize)
192+
187193

188194
chattyDownloadProgress
189195
:: ( HasLogFunc env

‎src/Stack/BuildPlan.hs

Lines changed: 32 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -37,7 +37,6 @@ import Distribution.System (Platform)
3737
import Distribution.Text (display)
3838
import Distribution.Types.UnqualComponentName (unUnqualComponentName)
3939
import qualified Distribution.Version as C
40-
import qualified RIO
4140
import Stack.Constants
4241
import Stack.Package
4342
import Stack.SourceMap
@@ -392,9 +391,13 @@ selectBestSnapshot
392391
-> NonEmpty SnapName
393392
-> RIO env (SnapshotCandidate env, RawSnapshotLocation, BuildPlanCheck)
394393
selectBestSnapshot pkgDirs snaps = do
395-
logInfo $ "Selecting the best among "
396-
<> displayShow (NonEmpty.length snaps)
397-
<> " snapshots...\n"
394+
prettyInfo $
395+
fillSep
396+
[ flow "Selecting the best among"
397+
, fromString $ show (NonEmpty.length snaps)
398+
, "snapshots..."
399+
]
400+
<> line
398401
F.foldr1 go (NonEmpty.map (getResult <=< snapshotLocation) snaps)
399402
where
400403
go mold mnew = do
@@ -413,19 +416,31 @@ selectBestSnapshot pkgDirs snaps = do
413416
| compareBuildPlanCheck r1 r2 /= LT = (s1, l1, r1)
414417
| otherwise = (s2, l2, r2)
415418

416-
reportResult BuildPlanCheckOk {} loc = do
417-
logInfo $ "* Matches " <> RIO.display loc
418-
logInfo ""
419-
420-
reportResult r@BuildPlanCheckPartial {} loc = do
421-
logWarn $ "* Partially matches " <> RIO.display loc
422-
logWarn $ RIO.display $ ind $ T.pack $ show r
423-
424-
reportResult r@BuildPlanCheckFail {} loc = do
425-
logWarn $ "* Rejected " <> RIO.display loc
426-
logWarn $ RIO.display $ ind $ T.pack $ show r
427-
428-
ind t = T.unlines $ fmap (" " <>) (T.lines t)
419+
reportResult BuildPlanCheckOk {} loc =
420+
prettyNote $
421+
fillSep
422+
[ flow "Matches"
423+
, pretty $ PrettyRawSnapshotLocation loc
424+
]
425+
<> line
426+
427+
reportResult r@BuildPlanCheckPartial {} loc =
428+
prettyWarn $
429+
fillSep
430+
[ flow "Partially matches"
431+
, pretty $ PrettyRawSnapshotLocation loc
432+
]
433+
<> blankLine
434+
<> string (show r)
435+
436+
reportResult r@BuildPlanCheckFail {} loc =
437+
prettyWarn $
438+
fillSep
439+
[ flow "Rejected"
440+
, pretty $ PrettyRawSnapshotLocation loc
441+
]
442+
<> blankLine
443+
<> string (show r)
429444

430445
showItems :: [String] -> Text
431446
showItems items = T.concat (map formatItem items)

‎src/Stack/Constants.hs

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -211,18 +211,18 @@ inContainerEnvVar = stackProgNameUpper ++ "_IN_CONTAINER"
211211
inNixShellEnvVar :: String
212212
inNixShellEnvVar = map toUpper stackProgName ++ "_IN_NIX_SHELL"
213213

214-
-- | The comment to 'see
215-
-- https://downloads.haskell.org/~ghc/7.10.1/docs/html/libraries/ghc/src/Module.html#integerPackageKey'
214+
-- | The comment to \'see
215+
-- https://downloads.haskell.org/~ghc/7.10.1/docs/html/libraries/ghc/src/Module.html#integerPackageKey\'
216216
-- appears to be out of date.
217217
--
218-
-- See 'Note [About units]' and 'Wired-in units' at
218+
-- See \'Note [About units]\' and \'Wired-in units\' at
219219
-- https://gitlab.haskell.org/ghc/ghc/-/blob/master/compiler/GHC/Unit.hs.
220220
--
221-
-- The 'wired-in packages' appear to have been replaced by those that have (e.g)
221+
-- The \'wired-in packages\' appear to have been replaced by those that have (e.g)
222222
--
223223
-- > ghc-options: -this-unit-id ghc-prim
224224
--
225-
-- in their Cabal file because they are 'magic'.
225+
-- in their Cabal file because they are \'magic\'.
226226
wiredInPackages :: Set PackageName
227227
wiredInPackages = case mparsed of
228228
Just parsed -> Set.fromList parsed
@@ -239,7 +239,7 @@ wiredInPackages = case mparsed of
239239
, "base"
240240
-- A magic package
241241
, "rts"
242-
-- Said to be not a 'real' package
242+
-- Said to be not a \'real\' package
243243
, "template-haskell"
244244
-- A magic package
245245
, "dph-seq"

0 commit comments

Comments
 (0)