{-# LANGUAGE DeriveGeneric #-}

-- | The project data type
module Pypi.Project
  ( PypiProject (..),
    PypiProjectInfo (..),
    PypiProjectRelease (..),
    getReleaseSemVer,
  )
where

import Data.Aeson (FromJSON, Options (fieldLabelModifier), defaultOptions, genericParseJSON, parseJSON)
import Data.Char (isUpper, toLower)
import Data.Either (rights)
import qualified Data.Map as M
import Data.Maybe (fromJust, fromMaybe, isJust, catMaybes, mapMaybe)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Versions
import Data.Versions (SemVer, versioning)
import GHC.Generics (Generic)

data PypiProjectInfo
  = PypiProjectInfo
      { PypiProjectInfo -> Text
ppiAuthor :: Text,
        PypiProjectInfo -> Text
ppiAuthorEmail :: Text,
        PypiProjectInfo -> [Text]
ppiClassifiers :: [Text],
        PypiProjectInfo -> Text
ppiLicense :: Text
      }
  deriving (PypiProjectInfo -> PypiProjectInfo -> Bool
(PypiProjectInfo -> PypiProjectInfo -> Bool)
-> (PypiProjectInfo -> PypiProjectInfo -> Bool)
-> Eq PypiProjectInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PypiProjectInfo -> PypiProjectInfo -> Bool
$c/= :: PypiProjectInfo -> PypiProjectInfo -> Bool
== :: PypiProjectInfo -> PypiProjectInfo -> Bool
$c== :: PypiProjectInfo -> PypiProjectInfo -> Bool
Eq, Int -> PypiProjectInfo -> ShowS
[PypiProjectInfo] -> ShowS
PypiProjectInfo -> String
(Int -> PypiProjectInfo -> ShowS)
-> (PypiProjectInfo -> String)
-> ([PypiProjectInfo] -> ShowS)
-> Show PypiProjectInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PypiProjectInfo] -> ShowS
$cshowList :: [PypiProjectInfo] -> ShowS
show :: PypiProjectInfo -> String
$cshow :: PypiProjectInfo -> String
showsPrec :: Int -> PypiProjectInfo -> ShowS
$cshowsPrec :: Int -> PypiProjectInfo -> ShowS
Show, Eq PypiProjectInfo
Eq PypiProjectInfo =>
(PypiProjectInfo -> PypiProjectInfo -> Ordering)
-> (PypiProjectInfo -> PypiProjectInfo -> Bool)
-> (PypiProjectInfo -> PypiProjectInfo -> Bool)
-> (PypiProjectInfo -> PypiProjectInfo -> Bool)
-> (PypiProjectInfo -> PypiProjectInfo -> Bool)
-> (PypiProjectInfo -> PypiProjectInfo -> PypiProjectInfo)
-> (PypiProjectInfo -> PypiProjectInfo -> PypiProjectInfo)
-> Ord PypiProjectInfo
PypiProjectInfo -> PypiProjectInfo -> Bool
PypiProjectInfo -> PypiProjectInfo -> Ordering
PypiProjectInfo -> PypiProjectInfo -> PypiProjectInfo
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PypiProjectInfo -> PypiProjectInfo -> PypiProjectInfo
$cmin :: PypiProjectInfo -> PypiProjectInfo -> PypiProjectInfo
max :: PypiProjectInfo -> PypiProjectInfo -> PypiProjectInfo
$cmax :: PypiProjectInfo -> PypiProjectInfo -> PypiProjectInfo
>= :: PypiProjectInfo -> PypiProjectInfo -> Bool
$c>= :: PypiProjectInfo -> PypiProjectInfo -> Bool
> :: PypiProjectInfo -> PypiProjectInfo -> Bool
$c> :: PypiProjectInfo -> PypiProjectInfo -> Bool
<= :: PypiProjectInfo -> PypiProjectInfo -> Bool
$c<= :: PypiProjectInfo -> PypiProjectInfo -> Bool
< :: PypiProjectInfo -> PypiProjectInfo -> Bool
$c< :: PypiProjectInfo -> PypiProjectInfo -> Bool
compare :: PypiProjectInfo -> PypiProjectInfo -> Ordering
$ccompare :: PypiProjectInfo -> PypiProjectInfo -> Ordering
$cp1Ord :: Eq PypiProjectInfo
Ord, (forall x. PypiProjectInfo -> Rep PypiProjectInfo x)
-> (forall x. Rep PypiProjectInfo x -> PypiProjectInfo)
-> Generic PypiProjectInfo
forall x. Rep PypiProjectInfo x -> PypiProjectInfo
forall x. PypiProjectInfo -> Rep PypiProjectInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PypiProjectInfo x -> PypiProjectInfo
$cfrom :: forall x. PypiProjectInfo -> Rep PypiProjectInfo x
Generic)

