{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings  #-}

-- |
-- Module    : Linux.Arch.Aur
-- Copyright : (c) Colin Woodbury, 2014 - 2020
-- License   : GPL3
-- Maintainer: Colin Woodbury <colin@fosskers.ca>
--
-- Access package metadata from the Arch Linux User Repository.

module Linux.Arch.Aur
  ( -- * Types
    AurInfo(..)
  , AurError(..)
    -- * Queries
  , info, search
  ) where

import           Control.Applicative ((<|>))
import           Data.Aeson
import           Data.ByteString (ByteString)
import           Data.Hashable (Hashable)
import           Data.Text (Text)
import qualified Data.Text as T
import           GHC.Generics (Generic)
import           Network.HTTP.Client
import           Network.HTTP.Types.Status

---

data RPCResp = RPCResp
  { RPCResp -> Int
_version     :: Int
  , RPCResp -> Text
_type        :: Text
  , RPCResp -> Int
_resultCount :: Int
  , RPCResp -> [AurInfo]
_results     :: [AurInfo] }
  deriving (Int -> RPCResp -> ShowS
[RPCResp] -> ShowS
RPCResp -> String
(Int -> RPCResp -> ShowS)
-> (RPCResp -> String) -> ([RPCResp] -> ShowS) -> Show RPCResp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RPCResp] -> ShowS
$cshowList :: [RPCResp] -> ShowS
show :: RPCResp -> String
$cshow :: RPCResp -> String
showsPrec :: Int -> RPCResp -> ShowS
$cshowsPrec :: Int -> RPCResp -> ShowS
Show)

instance FromJSON RPCResp where
  parseJSON :: Value -> Parser RPCResp
parseJSON = String -> (Object -> Parser RPCResp) -> Value -> Parser RPCResp
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RPCResp" ((Object -> Parser RPCResp) -> Value -> Parser RPCResp)
-> (Object -> Parser RPCResp) -> Value -> Parser RPCResp
forall a b. (a -> b) -> a -> b
$ \Object
v -> Int -> Text -> Int -> [AurInfo] -> RPCResp
RPCResp
    (Int -> Text -> Int -> [AurInfo] -> RPCResp)
