@@ -1,10 +1,14 @@
11{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE RecordWildCards #-}
23
34module ErrorsWarnings where
45
6+import Control.Applicative ((<$>))
57import Data.Aeson.BetterErrors
68import Data.Version
79import Data.Maybe
10+import Data.Monoid
11+import Data.Foldable (foldMap)
812import Data.List (intersperse)
913import Data.List.NonEmpty (NonEmpty(..))
1014import qualified Data.List.NonEmpty as NonEmpty
@@ -31,6 +35,7 @@ data PackageError
3135data PackageWarning
3236 = ResolutionNotVersion PackageName
3337 | UndeclaredDependency PackageName
38+ | UnacceptableVersion (PackageName, String)
3439 deriving (Show)
3540
3641-- | An error that should be fixed by the user.
@@ -247,32 +252,39 @@ displayOtherError e = case e of
247252 successivelyIndented
248253 [ "An IO exception occurred:", show exc ]
249254
250−renderWarnings :: [PackageWarning] -> Box
251−renderWarnings =
252− collectWarnings
253− [ (getResolutionNotVersion, warnResolutionNotVersions)
254− , (getUndeclaredDependency, warnUndeclaredDependencies)
255− ]
256− where
257− collectWarnings patterns warns =
258− let boxes = mapMaybe (collectWarnings' warns) patterns
259− result = vcat
260− [ para "Warnings:"
261− , indented (vcat (intersperse spacer boxes))
262− ]
263− in if null boxes then nullBox else result
255+data CollectedWarnings = CollectedWarnings
256+ { resolutionNotVersions :: [PackageName]
257+ , undeclaredDependencies :: [PackageName]
258+ , unacceptableVersions :: [(PackageName, String)]
259+ }
260+ deriving (Show, Eq, Ord)
264261
265− getResolutionNotVersion (ResolutionNotVersion n) = Just n
266− getResolutionNotVersion _ = Nothing
262+instance Monoid CollectedWarnings where
263+ mempty = CollectedWarnings mempty mempty mempty
264+ mappend (CollectedWarnings as bs cs) (CollectedWarnings as' bs' cs') =
265+ CollectedWarnings (as <> as') (bs <> bs') (cs <> cs')
267266
268− getUndeclaredDependency (UndeclaredDependency n) = Just n
269− getUndeclaredDependency _ = Nothing
267+collectWarnings :: [PackageWarning] -> CollectedWarnings
268+collectWarnings = foldMap singular
269+ where
270+ singular w = case w of
271+ ResolutionNotVersion pn -> CollectedWarnings [pn] [] []
272+ UndeclaredDependency pn -> CollectedWarnings [] [pn] []
273+ UnacceptableVersion t -> CollectedWarnings [] [] [t]
270274
271−collectWarnings' :: [PackageWarning] -> ((PackageWarning -> Maybe a), (NonEmpty a -> Box)) -> Maybe Box
272−collectWarnings' warns (pattern, render) =
273− case mapMaybe pattern warns of
274− [] -> Nothing
275− (x:xs) -> Just (render (x :| xs))
275+renderWarnings :: [PackageWarning] -> Box
276+renderWarnings warns =
277+ let CollectedWarnings{..} = collectWarnings warns
278+ go toBox warns' = toBox <$> NonEmpty.nonEmpty warns'
279+ mboxes = [ go warnResolutionNotVersions resolutionNotVersions
280+ , go warnUndeclaredDependencies undeclaredDependencies
281+ , go warnUnacceptableVersions unacceptableVersions
282+ ]
283+ in case catMaybes mboxes of
284+ [] -> nullBox
285+ boxes -> vcat [ para "Warnings:"
286+ , indented (vcat (intersperse spacer boxes))
287+ ]
276288
277289warnResolutionNotVersions :: NonEmpty PackageName -> Box
278290warnResolutionNotVersions pkgNames =
@@ -314,5 +326,34 @@ warnUndeclaredDependencies pkgNames =
314326 ] ++
315327 bulletedList runPackageName (NonEmpty.toList pkgNames)
316328
329+warnUnacceptableVersions :: NonEmpty (PackageName, String) -> Box
330+warnUnacceptableVersions pkgs =
331+ let singular = NonEmpty.length pkgs == 1
332+ pl a b = if singular then b else a
333+
334+ packages' = pl "packages'" "package's"
335+ packages = pl "packages" "package"
336+ anyOfThese = pl "any of these" "this"
337+ these = pl "these" "this"
338+ versions = pl "versions" "version"
339+ in vcat $
340+ [ para (concat
341+ [ "The following installed Bower ", packages', " ", versions, " could "
342+ , "not be parsed:"
343+ ])
344+ ] ++
345+ bulletedList showTuple (NonEmpty.toList pkgs)
346+ ++
347+ [ spacer
348+ , para (concat
349+ ["Links to types in ", anyOfThese, " ", packages, " will not work. In "
350+ , "order to make links work, edit your bower.json to specify an "
351+ , "acceptable version or version range for ", these, " ", packages, ", "
352+ , "and rerun `bower install`."
353+ ])
354+ ]
355+ where
356+ showTuple (pkgName, tag) = runPackageName pkgName ++ "#" ++ tag
357+
317358printWarnings :: [PackageWarning] -> IO ()
318359printWarnings = printToStderr . renderWarnings