Switch to named field puns and pure
This commit is contained in:
parent
4473ab4341
commit
3f72d89232
@ -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
|
||||||
|
|||||||
@ -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)
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user