[REFACT] HyperData

src/Gargantext/Database/Admin/Types/Hyperdata.hs

@@ -305,32 +305,23 @@ instance Hyperdata HyperdataResource
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
 -- TODO add the Graph Structure here
-data HyperdataPhylo = HyperdataPhylo { hyperdataPhylo_preferences   :: !(Maybe Text)
-                                     , hyperdataPhylo_data          :: !(Maybe Phylo)
-                                   } deriving (Show, Generic)
-$(deriveJSON (unPrefix "hyperdataPhylo_") ''HyperdataPhylo)
-
-instance Hyperdata HyperdataPhylo
 
 ------------------------------------------------------------------------
--- | TODO FEATURE: Notebook saved in the node
-data HyperdataNotebook = HyperdataNotebook { hyperdataNotebook_preferences   :: !(Maybe Text)
-                                   } deriving (Show, Generic)
-$(deriveJSON (unPrefix "hyperdataNotebook_") ''HyperdataNotebook)
-
-instance Hyperdata HyperdataNotebook
-
-
 -- | TODO CLEAN
+-- | TODO FEATURE: Notebook saved in the node
 data HyperData = HyperdataTexts { hd_preferences :: !(Maybe Text)}
                | HyperdataList' { hd_preferences :: !(Maybe Text)}
                | HyperdataDashboard { hd_preferences :: !(Maybe Text)
                                     , hd_charts      :: ![Chart]
                                     }
+               | HyperdataNotebook { hd_preferences :: !(Maybe Text)}
+               | HyperdataPhylo    { hd_preferences :: !(Maybe Text)
+                                   , hd_data        :: !(Maybe Phylo)
+                                   }
+
   deriving (Show, Generic)
 
 $(deriveJSON (unPrefix "hd_") ''HyperData)
-
 instance Hyperdata HyperData
 
 ------------------------------------------------------------------------
@@ -398,10 +389,6 @@ instance FromField HyperdataListModel
   where
     fromField = fromField'
 
-instance FromField HyperdataPhylo
-  where
-    fromField = fromField'
-
 instance FromField HyperdataAnnuaire
   where
     fromField = fromField'
@@ -440,10 +427,6 @@ instance QueryRunnerColumnDefault PGJsonb HyperdataListModel
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-instance QueryRunnerColumnDefault PGJsonb HyperdataPhylo
-  where
-    queryRunnerColumnDefault = fieldQueryRunnerColumn
-
 instance QueryRunnerColumnDefault PGJsonb HyperdataAnnuaire
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn

src/Gargantext/Database/Query/Table/Node.hs

@@ -240,6 +240,7 @@ instance HasDefault NodeType where
       NodeTexts -> "Texts"
       NodeList  -> "Lists"
       NodeListCooc -> "Cooc"
+      NodePhylo    -> "Phylo"
       _         -> panic "HasDefaultName undefined"
 
 ------------------------------------------------------------------------
@@ -278,16 +279,6 @@ mkGraph p u = insertNodesR [nodeGraphW Nothing Nothing p u]
 insertGraph :: ParentId -> UserId -> HyperdataGraph -> Cmd err [GraphId]
 insertGraph p u h = insertNodesR [nodeGraphW Nothing (Just h) p u]
 
-------------------------------------------------------------------------
-arbitraryPhylo :: HyperdataPhylo
-arbitraryPhylo = HyperdataPhylo Nothing Nothing
-
-nodePhyloW :: Maybe Name -> Maybe HyperdataPhylo -> ParentId -> UserId -> NodeWrite
-nodePhyloW maybeName maybePhylo pId = node NodePhylo name graph (Just pId)
-  where
-    name = maybe "Phylo" identity maybeName
-    graph = maybe arbitraryPhylo identity maybePhylo
-
 ------------------------------------------------------------------------
 arbitraryDashboard :: HyperData 
 arbitraryDashboard = HyperdataDashboard (Just "Preferences") []
@@ -454,10 +445,6 @@ mkDashboard p u = insertNodesR [nodeDashboardW Nothing Nothing p u]
         name = maybe "Board" identity maybeName
         dashboard = maybe arbitraryDashboard identity maybeDashboard
 
-
-mkPhylo :: ParentId -> UserId -> Cmd err [NodeId]
-mkPhylo p u = insertNodesR [nodePhyloW Nothing Nothing p u]
-
 getListsWithParentId :: NodeId -> Cmd err [Node HyperdataList]
 getListsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeList)
 

src/Gargantext/Viz/Phylo/API.hs

@@ -32,7 +32,7 @@ import Web.HttpApiData (parseUrlPiece, readTextData)
 import Gargantext.API.Prelude
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node -- (PhyloId, ListId, CorpusId, UserId, NodeId(..))
-import Gargantext.Database.Query.Table.Node (insertNodes, nodePhyloW, getNodeWith)
+import Gargantext.Database.Query.Table.Node (insertNodes, node, getNodeWith)
 import Gargantext.Database.Schema.Node (_node_hyperdata)
 import Gargantext.Prelude
 import Gargantext.Viz.Phylo
@@ -95,15 +95,16 @@ type GetPhylo =  QueryParam "listId"      ListId
 -- Add real text processing
 -- Fix Filter parameters
 getPhylo :: PhyloId -> GargServer GetPhylo
---getPhylo phId _lId l msb _f _b _l' _ms _x _y _z _ts _s _o _e _d _b' = do
 getPhylo phId _lId l msb  = do
-  phNode     <- getNodeWith phId (Proxy :: Proxy HyperdataPhylo)
+  phNode     <- getNodeWith phId (Proxy :: Proxy HyperData)
   let
     level = maybe 2 identity l
     branc = maybe 2 identity msb
-    maybePhylo = hyperdataPhylo_data $ _node_hyperdata phNode
+    maybePhylo = hd_data $ _node_hyperdata phNode
 
-  p <- liftBase $ viewPhylo2Svg $ viewPhylo level branc  $ maybe phyloFromQuery identity maybePhylo
+  p <- liftBase $ viewPhylo2Svg
+                $ viewPhylo level branc
+                $ maybe phyloFromQuery identity maybePhylo
   pure (SVG p)
 ------------------------------------------------------------------------
 type PostPhylo =  QueryParam "listId" ListId
@@ -119,7 +120,7 @@ postPhylo n userId _lId = do
     -- _sft = Just (Software "Gargantext" "4")
     -- _prm = initPhyloParam vrs sft (Just q)
   phy  <- flowPhylo n
-  pId <- insertNodes [nodePhyloW (Just "Phylo") (Just $ HyperdataPhylo Nothing (Just phy)) n userId]
+  pId <- insertNodes [node NodePhylo "Phylo" (HyperdataPhylo Nothing (Just phy)) (Just n) userId]
   pure $ NodeId (fromIntegral pId)
 
 ------------------------------------------------------------------------