Commit bfb0e7d8 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FIX] Query Search is ok.

parent 884906b4
......@@ -2,16 +2,16 @@
--
-- see: https://github.com/sol/hpack
--
-- hash: f8c91a232670fcf66018c2dc22039b92e3caf411691f9c10100f31a4337dc13d
-- hash: 7f8443023714c385aa78461bf264946e215e8e840afeaf9e117216f86773fe67
name: crawlerIsidore
version: 0.1.0.0
description: Please see the README on GitHub at <https://github.com/githubuser/crawlerIsidore#readme>
homepage: https://github.com/githubuser/crawlerIsidore#readme
bug-reports: https://github.com/githubuser/crawlerIsidore/issues
author: Author name here
maintainer: example@example.com
copyright: 2019 Author name here
homepage: https://github.com/gitlab.iscpif.fr/gargantext/crawlers/crawlerIsidore#readme
bug-reports: https://github.com/gitlab.iscpif.fr/gargantext/crawlers/crawlerIsidore/issues
author: CNRS/IMT
maintainer: contact@gargantext.org
copyright: 2019 CNRS/IMT
license: BSD3
license-file: LICENSE
build-type: Simple
......@@ -22,7 +22,7 @@ extra-source-files:
source-repository head
type: git
location: https://github.com/githubuser/crawlerIsidore
location: https://github.com/gitlab.iscpif.fr/gargantext/crawlers/crawlerIsidore
library
exposed-modules:
......@@ -41,7 +41,9 @@ library
, http-media
, servant
, servant-client
, servant-server
, text
, vector
default-language: Haskell2010
executable crawlerIsidore-exe
......@@ -61,7 +63,9 @@ executable crawlerIsidore-exe
, http-media
, servant
, servant-client
, servant-server
, text
, vector
default-language: Haskell2010
test-suite crawlerIsidore-test
......@@ -82,5 +86,7 @@ test-suite crawlerIsidore-test
, http-media
, servant
, servant-client
, servant-server
, text
, vector
default-language: Haskell2010
......@@ -22,6 +22,7 @@ description: Please see the README on GitHub at <https://github.com/gith
dependencies:
- base >= 4.7 && < 5
- aeson
- vector
- servant
- servant-client
- text
......
......@@ -3,61 +3,119 @@
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
module ISIDORE.Client where
import Control.Monad
import Servant.API
import Servant.Client
import GHC.Generics (Generic)
import Data.Proxy(Proxy(..))
import Data.ByteString.Lazy (ByteString)
import Data.Aeson
import qualified Data.Vector as V
import Data.Text (Text)
import qualified Data.Text as T
data LocalContent = LocalContent
{
_lang :: T.Text,
_content :: T.Text
data LangText =
LangText { _lang :: Text
, _text :: Text
}
| OnlyText Text
| ArrayText [LangText]
deriving (Show)
instance FromJSON LocalContent where
parseJSON (Object o) = LocalContent <$> (o .: "@xml:lang") <*> (o .: "$")
instance FromJSON LangText where
parseJSON (Object o) = LangText <$> (o .: "@xml:lang") <*> (o .: "$")
parseJSON (String x) = OnlyText <$> (pure x)
parseJSON (Array xs) = ArrayText <$> mapM parseJSON (V.toList xs)
--parseJSON Null = OnlyText <$> pure "null"
data Author = Author
{
_firstName :: T.Text,
_lastName :: T.Text
data Creator =
Creator { _creator :: Author }
| Creators { _creators :: [Author] }
deriving (Show)
instance FromJSON Creator where
parseJSON (Object o) = Creator <$> (o .: "creator")
parseJSON (Array os) = Creators <$> mapM parseJSON (V.toList os)
data Author =
Author { _firstName :: Name
, _lastName :: Name
}
| Authors [Author]
deriving (Show)
data Name = Name { _name :: Text }
deriving (Show)
instance FromJSON Name where
parseJSON (String o) = Name <$> (pure o)
parseJSON (Array os) = Name <$> (pure "empty")
instance FromJSON Author where
parseJSON (Object o) = Author <$> (o .: "firstName") <*> (o .: "lastName")
parseJSON (Object o) = Author <$> (o .: "firstname") <*> (o .: "lastname")
parseJSON (Array os) = Authors <$> mapM parseJSON (V.toList os)
data SourceInfo =
SourceInfo { _shortLabel :: Text
, _handle :: Text
, _collectionUuid :: Text
, _sourceName :: Text }
deriving (Show)
data MayBeLocal = Local LocalContent | NonLocal T.Text
deriving (Show, Generic)
instance FromJSON SourceInfo where
parseJSON (Object o) =
SourceInfo <$> (o .: "@shortLabel")
<*> (o .: "@handle")
<*> (o .: "@collectionUuid")
<*> (o .: "$")
instance FromJSON MayBeLocal
data IsidoreDoc = IsidoreDoc
{
_title :: MayBeLocal,
_abstract :: MayBeLocal,
_authors :: [Author]
{ _title :: LangText
, _abstract :: Maybe LangText
, _date :: Maybe Text
, _url :: Maybe Text
, _source :: Maybe SourceInfo
, _authors :: Maybe Creator
}
deriving (Show)
data Reply = Reply { _docs :: [IsidoreDoc]}
deriving (Show)
instance FromJSON IsidoreDoc where
parseJSON (Object o) = IsidoreDoc <$>
(responseReplies >>= (.: "title") )
<*> (responseReplies >>= (.: "abstract"))
<*> (responseReplies >>= (.: "enrichedCreators") >>= (.: "creator"))
where responseReplies = (o .: "response")
parseJSON (Object o) = IsidoreDoc <$> (i >>= (.: "title" ))
<*> (i >>= (.:? "abstract" ))
<*> (i >>= (.: "date" ) >>= (.:? "normalizedDate" ))
<*> (i >>= (.:? "url" ))
<*> (i >>= (.: "source_info" ) >>= (.:? "collectionLabel"))
<*> (i >>= (.:? "enrichedCreators"))
where
i = (o .: "isidore")
instance FromJSON Reply where
parseJSON (Object o) = Reply <$> (responseReplies >>= parseJSON)
-- <*> (responseReplies >>= (.: "abstract") >>= (.: "$"))
-- <*> (responseReplies >>= (.: "date") >>= (.: "origin"))
-- <*> (responseReplies >>= (.: "enrichedCreators") >>= (.: "creator"))
where
responseReplies = (o .: "response")
>>= (.: "replies")
>>= (.: "content")
>>= (.: "reply")
>>= (.: "isidore")
-- docs = mapM (\r -> IsidoreDoc <$> (r .: "isidore") >>= (.: "title")) responseReplies
-- >>= (.: "$"))
-- >>= (.: "isidore")
data Output = JSON
......@@ -72,11 +130,12 @@ type Search = "search"
:> QueryParam "output" Output
:> QueryParam "q" T.Text
:> QueryParam "author" T.Text
:> Get '[JSON] T.Text
:> Get '[JSON] Reply
isidoreAPI :: Proxy ISIDOREAPI
isidoreAPI = Proxy
search :: Maybe Int -> Maybe T.Text -> Maybe T.Text -> ClientM T.Text
search :: Maybe Int -> Maybe T.Text -> Maybe T.Text -> ClientM Reply
search n q a = client isidoreAPI n (Just JSON) q a
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