[REFACT] Hyperdata and Node API (WIP)

src/Gargantext/Database/Action/Node.hs

@@ -28,6 +28,7 @@ import Gargantext.Database.Query.Table.Node
 import Gargantext.Database.Query.Table.Node.Error
 import Gargantext.Database.Query.Table.Node.User
 import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
+import Gargantext.Viz.Graph (defaultHyperdataGraph)
 import Gargantext.Prelude
 import Gargantext.Prelude.Utils (sha)
 import Gargantext.Database.Prelude
@@ -53,47 +54,47 @@ mkNodeWithParent _ Nothing _ _ = nodeError HasParent
 mkNodeWithParent NodeFolder (Just i) uId name =
    insertNodesWithParentR (Just i) [node NodeFolder name hd Nothing uId]
     where
-      hd = defaultFolder
+      hd = defaultHyperdataFolder
 
 mkNodeWithParent NodeFolderPrivate (Just i) uId _ =
    insertNodesWithParentR (Just i) [node NodeFolderPrivate "Private" hd Nothing uId]
     where
-      hd = defaultFolder
+      hd = defaultHyperdataFolder
 
 mkNodeWithParent NodeFolderShared (Just i) uId _ =
    insertNodesWithParentR (Just i) [node NodeFolderShared "Shared" hd Nothing uId]
     where
-      hd = defaultFolder
+      hd = defaultHyperdataFolder
 
 mkNodeWithParent NodeFolderPublic (Just i) uId _ =
    insertNodesWithParentR (Just i) [node NodeFolderPublic "Public" hd Nothing uId]
     where
-      hd = defaultFolder
+      hd = defaultHyperdataFolder
 
 mkNodeWithParent NodeTeam (Just i) uId name =
    insertNodesWithParentR (Just i) [node NodeTeam name hd Nothing uId]
     where
-      hd = defaultFolder
+      hd = defaultHyperdataFolder
 ------------------------------------------------------------------------
 mkNodeWithParent NodeCorpus (Just i) uId name =
    insertNodesWithParentR (Just i) [node NodeCorpus name hd Nothing uId]
     where
-      hd = defaultCorpus
+      hd = defaultHyperdataCorpus
 
 mkNodeWithParent NodeAnnuaire (Just i) uId name =
    insertNodesWithParentR (Just i) [node NodeAnnuaire name hd Nothing uId]
     where
-      hd = defaultAnnuaire
+      hd = defaultHyperdataAnnuaire
 
 mkNodeWithParent NodeList (Just i) uId name =
    insertNodesWithParentR (Just i) [node NodeList name hd Nothing uId]
     where
-      hd = defaultAnnuaire
+      hd = defaultHyperdataAnnuaire
 
 mkNodeWithParent NodeGraph (Just i) uId name =
    insertNodesWithParentR (Just i) [node NodeGraph name hd Nothing uId]
     where
-      hd = arbitraryGraph
+      hd = defaultHyperdataGraph
 
 mkNodeWithParent NodeFrameWrite i u n =
   mkNodeWithParent_ConfigureHyperdata NodeFrameWrite i u n
@@ -101,10 +102,12 @@ mkNodeWithParent NodeFrameWrite i u n =
 mkNodeWithParent NodeFrameCalc i u n =
   mkNodeWithParent_ConfigureHyperdata NodeFrameCalc i u n
 
+{-
 mkNodeWithParent n (Just i) uId name =
    insertNodesWithParentR (Just i) [node NodeDashboard name (hasDefaultData n) Nothing uId]
+-}
 
--- mkNodeWithParent _ _ _ _       = nodeError NotImplYet
+mkNodeWithParent _ _ _ _       = nodeError NotImplYet
 
 
 -- | Sugar to create a node, get his NodeId and update his Hyperdata after
@@ -148,6 +151,3 @@ mkNodeWithParent_ConfigureHyperdata' nt (Just i) uId name = do
     (_:_:_)  -> nodeError MkNode
 mkNodeWithParent_ConfigureHyperdata' _ _ _ _ = nodeError HasParent
 
-
-
-

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

