diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/arxiv.cabal b/arxiv.cabal new file mode 100644 --- /dev/null +++ b/arxiv.cabal @@ -0,0 +1,48 @@ +Name: arxiv +Version: 0.0.1 +Cabal-Version: >= 1.8 +Copyright: Copyright (c) Tobias Schoofs, 2014 +License: LGPL +license-file: license/lgpl-3.0.txt +Author: Tobias Schoofs +Maintainer: Tobias Schoofs +Homepage: http://github.com/toschoo/libs +Category: Network, API, NetworkAPI, Arxiv +Build-Type: Simple +Synopsis: A client for the Arxiv API +Description: + + The arXiv is a repository of electronic preprints, known as e-prints, + of scientific papers in the fields of mathematics, physics, astronomy, + computer science, quantitative biology, statistics, and quantitative finance, + which can be accessed online. In many fields of mathematics and physics, + almost all scientific papers are self-archived on the arXiv. + + . + + The arXiv features an API to ease access to e-prints. + This library provides a simple and easy-to-use Haskell binding + for the arXiv API. + + . + + For the full documentation of the arXiv API, please refer to + . + + . + + More information on this haskell library, + examples and a test suite are available + on . + +Library + Build-Depends: base >= 4.0 && <= 5.0, + parsec >= 3.1.5, + split >= 0.2.2, + tagsoup >= 0.13 + + hs-source-dirs: src, . + + Exposed-Modules: Network.Api.Arxiv + other-modules: + diff --git a/license/lgpl-3.0.txt b/license/lgpl-3.0.txt new file mode 100644 --- /dev/null +++ b/license/lgpl-3.0.txt @@ -0,0 +1,165 @@ + GNU LESSER GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + + This version of the GNU Lesser General Public License incorporates +the terms and conditions of version 3 of the GNU General Public +License, supplemented by the additional permissions listed below. + + 0. Additional Definitions. + + As used herein, "this License" refers to version 3 of the GNU Lesser +General Public License, and the "GNU GPL" refers to version 3 of the GNU +General Public License. + + "The Library" refers to a covered work governed by this License, +other than an Application or a Combined Work as defined below. + + An "Application" is any work that makes use of an interface provided +by the Library, but which is not otherwise based on the Library. +Defining a subclass of a class defined by the Library is deemed a mode +of using an interface provided by the Library. + + A "Combined Work" is a work produced by combining or linking an +Application with the Library. The particular version of the Library +with which the Combined Work was made is also called the "Linked +Version". + + The "Minimal Corresponding Source" for a Combined Work means the +Corresponding Source for the Combined Work, excluding any source code +for portions of the Combined Work that, considered in isolation, are +based on the Application, and not on the Linked Version. + + The "Corresponding Application Code" for a Combined Work means the +object code and/or source code for the Application, including any data +and utility programs needed for reproducing the Combined Work from the +Application, but excluding the System Libraries of the Combined Work. + + 1. Exception to Section 3 of the GNU GPL. + + You may convey a covered work under sections 3 and 4 of this License +without being bound by section 3 of the GNU GPL. + + 2. Conveying Modified Versions. + + If you modify a copy of the Library, and, in your modifications, a +facility refers to a function or data to be supplied by an Application +that uses the facility (other than as an argument passed when the +facility is invoked), then you may convey a copy of the modified +version: + + a) under this License, provided that you make a good faith effort to + ensure that, in the event an Application does not supply the + function or data, the facility still operates, and performs + whatever part of its purpose remains meaningful, or + + b) under the GNU GPL, with none of the additional permissions of + this License applicable to that copy. + + 3. Object Code Incorporating Material from Library Header Files. + + The object code form of an Application may incorporate material from +a header file that is part of the Library. You may convey such object +code under terms of your choice, provided that, if the incorporated +material is not limited to numerical parameters, data structure +layouts and accessors, or small macros, inline functions and templates +(ten or fewer lines in length), you do both of the following: + + a) Give prominent notice with each copy of the object code that the + Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the object code with a copy of the GNU GPL and this license + document. + + 4. Combined Works. + + You may convey a Combined Work under terms of your choice that, +taken together, effectively do not restrict modification of the +portions of the Library contained in the Combined Work and reverse +engineering for debugging such modifications, if you also do each of +the following: + + a) Give prominent notice with each copy of the Combined Work that + the Library is used in it and that the Library and its use are + covered by this License. + + b) Accompany the Combined Work with a copy of the GNU GPL and this license + document. + + c) For a Combined Work that displays copyright notices during + execution, include the copyright notice for the Library among + these notices, as well as a reference directing the user to the + copies of the GNU GPL and this license document. + + d) Do one of the following: + + 0) Convey the Minimal Corresponding Source under the terms of this + License, and the Corresponding Application Code in a form + suitable for, and under terms that permit, the user to + recombine or relink the Application with a modified version of + the Linked Version to produce a modified Combined Work, in the + manner specified by section 6 of the GNU GPL for conveying + Corresponding Source. + + 1) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (a) uses at run time + a copy of the Library already present on the user's computer + system, and (b) will operate properly with a modified version + of the Library that is interface-compatible with the Linked + Version. + + e) Provide Installation Information, but only if you would otherwise + be required to provide such information under section 6 of the + GNU GPL, and only to the extent that such information is + necessary to install and execute a modified version of the + Combined Work produced by recombining or relinking the + Application with a modified version of the Linked Version. (If + you use option 4d0, the Installation Information must accompany + the Minimal Corresponding Source and Corresponding Application + Code. If you use option 4d1, you must provide the Installation + Information in the manner specified by section 6 of the GNU GPL + for conveying Corresponding Source.) + + 5. Combined Libraries. + + You may place library facilities that are a work based on the +Library side by side in a single library together with other library +facilities that are not Applications and are not covered by this +License, and convey such a combined library under terms of your +choice, if you do both of the following: + + a) Accompany the combined library with a copy of the same work based + on the Library, uncombined with any other library facilities, + conveyed under the terms of this License. + + b) Give prominent notice with the combined library that part of it + is a work based on the Library, and explaining where to find the + accompanying uncombined form of the same work. + + 6. Revised Versions of the GNU Lesser General Public License. + + The Free Software Foundation may publish revised and/or new versions +of the GNU Lesser General Public License from time to time. Such new +versions will be similar in spirit to the present version, but may +differ in detail to address new problems or concerns. + + Each version is given a distinguishing version number. If the +Library as you received it specifies that a certain numbered version +of the GNU Lesser General Public License "or any later version" +applies to it, you have the option of following the terms and +conditions either of that published version or of any later version +published by the Free Software Foundation. If the Library as you +received it does not specify a version number of the GNU Lesser +General Public License, you may choose any version of the GNU Lesser +General Public License ever published by the Free Software Foundation. + + If the Library as you received it specifies that a proxy can decide +whether future versions of the GNU Lesser General Public License shall +apply, that proxy's public statement of acceptance of any version is +permanent authorization for you to choose that version for the +Library. diff --git a/src/Network/Api/Arxiv.hs b/src/Network/Api/Arxiv.hs new file mode 100644 --- /dev/null +++ b/src/Network/Api/Arxiv.hs @@ -0,0 +1,1070 @@ +------------------------------------------------------------------------------- +-- | +-- Module : Network.Api.Arxiv.hs +-- Copyright : (c) Tobias Schoofs +-- License : LGPL +-- Stability : experimental +-- Portability: portable +-- +-- The ArXiv API is split in two parts: +-- Request and Response. +-- The Request part contains +-- a simple language to define queries, +-- a query parser and some helpers to navigate +-- through the results of a mutlipage query +-- (which, in fact, induces a new query). +-- +-- The Response part contains +-- an API to access the fields of the result +-- based on TagSoup. +-- +-- This library does not contain functions +-- to actually execute and manage http requests. +-- It is intended to be used with existing +-- http libraries such as http-conduit. +-- An example how to use the ArXiv library +-- with http-conduit is included in this documentation. +------------------------------------------------------------------------------- +module Network.Api.Arxiv ( + -- * Request + -- $RequestOv + baseUrl, apiUrl, apiQuery, + Field(..), Expression(..), + (/*/), (/+/), (/-/), + + -- * Expression Example + -- $ExpExample + + -- * Queries + Query(..), nextPage, + parseQuery, preprocess, parseIds, + mkQuery, exp2str, items2str, ids2str, + itemControl, + + -- * Response + -- $ResponseOv + totalResults, startIndex, itemsPerPage, + getEntry, forEachEntry, forEachEntryM, forEachEntryM_, + checkForError, exhausted, + getId, getIdUrl, getUpdated, getPublished, getYear, + getTitle, getSummary, + getComment, getJournal, getDoi, + Link(..), + getLinks, getPdfLink, getPdf, + Category(..), + getCategories, getPrimaryCategory, + Author(..), + getAuthors, getAuthorNames + + -- * A complete Example using http-conduit + -- $CompleteExample + ) +where + + import Text.HTML.TagSoup + import Text.Parsec + import Data.Char (isDigit) + import Data.Maybe (fromMaybe) + import Data.List (find, intercalate) + import qualified Data.List.Split as S + import Control.Applicative ((<$>)) + import Control.Monad (void) + + ------------------------------------------------------------------------ + -- import Debug.Trace (trace) + ------------------------------------------------------------------------ + + {- $ExpExample + + Expressions are intended to ease the construction + of well-formed queries in application code. + A simple example: + + > let au = Exp $ Au ["Knuth"] + > t1 = Exp $ Ti ["The Art of Computer Programming"] + > t2 = Exp $ Ti ["Concrete Mathematics"] + > ex = au /*/ (t1 /+/ t2) + > in ... + -} + + {- $RequestOv + + Requests are URL parameters, + either \"search_query\" or \"id_list\". + This module provides functions + to build and parse these parameters, + to create the full request string + and to navigate through a multi-page request + with a maximum number of items per page. + + For details of the Arxiv request format, + please refer to the Arxiv documentation. + -} + + {- $ResponseOv + + Response processing expects [Tag String] as input (see TagSoup). + The result produced by your http library + (such as http-conduit) must be converted to [Tag String] + before the result is passed to the response functions + defined here (see also the example below). + + The response functions extract information from the tag soup, + either in 'String', 'Int' or TagSoup format. + + For details of the Arxiv Feed format, please refer + to the Arxiv documentation. + -} + + {- $CompleteExample + + > module Main + > where + > + > import qualified Network.Api.Arxiv as Ax + > import Network.Api.Arxiv (Expression(..), + > Field(..), (/*/), (/+/)) + > import Network (withSocketsDo) + > import Network.HTTP.Conduit + > import Network.HTTP.Types.Status + > import Data.List (intercalate) + > import qualified Data.ByteString as B hiding (unpack) + > import qualified Data.ByteString.Char8 as B (unpack) + > import Data.Conduit (($$+-), (=$), ($$)) + > import qualified Data.Conduit as C + > import qualified Data.Conduit.List as CL + > import Text.HTML.TagSoup + > import Control.Monad.Trans (liftIO) + > import Control.Monad.Trans.Resource (MonadResource) + > import Control.Applicative ((<$>)) + > + > main :: IO () + > main = withSocketsDo (execQuery makeQuery) + > + > makeQuery :: Ax.Query + > makeQuery = + > let au = Exp $ Au ["Aaronson"] + > t1 = Exp $ Ti ["quantum"] + > t2 = Exp $ Ti ["complexity"] + > x = au /*/ (t1 /+/ t2) + > in Ax.Query { + > Ax.qExp = Just x, + > Ax.qIds = [], + > Ax.qStart = 0, + > Ax.qItems = 25} + > + > type Soup = Tag String + > + > execQuery :: Ax.Query -> IO () + > execQuery q = withManager $ \m -> searchAxv m q $$ outSnk + > + > ----------------------------------------------------------------- + > -- Execute query and start a source + > ----------------------------------------------------------------- + > searchAxv :: MonadResource m => + > Manager -> Ax.Query -> C.Source m String + > searchAxv m q = do + > u <- liftIO (parseUrl $ mkQuery q) + > rsp <- http u m + > case responseStatus rsp of + > (Status 200 _) -> getSoup rsp >>= results m q + > st -> error $ "Error:" ++ show st + > + > ----------------------------------------------------------------- + > -- Consume page by page + > ----------------------------------------------------------------- + > getSoup :: MonadResource m => + > Response (C.ResumableSource m B.ByteString) -> m [Soup] + > getSoup rsp = concat <$> (responseBody rsp $$+- + > toSoup =$ CL.consume) + > + > ----------------------------------------------------------------- + > -- Receive a ByteString and yield Soup + > ----------------------------------------------------------------- + > toSoup :: MonadResource m => C.Conduit B.ByteString m [Soup] + > toSoup = C.awaitForever (C.yield . parseTags . B.unpack) + > + > ------------------------------------------------------------------ + > -- Yield all entries and fetch next page + > ------------------------------------------------------------------ + > results :: MonadResource m => + > Manager -> Ax.Query -> [Soup] -> C.Source m String + > results m q sp = + > if Ax.exhausted sp + > then C.yield ("EOT: " ++ show (Ax.totalResults sp) ++ + > " results") + > else Ax.forEachEntryM_ sp (C.yield . mkResult) + > >> searchAxv m (Ax.nextPage q) + > + > ------------------------------------------------------------------ + > -- Get data and format somehow + > ------------------------------------------------------------------ + > mkResult :: [Soup] -> String + > mkResult sp = let aus = Ax.getAuthorNames sp + > y = Ax.getYear sp + > tmp = Ax.getTitle sp + > ti = if null tmp then "No title" else tmp + > in intercalate ", " aus ++ " (" ++ y ++ "): " ++ ti + > + > ------------------------------------------------------------------ + > -- Sink results + > ------------------------------------------------------------------ + > outSnk :: MonadResource m => C.Sink String m () + > outSnk = C.awaitForever (liftIO . putStrLn) + -} + + ------------------------------------------------------------------------ + -- | The Arxiv base URL \"arxiv.org\" + ------------------------------------------------------------------------ + baseUrl :: String + baseUrl = "arxiv.org" + + ------------------------------------------------------------------------ + -- | The Arxiv API URL \"export.arxiv.org/api\" + ------------------------------------------------------------------------ + apiUrl :: String + apiUrl = "http://export.arxiv.org/api/query?" + + ------------------------------------------------------------------------ + -- | The query string (\"search_query=\" or \"id_list=\") + ------------------------------------------------------------------------ + apiQuery,apiIdList :: String + apiQuery = "search_query=" + apiIdList = "id_list=" + + ------------------------------------------------------------------------ + -- | Field data type; + -- a field consist of a field identifier + -- (author, title, etc.) + -- and a list of search terms. + ------------------------------------------------------------------------ + data Field = + -- | Title + Ti [Term] + + -- | Author + | Au [Term] + + -- | Abstract + | Abs [Term] + + -- | Comment + | Co [Term] + + -- | Journal + | Jr [Term] + + -- | Category + | Cat [Term] + + -- | Report Number + | Rn [Term] + + -- | Article identifier + | Id [Term] + + -- | Any of the above + | All [Term] + deriving (Eq, Show) + + ------------------------------------------------------------------------ + -- | A term is just a string + ------------------------------------------------------------------------ + type Term = String + + ------------------------------------------------------------------------ + -- convert a field to a string + ------------------------------------------------------------------------ + field2str :: Field -> String + field2str (Ti s) = "ti:" ++ terms2str s + field2str (Au s) = "au:" ++ terms2str s + field2str (Abs s) = "abs:" ++ terms2str s + field2str (Co s) = "co:" ++ terms2str s + field2str (Jr s) = "jr:" ++ terms2str s + field2str (Cat s) = "cat:" ++ terms2str s + field2str (Rn s) = "rn:" ++ terms2str s + field2str (Id s) = "id:" ++ terms2str s + field2str (All s) = "all:" ++ terms2str s + + ------------------------------------------------------------------------ + -- convert a term to a string + ------------------------------------------------------------------------ + terms2str :: [Term] -> String + terms2str = intercalate "+" . map term2str + where term2str t = + let x = intercalate "+" (words t) + in if '+' `elem` x then "%22" ++ x ++ "%22" else x + + ------------------------------------------------------------------------ + -- | Expression data type. + -- An expression is either a field or a logical connection + -- of two expressions using the basic operators + -- AND, OR and ANDNOT. + ------------------------------------------------------------------------ + data Expression = + -- | Just a field + Exp Field + + -- | Logical \"and\" + | And Expression Expression + + -- | Logical \"or\" + | Or Expression Expression + + -- | Logical \"and . not\" + | AndNot Expression Expression + deriving (Eq, Show) + + ------------------------------------------------------------------------ + -- | AND operator. + -- The symbol was chosen because + -- 0 * 1 = 0. + ------------------------------------------------------------------------ + infix /*/ + (/*/) :: Expression -> Expression -> Expression + (/*/) = And + + ------------------------------------------------------------------------ + -- | OR operator. + -- The symbol was chosen because + -- 0 + 1 = 1. + ------------------------------------------------------------------------ + infix /+/ + (/+/) :: Expression -> Expression -> Expression + (/+/) = Or + + ------------------------------------------------------------------------ + -- | ANDNOT operator. + -- The symbol was chosen because + -- 1 - 1 = 0 and 1 - 0 = 1. + ------------------------------------------------------------------------ + infix /-/ + (/-/) :: Expression -> Expression -> Expression + (/-/) = AndNot + + ------------------------------------------------------------------------ + -- | Create a query string from an expression. + -- Note that we create redundant parentheses, + -- for instance \"a AND b OR c\" will be encoded as + -- \"a+AND+%28b+OR+c%29\". + -- The rationale is that the API specification is not clear + -- on how expressions are parsed. + -- The above expression could be understood as + -- \"a AND (b OR c)\" or as \"(a AND b) OR c\". + -- To avoid confusion, one should always use parentheses + -- to group boolean expressions - even if some of these parentheses + -- appear to be redundant under one or the other parsing strategy. + ------------------------------------------------------------------------ + exp2str, innerExp2str :: Expression -> String + exp2str (Exp f) = field2str f + exp2str (And e1 e2) = innerExp2str e1 ++ "+AND+" ++ innerExp2str e2 + exp2str (Or e1 e2) = innerExp2str e1 ++ "+OR+" ++ innerExp2str e2 + exp2str (AndNot e1 e2) = innerExp2str e1 ++ "+ANDNOT+" ++ innerExp2str e2 + innerExp2str (Exp f) = exp2str (Exp f) + innerExp2str e = "%28" ++ exp2str e ++ "%29" + + type Identifier = String + + ------------------------------------------------------------------------ + -- | Query data type. + -- + -- You usually want to create a query like: + -- + -- > let e = (Exp $ Au ["Aaronson"]) /*/ ( + -- > (Exp $ Ti ["quantum"]) /+/ + -- > (Exp $ Ti ["complexity"])) + -- > in Query { + -- > qExp = Just e, + -- > qIds = ["0902.3175v2","1406.2858v1","0912.3825v1"], + -- > qStart = 0, + -- > qItems = 10} + ------------------------------------------------------------------------ + data Query = Query { + -- | The query expression + qExp :: Maybe Expression, + -- | Id List + qIds :: [Identifier], + -- | The first item we want to see + qStart :: Int, + -- | The number of items we want to see + qItems :: Int} + deriving (Eq, Show) + + ------------------------------------------------------------------------- + -- | Prepares the query to fetch + -- the next page adding \"items per page\" to \"start index\". + ------------------------------------------------------------------------- + nextPage :: Query -> Query + nextPage q = let s = qStart q + i = qItems q + in q{qStart = s + i} + + ------------------------------------------------------------------------- + -- | Checks whether the query is exhausted or not, i.e. + -- whether all pages have been fetched already. + -- The first argument is the entire response (not just a part of it). + ------------------------------------------------------------------------- + exhausted :: [Tag String] -> Bool + exhausted sp = startIndex sp >= totalResults sp + + ------------------------------------------------------------------------- + -- | Parses an expression from a string. + -- Please refer to the Arxiv documentation for details + -- on query format. + -- + -- Just a minor remark here: + -- The operators OR, AND and ANDNOT are case sensitive. + -- \"andnot\" would be interpreted as part of a title, for instance: + -- \"ti:functional+andnot+object+oriented\" is just one title; + -- \"ti:functional+ANDNOT+object+oriented\" would cause an error, + -- because a field identifier (ti, au, etc.) is expected after + -- \"+ANDNOT+\". + -- + -- The other way round: the field content itself + -- is not case sensitive, i.e. + -- \"ti:complexity\" or \"au:aaronson\" is the same as + -- \"ti:Complexity\" and \"au:Aaronson\" respectively. + -- This is a feature of the very arXiv API. + -- + -- You may want to refer to the comments under + -- 'preprocess' and 'exp2str' for some more details + -- on our interpretation of the Arxiv documentation. + ------------------------------------------------------------------------- + parseQuery :: String -> Either String Expression + parseQuery s = case parse expression "" $ preprocess s of + Left e -> Left $ show e + Right e -> Right e + + ------------------------------------------------------------------------- + -- | Converts a string containing comma-separated identifiers + -- into a list of 'Identifier's. + -- As stated already: No whitespace! + ------------------------------------------------------------------------- + parseIds :: String -> [Identifier] + parseIds = S.endBy "," + + ------------------------------------------------------------------------- + -- | This is an internal function used by 'parseQuery'. + -- It may be occasionally useful for direct use: + -- It replaces \" \", \"(\", \")\" and \"\"\" + -- by \"+\", \"%28\", \"%29\" and \"%22\" + -- respectively. + -- + -- Usually, these substitutions are performed + -- when transforming a string to an URL, which should be done + -- by your http library anyway (e.g. http-conduit). + -- But this step is usually after parsing has been performed + -- on the input string. (Considering a work flow like: + -- parseQuery >>= mkQuery >>= parseUrl >>= execQuery.) + -- The parser, however, accepts + -- only the URL-encoded characters and, thus, some preprocessing + -- may be necessary. + -- + -- The other way round, this means + -- that you may use parentheses, spaces and quotation marks + -- instead of the URL encodings. + -- But be careful! Do not introduce two successive spaces - + -- we do not check for whitespace! + ------------------------------------------------------------------------- + preprocess :: String -> String + preprocess = concatMap s2s . map tos + where s2s "(" = "%28" + s2s ")" = "%29" + s2s "\"" = "%22" + s2s " " = "+" + s2s c = c + tos c = [c] + + ------------------------------------------------------------------------- + -- | Generates the complete query string + -- including URL, + -- query expression, + -- id list and + -- item control + ------------------------------------------------------------------------- + mkQuery :: Query -> String + mkQuery q = apiUrl ++ qry ++ x ++ plus ++ apiIdList ++ is ++ itm + where x = case qExp q of + Nothing -> "" + Just e -> exp2str e + plus = case qExp q of + Nothing -> "" + Just _ -> "&" + qry = case qExp q of + Nothing -> "" + Just _ -> apiQuery + is = ids2str $ qIds q + itm = items2str q + + ------------------------------------------------------------------------- + -- | Converts a list of 'Identifier' + -- to a string with comma-separated identifiers + ------------------------------------------------------------------------- + ids2str :: [Identifier] -> String + ids2str = foldr i2s "" + where i2s i [] = i + i2s i s = i ++ "," ++ s + + ------------------------------------------------------------------------- + -- | Converts the query to a string containing only the item control + ------------------------------------------------------------------------- + items2str :: Query -> String + items2str q = itemControl (qStart q) (qItems q) + + ------------------------------------------------------------------------- + -- | Generates the item control of a query string according + -- to first item and results per page: + -- + -- * 'Int': Start index for this page + -- + -- * 'Int': Number of results per page. + ------------------------------------------------------------------------- + itemControl :: Int -> Int -> String + itemControl s m = "&start=" ++ show s ++ + "&max_results=" ++ show m + + -- ====================================================================== + -- result + -- ====================================================================== + + ------------------------------------------------------------------------ + -- | Total results of the query + ------------------------------------------------------------------------ + totalResults :: [Tag String] -> Int + totalResults = getN "opensearch:totalResults" + + ------------------------------------------------------------------------ + -- | Start index of this page of results + ------------------------------------------------------------------------ + startIndex :: [Tag String] -> Int + startIndex = getN "opensearch:startIndex" + + ------------------------------------------------------------------------ + -- | Number of items per page + ------------------------------------------------------------------------ + itemsPerPage :: [Tag String] -> Int + itemsPerPage = getN "opensearch:itemsPerPage" + + ------------------------------------------------------------------------ + -- | Checks if the feed contains an error message, i.e. + -- + -- * it has only one entry, + -- + -- * the title of this entry is \"Error\" and + -- + -- * its id field contains an error message, + -- which is returned as 'Left'. + -- + -- Apparently, this function is not necessary, + -- since the Arxiv site returns error feeds + -- with status code 400 ("bad request"), + -- which should be handled by your http library anyway. + ------------------------------------------------------------------------ + checkForError :: [Tag String] -> Either String () + checkForError ts = case totalResults ts of + 1 -> head $ forEachEntry ts $ \e -> + if getTitle e == "Error" + then Left $ getError e + else Right () + _ -> Right () + + + ------------------------------------------------------------------------ + -- | Get the first entry in the tag soup. + -- The function returns a tuple of + -- + -- * The entry (if any) + -- + -- * The rest of the tag soup following the first entry. + -- + -- With getEntry, we can build a loop through all entries + -- in the result (which is actually implemented in 'forEachEntry'). + ------------------------------------------------------------------------ + getEntry :: [Tag String] -> ([Tag String],[Tag String]) + getEntry = element "entry" + + ------------------------------------------------------------------------ + -- | Loop through all entries in the result feed + -- applying a function on each one. + -- The results are returned as list. + -- The function is similar to 'map' + -- with the arguments swapped (as in Foldable 'forM'). + -- + -- Arguments: + -- + -- * ['Tag' 'String']: The TagSoup through which we are looping + -- + -- * ['Tag' 'String'] -> r: The function we are applying per entry; + -- the TagSoup passed in to the function + -- represents the current entry. + -- + -- Example: + -- + -- > forEachEntry soup $ \e -> + -- > let y = case getYear e of + -- > "" -> "s.a." + -- > x -> x + -- > a = case getAuthorNames e of + -- > [] -> "Anonymous" + -- > as -> head as ++ + -- > in a ++ " (" ++ y ++ ")" + -- + -- Would retrieve the name of the first author + -- and the year of publication (like "Aaronson (2013)") + -- from all entries. + ------------------------------------------------------------------------ + forEachEntry :: [Tag String] -> ([Tag String] -> r) -> [r] + forEachEntry = forEach "entry" + + ------------------------------------------------------------------------ + -- | Variant of 'forEachEntry' for monadic actions. + ------------------------------------------------------------------------ + forEachEntryM :: Monad m => + [Tag String] -> ([Tag String] -> m r) -> m [r] + forEachEntryM = forEachM "entry" + + ------------------------------------------------------------------------ + -- | Variant of 'forEachEntryM' for actions + -- that do not return a result. + ------------------------------------------------------------------------ + forEachEntryM_ :: Monad m => + [Tag String] -> ([Tag String] -> m ()) -> m () + forEachEntryM_ = forEachM_ "entry" + + ------------------------------------------------------------------------ + -- | Gets the full contents of the id field + -- (which contains an URL before the article identifier). + -- The [Tag String] argument is expected to be a single entry. + ------------------------------------------------------------------------ + getIdUrl :: [Tag String] -> String + getIdUrl = getString "id" + + ------------------------------------------------------------------------ + -- | Gets the article identifier as it can be used + -- in an \"id_list\" query, i.e. without the URL. + -- The [Tag String] argument is expected to be a single entry. + ------------------------------------------------------------------------ + getId :: [Tag String] -> String + getId = pureId . getString "id" + + ------------------------------------------------------------------------ + -- Extract the pure article identifier from the id string + ------------------------------------------------------------------------ + pureId :: String -> String + pureId s = let i = toSlash 2 (reverse s) + z = drop 6 i + in case z of + "" -> reverse i + '.':_ -> reverse $ toSlash 1 i + _ -> reverse i + where toSlash :: Int -> String -> String + toSlash i m = let x = takeWhile (/= '/') m + in if i == 1 then x + else x ++ ('/' : + toSlash (i-1) (drop (length x + 1) m)) + + ------------------------------------------------------------------------ + -- Get the error message + ------------------------------------------------------------------------ + getError :: [Tag String] -> String + getError = pureError . getString "id" + + ------------------------------------------------------------------------ + -- Extract the pure error message from the id string + ------------------------------------------------------------------------ + pureError :: String -> String + pureError = drop 1 . dropWhile (/= '#') + + ------------------------------------------------------------------------ + -- | Gets the contents of the \"update\" field in this entry, i.e. + -- the date when the article was last updated. + ------------------------------------------------------------------------ + getUpdated :: [Tag String] -> String + getUpdated = getString "updated" + + ------------------------------------------------------------------------ + -- | Gets the contents of the \"published\" field in this entry, i.e. + -- the date when the article was last uploaded. + ------------------------------------------------------------------------ + getPublished :: [Tag String] -> String + getPublished = getString "published" + + ------------------------------------------------------------------------ + -- | Gets the year of the \"published\" field in this entry. + ------------------------------------------------------------------------ + getYear :: [Tag String] -> String + getYear sp = case getPublished sp of + "" -> "s.a." + s -> takeWhile (/= '-') s + + ------------------------------------------------------------------------ + -- | Gets the title of this entry. + ------------------------------------------------------------------------ + getTitle :: [Tag String] -> String + getTitle = getString "title" + + ------------------------------------------------------------------------ + -- | Gets the summary of this entry. + ------------------------------------------------------------------------ + getSummary :: [Tag String] -> String + getSummary = getString "summary" + + ------------------------------------------------------------------------ + -- | Gets author''s comment (in \"arxiv:comment\") of this entry. + ------------------------------------------------------------------------ + getComment :: [Tag String] -> String + getComment = getString "arxiv:comment" + + ------------------------------------------------------------------------ + -- | Gets the journal information (in \"arxiv:journal_ref\") + -- of this entry. + ------------------------------------------------------------------------ + getJournal :: [Tag String] -> String + getJournal = getString "arxiv:journal_ref" + + ------------------------------------------------------------------------ + -- | Gets the digital object identifier (in \"arxiv:doi\") + -- of this entry. + ------------------------------------------------------------------------ + getDoi :: [Tag String] -> String + getDoi = getString "arxiv:doi" + + ------------------------------------------------------------------------ + -- | The Link data type + ------------------------------------------------------------------------ + data Link = Link { + -- | The hyperlink + lnkHref :: String, + -- | The link type (a MIME type) + lnkType :: String, + -- | The link title (e.g. \"pdf\" would be the link + -- where we find the article + -- in pdf format) + lnkTitle :: String, + -- | the link relation (e.g. \"related\" would point + -- to the related information, + -- such as the pdf document) + lnkRel :: String} + deriving (Show, Eq) + + ------------------------------------------------------------------------ + -- | Gets all links in the entry. + ------------------------------------------------------------------------ + getLinks :: [Tag String] -> [Link] + getLinks soup = case element "link" soup of + ([],_) -> [] + (x:_,[]) -> [mkLink x] + (x:_,rs) -> mkLink x : getLinks rs + where mkLink l = Link { + lnkHref = fromMaybe "" $ getAt "href" l, + lnkTitle = fromMaybe "" $ getAt "title" l, + lnkRel = fromMaybe "" $ getAt "rel" l, + lnkType = fromMaybe "" $ getAt "type" l} + + ------------------------------------------------------------------------ + -- | Gets only the pdf link of this entry (if any). + ------------------------------------------------------------------------ + getPdfLink :: [Tag String] -> Maybe Link + getPdfLink soup = case getLinks soup of + [] -> Nothing + ls -> find (\l -> lnkTitle l == "pdf") ls + + ------------------------------------------------------------------------ + -- | Gets the hyperlink to the pdf document of this entry (if any). + ------------------------------------------------------------------------ + getPdf :: [Tag String] -> String + getPdf soup = case getPdfLink soup of + Nothing -> "" + Just l -> lnkHref l + + ------------------------------------------------------------------------ + -- | Category data type + ------------------------------------------------------------------------ + data Category = Category { + -- | The category term (e.g. \"math-ph\") + catTerm :: String, + -- | The category scheme + catScheme :: String} + deriving (Show, Eq) + + ------------------------------------------------------------------------ + -- Make category from TagSoup + ------------------------------------------------------------------------ + mkCat :: Tag String -> Category + mkCat c = Category { + catTerm = fromMaybe "" $ getAt "term" c, + catScheme = fromMaybe "" $ getAt "scheme" c} + + ------------------------------------------------------------------------ + -- | Gets the categories of this entry. + ------------------------------------------------------------------------ + getCategories :: [Tag String] -> [Category] + getCategories soup = case element "category" soup of + ([],_) -> [] + (x:_,[]) -> [mkCat x] + (x:_,rs) -> mkCat x : getCategories rs + + ------------------------------------------------------------------------ + -- | Gets the primary category of this entry (if any). + ------------------------------------------------------------------------ + getPrimaryCategory :: [Tag String] -> Maybe Category + getPrimaryCategory soup = case element "arxiv:primary_category" soup of + ([],_) -> Nothing + (x:_,_) -> Just (mkCat x) + + ------------------------------------------------------------------------ + -- | The Author data type + ------------------------------------------------------------------------ + data Author = Author { + -- | Author name + auName :: String, + -- | Author Affiliation + auFil :: String} + deriving (Show, Eq) + + ------------------------------------------------------------------------ + -- | Gets the authors of this entry. + ------------------------------------------------------------------------ + getAuthors :: [Tag String] -> [Author] + getAuthors soup = case element "author" soup of + ([],_) -> [] + (xs,rs) -> mkAut xs : getAuthors rs + where mkAut au = let nm = case element "name" au of + ([],_) -> "" + (n,_) -> findTxt n + fl = case element "arxiv:affiliation" au of + ([],_) -> "" + (a,_) -> findTxt a + in Author { + auName = nm, + auFil = fl} + + ------------------------------------------------------------------------ + -- | Gets the names of all authors of this entry. + ------------------------------------------------------------------------ + getAuthorNames :: [Tag String] -> [String] + getAuthorNames = go + where go s = case element "author" s of + ([],[]) -> [] + (a,[]) -> [getString "name" a] + (a,r) -> getString "name" a : go r + + ------------------------------------------------------------------------ + -- Lookup attribute by name + ------------------------------------------------------------------------ + getAt :: String -> Tag String -> Maybe String + getAt a (TagOpen _ as) = lookup a as + getAt _ _ = Nothing + + ------------------------------------------------------------------------ + -- Find a 'TagText' and return the content + ------------------------------------------------------------------------ + getString :: String -> [Tag String] -> String + getString n soup = let (i,_) = element n soup + in if null i then "" else findTxt i + + ------------------------------------------------------------------------ + -- Find a 'TagText' and return the contentas a 'Int'. + -- If the tag is not found or the content is not a number, + -- -1 is returned. + ------------------------------------------------------------------------ + getN :: String -> [Tag String] -> Int + getN key soup = case element key soup of + (k,_) -> case findTxt k of + "" -> -1 + t -> if all isDigit t then read t else -1 + + ------------------------------------------------------------------------ + -- Get the content of a 'TagText' + ------------------------------------------------------------------------ + findTxt :: [Tag String] -> String + findTxt [] = "" + findTxt (t:ts) = case t of + TagText x -> x + _ -> findTxt ts + + ------------------------------------------------------------------------ + -- Map a function to all occurences of an element in the soup + ------------------------------------------------------------------------ + forEach :: String -> [Tag String] -> ([Tag String] -> r) -> [r] + forEach nm soup f = case element nm soup of + ([],_) -> [] + (e,rs) -> f e : forEach nm rs f + + ------------------------------------------------------------------------ + -- Variant of forEach for monadic actions + ------------------------------------------------------------------------ + forEachM :: Monad m => + String -> [Tag String] -> ([Tag String] -> m r) -> m [r] + forEachM nm soup f = case element nm soup of + ([],_) -> return [] + (e,rs) -> do r <- f e + rr <- forEachM nm rs f + return (r:rr) + + ------------------------------------------------------------------------ + -- Variant of forEachM for actions that do not return anything + ------------------------------------------------------------------------ + forEachM_ :: Monad m => + String -> [Tag String] -> ([Tag String] -> m ()) -> m () + forEachM_ nm soup f = case element nm soup of + ([],_) -> return () + (e,rs) -> f e >> forEachM_ nm rs f + + ------------------------------------------------------------------------ + -- Find occurrence of an element and + -- return this element (open tag to close tag) and + -- the rest of the soup behind the element. + ------------------------------------------------------------------------ + element :: String -> [Tag String] -> ([Tag String], [Tag String]) + element _ [] = ([],[]) + element nm (t:ts) | isTagOpenName nm t = let (r,rs) = closeEl 0 ts + in (t:r,rs) + | otherwise = element nm ts + where closeEl :: Int -> [Tag String] -> ([Tag String], [Tag String]) + closeEl _ [] = ([],[]) + closeEl i (x:xs) = go i (isTagCloseName nm x) x xs + go i b x xs | b && i == 0 = ([x],xs) + | b && i > 0 = let (r,rs) = closeEl (i-1) xs + in (x:r,rs) + | isTagOpenName nm x = let (r,rs) = closeEl (i+1) xs + in (x:r,rs) + | otherwise = let (r,rs) = closeEl i xs + in (x:r,rs) + + ------------------------------------------------------------------------ + -- Expression Parser + ------------------------------------------------------------------------ + type Parser a = Parsec String () a + + ------------------------------------------------------------------------ + -- Expression is something in parentheses or something + -- that starts with a field + ------------------------------------------------------------------------ + expression :: Parser Expression + expression = try parentheses <|> fieldOperator + + ------------------------------------------------------------------------ + -- A field potentially followed by an operator + ------------------------------------------------------------------------ + fieldOperator :: Parser Expression + fieldOperator = do + f <- field + c <- try (char '+') <|> return ' ' + if c == ' ' then return f + else opAndArg f + + ------------------------------------------------------------------------ + -- Find an operator and an expression + ------------------------------------------------------------------------ + opAndArg :: Expression -> Parser Expression + opAndArg f = do + o <- op + void $ char '+' + e <- expression + return (o f e) + + ------------------------------------------------------------------------ + -- A field consists of a fieldId and a list of terms + ------------------------------------------------------------------------ + field :: Parser Expression + field = do + i <- fieldId + ts <- terms + return (Exp $ i ts) + + ------------------------------------------------------------------------ + -- The field ids + ------------------------------------------------------------------------ + fieldId :: Parser ([Term] -> Field) + fieldId = try (void (string "au:" ) >> return Au) + <|> try (void (string "ti:" ) >> return Ti) + <|> try (void (string "abs:") >> return Abs) + <|> try (void (string "co:" ) >> return Co) + <|> try (void (string "cat:") >> return Cat) + <|> try (void (string "jr:" ) >> return Jr) + <|> try (void (string "rn:" ) >> return Rn) + <|> try (void (string "id:" ) >> return Id) + <|> (void (string "all:") >> return All) + + ------------------------------------------------------------------------ + -- A term may be quoted, + -- otherwise we build terms as list of strings + -- separated by '+' + ------------------------------------------------------------------------ + terms :: Parser [String] + terms = do + t <- try quoted <|> term + c <- try (lookAhead anyChar) <|> onEof '%' --ugly + case c of + '%' -> return [t] + '+' -> do x <- isOp + if x then return [t] + else void (char c) >> (t:) <$> terms + _ -> fail $ "unexpected symbol: '" ++ [c] ++ "'" + + ------------------------------------------------------------------------ + -- Checks if an operator follows without consuming input + ------------------------------------------------------------------------ + isOp :: Parser Bool + isOp = try (void (lookAhead (string "+ANDNOT+")) >> return True) + <|> try (void (lookAhead (string "+AND+")) >> return True) + <|> try (void (lookAhead (string "+OR+")) >> return True) + <|> return False + + ------------------------------------------------------------------------ + -- A quoted term + ------------------------------------------------------------------------ + quoted :: Parser String + quoted = do + void $ string "%22" + intercalate "+" <$> go + where go = do + t <- term + s <- try (string "%22") <|> return "" + if not (null s) then return [t] + else do c <- anyChar + let t' = if c == '+' then t + else t ++ [c] + (t':) <$> go + + ------------------------------------------------------------------------ + -- A single term + ------------------------------------------------------------------------ + term :: Parser String + term = do + c <- try (lookAhead anyChar) <|> onEof '%' + if c `elem` "%+" + then return "" + else do x <- char c + (x:) <$> term + + ------------------------------------------------------------------------ + -- Signal EOF by returning the specified char + ------------------------------------------------------------------------ + onEof :: Char -> Parser Char + onEof c = eof >> return c + + ------------------------------------------------------------------------ + -- An expression in parentheses, + -- which may be followed by another expression + ------------------------------------------------------------------------ + parentheses :: Parser Expression + parentheses = do + void $ string "%28" + e <- expression + void $ string "%29" + c <- try (char '+') <|> try (lookAhead (char '%')) <|> onEof '.' + case c of + '+' -> opAndArg e + _ -> return e + + ------------------------------------------------------------------------ + -- Parse operator (note that it is essential to + -- to process "ANDNOT" before "AND"! + ------------------------------------------------------------------------ + op :: Parser (Expression -> Expression -> Expression) + op = try (void (string "ANDNOT") >> return AndNot) + <|> try (void (string "OR") >> return Or) + <|> (void (string "AND") >> return And) +