Use a type class to categorize hyperdata types

src/Gargantext/Database/Node.hs

@@ -40,7 +40,7 @@ import Prelude hiding (null, id, map, sum)
 
 import Gargantext.Core (Lang(..))
 import Gargantext.Core.Types
-import Gargantext.Database.Types.Node (NodeType, defaultCorpus)
+import Gargantext.Database.Types.Node (NodeType, defaultCorpus, Hyperdata)
 import Gargantext.Database.Queries
 import Gargantext.Database.Config (nodeTypeId)
 import Gargantext.Prelude hiding (sum)
@@ -318,7 +318,7 @@ defaultUser :: HyperdataUser
 defaultUser = HyperdataUser (Just $ (pack . show) EN)
 
 nodeUserW :: Maybe Name -> Maybe HyperdataUser -> UserId -> NodeWrite'
-nodeUserW maybeName maybeHyperdata = node NodeUser name (Hyperdata user) Nothing
+nodeUserW maybeName maybeHyperdata = node NodeUser name user Nothing
   where
     name = maybe "User" identity maybeName
     user = maybe defaultUser identity maybeHyperdata
@@ -327,14 +327,14 @@ defaultFolder :: HyperdataFolder
 defaultFolder = HyperdataFolder (Just "Markdown Description")
 
 nodeFolderW :: Maybe Name -> Maybe HyperdataFolder -> ParentId -> UserId -> NodeWrite'
-nodeFolderW maybeName maybeFolder pid = node NodeFolder name (Hyperdata folder) (Just pid)
+nodeFolderW maybeName maybeFolder pid = node NodeFolder name folder (Just pid)
   where
     name   = maybe "Folder" identity maybeName
     folder = maybe defaultFolder identity maybeFolder
 ------------------------------------------------------------------------
 
 nodeCorpusW :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> NodeWrite'
-nodeCorpusW maybeName maybeCorpus pId = node NodeCorpus name (Hyperdata corpus) (Just pId)
+nodeCorpusW maybeName maybeCorpus pId = node NodeCorpus name corpus (Just pId)
   where
     name   = maybe "Corpus" identity maybeName
     corpus = maybe defaultCorpus identity maybeCorpus
@@ -343,7 +343,7 @@ defaultDocument :: HyperdataDocument
 defaultDocument = hyperdataDocument
 
 nodeDocumentW :: Maybe Name -> Maybe HyperdataDocument -> CorpusId -> UserId -> NodeWrite'
-nodeDocumentW maybeName maybeDocument cId = node NodeDocument name (Hyperdata doc) (Just cId)
+nodeDocumentW maybeName maybeDocument cId = node NodeDocument name doc (Just cId)
   where
     name = maybe "Document" identity maybeName
     doc  = maybe defaultDocument identity maybeDocument
@@ -352,7 +352,7 @@ defaultAnnuaire :: HyperdataAnnuaire
 defaultAnnuaire = HyperdataAnnuaire (Just "Title") (Just "Description")
 
 nodeAnnuaireW :: Maybe Name -> Maybe HyperdataAnnuaire -> ParentId -> UserId -> NodeWrite'
-nodeAnnuaireW maybeName maybeAnnuaire pId = node NodeAnnuaire name (Hyperdata annuaire) (Just pId)
+nodeAnnuaireW maybeName maybeAnnuaire pId = node NodeAnnuaire name annuaire (Just pId)
   where
     name     = maybe "Annuaire" identity maybeName
     annuaire = maybe defaultAnnuaire identity maybeAnnuaire
@@ -361,17 +361,17 @@ defaultContact :: HyperdataContact
 defaultContact = HyperdataContact (Just "Name") (Just "email@here")
 
 nodeContactW :: Maybe Name -> Maybe HyperdataContact -> AnnuaireId -> UserId -> NodeWrite'
-nodeContactW maybeName maybeContact aId = node NodeContact name (Hyperdata contact) (Just aId)
+nodeContactW maybeName maybeContact aId = node NodeContact name contact (Just aId)
   where
     name    = maybe "Contact" identity maybeName
     contact = maybe defaultContact identity maybeContact
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
-node :: ToJSON a => NodeType -> Name -> Hyperdata a -> Maybe ParentId -> UserId -> NodeWrite'
+node :: (ToJSON a, Hyperdata a) => NodeType -> Name -> a -> Maybe ParentId -> UserId -> NodeWrite'
 node nodeType name hyperData parentId userId = Node Nothing typeId userId parentId name Nothing byteData
   where
     typeId = nodeTypeId nodeType
-    byteData = DB.pack $ DBL.unpack $ encode $ unHyperdata hyperData
+    byteData = DB.pack . DBL.unpack $ encode hyperData
 
                   -------------------------------
 node2row :: (Functor maybe1, Functor maybe2, Functor maybe3) =>
@@ -491,7 +491,7 @@ mk c nt pId name  = mk' c nt userId pId name
 mk' :: Connection -> NodeType -> UserId -> Maybe ParentId -> Text -> IO [Int]
 mk' c nt uId pId name  = map fromIntegral <$> insertNodesWithParentR pId [node nt name hd pId uId] c
   where
-    hd = Hyperdata (HyperdataUser (Just $ (pack . show) EN))
+    hd = HyperdataUser . Just . pack $ show EN
 
 type Name = Text
 

