Commit 36d378b3 authored by Mudada's avatar Mudada

add abstract + need to delete space in output

parent 2b756240
......@@ -7,7 +7,9 @@ import ISTEX.Client
main :: IO ()
main = do
res <- runIstexAPIClient $ search (Just 40) (Just "ia") (Just "author,title")
res <- basicSearch (Just "ia")
case res of
(Left err) -> print err
(Right val) -> print val
(Left err) -> print "Error"
(Right val) -> do
print $ take 5 $ _hits val
-- print $ _abstract <$> (_hits val)
{-# LANGUAGE OverloadedStrings #-}
module ISTEX where
import ISTEX.Client
......@@ -5,7 +7,13 @@ import Network.HTTP.Client (newManager)
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Servant.Client
import qualified Data.Text as T
runIstexAPIClient :: ClientM (Documents) -> IO (Either ClientError Documents)
runIstexAPIClient cmd = do
manager' <- newManager tlsManagerSettings
runClientM cmd (mkClientEnv manager' $ BaseUrl Https "api.istex.fr" 443 "document")
basicSearch :: Maybe T.Text -> IO (Either ClientError Documents)
basicSearch rq = do
runIstexAPIClient $ search (Just "author,title,abstract") (Just 5000) rq
......@@ -31,13 +31,18 @@ data Document = Document
{
_id :: T.Text,
_title :: Maybe T.Text,
_authors :: [Author]
_authors :: [Author],
_abstract :: Maybe T.Text
} deriving (Show, Generic)
L.makeLenses ''Document
instance FromJSON Document where
parseJSON (Object o) =
Document <$> (o .: "id") <*> (o .:? "title") <*> (o .: "author" <|> pure [])
Document <$>
(o .: "id")
<*> (o .:? "title")
<*> (o .: "author" <|> pure [])
<*> (o .:? "abstract")
data Documents = Documents
{
......@@ -51,13 +56,14 @@ instance FromJSON Documents where
type ISTEXAPI = Search
type Search = QueryParam "size" Int
type Search =
QueryParam "output" T.Text
:> QueryParam "size" Int
:> QueryParam "q" T.Text
:> QueryParam "output" T.Text
:> Get '[JSON] Documents
istexProxy :: Proxy (ISTEXAPI)
istexProxy = Proxy
search :: Maybe Int -> Maybe T.Text -> Maybe T.Text -> ClientM Documents
search :: Maybe T.Text -> Maybe Int -> Maybe T.Text -> ClientM Documents
search = client istexProxy
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment