-------------------------------------------------------------------------------
-- |
-- 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.Socket (withSocketsDo)
     >   import           Network.HTTP.Simple as HT
     >   import           Network.HTTP.Conduit (parseRequest)
     >   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           Data.Function ((&))
     >   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 = C.runConduitRes (searchAxv q .| outSnk)
     > 
     >   ----------------------------------------------------------------------
     >   -- Execute query and start a source
     >   ----------------------------------------------------------------------
     >   searchAxv :: MonadResource m => Ax.Query -> C.ConduitT () String m ()
     >   searchAxv q = 
     >     let s = Ax.mkQuery q
     >      in do rsp <- HT.httpBS =<< liftIO (parseRequest s)
     >            case getResponseStatus rsp of
     >              (Status 200 _) -> getSoup (getResponseBody rsp)
     >                                >>= results q
     >              st             -> error $ "Error:" ++ show st
     > 
     >   ----------------------------------------------------------------------
     >   -- Consume page by page
     >   ----------------------------------------------------------------------
     >   getSoup :: MonadResource m =>  
     >              B.ByteString -> C.ConduitT () String m [Soup]
     >   getSoup b = concat <$> (C.yield b .| toSoup .| CL.consume)
     > 
     >   ----------------------------------------------------------------------
     >   -- Receive a ByteString and yield Soup
     >   ----------------------------------------------------------------------
     >   toSoup :: MonadResource m => C.ConduitT B.ByteString [Soup] m ()
     >   toSoup = C.awaitForever (C.yield . parseTags . B.unpack)
     > 
     >   ----------------------------------------------------------------------
     >   -- Yield all entries and fetch next page
     >   ----------------------------------------------------------------------
     >   results :: MonadResource m =>
     >              Ax.Query -> [Soup] -> C.ConduitT () String m ()
     >   results q sp = 
     >      if Ax.exhausted sp 
     >        then C.yield ("EOT: " ++ show (Ax.totalResults sp) ++ " results")
     >        else Ax.forEachEntryM_ sp (C.yield . mkResult) 
     >             >> searchAxv (Ax.nextPage q)
     >   
     >   ----------------------------------------------------------------------
     >   -- Get data and format
     >   ----------------------------------------------------------------------
     >   mkResult :: [Soup] -> String
     >   mkResult sp = let aus = Ax.getAuthorNames sp
     >                     y   = Ax.getYear sp
     >                     tmp = Ax.getTitle sp & clean ['\n', '\r', '\t']
     >                     ti  = if null tmp then "No title" else tmp
     >                  in intercalate ", " aus ++ " (" ++ y ++ "): " ++ ti
     >     where clean _ [] = []
     >           clean d (c:cs) | c `elem` d =   clean d cs
     >                          | otherwise  = c:clean d cs
     > 
     >   ----------------------------------------------------------------------
     >   -- Sink results 
     >   ----------------------------------------------------------------------
     >   outSnk :: MonadResource m => C.ConduitT String C.Void m ()
     >   outSnk = C.awaitForever (liftIO . putStrLn)
  -}

  ------------------------------------------------------------------------ 
  -- | The Arxiv base URL \"arxiv.org\"
  ------------------------------------------------------------------------ 
  baseUrl :: String
  baseUrl :: String
baseUrl =  String
"arxiv.org"

  ------------------------------------------------------------------------ 
  -- | The Arxiv API URL \"export.arxiv.org/api\"
  ------------------------------------------------------------------------ 
  apiUrl :: String
  apiUrl :: String
apiUrl =  String
"https://export.arxiv.org/api/query?"

  ------------------------------------------------------------------------ 
  -- | The query string (\"search_query=\" or \"id_list=\")
  ------------------------------------------------------------------------ 
  apiQuery,apiIdList :: String
  apiQuery :: String
apiQuery  = String
"search_query="
  apiIdList :: String
apiIdList = String
"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 (Field -> Field -> Bool
(Field -> Field -> Bool) -> (Field -> Field -> Bool) -> Eq Field
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Field -> Field -> Bool
$c/= :: Field -> Field -> Bool
== :: Field -> Field -> Bool
$c== :: Field -> Field -> Bool
Eq, Int -> Field -> ShowS
[Field] -> ShowS
Field -> String
(Int -> Field -> ShowS)
-> (Field -> String) -> ([Field] -> ShowS) -> Show Field
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Field] -> ShowS
$cshowList :: [Field] -> ShowS
show :: Field -> String
$cshow :: Field -> String
showsPrec :: Int -> Field -> ShowS
$cshowsPrec :: Int -> Field -> ShowS
Show)

  ------------------------------------------------------------------------
  -- | A term is just a string
  ------------------------------------------------------------------------
  type Term = String

  ------------------------------------------------------------------------
  -- convert a field to a string
  ------------------------------------------------------------------------
  field2str :: Field -> String
  field2str :: Field -> String
field2str (Ti  [String]
s) = String
"ti:"  String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
terms2str [String]
s
  field2str (Au  [String]
s) = String
"au:"  String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
terms2str [String]
s
  field2str (Abs [String]
s) = String
"abs:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
terms2str [String]
s
  field2str (Co  [String]
s) = String
"co:"  String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
terms2str [String]
s
  field2str (Jr  [String]
s) = String
"jr:"  String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
terms2str [String]
s
  field2str (Cat [String]
s) = String
"cat:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
terms2str [String]
s
  field2str (Rn  [String]
s) = String
"rn:"  String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
terms2str [String]
s
  field2str (Id  [String]
s) = String
"id:"  String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
terms2str [String]
s
  field2str (All [String]
s) = String
"all:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
terms2str [String]
s

  ------------------------------------------------------------------------
  -- convert a term to a string
  ------------------------------------------------------------------------
  terms2str :: [Term] -> String
  terms2str :: [String] -> String
terms2str = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"+" ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
term2str 
    where term2str :: ShowS
term2str String
t = 
            let x :: String
x = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"+" (String -> [String]
words String
t)
             in if Char
