1{-# LANGUAGE DeriveFunctor #-} 2{-# LANGUAGE ViewPatterns #-} 3module Data.License.Infer ( 4 License(..) 5, inferLicense 6) where 7 8import Control.Applicative 9import Control.Monad 10import Data.Foldable 11import Data.Char 12import Data.List 13import Data.Ord (comparing) 14import Data.Text (Text) 15import qualified Data.Text as T 16import Data.Text.Metrics 17 18import Data.License.SpdxLicenses (licenses) 19import Data.License.Type 20 21inferLicense :: String -> Maybe License 22inferLicense xs = inferLicenseByName xs <|> inferLicenseByLevenshtein xs 23 24inferLicenseByName :: String -> Maybe License 25inferLicenseByName (normalize -> xs) = asum $ map (matchName xs) licenseNames 26 27matchName :: String -> (License, String) -> Maybe License 28matchName xs (license, name) = license <$ guard (isPrefixOf name xs) 29 30licenseNames :: [(License, String)] 31licenseNames = map (fmap normalize) [ 32 (GPLv2, "GNU GENERAL PUBLIC LICENSE Version 2, June 1991") 33 , (GPLv3, "GNU GENERAL PUBLIC LICENSE Version 3, 29 June 2007") 34 , (LGPLv2_1, "GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999") 35 , (LGPLv3, "GNU LESSER GENERAL PUBLIC LICENSE Version 3, 29 June 2007") 36 , (AGPLv3, "GNU AFFERO GENERAL PUBLIC LICENSE Version 3, 19 November 2007") 37 , (MPL_2_0, "Mozilla Public License Version 2.0") 38 , (Apache_2_0, "Apache License Version 2.0, January 2004") 39 ] 40 41normalize :: String -> String 42normalize = map toLower . filter isAlphaNum 43 44inferLicenseByLevenshtein :: String -> Maybe License 45inferLicenseByLevenshtein (T.pack -> xs) 46 | T.length xs > 2000 = Nothing 47 | otherwise = case maximumBy (comparing snd) (probabilities xs) of 48 (license, n) | n > 0.85 -> Just license 49 _ -> Nothing 50 51probabilities :: Text -> [(License, Double)] 52probabilities license = map (fmap probability) licenses 53 where 54 probability = realToFrac . levenshteinNorm license 55