Add a report of errors

Main.hs

@@ -95,8 +95,10 @@ main = do
       Exit.die "Error: ..."
 
     Just dependencies -> do
-      dependenciesByLicense <-
+      (dependenciesByLicense', failed) <-
-        fmap (Set.map display) <$> orderPackagesByLicense pid dependencies
+        orderPackagesByLicense pid dependencies
+
+      let dependenciesByLicense = fmap (Set.map display) dependenciesByLicense'
 
       forM_ (Map.keys dependenciesByLicense) $
         \license ->
@@ -111,3 +113,7 @@ main = do
                 <> display license
                 <> ": "
                 <> intercalate ", " (Set.toList n)
+
+      unless (null failed) $ do
+        putStr "Failed: "
+        print failed

src/Licensor.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 ----------------------------------------------------------------------
 -- |
@@ -22,6 +23,7 @@ module Licensor
   where
 
 -- base
+import qualified Control.Exception as Exception
 import Data.Monoid ((<>))
 import Data.Version (Version)
 import System.IO
@@ -121,8 +123,9 @@ getDependencies =
 --
 --
 
-getPackageLicense :: PackageIdentifier -> IO LiLicense
+getPackageLicense :: PackageIdentifier -> IO (Maybe LiLicense)
 getPackageLicense p@PackageIdentifier{..} = do
+  putStr $ display p ++ "..."
   let
     url =
       "GET https://hackage.haskell.org/package/"
@@ -132,7 +135,13 @@ getPackageLicense p@PackageIdentifier{..} = do
         <> ".cabal"
 
   req <- parseRequest url
-  pd <- fmap getResponseBody (httpLBS req)
+  eitherPd <- Exception.try $ fmap getResponseBody (httpLBS req)
+
+  case eitherPd of
+    Left (_ :: HttpException) ->
+      return Nothing
+
+    Right pd -> do
 
       (file, handle) <- openTempFile "/tmp" "licensor"
       hClose handle
@@ -140,7 +149,10 @@ getPackageLicense p@PackageIdentifier{..} = do
       PackageDescription{license} <- getPackageDescription file
       hClose handle
       removeFile file
-  return (LiLicense license)
+
+      putStrLn $ display license
+
+      return $ Just (LiLicense license)
 
 
 -- |
@@ -150,24 +162,33 @@ getPackageLicense p@PackageIdentifier{..} = do
 orderPackagesByLicense
   :: PackageIdentifier
   -> Set PackageIdentifier
-  -> IO (Map LiLicense (Set PackageIdentifier))
+  -> IO (Map LiLicense (Set PackageIdentifier), Set PackageIdentifier)
 orderPackagesByLicense p =
   let
     insertPackage package orderedPackages' = do
-      license <- getPackageLicense package
+      maybeLicense <- getPackageLicense package
-      orderedPackages <- orderedPackages'
+
+      (orderedPackages, failed) <- orderedPackages'
       return $
         if p == package
           then
-            orderedPackages
+            (orderedPackages, failed)
           else
-            Map.insertWith
+            case maybeLicense of
+              Nothing ->
+                ( orderedPackages, Set.insert package failed
+                )
+
+              Just license ->
+                ( Map.insertWith
                     Set.union
                     license
                     (Set.singleton package)
                     orderedPackages
+                , failed
+                )
   in
-    foldr insertPackage (pure mempty)
+    foldr insertPackage (pure (mempty, mempty))
 
 
 -- |