{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

-- | Copyright: (c) 2020 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <1793913507@qq.com>
-- Stability: experimental
-- Portability: portable
-- This module supports <https://aur.archlinux.org/ AUR> searching.
module Distribution.ArchHs.Aur
  ( AurReply (..),
    AurSearch (..),
    AurInfo (..),
    Aur,
    searchByName,
    infoByName,
    isInAur,
    aurToIO,
  )
where

import Data.Aeson
import Data.Aeson.Ext (generateJSONInstance)
import Data.Text (Text, pack)
import Distribution.ArchHs.Exception
import Distribution.ArchHs.Internal.Prelude
import Distribution.ArchHs.Name
import Distribution.ArchHs.Types
import Network.HTTP.Req

-- | AUR response
data AurReply a = AurReply
  { AurReply a -> Int
r_version :: Int,
    AurReply a -> String
r_type :: String,
    AurReply a -> Int
r_resultcount :: Int,
    AurReply a -> [a]
r_results :: [a]
  }
  deriving stock (Int -> AurReply a -> ShowS
[AurReply a] -> ShowS
AurReply a -> String
(Int -> AurReply a -> ShowS)
-> (AurReply a -> String)
-> ([AurReply a] -> ShowS)
-> Show (AurReply a)
forall a. Show a => Int -> AurReply a -> ShowS
forall a. Show a => [AurReply a] -> ShowS
forall a. Show a => AurReply a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AurReply a] -> ShowS
$cshowList :: forall a. Show a => [AurReply a] -> ShowS
show :: AurReply a -> String
$cshow :: forall a. Show a => AurReply a -> String
showsPrec :: Int -> AurReply a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> AurReply a -> ShowS
Show, (forall x. AurReply a -> Rep (AurReply a) x)
-> (forall x. Rep (AurReply a) x -> AurReply a)
-> Generic (AurReply a)
forall x. Rep (AurReply a) x -> AurReply a
forall x. AurReply a -> Rep (AurReply a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (AurReply a) x -> AurReply a
forall a x. AurReply a -> Rep (AurReply a) x
$cto :: forall a x. Rep (AurReply a) x -> AurReply a
$cfrom :: forall a x. AurReply a -> Rep (AurReply a) x
Generic)

-- | AUR search result
data AurSearch = AurSearch
  { AurSearch -> Int
s_ID :: Int,
    AurSearch -> String
s_Name :: String,
    AurSearch -> Int
s_PackageBaseID :: Int,
    AurSearch -> String
s_PackageBase :: String,
    AurSearch -> String
s_Version :: String,
    AurSearch -> String
s_Description :: String,
    AurSearch -> String
s_URL :: String,
    AurSearch -> Int
s_NumVotes :: Int,
    AurSearch -> Double
s_Popularity :: Double,
    AurSearch -> Maybe Int
s_OutOfDate :: Maybe Int,
    AurSearch -> Maybe String
s_Maintainer :: Maybe String,
    AurSearch -> Int
s_FirstSubmitted :: Int, -- UTC
    AurSearch -> Int
s_LastModified :: Int, -- UTC
    AurSearch -> String
s_URLPath :: String
  }
  deriving stock (Int -> AurSearch -> ShowS
[AurSearch] -> ShowS
AurSearch -> String
(Int -> AurSearch -> ShowS)
-> (AurSearch -> String)
-> ([AurSearch] -> ShowS)
-> Show AurSearch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AurSearch] -> ShowS
$cshowList :: [AurSearch] -> ShowS
show :: AurSearch -> String
$cshow :: AurSearch -> String
showsPrec :: Int -> AurSearch -> ShowS
$cshowsPrec :: Int -> AurSearch -> ShowS
Show, (forall x. AurSearch -> Rep AurSearch x)
-> (forall x. Rep AurSearch x -> AurSearch) -> Generic AurSearch
forall x. Rep AurSearch x -> AurSearch
forall x. AurSearch -> Rep AurSearch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AurSearch x -> AurSearch
$cfrom :: forall x. AurSearch -> Rep AurSearch x
Generic)