data PypiProjectRelease
  = PypiProjectRelease
      { PypiProjectRelease -> Text
pprFilename :: Text,
        PypiProjectRelease -> Text
pprPackagetype :: Text
      }
  deriving (PypiProjectRelease -> PypiProjectRelease -> Bool
(PypiProjectRelease -> PypiProjectRelease -> Bool)
-> (PypiProjectRelease -> PypiProjectRelease -> Bool)
-> Eq PypiProjectRelease
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PypiProjectRelease -> PypiProjectRelease -> Bool
$c/= :: PypiProjectRelease -> PypiProjectRelease -> Bool
== :: PypiProjectRelease -> PypiProjectRelease -> Bool
$c== :: PypiProjectRelease -> PypiProjectRelease -> Bool
Eq, Int -> PypiProjectRelease -> ShowS
[PypiProjectRelease] -> ShowS
PypiProjectRelease -> String
(Int -> PypiProjectRelease -> ShowS)
-> (PypiProjectRelease -> String)
-> ([PypiProjectRelease] -> ShowS)
-> Show PypiProjectRelease
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PypiProjectRelease] -> ShowS
$cshowList :: [PypiProjectRelease] -> ShowS
show :: PypiProjectRelease -> String
$cshow :: PypiProjectRelease -> String
showsPrec :: Int -> PypiProjectRelease -> ShowS
$cshowsPrec :: Int -> PypiProjectRelease -> ShowS
Show, Eq PypiProjectRelease
Eq PypiProjectRelease =>
(PypiProjectRelease -> PypiProjectRelease -> Ordering)
-> (PypiProjectRelease -> PypiProjectRelease -> Bool)
-> (PypiProjectRelease -> PypiProjectRelease -> Bool)
-> (PypiProjectRelease -> PypiProjectRelease -> Bool)
-> (PypiProjectRelease -> PypiProjectRelease -> Bool)
-> (PypiProjectRelease -> PypiProjectRelease -> PypiProjectRelease)
-> (PypiProjectRelease -> PypiProjectRelease -> PypiProjectRelease)
-> Ord PypiProjectRelease
PypiProjectRelease -> PypiProjectRelease -> Bool
PypiProjectRelease -> PypiProjectRelease -> Ordering
PypiProjectRelease -> PypiProjectRelease -> PypiProjectRelease
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PypiProjectRelease -> PypiProjectRelease -> PypiProjectRelease
$cmin :: PypiProjectRelease -> PypiProjectRelease -> PypiProjectRelease
max :: PypiProjectRelease -> PypiProjectRelease -> PypiProjectRelease
$cmax :: PypiProjectRelease -> PypiProjectRelease -> PypiProjectRelease
>= :: PypiProjectRelease -> PypiProjectRelease -> Bool
$c>= :: PypiProjectRelease -> PypiProjectRelease -> Bool
> :: PypiProjectRelease -> PypiProjectRelease -> Bool
$c> :: PypiProjectRelease -> PypiProjectRelease -> Bool
<= :: PypiProjectRelease -> PypiProjectRelease -> Bool
$c<= :: PypiProjectRelease -> PypiProjectRelease -> Bool
< :: PypiProjectRelease -> PypiProjectRelease -> Bool
$c< :: PypiProjectRelease -> PypiProjectRelease -> Bool
compare :: PypiProjectRelease -> PypiProjectRelease -> Ordering
$ccompare :: PypiProjectRelease -> PypiProjectRelease -> Ordering
$cp1Ord :: Eq PypiProjectRelease
Ord, (forall x. PypiProjectRelease -> Rep PypiProjectRelease x)
-> (forall x. Rep PypiProjectRelease x -> PypiProjectRelease)
-> Generic PypiProjectRelease
forall x. Rep PypiProjectRelease x -> PypiProjectRelease
forall x. PypiProjectRelease -> Rep PypiProjectRelease x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PypiProjectRelease x -> PypiProjectRelease
$cfrom :: forall x. PypiProjectRelease -> Rep PypiProjectRelease x
Generic)