'+' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
x then String
"%22" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"%22" else String
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 (Expression -> Expression -> Bool
(Expression -> Expression -> Bool)
-> (Expression -> Expression -> Bool) -> Eq Expression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Expression -> Expression -> Bool
$c/= :: Expression -> Expression -> Bool
== :: Expression -> Expression -> Bool
$c== :: Expression -> Expression -> Bool
Eq, Int -> Expression -> ShowS
[Expression] -> ShowS
Expression -> String
(Int -> Expression -> ShowS)
-> (Expression -> String)
-> ([Expression] -> ShowS)
-> Show Expression
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Expression] -> ShowS
$cshowList :: [Expression] -> ShowS
show :: Expression -> String
$cshow :: Expression -> String
showsPrec :: Int -> Expression -> ShowS
$cshowsPrec :: Int -> Expression -> ShowS
Show)

  ------------------------------------------------------------------------
  -- | AND operator.
  --   The symbol was chosen because
  --   0 * 1 = 0.
  ------------------------------------------------------------------------
  infix /*/
  (/*/) :: Expression -> Expression -> Expression
  /*/ :: Expression -> Expression -> Expression
(/*/) = Expression -> Expression -> Expression
And

  ------------------------------------------------------------------------
  -- | OR operator.
  --   The symbol was chosen because
  --   0 + 1 = 1.
  ------------------------------------------------------------------------
  infix /+/
  (/+/) :: Expression -> Expression -> Expression
  /+/ :: Expression -> Expression -> Expression
(/+/) = Expression -> Expression -> Expression
Or 

  ------------------------------------------------------------------------
  -- | ANDNOT operator.
  --   The symbol was chosen because
  --   1 - 1 = 0 and 1 - 0 = 1.
  ------------------------------------------------------------------------
  infix /-/
  (/-/) :: Expression -> Expression -> Expression
  /-/ :: Expression -> Expression -> Expression
(/-/) = 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 :: Expression -> String
exp2str (Exp Field
f)        = Field -> String
field2str Field
f
  exp2str (And Expression
e1 Expression
e2)    = Expression -> String
innerExp2str Expression
e1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"+AND+"    String -> ShowS
forall a. [a] -> [a] -> [a]
++ Expression -> String
innerExp2str Expression
e2
  exp2str (Or  Expression
e1 Expression
e2)    = Expression -> String
innerExp2str Expression
e1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"+OR+"     String -> ShowS
forall a. [a] -> [a] -> [a]
++ Expression -> String
innerExp2str Expression
e2
  exp2str (AndNot Expression
e1 Expression
e2) = Expression -> String
innerExp2str Expression
e1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"+ANDNOT+" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Expression -> String
innerExp2str Expression
e2
  innerExp2str :: Expression -> String
innerExp2str (Exp Field
f)   = Expression -> String
exp2str (Field -> Expression
Exp Field
f)
  innerExp2str Expression
e         = String
"%28" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Expression -> String
exp2str Expression
e String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"%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
                 Query -> Maybe Expression
qExp   :: Maybe Expression,
                 -- | Id List
                 Query -> [String]
qIds :: [Identifier],
                 -- | The first item we want to see
                 Query -> Int
qStart :: Int,
                 -- | The number of items we want to see
                 Query -> Int
qItems :: Int}
    deriving (Query -> Query -> Bool
(Query -> Query -> Bool) -> (Query -> Query -> Bool) -> Eq Query
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Query -> Query -> Bool
$c/= :: Query -> Query -> Bool
== :: Query -> Query -> Bool
$c== :: Query -> Query -> Bool
Eq, Int -> Query -> ShowS
[Query] -> ShowS
Query -> String
(Int -> Query -> ShowS)
-> (Query -> String) -> ([Query] -> ShowS) -> Show Query
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Query] -> ShowS
$cshowList :: [Query] -> ShowS
show :: Query -> String
$cshow :: Query -> String
showsPrec :: Int -> Query -> ShowS
$cshowsPrec :: Int -> Query -> ShowS
Show)

  -------------------------------------------------------------------------
  -- | Prepares the query to fetch 
  --   the next page adding \"items per page\" to \"start index\".
  -------------------------------------------------------------------------
  nextPage :: Query -> Query
  nextPage :: Query -> Query
nextPage  Query
q = let s :: Int
s = Query -> Int
qStart Query
q
                    i :: Int
i = Query -> Int
qItems Query
q
                 in Query
q{qStart :: Int
qStart = Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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 :: [Tag String] -> Bool
exhausted [Tag String]
sp = [Tag String] -> Int
startIndex [Tag String]
sp Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [Tag String] -> Int
totalResults [Tag String]
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 :: String -> Either String Expression
parseQuery String
s = case Parsec String () Expression
-> String -> String -> Either ParseError Expression
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () Expression
expression String
"" (String -> Either ParseError Expression)
-> String -> Either ParseError Expression
forall a b. (a -> b) -> a -> b
$ ShowS
preprocess String
s of
                   Left  ParseError
e -> String -> Either String Expression
forall a b. a -> Either a b
Left (String -> Either String Expression)
-> String -> Either String Expression
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
e
                   Right Expression
e -> Expression -> Either String Expression
forall a b. b -> Either a b
Right Expression
e

  -------------------------------------------------------------------------
  -- | Converts a string containing comma-separated identifiers 
  --   into a list of 'Identifier's.
  --   As stated already: No whitespace! 
  -------------------------------------------------------------------------
  parseIds :: String -> [Identifier]
  parseIds :: String -> [String]
parseIds = String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
S.endBy String
"," 

  -------------------------------------------------------------------------
  -- | 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 :: ShowS
preprocess = ShowS -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ShowS
s2s ([String] -> String) -> (String -> [String]) -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String) -> String -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Char -> String
forall a. a -> [a]
tos
    where s2s :: ShowS
s2s String
"("  = String
"%28"
          s2s String
")"  = String
"%29"
          s2s String
"\"" = String
"%22"
          s2s String
" "  = String
"+"
          s2s String
c    = String
c
          tos :: a -> [a]
tos a
c    = [a
c]

  -------------------------------------------------------------------------
  -- | Generates the complete query string 
  --   including URL, 
  --             query expression,
  --             id list and 
  --             item control
  -------------------------------------------------------------------------
  mkQuery :: Query -> String
  mkQuery :: Query -> String
mkQuery Query
q   = String
apiUrl String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
qry String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
plus String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
apiIdList String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
is String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
itm
    where x :: String
x   = case Query -> Maybe Expression
qExp Query
q of
                  Maybe Expression
Nothing -> String
""
                  Just Expression
e  -> Expression -> String
exp2str Expression
e
          plus :: String
plus = case Query -> Maybe Expression
qExp Query
q of
                   Maybe Expression
Nothing -> String
""
                   Just Expression
_  -> String
"&"  
          qry :: String
qry = case Query -> Maybe Expression
qExp Query
q of
                  Maybe Expression
Nothing -> String
""
                  Just Expression
_  -> String
apiQuery
          is :: String
is  = [String] -> String
ids2str ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Query -> [String]
qIds Query
q
          itm :: String
itm = Query -> String
items2str Query
q

  -------------------------------------------------------------------------
  -- | Converts a list of 'Identifier' 
  --   to a string with comma-separated identifiers
  -------------------------------------------------------------------------
  ids2str :: [Identifier] -> String
  ids2str :: [String] -> String
