arch-web (empty) → 0.1.0
raw patch · 10 files changed
+846/−0 lines, 10 filesdep +HUnitdep +aesondep +arch-web
Dependencies added: HUnit, aeson, arch-web, base, deriving-aeson, exceptions, http-client, http-client-tls, http-types, lens, mtl, servant, servant-client, servant-client-core, text, time
Files
- CHANGELOG.md +5/−0
- LICENSE +21/−0
- README.md +49/−0
- arch-web.cabal +101/−0
- src/Web/ArchLinux.hs +14/−0
- src/Web/ArchLinux/API.hs +217/−0
- src/Web/ArchLinux/Types.hs +335/−0
- src/Web/ArchLinux/Types/API.hs +50/−0
- src/Web/ArchLinux/Types/Lens.hs +26/−0
- test/Main.hs +28/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# arch-web++## 0.1.0++Initial release
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2021 berberman++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.md view
@@ -0,0 +1,49 @@+# arch-web++[](https://hackage.haskell.org/package/arch-web)+[](LICENSE)++++`arch-web` is a simple library providing functions to access [Official repositories web interface](https://wiki.archlinux.org/index.php/Official_repositories_web_interface) and [Aurweb RPC interface](https://wiki.archlinux.org/index.php/Aurweb_RPC_interface), based on [servant-client](https://hackage.haskell.org/package/servant-client).++## Documentation++Documentation of released version is available at [hackage](https://hackage.haskell.org/package/arch-web),+and of master is at [github pages](https://berberman.github.io/arch-web).++## Example++* Print [linux](https://archlinux.org/packages/core/x86_64/linux/)'s version:++```haskell+import Control.Lens+import Control.Monad (void)+import Control.Monad.IO.Class (liftIO)+import qualified Data.Text as T+import Web.ArchLinux+import Web.ArchLinux.Types.Lens++main :: IO ()+main = void . runAPIClient' $ do+ linux <- getPackageDetails Core X86_64 "linux"+ liftIO . putStrLn $ "linux in [core] has version: " <> T.unpack (linux ^. pkgver)+```++* Search keywords "yay":++```haskell+import Control.Lens +import Control.Monad (void)+import Control.Monad.IO.Class (liftIO)+import Web.ArchLinux+import Web.ArchLinux.Types.Lens++main :: IO ()+main = void . runAPIClient' $ do+ response <- searchAur ByNameOrDesc "yay"+ liftIO . print $ (response ^. results ^.. each . name)+```++* ...+
+ arch-web.cabal view
@@ -0,0 +1,101 @@+cabal-version: 2.2+name: arch-web+version: 0.1.0+synopsis: Arch Linux official and AUR web interface binding+description:+ Arch Linux official and AUR web interface binding.+ See README for details.++category: Web+license: MIT+license-file: LICENSE+author: berberman+maintainer: berberman <berberman@yandex.com>+copyright: Copyright (c) berberman 2021+stability: alpha+homepage: https://github.com/berberman/arch-web+bug-reports: https://github.com/berberman/arch-web/issues+extra-doc-files:+ CHANGELOG.md+ README.md++tested-with:+ GHC ==8.8.3 || ==8.8.4 || ==8.10.1 || ==8.10.2 || ==8.10.3++common common+ build-depends:+ , aeson ^>=1.5.4+ , base >=4.10 && <5+ , deriving-aeson ^>=0.2.6+ , exceptions ^>=0.10.4+ , http-client ^>=0.6.4+ , http-client-tls ^>=0.3.5+ , http-types ^>=0.12.3+ , lens ^>=4.19.2+ , mtl ^>=2.2.2+ , servant ^>=0.18.2+ , servant-client ^>=0.18.2+ , servant-client-core ^>=0.18.2+ , text ^>=1.2.3+ , time ^>=1.9.3++ default-language: Haskell2010+ ghc-options:+ -Wall -Wcompat -Widentities -Wincomplete-uni-patterns+ -Wincomplete-record-updates++ if impl(ghc >=8.0)+ ghc-options: -Wredundant-constraints++ if impl(ghc >=8.2)+ ghc-options: -fhide-source-paths++ if impl(ghc >=8.4)+ ghc-options: -Wmissing-export-lists++ if impl(ghc >=8.8)+ ghc-options: -Wmissing-deriving-strategies++ default-extensions:+ NoStarIsType+ ConstraintKinds+ DataKinds+ DeriveAnyClass+ DeriveFunctor+ DeriveGeneric+ DerivingStrategies+ DerivingVia+ FlexibleContexts+ FlexibleInstances+ FunctionalDependencies+ KindSignatures+ LambdaCase+ OverloadedStrings+ RecordWildCards+ ScopedTypeVariables+ TypeApplications+ TypeFamilies+ TypeOperators+ ViewPatterns++library+ import: common+ exposed-modules:+ Web.ArchLinux+ Web.ArchLinux.API+ Web.ArchLinux.Types+ Web.ArchLinux.Types.Lens++ other-modules: Web.ArchLinux.Types.API+ hs-source-dirs: src++test-suite arch-web-test+ import: common+ type: exitcode-stdio-1.0+ build-depends: arch-web, HUnit+ hs-source-dirs: test+ main-is: Main.hs+ +source-repository head+ type: git+ location: https://github.com/berberman/arch-web
+ src/Web/ArchLinux.hs view
@@ -0,0 +1,14 @@+-- | Copyright: (c) 2021 berberman+-- SPDX-License-Identifier: MIT+-- Maintainer: berberman <berberman@yandex.com>+-- Stability: experimental+-- Portability: portable+-- Arch Linux official repositories web interfaces and AUR web interfaces.+module Web.ArchLinux+ ( module Web.ArchLinux.Types,+ module Web.ArchLinux.API,+ )+where++import Web.ArchLinux.API+import Web.ArchLinux.Types
+ src/Web/ArchLinux/API.hs view
@@ -0,0 +1,217 @@+{-# 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 {unWrapClientM :: ClientM a}+ deriving newtype+ ( Functor,+ Applicative,+ Monad,+ MonadIO,+ Generic,+ MonadReader ClientEnv,+ MonadError ClientError,+ MonadThrow,+ MonadCatch+ )+ deriving (RunClient) via ClientM++-- | Class to reify 'BaseUrl' from 'APIType'.+class HasBaseUrl (k :: APIType) where+ getBaseUrl :: BaseUrl++instance HasBaseUrl 'ArchLinux where+ getBaseUrl = BaseUrl Https "www.archlinux.org" 443 ""++instance HasBaseUrl 'Aur where+ getBaseUrl = BaseUrl Https "aur.archlinux.org" 443 ""++-- | 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 m = runClientM (unWrapClientM m) $ mkClientEnv manager $ getBaseUrl @s++-- | Like 'runAPIClient', but creates a 'Manager'.+runAPIClient' :: HasBaseUrl s => APIClient s a -> IO (Either ClientError a)+runAPIClient' m = newTlsManager >>= flip runAPIClient m++-----------------------------------------------------------------------------++-- | Options available in searching packages in Arch Linux official repositories.+--+-- See 'searchPackage'.+data SearchOptions = SearchOptions+ { _nameOrDescription :: Maybe Text,+ _exactName :: Maybe Text,+ _targetDescription :: Maybe Text,+ _targetRepositories :: [Repo],+ _targetArchitectures :: [Arch],+ _targetMaintianer :: Maybe Text,+ _targetPackager :: Maybe Text,+ _isFlagged :: Maybe Flagged+ }+ deriving stock (Generic, Eq, Ord, 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 Nothing Nothing Nothing [] [] Nothing Nothing Nothing++-- | Gets details of an exact package.+getPackageDetails ::+ -- | official repository+ Repo ->+ -- | arch+ Arch ->+ -- | exact name+ Text ->+ APIClient 'ArchLinux PackageInformation+getPackageDetails r a p = APIClient $ client (Proxy @GetPackageDetails) r a p++-- | Gets files list of an exact package.+getPackageFiles ::+ -- | official repository+ Repo ->+ -- | arch+ Arch ->+ -- | exact name+ Text ->+ APIClient 'ArchLinux PackageFiles+getPackageFiles r a p = APIClient $ client (Proxy @GetPackageFiles) r a p++-- | Searches packages.+--+-- See 'SearchOptions' and 'emptySearchOptions'.+searchPackage :: SearchOptions -> APIClient 'ArchLinux (ArchLinuxResponse PackageInformation)+searchPackage SearchOptions {..} =+ let f = client (Proxy @SearchPackage)+ in APIClient $+ f+ _nameOrDescription+ _exactName+ _targetDescription+ _targetRepositories+ _targetArchitectures+ _targetMaintianer+ _targetPackager+ _isFlagged++-----------------------------------------------------------------------------++-- | Searches packages in AUR by what?+data AurSearchType+ = ByName+ | ByNameOrDesc+ | ByMaintainer+ | ByDepends+ | ByMakedepends+ | ByOptdepends+ | ByCheckdepends+ deriving stock (Generic, Eq, Ord, Enum, Show)++searchTypeToValue :: AurSearchType -> Text+searchTypeToValue = \case+ ByName -> "name"+ ByNameOrDesc -> "name-desc"+ ByMaintainer -> "maintainer"+ ByDepends -> "depends"+ ByMakedepends -> "makedepends"+ ByOptdepends -> "optdepends"+ ByCheckdepends -> "checkdepends"++aurRPC :: Text -> Maybe Text -> [Text] -> ClientM Value+aurRPC = client (Proxy @AurRPC) 5++-- This is evil and cheating!!+-- Use this to report delayed json decode error in 'HttpClientError'+dummyResponse :: Response+dummyResponse = Response (toEnum 0) mempty http11 "dummy response for error display"++parseResult :: (FromJSON a) => Value -> ClientM a+parseResult v = case fromJSON v of+ Success x -> pure x+ Data.Aeson.Error err -> throwClientError $ DecodeFailure (T.pack err) dummyResponse++-- | Searches packages in AUR.+searchAur ::+ -- | search type+ AurSearchType ->+ -- | search argument+ Text ->+ APIClient 'Aur (AurResponse [AurSearch])+searchAur (searchTypeToValue -> f) arg = APIClient $ do+ result <- aurRPC "search" (Just f) [arg]+ parseResult result++-- | Gets details of a set of packages in AUR.+getAurInfo ::+ -- | exact names+ [Text] ->+ APIClient 'Aur (AurResponse [AurInfo])+getAurInfo exactNames = APIClient $ do+ result <- aurRPC "info" Nothing exactNames+ parseResult result
+ src/Web/ArchLinux/Types.hs view
@@ -0,0 +1,335 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE StandaloneDeriving #-}++-- | Copyright: (c) 2021 berberman+-- SPDX-License-Identifier: MIT+-- Maintainer: berberman <berberman@yandex.com>+-- Stability: experimental+-- Portability: portable+-- This module defines types and their serializations used in API.+--+-- Fields' names are prefixed with @_@ for lenses generation,+-- consider using "Web.ArchLinux.Types.Lens" to access data types smoothly.+module Web.ArchLinux.Types+ ( -- * Arch Linux official+ Repo (..),+ Arch (..),+ License (..),+ PackageInformation (..),+ PackageFiles (..),+ Flagged (..),+ ArchLinuxResponse (..),++ -- * AUR+ AurSearch (..),+ AurInfo (..),+ AurResponseType (..),+ AurResponse (..),+ )+where++import Data.Aeson+import Data.Char (toUpper)+import Data.Maybe (fromJust, fromMaybe)+import Data.Text (Text)+import qualified Data.Text as T+import Data.Time (UTCTime)+import Deriving.Aeson+import Servant.API (ToHttpApiData (..))++type ArchLinuxJSON = CustomJSON '[FieldLabelModifier (StripPrefix "_", CamelToSnake)]++unString :: Value -> Text+unString (String x) = x+unString _ = undefined++toQueryParamViaJSON :: ToJSON a => a -> Text+toQueryParamViaJSON = unString . fromJust . decode . encode++data AurModifier++instance StringModifier AurModifier where+ getStringModifier (T.pack -> t) = T.unpack $ eat "Url" "URL" $ eat "Id" "ID" upper+ where+ upper =+ case T.uncons t of+ Just (h, s) -> T.cons (toUpper h) s+ _ -> error "impossible"+ eat prefix to input = case T.stripPrefix prefix input of+ Just x -> to <> x+ _ -> input++type AurJSON = CustomJSON '[FieldLabelModifier (StripPrefix "_", AurModifier)]++-----------------------------------------------------------------------------++-- | Official repositories.+data Repo+ = Core+ | Extra+ | Testing+ | Multilib+ | MultilibTesting+ | Community+ | CommunityTesting+ deriving stock (Show, Eq, Ord, Enum, Generic)+ deriving (FromJSON, ToJSON) via CustomJSON '[ConstructorTagModifier CamelToKebab] Repo++instance ToHttpApiData Repo where+ toQueryParam (toQueryParamViaJSON -> x) = case T.breakOn "-" x of+ (T.uncons -> Just (h, s), "") -> T.cons (toUpper h) s+ (T.uncons -> Just (h1, s1), T.uncons -> Just ('-', T.uncons -> Just (h2, s2))) ->+ T.cons (toUpper h1) s1 <> "-" <> T.cons (toUpper h2) s2+ _ -> undefined++-- | Official architectures.+data Arch+ = Any+ | I686+ | X86_64+ deriving stock (Show, Eq, Ord, Enum, Generic)+ deriving (FromJSON, ToJSON) via CustomJSON '[ConstructorTagModifier CamelToSnake] Arch++instance ToHttpApiData Arch where+ toQueryParam = toQueryParamViaJSON++-- | Liceses defined in <https://archlinux.org/packages/core/any/licenses/>.+data License+ = AGPL3+ | Apache+ | Artistic2_0+ | CDDL+ | CPL+ | EPL+ | FDL1_2+ | FDL1_3+ | GPL2+ | GPL3+ | LGPL2_1+ | LGPL3+ | LPPL+ | MPL+ | MPL2+ | PHP+ | PSF+ | PerlArtistic+ | RUBY+ | Unlicense+ | W3C+ | ZPL+ | Custom Text+ deriving stock (Show, Eq, Ord, Generic)++licenseJSONOption :: Options+licenseJSONOption =+ defaultOptions+ { fieldLabelModifier = T.unpack . T.replace "_" "." . T.pack,+ sumEncoding = UntaggedValue+ }++instance ToJSON License where+ toJSON (Custom x) = String $ "custom: " <> x+ toJSON x =+ genericToJSON licenseJSONOption x++instance FromJSON License where+ parseJSON = withText "License" $ \txt -> do+ case T.stripPrefix "custom:" txt of+ Just c -> pure $ Custom c+ _ -> genericParseJSON licenseJSONOption (String $ T.stripStart txt)++-- | Package details returned by 'Web.ArchLinux.API.getPackageDetails'.+data PackageInformation = PackageInformation+ { _pkgname :: Text,+ _pkgbase :: Text,+ _repo :: Repo,+ _arch :: Arch,+ _pkgver :: Text,+ _pkgrel :: Text,+ _epoch :: Int,+ _pkgdesc :: Text,+ _url :: Text,+ _filename :: Text,+ _compressedSize :: Int,+ _installedSize :: Int,+ _buildDate :: UTCTime,+ _lastUpdate :: UTCTime,+ _flageDate :: Maybe UTCTime,+ _maintainers :: [Text],+ _packager :: Text,+ _groups :: [Text],+ _licenses :: [License],+ _conflicts :: [Text],+ _provides :: [Text],+ _replaces :: [Text],+ _depends :: [Text],+ _optdepends :: [Text],+ _makedepends :: [Text],+ _checkdepends :: [Text]+ }+ deriving stock (Show, Eq, Ord, Generic)+ deriving (FromJSON, ToJSON) via ArchLinuxJSON PackageInformation++-- | Package files list returned by 'Web.ArchLinux.API.getPackageFiles'+data PackageFiles = PackageFiles+ { _pkgname :: Text,+ _repo :: Repo,+ _arch :: Arch,+ _pkgLastUpdate :: UTCTime,+ _filesLastUpdate :: UTCTime,+ _filesCount :: Int,+ _dirCount :: Int,+ _files :: [FilePath]+ }+ deriving stock (Show, Eq, Ord, Generic)+ deriving (FromJSON, ToJSON) via ArchLinuxJSON PackageFiles++-- | Flagged package means out-of-date.+data Flagged = Flagged | NotFlagged+ deriving stock (Show, Eq, Ord, Enum, Generic)++instance ToHttpApiData Flagged where+ toQueryParam Flagged = "Flagged"+ toQueryParam NotFlagged = "Not+Flagged"++-- | Response data type of 'Web.ArchLinux.API.searchPackage'.+data ArchLinuxResponse a = ArchLinuxResponse+ { _version :: Int,+ _limit :: Int,+ _valid :: Bool,+ _results :: [a]+ }+ deriving stock (Show, Eq, Ord, Functor, Generic)++deriving via ArchLinuxJSON (ArchLinuxResponse a) instance (FromJSON a) => FromJSON (ArchLinuxResponse a)++deriving via ArchLinuxJSON (ArchLinuxResponse a) instance (ToJSON a) => ToJSON (ArchLinuxResponse a)++-----------------------------------------------------------------------------++-- | Search results returned by 'Web.ArchLinux.API.searchAur'.+--+-- Some of fileds are renamed in this record type, for sharing+-- overloaded lenses between data type returned by Arch Linux official API.+data AurSearch = AurSearch+ { _id :: Int,+ _name :: Text,+ _packageBaseID :: Int,+ _packageBase :: Text,+ _version :: Text,+ _description :: Maybe Text,+ -- | URL+ _url :: Maybe Text,+ _numVotes :: Int,+ _popularity :: Double,+ -- | UTCTime+ _outOfDate :: Maybe Int,+ _maintainer :: Maybe Text,+ -- | UTCTime+ _firstSubmitted :: Int,+ -- | UTCTime+ _lastModified :: Int,+ _urlPath :: Text+ }+ deriving stock (Show, Eq, Ord, Generic)+ deriving (FromJSON, ToJSON) via AurJSON AurSearch++-- | Package details returned by 'Web.ArchLinux.API.getAurInfo'.+--+-- This data type extends 'AurSearch' informally,+-- so it includes '_search' as a member.+data AurInfo = AurInfo+ { -- | ID, Name, PackageBaseID, ...+ _search :: AurSearch,+ -- | Depends+ _depends :: [Text],+ -- | MakeDepends+ _makedepends :: [Text],+ -- | OptDepends+ _optdepends :: [Text],+ -- | CheckDepends+ _checkdepends :: [Text],+ _conflicts :: [Text],+ _provides :: [Text],+ _replaces :: [Text],+ _groups :: [Text],+ _licenses :: [License],+ _keywords :: [Text]+ }+ deriving stock (Show, Eq, Ord, Generic)++instance FromJSON AurInfo where+ parseJSON = withObject "AurInfo" $ \o -> do+ _search <- parseJSON $ Object o+ _depends <- fromMaybe [] <$> o .:? "Depends"+ _makedepends <- fromMaybe [] <$> o .:? "MakeDepends"+ _optdepends <- fromMaybe [] <$> o .:? "OptDepends"+ _checkdepends <- fromMaybe [] <$> o .:? "CheckDepends"+ _conflicts <- fromMaybe [] <$> o .:? "Conflicts"+ _provides <- fromMaybe [] <$> o .:? "Provides"+ _replaces <- fromMaybe [] <$> o .:? "Replaces"+ _groups <- fromMaybe [] <$> o .:? "Groups"+ _licenses <- fromMaybe [] <$> o .:? "License"+ _keywords <- fromMaybe [] <$> o .:? "Keywords"+ pure AurInfo {..}++instance ToJSON AurInfo where+ toJSON AurInfo {..} =+ Object $+ unObject (toJSON _search)+ <> unObject+ ( object+ [ "Depends" .= _depends,+ "MakeDepends" .= _makedepends,+ "OptDepends" .= _optdepends,+ "CheckDepends" .= _checkdepends,+ "Conflicts" .= _conflicts,+ "Provides" .= _provides,+ "Replaces" .= _replaces,+ "Groups" .= _groups,+ "License" .= _licenses,+ "Keywords" .= _keywords+ ]+ )+ where+ unObject (Object o) = o+ unObject _ = error "impossible"++-- | Return types of AUR API.+data AurResponseType = Search | Multiinfo | Error+ deriving stock (Show, Eq, Ord, Enum, Generic)+ deriving (FromJSON, ToJSON) via CustomJSON '[ConstructorTagModifier CamelToSnake] AurResponseType++-- | Response data type of AUR API.+data AurResponse a = AurResponse+ { _version :: Int,+ -- | type+ _aurType :: AurResponseType,+ -- | resultcount+ _resultCount :: Int,+ _results :: a,+ -- | Available when 'aurType' equals to 'AurResponseType.Error'.+ _error :: Maybe Text+ }+ deriving stock (Show, Eq, Ord, Functor, Generic)++instance (FromJSON a) => FromJSON (AurResponse a) where+ parseJSON = withObject "AurResponse" $ \o -> do+ _version <- o .: "version"+ _aurType <- o .: "type"+ _resultCount <- o .: "resultcount"+ _results <- o .: "results"+ _error <- o .:? "error"+ pure AurResponse {..}++instance (ToJSON a) => ToJSON (AurResponse a) where+ toJSON AurResponse {..} =+ object $+ [ "version" .= _version,+ "type" .= _aurType,+ "resultcount" .= _resultCount,+ "results" .= _results+ ]+ <> case _error of+ Just err -> ["error" .= err]+ _ -> []
+ src/Web/ArchLinux/Types/API.hs view
@@ -0,0 +1,50 @@+{-# OPTIONS_HADDOCK hide, prune #-}++module Web.ArchLinux.Types.API+ ( module Web.ArchLinux.Types.API,+ )+where++import Data.Aeson (Value)+import Data.Text (Text)+import Servant.API+import Web.ArchLinux.Types++type GetPackageDetails =+ "packages"+ :> Capture "repository" Repo+ :> Capture "architecture" Arch+ :> Capture "package" Text+ :> "json"+ :> Get '[JSON] PackageInformation++type GetPackageFiles =+ "packages"+ :> Capture "repository" Repo+ :> Capture "architecture" Arch+ :> Capture "package" Text+ :> "files"+ :> "json"+ :> Get '[JSON] PackageFiles++type SearchPackage =+ "packages"+ :> "search"+ :> "json"+ :> QueryParam "q" Text+ :> QueryParam "name" Text+ :> QueryParam "desc" Text+ :> QueryParams "repo" Repo+ :> QueryParams "arch" Arch+ :> QueryParam "maintainer" Text+ :> QueryParam "packager" Text+ :> QueryParam "flagged" Flagged+ :> Get '[JSON] (ArchLinuxResponse PackageInformation)++type AurRPC =+ "rpc"+ :> QueryParam' '[Strict, Required] "v" Int+ :> QueryParam' '[Strict, Required] "type" Text+ :> QueryParam "by" Text+ :> QueryParams "arg" Text+ :> Get '[JSON] Value
+ src/Web/ArchLinux/Types/Lens.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE TemplateHaskell #-}++-- | Copyright: (c) 2021 berberman+-- SPDX-License-Identifier: MIT+-- Maintainer: berberman <berberman@yandex.com>+-- Stability: experimental+-- Portability: portable+-- Lenses.+module Web.ArchLinux.Types.Lens+ ( module Web.ArchLinux.Types.Lens,+ )+where++import Control.Lens.TH (makeFieldsNoPrefix, makeLenses)+import Web.ArchLinux.API+import Web.ArchLinux.Types++makeFieldsNoPrefix ''PackageInformation+makeFieldsNoPrefix ''PackageFiles+makeFieldsNoPrefix ''ArchLinuxResponse++makeFieldsNoPrefix ''AurSearch+makeFieldsNoPrefix ''AurInfo+makeFieldsNoPrefix ''AurResponse++makeLenses ''SearchOptions
+ test/Main.hs view
@@ -0,0 +1,28 @@+module Main (main) where++import Network.HTTP.Client (Manager)+import Network.HTTP.Client.TLS (newTlsManager)+import Test.HUnit+import Web.ArchLinux++main :: IO ()+main = do+ manager <- newTlsManager+ runTestTTAndExit $ tests manager++tests :: Manager -> Test+tests manager =+ TestList+ [ createTest "getPackageDetails" manager $ getPackageDetails Core X86_64 "linux",+ createTest "getPackageFiles" manager $ getPackageFiles Core X86_64 "linux",+ createTest "searchPackage" manager $ searchPackage emptySearchOptions {_nameOrDescription = Just "linux"},+ createTest "searchAur" manager $ searchAur ByNameOrDesc "haskell",+ createTest "getAurInfo" manager $ getAurInfo ["arch-hs-git"]+ ]++createTest :: HasBaseUrl k => String -> Manager -> APIClient k a -> Test+createTest tag manager action = TestLabel tag . TestCase $ do+ result <- runAPIClient manager action+ case result of+ Right _ -> pure ()+ Left err -> assertFailure $ show err