{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | Copyright: (c) 2021 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <berberman@yandex.com>
-- Stability: experimental
-- Portability: portable
-- Arch Linux official repositories APIs and AUR APIs.
--
-- These two kinds of APIs are distinguished by 'APIClient'.
-- Functions over them return 'APIClient' parametrize by corresponding 'APIType'.
--
-- Overall, there are five APIs available,
-- refer to <https://wiki.archlinux.org/index.php/Official_repositories_web_interface> and <https://wiki.archlinux.org/index.php/Aurweb_RPC_interface>.
module Web.ArchLinux.API
  ( -- * API Client
    APIClient (..),
    APIType (..),
    HasBaseUrl (..),
    runAPIClient,
    runAPIClient',

    -- * Arch Linux official
    SearchOptions (..),
    emptySearchOptions,
    getPackageDetails,
    getPackageFiles,
    searchPackage,

    -- * AUR
    AurSearchType (..),
    searchAur,
    getAurInfo,
  )
where

import Control.Monad.Catch (MonadCatch, MonadThrow)
import Control.Monad.Except (MonadError)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Reader (MonadReader)
import Data.Aeson (FromJSON, Result (..), Value, fromJSON)
import Data.Proxy
import Data.Text (Text)
import qualified Data.Text as T
import GHC.Generics (Generic)
import Network.HTTP.Client (Manager)
import Network.HTTP.Client.TLS (newTlsManager)
import Network.HTTP.Types (http11)
import Servant.Client
import Servant.Client.Core (RunClient, throwClientError)
import Web.ArchLinux.Types
import Web.ArchLinux.Types.API

-- | Two types of APIs.
data APIType = ArchLinux | Aur

-- | A wrapper of 'ClientM', with 'BaseUrl' reflected to type level phantom 'APIType'.
newtype APIClient (k :: APIType) a = APIClient {APIClient k a -> ClientM a
unWrapClientM :: ClientM a}
  deriving newtype
    ( a -> APIClient k b -> APIClient k a
(a -> b) -> APIClient k a -> APIClient k b
(forall a b. (a -> b) -> APIClient k a -> APIClient k b)
-> (forall a b. a -> APIClient k b -> APIClient k a)
-> Functor (APIClient k)
forall a b. a -> APIClient k b -> APIClient k a
forall a b. (a -> b) -> APIClient k a -> APIClient k b
forall (k :: APIType) a b. a -> APIClient k b -> APIClient k a
forall (k :: APIType) a b.
(a -> b) -> APIClient k a -> APIClient k b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> APIClient k b -> APIClient k a
$c<$ :: forall (k :: APIType) a b. a -> APIClient k b -> APIClient k a
fmap :: (a -> b) -> APIClient k a -> APIClient k b
$cfmap :: forall (k :: APIType) a b.
(a -> b) -> APIClient k a -> APIClient k b
Functor,
      Functor (APIClient k)
a -> APIClient k a
Functor (APIClient k)
-> (forall a. a -> APIClient k a)
-> (forall a b.
    APIClient k (a -> b) -> APIClient k a -> APIClient k b)
-> (forall a b c.
    (a -> b -> c) -> APIClient k a -> APIClient k b -> APIClient k c)
-> (forall a b. APIClient k a -> APIClient k b -> APIClient k b)
-> (forall a b. APIClient k a -> APIClient k b -> APIClient k a)
-> Applicative (APIClient k)
APIClient k a -> APIClient k b -> APIClient k b
APIClient k a -> APIClient k b -> APIClient k a
APIClient k (a -> b) -> APIClient k a -> APIClient k b
(a -> b -> c) -> APIClient k a -> APIClient k b -> APIClient k c
forall a. a -> APIClient k a
forall a b. APIClient k a -> APIClient k b -> APIClient k a
forall a b. APIClient k a -> APIClient k b -> APIClient k b
forall a b. APIClient k (a -> b) -> APIClient k a -> APIClient k b
forall a b c.
(a -> b -> c) -> APIClient k a -> APIClient k b -> APIClient k c
forall (k :: APIType). Functor (APIClient k)
forall (k :: APIType) a. a -> APIClient k a
forall (k :: APIType) a b.
APIClient k a -> APIClient k b -> APIClient k a
forall (k :: APIType) a b.
APIClient k a -> APIClient k b -> APIClient k b
forall (k :: APIType) a b.
APIClient k (a -> b) -> APIClient k a -> APIClient k b
forall (k :: APIType) a b c.
(a -> b -> c) -> APIClient k a -> APIClient k b -> APIClient k c
forall (f :: Type -> Type).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: APIClient k a -> APIClient k b -> APIClient k a
$c<* :: forall (k :: APIType) a b.
APIClient k a -> APIClient k b -> APIClient k a
*> :: APIClient k a -> APIClient k b -> APIClient k b
$c*> :: forall (k :: APIType) a b.
APIClient k a -> APIClient k b -> APIClient k b
liftA2 :: (a -> b -> c) -> APIClient k a -> APIClient k b -> APIClient k c
$cliftA2 :: forall (k :: APIType) a b c.
(a -> b -> c) -> APIClient k a -> APIClient k b -> APIClient k c
<*> :: APIClient k (a -> b) -> APIClient k a -> APIClient k b
$c<*> :: forall (k :: APIType) a b.
APIClient k (a -> b) -> APIClient k a -> APIClient k b
pure :: a -> APIClient k a
$cpure :: forall (k :: APIType) a. a -> APIClient k a
$cp1Applicative :: forall (k :: APIType). Functor (APIClient k)
Applicative,
      Applicative (APIClient k)
a -> APIClient k a
Applicative (APIClient k)
-> (forall a b.
    APIClient k a -> (a -> APIClient k b) -> APIClient k b)
-> (forall a b. APIClient k a -> APIClient k b -> APIClient k b)
-> (forall a. a -> APIClient k a)
-> Monad (APIClient k)
APIClient k a -> (a -> APIClient k b) -> APIClient k b
APIClient k a -> APIClient k b -> APIClient k b
forall a. a -> APIClient k a
forall a b. APIClient k a -> APIClient k b -> APIClient k b
forall a b. APIClient k a -> (a -> APIClient k b) -> APIClient k b
forall (k :: APIType). Applicative (APIClient k)
forall (k :: APIType) a. a -> APIClient k a
forall (k :: APIType) a b.
APIClient k a -> APIClient k b -> APIClient k b
forall (k :: APIType) a b.
APIClient k a -> (a -> APIClient k b) -> APIClient k b
forall (m :: Type -> Type).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> APIClient k a
$creturn :: forall (k :: APIType) a. a -> APIClient k a
>> :: APIClient k a -> APIClient k b -> APIClient k b
$c>> :: forall (k :: APIType) a b.
APIClient k a -> APIClient k b -> APIClient k b
>>= :: APIClient k a -> (a -> APIClient k b) -> APIClient k b
$c>>= :: forall (k :: APIType) a b.
APIClient k a -> (a -> APIClient k b) -> APIClient k b
$cp1Monad :: forall (k :: APIType). Applicative (APIClient k)
Monad,
      Monad (APIClient k)
Monad (APIClient k)
-> (forall a. IO a -> APIClient k a) -> MonadIO (APIClient k)
IO a -> APIClient k a
forall a. IO a -> APIClient k a
forall (k :: APIType). Monad (APIClient k)
forall (k :: APIType) a. IO a -> APIClient k a
forall (m :: Type -> Type).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> APIClient k a
$cliftIO :: forall (k :: APIType) a. IO a -> APIClient k a
$cp1MonadIO :: forall (k :: APIType). Monad (APIClient k)
MonadIO,
      Rep (APIClient k a) x -> APIClient k a
APIClient k a -> Rep (APIClient k a) x
(forall x. APIClient k a -> Rep (APIClient k a) x)
-> (forall x. Rep (APIClient k a) x -> APIClient k a)
-> Generic (APIClient k a)
forall x. Rep (APIClient k a) x -> APIClient k a
forall x. APIClient k a -> Rep (APIClient k a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (k :: APIType) a x. Rep (APIClient k a) x -> APIClient k a
forall (k :: APIType) a x. APIClient k a -> Rep (APIClient k a) x
to :: Rep (APIClient k a) x -> APIClient k a
$cto :: forall (k :: APIType) a x. Rep (APIClient k a) x -> APIClient k a
from :: APIClient k a -> Rep (APIClient k a) x
$cfrom :: forall (k :: APIType) a x. APIClient k a -> Rep (APIClient k a) x
Generic,
      MonadReader ClientEnv,
      MonadError ClientError,
      Monad (APIClient k)
e -> APIClient k a
Monad (APIClient k)
-> (forall e a. Exception e => e -> APIClient k a)
-> MonadThrow (APIClient k)
forall e a. Exception e => e -> APIClient k a
forall (k :: APIType). Monad (APIClient k)
forall (k :: APIType) e a. Exception e => e -> APIClient k a
forall (m :: Type -> Type).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> APIClient k a
$cthrowM :: forall (k :: APIType) e a. Exception e => e -> APIClient k a
$cp1MonadThrow :: forall (k :: APIType). Monad (APIClient k)
MonadThrow,
      MonadThrow (APIClient k)
MonadThrow (APIClient k)
-> (forall e a.
    Exception e =>
    APIClient k a -> (e -> APIClient k a) -> APIClient k a)
-> MonadCatch (APIClient k)
APIClient k a -> (e -> APIClient k a) -> APIClient k a
forall e a.
Exception e =>
APIClient k a -> (e -> APIClient k a) -> APIClient k a
forall (k :: APIType). MonadThrow (APIClient k)
forall (k :: APIType) e a.
Exception e =>
APIClient k a -> (e -> APIClient k a) -> APIClient k a
forall (m :: Type -> Type).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: APIClient k a -> (e -> APIClient k a) -> APIClient k a
$ccatch :: forall (k :: APIType) e a.
Exception e =>
APIClient k a -> (e -> APIClient k a) -> APIClient k a
$cp1MonadCatch :: forall (k :: APIType). MonadThrow (APIClient k)
MonadCatch
    )
  deriving (Monad (APIClient k)
Monad (APIClient k)
-> (Maybe [Status] -> Request -> APIClient k Response)
-> (forall a. ClientError -> APIClient k a)
-> RunClient (APIClient k)
Maybe [Status] -> Request -> APIClient k Response
ClientError -> APIClient k a
forall a. ClientError -> APIClient k a
forall (k :: APIType). Monad (APIClient k)
forall (k :: APIType).
Maybe [Status] -> Request -> APIClient k Response
forall (k :: APIType) a. ClientError -> APIClient k a
forall (m :: Type -> Type).
Monad m
-> (Maybe [Status] -> Request -> m Response)
-> (forall a. ClientError -> m a)
-> RunClient m
throwClientError :: ClientError -> APIClient k a
$cthrowClientError :: forall (k :: APIType) a. ClientError -> APIClient k a
runRequestAcceptStatus :: Maybe [Status] -> Request -> APIClient k Response
$crunRequestAcceptStatus :: forall (k :: APIType).
Maybe [Status] -> Request -> APIClient k Response
$cp1RunClient :: forall (k :: APIType). Monad (APIClient k)
RunClient) via ClientM

-- | Class to reify 'BaseUrl' from 'APIType'.
class HasBaseUrl (k :: APIType) where
  getBaseUrl :: BaseUrl

instance HasBaseUrl 'ArchLinux where
  getBaseUrl :: BaseUrl
getBaseUrl = Scheme -> String -> Int -> String -> BaseUrl
BaseUrl Scheme
Https String
"www.archlinux.org" Int
443 String
""

instance HasBaseUrl 'Aur where
  getBaseUrl :: BaseUrl
getBaseUrl = Scheme -> String -> Int -> String -> BaseUrl
BaseUrl Scheme
Https String
"aur.archlinux.org" Int
443 String
""

-- | Runs 'APIClient'.
--
-- It calls 'getBaseUrl', then creates 'ClientEnv', finally calls 'runClientM'.
runAPIClient :: forall s a. HasBaseUrl s => Manager -> APIClient s a -> IO (Either ClientError a)
runAPIClient :: Manager -> APIClient s a -> IO (Either ClientError a)
runAPIClient Manager
manager APIClient s a
m = ClientM a -> ClientEnv -> IO (Either ClientError a)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM (APIClient s a -> ClientM a
forall (k :: APIType) a. APIClient k a -> ClientM a
unWrapClientM APIClient s a
m) (ClientEnv -> IO (Either ClientError a))
-> ClientEnv -> IO (Either ClientError a)
forall a b. (a -> b) -> a -> b
$ Manager -> BaseUrl -> ClientEnv
mkClientEnv Manager
manager (BaseUrl -> ClientEnv) -> BaseUrl -> ClientEnv
forall a b. (a -> b) -> a -> b
$ HasBaseUrl s => BaseUrl
forall (k :: APIType). HasBaseUrl k => BaseUrl
getBaseUrl @s

-- | Like 'runAPIClient', but creates a 'Manager'.
runAPIClient' :: HasBaseUrl s => APIClient s a -> IO (Either ClientError a)
runAPIClient' :: APIClient s a -> IO (Either ClientError a)
runAPIClient' APIClient s a
m = IO Manager
forall (m :: Type -> Type). MonadIO m => m Manager
newTlsManager IO Manager
-> (Manager -> IO (Either ClientError a))
-> IO (Either ClientError a)
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Manager -> APIClient s a -> IO (Either ClientError a))
-> APIClient s a -> Manager -> IO (Either ClientError a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Manager -> APIClient s a -> IO (Either ClientError a)
forall (s :: APIType) a.
HasBaseUrl s =>
Manager -> APIClient s a -> IO (Either ClientError a)
runAPIClient APIClient s a
m

-----------------------------------------------------------------------------

-- | Options available in searching packages in Arch Linux official repositories.
--
-- See 'searchPackage'.
data SearchOptions = SearchOptions
  { SearchOptions -> Maybe Text
_nameOrDescription :: Maybe Text,
    SearchOptions -> Maybe Text
_exactName :: Maybe Text,
    SearchOptions -> Maybe Text
_targetDescription :: Maybe Text,
    SearchOptions -> [Repo]
_targetRepositories :: [Repo],
    SearchOptions -> [Arch]
_targetArchitectures :: [Arch],
    SearchOptions -> Maybe Text
_targetMaintianer :: Maybe Text,
    SearchOptions -> Maybe Text
_targetPackager :: Maybe Text,
    SearchOptions -> Maybe Flagged
_isFlagged :: Maybe Flagged
  }
  deriving stock ((forall x. SearchOptions -> Rep SearchOptions x)
-> (forall x. Rep SearchOptions x -> SearchOptions)
-> Generic SearchOptions
forall x. Rep SearchOptions x -> SearchOptions
forall x. SearchOptions -> Rep SearchOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SearchOptions x -> SearchOptions
$cfrom :: forall x. SearchOptions -> Rep SearchOptions x
Generic, SearchOptions -> SearchOptions -> Bool
(SearchOptions -> SearchOptions -> Bool)
-> (SearchOptions -> SearchOptions -> Bool) -> Eq SearchOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchOptions -> SearchOptions -> Bool
$c/= :: SearchOptions -> SearchOptions -> Bool
== :: SearchOptions -> SearchOptions -> Bool
$c== :: SearchOptions -> SearchOptions -> Bool
Eq, Eq SearchOptions
Eq SearchOptions
-> (SearchOptions -> SearchOptions -> Ordering)
-> (SearchOptions -> SearchOptions -> Bool)
-> (SearchOptions -> SearchOptions -> Bool)
-> (SearchOptions -> SearchOptions -> Bool)
-> (SearchOptions -> SearchOptions -> Bool)
-> (SearchOptions -> SearchOptions -> SearchOptions)
-> (SearchOptions -> SearchOptions -> SearchOptions)
-> Ord SearchOptions
SearchOptions -> SearchOptions -> Bool
SearchOptions -> SearchOptions -> Ordering
SearchOptions -> SearchOptions -> SearchOptions
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 :: SearchOptions -> SearchOptions -> SearchOptions
$cmin :: SearchOptions -> SearchOptions -> SearchOptions
max :: SearchOptions -> SearchOptions -> SearchOptions
$cmax :: SearchOptions -> SearchOptions -> SearchOptions
>= :: SearchOptions -> SearchOptions -> Bool
$c>= :: SearchOptions -> SearchOptions -> Bool
> :: SearchOptions -> SearchOptions -> Bool
$c> :: SearchOptions -> SearchOptions -> Bool
<= :: SearchOptions -> SearchOptions -> Bool
$c<= :: SearchOptions -> SearchOptions -> Bool
< :: SearchOptions -> SearchOptions -> Bool
$c< :: SearchOptions -> SearchOptions -> Bool
compare :: SearchOptions -> SearchOptions -> Ordering
$ccompare :: SearchOptions -> SearchOptions -> Ordering
$cp1Ord :: Eq SearchOptions
Ord, Int -> SearchOptions -> ShowS
[SearchOptions] -> ShowS
SearchOptions -> String
(Int -> SearchOptions -> ShowS)
-> (SearchOptions -> String)
-> ([SearchOptions] -> ShowS)
-> Show SearchOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SearchOptions] -> ShowS
$cshowList :: [SearchOptions] -> ShowS
show :: SearchOptions -> String
$cshow :: SearchOptions -> String
showsPrec :: Int -> SearchOptions -> ShowS
$cshowsPrec :: Int -> SearchOptions -> ShowS
Show)

-- | An empty options value for convenient.
--
-- For example,
-- 
-- > let options =
-- >       emptySearchOptions
-- >         & nameOrDescription ?~ "kea"
-- >         & targetRepositories .~ [Community, CommunityTesting]
-- > searchPackage options
-- 
-- searchs packages whose names or descriptions contain @kea@, from @Community@ or @Community-Testing@.
emptySearchOptions :: SearchOptions
emptySearchOptions :: SearchOptions
emptySearchOptions = Maybe Text
-> Maybe Text
-> Maybe Text
-> [Repo]
-> [Arch]
-> Maybe Text
-> Maybe Text
-> Maybe Flagged
-> SearchOptions
SearchOptions Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing [] [] Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Flagged
forall a. Maybe a
Nothing

-- | Gets details of an exact package.
getPackageDetails ::
  -- | official repository
  Repo ->
  -- | arch
  Arch ->
  -- | exact name
  Text ->
  APIClient 'ArchLinux PackageInformation
getPackageDetails :: Repo -> Arch -> Text -> APIClient 'ArchLinux PackageInformation
getPackageDetails Repo
r Arch
a Text
p = ClientM PackageInformation
-> APIClient 'ArchLinux PackageInformation
forall (k :: APIType) a. ClientM a -> APIClient k a
APIClient (ClientM PackageInformation
 -> APIClient 'ArchLinux PackageInformation)
-> ClientM PackageInformation
-> APIClient 'ArchLinux PackageInformation
forall a b. (a -> b) -> a -> b
$ Proxy GetPackageDetails
-> Repo -> Arch -> Text -> ClientM PackageInformation
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy GetPackageDetails
forall k (t :: k). Proxy t
Proxy @GetPackageDetails) Repo
r Arch
a Text
p

-- | Gets files list of an exact package.
getPackageFiles ::
  -- | official repository
  Repo ->
  -- | arch
  Arch ->
  -- | exact name
  Text ->
  APIClient 'ArchLinux PackageFiles
getPackageFiles :: Repo -> Arch -> Text -> APIClient 'ArchLinux PackageFiles
getPackageFiles Repo
r Arch
a Text
p = ClientM PackageFiles -> APIClient 'ArchLinux PackageFiles
forall (k :: APIType) a. ClientM a -> APIClient k a
APIClient (ClientM PackageFiles -> APIClient 'ArchLinux PackageFiles)
-> ClientM PackageFiles -> APIClient 'ArchLinux PackageFiles
forall a b. (a -> b) -> a -> b
$ Proxy GetPackageFiles
-> Repo -> Arch -> Text -> ClientM PackageFiles
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy GetPackageFiles
forall k (t :: k). Proxy t
Proxy @GetPackageFiles) Repo
r Arch
a Text
p

-- | Searches packages.
--
-- See 'SearchOptions' and 'emptySearchOptions'.
searchPackage :: SearchOptions -> APIClient 'ArchLinux (ArchLinuxResponse PackageInformation)
searchPackage :: SearchOptions
-> APIClient 'ArchLinux (ArchLinuxResponse PackageInformation)
searchPackage SearchOptions {[Arch]
[Repo]
Maybe Text
Maybe Flagged
_isFlagged :: Maybe Flagged
_targetPackager :: Maybe Text
_targetMaintianer :: Maybe Text
_targetArchitectures :: [Arch]
_targetRepositories :: [Repo]
_targetDescription :: Maybe Text
_exactName :: Maybe Text
_nameOrDescription :: Maybe Text
_isFlagged :: SearchOptions -> Maybe Flagged
_targetPackager :: SearchOptions -> Maybe Text
_targetMaintianer :: SearchOptions -> Maybe Text
_targetArchitectures :: SearchOptions -> [Arch]
_targetRepositories :: SearchOptions -> [Repo]
_targetDescription :: SearchOptions -> Maybe Text
_exactName :: SearchOptions -> Maybe Text
_nameOrDescription :: SearchOptions -> Maybe Text
..} =
  let f :: Client ClientM SearchPackage
f = Proxy SearchPackage -> Client ClientM SearchPackage
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy SearchPackage
forall k (t :: k). Proxy t
Proxy @SearchPackage)
   in ClientM (ArchLinuxResponse PackageInformation)