ids2str = (String -> ShowS) -> String -> [String] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr String -> ShowS
i2s String
"" 
    where i2s :: String -> ShowS
i2s String
i [] = String
i 
          i2s String
i String
s  = String
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

  -------------------------------------------------------------------------
  -- | Converts the query to a string containing only the item control
  -------------------------------------------------------------------------
  items2str :: Query -> String
  items2str :: Query -> String
items2str Query
q = Int -> Int -> String
itemControl (Query -> Int
qStart Query
q) (Query -> Int
qItems Query
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 :: Int -> Int -> String
itemControl Int
s Int
m = String
"&amp;start="       String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
s String -> ShowS
forall a. [a] -> [a] -> [a]
++
                    String
"&amp;max_results=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
m

  -- ======================================================================
  -- result
  -- ======================================================================

  ------------------------------------------------------------------------
  -- | Total results of the query
  ------------------------------------------------------------------------
  totalResults :: [Tag String] -> Int
  totalResults :: [Tag String] -> Int
totalResults = String -> [Tag String] -> Int
getN String
"opensearch:totalResults" 

  ------------------------------------------------------------------------
  -- | Start index of this page of results
  ------------------------------------------------------------------------
  startIndex :: [Tag String] -> Int
  startIndex :: [Tag String] -> Int
startIndex = String -> [Tag String] -> Int
getN String
"opensearch:startIndex"

  ------------------------------------------------------------------------
  -- | Number of items per page
  ------------------------------------------------------------------------
  itemsPerPage :: [Tag String] -> Int
  itemsPerPage :: [Tag String] -> Int
itemsPerPage = String -> [Tag String] -> Int
getN String
"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 :: [Tag String] -> Either String ()
checkForError [Tag String]
ts = case [Tag String] -> Int
totalResults [Tag String]
ts of
                       Int
1 -> [Either String ()] -> Either String ()
forall a. [a] -> a
head ([Either String ()] -> Either String ())
-> [Either String ()] -> Either String ()
forall a b. (a -> b) -> a -> b
$ [Tag String]
-> ([Tag String] -> Either String ()) -> [Either String ()]
forall r. [Tag String] -> ([Tag String] -> r) -> [r]
forEachEntry [Tag String]
ts (([Tag String] -> Either String ()) -> [Either String ()])
-> ([Tag String] -> Either String ()) -> [Either String ()]
forall a b. (a -> b) -> a -> b
$ \[Tag String]
e ->
                              if [Tag String] -> String
getTitle [Tag String]
e String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"Error"
                                then String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ [Tag String] -> String
getError [Tag String]
e
                                else () -> Either String ()
forall a b. b -> Either a b
Right ()
                       Int
_ -> () -> Either String ()
forall a b. b -> Either a b
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.
  ------------------------------------------------------------------------
  getEntry :: [Tag String] -> ([Tag String],[Tag String])
  getEntry :: [Tag String] -> ([Tag String], [Tag String])
getEntry = String -> [Tag String] -> ([Tag String], [Tag String])
element String
"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 :: [Tag String] -> ([Tag String] -> r) -> [r]
forEachEntry = String -> [Tag String] -> ([Tag String] -> r) -> [r]
forall r. String -> [Tag String] -> ([Tag String] -> r) -> [r]
forEach String
"entry"

  ------------------------------------------------------------------------
  -- | Variant of 'forEachEntry' for monadic actions.
  ------------------------------------------------------------------------
  forEachEntryM :: Monad m =>
                   [Tag String] -> ([Tag String] -> m r) -> m [r]
  forEachEntryM :: [Tag String] -> ([Tag String] -> m r) -> m [r]
forEachEntryM = String -> [Tag String] -> ([Tag String] -> m r) -> m [r]
forall (m :: * -> *) r.
Monad m =>
String -> [Tag String] -> ([Tag String] -> m r) -> m [r]
forEachM String
"entry"
                   
  ------------------------------------------------------------------------
  -- | Variant of 'forEachEntryM' for actions 
  --   that do not return a result.
  ------------------------------------------------------------------------
  forEachEntryM_ :: Monad m =>
                    [Tag String] -> ([Tag String] -> m ()) -> m ()
  forEachEntryM_ :: [Tag String] -> ([Tag String] -> m ()) -> m ()
forEachEntryM_ = String -> [Tag String] -> ([Tag String] -> m ()) -> m ()
forall (m :: * -> *).
Monad m =>
String -> [Tag String] -> ([Tag String] -> m ()) -> m ()
forEachM_ String
"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 :: [Tag String] -> String
getIdUrl = String -> [Tag String] -> String
getString String
"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 :: [Tag String] -> String
getId = ShowS
pureId ShowS -> ([Tag String] -> String) -> [Tag String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Tag String] -> String
getString String
"id"

  ------------------------------------------------------------------------
  -- Extract the pure article identifier from the id string
  ------------------------------------------------------------------------
  pureId :: String -> String
  pureId :: ShowS
pureId String
s = let i :: String
i = Int -> ShowS
toSlash Int
2 (ShowS
forall a. [a] -> [a]
reverse String
s) 
                 z :: String
z = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
6 String
i
              in case String
z of
                   String
""    -> ShowS
forall a. [a] -> [a]
reverse String
i
                   Char
'.':String
_ -> ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
toSlash Int
1 String
i
                   String
_     -> ShowS
forall a. [a] -> [a]
reverse String
i
    where toSlash :: Int -> String -> String
          toSlash :: Int -> ShowS
toSlash Int
i String
m = let x :: String
x = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') String
m
                         in if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then String
x 
                            else String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Char
'/' Char -> ShowS
forall a. a -> [a] -> [a]
:
                                 Int -> ShowS
toSlash (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) (Int -> ShowS
forall a. Int -> [a] -> [a]
drop (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String
m))

  ------------------------------------------------------------------------
  -- Get the error message
  ------------------------------------------------------------------------
  getError :: [Tag String] -> String
  getError :: [Tag String] -> String
getError = ShowS
pureError ShowS -> ([Tag String] -> String) -> [Tag String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Tag String] -> String
getString String
"id"

  ------------------------------------------------------------------------
  -- Extract the pure error message from the id string
  ------------------------------------------------------------------------
  pureError :: String -> String
  pureError :: ShowS
pureError = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'#')

  ------------------------------------------------------------------------
  -- | Gets the contents of the \"updated\" field in this entry, i.e.
  --   the date when the article was last updated.
  --   Be aware that there is another \"updated\" field
  --   right below the root node of the result.
  --   Make sure your are operating on an entry,
  --   not on the root node!
  ------------------------------------------------------------------------
  getUpdated :: [Tag String] -> String
  getUpdated :: [Tag String] -> String
