    {-# 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