-> APIClient 'ArchLinux (ArchLinuxResponse PackageInformation)
forall (k :: APIType) a. ClientM a -> APIClient k a
APIClient (ClientM (ArchLinuxResponse PackageInformation)
 -> APIClient 'ArchLinux (ArchLinuxResponse PackageInformation))
-> ClientM (ArchLinuxResponse PackageInformation)
-> APIClient 'ArchLinux (ArchLinuxResponse PackageInformation)
forall a b. (a -> b) -> a -> b
$
        Maybe Text
-> Maybe Text
-> Maybe Text
-> [Repo]
-> [Arch]
-> Maybe Text
-> Maybe Text
-> Maybe Flagged
-> ClientM (ArchLinuxResponse PackageInformation)
f
          Maybe Text
_nameOrDescription
          Maybe Text
_exactName
          Maybe Text
_targetDescription
          [Repo]
_targetRepositories
          [Arch]
_targetArchitectures
          Maybe Text
_targetMaintianer
          Maybe Text
_targetPackager
          Maybe Flagged
_isFlagged

-----------------------------------------------------------------------------

-- | Searches packages in AUR by what?
data AurSearchType
  = ByName
  | ByNameOrDesc
  | ByMaintainer
  | ByDepends
  | ByMakedepends
  | ByOptdepends
  | ByCheckdepends
  deriving stock ((forall x. AurSearchType -> Rep AurSearchType x)
-> (forall x. Rep AurSearchType x -> AurSearchType)
-> Generic AurSearchType
forall x. Rep AurSearchType x -> AurSearchType
forall x. AurSearchType -> Rep AurSearchType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AurSearchType x -> AurSearchType
$cfrom :: forall x. AurSearchType -> Rep AurSearchType x
Generic, AurSearchType -> AurSearchType -> Bool
(AurSearchType -> AurSearchType -> Bool)
-> (AurSearchType -> AurSearchType -> Bool) -> Eq AurSearchType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AurSearchType -> AurSearchType -> Bool
$c/= :: AurSearchType -> AurSearchType -> Bool
== :: AurSearchType -> AurSearchType -> Bool
$c== :: AurSearchType -> AurSearchType -> Bool
Eq, Eq AurSearchType
Eq AurSearchType
-> (AurSearchType -> AurSearchType -> Ordering)
-> (AurSearchType -> AurSearchType -> Bool)
-> (AurSearchType -> AurSearchType -> Bool)
-> (AurSearchType -> AurSearchType -> Bool)
-> (AurSearchType -> AurSearchType -> Bool)
-> (AurSearchType -> AurSearchType -> AurSearchType)
-> (AurSearchType -> AurSearchType -> AurSearchType)
-> Ord AurSearchType
AurSearchType -> AurSearchType -> Bool
AurSearchType -> AurSearchType -> Ordering
AurSearchType -> AurSearchType -> AurSearchType
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 :: AurSearchType -> AurSearchType -> AurSearchType
$cmin :: AurSearchType -> AurSearchType -> AurSearchType
max :: AurSearchType -> AurSearchType -> AurSearchType
$cmax :: AurSearchType -> AurSearchType -> AurSearchType
>= :: AurSearchType -> AurSearchType -> Bool
$c>= :: AurSearchType -> AurSearchType -> Bool
> :: AurSearchType -> AurSearchType -> Bool
$c> :: AurSearchType -> AurSearchType -> Bool
<= :: AurSearchType -> AurSearchType -> Bool
$c<= :: AurSearchType -> AurSearchType -> Bool
< :: AurSearchType -> AurSearchType -> Bool
$c< :: AurSearchType -> AurSearchType -> Bool
compare :: AurSearchType -> AurSearchType -> Ordering
$ccompare :: AurSearchType -> AurSearchType -> Ordering
$cp1Ord :: Eq AurSearchType
Ord, Int -> AurSearchType
AurSearchType -> Int
AurSearchType -> [AurSearchType]
AurSearchType -> AurSearchType
AurSearchType -> AurSearchType -> [AurSearchType]
AurSearchType -> AurSearchType -> AurSearchType -> [AurSearchType]
(AurSearchType -> AurSearchType)
-> (AurSearchType -> AurSearchType)
-> (Int -> AurSearchType)
-> (AurSearchType -> Int)
-> (AurSearchType -> [AurSearchType])
-> (AurSearchType -> AurSearchType -> [AurSearchType])
-> (AurSearchType -> AurSearchType -> [AurSearchType])
-> (AurSearchType
    -> AurSearchType -> AurSearchType -> [AurSearchType])
-> Enum AurSearchType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: AurSearchType -> AurSearchType -> AurSearchType -> [AurSearchType]
$cenumFromThenTo :: AurSearchType -> AurSearchType -> AurSearchType -> [AurSearchType]
enumFromTo :: AurSearchType -> AurSearchType -> [AurSearchType]
$cenumFromTo :: AurSearchType -> AurSearchType -> [AurSearchType]
enumFromThen :: AurSearchType -> AurSearchType -> [AurSearchType]
$cenumFromThen :: AurSearchType -> AurSearchType -> [AurSearchType]
enumFrom :: AurSearchType -> [AurSearchType]
$cenumFrom :: AurSearchType -> [AurSearchType]
fromEnum :: AurSearchType -> Int
$cfromEnum :: AurSearchType -> Int
toEnum :: Int -> AurSearchType
$ctoEnum :: Int -> AurSearchType
pred :: AurSearchType -> AurSearchType
$cpred :: AurSearchType -> AurSearchType
succ :: AurSearchType -> AurSearchType
$csucc :: AurSearchType -> AurSearchType
Enum, Int -> AurSearchType -> ShowS
[AurSearchType] -> ShowS
AurSearchType -> String
(Int -> AurSearchType -> ShowS)
-> (AurSearchType -> String)
-> ([AurSearchType] -> ShowS)
-> Show AurSearchType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AurSearchType] -> ShowS
$cshowList :: [AurSearchType] -> ShowS
show :: AurSearchType -> String
$cshow :: AurSearchType -> String
showsPrec :: Int -> AurSearchType -> ShowS
$cshowsPrec :: Int -> AurSearchType -> ShowS
Show)

