Switch to named field puns and pure

This commit is contained in:
Juan Pedro Villa Isaza 2020-02-16 17:55:08 -05:00
parent 4473ab4341
commit 3f72d89232
2 changed files with 25 additions and 27 deletions

View File

@ -1,5 +1,5 @@
{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NamedFieldPuns #-}
---------------------------------------------------------------------- ----------------------------------------------------------------------
-- | -- |
@ -86,11 +86,11 @@ main = do
if stack if stack
then do then do
putStrLn "Found stack.yaml..." putStrLn "Found stack.yaml..."
return Nothing pure Nothing
else else
Exit.die "Error: No Cabal file found." Exit.die "Error: No Cabal file found."
Just PackageDescription{..} -> do Just PackageDescription { license, package } -> do
putStrLn $ putStrLn $
"Package: " "Package: "
<> display package <> display package
@ -98,7 +98,7 @@ main = do
<> "License: " <> "License: "
<> display license <> display license
<> ")" <> ")"
return (Just package) pure (Just package)
maybeDependencies <- getDependencies maybeDependencies <- getDependencies
maybeLicenses <- getLicenses maybeLicenses <- getLicenses

View File

@ -1,5 +1,4 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
---------------------------------------------------------------------- ----------------------------------------------------------------------
@ -28,13 +27,13 @@ import Control.Monad (unless)
import Data.Version (Version) import Data.Version (Version)
-- Cabal -- Cabal
import Distribution.License import Distribution.License (License)
import Distribution.Package import Distribution.Package (PackageIdentifier(..), PackageName)
import Distribution.PackageDescription import Distribution.PackageDescription (PackageDescription, packageDescription)
import Distribution.PackageDescription.Parse import Distribution.PackageDescription.Parse (readGenericPackageDescription)
import Distribution.Simple.Utils import Distribution.Simple.Utils (comparing, findPackageDesc)
import Distribution.Text import Distribution.Text (Text, display, simpleParse)
import Distribution.Verbosity import Distribution.Verbosity (silent)
-- containers -- containers
import Data.Map.Strict (Map) import Data.Map.Strict (Map)
@ -43,13 +42,13 @@ import Data.Set (Set)
import qualified Data.Set as Set import qualified Data.Set as Set
-- directory -- directory
import System.Directory import System.Directory (getCurrentDirectory)
-- licensor -- licensor
import qualified Paths_licensor import qualified Paths_licensor
-- process -- process
import System.Process import System.Process (readProcess)
-- | -- |
@ -89,7 +88,7 @@ getPackage :: IO (Maybe PackageDescription)
getPackage = do getPackage = do
currentDirectory <- getCurrentDirectory currentDirectory <- getCurrentDirectory
fmap getPackageDescription <$> findPackageDesc currentDirectory fmap getPackageDescription <$> findPackageDesc currentDirectory
>>= either (const (return Nothing)) (fmap Just) >>= either (const (pure Nothing)) (fmap Just)
-- | -- |
@ -98,7 +97,7 @@ getPackage = do
getPackageDescription :: FilePath -> IO PackageDescription getPackageDescription :: FilePath -> IO PackageDescription
getPackageDescription = getPackageDescription =
fmap packageDescription . readPackageDescription silent fmap packageDescription . readGenericPackageDescription silent
-- | -- |
@ -112,10 +111,10 @@ getDependencies = do
case eitherDeps of case eitherDeps of
Left (_ :: IOError) -> Left (_ :: IOError) ->
return Nothing pure Nothing
Right deps -> Right deps ->
return $ Set.fromList <$> traverse simpleParse (lines deps) pure $ Set.fromList <$> traverse simpleParse (lines deps)
getLicenses :: IO (Maybe [(PackageName, License)]) getLicenses :: IO (Maybe [(PackageName, License)])
@ -125,10 +124,10 @@ getLicenses = do
case eitherDeps of case eitherDeps of
Left (_ :: IOError) -> Left (_ :: IOError) ->
return Nothing pure Nothing
Right deps -> Right deps ->
return $ traverse toNameLicense (lines deps) pure $ traverse toNameLicense (lines deps)
where where
toNameLicense dep = toNameLicense dep =
case words dep of case words dep of
@ -148,15 +147,14 @@ getPackageLicense
-> PackageIdentifier -> PackageIdentifier
-> [(PackageName, License)] -> [(PackageName, License)]
-> IO (Maybe LiLicense) -> IO (Maybe LiLicense)
getPackageLicense quiet p@PackageIdentifier{..} licenses = do getPackageLicense quiet packageIdentifier licenses = do
unless quiet (putStr $ display p ++ "...") unless quiet (putStr $ display packageIdentifier ++ "...")
case lookup pkgName licenses of case lookup (pkgName packageIdentifier) licenses of
Just license -> do Just license -> do
unless quiet (putStrLn $ display license) unless quiet (putStrLn $ display license)
return $ Just (LiLicense license) pure $ Just (LiLicense license)
Nothing -> Nothing ->
return Nothing pure Nothing
-- PackageDescription{license} <- getPackageDescription file
-- | -- |
@ -178,7 +176,7 @@ orderPackagesByLicense quiet maybeP licenses =
maybeLicense <- getPackageLicense quiet package licenses maybeLicense <- getPackageLicense quiet package licenses
(orderedPackages, failed) <- orderedPackages' (orderedPackages, failed) <- orderedPackages'
return $ pure $
if cond package if cond package
then then
(orderedPackages, failed) (orderedPackages, failed)