[search] fix deserialization of search rest API json

src/Gargantext/Components/FacetsTable.purs

@@ -5,6 +5,7 @@ module Gargantext.Components.FacetsTable where
 
 import Gargantext.Prelude
 
+import DOM.Simple.Console (log2)
 import Data.Either (Either(..))
 import Data.Eq.Generic (genericEq)
 import Data.Generic.Rep (class Generic)
@@ -18,17 +19,13 @@ import Data.Show.Generic (genericShow)
 import Data.Tuple.Nested ((/\))
 import Effect (Effect)
 import Effect.Aff (Aff, launchAff_)
-import Reactix as R
-import Reactix.DOM.HTML as H
-import Simple.JSON as JSON
-import Toestand as T
-
+import Effect.Class (liftEffect)
 import Gargantext.Components.Category (CategoryQuery(..), putCategories)
 import Gargantext.Components.Category.Types (Category(..), decodeCategory, favCategory)
 import Gargantext.Components.Search (Contact(..), Document(..), HyperdataRowContact(..), HyperdataRowDocument(..), SearchQuery, SearchResult(..), SearchResultTypes(..))
 import Gargantext.Components.Table as T
 import Gargantext.Components.Table.Types as T
-import Gargantext.Config.REST (RESTError)
+import Gargantext.Config.REST (RESTError(..))
 import Gargantext.Ends (url, Frontends)
 import Gargantext.Hooks.Loader (useLoader)
 import Gargantext.Routes (SessionRoute(Search, NodeAPI))
@@ -37,6 +34,10 @@ import Gargantext.Sessions (Session, sessionId, post, deleteWithBody)
 import Gargantext.Types (NodeType(..), OrderBy(..), NodeID)
 import Gargantext.Utils (toggleSet, zeroPad)
 import Gargantext.Utils.Reactix as R2
+import Reactix as R
+import Reactix.DOM.HTML as H
+import Simple.JSON as JSON
+import Toestand as T
 
 here :: R2.Here
 here = R2.here "Gargantext.Components.FacetsTable"
@@ -67,10 +68,8 @@ newtype Pair =
        }
 
 derive instance Generic Pair _
-instance Eq Pair where
-  eq = genericEq
-instance Show Pair where
-  show = genericShow
+instance Eq Pair where eq = genericEq
+instance Show Pair where show = genericShow
 
 ----------------------------------------------------------------------
 newtype DocumentsView =
@@ -90,10 +89,8 @@ newtype DocumentsView =
   }
 
 derive instance Generic DocumentsView _
-instance Eq DocumentsView where
-  eq = genericEq
-instance Show DocumentsView where
-  show = genericShow
+instance Eq DocumentsView where eq = genericEq
+instance Show DocumentsView where show = genericShow
 
 ----------------------------------------------------------------------
 newtype ContactsView =
@@ -105,17 +102,14 @@ newtype ContactsView =
   , delete     :: Boolean
   }
 derive instance Generic ContactsView _
-instance Eq ContactsView where
-  eq = genericEq
-instance Show ContactsView where
-  show = genericShow
+instance Eq ContactsView where eq = genericEq
+instance Show ContactsView where show = genericShow
 
 ----------------------------------------------------------------------
 data Rows = Docs     { docs     :: Seq DocumentsView }
           | Contacts { contacts :: Seq ContactsView  }
 derive instance Generic Rows _
-instance Eq Rows where
-  eq = genericEq
+instance Eq Rows where eq = genericEq
 
 ----------------------------------------------------------------------
 
@@ -212,7 +206,7 @@ initialPagePath :: {session :: Session, nodeId :: Int, listId :: Int, query :: S
 initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, query, params: T.initialParams}
 
 loadPage :: PagePath -> Aff (Either RESTError Rows)
-loadPage { session, nodeId, listId, query, params: {limit, offset, orderBy }} = do
+loadPage { session, nodeId, listId, query, params: {limit, offset, orderBy } } = do
   let
     convOrderBy (T.ASC  (T.ColumnName "Date")) = DateAsc
     convOrderBy (T.DESC (T.ColumnName "Date")) = DateDesc
@@ -228,7 +222,8 @@ loadPage { session, nodeId, listId, query, params: {limit, offset, orderBy }} =
   eSearchResult <- post session p query
   case eSearchResult of
     Left err -> pure $ Left err