-- | AUR info result
data AurInfo = AurInfo
  { AurInfo -> Int
i_ID :: Int,
    AurInfo -> String
i_Name :: String,
    AurInfo -> Int
i_PackageBaseID :: Int,
    AurInfo -> String
i_PackageBase :: String,
    AurInfo -> String
i_Version :: String,
    AurInfo -> String
i_Description :: String,
    AurInfo -> String
i_URL :: String,
    AurInfo -> Int
i_NumVotes :: Int,
    AurInfo -> Double
i_Popularity :: Double,
    AurInfo -> Maybe Int
i_OutOfDate :: Maybe Int,
    AurInfo -> Maybe String
i_Maintainer :: Maybe String,
    AurInfo -> Int
i_FirstSubmitted :: Int, -- UTC
    AurInfo -> Int
i_LastModified :: Int, -- UTC
    AurInfo -> String
i_URLPath :: String,
    AurInfo -> Maybe [String]
i_Depends :: Maybe [String],
    AurInfo -> Maybe [String]
i_MakeDepends :: Maybe [String],
    AurInfo -> Maybe [String]
i_OptDepends :: Maybe [String],
    AurInfo -> Maybe [String]
i_CheckDepends :: Maybe [String],
    AurInfo -> Maybe [String]
i_Conflicts :: Maybe [String],
    AurInfo -> Maybe [String]
i_Provides :: Maybe [String],
    AurInfo -> Maybe [String]
i_Replaces :: Maybe [String],
    AurInfo -> Maybe [String]
i_Groups :: Maybe [String],
    AurInfo -> Maybe [String]
i_License :: Maybe [String],
    AurInfo -> Maybe [String]
i_Keywords :: Maybe [String]
  }
  deriving stock (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)

instance (FromJSON a) => FromJSON (AurReply a) where
  parseJSON :: Value -> Parser (AurReply a)
parseJSON (Object Object
v) =
    Int -> String -> Int -> [a] -> AurReply a
forall a. Int -> String -> Int -> [a] -> AurReply a
AurReply
      (Int -> String -> Int -> [a] -> AurReply a)
