diff --git a/src/Main.hs b/src/Main.hs index eaf15c8..fc6bcc6 100644 --- a/src/Main.hs +++ b/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