getUpdated = String -> [Tag String] -> String
getString String
"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 :: [Tag String] -> String
getPublished = String -> [Tag String] -> String
getString String
"published"

  ------------------------------------------------------------------------
  -- | Gets the year of the \"published\" field in this entry.
  ------------------------------------------------------------------------
  getYear :: [Tag String] -> String
  getYear :: [Tag String] -> String
getYear [Tag String]
sp = case [Tag String] -> String
getPublished [Tag String]
sp of
                 String
"" -> String
"s.a."
                 String
s  -> (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-') String
s

  ------------------------------------------------------------------------
  -- | Gets the title of this entry.
  ------------------------------------------------------------------------
  getTitle :: [Tag String] -> String
  getTitle :: [Tag String] -> String
getTitle = String -> [Tag String] -> String
getString String
"title"

  ------------------------------------------------------------------------
  -- | Gets the summary of this entry.
  ------------------------------------------------------------------------
  getSummary :: [Tag String] -> String
  getSummary :: [Tag String] -> String
getSummary = String -> [Tag String] -> String
getString String
"summary"

  ------------------------------------------------------------------------
  -- | Gets author''s comment (in \"arxiv:comment\") of this entry.
  ------------------------------------------------------------------------
  getComment :: [Tag String] -> String
  getComment :: [Tag String] -> String
getComment = String -> [Tag String] -> String
getString String
"arxiv:comment"

  ------------------------------------------------------------------------
  -- | Gets the journal information (in \"arxiv:journal_ref\")
  --   of this entry.
  ------------------------------------------------------------------------
  getJournal :: [Tag String] -> String
  getJournal :: [Tag String] -> String
getJournal = String -> [Tag String] -> String
getString String
"arxiv:journal_ref"

  ------------------------------------------------------------------------
  -- | Gets the digital object identifier (in \"arxiv:doi\") 
  --   of this entry.
  ------------------------------------------------------------------------
  getDoi :: [Tag String] -> String
  getDoi :: [Tag String] -> String
getDoi = String -> [Tag String] -> String
getString String
"arxiv:doi"

  ------------------------------------------------------------------------
  -- | The Link data type
  ------------------------------------------------------------------------
  data Link = Link {
                -- | The hyperlink
                Link -> String
lnkHref  :: String,
                -- | The link type (a MIME type)
                Link -> String
lnkType  :: String, 
                -- | The link title (e.g. \"pdf\" would be the link
                --                        where we find the article 
                --                        in pdf format)
                Link -> String
lnkTitle :: String,
                -- | the link relation (e.g. \"related\" would point
                --                           to the related information,
                --                           such as the pdf document)
                Link -> String
lnkRel   :: String}
    deriving (Int -> Link -> ShowS
[Link] -> ShowS
Link -> String
(Int -> Link -> ShowS)
-> (Link -> String) -> ([Link] -> ShowS) -> Show Link
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Link] -> ShowS
$cshowList :: [Link] -> ShowS
show :: Link -> String
$cshow :: Link -> String
showsPrec :: Int -> Link -> ShowS
$cshowsPrec :: Int -> Link -> ShowS
Show, Link -> Link -> Bool
(Link -> Link -> Bool) -> (Link -> Link -> Bool) -> Eq Link
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Link -> Link -> Bool
$c/= :: Link -> Link -> Bool
== :: Link -> Link -> Bool
$c== :: Link -> Link -> Bool
Eq)

  ------------------------------------------------------------------------
  -- | Gets all links in the entry.
  ------------------------------------------------------------------------
  getLinks :: [Tag String] -> [Link]
  getLinks :: [Tag String] -> [Link]
getLinks [Tag String]
soup = case String -> [Tag String] -> ([Tag String], [Tag String])
element String
"link" [Tag String]
soup of
                    ([],[Tag String]
_)     -> []
                    (Tag String
x:[Tag String]
_,[]) -> [Tag String -> Link
mkLink Tag String
x]
                    (Tag String
x:[Tag String]
_,[Tag String]
rs) -> Tag String -> Link
mkLink Tag String
x Link -> [Link] -> [Link]
forall a. a -> [a] -> [a]
: [Tag String] -> [Link]
getLinks [Tag String]
rs
    where mkLink :: Tag String -> Link
mkLink Tag String
l = Link :: String -> String -> String -> String -> Link
Link {
                       lnkHref :: String
lnkHref  = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> Tag String -> Maybe String
getAt String
"href"  Tag String
l,
                       lnkTitle :: String
lnkTitle = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> Tag String -> Maybe String
getAt String
"title" Tag String
l,
                       lnkRel :: String
lnkRel   = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> Tag String -> Maybe String
getAt String
"rel"   Tag String
l,
                       lnkType :: String
lnkType  = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> Tag String -> Maybe String
getAt String
"type"  Tag String
l}

  ------------------------------------------------------------------------
  -- | Gets only the pdf link of this entry (if any).
  ------------------------------------------------------------------------
  getPdfLink :: [Tag String] -> Maybe Link
  getPdfLink :: [Tag String] -> Maybe Link
getPdfLink [Tag String]
soup = case [Tag String] -> [Link]
getLinks [Tag String]
soup of
                      [] -> Maybe Link
forall a. Maybe a
Nothing
                      [Link]
ls -> (Link -> Bool) -> [Link] -> Maybe Link
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\Link
l -> Link -> String
lnkTitle Link
l String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"pdf") [Link]
ls

  ------------------------------------------------------------------------
  -- | Gets the hyperlink to the pdf document of this entry (if any).
  ------------------------------------------------------------------------
  getPdf :: [Tag String] -> String
  getPdf :: [Tag String] -> String
getPdf [Tag String]
soup = case [Tag String] -> Maybe Link
getPdfLink [Tag String]
soup of
                  Maybe Link
Nothing -> String
""
                  Just Link
l  -> Link -> String
lnkHref Link
l

  ------------------------------------------------------------------------
  -- | Category data type
  ------------------------------------------------------------------------
  data Category = Category {
                    -- | The category term (e.g. \"math-ph\")
                    Category -> String
catTerm   :: String,
                    -- | The category scheme
                    Category -> String
catScheme :: String}
    deriving (Int -> Category -> ShowS
[Category] -> ShowS
Category -> String
(Int -> Category -> ShowS)
-> (Category -> String) -> ([Category] -> ShowS) -> Show Category
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Category] -> ShowS
$cshowList :: [Category] -> ShowS
show :: Category -> String
$cshow :: Category -> String
showsPrec :: Int -> Category -> ShowS
$cshowsPrec :: Int -> Category -> ShowS
Show, Category -> Category -> Bool
(Category -> Category -> Bool)
-> (Category -> Category -> Bool) -> Eq Category
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Category -> Category -> Bool
$c/= :: Category -> Category -> Bool
== :: Category -> Category -> Bool
$c== :: Category -> Category -> Bool
Eq)

  ------------------------------------------------------------------------
  -- Make category from TagSoup
  ------------------------------------------------------------------------
  mkCat :: Tag String -> Category
  mkCat :: Tag String -> Category
mkCat Tag String
c = Category :: String -> String -> Category
Category {
              catTerm :: String
catTerm   = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> Tag String -> Maybe String
getAt String
"term"   Tag String
c,
              catScheme :: String
catScheme = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> Tag String -> Maybe String
getAt String
"scheme" Tag String
c}

  ------------------------------------------------------------------------
  -- | Gets the categories of this entry.
  ------------------------------------------------------------------------
  getCategories :: [Tag String] -> [Category]
  getCategories :: [Tag String] -> [Category]
getCategories [Tag String]
soup = case String -> [Tag String] -> ([Tag String], [Tag String])
element String
"category" [Tag String]
soup of
                         ([],[Tag String]
_)   -> []
                         (Tag String
x:[Tag String]
_,[]) -> [Tag String -> Category
mkCat Tag String
x]
                         (Tag String
x:[Tag String]
_,[Tag String]
rs) -> Tag String -> Category
mkCat Tag String
x Category -> [Category] -> [Category]
forall a. a -> [a] -> [a]
: [Tag String] -> [Category]
getCategories [Tag String]
rs

  ------------------------------------------------------------------------
  -- | Gets the primary category of this entry (if any).
  ------------------------------------------------------------------------
  getPrimaryCategory :: [Tag String] -> Maybe Category
  getPrimaryCategory :: [Tag String] -> Maybe Category
getPrimaryCategory [Tag String]
soup = case String -> [Tag String] -> ([Tag String], [Tag String])
element String
"arxiv:primary_category" [Tag String]
soup of
                              ([],[Tag String]
_)  -> Maybe Category
forall a. Maybe a
Nothing
                              (Tag String
x:[Tag String]
_,[Tag String]
_) -> Category -> Maybe Category
forall a. a -> Maybe a
Just (Tag String -> Category
mkCat Tag String
x)

  ------------------------------------------------------------------------
  -- | The Author data type
  ------------------------------------------------------------------------
  data Author = Author {
                  -- | Author name
                  Author -> String
auName :: String,
                  -- | Author Affiliation
                  Author -> String
auFil  :: String}
    deriving (Int -> Author -> ShowS
[Author] -> ShowS
Author -> String
(Int -> Author -> ShowS)
-> (Author -> String) -> ([Author] -> ShowS) -> Show Author
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Author] -> ShowS
$cshowList :: [Author] -> ShowS
show :: Author -> String
$cshow :: Author -> String
showsPrec :: Int -> Author -> ShowS
$cshowsPrec :: Int -> Author -> ShowS
Show, Author -> Author -> Bool
(Author -> Author -> Bool)
-> (Author -> Author -> Bool) -> Eq Author
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Author -> Author -> Bool
$c/= :: Author -> Author -> Bool
== :: Author -> Author -> Bool
$c== :: Author -> Author -> Bool
Eq)

  ------------------------------------------------------------------------
  -- | Gets the authors of this entry.
  ------------------------------------------------------------------------
  getAuthors :: [Tag String] -> [Author]
  getAuthors :: [Tag String] -> [Author]
getAuthors [Tag String]
soup = case String -> [Tag String] -> ([Tag String], [Tag String])
element String
"author" [Tag String]
soup of
                      ([],[Tag String]
_)     -> []
                      ([Tag String]
xs,[Tag String]
rs) -> [Tag String] -> Author
mkAut [Tag String]
xs Author -> [Author] -> [Author]
forall a. a -> [a] -> [a]
: [Tag String] -> [Author]
getAuthors [Tag String]
rs
    where mkAut :: [Tag String] -> Author
mkAut [Tag String]
au = let nm :: String
nm = case String -> [Tag String] -> ([Tag String], [Tag String])
element String
"name" [Tag String]
au of
                                ([],[Tag String]
_) -> String
""
                                ([Tag String]
n,[Tag String]
_)  -> [Tag String] -> String
findTxt [Tag String]
n
                         fl :: String
fl = case String -> [Tag String] -> ([Tag String], [Tag String])
element String
"arxiv:affiliation" [Tag String]
au of
                                ([],[Tag String]
_) -> String
""
                                ([Tag String]
a,[Tag String]
_)  -> [Tag String] -> String
findTxt [Tag String]
a
                      in Author :: String -> String -> Author
Author {
                           auName :: String
auName = String
nm,
                           auFil :: String
auFil  = String
fl}

  ------------------------------------------------------------------------
  -- | Gets the names of all authors of this entry.
  ------------------------------------------------------------------------
  getAuthorNames :: [Tag String] -> [String]
  getAuthorNames :: [Tag String] -> [String]
getAuthorNames = [Tag String] -> [String]
go 
    where go :: [Tag String] -> [String]
go [Tag String]
s = case String -> [Tag String] -> ([Tag String], [Tag String])
element String
"author" [Tag String]
s of
                   ([],[]) -> []
                   ([Tag String]
a,[])  -> [String -> [Tag String] -> String
getString String
"name" [Tag String]
a]
                   ([Tag String]
a,[Tag String]
r)   ->  String -> [Tag String] -> String
getString String
"name" [Tag String]
a String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [Tag String] -> [String]
go [Tag String]
r

  ------------------------------------------------------------------------
  -- Lookup attribute by name
  ------------------------------------------------------------------------
  getAt :: String -> Tag String -> Maybe String
  getAt :: String -> Tag String -> Maybe String
getAt String
a (TagOpen String
_ [Attribute String]
as) = String -> [Attribute String] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
a [Attribute String]
as 
  getAt String
_ Tag String
_              = Maybe String
forall a. Maybe a
Nothing

  ------------------------------------------------------------------------
  -- Find a 'TagText' and return the content
  ------------------------------------------------------------------------
  getString :: String -> [Tag String] -> String
  getString :: String -> [Tag String] -> String
getString String
n [Tag String]
soup = let ([Tag String]
i,[Tag String]
_) = String -> [Tag String] -> ([Tag String], [Tag String])
element String
n [Tag String]
soup 
                      in if [Tag String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tag String]
i then String
"" else [Tag String] -> String
findTxt [Tag String]
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 :: String -> [Tag String] -> Int
getN String
key [Tag String]
soup = case String -> [Tag String] -> ([Tag String], [Tag String])
element String
key [Tag String]
soup of
                    ([Tag String]
k,[Tag String]
_) -> case [Tag String] -> String
findTxt [Tag String]
k of
                               String
"" -> -Int
1
                               String
t  -> if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
t then String -> Int
forall a. Read a => String -> a
read String
t else -Int
1

  ------------------------------------------------------------------------
  -- Get the content of a 'TagText'
  ------------------------------------------------------------------------
  findTxt :: [Tag String] -> String
  findTxt :: [Tag String] -> String
findTxt [] = String
""
  findTxt (Tag String
t:[Tag String]
ts) = case Tag String
t of
                     TagText String
x -> String
x
                     Tag String
_         -> [Tag String] -> String
findTxt [Tag String]
ts

  ------------------------------------------------------------------------
  -- Map a function to all occurences of an element in the soup
  ------------------------------------------------------------------------
  forEach :: String -> [Tag String] -> ([Tag String] -> r) -> [r]
  forEach :: String -> [Tag String] -> ([Tag String] -> r) -> [r]
forEach String
nm [Tag String]
soup [Tag String] -> r
f = case String -> [Tag String] -> ([Tag String], [Tag String])
element String
nm [Tag String]
soup of
                        ([],[Tag String]
_) -> []
                        ([Tag String]
e,[Tag String]
rs) -> [Tag String] -> r
f [Tag String]
e r -> [r] -> [r]
forall a. a -> [a] -> [a]
: String -> [Tag String] -> ([Tag String] -> r) -> [r]
forall r. String -> [Tag String] -> ([Tag String] -> r) -> [r]
forEach String
nm [Tag String]
rs [Tag String] -> r
f

  ------------------------------------------------------------------------
  -- Variant of forEach for monadic actions
  ------------------------------------------------------------------------
  forEachM :: Monad m => 
              String  -> [Tag String] -> ([Tag String] -> m r) -> m [r]
  forEachM :: String -> [Tag String] -> ([Tag String] -> m r) -> m [r]
forEachM String
nm [Tag String]
soup [Tag String] -> m r
f = case String -> [Tag String] -> ([Tag String], [Tag String])
element String
nm [Tag String]
soup of
                         ([],[Tag String]
_) -> [r] -> m [r]
forall (m :: * -> *) a. Monad m => a -> m a
return []
                         ([Tag String]
e,[Tag String]
rs) -> do r
r  <- [Tag String] -> m r
f [Tag String]
e 
                                      [r]
rr <- String -> [Tag String] -> ([Tag String] -> m r) -> m [r]
forall (m :: * -> *) r.
Monad m =>
String -> [Tag String] -> ([Tag String] -> m r) -> m [r]
forEachM String
nm [Tag String]
rs [Tag String] -> m r
f
                                      [r] -> m [r]
forall (m :: * -> *) a. Monad m => a -> m a
return (r
rr -> [r] -> [r]
forall a. a -> [a] -> [a]
:[r]
rr)

  ------------------------------------------------------------------------
  -- Variant of forEachM for actions that do not return anything
  ------------------------------------------------------------------------
  forEachM_ :: Monad m => 
               String  -> [Tag String] -> ([Tag String] -> m ()) -> m ()
  forEachM_ :: String -> [Tag String] -> ([Tag String] -> m ()) -> m ()
forEachM_ String
nm [Tag String]
soup [Tag String] -> m ()
f = case String -> [Tag String] -> ([Tag String], [Tag String])
element String
nm [Tag String]
soup of
                          ([],[Tag String]
_) -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                          ([Tag String]
e,[Tag String]
rs) -> [Tag String] -> m ()
f [Tag String]
e m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> [Tag String] -> ([Tag String] -> m ()) -> m ()
forall (m :: * -> *).
Monad m =>
String -> [Tag String] -> ([Tag String] -> m ()) -> m ()
forEachM_ String
nm [Tag String]
rs [Tag String] -> m ()
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 :: String -> [Tag String] -> ([Tag String], [Tag String])
element String
_  []     = ([],[])
  element String
nm (Tag String
t:[Tag String]
ts) | String -> Tag String -> Bool
forall str. Eq str => str -> Tag str -> Bool
isTagOpenName String
nm Tag String
t = let ([Tag String]
r,[Tag String]
rs) = Int -> [Tag String] -> ([Tag String], [Tag String])
closeEl Int
0 [Tag String]
ts
                                            in (Tag String
tTag String -> [Tag String] -> [Tag String]
forall a. a -> [a] -> [a]
:[Tag String]
r,[Tag String]
rs)
                    | Bool
otherwise          = String -> [Tag String] -> ([Tag String], [Tag String])
element String
nm [Tag String]
ts
    where closeEl :: Int -> [Tag String] -> ([Tag String], [Tag String])
          closeEl :: Int -> [Tag String] -> ([Tag String], [Tag String])
closeEl Int
_ [] = ([],[])
          closeEl Int
i (Tag String
x:[Tag String]
xs) = Int
-> Bool
-> Tag String
-> [Tag String]
-> ([Tag String], [Tag String])
go Int
i (String -> Tag String -> Bool
forall str. Eq str => str -> Tag str -> Bool
isTagCloseName String
nm Tag String
x) Tag String
x [Tag String]
xs
          go :: Int
-> Bool
-> Tag String
-> [Tag String]
-> ([Tag String], [Tag String])
go Int
i Bool
b Tag String
x [Tag String]
xs | Bool
b Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0        = ([Tag String
x],[Tag String]
xs) 
                      | Bool
b Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>  Int
0        = let ([Tag String]
r,[Tag String]
rs) = Int -> [Tag String] -> ([Tag String], [Tag String])
closeEl (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [Tag String]
xs 
                                              in (Tag String
xTag String -> [Tag String] -> [Tag String]
forall a. a -> [a] -> [a]
:[Tag String]
r,[Tag String]
rs)
                      | String -> Tag String -> Bool
forall str. Eq str => str -> Tag str -> Bool
isTagOpenName String
nm Tag String
x = let ([Tag String]
r,[Tag String]
rs) = Int -> [Tag String] -> ([Tag String], [Tag String])
closeEl (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [Tag String]
xs 
                                              in (Tag String
xTag String -> [Tag String] -> [Tag String]
forall a. a -> [a] -> [a]
:[Tag String]
r,[Tag String]
rs)
                      | Bool
otherwise          = let ([Tag String]
r,[Tag String]
rs) = Int -> [Tag String] -> ([Tag String], [Tag String])
closeEl Int
i     [Tag String]
xs 
                                              in (Tag String
xTag String -> [Tag String] -> [Tag String]
forall a. a -> [a] -> [a]
:[Tag String]
r,[Tag String]
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 :: Parsec String () Expression
expression = Parsec String () Expression -> Parsec String () Expression
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec String () Expression
parentheses Parsec String () Expression
-> Parsec String () Expression -> Parsec String () Expression
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parsec String () Expression
fieldOperator

  ------------------------------------------------------------------------
  -- A field potentially followed by an operator
  ------------------------------------------------------------------------
  fieldOperator :: Parser Expression
  fieldOperator :: Parsec String () Expression
fieldOperator = do
    Expression
f <- Parsec String () Expression
field
    Char
c <- ParsecT String () Identity Char -> ParsecT String () Identity Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+') ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT String () Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
' '
    if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' then Expression -> Parsec String () Expression
forall (m :: * -> *) a. Monad m => a -> m a
return   Expression
f
                else Expression -> Parsec String () Expression
opAndArg Expression
f
 
  ------------------------------------------------------------------------
  -- Find an operator and an expression
  ------------------------------------------------------------------------
  opAndArg :: Expression -> Parser Expression
  opAndArg :: Expression -> Parsec String () Expression
opAndArg Expression
f = do
    Expression -> Expression -> Expression
o <- Parser (Expression -> Expression -> Expression)
op
    ParsecT String () Identity Char -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity Char -> ParsecT String () Identity ())
-> ParsecT String () Identity Char -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+'
    Expression
e <- Parsec String () Expression
expression
    Expression -> Parsec String () Expression
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression -> Expression -> Expression
o Expression
f Expression
e)

  ------------------------------------------------------------------------
  -- A field consists of a fieldId and a list of terms
  ------------------------------------------------------------------------
  field :: Parser Expression
  field :: Parsec String () Expression
field = do 
    [String] -> Field
i  <- Parser ([String] -> Field)
fieldId 
    [String]
ts <- Parser [String]
terms
    Expression -> Parsec String () Expression
forall (m :: * -> *) a. Monad m => a -> m a
return (Field -> Expression
Exp (Field -> Expression) -> Field -> Expression
forall a b. (a -> b) -> a -> b
$ [String] -> Field
i [String]
ts)
     
  ------------------------------------------------------------------------
  -- The field ids
  ------------------------------------------------------------------------
  fieldId :: Parser ([Term] -> Field)
  fieldId :: Parser ([String] -> Field)
fieldId =   Parser ([String] -> Field) -> Parser ([String] -> Field)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"au:" ) ParsecT String () Identity ()
-> Parser ([String] -> Field) -> Parser ([String] -> Field)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([String] -> Field) -> Parser ([String] -> Field)
forall (m :: * -> *) a. Monad m => a -> m a
return [String] -> Field
Au)
          Parser ([String] -> Field)
