Improve user directory handling

src/Main.hs

@@ -78,8 +78,8 @@ userLicenseDir = userHomeDir <&> (++ defaultUserLicenseRelDir)
 
 writeLicense :: String -> SearchMode -> String -> IO ()
 writeLicense outfile sm name = do
-    paths <- searchPathList sm
-    content <- try (readLicense paths) :: IO (Either IOError String)
+    content <-
+        searchPathList sm >>= (try . readLicense) :: IO (Either IOError String)
     case content of
         Left e -> printReadError e
         Right text -> catch (writeFile outfile text) printWriteError
@@ -142,24 +142,33 @@ printHelp = do
 
 listLicenses :: IO ()
 listLicenses = do
-    hadSystem <- printLicenseDir "System" defaultSystemLicenseDir
     homeDir <- userLicenseDir
-    hadUser <- printLicenseDir "User" homeDir
-    unless (hadSystem || hadUser) $
+    (userFound, userFiles) <- printLicenseDir "User" homeDir []
+    unless (null userFiles) $ putStrLn ""
+    (systemFound, _) <- printLicenseDir "System" defaultSystemLicenseDir userFiles
+    unless (userFound || systemFound) $
         do
-            hPutStrLn stderr "Unable to read both system and user license dir"
+            hPutStrLn stderr "Unable to read both system and user license directory."
             hPutStrLn stderr $ "System: " ++ show defaultSystemLicenseDir
             hPutStrLn stderr $ "User: " ++ show homeDir
   where
-    printLicenseDir :: String -> String -> IO Bool
-    printLicenseDir name dir = do
+    -- Return the list of licenses found
+    printLicenseDir :: String -> String -> [String] -> IO (Bool, [String])
+    printLicenseDir name dir overriden = do
         res <- try (listDirectory dir) :: IO (Either IOError [String])
         case res of
             Right files -> do
-                putStrLn $ name ++ " license dir:"
-                mapM_ (putStrLn . (" - " ++)) files
-                return True
-            Left _ -> return False
+                unless (null files) $ putStrLn $ name ++ " licenses:"
+                mapM_
+                    ( \f ->
+                        putStrLn $
+                            if f `elem` overriden
+                                then " - " ++ f ++ " [overriden]"
+                                else " - " ++ f
+                    )
+                    files
+                return (True, files)
+            Left _ -> return (False, [])
 
 handleArgError :: String -> IO ()
 handleArgError msg = hPutStrLn stderr $ "error: " ++ msg