{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ViewPatterns #-}
module Data.License.Infer (
  License(..)
, inferLicense
) where

import           Control.Applicative
import           Control.Monad
import           Data.Foldable
import           Data.Char
import           Data.List
import           Data.Ord (comparing)
import           Data.Text (Text)
import qualified Data.Text as T
import           Data.Text.Metrics

import           Data.License.SpdxLicenses (licenses)
import           Data.License.Type

inferLicense :: String -> Maybe License
inferLicense :: String -> Maybe License
inferLicense String
xs = String -> Maybe License
inferLicenseByName String
xs Maybe License -> Maybe License -> Maybe License
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Maybe License
inferLicenseByLevenshtein String
xs

inferLicenseByName :: String -> Maybe License
inferLicenseByName :: String -> Maybe License
inferLicenseByName (String -> String
normalize -> String
xs) = [Maybe License] -> Maybe License
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Maybe License] -> Maybe License)
-> [Maybe License] -> Maybe License
forall a b. (a -> b) -> a -> b
$ ((License, String) -> Maybe License)
-> [(License, String)] -> [Maybe License]
forall a b. (a -> b) -> [a] -> [b]
map (String -> (License, String) -> Maybe License
matchName String
xs) [(License, String)]
licenseNames

matchName :: String -> (License, String) -> Maybe License
matchName :: String -> (License, String) -> Maybe License
matchName String
xs (License
license, String
name) = License
license License -> Maybe () -> Maybe License
forall a b. a -> Maybe b -> Maybe a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
name String
xs)

licenseNames :: [(License, String)]
licenseNames :: [(License, String)]
licenseNames = ((License, String) -> (License, String))
-> [(License, String)] -> [(License, String)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> String) -> (License, String) -> (License, String)
forall a b. (a -> b) -> (License, a) -> (License, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> String
normalize) [
    (License
GPLv2, String
"GNU GENERAL PUBLIC LICENSE Version 2, June 1991")
  , (License
GPLv3, String
"GNU GENERAL PUBLIC LICENSE Version 3, 29 June 2007")
  , (License
LGPLv2_1, String
"GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999")
  , (License
LGPLv3, String
"GNU LESSER GENERAL PUBLIC LICENSE Version 3, 29 June 2007")
  , (License
AGPLv3, String
"GNU AFFERO GENERAL PUBLIC LICENSE Version 3, 19 November 2007")
  , (License
MPL_2_0, String
"Mozilla Public License Version 2.0")
  , (License
Apache_2_0, String
"Apache License Version 2.0, January 2004")
  ]

normalize :: String -> String
normalize :: String -> String
normalize = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isAlphaNum

inferLicenseByLevenshtein :: String -> Maybe License
inferLicenseByLevenshtein :: String -> Maybe License
inferLicenseByLevenshtein (String -> Text
T.pack -> Text
xs)
  | Text -> Int
T.length Text
xs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2000 = Maybe License
forall a. Maybe a
Nothing
  | Bool
otherwise = case ((License, Double) -> (License, Double) -> Ordering)
-> [(License, Double)] -> (License, Double)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (((License, Double) -> Double)
-> (License, Double) -> (License, Double) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (License, Double) -> Double
forall a b. (a, b) -> b
snd) (Text -> [(License, Double)]
probabilities Text
xs) of
      (License
license, Double
n) | Double
n Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0.85 -> License -> Maybe License
forall a. a -> Maybe a
Just License
license
      (License, Double)
_ -> Maybe License
forall a. Maybe a
Nothing

probabilities :: Text -> [(License, Double)]
probabilities :: Text -> [(License, Double)]
probabilities Text
license = ((License, Text) -> (License, Double))
-> [(License, Text)] -> [(License, Double)]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Double) -> (License, Text) -> (License, Double)
forall a b. (a -> b) -> (License, a) -> (License, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Double
probability) [(License, Text)]
licenses
  where
    probability :: Text -> Double
probability = Ratio Int -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Ratio Int -> Double) -> (Text -> Ratio Int) -> Text -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> Ratio Int
levenshteinNorm Text
license