-> Parser ([String] -> Field) -> Parser ([String] -> Field)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser ([String] -> Field) -> Parser ([String] -> Field)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"ti:" ) ParsecT String () Identity ()
-> Parser ([String] -> Field) -> Parser ([String] -> Field)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([String] -> Field) -> Parser ([String] -> Field)
forall (m :: * -> *) a. Monad m => a -> m a
return [String] -> Field
Ti)
          Parser ([String] -> Field)
-> Parser ([String] -> Field) -> Parser ([String] -> Field)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser ([String] -> Field) -> Parser ([String] -> Field)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"abs:") ParsecT String () Identity ()
-> Parser ([String] -> Field) -> Parser ([String] -> Field)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([String] -> Field) -> Parser ([String] -> Field)
forall (m :: * -> *) a. Monad m => a -> m a
return [String] -> Field
Abs)
          Parser ([String] -> Field)
-> Parser ([String] -> Field) -> Parser ([String] -> Field)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser ([String] -> Field) -> Parser ([String] -> Field)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"co:" ) ParsecT String () Identity ()
-> Parser ([String] -> Field) -> Parser ([String] -> Field)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([String] -> Field) -> Parser ([String] -> Field)
forall (m :: * -> *) a. Monad m => a -> m a
return [String] -> Field
Co)
          Parser ([String] -> Field)