-> Parser Int -> Parser (String -> Int -> [a] -> AurReply a)
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 (String -> Int -> [a] -> AurReply a)
-> Parser String -> Parser (Int -> [a] -> AurReply a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type"
        Parser (Int -> [a] -> AurReply a)
-> Parser Int -> Parser ([a] -> AurReply a)
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 ([a] -> AurReply a) -> Parser [a] -> Parser (AurReply a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser [a]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"results"
  parseJSON Value
_ = String -> Parser (AurReply a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unable to parse AUR reply."

instance (ToJSON a) => ToJSON (AurReply a)

$(generateJSONInstance ''AurSearch)
$(generateJSONInstance ''AurInfo)

-- | AUR Effect
data Aur m a where
  SearchByName :: String -> Aur m (Maybe AurSearch)
  InfoByName :: String -> Aur m (Maybe AurInfo)
  IsInAur :: HasMyName n => n -> Aur m Bool

makeSem_ ''Aur

-- | Serach a package from AUR
searchByName :: Member Aur r => String -> Sem r (Maybe AurSearch)

-- | Get package info from AUR
infoByName :: Member Aur r => String -> Sem r (Maybe AurInfo)

-- | Check whether a __haskell__ package exists in AUR
isInAur :: (HasMyName n, Member Aur r) => n -> Sem r Bool
baseURL :: Url 'Https
baseURL :: Url 'Https
baseURL = Text -> Url 'Https
https Text
"aur.archlinux.org" Url 'Https -> Text -> Url 'Https
forall (scheme :: Scheme). Url scheme -> Text -> Url scheme
/: Text
"rpc"

-- | Run 'Aur' effect.
aurToIO :: Members [WithMyErr, Embed IO] r => Sem (Aur ': r) a -> Sem r a
aurToIO :: Sem (Aur : r) a -> Sem r a
aurToIO = (forall x (rInitial :: EffectRow). Aur (Sem rInitial) x -> Sem r x)
-> Sem (Aur : r) a -> Sem r a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall x (rInitial :: EffectRow). e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall x (rInitial :: EffectRow).
  Aur (Sem rInitial) x -> Sem r x)
 -> Sem (Aur : r) a -> Sem r a)
-> (forall x (rInitial :: EffectRow).
    Aur (Sem rInitial) x -> Sem r x)
-> Sem (Aur : r) a
-> Sem r a
forall a b. (a -> b) -> a -> b
$ \case
  (SearchByName name) -> do
    let parms :: Option 'Https
parms =
          Text
"v" Text -> Text -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: (Text
"5" :: Text)
            Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<> Text
"type" Text -> Text -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: (Text
"search" :: Text)
            Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<> Text
"by" Text -> Text -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: (Text
"name" :: Text)
            Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<> Text
"arg" Text -> Text -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: String -> Text
pack String
name
        r :: Req (JsonResponse (AurReply AurSearch))
r = GET
-> Url 'Https
-> NoReqBody
-> Proxy (JsonResponse (AurReply AurSearch))
-> Option 'Https
-> Req (JsonResponse (AurReply AurSearch))
forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
 HttpResponse response,
 HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> m response
req GET
GET Url 'Https
baseURL NoReqBody
NoReqBody Proxy (JsonResponse (AurReply AurSearch))
forall a. Proxy (JsonResponse a)
jsonResponse Option 'Https
parms
    JsonResponse (AurReply AurSearch)
response <- IO (JsonResponse (AurReply AurSearch))
-> Sem r (JsonResponse (AurReply AurSearch))
forall (r :: EffectRow) a.
Members '[WithMyErr, Embed IO] r =>
IO a -> Sem r a
interceptHttpException (IO (JsonResponse (AurReply AurSearch))
 -> Sem r (JsonResponse (AurReply AurSearch)))
-> IO (JsonResponse (AurReply AurSearch))
-> Sem r (JsonResponse (AurReply AurSearch))
forall a b. (a -> b) -> a -> b
$ HttpConfig
-> Req (JsonResponse (AurReply AurSearch))
-> IO (JsonResponse (AurReply AurSearch))
forall (m :: * -> *) a. MonadIO m => HttpConfig -> Req a -> m a
runReq HttpConfig
defaultHttpConfig Req (JsonResponse (AurReply AurSearch))
r
    let AurReply AurSearch
body :: AurReply AurSearch = JsonResponse (AurReply AurSearch)
-> HttpResponseBody (JsonResponse (AurReply AurSearch))
forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody JsonResponse (AurReply AurSearch)
response
    Maybe AurSearch -> Sem r (Maybe AurSearch)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe AurSearch -> Sem r (Maybe AurSearch))
-> Maybe AurSearch -> Sem r (Maybe AurSearch)
forall a b. (a -> b) -> a -> b
$ case AurReply AurSearch -> Int
forall a. AurReply a -> Int
r_resultcount AurReply AurSearch
body of
      Int
1 -> AurSearch -> Maybe AurSearch
forall a. a -> Maybe a
Just (AurSearch -> Maybe AurSearch)
-> ([AurSearch] -> AurSearch) -> [AurSearch] -> Maybe AurSearch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AurSearch] -> AurSearch
forall a. [a] -> a
head ([AurSearch] -> Maybe AurSearch) -> [AurSearch] -> Maybe AurSearch
forall a b. (a -> b) -> a -> b
$ AurReply AurSearch -> [AurSearch]
forall a. AurReply a -> [a]
r_results AurReply AurSearch
body
      Int
_ -> Maybe AurSearch
forall a. Maybe a
Nothing
  (InfoByName name) -> do
    let parms :: Option 'Https
parms =
          Text
"v" Text -> Text -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: (Text
"5" :: Text)
            Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<> Text
"type" Text -> Text -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: (Text
"info" :: Text)
            Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<> Text
"by" Text -> Text -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: (Text
"name" :: Text)
            Option 'Https -> Option 'Https -> Option 'Https
forall a. Semigroup a => a -> a -> a
<> Text
"arg[]" Text -> Text -> Option 'Https
forall param a.
(QueryParam param, ToHttpApiData a) =>
Text -> a -> param
=: String -> Text
pack String
name
        r :: Req (JsonResponse (AurReply AurInfo))
r = GET
-> Url 'Https
-> NoReqBody
-> Proxy (JsonResponse (AurReply AurInfo))
-> Option 'Https
-> Req (JsonResponse (AurReply AurInfo))
forall (m :: * -> *) method body response (scheme :: Scheme).
(MonadHttp m, HttpMethod method, HttpBody body,
 HttpResponse response,
 HttpBodyAllowed (AllowsBody method) (ProvidesBody body)) =>
