packages feed

arxiv-client (empty) → 0.1.0.0

raw patch · 12 files changed

+1103/−0 lines, 12 filesdep +aesondep +arxiv-clientdep +base

Dependencies added: aeson, arxiv-client, base, bytestring, directory, megaparsec, modern-uri, req, text, time, xml-conduit

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for arxiv-client++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,29 @@+Copyright (c) 2025, Eiko+++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of the copyright holder nor the names of its+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,13 @@+## Arxiv-client++A simple arxiv-client API library for searching, querying, and downloading pdf, source from arXiv.org.++This is a library, and the command line interface (cli) application wrapping this library is provided by the `arxiv-client-cli` package.++## Library Guide++Two query ASTs are defined:++* The primitive `Term`, `ArxivQuery` and their builder functions are defined in `Arxiv.Query`. Suitable for building queries programmatically using functions.++* The higher-level `QueryTerm` which is algebraic query, defined in `Arxiv.Query.Algebraic` and `Arxiv.Query.Parser`, suitable for parsing from user input.
+ arxiv-client.cabal view
@@ -0,0 +1,58 @@+cabal-version:      3.0+name:               arxiv-client+version:            0.1.0.0+synopsis:           Tiny client for the arXiv Atom API with a simple query DSL+description:        This library provides a tiny client for the arXiv Atom API, allowing users to perform searches, retrieve metadata and download academic papers hosted on arXiv.org. It features a simple domain-specific language for constructing queries, making it easy to filter and sort results based on various criteria such as author, title, abstract, categories, and submission dates.+license:            BSD-3-Clause+license-file:       LICENSE+author:             Eiko+maintainer:         eikochanowo@outlook.com+-- copyright:+category:           Network, Arxiv, API, DSL+build-type:         Simple+extra-doc-files: CHANGELOG.md+               , README.md+tested-with: GHC == 9.12.2+source-repository head+    type: git+    location: https://github.com/Eiko-Tokura/arxiv-client.git+-- extra-source-files:++common warnings+    ghc-options: -Wall++library+    import:           warnings+    exposed-modules:+        Arxiv.Entry+      , Arxiv.Client+      , Arxiv.Download+      , Arxiv.Query+      , Arxiv.Query.Parser+      , Arxiv.Query.Algebraic+      , Arxiv.Filters+    hs-source-dirs:   src+    build-depends:+        base          >=4    && <5+      , aeson         >=2    && <2.3+      , text          >=2.0  && <2.2+      , bytestring    >=0.10 && <0.13+      , time          >=1.11 && <1.15+      , req           >=3.13 && <3.14+      , xml-conduit   >=1.10 && <1.11+      , megaparsec    >=9.5  && <9.8+      , modern-uri    >=0.3  && <0.4+      , directory     >=1.3  && <1.4+    hs-source-dirs:   src+    default-language: GHC2021++test-suite arxiv-client-test+    import:           warnings+    default-language: GHC2021+    type:             exitcode-stdio-1.0+    hs-source-dirs:   test+    main-is:          Main.hs+    build-depends:+        base+      , arxiv-client+      , text
+ src/Arxiv/Client.hs view
@@ -0,0 +1,195 @@+{-# LANGUAGE OverloadedStrings, OverloadedRecordDot #-}++module Arxiv.Client+  ( queryArxiv+  , queryArxivIO+  , queryArxivRaw+  , queryArxivRawIO+  , buildRequestUrlText+  , downloadTo+  ) where++import           Control.Applicative ((<|>), asum)+import           Control.Monad.IO.Class (MonadIO(..))+import           Data.Maybe (listToMaybe, fromMaybe, mapMaybe)+import           Data.Text (Text)+import qualified Data.Text as T+import qualified Data.ByteString.Lazy as LBS+import           Data.Time (UTCTime, parseTimeM, defaultTimeLocale)+import           Data.Time.Format.ISO8601 (iso8601ParseM)+import           Arxiv.Query+import           Arxiv.Entry+import           Network.HTTP.Req+import qualified Text.XML as X+import           Text.XML.Cursor+import qualified Text.URI as URI++axisLocal :: Text -> Axis+axisLocal ln = element (nNamespace ln)++-- Build the query string for debugging (best-effort).+buildRequestUrlText :: ArxivQuery -> Text+buildRequestUrlText q =+  let base = "http://export.arxiv.org/api/query?"+      kv k v = k <> "=" <> v+      joinAmp = T.intercalate "&"+      parts =+        [ kv "search_query" (renderSearchQuery q)+        , kv "start"        (tshow (qStart q))+        , kv "max_results"  (tshow (qMax   q))+        ] <>+        maybe [] (\sb -> [kv "sortBy"    (sortByText sb)]) (qSortBy q) <>+        maybe [] (\so -> [kv "sortOrder" (sortOrderText so)]) (qSortOrder q) <>+        [kv "id_list" (T.intercalate "," (qIdList q)) | not (null (qIdList q))]+  in base <> joinAmp parts++-- Raw response (XML bytes) + parsed entries, for debugging.+queryArxivRaw :: (MonadHttp m, MonadIO m) => ArxivQuery -> m (LBS.ByteString, [ArxivEntry])+queryArxivRaw q = do+  let baseUrl = https "export.arxiv.org" /: "api" /: "query"+      mkParam name val = name =: (val :: Text)+      params =+           mkParam "search_query" (renderSearchQuery q)+        <> mkParam "start"       (tshow (qStart q))+        <> mkParam "max_results" (tshow (qMax   q))+        <> maybe mempty (\sb -> "sortBy"    =: sortByText sb) (qSortBy q)+        <> maybe mempty (\so -> "sortOrder" =: sortOrderText so) (qSortOrder q)+        <> (if null (qIdList q) then mempty else "id_list" =: T.intercalate "," (qIdList q))+  r <- req GET baseUrl NoReqBody lbsResponse params+  let bs = responseBody r+  pure (bs, parseFeed bs)++-- queryArxiv now just calls queryArxivRaw and returns parsed entries.+queryArxiv :: (MonadHttp m, MonadIO m) => ArxivQuery -> m [ArxivEntry]+queryArxiv q = snd <$> queryArxivRaw q+-----------------------------++queryArxivRawIO :: ArxivQuery -> IO (LBS.ByteString, [ArxivEntry])+queryArxivRawIO q = runReq defaultHttpConfig (queryArxivRaw q)++-- | Run in IO.+queryArxivIO :: ArxivQuery -> IO [ArxivEntry]+queryArxivIO q = runReq defaultHttpConfig (queryArxiv q)++tshow :: Show a => a -> Text+tshow = T.pack . show++sortByText :: SortBy -> Text+sortByText Relevance       = "relevance"+sortByText LastUpdatedDate = "lastUpdatedDate"+sortByText SubmittedDate   = "submittedDate"++sortOrderText :: SortOrder -> Text+sortOrderText Asc  = "ascending"+sortOrderText Desc = "descending"++nNamespace :: Text -> X.Name+nNamespace local = X.Name local (Just "http://www.w3.org/2005/Atom") Nothing++nAttr :: Text -> X.Name+nAttr local = X.Name local Nothing Nothing++parseFeed :: LBS.ByteString -> [ArxivEntry]+parseFeed lbs =+  let doc     = X.parseLBS_ X.def lbs+      rootCur = fromDocument doc+      -- Descendant axis + local-name match (namespace-agnostic).+      entries = rootCur $// axisLocal "entry"+  in mapMaybe cursorToEntry entries++contents :: Cursor -> [Text]+contents cur = case cur.node of+  X.NodeContent t -> [t]+  _               -> case cur $/ content of+                       [] -> []+                       ts -> ts++-- | Safely take the first concatenated text of an element.+txtFirstOf :: Cursor -> Text -> Maybe Text+txtFirstOf cur local =+  case concatMap contents (cur $// axisLocal local) of+    [] -> Nothing+    xs -> Just (T.strip (T.concat xs))++cursorToEntry :: Cursor -> Maybe ArxivEntry+cursorToEntry e = do+  title'     <- txtFirstOf e "title"+  summary'   <- txtFirstOf e "summary"+  idURL      <- txtFirstOf e "id"+  published' <- txtFirstOf e "published" >>= parseTime+  updated'   <- txtFirstOf e "updated" >>= parseTime++  -- Authors: for each <author>, concat all <name> text nodes. Missing -> "".+  let authors' =+        [ T.strip . T.concat $ concatMap contents (aCur $/ laxElement "name")+        | aCur <- e $// axisLocal "author"+        ]++      cats =+        (e $// axisLocal "category") >>= attribute (nAttr "term")++      -- pick <link ... href="..."> by attribute match+      pickLink :: Text -> Text -> Maybe Text+      pickLink attrName attrVal =+        let links = e $// (axisLocal "link" >=> attributeIs (nAttr attrName) attrVal)+        in listToMaybe (links >>= attribute (nAttr "href"))++      arxId = lastSegment idURL++      absL = fromMaybe ("https://arxiv.org/abs/" <> arxId)+             (pickLink "rel" "alternate")++      pdfL = fromMaybe ("https://arxiv.org/pdf/" <> arxId <> ".pdf")+             ( pickLink "title" "pdf"+               <|> pickLink "type" "application/pdf"+             )++      srcL = "https://arxiv.org/src/" <> arxId++  pure ArxivEntry+        { arxivId   = arxId+        , absUrl    = absL+        , pdfUrl    = pdfL+        , sourceUrl = srcL+        , title     = title'+        , summary   = summary'+        , authors   = authors'+        , categories= cats+        , published = published'+        , updated   = updated'+        }++parseTime :: Text -> Maybe UTCTime+parseTime t = --iso8601ParseM . T.unpack+  let s = T.unpack (T.strip t)+  in asum+       [ iso8601ParseM s+       , parseTimeM True defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ"      s+       , parseTimeM True defaultTimeLocale "%Y-%m-%dT%H:%M:%S%QZ"    s+       , parseTimeM True defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Ez"    s+       , parseTimeM True defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Ez"    s+       ]++lastSegment :: Text -> Text+lastSegment url =+  case reverse (T.splitOn "/" (T.takeWhile (/= '#') url)) of+    (x:_) | not (T.null x) -> x+    _                      -> url++-- | Download any http/https URL to a file, using 'modern-uri'.+downloadTo :: (MonadHttp m, MonadIO m) => Text -> FilePath -> m ()+downloadTo urlT fp =+  case URI.mkURI urlT of+    Left _err -> error "downloadTo: invalid URL"+    Right uri ->+      case useHttpsURI uri of+        Just (u, opt) -> do+          r <- req GET u NoReqBody lbsResponse opt+          liftIO (LBS.writeFile fp (responseBody r))+        Nothing ->+          case useHttpURI uri of+            Just (u, opt) -> do+              r <- req GET u NoReqBody lbsResponse opt+              liftIO (LBS.writeFile fp (responseBody r))+            Nothing ->+              error "downloadTo: unsupported scheme (expect http/https)"
+ src/Arxiv/Download.hs view
@@ -0,0 +1,64 @@+-- | Convenient functions for downloading arXiv papers.+module Arxiv.Download where++import Arxiv.Entry+import Control.Monad+import Network.HTTP.Req+import Text.URI (mkURI)+import qualified Data.Text as T+import qualified Data.ByteString.Lazy as BL+import System.Directory (doesFileExist)++downloadPdf :: ArxivEntry -> IO BL.ByteString+downloadPdf entry = runReq defaultHttpConfig $ do+  let url = pdfUrl entry+  uri <- mkURI url+  case useURI uri of+    Just (Left (httpUrl, options)) -> do+      response <- req GET httpUrl NoReqBody lbsResponse options+      return (responseBody response)+    Just (Right (httpsUrl, options)) -> do+      response <- req GET httpsUrl NoReqBody lbsResponse options+      return (responseBody response)+    Nothing -> error $ "Invalid URL: " ++ T.unpack url++-- | Usage:+-- @defaultFileName ".pdf" entry@+defaultFileName :: String -> ArxivEntry -> FilePath+defaultFileName suffix entry = toValidFileName (T.unpack (title entry)) ++ "-" ++ T.unpack (arxivId entry) ++ suffix++toValidFileName :: String -> String+toValidFileName = concatMap replaceInvalid+  where+    replaceInvalid c+      | c `elem` ['a'..'z'] || c `elem` ['A'..'Z'] || c `elem` ['0'..'9'] = [c]+      | c `elem` " ._-" = [c]+      | otherwise = "_"++-- | Detect if the file is already exists before downloading.+downloadPdfToFile :: ArxivEntry -> FilePath -> IO ()+downloadPdfToFile entry filePath = do+  fileExists <- doesFileExist filePath+  unless fileExists $ do+      pdfData <- downloadPdf entry+      BL.writeFile filePath pdfData++downloadSource :: ArxivEntry -> IO BL.ByteString+downloadSource entry = runReq defaultHttpConfig $ do+  let url = sourceUrl entry+  uri <- mkURI url+  case useURI uri of+    Just (Left (httpUrl, options)) -> do+      response <- req GET httpUrl NoReqBody lbsResponse options+      return (responseBody response)+    Just (Right (httpsUrl, options)) -> do+      response <- req GET httpsUrl NoReqBody lbsResponse options+      return (responseBody response)+    Nothing -> error $ "Invalid URL: " ++ T.unpack url++downloadSourceToFile :: ArxivEntry -> FilePath -> IO ()+downloadSourceToFile entry filePath = do+  fileExists <- doesFileExist filePath+  unless fileExists $ do+      srcData <- downloadSource entry+      BL.writeFile filePath srcData
+ src/Arxiv/Entry.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE OverloadedStrings #-}++module Arxiv.Entry+  ( ArxivEntry(..)+  , arxivIdNoVersion+  ) where++import Data.Aeson+import Data.Text (Text)+import Data.Time (UTCTime)+import qualified Data.Text as T+import GHC.Generics (Generic)++-- | Parsed arXiv entry from the Atom feed.+data ArxivEntry = ArxivEntry+  { arxivId       :: !Text       -- ^ e.g. \"2401.01234v2\"+  , absUrl        :: !Text       -- ^ https://arxiv.org/abs/<id>+  , pdfUrl        :: !Text       -- ^ https://arxiv.org/pdf/<id>.pdf+  , sourceUrl     :: !Text       -- ^ https://arxiv.org/src/<id> (tarball of sources)+  , title         :: !Text+  , summary       :: !Text       -- ^ abstract+  , authors       :: ![Text]     -- ^ author names+  , categories    :: ![Text]     -- ^ arXiv subjects, e.g. \"math.NT\"+  , published     :: !UTCTime+  , updated       :: !UTCTime+  } deriving (Show, Eq, Generic, FromJSON, ToJSON)++-- | Drop a trailing version suffix (...vN) if present.+arxivIdNoVersion :: Text -> Text+arxivIdNoVersion t = case T.breakOnEnd "v" t of+  (prefix, ver) | not (T.null prefix) && T.all (`elem` ['0'..'9']) ver -> T.dropEnd (T.length ver + 1) t+  _ -> T.takeWhile (/= 'v') t
+ src/Arxiv/Filters.hs view
@@ -0,0 +1,41 @@+module Arxiv.Filters+  ( publishedBetween+  , publishedAfter+  , publishedBefore+  , hasCategory+  , authorContains+  , titleContains+  , abstractContains+  ) where++import Data.Text (Text)+import qualified Data.Text as T+import Data.Time (UTCTime)+import Arxiv.Entry++publishedBetween :: UTCTime -> UTCTime -> [ArxivEntry] -> [ArxivEntry]+publishedBetween a b = filter (\e -> published e >= a && published e <= b)++publishedAfter :: UTCTime -> [ArxivEntry] -> [ArxivEntry]+publishedAfter t = filter (\e -> published e >= t)++publishedBefore :: UTCTime -> [ArxivEntry] -> [ArxivEntry]+publishedBefore t = filter (\e -> published e <= t)++hasCategory :: Text -> [ArxivEntry] -> [ArxivEntry]+hasCategory cat = filter (\e -> cat `elem` categories e)++authorContains :: Text -> [ArxivEntry] -> [ArxivEntry]+authorContains needle =+  let n = T.toCaseFold needle+  in filter (any (T.isInfixOf n . T.toCaseFold) . authors)++titleContains :: Text -> [ArxivEntry] -> [ArxivEntry]+titleContains needle =+  let n = T.toCaseFold needle+  in filter (\e -> n `T.isInfixOf` T.toCaseFold (title e))++abstractContains :: Text -> [ArxivEntry] -> [ArxivEntry]+abstractContains needle =+  let n = T.toCaseFold needle+  in filter (\e -> n `T.isInfixOf` T.toCaseFold (summary e))
+ src/Arxiv/Query.hs view
@@ -0,0 +1,438 @@+{-# LANGUAGE OverloadedStrings #-}+{-|+Module      : Arxiv.Query+Description : A tiny, composable DSL for arXiv API search queries+Copyright   : (c) Eiko 2025+License     : BSD3+Maintainer  : eikochanowo@outlook.com+Stability   : experimental+Portability : portable++This module provides a small, ergonomic DSL to compose arXiv queries that+render to the API's @search_query@ parameter. It also carries paging and+sorting settings, plus an optional @id_list@ (server-side filtering by IDs).++### TL;DR++Build queries fluently with /builders/ (functions of type 'QBuilder'):++@+import Data.Function ((&))+import Arxiv.Query++let q =+      emptyQuery+      & ( titleAll [\"Coleman\",\"Tropical\"]+          .|| title \"Chabauty\"+          .&& (title \"Differential\" .|| title \"Equation\")+        )+      .&& inCategory \"math.NT\"+      & setSort SubmittedDate Desc+      & setPaging 0 25++renderSearchQuery q+-- (ti:Coleman+AND+ti:Tropical)+OR+(ti:Chabauty)+AND+((ti:Differential)+OR+(ti:Equation))+AND+cat:math.NT+@++- '(.&&)' and '(.||)' are boolean-style combinators with sensible precedence:+  @(.&&)@ binds tighter than @(.||)@ (like '&&' vs '||' in Haskell).+- Builders keep parentheses correct using an internal AST.++### Fields & Syntax++arXiv supports fielded search terms such as:++* @ti:@ (title), @abs:@ (abstract), @au:@ (author), @cat:@ (category)+* @co:@ (comment), @jr:@ (journal reference), @rn:@ (report number)+* @all:@ searches all fields (used by 'anyWords', 'allWords', 'exactPhrase')++Values are automatically quoted when they contain spaces or special characters.+You can also inject raw snippets via 'rawTerm' / 'rawGroupAnd' / 'rawGroupOr'+when you want full control.++### Paging, Sorting, and id_list++- Use 'setPaging' to set @start@ and @max_results@ (arXiv typically allows up+  to ~300).+- Use 'setSort' to choose 'SortBy' and 'SortOrder'.+- 'setIdList' / 'addId' / 'clearIdList' manipulate the optional @id_list@+  parameter (comma-separated), which the client layer will send alongside+  @search_query@.++@renderSearchQuery@ only renders the query expression; paging, sorting, and+@id_list@ are carried in 'ArxivQuery' and used by the client code.++### Not / Negation++- To negate words across all fields, use 'notWords'.+- To negate field-specific predicates, use 'notInTitle', 'notInAbstract',+  'notInCategories', or the general 'groupNot'.++@since 0.1.0.0+-}+module Arxiv.Query+  ( -- * Sorting+    SortBy(..)+  , SortOrder(..)++    -- * QBuilder type+  , QBuilder++    -- * Query record & basics+  , ArxivQuery(..)+  , emptyQuery+  , setPaging+  , setSort++    -- * Author predicates+  , byAuthor+  , authorAny+  , authorAll+  , authorExact++    -- * Title predicates+  , titleHas+  , titleAny+  , titleAll+  , titlePhrase+  , notInTitle++    -- * Abstract predicates+  , abstractHas+  , abstractAny+  , abstractAll+  , abstractPhrase+  , notInAbstract++    -- * Category predicates+  , inCategory+  , categoriesAny+  , categoriesAll+  , notInCategories++    -- * All-fields helpers+  , anyWords+  , allWords+  , exactPhrase+  , notWords++    -- * Raw injections+  , rawTerm+  , rawGroupAnd+  , rawGroupOr++    -- * Boolean-style combinators and grouping+  , (.&&)+  , (.||)+  , groupAnd+  , groupOr+  , groupNot++    -- * Other fields+  , commentHas+  , journalRefHas+  , reportNumberIs++    -- * id_list helpers+  , setIdList+  , addId+  , clearIdList++    -- * Rendering+  , renderSearchQuery++    -- * Term type+  , Term(..)+  , addTerm++    -- * Helper Functions+  , (&)+  ) where++import Data.Function ((&))+import Data.Text (Text)+import qualified Data.Text as T++-- | Builder type for arXiv queries.+--+-- A 'QBuilder' takes an 'ArxivQuery' and returns a modified one. Most+-- functions in this module are such builders and can be composed with+-- function application or with '(.&&)' / '(.||)'.+type QBuilder = ArxivQuery -> ArxivQuery++-- Sorting ---------------------------------------------------------------++-- | Sorting key for the arXiv API.+data SortBy+  = Relevance         -- ^ @sortBy=relevance@+  | LastUpdatedDate   -- ^ @sortBy=lastUpdatedDate@+  | SubmittedDate     -- ^ @sortBy=submittedDate@+  deriving (Eq, Show)++-- | Sort direction.+data SortOrder = Asc | Desc+  deriving (Eq, Show)++-- Tiny internal AST -----------------------------------------------------++-- | Internal query AST (keeps parentheses and negations correct).+data Term+  = TField Text Text            -- ^ @f:v@  (auto-quoting values as needed)+  | TAllWord Text               -- ^ @all:v@+  | TAllPhrase Text             -- ^ @all:\"...\"@+  | TRaw Text                   -- ^ Injected verbatim snippet+  | TNot Term+  | TAnd [Term]+  | TOr  [Term]+  deriving (Eq, Show)++-- Query record ----------------------------------------------------------++-- | The full query configuration that the client consumes.+data ArxivQuery = ArxivQuery+  { qTerms     :: [Term]             -- ^ Query expression terms (top-level AND).+  , qStart     :: !Int               -- ^ Paging start index (offset).+  , qMax       :: !Int               -- ^ Paging size (max_results).+  , qSortBy    :: !(Maybe SortBy)    -- ^ Optional sort key.+  , qSortOrder :: !(Maybe SortOrder) -- ^ Optional sort direction.+  , qIdList    :: ![Text]            -- ^ Optional @id_list@ (comma-separated).+  } deriving (Eq, Show)++-- | An empty query with no terms, start @0@, max @50@, and no sorting.+emptyQuery :: ArxivQuery+emptyQuery = ArxivQuery [] 0 50 Nothing Nothing []++-- | Set paging parameters.+--+-- Values are clamped to @start >= 0@ and @max >= 1@.+setPaging :: Int -> Int -> QBuilder+setPaging s m q = q { qStart = max 0 s, qMax = max 1 m }++-- | Set sorting: see 'SortBy' and 'SortOrder'.+setSort :: SortBy -> SortOrder -> QBuilder+setSort sb so q = q { qSortBy = Just sb, qSortOrder = Just so }++-- Helpers ---------------------------------------------------------------++quoteIfNeeded :: Text -> Text+quoteIfNeeded t+  | T.any (\c -> c == ' ' || c == ':' || c == '(' || c == ')' || c == '"') t+      = "\"" <> t <> "\""+  | otherwise = t++paren :: Text -> Text+paren x = "(" <> x <> ")"++renderTerm :: Term -> Text+renderTerm (TField f v)   = f <> ":" <> quoteIfNeeded v+renderTerm (TAllWord w)   = "all:"   <> quoteIfNeeded w+renderTerm (TAllPhrase p) = "all:"   <> "\"" <> p <> "\""+renderTerm (TRaw t)       = t+renderTerm (TNot t)       = "-" <> renderTerm t+renderTerm (TAnd xs)      = paren (T.intercalate " AND " (map renderTerm xs))+renderTerm (TOr  xs)      = paren (T.intercalate " OR "  (map renderTerm xs))++addTerm :: Term -> QBuilder+addTerm t q = q { qTerms = qTerms q <> [t] }++-- Existing API (preserved) ---------------------------------------------++-- | Search by author: @au:<author>@.+--+-- Examples:+--+-- @+-- emptyQuery & byAuthor "Minhyong Kim"+-- emptyQuery & authorExact "Minhyong Kim"  -- quoted exact match+-- @+byAuthor :: Text -> QBuilder+byAuthor a = addTerm (TField "au" a)++-- | Title contains a token: @ti:<title>@.+titleHas :: Text -> QBuilder+titleHas t = addTerm (TField "ti" t)++-- | Abstract contains a token: @abs:<abstract>@.+abstractHas :: Text -> QBuilder+abstractHas t = addTerm (TField "abs" t)++-- | In category: @cat:<category>@ (e.g. @\"math.NT\"@).+inCategory :: Text -> QBuilder+inCategory c = addTerm (TField "cat" c)++-- | Match any of the given words across all fields (OR): @all:...@.+anyWords :: [Text] -> QBuilder+anyWords []  q = q+anyWords ws  q = addTerm (TOr  (map TAllWord ws)) q++-- | Match all the given words across all fields (AND): @all:...@.+allWords :: [Text] -> QBuilder+allWords []  q = q+allWords ws  q = addTerm (TAnd (map TAllWord ws)) q++-- | Match an exact phrase across all fields: @all:\"...\"@.+exactPhrase :: Text -> QBuilder+exactPhrase p = addTerm (TAllPhrase p)++-- | Negate words across all fields: @-all:...@.+notWords :: [Text] -> QBuilder+notWords []  q = q+notWords ws  q = addTerm (TAnd (map (TNot . TAllWord) ws)) q++-- | Inject a raw term snippet exactly as written.+--+-- Use this when you need complete control over the fielding/quoting.+rawTerm :: Text -> QBuilder+rawTerm t = addTerm (TRaw t)++-- New fielded combinators ----------------------------------------------++-- | Title contains /any/ of these tokens: @(ti:a OR ti:b ...)@.+titleAny :: [Text] -> QBuilder+titleAny ws = addTerm (TOr  (map (TField "ti") ws))++-- | Title contains /all/ of these tokens: @(ti:a AND ti:b ...)@.+titleAll :: [Text] -> QBuilder+titleAll ws = addTerm (TAnd (map (TField "ti") ws))++-- | Title contains this exact phrase: @ti:\"...\"@.+titlePhrase :: Text -> QBuilder+titlePhrase p = addTerm (TRaw ("ti:" <> "\"" <> p <> "\""))++-- | Title does /not/ contain any of these tokens: @-ti:a AND -ti:b ...@.+notInTitle :: [Text] -> QBuilder+notInTitle ws = addTerm (TAnd (map (TNot . TField "ti") ws))++-- | Abstract contains /any/ of these tokens: @(abs:a OR abs:b ...)@.+abstractAny :: [Text] -> QBuilder+abstractAny ws = addTerm (TOr  (map (TField "abs") ws))++-- | Abstract contains /all/ of these tokens: @(abs:a AND abs:b ...)@.+abstractAll :: [Text] -> QBuilder+abstractAll ws = addTerm (TAnd (map (TField "abs") ws))++-- | Abstract contains this exact phrase: @abs:\"...\"@.+abstractPhrase :: Text -> QBuilder+abstractPhrase p = addTerm (TRaw ("abs:" <> "\"" <> p <> "\""))++-- | Abstract does /not/ contain any of these tokens.+notInAbstract :: [Text] -> QBuilder+notInAbstract ws = addTerm (TAnd (map (TNot . TField "abs") ws))++-- | Author matches /any/ token: @(au:a OR au:b ...)@.+authorAny :: [Text] -> QBuilder+authorAny ws = addTerm (TOr  (map (TField "au") ws))++-- | Author matches /all/ tokens: @(au:a AND au:b ...)@.+authorAll :: [Text] -> QBuilder+authorAll ws = addTerm (TAnd (map (TField "au") ws))++-- | Author exact (quoted): @au:\"...\"@.+authorExact :: Text -> QBuilder+authorExact a = addTerm (TRaw ("au:" <> "\"" <> a <> "\""))++-- | Category is /any/ of: @(cat:a OR cat:b ...)@.+categoriesAny :: [Text] -> QBuilder+categoriesAny cs = addTerm (TOr  (map (TField "cat") cs))++-- | Category is /all/ of: @(cat:a AND cat:b ...)@.+categoriesAll :: [Text] -> QBuilder+categoriesAll cs = addTerm (TAnd (map (TField "cat") cs))++-- | Category is /not/ any of: @-cat:a AND -cat:b ...@.+notInCategories :: [Text] -> QBuilder+notInCategories cs = addTerm (TAnd (map (TNot . TField "cat") cs))++-- | Comment contains a token: @co:<text>@.+commentHas :: Text -> QBuilder+commentHas t = addTerm (TField "co" t)++-- | Journal reference contains a token: @jr:<text>@.+journalRefHas :: Text -> QBuilder+journalRefHas t = addTerm (TField "jr" t)++-- | Report number equals token (usually exact): @rn:<id>@.+reportNumberIs :: Text -> QBuilder+reportNumberIs rn = addTerm (TField "rn" rn)++-- Boolean-style combinators & grouping ---------------------------------++infixr 3 .&&   -- | AND; binds tighter (like '&&').+infixr 2 .||   -- | OR; binds looser (like '||').++-- | Combine two builders under an AND group (parenthesized).+--+-- @+-- title \"Chabauty\" .&& inCategory \"math.NT\"+-- -- renders as: (ti:Chabauty)+AND+cat:math.NT+-- @+(.&&) :: QBuilder -> QBuilder -> QBuilder+(.&&) f g = groupAnd [f, g]++-- | Combine two builders under an OR group (parenthesized).+(.||) :: QBuilder -> QBuilder -> QBuilder+(.||) f g = groupOr  [f, g]++-- | Group a list of builders using AND: @(A AND B AND ...)@.+groupAnd :: [QBuilder] -> QBuilder+groupAnd fs q0 =+  let ts = qTerms (foldl (\q f -> f q) (q0 { qTerms = [] }) fs)+  in addTerm (TAnd ts) q0++-- | Group a list of builders using OR: @(A OR B OR ...)@.+groupOr :: [QBuilder] -> QBuilder+groupOr fs q0 =+  let ts = qTerms (foldl (\q f -> f q) (q0 { qTerms = [] }) fs)+  in addTerm (TOr ts) q0++-- | Negate a grouped builder: @-(A AND B ...)@.+--+-- If the builder expands to multiple terms, they are AND-ed before negation.+groupNot :: QBuilder -> QBuilder+groupNot f q0 =+  let ts = qTerms (f (q0 { qTerms = [] }))+  in case ts of+       []    -> q0+       [one] -> addTerm (TNot one) q0+       many  -> addTerm (TNot (TAnd many)) q0++-- Raw groups (inject ready-made snippets) -------------------------------++-- | Group raw snippets with AND, injected verbatim.+rawGroupAnd :: [Text] -> QBuilder+rawGroupAnd xs = addTerm (TAnd (map TRaw xs))++-- | Group raw snippets with OR, injected verbatim.+rawGroupOr :: [Text] -> QBuilder+rawGroupOr xs = addTerm (TOr (map TRaw xs))++-- id_list helpers -------------------------------------------------------++-- | Replace the entire @id_list@ (comma-separated on the wire).+--+-- This is sent alongside @search_query@ by the client layer; arXiv will+-- restrict results to those IDs.+setIdList :: [Text] -> QBuilder+setIdList ids q = q { qIdList = ids }++-- | Append a single ID to @id_list@.+addId :: Text -> QBuilder+addId i q = q { qIdList = qIdList q <> [i] }++-- | Clear @id_list@.+clearIdList :: QBuilder+clearIdList q = q { qIdList = [] }++-- Render ---------------------------------------------------------------++-- | Render the query expression (for the API's @search_query@ parameter).+--+-- Note that paging, sorting, and @id_list@ are not part of this string; they+-- are carried in 'ArxivQuery' and used by the HTTP client.+--+-- If no terms are present, renders to @all:*@.+renderSearchQuery :: ArxivQuery -> Text+renderSearchQuery q =+  if null (qTerms q)+     then "all:*"+     else T.intercalate " AND " (map renderTerm (qTerms q))
+ src/Arxiv/Query/Algebraic.hs view
@@ -0,0 +1,59 @@+-- | Module      : Arxiv.Query.Algebraic+-- Description : Algebraic representation of arXiv queries, can be useful for reading and constructing queries.+{-# LANGUAGE OverloadedStrings #-}+module Arxiv.Query.Algebraic where++import Data.Text (Text)+import Arxiv.Query++data IsHasAnyAll a+  = Is  !a+  | Has !a+  | Any ![a]+  | All ![a]+  deriving (Show, Eq, Read)++data QueryTerm+  = Title     !(IsHasAnyAll Text)+  | Abstract  !(IsHasAnyAll Text)+  | Author    !(IsHasAnyAll Text)+  | Category  !(IsHasAnyAll Text)+  | AnyWhere  !(IsHasAnyAll Text)+  | Or        !QueryTerm          !QueryTerm+  | And       !QueryTerm          !QueryTerm+  | Ors       ![QueryTerm]+  | Ands      ![QueryTerm]+  | Not       !QueryTerm+  deriving (Show, Eq, Read)++toTerms :: QueryTerm -> [Term]+toTerms (Title (Is t))      = [TField "ti" $ "\"" <> t <> "\""]+toTerms (Title (Has t))     = [TField "ti" t]+toTerms (Title (Any ts))    = [TOr  $ TField "ti" <$> ts]+toTerms (Title (All ts))    = [TAnd $ TField "ti" <$> ts]+toTerms (Abstract (Is t))   = [TField "abs" t]+toTerms (Abstract (Has t))  = [TField "abs" t]+toTerms (Abstract (Any ts)) = [TOr  $ TField "abs" <$> ts]+toTerms (Abstract (All ts)) = [TAnd $ TField "abs" <$> ts]+toTerms (Author (Is t))     = [TField "au" $ "\"" <> t <> "\""]+toTerms (Author (Has t))    = [TField "au" t]+toTerms (Author (Any ts))   = [TOr  $ TField "au" <$> ts]+toTerms (Author (All ts))   = [TAnd $ TField "au" <$> ts]+toTerms (Category (Is t))   = [TField "cat" t]+toTerms (Category (Has t))  = [TField "cat" t]+toTerms (Category (Any ts)) = [TOr  $ TField "cat" <$> ts]+toTerms (Category (All ts)) = [TAnd $ TField "cat" <$> ts]+toTerms (AnyWhere (Is t))   = [TField "all" t]+toTerms (AnyWhere (Has t))  = [TField "all" t]+toTerms (AnyWhere (Any ts)) = [TOr  $ TField "all" <$> ts]+toTerms (AnyWhere (All ts)) = [TAnd $ TField "all" <$> ts]+toTerms (Or t1 t2)          = [TOr (toTerms t1 ++ toTerms t2)]+toTerms (Ors ts)            = [TOr (concatMap toTerms ts)]+toTerms (And t1 t2)         = [TAnd (toTerms t1 ++ toTerms t2)]+toTerms (Ands ts)           = [TAnd (concatMap toTerms ts)]+toTerms (Not t)             = [TNot (TAnd $ toTerms t)]+{-# INLINE toTerms #-}++applyQueryTerm :: QueryTerm -> ArxivQuery -> ArxivQuery+applyQueryTerm qt query = foldr addTerm query ( toTerms qt )+{-# INLINE applyQueryTerm #-}
+ src/Arxiv/Query/Parser.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE OverloadedStrings #-}+-- | Parse algebraic query expressions+module Arxiv.Query.Parser+  ( parseQueryTerm+  , queryTermParser+  , runQueryTermTests+  ) where++import Arxiv.Query.Algebraic+import Control.Applicative (asum)+import Control.Monad (forM_)+import Data.Text (Text, pack)+import Data.Void (Void)+import Text.Megaparsec+import Text.Megaparsec.Char+import qualified Data.Text.IO as TIO++data AndOrBracket a+  = AndTerm     !(AndOrBracket a) !(AndOrBracket a)+  | OrTerm      !(AndOrBracket a) !(AndOrBracket a)+  | NotTerm     !(AndOrBracket a)+  | BracketTerm !(AndOrBracket a)+  | SingleTerm  !a+  deriving (Show, Eq)++queryTermReduction :: AndOrBracket QueryTerm -> QueryTerm+queryTermReduction (AndTerm t1 t2) = And (queryTermReduction t1) (queryTermReduction t2)+queryTermReduction (OrTerm  t1 t2) = Or  (queryTermReduction t1) (queryTermReduction t2)+queryTermReduction (NotTerm t)     = Not (queryTermReduction t)+queryTermReduction (BracketTerm t) = queryTermReduction t+queryTermReduction (SingleTerm t)  = t++andOrBracketParser :: Int -> (Char, Char) -> Parsec Void Text a -> Parsec Void Text (AndOrBracket a)+andOrBracketParser !braLevel (bra, ket) termParser = asum+  [+    try $ (AndTerm <$> bracketTermP) <* space <* string "&&" <* space+      <*> andOrBracketParser braLevel (bra, ket) termParser+  , try $ (OrTerm <$> bracketTermP) <* space <* string "||" <* space+      <*> andOrBracketParser braLevel (bra, ket) termParser+  , bracketTermP+  , try $ (AndTerm . SingleTerm <$> termParser) <* space <* string "&&" <* space+      <*> andOrBracketParser braLevel (bra, ket) termParser+  , try $ (OrTerm . SingleTerm <$> termParser) <* space <* string "||" <* space+      <*> andOrBracketParser braLevel (bra, ket) termParser+  , NotTerm <$> (string "not" >> space1 >> andOrBracketParser braLevel (bra, ket) termParser)+  , SingleTerm <$> termParser+  ] where bracketTermP = do+            _ <- char bra+            term <- andOrBracketParser (braLevel + 1) (bra, ket) termParser+            _ <- char ket+            return (BracketTerm term)++{- example:++title is coleman     ---> Title (Is "coleman")+title has "coleman integral"  ---> Title (Has "coleman integral")+ands [<queryTerm>, ...]  ---> Ands [<queryTerm>, ...]++-}+queryTermParser :: Parsec Void Text QueryTerm+queryTermParser = asum+  [ titleParser+  , abstractParser+  , authorParser+  , categoryParser+  , anywhereParser+  , fmap Ands $ string "ands" >> space >> listOf queryTermParser+  , fmap Ors  $ string "ors"  >> space >> listOf queryTermParser+  , AnyWhere . Has <$> quotedTextParser -- without any prefix, "text" is treated as anywhere has "text"+  ]+  where+    titleParser    = string "title"    >> space1 >> Title    <$> isHasAnyAllParser+    abstractParser = string "abstract" >> space1 >> Abstract <$> isHasAnyAllParser+    authorParser   = string "author"   >> space1 >> Author   <$> isHasAnyAllParser+    categoryParser = string "category" >> space1 >> Category <$> isHasAnyAllParser+    anywhereParser = string "anywhere" >> space1 >> AnyWhere <$> isHasAnyAllParser+    isHasAnyAllParser = asum+      [ Is  <$> (string "is"  >> space1 >> quotedTextParser)+      , Has <$> (string "has" >> space1 >> quotedTextParser)+      , Any <$> (string "any" >> space1 >> listOf quotedTextParser)+      , All <$> (string "all" >> space1 >> listOf quotedTextParser)+      ]+    quotedTextParser = pack <$> (char '"' >> manyTill anySingle (char '"'))+    listOf p         = between (char '[') (char ']') (sepBy p (char ',' >> space))++fullQueryTermParser :: Parsec Void Text QueryTerm+fullQueryTermParser = queryTermReduction <$> andOrBracketParser 0 ('(', ')') queryTermParser++parseQueryTerm :: Text -> Either (ParseErrorBundle Text Void) QueryTerm+parseQueryTerm = runParser (fullQueryTermParser <* eof) ""++queryTermTestItem :: Text -> QueryTerm -> Maybe String+queryTermTestItem input expected =+  case runParser (fullQueryTermParser <* eof) "" input of+    Left err     -> Just ("Parse error: " ++ errorBundlePretty err)+    Right actual ->+      if actual == expected+        then Nothing+        else Just ("Expected: " ++ show expected ++ ", but got: " ++ show actual)++queryTermTests :: [(Text, QueryTerm)]+queryTermTests =+  [ ("title is \"coleman\"", Title (Is "coleman"))+  , ("abstract has \"p-adic integral\"", Abstract (Has "p-adic integral"))+  , ("author any [\"john doe\", \"jane smith\"]", Author (Any ["john doe", "jane smith"]))+  , ("category all [\"math.NT\", \"math.AG\"]", Category (All ["math.NT", "math.AG"]))+  , ("anywhere is \"quantum mechanics\"", AnyWhere (Is "quantum mechanics"))+  , ("ands [title is \"coleman\", author has \"doe\"]", Ands [Title (Is "coleman"), Author (Has "doe")])+  , ("ors [category is \"math.NT\", category is \"math.AG\"]", Ors [Category (Is "math.NT"), Category (Is "math.AG")])+  , ("(title has \"haskell\" && author has \"simon\")",+      And+        (Title (Has "haskell"))+        (Author (Has "simon")))+  , ("(title has \"haskell\" && author has \"simon\") || abstract has \"functional programming\"",+      Or+        (And+          (Title (Has "haskell"))+          (Author (Has "simon")))+        (Abstract (Has "functional programming")))+  , ("\"haskell\" && \"simon\"",+      And+        (AnyWhere (Has "haskell"))+        (AnyWhere (Has "simon")))+  , ("not (title is \"quantum\")",+      Not+        (Title (Is "quantum")))+  ]++runQueryTermTests :: IO ()+runQueryTermTests = do+  let results = map (\(input, expected) -> (input, queryTermTestItem input expected)) queryTermTests+  let failures = [(input, err) | (input, Just err) <- results]+  if null failures+    then putStrLn "All query term parser tests passed."+    else do+      putStrLn "Some query term parser tests failed:"+      forM_ failures $ \(input, err) -> do+        putStr "Input: " >> TIO.putStr input+        putStrLn $ "\nError: " ++ err
+ test/Main.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings #-}+module Main (main) where++import qualified Data.Text as T+import Arxiv.Query+import Arxiv.Client++failWith :: String -> IO a+failWith msg = ioError (userError msg)++assert :: Bool -> String -> IO ()+assert True _  = pure ()+assert False m = failWith m++main :: IO ()+main = do+  putStrLn "[test] renderSearchQuery builds fielded terms"+  let q = emptyQuery & inCategory "math.NT" & anyWords ["Chabauty","Coleman"]+  let rq = renderSearchQuery q+  putStrLn (" search_query = " <> T.unpack rq)+  assert ("cat:math.NT" `T.isInfixOf` rq) "missing cat:math.NT"+  assert ("all:" `T.isInfixOf` rq)        "missing 'all:' prefix"++  putStrLn "[test] simple network call returns some entries"+  es <- queryArxivIO (emptyQuery & anyWords ["electron"] & setPaging 0 5)+  assert (not (null es)) "expected non-empty result for 'electron'"++  putStrLn "[test] OK"