[API] Generic instances fixed for Document (WIP)

src/Gargantext/API/Node.hs

@@ -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

@@ -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

@@ -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

@@ -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

@@ -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"
+                                              }
+                                )
 ------------------------------------------------------------------------