src/Gargantext/Database/Types/Node.hs

@@ -79,8 +79,11 @@ data StatusV3  = StatusV3 { statusV3_error  :: Maybe Text
                           , statusV3_action :: Maybe Text
                       } deriving (Show, Generic)
 $(deriveJSON (unPrefix "statusV3_") ''StatusV3)
-
 ------------------------------------------------------------------------
+
+-- Only Hyperdata types should be member of this type class.
+class Hyperdata a
+
 ------------------------------------------------------------------------
 data HyperdataDocumentV3 = HyperdataDocumentV3 { hyperdataDocumentV3_publication_day    :: !(Maybe Int)
                                                , hyperdataDocumentV3_language_iso2      :: !(Maybe Text)
@@ -101,6 +104,8 @@ data HyperdataDocumentV3 = HyperdataDocumentV3 { hyperdataDocumentV3_publication
                                                , hyperdataDocumentV3_title              :: !(Maybe Text)
                                                } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataDocumentV3_") ''HyperdataDocumentV3)
+
+instance Hyperdata HyperdataDocumentV3
 ------------------------------------------------------------------------
 
 data HyperdataDocument = HyperdataDocument { _hyperdataDocument_bdd                :: Maybe Text
@@ -125,6 +130,8 @@ data HyperdataDocument = HyperdataDocument { _hyperdataDocument_bdd
 $(deriveJSON (unPrefix "_hyperdataDocument_") ''HyperdataDocument)
 $(makeLenses ''HyperdataDocument)
 
+instance Hyperdata HyperdataDocument
+
 instance ToField HyperdataDocument where
   toField = toJSONField
 
@@ -203,18 +210,17 @@ instance ToSchema Resource where
 
 ------------------------------------------------------------------------
 
-data Hyperdata a = Hyperdata { unHyperdata :: a}
-$(deriveJSON (unPrefix "") ''Hyperdata)
-
 data HyperdataUser = HyperdataUser { hyperdataUser_language       :: Maybe Text
                                        } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataUser_") ''HyperdataUser)
 
+instance Hyperdata HyperdataUser
 
 data HyperdataFolder = HyperdataFolder { hyperdataFolder_desc    :: Maybe Text
                                        } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataFolder_") ''HyperdataFolder)
 
+instance Hyperdata HyperdataFolder
 
 data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_title        :: Maybe Text
                                        , hyperdataCorpus_desc         :: Maybe Text
@@ -224,6 +230,8 @@ data HyperdataCorpus = HyperdataCorpus { hyperdataCorpus_title        :: Maybe T
                                        } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataCorpus_") ''HyperdataCorpus)
 
+instance Hyperdata HyperdataCorpus
+
 corpusExample :: ByteString
 corpusExample = "" -- TODO
 
@@ -244,6 +252,8 @@ data HyperdataAnnuaire = HyperdataAnnuaire { hyperdataAnnuaire_title        :: M
                                            } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataAnnuaire_") ''HyperdataAnnuaire)
 
+instance Hyperdata HyperdataAnnuaire
+
 hyperdataAnnuaire :: HyperdataAnnuaire
 hyperdataAnnuaire = HyperdataAnnuaire (Just "Annuaire Title") (Just "Annuaire Description")
 
@@ -255,10 +265,14 @@ data HyperdataContact = HyperdataContact { hyperdataContact_name        :: Maybe
                                          , hyperdataContact_mail        :: Maybe Text
                                          } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataContact_") ''HyperdataContact)
+
+instance Hyperdata HyperdataContact
 ------------------------------------------------------------------------
 newtype HyperdataAny = HyperdataAny Object
   deriving (Show, Generic, ToJSON, FromJSON)
 
+instance Hyperdata HyperdataAny
+
 instance Arbitrary HyperdataAny where
     arbitrary = pure $ HyperdataAny mempty -- TODO produce arbitrary objects
 ------------------------------------------------------------------------
@@ -267,15 +281,20 @@ data HyperdataList = HyperdataList { hyperdataList_preferences   :: Maybe Text
                                    } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataList_") ''HyperdataList)
 
+instance Hyperdata HyperdataList
+
 data HyperdataScore = HyperdataScore { hyperdataScore_preferences   :: Maybe Text
                                    } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
 
+instance Hyperdata HyperdataScore
+
 
 data HyperdataResource = HyperdataResource { hyperdataResource_preferences   :: Maybe Text
                                    } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataResource_") ''HyperdataResource)
 
+instance Hyperdata HyperdataResource
 
 
 -- TODO add the Graph Structure here
@@ -283,17 +302,22 @@ data HyperdataGraph = HyperdataGraph { hyperdataGraph_preferences   :: Maybe Tex
                                    } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataGraph_") ''HyperdataGraph)
 
+instance Hyperdata HyperdataGraph
 
 -- TODO add the Graph Structure here
 data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences   :: Maybe Text
                                    } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
 
+instance Hyperdata HyperdataPhylo
+
 -- | TODO FEATURE: Notebook saved in the node (to work with Python or Haskell)
 data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences   :: Maybe Text
                                    } deriving (Show, Generic)
 $(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
 
+instance Hyperdata HyperdataNotebook
+
 
 
 -- | NodePoly indicates that Node has a Polymorphism Type