diff --git a/CHANGELOG.md b/CHANGELOG.md index 28939116..1bda5206 100644 --- a/CHANGELOG.md +++ b/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) diff --git a/README.md b/README.md index cce1ef7e..86160290 100644 --- a/README.md +++ b/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` | | | diff --git a/generate-spdx-licenses-module.sh b/generate-spdx-licenses-module.sh new file mode 100755 index 00000000..64cfd22b --- /dev/null +++ b/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 ' ]' diff --git a/hpack.cabal b/hpack.cabal index 90fe59e1..330579b3 100644 --- a/hpack.cabal +++ b/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 diff --git a/package.yaml b/package.yaml index 02a94ce9..dc1e33d3 100644 --- a/package.yaml +++ b/package.yaml @@ -33,6 +33,7 @@ dependencies: - http-client - http-client-tls - vector + - text-metrics library: source-dirs: src diff --git a/spdx-licenses/BSD-2-Clause.txt b/spdx-licenses/BSD-2-Clause.txt new file mode 100644 index 00000000..c2e480ee --- /dev/null +++ b/spdx-licenses/BSD-2-Clause.txt @@ -0,0 +1,22 @@ +Copyright (c) . 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. diff --git a/spdx-licenses/BSD-3-Clause.txt b/spdx-licenses/BSD-3-Clause.txt new file mode 100644 index 00000000..b2a9c51f --- /dev/null +++ b/spdx-licenses/BSD-3-Clause.txt @@ -0,0 +1,26 @@ +Copyright (c) . 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. diff --git a/spdx-licenses/BSD-4-Clause.txt b/spdx-licenses/BSD-4-Clause.txt new file mode 100644 index 00000000..09c07fb1 --- /dev/null +++ b/spdx-licenses/BSD-4-Clause.txt @@ -0,0 +1,31 @@ +Copyright (c) . 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. diff --git a/spdx-licenses/MIT.txt b/spdx-licenses/MIT.txt new file mode 100644 index 00000000..f0fd20ab --- /dev/null +++ b/spdx-licenses/MIT.txt @@ -0,0 +1,20 @@ +MIT License + +Copyright (c) + +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. diff --git a/src/Hpack/Config.hs b/src/Hpack/Config.hs index 4a59903e..4189e812 100644 --- a/src/Hpack/Config.hs +++ b/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 diff --git a/src/Hpack/License.hs b/src/Hpack/License.hs index ad86cf5c..d842ab6c 100644 --- a/src/Hpack/License.hs +++ b/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) diff --git a/src/Hpack/SpdxLicenses.hs b/src/Hpack/SpdxLicenses.hs new file mode 100644 index 00000000..2f6e8be3 --- /dev/null +++ b/src/Hpack/SpdxLicenses.hs @@ -0,0 +1,118 @@ +-- DO NOT MODIFY MANUALLY +-- +-- This file has been generated with ./generate-spdx-licenses-module.sh. + +{-# LANGUAGE OverloadedStrings #-} +module Hpack.SpdxLicenses where +import Data.Text (Text) +import Distribution.SPDX.LicenseId +licenses :: [(LicenseId, Text)] +licenses = [ + (BSD_2_Clause, "\ +\Copyright (c) . All rights reserved.\n\ +\\n\ +\Redistribution and use in source and binary forms, with or without modification,\n\ +\are permitted provided that the following conditions are met:\n\ +\\n\ +\1. Redistributions of source code must retain the above copyright notice,\n\ +\this list of conditions and the following disclaimer.\n\ +\\n\ +\2. Redistributions in binary form must reproduce the above copyright notice,\n\ +\this list of conditions and the following disclaimer in the documentation\n\ +\and/or other materials provided with the distribution.\n\ +\\n\ +\THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS \"AS IS\"\n\ +\AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE\n\ +\IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE\n\ +\ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE\n\ +\LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL\n\ +\DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR\n\ +\SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER\n\ +\CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,\n\ +\OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE\n\ +\USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n\ +\") + , (BSD_3_Clause, "\ +\Copyright (c) . All rights reserved.\n\ +\\n\ +\Redistribution and use in source and binary forms, with or without modification,\n\ +\are permitted provided that the following conditions are met:\n\ +\\n\ +\1. Redistributions of source code must retain the above copyright notice,\n\ +\this list of conditions and the following disclaimer.\n\ +\\n\ +\2. Redistributions in binary form must reproduce the above copyright notice,\n\ +\this list of conditions and the following disclaimer in the documentation\n\ +\and/or other materials provided with the distribution.\n\ +\\n\ +\3. Neither the name of the copyright holder nor the names of its contributors\n\ +\may be used to endorse or promote products derived from this software without\n\ +\specific prior written permission.\n\ +\\n\ +\THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS \"AS IS\"\n\ +\AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE\n\ +\IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE\n\ +\ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE\n\ +\LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL\n\ +\DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR\n\ +\SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER\n\ +\CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,\n\ +\OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE\n\ +\USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.\n\ +\") + , (BSD_4_Clause, "\ +\Copyright (c) . All rights reserved.\n\ +\\n\ +\Redistribution and use in source and binary forms, with or without modification,\n\ +\are permitted provided that the following conditions are met:\n\ +\\n\ +\1. Redistributions of source code must retain the above copyright notice,\n\ +\this list of conditions and the following disclaimer.\n\ +\\n\ +\2. Redistributions in binary form must reproduce the above copyright notice,\n\ +\this list of conditions and the following disclaimer in the documentation\n\ +\and/or other materials provided with the distribution.\n\ +\\n\ +\3. All advertising materials mentioning features or use of this software must\n\ +\display the following acknowledgement:\n\ +\\n\ +\ This product includes software developed by the organization .\n\ +\\n\ +\4. Neither the name of the copyright holder nor the names of its contributors\n\ +\may be used to endorse or promote products derived from this software without\n\ +\specific prior written permission.\n\ +\\n\ +\THIS SOFTWARE IS PROVIDED BY COPYRIGHT HOLDER \"AS IS\" AND ANY EXPRESS OR IMPLIED\n\ +\WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY\n\ +\AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL COPYRIGHT\n\ +\HOLDER BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,\n\ +\OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE\n\ +\GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)\n\ +\HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT\n\ +\LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY\n\ +\OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH\n\ +\DAMAGE.\n\ +\") + , (MIT, "\ +\MIT License\n\ +\\n\ +\Copyright (c) \n\ +\\n\ +\Permission is hereby granted, free of charge, to any person obtaining a copy\n\ +\of this software and associated documentation files (the \"Software\"), to deal\n\ +\in the Software without restriction, including without limitation the rights\n\ +\to use, copy, modify, merge, publish, distribute, sublicense, and/or sell\n\ +\copies of the Software, and to permit persons to whom the Software is furnished\n\ +\to do so, subject to the following conditions:\n\ +\\n\ +\The above copyright notice and this permission notice shall be included in\n\ +\all copies or substantial portions of the Software.\n\ +\\n\ +\THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR\n\ +\IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS\n\ +\FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS\n\ +\OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,\n\ +\WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF\n\ +\OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.\n\ +\") + ] diff --git a/test/EndToEndSpec.hs b/test/EndToEndSpec.hs index 04e17e22..86bf448e 100644 --- a/test/EndToEndSpec.hs +++ b/test/EndToEndSpec.hs @@ -351,6 +351,30 @@ spec = around_ (inTempDirectoryNamed "foo") $ do default-language: Haskell2010 |]) {packageCabalVersion = "2.2"} + context "with a LICENSE file" $ do + before_ (writeFile "LICENSE" license) $ do + it "infers license" $ do + [i| + |] `shouldRenderTo` (package [i| + license-file: LICENSE + license: MIT + |]) + + context "when license can not be inferred" $ do + it "warns" $ do + writeFile "LICENSE" "some-licenese" + [i| + name: foo + |] `shouldWarn` ["Inferring license from file LICENSE failed!"] + + context "when license is null" $ do + it "does not infer license" $ do + [i| + license: null + |] `shouldRenderTo` (package [i| + license-file: LICENSE + |]) + describe "build-type" $ do it "accept Simple" $ do [i| @@ -1411,3 +1435,26 @@ build-type: #{packageBuildType} indentBy :: Int -> String -> String indentBy n = unlines . map (replicate n ' ' ++) . lines + +license :: String +license = [i| +Copyright (c) 2014-2018 Simon Hengel + +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. +|] diff --git a/test/Hpack/LicenseSpec.hs b/test/Hpack/LicenseSpec.hs index ce6cb1aa..8a212a16 100644 --- a/test/Hpack/LicenseSpec.hs +++ b/test/Hpack/LicenseSpec.hs @@ -61,3 +61,19 @@ spec = do forM_ (cabalLicenses ++ spdxLicenses ++ unknownLicenses) $ \ (license, expected) -> do it [i|parses #{license}|] $ do prettyShow <$> parseLicense license `shouldBe` expected + + describe "inferLicense" $ do + it "infers MIT" $ do + inferLicense <$> readFile "test/resources/mit" `shouldReturn` Just (CanSPDX Cabal.MIT "MIT") + + it "infers BSD-2-Clause" $ do + inferLicense <$> readFile "test/resources/bsd2" `shouldReturn` Just (CanSPDX Cabal.BSD2 "BSD-2-Clause") + + it "infers BSD-3-Clause" $ do + inferLicense <$> readFile "test/resources/bsd3" `shouldReturn` Just (CanSPDX Cabal.BSD3 "BSD-3-Clause") + + it "infers BSD-4-Clause" $ do + inferLicense <$> readFile "test/resources/bsd4" `shouldReturn` Just (CanSPDX Cabal.BSD4 "BSD-4-Clause") + + it "rejects unknown licenses" $ do + inferLicense "unknown" `shouldBe` Nothing diff --git a/test/resources/bsd2 b/test/resources/bsd2 new file mode 100644 index 00000000..322d5fcd --- /dev/null +++ b/test/resources/bsd2 @@ -0,0 +1,22 @@ +Copyright (c) 2014-2018, Simon Hengel +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 OWNER 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. diff --git a/test/resources/bsd3 b/test/resources/bsd3 new file mode 100644 index 00000000..c3d49b0c --- /dev/null +++ b/test/resources/bsd3 @@ -0,0 +1,24 @@ +Copyright (c) 2014-2018, Simon Hengel +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + * 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. + * Neither the name of the 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 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. diff --git a/test/resources/bsd4 b/test/resources/bsd4 new file mode 100644 index 00000000..7906c787 --- /dev/null +++ b/test/resources/bsd4 @@ -0,0 +1,27 @@ +Copyright (c) 2014-2018, Simon Hengel +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 . +4. Neither the name of the 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 ''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 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. diff --git a/test/resources/mit b/test/resources/mit new file mode 100644 index 00000000..01f3eb38 --- /dev/null +++ b/test/resources/mit @@ -0,0 +1,19 @@ +Copyright (c) 2014-2018 Simon Hengel + +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.