-> Parser ([String] -> Field) -> Parser ([String] -> Field)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser ([String] -> Field) -> Parser ([String] -> Field)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"cat:") ParsecT String () Identity ()
-> Parser ([String] -> Field) -> Parser ([String] -> Field)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([String] -> Field) -> Parser ([String] -> Field)
forall (m :: * -> *) a. Monad m => a -> m a
return [String] -> Field
Cat)
          Parser ([String] -> Field)
-> Parser ([String] -> Field) -> Parser ([String] -> Field)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser ([String] -> Field) -> Parser ([String] -> Field)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"jr:" ) ParsecT String () Identity ()
-> Parser ([String] -> Field) -> Parser ([String] -> Field)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([String] -> Field) -> Parser ([String] -> Field)
forall (m :: * -> *) a. Monad m => a -> m a
return [String] -> Field
Jr)
          Parser ([String] -> Field)
-> Parser ([String] -> Field) -> Parser ([String] -> Field)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser ([String] -> Field) -> Parser ([String] -> Field)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"rn:" ) ParsecT String () Identity ()
-> Parser ([String] -> Field) -> Parser ([String] -> Field)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([String] -> Field) -> Parser ([String] -> Field)
forall (m :: * -> *) a. Monad m => a -> m a
return [String] -> Field
Rn)
          Parser ([String] -> Field)