@@ -14,6 +14,7 @@ Portability : POSIX
 module Gargantext.Database.Admin.Types.Hyperdata
   ( module Gargantext.Database.Admin.Types.Hyperdata.Corpus
   , module Gargantext.Database.Admin.Types.Hyperdata.Document
+  , module Gargantext.Database.Admin.Types.Hyperdata.List
   , module Gargantext.Database.Admin.Types.Hyperdata.Prelude
   )
   where
@@ -21,3 +22,7 @@ module Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Hyperdata.Prelude (Hyperdata)
 import Gargantext.Database.Admin.Types.Hyperdata.Corpus
 import Gargantext.Database.Admin.Types.Hyperdata.Document
+import Gargantext.Database.Admin.Types.Hyperdata.List
+
+
+

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

@@ -23,12 +23,9 @@ Portability : POSIX
 module Gargantext.Database.Admin.Types.Hyperdata.Corpus
   where
 
-import Gargantext.API.Ngrams.NTree (MyTree)
+import Gargantext.Prelude
 import Gargantext.Database.Admin.Types.Hyperdata.Prelude
-import Gargantext.Database.Admin.Types.Metrics (ChartMetrics(..), Metrics)
 import Gargantext.Viz.Phylo (Phylo(..))
-import Gargantext.Viz.Types (Histo(..))
-import Protolude hiding (ByteString)
 
 
 data CodeType = JSON | Markdown | Haskell
@@ -68,16 +65,6 @@ instance ToSchema CorpusField where
     & mapped.schema.example ?~ toJSON defaultCorpusField
 
 ------------------------------------------------------------------------
-data Chart =
-    CDocsHistogram
-  | CAuthorsPie
-  | CInstitutesTree
-  | CTermsMetrics
-  deriving (Generic, Show, Eq)
-instance ToJSON Chart
-instance FromJSON Chart
-instance ToSchema Chart
-
 ------------------------------------------------------------------------
 
 data HyperdataField a =
@@ -107,6 +94,7 @@ $(makeLenses ''HyperdataCorpus)
 instance Hyperdata HyperdataCorpus
 
 type HyperdataFolder = HyperdataCorpus
+
 ------------------------------------------------------------------------
 data HyperdataFrame =
   HyperdataFrame { base :: !Text 
@@ -133,21 +121,18 @@ hyperdataCorpus = case decode corpusExample of
   Just hp -> hp
   Nothing -> defaultCorpus
 
+defaultHyperdataCorpus :: HyperdataCorpus
+defaultHyperdataCorpus = defaultCorpus
+
+defaultHyperdataFolder :: HyperdataFolder
+defaultHyperdataFolder = defaultHyperdataCorpus
+
+
+
 instance Arbitrary HyperdataCorpus where
     arbitrary = pure hyperdataCorpus -- TODO
 
 ------------------------------------------------------------------------
-data HyperdataList =
-  HyperdataList { hd_chart   :: !(Maybe (ChartMetrics Histo))
-                , hd_list    :: !(Maybe Text)
-                , hd_pie     :: !(Maybe (ChartMetrics Histo))
-                , hd_scatter :: !(Maybe Metrics)
-                , hd_tree    :: !(Maybe (ChartMetrics [MyTree]))
-                } deriving (Show, Generic)
-$(deriveJSON (unPrefix "hd_") ''HyperdataList)
-
-instance Hyperdata HyperdataList
-
 ------------------------------------------------------------------------
 data HyperdataAnnuaire = HyperdataAnnuaire { hyperdataAnnuaire_title        :: !(Maybe Text)
                                            , hyperdataAnnuaire_desc         :: !(Maybe Text)
@@ -156,11 +141,11 @@ $(deriveJSON (unPrefix "hyperdataAnnuaire_") ''HyperdataAnnuaire)
 
 instance Hyperdata HyperdataAnnuaire
 
-hyperdataAnnuaire :: HyperdataAnnuaire
-hyperdataAnnuaire = HyperdataAnnuaire (Just "Annuaire Title") (Just "Annuaire Description")
+defaultHyperdataAnnuaire :: HyperdataAnnuaire
+defaultHyperdataAnnuaire = HyperdataAnnuaire (Just "Title") (Just "Description")
 
 instance Arbitrary HyperdataAnnuaire where
-    arbitrary = pure hyperdataAnnuaire -- TODO
+  arbitrary = pure defaultHyperdataAnnuaire -- TODO
 
 ------------------------------------------------------------------------
 newtype HyperdataAny = HyperdataAny Object
@@ -171,34 +156,6 @@ instance Hyperdata HyperdataAny
 instance Arbitrary HyperdataAny where
     arbitrary = pure $ HyperdataAny mempty -- TODO produce arbitrary objects
 ------------------------------------------------------------------------
-
-{-
-instance Arbitrary HyperdataList' where
-  arbitrary = elements [HyperdataList' (Just "from list A")]
--}
-
-                      ----
-data HyperdataListModel =
-  HyperdataListModel { _hlm_params  :: !(Int, Int)
-                     , _hlm_path    :: !Text
-                     , _hlm_score   :: !(Maybe Double)
-                     } deriving (Show, Generic)
-
-instance Hyperdata HyperdataListModel
-instance Arbitrary HyperdataListModel where
-  arbitrary = elements [HyperdataListModel (100,100) "models/example.model" Nothing]
-
-$(deriveJSON (unPrefix "_hlm_") ''HyperdataListModel)
-$(makeLenses ''HyperdataListModel)
-
-------------------------------------------------------------------------
-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)
@@ -212,20 +169,58 @@ instance Hyperdata HyperdataResource
 ------------------------------------------------------------------------
 -- | 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)
-                                   }
+data HyperdataTexts =
+  HyperdataTexts { ht_preferences :: !(Maybe Text)}
+  deriving (Show, Generic)
+
+instance Hyperdata HyperdataTexts
+instance ToJSON HyperdataTexts
+instance FromJSON HyperdataTexts
 
