Skip to content

H
haskell-gargantext
Commit 9b94b47f authored by Alexandre Delanoë's avatar Alexandre Delanoë
Browse files
Options

[API] Generic instances fixed for Document (WIP)

parent 95508061
Hide whitespace changes
Inline Side-by-side
Showing with 199 additions and 48 deletions
src/Gargantext/API/Node.hs
View file @ 9b94b47f
......@@ -129,7 +129,7 @@ type NodeAPI a = Get '[JSON] (Node a)
:<|> "ngrams" :> TableNgramsApi
:<|> "category" :> CatApi
:<|> "search" :> (Search.API Int) -- Search.SearchResult)
:<|> "search" :> (Search.API Search.SearchResult)
:<|> "share" :> Share.API
-- Pairing utilities
......
src/Gargantext/API/Search.hs
View file @ 9b94b47f
......@@ -20,16 +20,17 @@ module Gargantext.API.Search
where
import Data.Aeson
import Data.Swagger
import Data.Maybe (fromMaybe)
import Data.Swagger hiding (fieldLabelModifier)
import Data.Text (Text)
-- import Data.Time (UTCTime)
import Data.Time (UTCTime)
import GHC.Generics (Generic)
import Gargantext.API.Prelude (GargServer)
import Gargantext.Core.Utils.Prefix (unPrefixSwagger)
import Gargantext.Core.Utils.Prefix (unPrefixSwagger, unCapitalize, dropPrefix)
import Gargantext.Database.Query.Facet
-- import Gargantext.Database.Action.Search
-- import Gargantext.Database.Action.Flow.Pairing (isPairedWith)
-- import Gargantext.Database.Admin.Types.Hyperdata (HyperdataContact)
import Gargantext.Database.Action.Search
import Gargantext.Database.Action.Flow.Pairing (isPairedWith)
import Gargantext.Database.Admin.Types.Hyperdata (HyperdataContact, HyperdataDocument(..))
import Gargantext.Database.Admin.Types.Node
import Gargantext.Prelude
import Servant
......@@ -47,23 +48,17 @@ type API results = Summary "Search endpoint"
:> QueryParam "order" OrderBy
:> Post '[JSON] results
-----------------------------------------------------------------------
api :: NodeId -> GargServer (API Int) -- SearchResult)
api _ _ _ _ _ = undefined
{-
api :: NodeId -> GargServer (API SearchResult)
api nId (SearchQuery q SearchDoc) o l order =
SearchResultDoc <$> searchInCorpus nId False q o l order
SearchResult <$> SearchResultDoc <$> map toRow <$> searchInCorpus nId False q o l order
api nId (SearchQuery q SearchContact) o l order = do
undefined
{- aIds <- isPairedWith NodeAnnuaire nId
aIds <- isPairedWith NodeAnnuaire nId
-- TODO if paired with several corpus
case head aIds of
Nothing -> pure $ SearchNoResult "[G.A.Search] pair corpus with an Annuaire"
Just aId -> SearchResultContact <$> searchInCorpusWithContacts nId aId q o l order
-}
-}
Nothing -> pure $ SearchResult $ SearchNoResult "[G.A.Search] pair corpus with an Annuaire"
Just aId -> SearchResult <$> SearchResultContact <$> searchInCorpusWithContacts nId aId q o l order
api _ _ _ _ _ = undefined
-----------------------------------------------------------------------
-----------------------------------------------------------------------
-- | Main Types
......@@ -110,32 +105,161 @@ instance Arbitrary SearchQuery where
-- arbitrary = elements [SearchQuery "electrodes" 1 ] --SearchDoc]
-----------------------------------------------------------------------
data SearchResult = SearchResultDoc { docs :: ![FacetDoc]}
-- | SearchResultContact { contacts :: ![FacetPaired Int UTCTime HyperdataContact Int] }
-- | SearchNoResult { message :: !Text }
deriving (Generic)
data SearchResult =
SearchResult { result :: !SearchResultTypes
}
| SearchResultErr !Text
deriving (Generic)
instance FromJSON SearchResult
{-
where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
-}
instance ToJSON SearchResult
{-
where
toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance ToSchema SearchResult
{-
where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
-}
instance Arbitrary SearchResult where
arbitrary = SearchResult <$> arbitrary
data SearchResultTypes = SearchResultDoc { docs :: ![Row]}
| SearchResultContact { contacts :: ![FacetPaired Int UTCTime HyperdataContact Int] }
| SearchNoResult { message :: !Text }
deriving (Generic)
instance FromJSON SearchResultTypes
where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance ToJSON SearchResultTypes
where
toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance Arbitrary SearchResultTypes where
arbitrary = do
srd <- SearchResultDoc <$> arbitrary
-- src <- SearchResultContact <$> arbitrary
-- srn <- pure $ SearchNoResult "No result because.."
elements [srd] -- , src, srn]
src <- SearchResultContact <$> arbitrary
srn <- pure $ SearchNoResult "No result because.."
elements [srd, src, srn]
instance ToSchema SearchResultTypes where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
--------------------------------------------------------------------
data Row =
Document { id :: !NodeId
, created :: !UTCTime
, title :: !Text
, hyperdata :: !HyperdataRow
, category :: !Int
, score :: !Int
}
| Contact { c_id :: !Int
, c_created :: !Text
, c_hyperdata :: !HyperdataContact
, c_score :: !Int
}
deriving (Generic)
instance FromJSON Row
where
parseJSON = genericParseJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance ToJSON Row
where
toJSON = genericToJSON (defaultOptions { sumEncoding = ObjectWithSingleField })
instance Arbitrary Row where
arbitrary = arbitrary
instance ToSchema Row where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "")
toRow :: FacetDoc -> Row
toRow (FacetDoc nId utc t h mc md) = Document nId utc t (toHyperdataRow h) (fromMaybe 0 mc) (round $ fromMaybe 0 md)
--------------------------------------------------------------------
data HyperdataRow =
HyperdataRowDocument { _hr_bdd :: !Text
, _hr_doi :: !Text
, _hr_url :: !Text
, _hr_uniqId :: !Text
, _hr_uniqIdBdd :: !Text
, _hr_page :: !Int
, _hr_title :: !Text
, _hr_authors :: !Text
, _hr_institutes :: !Text
, _hr_source :: !Text
, _hr_abstract :: !Text
, _hr_publication_date :: !Text
, _hr_publication_year :: !Int
, _hr_publication_month :: !Int
, _hr_publication_day :: !Int
, _hr_publication_hour :: !Int
, _hr_publication_minute :: !Int
, _hr_publication_second :: !Int
, _hr_language_iso2 :: !Text
}
| HyperdataRowContact { _hr_name :: !Text }
deriving (Generic)
instance FromJSON HyperdataRow
where
parseJSON = genericParseJSON
( defaultOptions
{ sumEncoding = ObjectWithSingleField
, fieldLabelModifier = unCapitalize . dropPrefix "_hr_"
, omitNothingFields = True
}
)
instance ToJSON HyperdataRow
where
toJSON = genericToJSON
( defaultOptions
{ sumEncoding = ObjectWithSingleField
, fieldLabelModifier = unCapitalize . dropPrefix "_hr_"
, omitNothingFields = True
}
)
instance Arbitrary HyperdataRow where
arbitrary = arbitrary
instance ToSchema SearchResult where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "sr_")
instance ToSchema HyperdataRow where
declareNamedSchema = genericDeclareNamedSchema (unPrefixSwagger "_hr_")
toHyperdataRow :: HyperdataDocument -> HyperdataRow
toHyperdataRow (HyperdataDocument b d u ui ub p t a i s abs pd py pm pda ph pmin psec l) =
HyperdataRowDocument
(fromMaybe "" b)
(fromMaybe "" d)
(fromMaybe "" u)
(fromMaybe "" ui)
(fromMaybe "" ub)
(fromMaybe 0 p)
(fromMaybe "Title" t)
(fromMaybe "" a)
(fromMaybe "" i)
(fromMaybe "" s)
(fromMaybe "" abs)
(fromMaybe "" pd)
(fromMaybe 2020 py)
(fromMaybe 1 pm)
(fromMaybe 1 pda)
(fromMaybe 1 ph)
(fromMaybe 1 pmin)
(fromMaybe 1 psec)
(fromMaybe "EN" l)
src/Gargantext/Core/Flow/Types.hs
View file @ 9b94b47f
......@@ -17,7 +17,7 @@ module Gargantext.Core.Flow.Types where
import Control.Lens (Lens')
import Data.Map (Map)
import Data.Maybe (Maybe)
-- import Control.Applicative
import Gargantext.Text (HasText(..))
import Gargantext.Core.Types.Main (HashId)
import Gargantext.Database.Admin.Types.Hyperdata
......
src/Gargantext/Database/Admin/Types/Hyperdata/Document.hs
View file @ 9b94b47f
......@@ -21,6 +21,7 @@ Portability : POSIX
module Gargantext.Database.Admin.Types.Hyperdata.Document where
import Gargantext.Prelude
import Gargantext.Core.Utils.Prefix (unCapitalize, dropPrefix)
import Gargantext.Database.Admin.Types.Hyperdata.Prelude
......@@ -44,7 +45,8 @@ data HyperdataDocument = HyperdataDocument { _hd_bdd :: !(Maybe T
, _hd_publication_minute :: !(Maybe Int)
, _hd_publication_second :: !(Maybe Int)
, _hd_language_iso2 :: !(Maybe Text)
} deriving (Show, Generic)
}
deriving (Show, Generic)
defaultHyperdataDocument :: HyperdataDocument
......@@ -67,6 +69,7 @@ data StatusV3 = StatusV3 { statusV3_error :: !(Maybe Text)
} deriving (Show, Generic)
$(deriveJSON (unPrefix "statusV3_") ''StatusV3)
------------------------------------------------------------------------
data HyperdataDocumentV3 = HyperdataDocumentV3 { _hdv3_publication_day :: !(Maybe Int)
, _hdv3_language_iso2 :: !(Maybe Text)
......@@ -132,9 +135,32 @@ instance Hyperdata HyperdataDocument
instance Hyperdata HyperdataDocumentV3
------------------------------------------------------------------------
$(makeLenses ''HyperdataDocument)
makePrisms ''HyperdataDocument
$(makeLenses ''HyperdataDocumentV3)
$(deriveJSON (unPrefix "_hd_") ''HyperdataDocument)
-- $(deriveJSON (unPrefix "_hd_") ''HyperdataDocument)
instance FromJSON HyperdataDocument
where
parseJSON = genericParseJSON
( defaultOptions { sumEncoding = ObjectWithSingleField
, fieldLabelModifier = unCapitalize . dropPrefix "_hd"
, omitNothingFields = True
}
)
instance ToJSON HyperdataDocument
where
toJSON = genericToJSON
( defaultOptions { sumEncoding = ObjectWithSingleField
, fieldLabelModifier = unCapitalize . dropPrefix "_hd"
, omitNothingFields = True
}
)
$(deriveJSON (unPrefix "_hdv3_") ''HyperdataDocumentV3)
instance ToSchema HyperdataDocument where
......
src/Gargantext/Database/Schema/Node.hs
View file @ 9b94b47f
......@@ -156,16 +156,17 @@ $(deriveJSON (unPrefix "_ns_") ''NodePolySearch)
$(makeLenses ''NodePolySearch)
nodeTableSearch :: Table NodeSearchWrite NodeSearchRead
nodeTableSearch = Table "nodes" (pNodeSearch NodeSearch { _ns_id = optional "id"
, _ns_typename = required "typename"
, _ns_userId = required "user_id"
, _ns_parentId = required "parent_id"
, _ns_name = required "name"
, _ns_date = optional "date"
, _ns_hyperdata = required "hyperdata"
, _ns_search = optional "search"
}
)
nodeTableSearch = Table "nodes" ( pNodeSearch
NodeSearch { _ns_id = optional "id"
, _ns_typename = required "typename"
, _ns_userId = required "user_id"
, _ns_parentId = required "parent_id"
, _ns_name = required "name"
, _ns_date = optional "date"
, _ns_hyperdata = required "hyperdata"
, _ns_search = optional "search"
}
)
------------------------------------------------------------------------
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