-> Parser ([String] -> Field) -> Parser ([String] -> Field)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser ([String] -> Field) -> Parser ([String] -> Field)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"id:" ) ParsecT String () Identity ()
-> Parser ([String] -> Field) -> Parser ([String] -> Field)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([String] -> Field) -> Parser ([String] -> Field)
forall (m :: * -> *) a. Monad m => a -> m a
return [String] -> Field
Id)
          Parser ([String] -> Field)
-> Parser ([String] -> Field) -> Parser ([String] -> Field)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>     (ParsecT String () Identity String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"all:") ParsecT String () Identity ()
-> Parser ([String] -> Field) -> Parser ([String] -> Field)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ([String] -> Field) -> Parser ([String] -> Field)
forall (m :: * -> *) a. Monad m => a -> m a
return [String] -> Field
All)

  ------------------------------------------------------------------------
  -- A term may be quoted,
  -- otherwise we build terms as list of strings
  -- separated by '+'
  ------------------------------------------------------------------------
  terms :: Parser [String]
  terms :: Parser [String]
terms = do
    String
t <- ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT String () Identity String
quoted ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity String
term
    Char
c <- ParsecT String () Identity Char -> ParsecT String () Identity Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity Char -> ParsecT String () Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar) ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT String () Identity Char
onEof Char
'%' --ugly
    case Char