data PypiProject
  = PypiProject
      { PypiProject -> PypiProjectInfo
ppInfo :: PypiProjectInfo,
        PypiProject -> Map Text [PypiProjectRelease]
ppReleases :: M.Map Text [PypiProjectRelease]
      }
  deriving (PypiProject -> PypiProject -> Bool
(PypiProject -> PypiProject -> Bool)
-> (PypiProject -> PypiProject -> Bool) -> Eq PypiProject
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PypiProject -> PypiProject -> Bool
$c/= :: PypiProject -> PypiProject -> Bool
== :: PypiProject -> PypiProject -> Bool
$c== :: PypiProject -> PypiProject -> Bool
Eq, Int -> PypiProject -> ShowS
[PypiProject] -> ShowS
PypiProject -> String
(Int -> PypiProject -> ShowS)
-> (PypiProject -> String)
-> ([PypiProject] -> ShowS)
-> Show PypiProject
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PypiProject] -> ShowS
$cshowList :: [PypiProject] -> ShowS
show :: PypiProject -> String
$cshow :: PypiProject -> String
showsPrec :: Int -> PypiProject -> ShowS
$cshowsPrec :: Int -> PypiProject -> ShowS
Show, Eq PypiProject
Eq PypiProject =>
(PypiProject -> PypiProject -> Ordering)
-> (PypiProject -> PypiProject -> Bool)
-> (PypiProject -> PypiProject -> Bool)
-> (PypiProject -> PypiProject -> Bool)
-> (PypiProject -> PypiProject -> Bool)
-> (PypiProject -> PypiProject -> PypiProject)
-> (PypiProject -> PypiProject -> PypiProject)
-> Ord PypiProject
PypiProject -> PypiProject -> Bool
PypiProject -> PypiProject -> Ordering
PypiProject -> PypiProject -> PypiProject
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: PypiProject -> PypiProject -> PypiProject
$cmin :: PypiProject -> PypiProject -> PypiProject
max :: PypiProject -> PypiProject -> PypiProject
$cmax :: PypiProject -> PypiProject -> PypiProject
>= :: PypiProject -> PypiProject -> Bool
$c>= :: PypiProject -> PypiProject -> Bool
> :: PypiProject -> PypiProject -> Bool
$c> :: PypiProject -> PypiProject -> Bool
<= :: PypiProject -> PypiProject -> Bool
$c<= :: PypiProject -> PypiProject -> Bool
< :: PypiProject -> PypiProject -> Bool
$c< :: PypiProject -> PypiProject -> Bool
compare :: PypiProject -> PypiProject -> Ordering
$ccompare :: PypiProject -> PypiProject -> Ordering
$cp1Ord :: Eq PypiProject
Ord, (forall x. PypiProject -> Rep PypiProject x)
-> (forall x. Rep PypiProject x -> PypiProject)
-> Generic PypiProject
forall x. Rep PypiProject x -> PypiProject
forall x. PypiProject -> Rep PypiProject x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PypiProject x -> PypiProject
$cfrom :: forall x. PypiProject -> Rep PypiProject x
Generic)

