[docker] update image, add README info
[gargantext.git] / src / Gargantext / Database / Schema / Node.hs
index a491c654578951f8a23e99f646631d04a2fede7c..16e13d66bb25461fc64c48141e8d5539156614b2 100644 (file)
@@ -22,6 +22,7 @@ Portability : POSIX
 {-# LANGUAGE NoImplicitPrelude      #-}
 {-# LANGUAGE RankNTypes             #-}
 {-# LANGUAGE TemplateHaskell        #-}
+{-# LANGUAGE TypeFamilies           #-}
 
 module Gargantext.Database.Schema.Node where
 
@@ -32,17 +33,20 @@ import Control.Monad.Error.Class (MonadError(..))
 import Data.Aeson
 import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
-import Data.Text (Text, pack)
+import Data.Text (Text)
 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
 import GHC.Int (Int64)
-import Gargantext.Core (Lang(..))
 import Gargantext.Core.Types
 import Gargantext.Core.Types.Individu (Username)
 import Gargantext.Database.Config (nodeTypeId)
 import Gargantext.Database.Queries.Filter (limit', offset')
-import Gargantext.Database.Types.Node (NodeType, defaultCorpus, Hyperdata)
+import Gargantext.Database.Types.Node (NodeType(..), defaultCorpus, Hyperdata, HyperData(..))
+import Gargantext.Database.Node.User (HyperdataUser(..), fake_HyperdataUser)
+import Gargantext.Database.Node.Contact (HyperdataContact(..), arbitraryHyperdataContact)
 import Gargantext.Database.Utils
 import Gargantext.Prelude hiding (sum, head)
+import Gargantext.Viz.Graph (HyperdataGraph(..))
+
 import Opaleye hiding (FromField)
 import Opaleye.Internal.QueryArr (Query)
 import Prelude hiding (null, id, map, sum)
@@ -87,11 +91,11 @@ instance FromField HyperdataDocumentV3
   where
     fromField = fromField'
 
-instance FromField HyperdataUser
+instance FromField HyperData
   where
     fromField = fromField'
 
-instance FromField HyperdataList
+instance FromField HyperdataListModel
   where
     fromField = fromField'
 
@@ -99,14 +103,35 @@ instance FromField HyperdataGraph
   where
     fromField = fromField'
 
+instance FromField HyperdataPhylo
+  where
+    fromField = fromField'
+
 instance FromField HyperdataAnnuaire
   where
     fromField = fromField'
+
+instance FromField HyperdataList
+  where
+    fromField = fromField'
+
+instance FromField (NodeId, Text)
+  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 HyperdataDocument
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
@@ -119,15 +144,15 @@ instance QueryRunnerColumnDefault PGJsonb HyperdataCorpus
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-instance QueryRunnerColumnDefault PGJsonb HyperdataUser
+instance QueryRunnerColumnDefault PGJsonb HyperdataListModel
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-instance QueryRunnerColumnDefault PGJsonb HyperdataList
+instance QueryRunnerColumnDefault PGJsonb HyperdataGraph
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
-instance QueryRunnerColumnDefault PGJsonb HyperdataGraph
+instance QueryRunnerColumnDefault PGJsonb HyperdataPhylo
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
@@ -147,50 +172,51 @@ instance QueryRunnerColumnDefault PGInt4 NodeId
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
+instance QueryRunnerColumnDefault (Nullable PGInt4) NodeId
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
+
 
-------------------------------------------------------------------------
--- WIP
--- TODO Classe HasDefault where
--- default NodeType = Hyperdata
 ------------------------------------------------------------------------
 $(makeAdaptorAndInstance "pNode" ''NodePoly)
 $(makeLensesWith abbreviatedFields ''NodePoly)
+
 $(makeAdaptorAndInstance "pNodeSearch" ''NodePolySearch)
 $(makeLensesWith abbreviatedFields ''NodePolySearch)
 
-type NodeWrite = NodePoly  (Maybe (Column  PGInt4       ))
-                                  (Column  PGInt4       )
-                                  (Column  PGInt4       )
-                           (Maybe (Column  PGInt4       ))
-                                  (Column PGText        )
-                           (Maybe (Column  PGTimestamptz))
-                                  (Column  PGJsonb      )
-
-type NodeRead = NodePoly  (Column PGInt4        )
-                          (Column PGInt4        )
-                          (Column PGInt4        )
-                          (Column PGInt4        )
-                          (Column PGText        )
-                          (Column PGTimestamptz )
-                          (Column PGJsonb       )
-
-type NodeReadNull = NodePoly  (Column (Nullable PGInt4 ))
-                              (Column (Nullable PGInt4 ))
-                              (Column (Nullable PGInt4 ))
-                              (Column (Nullable PGInt4 ))
-                              (Column (Nullable PGText ))
-                              (Column (Nullable PGTimestamptz ))
-                              (Column (Nullable PGJsonb))
+type NodeWrite = NodePoly (Maybe (Column PGInt4)      )
+                                 (Column PGInt4)
+                                 (Column PGInt4)
+                          (Maybe (Column PGInt4)      )
+                                 (Column PGText)
+                          (Maybe (Column PGTimestamptz))
+                                 (Column PGJsonb)
+
+type NodeRead = NodePoly (Column PGInt4        )
+                         (Column PGInt4        )
+                         (Column PGInt4        )
+                         (Column PGInt4        )
+                         (Column PGText        )
+                         (Column PGTimestamptz )
+                         (Column PGJsonb       )
+
+type NodeReadNull = NodePoly (Column (Nullable PGInt4))
+                             (Column (Nullable PGInt4))
+                             (Column (Nullable PGInt4))
+                             (Column (Nullable PGInt4))
+                             (Column (Nullable PGText))
+                             (Column (Nullable PGTimestamptz))
+                             (Column (Nullable PGJsonb))
 
 nodeTable :: Table NodeWrite NodeRead
 nodeTable = Table "nodes" (pNode Node { _node_id         = optional "id"
                                       , _node_typename   = required "typename"
                                       , _node_userId     = required "user_id"
-                                      
+
                                       , _node_parentId   = optional "parent_id"
                                       , _node_name       = required "name"
                                       , _node_date       = optional "date"
-                                      
+
                                       , _node_hyperdata  = required "hyperdata"
                                       }
                             )
@@ -201,48 +227,53 @@ queryNodeTable = queryTable nodeTable
 ------------------------------------------------------------------------
 -- | Node(Read|Write)Search is slower than Node(Write|Read) use it
 -- for full text search only
-type NodeSearchWrite = NodePolySearch  (Maybe (Column  PGInt4              ))
-                                  (Column  PGInt4               )
-                                  (Column  PGInt4               )
-                                  (Column (Nullable PGInt4     ))
-                                  (Column (PGText              ))
-                                  (Maybe  (Column PGTimestamptz))
-                                  (Column  PGJsonb              )
-                                  (Maybe (Column PGTSVector))
-
-type NodeSearchRead = NodePolySearch  (Column  PGInt4           )
-                          (Column  PGInt4           )
-                          (Column  PGInt4           )
-                          (Column (Nullable PGInt4 ))
-                          (Column (PGText          ))
-                          (Column PGTimestamptz     )
-                          (Column PGJsonb) 
-                          (Column PGTSVector)
-
-type NodeSearchReadNull = NodePolySearch  (Column  (Nullable PGInt4           ))
-                              (Column  (Nullable PGInt4           ))
-                              (Column  (Nullable PGInt4           ))
-                              (Column (Nullable PGInt4 ))
-                              (Column (Nullable PGText          ))
-                              (Column (Nullable PGTimestamptz     ))
-                              (Column (Nullable PGJsonb))
-                              (Column (Nullable PGTSVector))
-
---{-
+type NodeSearchWrite =
+  NodePolySearch
+    (Maybe  (Column  PGInt4)      )
+    (Column  PGInt4               )
+    (Column  PGInt4               )
+    (Column (Nullable PGInt4)     )
+    (Column PGText                )
+    (Maybe  (Column PGTimestamptz))
+    (Column  PGJsonb              )
+    (Maybe  (Column PGTSVector)   )
+
+type NodeSearchRead =
+  NodePolySearch
+    (Column  PGInt4           )
+    (Column  PGInt4           )
+    (Column  PGInt4           )
+    (Column (Nullable PGInt4 ))
+    (Column  PGText           )
+    (Column  PGTimestamptz    )
+    (Column  PGJsonb          )
+    (Column  PGTSVector       )
+
+type NodeSearchReadNull =
+  NodePolySearch
+    (Column (Nullable PGInt4)       )
+    (Column (Nullable PGInt4)       )
+    (Column (Nullable PGInt4)       )
+    (Column (Nullable PGInt4)       )
+    (Column (Nullable PGText)       )
+    (Column (Nullable PGTimestamptz))
+    (Column (Nullable PGJsonb)      )
+    (Column (Nullable PGTSVector)   )
+
 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"
                                       }
                             )
---}
+
 
 queryNodeSearchTable :: Query NodeSearchRead
 queryNodeSearchTable = queryTable nodeTableSearch
@@ -253,12 +284,13 @@ selectNode id = proc () -> do
     restrict -< _node_id row .== id
     returnA -< row
 
-runGetNodes :: Query NodeRead -> Cmd err [NodeAny]
+
+
+runGetNodes :: Query NodeRead -> Cmd err [Node HyperdataAny]
 runGetNodes = runOpaQuery
 
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
-
 -- | order by publication date
 -- Favorites (Bool), node_ngrams
 selectNodesWith :: ParentId     -> Maybe NodeType
@@ -283,7 +315,6 @@ selectNodesWith' parentId maybeNodeType = proc () -> do
       returnA  -< row ) -< ()
     returnA -< node
 
-
 deleteNode :: NodeId -> Cmd err Int
 deleteNode n = mkCmd $ \conn ->
   fromIntegral <$> runDelete conn nodeTable
@@ -302,8 +333,14 @@ getNodesWith parentId _ nodeType maybeOffset maybeLimit =
 
 -- TODO: Why is the second parameter ignored?
 -- TODO: Why not use getNodesWith?
-getNodesWithParentId :: NodeId -> Maybe Text -> Cmd err [NodeAny]
-getNodesWithParentId n _ = runOpaQuery $ selectNodesWithParentID n
+getNodesWithParentId :: (Hyperdata a, QueryRunnerColumnDefault PGJsonb a)
+                     => Maybe NodeId
+                     -> Cmd err [Node a]
+getNodesWithParentId n = runOpaQuery $ selectNodesWithParentID n'
+  where
+    n' = case n of
+      Just n'' -> n''
+      Nothing  -> 0
 
 ------------------------------------------------------------------------
 getDocumentsV3WithParentId :: NodeId -> Cmd err [Node HyperdataDocumentV3]
@@ -313,8 +350,8 @@ getDocumentsV3WithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeDocume
 getDocumentsWithParentId :: NodeId -> Cmd err [Node HyperdataDocument]
 getDocumentsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeDocument)
 
