module Network.Api.Arxiv (
baseUrl, apiUrl, apiQuery,
Field(..), Expression(..),
(/*/), (/+/), (/-/),
Query(..), nextPage,
parseQuery, preprocess, parseIds,
mkQuery, exp2str, items2str, ids2str,
itemControl,
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
)
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)
baseUrl :: String
baseUrl :: String
baseUrl = String
"arxiv.org"
apiUrl :: String
apiUrl :: String
apiUrl = String
"https://export.arxiv.org/api/query?"
apiQuery,apiIdList :: String
apiQuery :: String
apiQuery = String
"search_query="
apiIdList :: String
apiIdList = String
"id_list="
data Field =
Ti [Term]
| Au [Term]
| Abs [Term]
| Co [Term]
| Jr [Term]
| Cat [Term]
| Rn [Term]
| Id [Term]
| 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)
type Term = 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
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
data Expression =
Exp Field
| And Expression Expression
| Or Expression Expression
| 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)
infix /*/
(/*/) :: Expression -> Expression -> Expression
/*/ :: Expression -> Expression -> Expression
(/*/) = Expression -> Expression -> Expression
And
infix /+/
(/+/) :: Expression -> Expression -> Expression
/+/ :: Expression -> Expression -> Expression
(/+/) = Expression -> Expression -> Expression
Or
infix /-/
(/-/) :: Expression -> Expression -> Expression
/-/ :: Expression -> Expression -> Expression
(/-/) = Expression -> Expression -> Expression
AndNot
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
data Query = Query {
Query -> Maybe Expression
qExp :: Maybe Expression,
Query -> [String]
qIds :: [Identifier],
Query -> Int
qStart :: Int,
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)
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}
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
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
parseIds :: String -> [Identifier]
parseIds :: String -> [String]
parseIds = String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
S.endBy String
","
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]
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
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
items2str :: Query -> String
items2str :: Query -> String
items2str Query
q = Int -> Int -> String
itemControl (Query -> Int
qStart Query
q) (Query -> Int
qItems Query
q)
itemControl :: Int -> Int -> String
itemControl :: Int -> Int -> String
itemControl Int
s Int
m = String
"&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
"&max_results=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
m
totalResults :: [Tag String] -> Int
totalResults :: [Tag String] -> Int
totalResults = String -> [Tag String] -> Int
getN String
"opensearch:totalResults"
startIndex :: [Tag String] -> Int
startIndex :: [Tag String] -> Int
startIndex = String -> [Tag String] -> Int
getN String
"opensearch:startIndex"
itemsPerPage :: [Tag String] -> Int
itemsPerPage :: [Tag String] -> Int
itemsPerPage = String -> [Tag String] -> Int
getN String
"opensearch:itemsPerPage"
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 ()
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"
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"
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"
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"
getIdUrl :: [Tag String] -> String
getIdUrl :: [Tag String] -> String
getIdUrl = String -> [Tag String] -> String
getString String
"id"
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"
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))
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"
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
'#')
getUpdated :: [Tag String] -> String
getUpdated :: [Tag String] -> String
getUpdated = String -> [Tag String] -> String
getString String
"updated"
getPublished :: [Tag String] -> String
getPublished :: [Tag String] -> String
getPublished = String -> [Tag String] -> String
getString String
"published"
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
getTitle :: [Tag String] -> String
getTitle :: [Tag String] -> String
getTitle = String -> [Tag String] -> String
getString String
"title"
getSummary :: [Tag String] -> String
getSummary :: [Tag String] -> String
getSummary = String -> [Tag String] -> String
getString String
"summary"
getComment :: [Tag String] -> String
= String -> [Tag String] -> String
getString String
"arxiv:comment"
getJournal :: [Tag String] -> String
getJournal :: [Tag String] -> String
getJournal = String -> [Tag String] -> String
getString String
"arxiv:journal_ref"
getDoi :: [Tag String] -> String
getDoi :: [Tag String] -> String
getDoi = String -> [Tag String] -> String
getString String
"arxiv:doi"
data Link = Link {
Link -> String
lnkHref :: String,
Link -> String
lnkType :: String,
Link -> String
lnkTitle :: String,
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)
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}
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
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
data Category = Category {
Category -> String
catTerm :: String,
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)
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}
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
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)
data Author = Author {
Author -> String
auName :: String,
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)
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}
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
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
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
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
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
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
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)
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
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)
type Parser a = Parsec String () a
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
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
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)
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)
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)
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
'%'
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
"'"
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
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
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
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
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
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)