-    Right (SearchResult {result}) ->
+    Right (SearchResult {result}) -> do
+      liftEffect $ log2 "[loadPage] result" result
       -- $ SearchQuery {query: concat query, expected: SearchDoc}
       pure $ Right $ case result of
               SearchResultDoc     {docs}     -> Docs     {docs: doc2view     <$> Seq.fromFoldable docs}
@@ -239,7 +234,6 @@ doc2view :: Document -> DocumentsView
 doc2view ( Document { id
                     , created: date
                     , hyperdata:  HyperdataRowDocument { authors
-                                                       , title
                                                        , source
                                                        , publication_year
                                                        , publication_month
@@ -247,10 +241,11 @@ doc2view ( Document { id
                                                        }
                     , category
                     , score
+                    , title
                     }
         ) = DocumentsView { id
                           , date
-                          , title: fromMaybe "Title" title
+                          , title: title
                           , source: fromMaybe "Source" source
                           , score
                           , authors: fromMaybe "Authors" authors
@@ -315,11 +310,14 @@ pageLayoutCpt = here.component "pageLayout" cpt
                 , loader: loadPage
                 , path: path'
                 , render: \rowsLoaded -> page { container, deletions, frontends, path, rowsLoaded, session, totalRecords } [] }
-    errorHandler err = here.log2 "[pageLayout] RESTError" err
+    errorHandler err = do
+      here.log2 "[pageLayout] RESTError" err
+      case err of
+        ReadJSONError err' -> here.log2 "[pageLayout] ReadJSONError" $ show err'
+        _ -> pure unit
 
 page :: R2.Component PageProps
 page = R.createElement pageCpt
-
 pageCpt :: R.Component PageProps
 pageCpt = here.component "page" cpt
   where
@@ -350,8 +348,8 @@ pageCpt = here.component "page" cpt
                      }
       where
         colNames = case rowsLoaded of
-            Docs     _ -> T.ColumnName <$> [ "", "Date", "Title", "Journal", "", "" ]
-            Contacts _ -> T.ColumnName <$> [ "", "Contact", "Organization", "", "", "" ]
+          Docs     _ -> T.ColumnName <$> [ "", "Date", "Title", "Journal", "", "" ]
+          Contacts _ -> T.ColumnName <$> [ "", "Contact", "Organization", "", "", "" ]
 
         wrapColElts = const identity
         -- TODO: how to interprete other scores?

src/Gargantext/Components/Search.purs

 module Gargantext.Components.Search where
 
-import Data.Generic.Rep (class Generic)
+import Gargantext.Prelude
+
+import Data.Either (Either(..))
 import Data.Eq.Generic (genericEq)
-import Data.Show.Generic (genericShow)
+import Data.Generic.Rep (class Generic)
 import Data.Maybe (Maybe)
 import Data.Newtype (class Newtype)
+import Data.Show.Generic (genericShow)
+import Gargantext.Utils.SimpleJSON as GUSJ
 import Simple.JSON as JSON
 import Simple.JSON.Generics as JSONG
 
-import Gargantext.Prelude
-
 -- Example:
 --   [["machine","learning"],["artificial","intelligence"]]
 -- This searches for documents with "machine learning" or "artificial intelligence"
@@ -43,13 +45,13 @@ derive newtype instance JSON.ReadForeign SearchResult
 derive newtype instance JSON.WriteForeign SearchResult
 
 ------------------------------------------------------------------------
-data SearchResultTypes = SearchResultDoc     { docs     :: Array Document}
-                       | SearchNoResult      { message  :: String        }
-                       | SearchResultContact { contacts :: Array Contact }
+data SearchResultTypes = SearchResultDoc     { docs     :: Array Document }
+                       | SearchNoResult      { message  :: String         }
+                       | SearchResultContact { contacts :: Array Contact  }
 derive instance Generic SearchResultTypes _
 instance Eq SearchResultTypes where eq = genericEq
 instance Show SearchResultTypes where show = genericShow
-instance JSON.ReadForeign SearchResultTypes where readImpl = JSONG.untaggedSumRep
+instance JSON.ReadForeign SearchResultTypes where readImpl = GUSJ.taggedSumRep
 instance JSON.WriteForeign SearchResultTypes where
   writeImpl (SearchResultDoc s)     = JSON.writeImpl s
   writeImpl (SearchNoResult s)      = JSON.writeImpl s
@@ -73,25 +75,25 @@ derive newtype instance JSON.WriteForeign Document
 
 ------------------------------------------------------------------------
 newtype HyperdataRowDocument =
-  HyperdataRowDocument { bdd                :: Maybe String
-                       , doi                :: Maybe String
-                       , url                :: Maybe String
-                       , uniqId             :: Maybe String
-                       , uniqIdBdd          :: Maybe String
-                       , page               :: Maybe Int
-                       , title              :: Maybe String
+  HyperdataRowDocument { abstract           :: Maybe String
                        , authors            :: Maybe String
+                       , bdd                :: Maybe String
+                       , doi                :: Maybe String
                        , institutes         :: Maybe String
-                       , source             :: Maybe String
-                       , abstract           :: Maybe String
+                       , language_iso2      :: Maybe String
+                       , page               :: Maybe Int
                        , publication_date   :: Maybe String
-                       , publication_year   :: Maybe Int
-                       , publication_month  :: Maybe Int
                        , publication_day    :: Maybe Int
                        , publication_hour   :: Maybe Int
                        , publication_minute :: Maybe Int
+                       , publication_month  :: Maybe Int
                        , publication_second :: Maybe Int
-                       , language_iso2      :: Maybe String
+                       , publication_year   :: Maybe Int
+                       , source             :: Maybe String
+                       , title              :: Maybe String
+                       , url                :: Maybe String
+                       , uniqId             :: Maybe String
+                       , uniqIdBdd          :: Maybe String
                        }
 
 derive instance Generic HyperdataRowDocument _

src/Gargantext/Utils/SimpleJSON.purs

+module Gargantext.Utils.SimpleJSON where
+
+import Prelude
+
+import Control.Alt ((<|>))
+import Control.Monad.Except (withExcept)
+import Data.Generic.Rep as GR
+import Data.Maybe (Maybe(..))
+import Data.Tuple (Tuple(..))
+import Foreign (Foreign, ForeignError(..), fail)
+import Foreign as Foreign
+import Foreign.Object as FO
+import Simple.JSON as JSON
+import Type.Prelude (class IsSymbol, SProxy(..), reflectSymbol)
+
+taggedSumRep :: forall a rep
+   . GR.Generic a rep
+  => GenericTaggedSumRep rep
+  => Foreign
+  -> Foreign.F a
+taggedSumRep f = GR.to <$> genericTaggedSumRep f
+
+-- | Generic Tagged Sum Representations, with "type" as key and rest
+-- of key/values representing the object.  Note that this is slightly
+-- difrerent than what Simple.JSON generics provides as it wrapes the
+-- tag in "type" and object under "value" key.
+class GenericTaggedSumRep rep where
+  genericTaggedSumRep :: Foreign -> Foreign.F rep
+
+instance ( GenericTaggedSumRep a
+         , GenericTaggedSumRep b
+         ) => GenericTaggedSumRep (GR.Sum a b) where
+  genericTaggedSumRep f
+      = GR.Inl <$> genericTaggedSumRep f
+    <|> GR.Inr <$> genericTaggedSumRep f
+
+instance ( GenericTaggedSumRep a
+         , IsSymbol name
+         ) => GenericTaggedSumRep (GR.Constructor name a) where
+  genericTaggedSumRep f = do
+    -- r :: { "type" :: String } <- JSON.read' f
+    -- if r."type" == name 
+    --   then withExcept (map $ ErrorAtProperty name) $ GR.Constructor <$> genericTaggedSumRep r
+    --   else fail $ ForeignError $ "Wrong type tag " <> r."type" <> " where " <> name <> " was expected."
+    r :: FO.Object Foreign <- JSON.read' f
+    case FO.pop "type" r of
+      Nothing -> fail $ ForeignError $ "Key 'type' not found."
+      Just (Tuple name' obj) -> do
+        n' <- Foreign.readString name'
+        if n' == name
+         then withExcept (map $ ErrorAtProperty name) $ GR.Constructor <$> (genericTaggedSumRep $ Foreign.unsafeToForeign obj)
+         else fail $ ForeignError $ "Wrong type tag " <> n' <> " where " <> name <> " was expected."
+    where
+      nameP = SProxy :: SProxy name
+      name = reflectSymbol nameP
+
+instance ( JSON.ReadForeign a
+         ) => GenericTaggedSumRep (GR.Argument a) where
+  genericTaggedSumRep f = GR.Argument <$> JSON.readImpl f
+
+
+
+
+