Infer license from license-file

CHANGELOG.md

@@ -1,3 +1,6 @@
+## Changes in next
+ - Infer `license` from `license-file`
+
 ## Changes in 0.29.0
  - Put the `cabal-version` at the beginning of the generated file. This Is
  required with `cabal-version: 2.1` and higher. (see #292)

README.md

@@ -59,7 +59,7 @@ at the Singapore Haskell meetup: http://typeful.net/talks/hpack
 | `author` | · | | May be a list | | |
 | `maintainer` | · | | May be a list | | |
 | `copyright` | · | | May be a list | |
-| `license` | · | | Both [SPDX license expressions](https://spdx.org/licenses/) and traditional Cabal license identifiers are accepted. | `license: MIT` | SPDX: `0.29.0` |
+| `license` | · | Inferred from `license-file` | Both [SPDX license expressions](https://spdx.org/licenses/) and traditional Cabal license identifiers are accepted. | `license: MIT` | SPDX: `0.29.0` |
 | `license-file` | `license-file` or `license-files` | `LICENSE` if file exists | May be a list | | |
 | `tested-with` | · | | | | |
 | `build-type` | · | `Simple`, or `Custom` if `custom-setup` exists | Must be `Simple`, `Configure`, `Make`, or `Custom` | | |

generate-spdx-licenses-module.sh

@@ -0,0 +1,34 @@
+#!/bin/bash
+
+set -o nounset
+set -o errexit
+
+exec > "src/Hpack/SpdxLicenses.hs"
+
+echo '-- DO NOT MODIFY MANUALLY'
+echo '--'
+echo "-- This file has been generated with $0."
+echo
+echo '{-# LANGUAGE OverloadedStrings #-}'
+echo 'module Hpack.SpdxLicenses where'
+echo 'import Data.Text (Text)'
+echo 'import Distribution.SPDX.LicenseId'
+
+first=true
+
+echo 'licenses :: [(LicenseId, Text)]'
+echo 'licenses = ['
+for license in spdx-licenses/*.txt; do
+ file=$(basename "$license")
+ license_id=${file%.*}
+ license_id_constructor=${license_id//-/_}
+ $first && echo -n " " || echo -n " , "
+ first=false
+ echo -n "($license_id_constructor, "
+ echo '"\'
+ while IFS='' read -r line || [[ -n "$line" ]]; do
+ echo "\\${line//\"/\\\"}\\n\\"
+ done < $license
+ echo '\")'
+done
+echo ' ]'

hpack.cabal

@@ -4,7 +4,7 @@ cabal-version: >= 1.10
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: cfd597be64fbc0242e6c338653cce17e853d1ce5843d07785f81ce0f208ee198
+-- hash: 52521e0c9125c323c9fdaa2ef38926da5951af604045f54174992bc7f3cfb66b
 
 name: hpack
 version: 0.29.0
@@ -46,6 +46,7 @@ library
  , pretty
  , scientific
  , text
+ , text-metrics
  , transformers
  , unordered-containers
  , vector
@@ -67,6 +68,7 @@ library
  Hpack.Options
  Hpack.Render.Dsl
  Hpack.Render.Hints
+ Hpack.SpdxLicenses
  Hpack.Syntax.Defaults
  Hpack.Syntax.Dependency
  Hpack.Syntax.Git
@@ -99,6 +101,7 @@ executable hpack
  , pretty
  , scientific
  , text
+ , text-metrics
  , transformers
  , unordered-containers
  , vector
@@ -140,6 +143,7 @@ test-suite spec
  , template-haskell
  , temporary
  , text
+ , text-metrics
  , transformers
  , unordered-containers
  , vector
@@ -179,6 +183,7 @@ test-suite spec
  Hpack.Render
  Hpack.Render.Dsl
  Hpack.Render.Hints
+ Hpack.SpdxLicenses
  Hpack.Syntax.Defaults
  Hpack.Syntax.Dependency
  Hpack.Syntax.Git

package.yaml

@@ -33,6 +33,7 @@ dependencies:
  - http-client
  - http-client-tls
  - vector
+ - text-metrics
 
 library:
  source-dirs: src

spdx-licenses/BSD-2-Clause.txt

@@ -0,0 +1,22 @@
+Copyright (c) <year> <owner> . All rights reserved.
+
+Redistribution and use in source and binary forms, with or without modification,
+are permitted provided that the following conditions are met:
+
+1. Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
+USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

spdx-licenses/BSD-3-Clause.txt

@@ -0,0 +1,26 @@
+Copyright (c) <year> <owner> . All rights reserved.
+
+Redistribution and use in source and binary forms, with or without modification,
+are permitted provided that the following conditions are met:
+
+1. Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.
+
+3. Neither the name of the copyright holder nor the names of its contributors
+may be used to endorse or promote products derived from this software without
+specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
+USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

spdx-licenses/BSD-4-Clause.txt

@@ -0,0 +1,31 @@
+Copyright (c) <year> <owner> . All rights reserved.
+
+Redistribution and use in source and binary forms, with or without modification,
+are permitted provided that the following conditions are met:
+
+1. Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.
+
+3. All advertising materials mentioning features or use of this software must
+display the following acknowledgement:
+
+ This product includes software developed by the organization .
+
+4. Neither the name of the copyright holder nor the names of its contributors
+may be used to endorse or promote products derived from this software without
+specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY COPYRIGHT HOLDER "AS IS" AND ANY EXPRESS OR IMPLIED
+WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL COPYRIGHT
+HOLDER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
+OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
+DAMAGE.

spdx-licenses/MIT.txt

@@ -0,0 +1,20 @@
+MIT License
+
+Copyright (c) <year> <copyright holders>
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is furnished
+to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
+FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS
+OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF
+OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

src/Hpack/Config.hs

@@ -504,7 +504,7 @@ data PackageConfig_ library executable = PackageConfig {
 , packageConfigMaintainer :: Maybe (List String)
 , packageConfigCopyright :: Maybe (List String)
 , packageConfigBuildType :: Maybe BuildType
-, packageConfigLicense :: Maybe String
+, packageConfigLicense :: Maybe (Maybe String)
 , packageConfigLicenseFile :: Maybe (List String)
 , packageConfigTestedWith :: Maybe String
 , packageConfigFlags :: Maybe (Map String FlagSection)
@@ -580,8 +580,8 @@ readPackageConfig (DecodeOptions file mUserDataDir readValue) = runExceptT $ fma
  userDataDir <- liftIO $ maybe (getAppUserDataDirectory "hpack") return mUserDataDir
  toPackage userDataDir dir config
  where
- addCabalFile :: (Package, [String]) -> DecodeResult
- addCabalFile (pkg, warnings) = uncurry DecodeResult (cabalVersion pkg) (takeDirectory_ file </> (packageName pkg ++ ".cabal")) warnings
+ addCabalFile :: ((Package, String), [String]) -> DecodeResult
+ addCabalFile ((pkg, cabalVersion), warnings) = DecodeResult pkg cabalVersion (takeDirectory_ file </> (packageName pkg ++ ".cabal")) warnings
 
  takeDirectory_ :: FilePath -> FilePath
  takeDirectory_ p
@@ -600,15 +600,17 @@ verbatimValueToString = \ case
  VerbatimBool b -> show b
  VerbatimNull -> ""
 
-cabalVersion :: Package -> (Package, String)
-cabalVersion pkg@Package{..} = (
+determineCabalVersion :: Maybe (License String) -> Package -> (Package, String)
+determineCabalVersion inferredLicense pkg@Package{..} = (
  pkg {
  packageVerbatim = deleteVerbatimField "cabal-version" packageVerbatim
- , packageLicense = formatLicense <$> parsedLicense
+ , packageLicense = formatLicense <$> license
  }
  , "cabal-version: " ++ fromMaybe inferredCabalVersion verbatimCabalVersion ++ "\n\n"
  )
  where
+ license = parsedLicense <|> inferredLicense
+
  parsedLicense = fmap prettyShow . parseLicense <$> packageLicense
 
  formatLicense = \ case
@@ -618,7 +620,7 @@ cabalVersion pkg@Package{..} = (
  DontTouch original -> original
 
  mustSPDX :: Bool
- mustSPDX = maybe False f parsedLicense
+ mustSPDX = maybe False f license
  where
  f = \case
  DontTouch _ -> False
@@ -827,7 +829,7 @@ type ConfigWithDefaults = Product
 type CommonOptionsWithDefaults a = Product DefaultsConfig (CommonOptions ParseCSources ParseCxxSources ParseJsSources a)
 type WithCommonOptionsWithDefaults a = Product DefaultsConfig (WithCommonOptions ParseCSources ParseCxxSources ParseJsSources a)
 
-toPackage :: FilePath -> FilePath -> ConfigWithDefaults -> Warnings (Errors IO) Package
+toPackage :: FilePath -> FilePath -> ConfigWithDefaults -> Warnings (Errors IO) (Package, String)
 toPackage userDataDir dir =
  expandDefaultsInConfig userDataDir dir
  >=> traverseConfig (expandForeignSources dir)
@@ -916,7 +918,7 @@ toExecutableMap name executables mExecutable = do
 
 type GlobalOptions = CommonOptions CSources CxxSources JsSources Empty
 
-toPackage_ :: MonadIO m => FilePath -> Product GlobalOptions (PackageConfig CSources CxxSources JsSources) -> Warnings m Package
+toPackage_ :: MonadIO m => FilePath -> Product GlobalOptions (PackageConfig CSources CxxSources JsSources) -> Warnings m (Package, String)
 toPackage_ dir (Product g PackageConfig{..}) = do
  let
  globalVerbatim = commonOptionsVerbatim g
@@ -949,14 +951,25 @@ toPackage_ dir (Product g PackageConfig{..}) = do
 
  dataFiles <- expandGlobs "data-files" dataBaseDir (fromMaybeList packageConfigDataFiles)
 
+ let
+ licenseFiles :: [String]
+ licenseFiles = fromMaybeList $ packageConfigLicenseFile <|> do
+ guard licenseFileExists
+ Just (List ["LICENSE"])
+
+ inferredLicense <- case (packageConfigLicense, licenseFiles) of
+ (Nothing, [file]) -> do
+ input <- liftIO (tryReadFile (dir </> file))
+ case input >>= inferLicense of
+ Nothing -> do
+ tell ["Inferring license from file " ++ file ++ " failed!"]
+ return Nothing
+ license -> return license
+ _ -> return Nothing
+
  let defaultBuildType :: BuildType
  defaultBuildType = maybe Simple (const Custom) mCustomSetup
 
- configLicenseFiles :: Maybe (List String)
- configLicenseFiles = packageConfigLicenseFile <|> do
- guard licenseFileExists
- Just (List ["LICENSE"])
-
  pkg = Package {
  packageName = packageName_
  , packageVersion = maybe "0.0.0" unPackageVersion packageConfigVersion
@@ -970,8 +983,8 @@ toPackage_ dir (Product g PackageConfig{..}) = do
  , packageMaintainer = fromMaybeList packageConfigMaintainer
  , packageCopyright = fromMaybeList packageConfigCopyright
  , packageBuildType = fromMaybe defaultBuildType packageConfigBuildType
- , packageLicense = packageConfigLicense
- , packageLicenseFile = fromMaybeList configLicenseFiles
+ , packageLicense = join packageConfigLicense
+ , packageLicenseFile = licenseFiles
  , packageTestedWith = packageConfigTestedWith
  , packageFlags = flags
  , packageExtraSourceFiles = extraSourceFiles
@@ -990,7 +1003,7 @@ toPackage_ dir (Product g PackageConfig{..}) = do
 
  tell nameWarnings
  tell (formatMissingSourceDirs missingSourceDirs)
- return pkg
+ return (determineCabalVersion inferredLicense pkg)
  where
  nameWarnings :: [String]
  packageName_ :: String

src/Hpack/License.hs

@@ -1,13 +1,22 @@
 {-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE ViewPatterns #-}
 module Hpack.License where
 
 import Control.Arrow ((&&&))
+import Data.List
+import Data.Ord (comparing)
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Metrics
 
 import Distribution.Pretty (prettyShow)
 import qualified Distribution.License as Cabal
 import qualified Distribution.SPDX.License as SPDX
+import Distribution.SPDX.LicenseId
 import Distribution.Parsec.Class (eitherParsec)
 
+import Hpack.SpdxLicenses (licenses)
+
 data License a = DontTouch String | CanSPDX Cabal.License a | MustSPDX a
  deriving (Eq, Show, Functor)
 
@@ -23,3 +32,22 @@ parseLicense license = case lookup license knownLicenses of
 
  spdxLicense :: Maybe SPDX.License
  spdxLicense = either (const Nothing) Just (eitherParsec license)
+
+probabilities :: Text -> [(LicenseId, Double)]
+probabilities license = map (fmap probability) licenses
+ where
+ probability = realToFrac . levenshteinNorm license
+
+inferLicense :: String -> Maybe (License String)
+inferLicense (T.pack -> xs) = case maximumBy (comparing snd) (probabilities xs) of
+ (license, n) | n > 0.85 -> Just (toLicense license)
+ _ -> Nothing
+ where
+ toLicense :: LicenseId -> License String
+ toLicense license = (case license of
+ MIT -> CanSPDX Cabal.MIT
+ BSD_2_Clause -> CanSPDX Cabal.BSD2
+ BSD_3_Clause -> CanSPDX Cabal.BSD3
+ BSD_4_Clause -> CanSPDX Cabal.BSD4
+ _ -> MustSPDX
+ ) (licenseId license)