method
-> Url scheme
-> body
-> Proxy response
-> Option scheme
-> m response
req GET
GET Url 'Https
baseURL NoReqBody
NoReqBody Proxy (JsonResponse (AurReply AurInfo))
forall a. Proxy (JsonResponse a)
jsonResponse Option 'Https
parms
    JsonResponse (AurReply AurInfo)
response <- IO (JsonResponse (AurReply AurInfo))
-> Sem r (JsonResponse (AurReply AurInfo))
forall (r :: EffectRow) a.
Members '[WithMyErr, Embed IO] r =>
IO a -> Sem r a
interceptHttpException (IO (JsonResponse (AurReply AurInfo))
 -> Sem r (JsonResponse (AurReply AurInfo)))
-> IO (JsonResponse (AurReply AurInfo))
-> Sem r (JsonResponse (AurReply AurInfo))
forall a b. (a -> b) -> a -> b
$ HttpConfig
-> Req (JsonResponse (AurReply AurInfo))
-> IO (JsonResponse (AurReply AurInfo))
forall (m :: * -> *) a. MonadIO m => HttpConfig -> Req a -> m a
runReq HttpConfig
defaultHttpConfig Req (JsonResponse (AurReply AurInfo))
r
    let AurReply AurInfo
body :: AurReply AurInfo = JsonResponse (AurReply AurInfo)
-> HttpResponseBody (JsonResponse (AurReply AurInfo))
forall response.
HttpResponse response =>
response -> HttpResponseBody response
responseBody JsonResponse (AurReply AurInfo)
response
    Maybe AurInfo -> Sem r (Maybe AurInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe AurInfo -> Sem r (Maybe AurInfo))
-> Maybe AurInfo -> Sem r (Maybe AurInfo)
forall a b. (a -> b) -> a -> b
$ case AurReply AurInfo -> Int
forall a. AurReply a -> Int
r_resultcount AurReply AurInfo
body of
      Int
1 -> AurInfo -> Maybe AurInfo
forall a. a -> Maybe a
Just (AurInfo -> Maybe AurInfo)
-> ([AurInfo] -> AurInfo) -> [AurInfo] -> Maybe AurInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AurInfo] -> AurInfo
forall a. [a] -> a
head ([AurInfo] -> Maybe AurInfo) -> [AurInfo] -> Maybe AurInfo
forall a b. (a -> b) -> a -> b
$ AurReply AurInfo -> [AurInfo]
forall a. AurReply a -> [a]
r_results AurReply AurInfo
body
      Int
_ -> Maybe AurInfo
forall a. Maybe a
Nothing
  (IsInAur name) -> do
    Maybe AurSearch
result <- Sem (Aur : r) (Maybe AurSearch) -> Sem r (Maybe AurSearch)
forall (r :: EffectRow) a.
Members '[WithMyErr, Embed IO] r =>
Sem (Aur : r) a -> Sem r a
aurToIO (Sem (Aur : r) (Maybe AurSearch) -> Sem r (Maybe AurSearch))
-> (n -> Sem (Aur : r) (Maybe AurSearch))
-> n
-> Sem r (Maybe AurSearch)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Sem (Aur : r) (Maybe AurSearch)
forall (r :: EffectRow).
Member Aur r =>
String -> Sem r (Maybe AurSearch)
searchByName (String -> Sem (Aur : r) (Maybe AurSearch))
-> (n -> String) -> n -> Sem (Aur : r) (Maybe AurSearch)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommunityName -> String
unCommunityName (CommunityName -> String) -> (n -> CommunityName) -> n -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> CommunityName
forall n. HasMyName n => n -> CommunityName
toCommunityName (n -> Sem r (Maybe AurSearch)) -> n -> Sem r (Maybe AurSearch)
forall a b. (a -> b) -> a -> b
$ n
name
    Bool -> Sem r Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Sem r Bool) -> Bool -> Sem r Bool
forall a b. (a -> b) -> a -> b
$ case Maybe AurSearch
result of
      Just AurSearch
_ -> Bool
True
      Maybe AurSearch
_ -> Bool
False