-getListsWithParentId :: NodeId -> Cmd err [Node HyperdataList]
-getListsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeList)
+getListsModelWithParentId :: NodeId -> Cmd err [Node HyperdataListModel]
+getListsModelWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeListModel)
 
 getCorporaWithParentId :: NodeId -> Cmd err [Node HyperdataCorpus]
 getCorporaWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeCorpus)
@@ -334,28 +371,50 @@ selectNodesWithType type_id = proc () -> do
 
 type JSONB = QueryRunnerColumnDefault PGJsonb
 
-getNode :: JSONB a => NodeId -> proxy a -> Cmd err (Node a)
-getNode nId _ = do
-    fromMaybe (error $ "Node does node exist: " <> show nId) . headMay <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
+
+getNode :: NodeId -> Cmd err (Node Value)
+getNode nId = fromMaybe (error $ "Node does not exist: " <> show nId) . headMay
+             <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
+
+getNodeWith :: JSONB a => NodeId -> proxy a -> Cmd err (Node a)
+getNodeWith nId _ = do
+    fromMaybe (error $ "Node does not exist: " <> show nId) . headMay
+             <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
+
+getNodeUser :: NodeId -> Cmd err (Node HyperdataUser)
+getNodeUser nId = do
+    fromMaybe (error $ "Node does not exist: " <> show nId) . headMay
+             <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
+
+
+getNodePhylo :: NodeId -> Cmd err (Node HyperdataPhylo)
+getNodePhylo nId = do
+    fromMaybe (error $ "Node Phylo does not exist: " <> show nId) . headMay
+             <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
+
 
 getNodesWithType :: Column PGInt4 -> Cmd err [Node HyperdataDocument]
 getNodesWithType = runOpaQuery . selectNodesWithType
 
 ------------------------------------------------------------------------