searchTypeToValue :: AurSearchType -> Text
searchTypeToValue :: AurSearchType -> Text
searchTypeToValue = \case
  AurSearchType
ByName -> Text
"name"
  AurSearchType
ByNameOrDesc -> Text
"name-desc"
  AurSearchType
ByMaintainer -> Text
"maintainer"
  AurSearchType
ByDepends -> Text
"depends"
  AurSearchType
ByMakedepends -> Text
"makedepends"
  AurSearchType
ByOptdepends -> Text
"optdepends"
  AurSearchType
ByCheckdepends -> Text
"checkdepends"

aurRPC :: Text -> Maybe Text -> [Text] -> ClientM Value
aurRPC :: Text -> Maybe Text -> [Text] -> ClientM Value
aurRPC = Proxy AurRPC
-> Int -> Text -> Maybe Text -> [Text] -> ClientM Value
forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (Proxy AurRPC
forall k (t :: k). Proxy t
Proxy @AurRPC) Int
5

-- This is evil and cheating!!
-- Use this to report delayed json decode error in 'HttpClientError'
dummyResponse :: Response
dummyResponse :: Response
dummyResponse = Status -> Seq Header -> HttpVersion -> ByteString -> Response
forall a. Status -> Seq Header -> HttpVersion -> a -> ResponseF a
Response (Int -> Status
forall a. Enum a => Int -> a
toEnum Int
0) Seq Header
forall a. Monoid a => a
mempty HttpVersion
http11 ByteString
"dummy response for error display"