-- Get release semver
getReleaseSemVer :: PypiProject -> [SemVer]
getReleaseSemVer :: PypiProject -> [SemVer]
getReleaseSemVer = (Versioning -> Maybe SemVer) -> [Versioning] -> [SemVer]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Versioning -> Maybe SemVer
go ([Versioning] -> [SemVer])
-> (PypiProject -> [Versioning]) -> PypiProject -> [SemVer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either ParsingError Versioning] -> [Versioning]
forall a b. [Either a b] -> [b]
rights ([Either ParsingError Versioning] -> [Versioning])
-> (PypiProject -> [Either ParsingError Versioning])
-> PypiProject
-> [Versioning]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Either ParsingError Versioning)
-> [Text] -> [Either ParsingError Versioning]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Either ParsingError Versioning
versioning ([Text] -> [Either ParsingError Versioning])
-> (PypiProject -> [Text])
-> PypiProject
-> [Either ParsingError Versioning]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text [PypiProjectRelease] -> [Text]
forall k a. Map k a -> [k]
M.keys (Map Text [PypiProjectRelease] -> [Text])
-> (PypiProject -> Map Text [PypiProjectRelease])
-> PypiProject
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PypiProject -> Map Text [PypiProjectRelease]
ppReleases
  where
    go :: Data.Versions.Versioning -> Maybe SemVer
    go :: Versioning -> Maybe SemVer
go v :: Versioning
v = case Versioning
v of
      Data.Versions.Ideal semver :: SemVer
semver -> SemVer -> Maybe SemVer
forall a. a -> Maybe a
Just SemVer
semver
      _ -> Maybe SemVer
forall a. Maybe a
Nothing

-- Convert ppiAuthorEmail to author_email
pypiParseJSON :: String -> Options
pypiParseJSON :: String -> Options
pypiParseJSON prefix :: String
prefix = Options
defaultOptions {fieldLabelModifier :: ShowS
fieldLabelModifier = ShowS
recordToJson}
  where
    recordToJson :: ShowS
recordToJson = ShowS
updateCase ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
prefix)
    updateCase :: ShowS
updateCase [] = []
    updateCase (x :: Char
x : xs :: String
xs) = Char -> Char
toLower Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
updateCase' String
xs
    updateCase' :: ShowS
updateCase' [] = []
    updateCase' (x :: Char
x : xs :: String
xs)
      | Char -> Bool
isUpper Char
x = '_' Char -> ShowS
forall a. a -> [a] -> [a]
: Char -> Char
toLower Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
updateCase' String
xs
      | Bool
otherwise = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
updateCase' String
xs

instance FromJSON PypiProjectInfo where
  parseJSON :: Value -> Parser PypiProjectInfo
parseJSON = Options -> Value -> Parser PypiProjectInfo
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser PypiProjectInfo)
-> Options -> Value -> Parser PypiProjectInfo
forall a b. (a -> b) -> a -> b
$ String -> Options
pypiParseJSON "ppi"

instance FromJSON PypiProjectRelease where
  parseJSON :: Value -> Parser PypiProjectRelease
parseJSON = Options -> Value -> Parser PypiProjectRelease
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser PypiProjectRelease)
-> Options -> Value -> Parser PypiProjectRelease
forall a b. (a -> b) -> a -> b
$ String -> Options
pypiParseJSON "ppr"

instance FromJSON PypiProject where
  parseJSON :: Value -> Parser PypiProject
parseJSON = Options -> Value -> Parser PypiProject
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options -> Value -> Parser PypiProject)
-> Options -> Value -> Parser PypiProject
forall a b. (a -> b) -> a -> b
$ String -> Options
pypiParseJSON "pp"