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