+defaultHyperdataTexts :: HyperdataTexts
+defaultHyperdataTexts = HyperdataTexts Nothing
+
+data HyperdataDashboard =
+  HyperdataDashboard { hda_preferences :: !(Maybe Text)
+                     , hda_charts      :: ![Chart]
+                     }
   deriving (Show, Generic)
 
-$(deriveJSON (unPrefix "hd_") ''HyperData)
-instance Hyperdata HyperData
+instance Hyperdata HyperdataDashboard
+instance ToJSON    HyperdataDashboard
+instance FromJSON  HyperdataDashboard
+
+
+
+data HyperdataNotebook =
+  HyperdataNotebook { hn_preferences :: !(Maybe Text)}
+  deriving (Show, Generic)
+
+data HyperdataPhylo =
+  HyperdataPhylo    { hp_preferences :: !(Maybe Text)
+                    , hp_data        :: !(Maybe Phylo)
+                    }
+  deriving (Show, Generic)
+
+instance Hyperdata HyperdataPhylo
+instance ToJSON    HyperdataPhylo
+instance FromJSON  HyperdataPhylo
+
+defaultHyperdataPhylo :: HyperdataPhylo
+defaultHyperdataPhylo = HyperdataPhylo Nothing Nothing
+
+instance FromField HyperdataPhylo where
+    fromField = fromField'
+
+instance QueryRunnerColumnDefault PGJsonb HyperdataPhylo
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
+
+instance ToSchema HyperdataPhylo where
+  declareNamedSchema proxy =
+    genericDeclareNamedSchema (unPrefixSwagger "hp_") proxy
+    & mapped.schema.description ?~ "Phylo"
+    & mapped.schema.example ?~ toJSON defaultHyperdataPhylo
 
 ------------------------------------------------------------------------
 -- Instances
@@ -241,7 +236,7 @@ instance ToSchema HyperdataAnnuaire where
   declareNamedSchema proxy =
     genericDeclareNamedSchema (unPrefixSwagger "hyperdataAnnuaire_") proxy
     & mapped.schema.description ?~ "an annuaire"
-    & mapped.schema.example ?~ toJSON hyperdataAnnuaire
+    & mapped.schema.example ?~ toJSON defaultHyperdataAnnuaire
 
 instance ToSchema HyperdataAny where
   declareNamedSchema proxy =
@@ -258,44 +253,20 @@ instance FromField HyperdataCorpus
   where
     fromField = fromField'
 
-instance FromField HyperData
-  where
-    fromField = fromField'
-
-instance FromField HyperdataListModel
-  where
-    fromField = fromField'
-
 instance FromField HyperdataAnnuaire
   where
     fromField = fromField'
 