c of
      Char
'%' -> [String] -> Parser [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String
t]
      Char
'+' -> do Bool
x <- Parser Bool
isOp
                if Bool
x then [String] -> Parser [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String
t] 
                     else ParsecT String () Identity Char -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c) ParsecT String () Identity () -> Parser [String] -> Parser [String]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (String
tString -> [String] -> [String]
forall a. a -> [a] -> [a]
:) ([String] -> [String]) -> Parser [String] -> Parser [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [String]
terms
      Char
_   -> String -> Parser [String]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser [String]) -> String -> Parser [String]
forall a b. (a -> b) -> a -> b
$ String
"unexpected symbol: '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
c] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'"

  ------------------------------------------------------------------------
  -- Checks if an operator follows without consuming input
  ------------------------------------------------------------------------
  isOp :: Parser Bool
  isOp :: Parser Bool
isOp =     Parser Bool -> Parser Bool
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity String
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"+ANDNOT+")) ParsecT String () Identity () -> Parser Bool -> Parser Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
         Parser Bool -> Parser Bool -> Parser Bool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Bool -> Parser Bool
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity String
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"+AND+"))    ParsecT String () Identity () -> Parser Bool -> Parser Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
         Parser Bool -> Parser Bool -> Parser Bool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser Bool -> Parser Bool
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity String
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"+OR+"))     ParsecT String () Identity () -> Parser Bool -> Parser Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Parser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
         Parser Bool -> Parser Bool -> Parser Bool
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Bool -> Parser Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

  ------------------------------------------------------------------------
  -- A quoted term
  ------------------------------------------------------------------------
  quoted :: Parser String
  quoted :: ParsecT String () Identity String
quoted = do
    ParsecT String () Identity String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity String
 -> ParsecT String () Identity ())
-> ParsecT String () Identity String
-> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"%22"
    String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"+" ([String] -> String)
-> Parser [String] -> ParsecT String () Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [String]
go
    where go :: Parser [String]
go = do
            String
t <- ParsecT String () Identity String
term
            String
s <- ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"%22") ParsecT String () Identity String
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String () Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
            if Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s) then [String] -> Parser [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String
t] 
                            else do Char
c <- ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar 
                                    let t' :: String
t' = if Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+' then String
t 
                                                         else String
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char
c]
                                    (String
t'String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) ([String] -> [String]) -> Parser [String] -> Parser [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser [String]
go
    
  ------------------------------------------------------------------------
  -- A single term 
  ------------------------------------------------------------------------
  term :: Parser String
  term :: ParsecT String () Identity String
term = do 
    Char
c <- ParsecT String () Identity Char -> ParsecT String () Identity Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity Char -> ParsecT String () Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar) ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT String () Identity Char
onEof Char
'%'
    if Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"%+"
      then String -> ParsecT String () Identity String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
      else do Char
x <- Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c
              (Char
xChar -> ShowS
forall a. a -> [a] -> [a]
:) ShowS
-> ParsecT String () Identity String
-> ParsecT String () Identity String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT String () Identity String
term
  
  ------------------------------------------------------------------------
  -- Signal EOF by returning the specified char
  ------------------------------------------------------------------------
  onEof :: Char -> Parser Char
  onEof :: Char -> ParsecT String () Identity Char
onEof Char
c = ParsecT String () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof ParsecT String () Identity ()
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT String () Identity Char
forall (m :: * -> *) a. Monad m => a -> m a
return Char
c

  ------------------------------------------------------------------------
  -- An expression in parentheses,
  -- which may be followed by another expression
  ------------------------------------------------------------------------
  parentheses :: Parser Expression
  parentheses :: Parsec String () Expression
parentheses = do
    ParsecT String () Identity String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity String
 -> ParsecT String () Identity ())
-> ParsecT String () Identity String
-> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"%28"
    Expression
e <- Parsec String () Expression
expression
    ParsecT String () Identity String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT String () Identity String
 -> ParsecT String () Identity ())
-> ParsecT String () Identity String
-> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"%29"
    Char
c <- ParsecT String () Identity Char -> ParsecT String () Identity Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+') ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT String () Identity Char -> ParsecT String () Identity Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity Char -> ParsecT String () Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (Char -> ParsecT String () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'%')) ParsecT String () Identity Char
-> ParsecT String () Identity Char
-> ParsecT String () Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Char -> ParsecT String () Identity Char
onEof Char
'.'
    case Char
c of
      Char
'+' -> Expression -> Parsec String () Expression
opAndArg Expression
e
      Char
_   -> Expression -> Parsec String () Expression
forall (m :: * -> *) a. Monad m => a -> m a
return   Expression
e

  ------------------------------------------------------------------------
  -- Parse operator (note that it is essential to 
  -- to process "ANDNOT" before "AND"!
  ------------------------------------------------------------------------
  op :: Parser (Expression -> Expression -> Expression)
  op :: Parser (Expression -> Expression -> Expression)
op =       Parser (Expression -> Expression -> Expression)
-> Parser (Expression -> Expression -> Expression)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"ANDNOT") ParsecT String () Identity ()
-> Parser (Expression -> Expression -> Expression)
-> Parser (Expression -> Expression -> Expression)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Expression -> Expression -> Expression)
-> Parser (Expression -> Expression -> Expression)
forall (m :: * -> *) a. Monad m => a -> m a
return Expression -> Expression -> Expression
AndNot) 
         Parser (Expression -> Expression -> Expression)
-> Parser (Expression -> Expression -> Expression)
-> Parser (Expression -> Expression -> Expression)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser (Expression -> Expression -> Expression)
-> Parser (Expression -> Expression -> Expression)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"OR")     ParsecT String () Identity ()
-> Parser (Expression -> Expression -> Expression)
-> Parser (Expression -> Expression -> Expression)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Expression -> Expression -> Expression)
-> Parser (Expression -> Expression -> Expression)
forall (m :: * -> *) a. Monad m => a -> m a
return Expression -> Expression -> Expression
Or) 
         Parser (Expression -> Expression -> Expression)
-> Parser (Expression -> Expression -> Expression)
-> Parser (Expression -> Expression -> Expression)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>     (ParsecT String () Identity String -> ParsecT String () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"AND")    ParsecT String () Identity ()
-> Parser (Expression -> Expression -> Expression)
-> Parser (Expression -> Expression -> Expression)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Expression -> Expression -> Expression)
-> Parser (Expression -> Expression -> Expression)
forall (m :: * -> *) a. Monad m => a -> m a
return Expression -> Expression -> Expression
And)