-> Parser Int -> Parser (Text -> Int -> [AurInfo] -> RPCResp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"version"
    Parser (Text -> Int -> [AurInfo] -> RPCResp)
-> Parser Text -> Parser (Int -> [AurInfo] -> RPCResp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type"
    Parser (Int -> [AurInfo] -> RPCResp)
-> Parser Int -> Parser ([AurInfo] -> RPCResp)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"resultcount"
    Parser ([AurInfo] -> RPCResp) -> Parser [AurInfo] -> Parser RPCResp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser [AurInfo]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"results"

-- | All relevant information about an AUR package.
data AurInfo = AurInfo
  { AurInfo -> Int
aurIdOf          :: Int
  , AurInfo -> Text
aurNameOf        :: Text
  , AurInfo -> Int
pkgBaseIdOf      :: Int
  , AurInfo -> Text
pkgBaseOf        :: Text
  , AurInfo -> Text
aurVersionOf     :: Text
  , AurInfo -> Maybe Text
aurDescriptionOf :: Maybe Text
  , AurInfo -> Maybe Text
urlOf            :: Maybe Text
  , AurInfo -> Int
aurVotesOf       :: Int
  , AurInfo -> Float
popularityOf     :: Float
  , AurInfo -> Maybe Int
dateObsoleteOf   :: Maybe Int
  , AurInfo -> Maybe Text
aurMaintainerOf  :: Maybe Text
  , AurInfo -> Int
submissionDateOf :: Int
  , AurInfo -> Int
modifiedDateOf   :: Int
  , AurInfo -> Maybe Text
urlPathOf        :: Maybe Text
  , AurInfo -> [Text]
dependsOf        :: [Text]
  , AurInfo -> [Text]
makeDepsOf       :: [Text]
  , AurInfo -> [Text]
optDepsOf        :: [Text]
  , AurInfo -> [Text]
conflictsOf      :: [Text]
  , AurInfo -> [Text]
providesOf       :: [Text]
  , AurInfo -> [Text]
licenseOf        :: [Text]
  , AurInfo -> [Text]
keywordsOf       :: [Text]}
  deriving (AurInfo -> AurInfo -> Bool
(AurInfo -> AurInfo -> Bool)
-> (AurInfo -> AurInfo -> Bool) -> Eq AurInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AurInfo -> AurInfo -> Bool
$c/= :: AurInfo -> AurInfo -> Bool
== :: AurInfo -> AurInfo -> Bool
$c== :: AurInfo -> AurInfo -> Bool
Eq, Eq AurInfo
Eq AurInfo
-> (AurInfo -> AurInfo -> Ordering)
-> (AurInfo -> AurInfo -> Bool)
-> (AurInfo -> AurInfo -> Bool)
-> (AurInfo -> AurInfo -> Bool)
-> (AurInfo -> AurInfo -> Bool)
-> (AurInfo -> AurInfo -> AurInfo)
-> (AurInfo -> AurInfo -> AurInfo)
-> Ord AurInfo
AurInfo -> AurInfo -> Bool
AurInfo -> AurInfo -> Ordering
AurInfo -> AurInfo -> AurInfo
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 :: AurInfo -> AurInfo -> AurInfo
$cmin :: AurInfo -> AurInfo -> AurInfo
max :: AurInfo -> AurInfo -> AurInfo
$cmax :: AurInfo -> AurInfo -> AurInfo
>= :: AurInfo -> AurInfo -> Bool
$c>= :: AurInfo -> AurInfo -> Bool
> :: AurInfo -> AurInfo -> Bool
$c> :: AurInfo -> AurInfo -> Bool
<= :: AurInfo -> AurInfo -> Bool
$c<= :: AurInfo -> AurInfo -> Bool
< :: AurInfo -> AurInfo -> Bool
$c< :: AurInfo -> AurInfo -> Bool
compare :: AurInfo -> AurInfo -> Ordering
$ccompare :: AurInfo -> AurInfo -> Ordering
$cp1Ord :: Eq AurInfo
Ord, Int -> AurInfo -> ShowS
[AurInfo] -> ShowS
AurInfo -> String
(Int -> AurInfo -> ShowS)
-> (AurInfo -> String) -> ([AurInfo] -> ShowS) -> Show AurInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AurInfo] -> ShowS
$cshowList :: [AurInfo] -> ShowS
show :: AurInfo -> String
$cshow :: AurInfo -> String
showsPrec :: Int -> AurInfo -> ShowS
$cshowsPrec :: Int -> AurInfo -> ShowS
Show, (forall x. AurInfo -> Rep AurInfo x)
-> (forall x. Rep AurInfo x -> AurInfo) -> Generic AurInfo
forall x. Rep AurInfo x -> AurInfo
forall x. AurInfo -> Rep AurInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AurInfo x -> AurInfo
$cfrom :: forall x. AurInfo -> Rep AurInfo x
Generic, Int -> AurInfo -> Int
AurInfo -> Int
(Int -> AurInfo -> Int) -> (AurInfo -> Int) -> Hashable AurInfo
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: AurInfo -> Int
$chash :: AurInfo -> Int
hashWithSalt :: Int -> AurInfo -> Int
$chashWithSalt :: Int -> AurInfo -> Int
Hashable)

instance FromJSON AurInfo where
    parseJSON :: Value -> Parser AurInfo
parseJSON = String -> (Object -> Parser AurInfo) -> Value -> Parser AurInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"AurInfo" ((Object -> Parser AurInfo) -> Value -> Parser AurInfo)
-> (Object -> Parser AurInfo) -> Value -> Parser AurInfo
forall a b. (a -> b) -> a -> b
$ \Object
v -> Int
-> Text
-> Int
-> Text
-> Text
-> Maybe Text
-> Maybe Text
-> Int
-> Float
-> Maybe Int
-> Maybe Text
-> Int
-> Int
-> Maybe Text
-> [Text]
-> [Text]
-> [Text]
-> [Text]
-> [Text]
-> [Text]
-> [Text]
-> AurInfo
AurInfo
      (Int
 -> Text
 -> Int
 -> Text
 -> Text
 -> Maybe Text
 -> Maybe Text
 -> Int
 -> Float
 -> Maybe Int
 -> Maybe Text
 -> Int
 -> Int
 -> Maybe Text
 -> [Text]
 -> [Text]
 -> [Text]
 -> [Text]
 -> [Text]
 -> [Text]
 -> [Text]
 -> AurInfo)
-> Parser Int
-> Parser
     (Text
      -> Int
      -> Text
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> Int
      -> Float
      -> Maybe Int
      -> Maybe Text
      -> Int
      -> Int
      -> Maybe Text
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> AurInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"ID"
      Parser
  (Text
   -> Int
   -> Text
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> Int
   -> Float
   -> Maybe Int
   -> Maybe Text
   -> Int
   -> Int
   -> Maybe Text
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> AurInfo)
-> Parser Text
-> Parser
     (Int
      -> Text
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> Int
      -> Float
      -> Maybe Int
      -> Maybe Text
      -> Int
      -> Int
      -> Maybe Text
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> AurInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"Name"
      Parser
  (Int
   -> Text
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> Int
   -> Float
   -> Maybe Int
   -> Maybe Text
   -> Int
   -> Int
   -> Maybe Text
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> AurInfo)
-> Parser Int
-> Parser
     (Text
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> Int
      -> Float
      -> Maybe Int
      -> Maybe Text
      -> Int
      -> Int
      -> Maybe Text
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> AurInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"PackageBaseID"
      Parser
  (Text
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> Int
   -> Float
   -> Maybe Int
   -> Maybe Text
   -> Int
   -> Int
   -> Maybe Text
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> AurInfo)
-> Parser Text
-> Parser
     (Text
      -> Maybe Text
      -> Maybe Text
      -> Int
      -> Float
      -> Maybe Int
      -> Maybe Text
      -> Int
      -> Int
      -> Maybe Text
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> AurInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"PackageBase"
      Parser
  (Text
   -> Maybe Text
   -> Maybe Text
   -> Int
   -> Float
   -> Maybe Int
   -> Maybe Text
   -> Int
   -> Int
   -> Maybe Text
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> AurInfo)
-> Parser Text
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Int
      -> Float
      -> Maybe Int
      -> Maybe Text
      -> Int
      -> Int
      -> Maybe Text
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> AurInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"Version"
      Parser
  (Maybe Text
   -> Maybe Text
   -> Int
   -> Float
   -> Maybe Int
   -> Maybe Text
   -> Int
   -> Int
   -> Maybe Text
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> AurInfo)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Int
      -> Float
      -> Maybe Int
      -> Maybe Text
      -> Int
      -> Int
      -> Maybe Text
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> AurInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"Description"
      Parser
  (Maybe Text
   -> Int
   -> Float
   -> Maybe Int
   -> Maybe Text
   -> Int
   -> Int
   -> Maybe Text
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> AurInfo)
-> Parser (Maybe Text)
-> Parser
     (Int
      -> Float
      -> Maybe Int
      -> Maybe Text
      -> Int
      -> Int
      -> Maybe Text
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> AurInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"URL"
      Parser
  (Int
   -> Float
   -> Maybe Int
   -> Maybe Text
   -> Int
   -> Int
   -> Maybe Text
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> AurInfo)
-> Parser Int
-> Parser
     (Float
      -> Maybe Int
      -> Maybe Text
      -> Int
      -> Int
      -> Maybe Text
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> AurInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"NumVotes"
      Parser
  (Float
   -> Maybe Int
   -> Maybe Text
   -> Int
   -> Int
   -> Maybe Text
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> AurInfo)
-> Parser Float
-> Parser
     (Maybe Int
      -> Maybe Text
      -> Int
      -> Int
      -> Maybe Text
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> AurInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Float
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"Popularity"
      Parser
  (Maybe Int
   -> Maybe Text
   -> Int
   -> Int
   -> Maybe Text
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> AurInfo)
-> Parser (Maybe Int)
-> Parser
     (Maybe Text
      -> Int
      -> Int
      -> Maybe Text
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> AurInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"OutOfDate"  Parser (Maybe Int) -> Parser (Maybe Int) -> Parser (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Int -> Parser (Maybe Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Int
forall a. Maybe a
Nothing)
      Parser
  (Maybe Text
   -> Int
   -> Int
   -> Maybe Text
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> AurInfo)
-> Parser (Maybe Text)
-> Parser
     (Int
      -> Int
      -> Maybe Text
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> AurInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"Maintainer" Parser (Maybe Text) -> Parser (Maybe Text) -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing)
      Parser
  (Int
   -> Int
   -> Maybe Text
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> AurInfo)
-> Parser Int
-> Parser
     (Int
      -> Maybe Text
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> AurInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"FirstSubmitted"
      Parser
  (Int
   -> Maybe Text
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> AurInfo)
-> Parser Int
-> Parser
     (Maybe Text
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> AurInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.:  Text
"LastModified"
      Parser
  (Maybe Text
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> AurInfo)
-> Parser (Maybe Text)
-> Parser
     ([Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> [Text]
      -> AurInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"URLPath"
      Parser
  ([Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> [Text]
   -> AurInfo)
-> Parser [Text]
-> Parser
     ([Text]
      -> [Text] -> [Text] -> [Text] -> [Text] -> [Text] -> AurInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"Depends"     Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      Parser
  ([Text]
   -> [Text] -> [Text] -> [Text] -> [Text] -> [Text] -> AurInfo)
-> Parser [Text]
-> Parser
     ([Text] -> [Text] -> [Text] -> [Text] -> [Text] -> AurInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"MakeDepends" Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      Parser ([Text] -> [Text] -> [Text] -> [Text] -> [Text] -> AurInfo)
-> Parser [Text]
-> Parser ([Text] -> [Text] -> [Text] -> [Text] -> AurInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"OptDepends"  Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      Parser ([Text] -> [Text] -> [Text] -> [Text] -> AurInfo)
-> Parser [Text] -> Parser ([Text] -> [Text] -> [Text] -> AurInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"Conflicts"   Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      Parser ([Text] -> [Text] -> [Text] -> AurInfo)
-> Parser [Text] -> Parser ([Text] -> [Text] -> AurInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"Provides"    Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      Parser ([Text] -> [Text] -> AurInfo)
-> Parser [Text] -> Parser ([Text] -> AurInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"License"     Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
      Parser ([Text] -> AurInfo) -> Parser [Text] -> Parser AurInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"Keywords"    Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []

instance ToJSON AurInfo where
  toJSON :: AurInfo -> Value
toJSON AurInfo
ai = [Pair] -> Value
object
    [ Text
"ID" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AurInfo -> Int
aurIdOf AurInfo
ai
    , Text
"Name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AurInfo -> Text
aurNameOf AurInfo
ai
    , Text
"PackageBaseID" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AurInfo -> Int
pkgBaseIdOf AurInfo
ai
    , Text
"PackageBase" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AurInfo -> Text
pkgBaseOf AurInfo
ai
    , Text
"Version" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AurInfo -> Text
aurVersionOf AurInfo
ai
    , Text
"Description" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AurInfo -> Maybe Text
aurDescriptionOf AurInfo
ai
    , Text
"URL" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AurInfo -> Maybe Text
urlOf AurInfo
ai
    , Text
"NumVotes" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AurInfo -> Int
aurVotesOf AurInfo
ai
    , Text
"Popularity" Text -> Float -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AurInfo -> Float
popularityOf AurInfo
ai
    , Text
"OutOfDate" Text -> Maybe Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AurInfo -> Maybe Int
dateObsoleteOf AurInfo
ai
    , Text
"Maintainer" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AurInfo -> Maybe Text
aurMaintainerOf AurInfo
ai
    , Text
"FirstSubmitted" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AurInfo -> Int
submissionDateOf AurInfo
ai
    , Text
"LastModified" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AurInfo -> Int
modifiedDateOf AurInfo
ai
    , Text
"URLPath" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AurInfo -> Maybe Text
urlPathOf AurInfo
ai
    , Text
"Depends" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AurInfo -> [Text]
dependsOf AurInfo
ai
    , Text
"MakeDepends" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AurInfo -> [Text]
makeDepsOf AurInfo
ai
    , Text
"OptDepends" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AurInfo -> [Text]
optDepsOf AurInfo
ai
    , Text
"Conflicts" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AurInfo -> [Text]
conflictsOf AurInfo
ai
    , Text
"Provides" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AurInfo -> [Text]
providesOf AurInfo
ai
    , Text
"License" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AurInfo -> [Text]
licenseOf AurInfo
ai
    , Text
"Keywords" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= AurInfo -> [Text]
keywordsOf AurInfo
ai ]

data AurError = NotFound ByteString | BadJSON | OtherAurError ByteString
  deriving stock (AurError -> AurError -> Bool
(AurError -> AurError -> Bool)
-> (AurError -> AurError -> Bool) -> Eq AurError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AurError -> AurError -> Bool
$c/= :: AurError -> AurError -> Bool
== :: AurError -> AurError -> Bool
$c== :: AurError -> AurError -> Bool
Eq, Eq AurError
Eq AurError
-> (AurError -> AurError -> Ordering)
-> (AurError -> AurError -> Bool)
-> (AurError -> AurError -> Bool)
-> (AurError -> AurError -> Bool)
-> (AurError -> AurError -> Bool)
-> (AurError -> AurError -> AurError)
-> (AurError -> AurError -> AurError)
-> Ord AurError
AurError -> AurError -> Bool
AurError -> AurError -> Ordering
AurError -> AurError -> AurError
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 :: AurError -> AurError -> AurError
$cmin :: AurError -> AurError -> AurError
max :: AurError -> AurError -> AurError
$cmax :: AurError -> AurError -> AurError
>= :: AurError -> AurError -> Bool
$c>= :: AurError -> AurError -> Bool
> :: AurError -> AurError -> Bool
$c> :: AurError -> AurError -> Bool
<= :: AurError -> AurError -> Bool
$c<= :: AurError -> AurError -> Bool
< :: AurError -> AurError -> Bool
$c< :: AurError -> AurError -> Bool
compare :: AurError -> AurError -> Ordering
$ccompare :: AurError -> AurError -> Ordering
$cp1Ord :: Eq AurError
Ord, Int -> AurError -> ShowS
[AurError] -> ShowS
AurError -> String
(Int -> AurError -> ShowS)
-> (AurError -> String) -> ([AurError] -> ShowS) -> Show AurError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AurError] -> ShowS
$cshowList :: [AurError] -> ShowS
show :: AurError -> String
$cshow :: AurError -> String
showsPrec :: Int -> AurError -> ShowS
$cshowsPrec :: Int -> AurError -> ShowS
Show)

-- | Perform an @info@ call on one or more package names.
-- Will fail with a `Left` if there was a connection/decoding error.
info :: Manager -> [Text] -> IO (Either AurError [AurInfo])
info :: Manager -> [Text] -> IO (Either AurError [AurInfo])
info Manager
m [Text]
ps = Manager -> String -> IO (Either AurError [AurInfo])
work Manager
m String
url
  where
    url :: String
url = String
"https://aur.archlinux.org/rpc?v=5&type=info&" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
as
    as :: String
as = Text -> String
T.unpack (Text -> String) -> ([Text] -> Text) -> [Text] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"&" ([Text] -> String) -> [Text] -> String
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
p -> Text
"arg%5B%5D=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
escape Text
p) [Text]
ps

escape :: Char -> Text
escape :: Char -> Text
escape Char
'+' = Text
"%2B"
escape Char
c   = Char -> Text
T.singleton Char
c

-- | Perform a @search@ call on a package name or description text.
-- Will fail with a `Left` if there was a connection/decoding error.
search :: Manager -> Text -> IO (Either AurError [AurInfo])
search :: Manager -> Text -> IO (Either AurError [AurInfo])
search Manager
m Text
p = Manager -> String -> IO (Either AurError [AurInfo])
work Manager
m String
url
  where
    url :: String
url = String
"https://aur.archlinux.org/rpc?v=5&type=search&arg=" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
p

work :: Manager -> String -> IO (Either AurError [AurInfo])
work :: Manager -> String -> IO (Either AurError [AurInfo])
work Manager
m String
url = do
  Request
req <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
url
  Response ByteString
res <- Request -> Manager -> IO (Response ByteString)
httpLbs Request
req Manager
m
  case Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
res of
    Status Int
200 ByteString
_ -> Either AurError [AurInfo] -> IO (Either AurError [AurInfo])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either AurError [AurInfo] -> IO (Either AurError [AurInfo]))
-> (ByteString -> Either AurError [AurInfo])
-> ByteString
-> IO (Either AurError [AurInfo])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either AurError [AurInfo]
-> (RPCResp -> Either AurError [AurInfo])
-> Maybe RPCResp
-> Either AurError [AurInfo]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (AurError -> Either AurError [AurInfo]
forall a b. a -> Either a b
Left AurError
BadJSON) ([AurInfo] -> Either AurError [AurInfo]
forall a b. b -> Either a b
Right ([AurInfo] -> Either AurError [AurInfo])
-> (RPCResp -> [AurInfo]) -> RPCResp -> Either AurError [AurInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RPCResp -> [AurInfo]
_results) (Maybe RPCResp -> Either AurError [AurInfo])
-> (ByteString -> Maybe RPCResp)
-> ByteString
-> Either AurError [AurInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe RPCResp
forall a. FromJSON a => ByteString -> Maybe a
decode' (ByteString -> IO (Either AurError [AurInfo]))
-> ByteString -> IO (Either AurError [AurInfo])
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
res
    Status Int
404 ByteString
e -> Either AurError [AurInfo] -> IO (Either AurError [AurInfo])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either AurError [AurInfo] -> IO (Either AurError [AurInfo]))
-> (AurError -> Either AurError [AurInfo])
-> AurError
-> IO (Either AurError [AurInfo])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AurError -> Either AurError [AurInfo]
forall a b. a -> Either a b
Left (AurError -> IO (Either AurError [AurInfo]))
-> AurError -> IO (Either AurError [AurInfo])
forall a b. (a -> b) -> a -> b
$ ByteString -> AurError
NotFound ByteString
e
    Status Int
_ ByteString
e   -> Either AurError [AurInfo] -> IO (Either AurError [AurInfo])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either AurError [AurInfo] -> IO (Either AurError [AurInfo]))
-> (AurError -> Either AurError [AurInfo])
-> AurError
-> IO (Either AurError [AurInfo])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AurError -> Either AurError [AurInfo]
forall a b. a -> Either a b
Left (AurError -> IO (Either AurError [AurInfo]))
-> AurError -> IO (Either AurError [AurInfo])
forall a b. (a -> b) -> a -> b
$ ByteString -> AurError
OtherAurError ByteString
e