-instance FromField HyperdataList
-  where
-    fromField = fromField'
-
 ------------------------------------------------------------------------
 
 instance QueryRunnerColumnDefault PGJsonb HyperdataAny
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-instance QueryRunnerColumnDefault PGJsonb HyperdataList
-  where
-    queryRunnerColumnDefault = fieldQueryRunnerColumn
-
-instance QueryRunnerColumnDefault PGJsonb HyperData
-  where
-    queryRunnerColumnDefault = fieldQueryRunnerColumn
-
 instance QueryRunnerColumnDefault PGJsonb HyperdataCorpus
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-instance QueryRunnerColumnDefault PGJsonb HyperdataListModel
-  where
-    queryRunnerColumnDefault = fieldQueryRunnerColumn
-
 instance QueryRunnerColumnDefault PGJsonb HyperdataAnnuaire
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn

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

@@ -76,18 +76,19 @@ data HyperdataDocument = HyperdataDocument { _hyperdataDocument_bdd
                                            } deriving (Show, Generic)
 
 ------------------------------------------------------------------------
-docExample :: ByteString
-docExample = "{\"doi\":\"sdfds\",\"publication_day\":6,\"language_iso2\":\"en\",\"publication_minute\":0,\"publication_month\":7,\"language_iso3\":\"eng\",\"publication_second\":0,\"authors\":\"Nils Hovdenak, Kjell Haram\",\"publication_year\":2012,\"publication_date\":\"2012-07-06 00:00:00+00:00\",\"language_name\":\"English\",\"realdate_full_\":\"2012 01 12\",\"source\":\"European journal of obstetrics, gynecology, and reproductive biology\",\"abstract\":\"The literature was searched for publications on minerals and vitamins during pregnancy and the possible influence of supplements on pregnancy outcome.\",\"title\":\"Influence of mineral and vitamin supplements on pregnancy outcome.\",\"publication_hour\":0}"
+defaultHyperdataDocument :: HyperdataDocument
+defaultHyperdataDocument = case decode docExample of
+  Just hp -> hp
+  Nothing -> HyperdataDocument Nothing Nothing Nothing Nothing
+                               Nothing Nothing Nothing Nothing
+                               Nothing Nothing Nothing Nothing
+                               Nothing Nothing Nothing Nothing
+                               Nothing Nothing Nothing
 
+  where
+    docExample :: ByteString
+    docExample = "{\"doi\":\"sdfds\",\"publication_day\":6,\"language_iso2\":\"en\",\"publication_minute\":0,\"publication_month\":7,\"language_iso3\":\"eng\",\"publication_second\":0,\"authors\":\"Nils Hovdenak, Kjell Haram\",\"publication_year\":2012,\"publication_date\":\"2012-07-06 00:00:00+00:00\",\"language_name\":\"English\",\"realdate_full_\":\"2012 01 12\",\"source\":\"European journal of obstetrics, gynecology, and reproductive biology\",\"abstract\":\"The literature was searched for publications on minerals and vitamins during pregnancy and the possible influence of supplements on pregnancy outcome.\",\"title\":\"Influence of mineral and vitamin supplements on pregnancy outcome.\",\"publication_hour\":0}"
 
-hyperdataDocument :: HyperdataDocument
-hyperdataDocument = case decode docExample of
-                      Just hp -> hp
-                      Nothing -> HyperdataDocument Nothing Nothing Nothing Nothing
-                                                   Nothing Nothing Nothing Nothing
-                                                   Nothing Nothing Nothing Nothing
-                                                   Nothing Nothing Nothing Nothing
-                                                   Nothing Nothing Nothing
 
 ------------------------------------------------------------------------
 -- Instances
@@ -99,7 +100,7 @@ instance ToSchema HyperdataDocument where
   declareNamedSchema proxy =
     genericDeclareNamedSchema (unPrefixSwagger "_hyperdataDocument_") proxy
     & mapped.schema.description ?~ "a document"
-    & mapped.schema.example ?~ toJSON hyperdataDocument
+    & mapped.schema.example ?~ toJSON defaultHyperdataDocument
 ------------------------------------------------------------------------
 instance FromField HyperdataDocument
   where

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