-------------------------------------------------------------------------
-defaultUser :: HyperdataUser
-defaultUser = HyperdataUser (Just $ (pack . show) EN)
-
 nodeUserW :: Maybe Name -> Maybe HyperdataUser -> UserId -> NodeWrite
 nodeUserW maybeName maybeHyperdata = node NodeUser name user Nothing
   where
     name = maybe "User" identity maybeName
-    user = maybe defaultUser identity maybeHyperdata
+    user = maybe fake_HyperdataUser identity maybeHyperdata
+
+nodeContactW :: Maybe Name -> Maybe HyperdataContact
+             -> AnnuaireId -> UserId -> NodeWrite
+nodeContactW maybeName maybeContact aId = 
+  node NodeContact name contact (Just aId)
+    where
+      name    = maybe "Contact" identity maybeName
+      contact = maybe arbitraryHyperdataContact identity maybeContact
 ------------------------------------------------------------------------
-defaultFolder :: HyperdataFolder
-defaultFolder = HyperdataFolder (Just "Markdown Description")
+defaultFolder :: HyperdataCorpus
+defaultFolder = defaultCorpus
 
-nodeFolderW :: Maybe Name -> Maybe HyperdataFolder -> ParentId -> UserId -> NodeWrite
+nodeFolderW :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> NodeWrite
 nodeFolderW maybeName maybeFolder pid = node NodeFolder name folder (Just pid)
   where
     name   = maybe "Folder" identity maybeName