parseResult :: (FromJSON a) => Value -> ClientM a
parseResult :: Value -> ClientM a
parseResult Value
v = case Value -> Result a
forall a. FromJSON a => Value -> Result a
fromJSON Value
v of
  Success a
x -> a -> ClientM a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure a
x
  Data.Aeson.Error String
err -> ClientError -> ClientM a
forall (m :: Type -> Type) a. RunClient m => ClientError -> m a
throwClientError (ClientError -> ClientM a) -> ClientError -> ClientM a
forall a b. (a -> b) -> a -> b
$ Text -> Response -> ClientError
DecodeFailure (String -> Text
T.pack String
err) Response
dummyResponse

-- | Searches packages in AUR.
searchAur ::
  -- | search type
  AurSearchType ->
  -- | search argument
  Text ->
  APIClient 'Aur (AurResponse [AurSearch])
searchAur :: AurSearchType -> Text -> APIClient 'Aur (AurResponse [AurSearch])
searchAur (AurSearchType -> Text
searchTypeToValue -> Text
f) Text
arg = ClientM (AurResponse [AurSearch])
-> APIClient 'Aur (AurResponse [AurSearch])
forall (k :: APIType) a. ClientM a -> APIClient k a
APIClient (ClientM (AurResponse [AurSearch])
 -> APIClient 'Aur (AurResponse [AurSearch]))
-> ClientM (AurResponse [AurSearch])
-> APIClient 'Aur (AurResponse [AurSearch])
forall a b. (a -> b) -> a -> b
$ do
  Value
result <- Text -> Maybe Text -> [Text] -> ClientM Value
aurRPC Text
"search" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
f) [Text
arg]
  Value -> ClientM (AurResponse [AurSearch])
forall a. FromJSON a => Value -> ClientM a
parseResult Value
result

-- | Gets details of a set of packages in AUR.
getAurInfo ::
  -- | exact names
  [Text] ->
  APIClient 'Aur (AurResponse [AurInfo])
getAurInfo :: [Text] -> APIClient 'Aur (AurResponse [AurInfo])
getAurInfo [Text]
exactNames = ClientM (AurResponse [AurInfo])
-> APIClient 'Aur (AurResponse [AurInfo])
forall (k :: APIType) a. ClientM a -> APIClient k a
APIClient (ClientM (AurResponse [AurInfo])
 -> APIClient 'Aur (AurResponse [AurInfo]))
-> ClientM (AurResponse [AurInfo])
-> APIClient 'Aur (AurResponse [AurInfo])
forall a b. (a -> b) -> a -> b
$ do
  Value
result <- Text -> Maybe Text -> [Text] -> ClientM Value
aurRPC Text
"info" Maybe Text
forall a. Maybe a
Nothing [Text]
exactNames
  Value -> ClientM (AurResponse [AurInfo])
forall a. FromJSON a => Value -> ClientM a
parseResult Value
result