+{-|
+Module      : Gargantext.Database.Admin.Types.Hyperdata.List
+Description :
+Copyright   : (c) CNRS, 2017-Present
+License     : AGPL + CECILL v3
+Maintainer  : team@gargantext.org
+Stability   : experimental
+Portability : POSIX
+
+-}
+
+{-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE FlexibleContexts  #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes        #-}
+{-# LANGUAGE TemplateHaskell   #-}
+
+
+module Gargantext.Database.Admin.Types.Hyperdata.List
+  where
+
+import Gargantext.Prelude
+import Gargantext.Viz.Types (Histo(..))
+import Gargantext.API.Ngrams.NTree (MyTree)
+import Gargantext.Database.Admin.Types.Hyperdata.Prelude
+import Gargantext.Database.Admin.Types.Metrics (ChartMetrics(..), Metrics)
+
+------------------------------------------------------------------------
+data HyperdataList =
+  HyperdataList { hd_chart   :: !(Maybe (ChartMetrics Histo))
+                , hd_list    :: !(Maybe Text)
+                , hd_pie     :: !(Maybe (ChartMetrics Histo))
+                , hd_scatter :: !(Maybe Metrics)
+                , hd_tree    :: !(Maybe (ChartMetrics [MyTree]))
+                } deriving (Show, Generic)
+$(deriveJSON (unPrefix "hd_") ''HyperdataList)
+
+instance Hyperdata HyperdataList
+
+defaultHyperdataList :: HyperdataList
+defaultHyperdataList = HyperdataList Nothing Nothing Nothing Nothing Nothing
+
+                      ----
+data HyperdataListModel =
+  HyperdataListModel { _hlm_params  :: !(Int, Int)
+                     , _hlm_path    :: !Text
+                     , _hlm_score   :: !(Maybe Double)
+                     } deriving (Show, Generic)
+
+instance Hyperdata HyperdataListModel
+instance Arbitrary HyperdataListModel where
+  arbitrary = elements [HyperdataListModel (100,100) "models/example.model" Nothing]
+
+$(deriveJSON (unPrefix "_hlm_") ''HyperdataListModel)
+$(makeLenses ''HyperdataListModel)
+
+defaultHyperdataListModel :: HyperdataListModel
+defaultHyperdataListModel = HyperdataListModel (400,500) "data/models/test.model" (Just 0.83)
+
+
+------------------------------------------------------------------------
+data HyperdataScore = HyperdataScore { hyperdataScore_preferences   :: !(Maybe Text)
+                                   } deriving (Show, Generic)
+$(deriveJSON (unPrefix "hyperdataScore_") ''HyperdataScore)
+
+instance Hyperdata HyperdataScore
+
+------------------------------------------------------------------------
+-- Instances
+------------------------------------------------------------------------
+instance FromField HyperdataList
+  where
+    fromField = fromField'
+
+instance FromField HyperdataListModel
+  where
+    fromField = fromField'
+------------------------------------------------------------------------
+instance QueryRunnerColumnDefault PGJsonb HyperdataList
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
+
+instance QueryRunnerColumnDefault PGJsonb HyperdataListModel
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
+

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

@@ -16,6 +16,7 @@ module Gargantext.Database.Admin.Types.Hyperdata.Prelude
   , module Data.Aeson.TH
   , module Data.Aeson.Types
   , module Data.ByteString.Lazy.Internal
+  , module Data.Maybe
   , module Data.Monoid
   , module Data.Swagger
   , module Data.Text
@@ -28,27 +29,45 @@ module Gargantext.Database.Admin.Types.Hyperdata.Prelude
   , module Test.QuickCheck
   , module Test.QuickCheck.Arbitrary
   , Hyperdata
+  , Chart(..)
   )
   where
 
-import Data.Text (Text)
 import Control.Lens hiding (elements, (&), (.=))
 import Data.Aeson
 import Data.Aeson.TH (deriveJSON)
 import Data.Aeson.Types (emptyObject)
 import Data.ByteString.Lazy.Internal (ByteString)
+import Data.Maybe (Maybe(..))
 import Data.Monoid (mempty)
 import Data.Swagger hiding (unwrapUnaryRecords, constructorTagModifier, allNullaryToStringTag, allOf, fieldLabelModifier)
+import Data.Text (Text)
 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
 import Database.PostgreSQL.Simple.ToField (ToField, toField, toJSONField)
 import GHC.Generics (Generic)
 import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
 import Gargantext.Database.Prelude (fromField')
+import Gargantext.Prelude
 import Opaleye (QueryRunnerColumnDefault, queryRunnerColumnDefault, PGJsonb, fieldQueryRunnerColumn)
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
 
+------------------------------------------------------------------------
 -- Only Hyperdata types should be member of this type class.
 class Hyperdata a
 
 
+data Chart =
+    CDocsHistogram
+  | CAuthorsPie
+  | CInstitutesTree
+  | CTermsMetrics
+  deriving (Generic, Show, Eq)
+instance ToJSON Chart
+instance FromJSON Chart
+instance ToSchema Chart
+
+
+
+
+

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

@@ -41,7 +41,7 @@ import Gargantext.Database.Prelude
 import Gargantext.Database.Query.Table.Node.Contact (HyperdataContact(..), arbitraryHyperdataContact)
 import Gargantext.Database.Schema.Node
 import Gargantext.Prelude hiding (sum, head)
-import Gargantext.Viz.Graph (HyperdataGraph(..))
+import Gargantext.Viz.Graph (HyperdataGraph(..), defaultHyperdataGraph)
 
 
 queryNodeSearchTable :: Query NodeSearchRead
@@ -181,79 +181,20 @@ nodeCorpusW maybeName maybeCorpus pId = node NodeCorpus name corpus (Just pId)
     name   = maybe "Corpus" identity maybeName
     corpus = maybe defaultCorpus identity maybeCorpus
                    --------------------------
-defaultDocument :: HyperdataDocument
-defaultDocument = hyperdataDocument
 
 nodeDocumentW :: Maybe Name -> Maybe HyperdataDocument -> CorpusId -> UserId -> NodeWrite
 nodeDocumentW maybeName maybeDocument cId = node NodeDocument name doc (Just cId)
   where
     name = maybe "Document" identity maybeName
-    doc  = maybe defaultDocument identity maybeDocument
+    doc  = maybe defaultHyperdataDocument identity maybeDocument
 ------------------------------------------------------------------------
-defaultAnnuaire :: HyperdataAnnuaire
-defaultAnnuaire = HyperdataAnnuaire (Just "Title") (Just "Description")
-
 nodeAnnuaireW :: Maybe Name -> Maybe HyperdataAnnuaire -> ParentId -> UserId -> NodeWrite
 nodeAnnuaireW maybeName maybeAnnuaire pId = node NodeAnnuaire name annuaire (Just pId)
   where
     name     = maybe "Annuaire" identity maybeName
-    annuaire = maybe defaultAnnuaire identity maybeAnnuaire
-
-------------------------------------------------------------------------
-
-{-
-class IsNodeDb a where
-  data Node'' a :: *
-  data Hyper  a :: *
-
-instance IsNodeDb NodeType where
-  data 
-
-instance HasHyperdata NodeType where
-  data Hyper NodeType = HyperList   HyperdataList
-                      | HyperCorpus HyperdataCorpus
-
-  hasHyperdata nt = case nt of
-    NodeList   -> HyperList $ HyperdataList (Just "list")
-
-  unHyper h = case h of
-    HyperList h' -> h'
-
---}
-
-
-class HasDefault a where
-  hasDefaultData :: a -> HyperData
-  hasDefaultName :: a -> Text
-
-instance HasDefault NodeType where
-  hasDefaultData nt = case nt of
-      NodeTexts     -> HyperdataTexts (Just "Preferences")
-      NodeList      -> HyperdataList' (Just "Preferences")
-      NodeListCooc  -> HyperdataList' (Just "Preferences")
-      -- NodeFolder    -> defaultFolder
-      NodeDashboard -> arbitraryDashboard
-      _             -> panic "HasDefaultData undefined"
-      --NodeAnnuaire -> HyperdataAnnuaire (Just "Title") (Just "Description")
-
-  hasDefaultName nt = case nt of
-      NodeTexts -> "Texts"
-      NodeList  -> "Lists"
-      NodeListCooc -> "Cooc"
-      NodePhylo    -> "Phylo"
-      _         -> panic "HasDefaultName undefined"
+    annuaire = maybe defaultHyperdataAnnuaire identity maybeAnnuaire
 
 ------------------------------------------------------------------------
-nodeDefault :: NodeType -> ParentId -> UserId -> NodeWrite
-nodeDefault nt parent = node nt name hyper (Just parent)
-  where
-    name  = (hasDefaultName nt)
-    hyper = (hasDefaultData nt)
-
-------------------------------------------------------------------------
-arbitraryListModel :: HyperdataListModel
-arbitraryListModel = HyperdataListModel (400,500) "data/models/test.model" (Just 0.83)
-
 mkListModelNode :: HasNodeError err => ParentId -> UserId -> Cmd err [NodeId]
 mkListModelNode p u = insertNodesR [nodeListModelW Nothing Nothing p u]
 
@@ -261,17 +202,14 @@ nodeListModelW :: Maybe Name -> Maybe HyperdataListModel -> ParentId -> UserId -
 nodeListModelW maybeName maybeListModel pId = node NodeListModel name list (Just pId)
   where
     name = maybe "List Model" identity maybeName
-    list = maybe arbitraryListModel identity maybeListModel
+    list = maybe defaultHyperdataListModel identity maybeListModel
 
 ------------------------------------------------------------------------
-arbitraryGraph :: HyperdataGraph
-arbitraryGraph = HyperdataGraph Nothing
-
 nodeGraphW :: Maybe Name -> Maybe HyperdataGraph -> ParentId -> UserId -> NodeWrite
 nodeGraphW maybeName maybeGraph pId = node NodeGraph name graph (Just pId)
   where
     name = maybe "Graph" identity maybeName
-    graph = maybe arbitraryGraph identity maybeGraph
+    graph = maybe defaultHyperdataGraph identity maybeGraph
 
 mkGraph :: ParentId -> UserId -> Cmd err [GraphId]
 mkGraph p u = insertNodesR [nodeGraphW Nothing Nothing p u]
@@ -279,11 +217,18 @@ 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]
 
+
 ------------------------------------------------------------------------
-arbitraryDashboard :: HyperData 
-arbitraryDashboard = HyperdataDashboard (Just "Preferences") []
-------------------------------------------------------------------------
+nodeDefault :: NodeType -> ParentId -> UserId -> NodeWrite
+nodeDefault NodeList      parentId = node NodeList      "List"   defaultHyperdataList      (Just parentId)
+nodeDefault NodeCorpus    parentId = node NodeCorpus    "Corpus" defaultHyperdataCorpus    (Just parentId)
+nodeDefault NodeDocument  parentId = node NodeDocument  "Doc"    defaultHyperdataDocument  (Just parentId)
+nodeDefault NodeTexts     parentId = node NodeTexts     "Texts"  defaultHyperdataTexts     (Just parentId)
+nodeDefault NodeListModel parentId = node NodeListModel "Model"  defaultHyperdataListModel (Just parentId)
+nodeDefault nt _ = panic $ "G.D.Q.T.Node.nodeDefault " <> (cs $ show nt)
 
+------------------------------------------------------------------------
+------------------------------------------------------------------------
 node :: (ToJSON a, Hyperdata a)
      => NodeType
      -> Name
@@ -316,19 +261,6 @@ insertNodesWithParent pid ns = insertNodes (set node_parentId (pgNodeId <$> pid)
 insertNodesWithParentR :: Maybe ParentId -> [NodeWrite] -> Cmd err [NodeId]
 insertNodesWithParentR pid ns = insertNodesR (set node_parentId (pgNodeId <$> pid) <$> ns)
 ------------------------------------------------------------------------
--- TODO Hierachy of Nodes
--- post and get same types Node' and update if changes
-
-{- TODO semantic to achieve
-post c uid pid [ Node' NodeCorpus "name" "{}" []
-               , Node' NodeFolder "name" "{}" [Node' NodeCorpus "test 2" "" [ Node' NodeDocument "title" "metaData" []
-                                                                    , Node' NodeDocument "title" "jsonData" []
-                                                                    ]
-                                          ]
-               ]
--}
-------------------------------------------------------------------------
-
 -- TODO
 -- currently this function removes the child relation
 -- needs a Temporary type between Node' and NodeWriteT
@@ -352,41 +284,6 @@ mkNodeR :: [NodeWrite] -> Cmd err [NodeId]
 mkNodeR ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns (rReturning _node_id) Nothing
 
 ------------------------------------------------------------------------
-
-{-
-data NewNode = NewNode { _newNodeId :: NodeId
-                       , _newNodeChildren :: [NodeId] }
-
-postNode :: HasNodeError err
-         => UserId
-         -> Maybe ParentId
-         -> Node'
-         -> Cmd err NewNode
-
-postNode uid pid (Node' nt txt v []) = do
-  pids <- mkNodeR [node2table uid pid (Node' nt txt v [])]
-  case pids of
-    [pid'] -> pure $ NewNode pid' []
-    _ -> nodeError ManyParents
-
-postNode uid pid (Node' NodeCorpus txt v ns) = do
-  NewNode pid' _ <- postNode uid pid (Node' NodeCorpus txt v [])
-  pids  <- mkNodeR (concat $ map (\n -> [childWith uid pid' n]) ns)
-  pure $ NewNode pid' pids
-
-postNode uid pid (Node' NodeAnnuaire txt v ns) = do
-  NewNode pid' _ <- postNode uid pid (Node' NodeAnnuaire txt v [])
-  pids  <- mkNodeR (concat $ map (\n -> [childWith uid pid' n]) ns)
-  pure $ NewNode pid' pids
-
-postNode uid pid (Node' NodeDashboard txt v ns) = do
-  NewNode pid' _ <- postNode uid pid (Node' NodeDashboard txt v [])
-  pids  <- mkNodeR (concat $ map (\n -> [childWith uid pid' n]) ns)
-  pure $ NewNode pid' pids
-
-postNode _ _ (Node' _ _ _ _) = nodeError NotImplYet
--}
-
 childWith :: UserId -> ParentId -> Node' -> NodeWrite
 childWith uId pId (Node' NodeDocument txt v []) = node2table uId (Just pId) (Node' NodeDocument txt v [])
 childWith uId pId (Node' NodeContact  txt v []) = node2table uId (Just pId) (Node' NodeContact txt v [])
@@ -439,11 +336,14 @@ mkNode nt p u = insertNodesR [nodeDefault nt p u]
 mkDashboard :: ParentId -> UserId -> Cmd err [NodeId]
 mkDashboard p u = insertNodesR [nodeDashboardW Nothing Nothing p u]
   where
-    nodeDashboardW :: Maybe Name -> Maybe HyperData -> ParentId -> UserId -> NodeWrite
+    nodeDashboardW :: Maybe Name -> Maybe HyperdataDashboard -> ParentId -> UserId -> NodeWrite
     nodeDashboardW maybeName maybeDashboard pId = node NodeDashboard name dashboard (Just pId)
       where
         name = maybe "Board" identity maybeName
         dashboard = maybe arbitraryDashboard identity maybeDashboard
+        arbitraryDashboard :: HyperdataDashboard 
+        arbitraryDashboard = HyperdataDashboard (Just "Preferences") []
+
 
 getListsWithParentId :: NodeId -> Cmd err [Node HyperdataList]
 getListsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeList)

src/Gargantext/Viz/Graph.hs

@@ -170,6 +170,10 @@ data HyperdataGraph =
                  } deriving (Show, Generic)
 $(deriveJSON (unPrefix "") ''HyperdataGraph)
 
+defaultHyperdataGraph :: HyperdataGraph 
+defaultHyperdataGraph = HyperdataGraph Nothing
+
+
 instance Hyperdata HyperdataGraph
 makeLenses ''HyperdataGraph
 

src/Gargantext/Viz/Phylo/API.hs

@@ -96,11 +96,11 @@ type GetPhylo =  QueryParam "listId"      ListId
 -- Fix Filter parameters
 getPhylo :: PhyloId -> GargServer GetPhylo
 getPhylo phId _lId l msb  = do
-  phNode     <- getNodeWith phId (Proxy :: Proxy HyperData)
+  phNode     <- getNodeWith phId (Proxy :: Proxy HyperdataPhylo)
   let
     level = maybe 2 identity l
     branc = maybe 2 identity msb
-    maybePhylo = hd_data $ _node_hyperdata phNode
+    maybePhylo = hp_data $ _node_hyperdata phNode
 
   p <- liftBase $ viewPhylo2Svg
                 $ viewPhylo level branc