@@ -384,21 +443,72 @@ nodeAnnuaireW maybeName maybeAnnuaire pId = node NodeAnnuaire name annuaire (Jus
   where
     name     = maybe "Annuaire" identity maybeName
     annuaire = maybe defaultAnnuaire identity maybeAnnuaire
-                   --------------------------
 
 ------------------------------------------------------------------------
-arbitraryList :: HyperdataList
-arbitraryList = HyperdataList (Just "Preferences")
 
-nodeListW :: Maybe Name -> Maybe HyperdataList -> ParentId -> UserId -> NodeWrite
-nodeListW maybeName maybeList pId = node NodeList name list (Just pId)
+{-
+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")
+      _         -> undefined
+      --NodeAnnuaire -> HyperdataAnnuaire (Just "Title") (Just "Description")
+
+  hasDefaultName nt = case nt of
+      NodeTexts -> "Texts"
+      NodeList  -> "Lists"
+      NodeListCooc -> "Cooc"
+      _         -> undefined
+
+------------------------------------------------------------------------
+
+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]
+
+nodeListModelW :: Maybe Name -> Maybe HyperdataListModel -> ParentId -> UserId -> NodeWrite
+nodeListModelW maybeName maybeListModel pId = node NodeListModel name list (Just pId)
   where
-    name = maybe "Listes" identity maybeName
-    list = maybe arbitraryList identity maybeList
+    name = maybe "List Model" identity maybeName
+    list = maybe arbitraryListModel identity maybeListModel
 
 ------------------------------------------------------------------------
 arbitraryGraph :: HyperdataGraph
-arbitraryGraph = HyperdataGraph (Just "Preferences")
+arbitraryGraph = HyperdataGraph Nothing
 
 nodeGraphW :: Maybe Name -> Maybe HyperdataGraph -> ParentId -> UserId -> NodeWrite
 nodeGraphW maybeName maybeGraph pId = node NodeGraph name graph (Just pId)
@@ -406,26 +516,43 @@ nodeGraphW maybeName maybeGraph pId = node NodeGraph name graph (Just pId)
     name = maybe "Graph" identity maybeName
     graph = maybe arbitraryGraph identity maybeGraph
 
-------------------------------------------------------------------------
+mkGraph :: ParentId -> UserId -> Cmd err [GraphId]
+mkGraph p u = insertNodesR [nodeGraphW Nothing Nothing p u]
 
-arbitraryDashboard :: HyperdataDashboard
-arbitraryDashboard = HyperdataDashboard (Just "Preferences")
+insertGraph :: ParentId -> UserId -> HyperdataGraph -> Cmd err [GraphId]
+insertGraph p u h = insertNodesR [nodeGraphW Nothing (Just h) p u]
+
+------------------------------------------------------------------------
+arbitraryPhylo :: HyperdataPhylo
+arbitraryPhylo = HyperdataPhylo Nothing Nothing
 
-nodeDashboardW :: Maybe Name -> Maybe HyperdataDashboard -> ParentId -> UserId -> NodeWrite
-nodeDashboardW maybeName maybeDashboard pId = node NodeDashboard name dashboard (Just pId)
+nodePhyloW :: Maybe Name -> Maybe HyperdataPhylo -> ParentId -> UserId -> NodeWrite
+nodePhyloW maybeName maybePhylo pId = node NodePhylo name graph (Just pId)
   where
-    name = maybe "Dashboard" identity maybeName
-    dashboard = maybe arbitraryDashboard identity maybeDashboard
+    name = maybe "Phylo" identity maybeName
+    graph = maybe arbitraryPhylo identity maybePhylo
+
 
 ------------------------------------------------------------------------
+arbitraryDashboard :: HyperdataDashboard
+arbitraryDashboard = HyperdataDashboard (Just "Preferences") []
+------------------------------------------------------------------------
+
 node :: (ToJSON a, Hyperdata a) => NodeType -> Name -> a -> Maybe ParentId -> UserId -> NodeWrite
-node nodeType name hyperData parentId userId = Node Nothing (pgInt4 typeId) (pgInt4 userId) (pgNodeId <$> parentId) (pgStrictText name) Nothing (pgJSONB $ cs $ encode hyperData)
-  where
-    typeId = nodeTypeId nodeType
+node nodeType name hyperData parentId userId =
+  Node Nothing 
+       (pgInt4 typeId)
+       (pgInt4 userId)
+       (pgNodeId <$> parentId)
+       (pgStrictText name)
+       Nothing
+       (pgJSONB $ cs $ encode hyperData)
+    where
+      typeId = nodeTypeId nodeType
 
                   -------------------------------
 insertNodes :: [NodeWrite] -> Cmd err Int64
-insertNodes ns = mkCmd $ \conn -> runInsertMany conn nodeTable ns
+insertNodes ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns rCount Nothing
 
 insertNodesR :: [NodeWrite] -> Cmd err [NodeId]
 insertNodesR ns = mkCmd $ \conn ->
@@ -464,11 +591,11 @@ data Node' = Node' { _n_type :: NodeType
                    , _n_children :: [Node']
                    } deriving (Show)
 
-mkNode :: [NodeWrite] -> Cmd err Int64
-mkNode ns = mkCmd $ \conn -> runInsertMany conn nodeTable ns
+mkNodes :: [NodeWrite] -> Cmd err Int64
+mkNodes ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns rCount Nothing
 
 mkNodeR :: [NodeWrite] -> Cmd err [NodeId]
-mkNodeR ns = mkCmd $ \conn -> runInsertManyReturning conn nodeTable ns (_node_id)
+mkNodeR ns = mkCmd $ \conn -> runInsert_ conn $ Insert nodeTable ns (rReturning _node_id) Nothing
 
 ------------------------------------------------------------------------
 
@@ -476,6 +603,7 @@ 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
@@ -491,6 +619,12 @@ 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
 
 
@@ -500,57 +634,130 @@ childWith uId pId (Node' NodeContact  txt v []) = node2table uId (Just pId) (Nod
 childWith _   _   (Node' _        _   _ _) = panic "This NodeType can not be a child"
 
 
--- | TODO Use right userId
-mk :: NodeType -> Maybe ParentId -> Text -> Cmd err [NodeId]
-mk nt pId name  = mk' nt userId pId name
-  where
-    userId = 1
+-- =================================================================== --
+------------------------------------------------------------------------
+-- | TODO mk all others nodes
+mkNodeWithParent :: HasNodeError err => NodeType -> Maybe ParentId -> UserId -> Name -> Cmd err [NodeId]
+mkNodeWithParent NodeUser (Just _) _   _    = nodeError UserNoParent
 
-mk' :: NodeType -> UserId -> Maybe ParentId -> Text -> Cmd err [NodeId]
-mk' nt uId pId name  = insertNodesWithParentR pId [node nt name hd pId uId]
-  where
-    hd = HyperdataUser . Just . pack $ show EN
+------------------------------------------------------------------------
+mkNodeWithParent NodeUser Nothing  uId name =
+  insertNodesWithParentR Nothing [node NodeUser name fake_HyperdataUser Nothing uId]
+
+mkNodeWithParent _ Nothing _ _ = nodeError HasParent
+------------------------------------------------------------------------
+mkNodeWithParent NodeFolder (Just i) uId name = 
+   insertNodesWithParentR (Just i) [node NodeFolder name hd Nothing uId]
+    where
+      hd = defaultFolder
+
+mkNodeWithParent NodeFolderPrivate (Just i) uId _ = 
+   insertNodesWithParentR (Just i) [node NodeFolderPrivate "Private" hd Nothing uId]
+    where
+      hd = defaultFolder
+
+mkNodeWithParent NodeFolderShared (Just i) uId _ = 
+   insertNodesWithParentR (Just i) [node NodeFolderShared "Shared" hd Nothing uId]
+    where
+      hd = defaultFolder
+
+mkNodeWithParent NodeFolderPublic (Just i) uId _ = 
+   insertNodesWithParentR (Just i) [node NodeFolderPublic "Public" hd Nothing uId]
+    where
+      hd = defaultFolder
+
+mkNodeWithParent NodeTeam (Just i) uId _ = 
+   insertNodesWithParentR (Just i) [node NodeTeam "Team" hd Nothing uId]
+    where
+      hd = defaultFolder
+------------------------------------------------------------------------
+mkNodeWithParent NodeCorpus (Just i) uId name =
+   insertNodesWithParentR (Just i) [node NodeCorpus name hd Nothing uId]
+    where
+      hd = defaultCorpus
+
+mkNodeWithParent NodeAnnuaire (Just i) uId name =
+   insertNodesWithParentR (Just i) [node NodeAnnuaire name hd Nothing uId]
+    where
+      hd = defaultAnnuaire
+
+mkNodeWithParent _ _ _ _       = nodeError NotImplYet
+------------------------------------------------------------------------
+-- =================================================================== --
 
-type Name = Text
 
-mk'' :: HasNodeError err => NodeType -> Maybe ParentId -> UserId -> Name -> Cmd err [NodeId]
-mk'' NodeUser Nothing uId name  = mk' NodeUser uId Nothing name
-mk'' NodeUser _       _   _     = nodeError UserNoParent
-mk'' _        Nothing _   _     = nodeError HasParent
-mk'' nt       pId     uId name  = mk' nt uId pId name
 
 mkRoot :: HasNodeError err => Username -> UserId -> Cmd err [RootId]
 mkRoot uname uId = case uId > 0 of
                False -> nodeError NegativeId
-               True  -> mk'' NodeUser Nothing uId uname
+               True  -> do
+                 rs <- mkNodeWithParent NodeUser Nothing uId uname
+                 _ <- case rs of
+                   [r] -> do
+                     _ <- mkNodeWithParent NodeFolderPrivate (Just r) uId uname
+                     _ <- mkNodeWithParent NodeFolderShared  (Just r) uId uname
+                     _ <- mkNodeWithParent NodeFolderPublic  (Just r) uId uname
+                     pure rs
+                   _   -> pure rs
+                 pure rs
+
+-- |
+-- CorpusDocument is a corpus made from a set of documents
+-- CorpusContact  is a corpus made from a set of contacts (syn of Annuaire)
+data CorpusType = CorpusDocument | CorpusContact
+
+class MkCorpus a
+  where
+    mk :: Maybe Name -> Maybe a -> ParentId -> UserId -> Cmd err [NodeId]
+
+instance MkCorpus HyperdataCorpus
+  where
+    mk n h p u = insertNodesR [nodeCorpusW n h p u]
 
-mkCorpus :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> Cmd err [CorpusId]
-mkCorpus n h p u = insertNodesR [nodeCorpusW n h p u]
 
-getOrMkList :: HasNodeError err => ParentId -> UserId -> Cmd err NodeId
+instance MkCorpus HyperdataAnnuaire
+  where
+    mk n h p u = insertNodesR [nodeAnnuaireW n h p u]
+
+
+getOrMkList :: HasNodeError err => ParentId -> UserId -> Cmd err ListId
 getOrMkList pId uId =
   maybe (mkList' pId uId) (pure . view node_id) . headMay =<< getListsWithParentId pId
     where
-      mkList' pId uId = maybe (nodeError MkNode) pure . headMay =<< mkList pId uId
+      mkList' pId uId = maybe (nodeError MkNode) pure . headMay =<< mkNode NodeList pId uId
 
 -- | TODO remove defaultList
 defaultList :: HasNodeError err => CorpusId -> Cmd err ListId
 defaultList cId =
   maybe (nodeError NoListFound) (pure . view node_id) . headMay =<< getListsWithParentId cId
 
-mkList :: HasNodeError err => ParentId -> UserId -> Cmd err [NodeId]
-mkList p u = insertNodesR [nodeListW Nothing Nothing p u]
-
-mkGraph :: ParentId -> UserId -> Cmd err [GraphId]
-mkGraph p u = insertNodesR [nodeGraphW Nothing Nothing p u]
+mkNode :: NodeType -> ParentId -> UserId -> Cmd err [NodeId]
+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 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
+
 
-mkAnnuaire :: ParentId -> UserId -> Cmd err [NodeId]
-mkAnnuaire p u = insertNodesR [nodeAnnuaireW Nothing Nothing p u]
+mkPhylo :: ParentId -> UserId -> Cmd err [NodeId]
+mkPhylo p u = insertNodesR [nodePhyloW Nothing Nothing p u]
 
 -- | Default CorpusId Master and ListId Master
 
 pgNodeId :: NodeId -> Column PGInt4
 pgNodeId = pgInt4 . id2int
+
+getListsWithParentId :: NodeId -> Cmd err [Node HyperdataList]
+getListsWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeList)
+
+
+-- import Gargantext.Database.Node.UpdateOpaleye (updateHyperdata)
+-- updateNodeUser_fake :: NodeId -> Cmd err Int64
+-- updateNodeUser_fake n = updateHyperdata n fake_HyperdataUser
+
+