src/Gargantext/Database/Node.hs

   1 {-|
   2 Module      : Gargantext.Database.Node
   3 Description : Main requests of Node to the database
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9 -}
  10
  11 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
  12 {-# OPTIONS_GHC -fno-warn-orphans        #-}
  13
  14 {-# LANGUAGE Arrows                 #-}
  15 {-# LANGUAGE DeriveGeneric          #-}
  16 {-# LANGUAGE ConstraintKinds        #-}
  17 {-# LANGUAGE FlexibleContexts       #-}
  18 {-# LANGUAGE FlexibleInstances      #-}
  19 {-# LANGUAGE FunctionalDependencies #-}
  20 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  21 {-# LANGUAGE OverloadedStrings #-}
  22 {-# LANGUAGE MultiParamTypeClasses  #-}
  23 {-# LANGUAGE NoImplicitPrelude      #-}
  24 {-# LANGUAGE TemplateHaskell        #-}
  25
  26 module Gargantext.Database.Node where
  27
  28 import Data.Text (pack)
  29 import GHC.Int (Int64)
  30 import Control.Lens (set)
  31 import Data.Maybe
  32 import Data.Time (UTCTime)
  33 import Database.PostgreSQL.Simple.FromField (FromField, fromField)
  34 import Prelude hiding (null, id, map, sum)
  35
  36 import Gargantext.Core (Lang(..))
  37 import Gargantext.Core.Types
  38 import Gargantext.Core.Types.Individu (Username)
  39 import Gargantext.Database.Utils (fromField')
  40 import Gargantext.Database.Types.Node (NodeType, defaultCorpus, Hyperdata)
  41 import Gargantext.Database.Queries
  42 import Gargantext.Database.Config (nodeTypeId)
  43 import Gargantext.Prelude hiding (sum)
  44
  45 import Control.Applicative (Applicative)
  46 import Control.Arrow (returnA)
  47 import Control.Lens.TH (makeLensesWith, abbreviatedFields)
  48 import Control.Monad.IO.Class
  49 import Control.Monad.Reader
  50 import Data.Aeson
  51 import Data.Maybe (Maybe, fromMaybe)
  52 import Data.Text (Text)
  53 import Data.Profunctor.Product.TH (makeAdaptorAndInstance)
  54
  55 import qualified Data.ByteString      as DB
  56 import qualified Data.ByteString.Lazy as DBL
  57 import Data.ByteString (ByteString)
  58
  59 import Database.PostgreSQL.Simple (Connection)
  60 import Opaleye hiding (FromField)
  61 import Opaleye.Internal.QueryArr (Query)
  62 import qualified Data.Profunctor.Product as PP
  63
  64 ------------------------------------------------------------------------
  65 ------------------------------------------------------------------------
  66 {- | Reader Monad reinvented here:
  67
  68 newtype Cmd a = Cmd { unCmd :: Connection -> IO a }
  69
  70 instance Monad Cmd where
  71   return a = Cmd $ \_ -> return a
  72
  73   m >>= f = Cmd $ \c -> do
  74     a <- unCmd m c
  75     unCmd (f a) c
  76 -}
  77 newtype Cmd a = Cmd (ReaderT Connection IO a)
  78   deriving (Functor, Applicative, Monad, MonadReader Connection, MonadIO)
  79
  80 runCmd :: Connection -> Cmd a -> IO a
  81 runCmd c (Cmd f) = runReaderT f c
  82
  83 mkCmd :: (Connection -> IO a) -> Cmd a
  84 mkCmd = Cmd . ReaderT
  85
  86 ------------------------------------------------------------------------
  87 type CorpusId   = Int
  88 type AnnuaireId = Int
  89
  90 type DocId  = Int
  91 type UserId = Int
  92 type TypeId = Int
  93 ------------------------------------------------------------------------
  94 instance FromField HyperdataAny
  95   where
  96     fromField = fromField'
  97
  98 instance FromField HyperdataCorpus
  99   where
 100     fromField = fromField'
 101
 102 instance FromField HyperdataDocument
 103   where
 104     fromField = fromField'
 105
 106 instance FromField HyperdataDocumentV3
 107   where
 108     fromField = fromField'
 109
 110 instance FromField HyperdataUser
 111   where
 112     fromField = fromField'
 113
 114 instance FromField HyperdataList
 115   where
 116     fromField = fromField'
 117
 118 instance FromField HyperdataAnnuaire
 119   where
 120     fromField = fromField'
 121 ------------------------------------------------------------------------
 122 instance QueryRunnerColumnDefault PGJsonb HyperdataAny
 123   where
 124     queryRunnerColumnDefault = fieldQueryRunnerColumn
 125
 126 instance QueryRunnerColumnDefault PGJsonb HyperdataDocument
 127   where
 128     queryRunnerColumnDefault = fieldQueryRunnerColumn
 129
 130 instance QueryRunnerColumnDefault PGJsonb HyperdataDocumentV3
 131   where
 132     queryRunnerColumnDefault = fieldQueryRunnerColumn
 133
 134 instance QueryRunnerColumnDefault PGJsonb HyperdataCorpus
 135   where
 136     queryRunnerColumnDefault = fieldQueryRunnerColumn
 137
 138 instance QueryRunnerColumnDefault PGJsonb HyperdataUser
 139   where
 140     queryRunnerColumnDefault = fieldQueryRunnerColumn
 141
 142 instance QueryRunnerColumnDefault PGJsonb HyperdataList
 143   where
 144     queryRunnerColumnDefault = fieldQueryRunnerColumn
 145
 146 instance QueryRunnerColumnDefault PGJsonb HyperdataAnnuaire
 147   where
 148     queryRunnerColumnDefault = fieldQueryRunnerColumn
 149 ------------------------------------------------------------------------
 150
 151 $(makeAdaptorAndInstance "pNode" ''NodePoly)
 152 $(makeLensesWith abbreviatedFields ''NodePoly)
 153
 154
 155 nodeTable :: Table NodeWrite NodeRead
 156 nodeTable = Table "nodes" (pNode Node { _node_id                = optional "id"
 157                                         , _node_typename        = required "typename"
 158                                         , _node_userId          = required "user_id"
 159                                         , _node_parentId        = required "parent_id"
 160                                         , _node_name            = required "name"
 161                                         , _node_date            = optional "date"
 162                                         , _node_hyperdata       = required "hyperdata"
 163                      --                   , node_titleAbstract   = optional "title_abstract"
 164                                         }
 165                             )
 166
 167
 168 nodeTable' :: Table (Maybe (Column PGInt4)
 169                     ,       Column PGInt4
 170                     ,       Column PGInt4
 171                     ,Maybe (Column PGInt4)
 172                     ,       Column PGText
 173                     ,Maybe (Column PGTimestamptz)
 174                     ,       Column PGJsonb
 175                     )
 176                     ((Column PGInt4)
 177                     ,       Column PGInt4
 178                     ,       Column PGInt4
 179                     ,       Column PGInt4
 180                     ,       Column PGText
 181                     ,(Column PGTimestamptz)
 182                     ,       Column PGJsonb
 183                     )
 184
 185 nodeTable' = Table "nodes" (PP.p7 ( optional "id"
 186                                , required "typename"
 187                                , required "user_id"
 188                                , optional "parent_id"
 189                                , required "name"
 190                                , optional "date"
 191                                , required "hyperdata"
 192                                )
 193                             )
 194
 195
 196 queryNodeTable :: Query NodeRead
 197 queryNodeTable = queryTable nodeTable
 198
 199 selectNode :: Column PGInt4 -> Query NodeRead
 200 selectNode id = proc () -> do
 201     row <- queryNodeTable -< ()
 202     restrict -< _node_id row .== id
 203     returnA -< row
 204
 205 runGetNodes :: Query NodeRead -> Cmd [NodeAny]
 206 runGetNodes q = mkCmd $ \conn -> runQuery conn q
 207
 208 ------------------------------------------------------------------------
 209 ------------------------------------------------------------------------
 210
 211 -- | order by publication date
 212 -- Favorites (Bool), node_ngrams
 213 selectNodesWith :: ParentId     -> Maybe NodeType
 214                 -> Maybe Offset -> Maybe Limit   -> Query NodeRead
 215 selectNodesWith parentId maybeNodeType maybeOffset maybeLimit =
 216         --offset' maybeOffset $ limit' maybeLimit $ orderBy (asc (hyperdataDocument_Publication_date . node_hyperdata)) $ selectNodesWith' parentId typeId
 217   limit' maybeLimit $ offset' maybeOffset
 218                     $ orderBy (asc _node_id)
 219                     $ selectNodesWith' parentId maybeNodeType
 220
 221 selectNodesWith' :: ParentId -> Maybe NodeType -> Query NodeRead
 222 selectNodesWith' parentId maybeNodeType = proc () -> do
 223     node <- (proc () -> do
 224       row@(Node _ typeId _ parentId' _ _ _) <- queryNodeTable -< ()
 225       restrict -< parentId' .== (toNullable $ pgInt4 parentId)
 226
 227       let typeId' = maybe 0 nodeTypeId maybeNodeType
 228
 229       restrict -< if typeId' > 0
 230                      then typeId   .== (pgInt4 (typeId' :: Int))
 231                      else (pgBool True)
 232       returnA  -< row ) -< ()
 233     returnA -< node
 234
 235
 236 --type Cmd' a = forall m. (MonadReader env m, HasConnection env, MonadIO m) => m a
 237
 238
 239 -- deleteNode :: (MonadReader Connection m, MonadIO m) => Int -> m Int
 240 -- deleteNode :: Int -> Cmd' Int
 241
 242 deleteNode :: Int -> Cmd Int
 243 deleteNode n = mkCmd $ \conn ->
 244   fromIntegral <$> runDelete conn nodeTable
 245                  (\(Node n_id _ _ _ _ _ _) -> n_id .== pgInt4 n)
 246
 247 deleteNodes :: [Int] -> Cmd Int
 248 deleteNodes ns = mkCmd $ \conn ->
 249   fromIntegral <$> runDelete conn nodeTable
 250                    (\(Node n_id _ _ _ _ _ _) -> in_ ((map pgInt4 ns)) n_id)
 251
 252
 253 getNodesWith :: JSONB a => Connection -> Int -> proxy a -> Maybe NodeType
 254              -> Maybe Offset -> Maybe Limit -> IO [Node a]
 255 getNodesWith conn parentId _ nodeType maybeOffset maybeLimit =
 256     runQuery conn $ selectNodesWith parentId nodeType maybeOffset maybeLimit
 257
 258
 259 -- NP check type
 260 getNodesWithParentId :: Int
 261                      -> Maybe Text -> Connection -> IO [NodeAny]
 262 getNodesWithParentId n _ conn = runQuery conn $ selectNodesWithParentID n
 263
 264 getNodesWithParentId' :: Int
 265                      -> Maybe Text -> Connection -> IO [NodeAny]
 266 getNodesWithParentId' n _ conn = runQuery conn $ selectNodesWithParentID n
 267
 268
 269 ------------------------------------------------------------------------
 270 getDocumentsV3WithParentId :: Connection -> Int -> IO [Node HyperdataDocumentV3]
 271 getDocumentsV3WithParentId conn n = runQuery conn $ selectNodesWith' n (Just NodeDocument)
 272
 273 getDocumentsWithParentId :: Connection -> Int -> IO [Node HyperdataDocument]
 274 getDocumentsWithParentId conn n = runQuery conn $ selectNodesWith' n (Just NodeDocument)
 275
 276 getListsWithParentId :: Connection -> Int -> IO [Node HyperdataList]
 277 getListsWithParentId conn n = runQuery conn $ selectNodesWith' n (Just NodeList)
 278
 279 ------------------------------------------------------------------------
 280 selectNodesWithParentID :: Int -> Query NodeRead
 281 selectNodesWithParentID n = proc () -> do
 282     row@(Node _ _ _ parent_id _ _ _) <- queryNodeTable -< ()
 283     restrict -< if n > 0
 284       then parent_id .== (toNullable $ pgInt4 n)
 285       else isNull parent_id
 286     returnA -< row
 287
 288 selectNodesWithType :: Column PGInt4 -> Query NodeRead
 289 selectNodesWithType type_id = proc () -> do
 290     row@(Node _ tn _ _ _ _ _) <- queryNodeTable -< ()
 291     restrict -< tn .== type_id
 292     returnA -< row
 293
 294 type JSONB = QueryRunnerColumnDefault PGJsonb
 295
 296 getNode :: JSONB a => Connection -> Int -> proxy a -> IO (Node a)
 297 getNode conn id _ = do
 298     fromMaybe (error $ "Node does node exist: " <> show id) . headMay <$> runQuery conn (limit 1 $ selectNode (pgInt4 id))
 299
 300 getNodesWithType :: Connection -> Column PGInt4 -> IO [Node HyperdataDocument]
 301 getNodesWithType conn type_id = do
 302     runQuery conn $ selectNodesWithType type_id
 303
 304 ------------------------------------------------------------------------
 305 -- WIP
 306 -- TODO Classe HasDefault where
 307 -- default NodeType = Hyperdata
 308 ------------------------------------------------------------------------
 309 type NodeWrite' = NodePoly (Maybe Int) Int Int (Maybe ParentId) Text (Maybe UTCTime) ByteString
 310 ------------------------------------------------------------------------
 311 defaultUser :: HyperdataUser
 312 defaultUser = HyperdataUser (Just $ (pack . show) EN)
 313
 314 nodeUserW :: Maybe Name -> Maybe HyperdataUser -> UserId -> NodeWrite'
 315 nodeUserW maybeName maybeHyperdata = node NodeUser name user Nothing
 316   where
 317     name = maybe "User" identity maybeName
 318     user = maybe defaultUser identity maybeHyperdata
 319 ------------------------------------------------------------------------
 320 defaultFolder :: HyperdataFolder
 321 defaultFolder = HyperdataFolder (Just "Markdown Description")
 322
 323 nodeFolderW :: Maybe Name -> Maybe HyperdataFolder -> ParentId -> UserId -> NodeWrite'
 324 nodeFolderW maybeName maybeFolder pid = node NodeFolder name folder (Just pid)
 325   where
 326     name   = maybe "Folder" identity maybeName
 327     folder = maybe defaultFolder identity maybeFolder
 328 ------------------------------------------------------------------------
 329 nodeCorpusW :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> NodeWrite'
 330 nodeCorpusW maybeName maybeCorpus pId = node NodeCorpus name corpus (Just pId)
 331   where
 332     name   = maybe "Corpus" identity maybeName
 333     corpus = maybe defaultCorpus identity maybeCorpus
 334                    --------------------------
 335 defaultDocument :: HyperdataDocument
 336 defaultDocument = hyperdataDocument
 337
 338 nodeDocumentW :: Maybe Name -> Maybe HyperdataDocument -> CorpusId -> UserId -> NodeWrite'
 339 nodeDocumentW maybeName maybeDocument cId = node NodeDocument name doc (Just cId)
 340   where
 341     name = maybe "Document" identity maybeName
 342     doc  = maybe defaultDocument identity maybeDocument
 343 ------------------------------------------------------------------------
 344 defaultAnnuaire :: HyperdataAnnuaire
 345 defaultAnnuaire = HyperdataAnnuaire (Just "Title") (Just "Description")
 346
 347 nodeAnnuaireW :: Maybe Name -> Maybe HyperdataAnnuaire -> ParentId -> UserId -> NodeWrite'
 348 nodeAnnuaireW maybeName maybeAnnuaire pId = node NodeAnnuaire name annuaire (Just pId)
 349   where
 350     name     = maybe "Annuaire" identity maybeName
 351     annuaire = maybe defaultAnnuaire identity maybeAnnuaire
 352                    --------------------------
 353
 354 ------------------------------------------------------------------------
 355 arbitraryList :: HyperdataList
 356 arbitraryList = HyperdataList (Just "Preferences")
 357
 358 nodeListW :: Maybe Name -> Maybe HyperdataList -> ParentId -> UserId -> NodeWrite'
 359 nodeListW maybeName maybeList pId = node NodeList name list (Just pId)
 360   where
 361     name = maybe "Listes" identity maybeName
 362     list = maybe arbitraryList identity maybeList
 363
 364 ------------------------------------------------------------------------
 365 arbitraryGraph :: HyperdataGraph
 366 arbitraryGraph = HyperdataGraph (Just "Preferences")
 367
 368 nodeGraphW :: Maybe Name -> Maybe HyperdataGraph -> ParentId -> UserId -> NodeWrite'
 369 nodeGraphW maybeName maybeGraph pId = node NodeGraph name graph (Just pId)
 370   where
 371     name = maybe "Graph" identity maybeName
 372     graph = maybe arbitraryGraph identity maybeGraph
 373
 374 ------------------------------------------------------------------------
 375
 376 arbitraryDashboard :: HyperdataDashboard
 377 arbitraryDashboard = HyperdataDashboard (Just "Preferences")
 378
 379 nodeDashboardW :: Maybe Name -> Maybe HyperdataDashboard -> ParentId -> UserId -> NodeWrite'
 380 nodeDashboardW maybeName maybeDashboard pId = node NodeDashboard name dashboard (Just pId)
 381   where
 382     name = maybe "Dashboard" identity maybeName
 383     dashboard = maybe arbitraryDashboard identity maybeDashboard
 384
 385
 386
 387 ------------------------------------------------------------------------
 388 node :: (ToJSON a, Hyperdata a) => NodeType -> Name -> a -> Maybe ParentId -> UserId -> NodeWrite'
 389 node nodeType name hyperData parentId userId = Node Nothing typeId userId parentId name Nothing byteData
 390   where
 391     typeId = nodeTypeId nodeType
 392     byteData = DB.pack . DBL.unpack $ encode hyperData
 393
 394                   -------------------------------
 395 node2row :: (Functor maybe1, Functor maybe2, Functor maybe3) =>
 396               NodePoly (maybe2 Int)                      Int            Int  (maybe1           Int)
 397                                 Text        (maybe3 UTCTime)             ByteString
 398                     -> (maybe2 (Column PGInt4), Column PGInt4, Column PGInt4, maybe1 (Column PGInt4)
 399                      , Column PGText, maybe3 (Column PGTimestamptz), Column PGJsonb)
 400 node2row (Node id tn ud pid nm dt hp) = ((pgInt4    <$> id)
 401                                         ,(pgInt4        tn)
 402                                         ,(pgInt4        ud)
 403                                         ,(pgInt4   <$> pid)
 404                                         ,(pgStrictText  nm)
 405                                         ,(pgUTCTime <$> dt)
 406                                         ,(pgStrictJSONB hp)
 407                                         )
 408 ------------------------------------------------------------------------
 409 insertNodesR' :: [NodeWrite'] -> Cmd [Int]
 410 insertNodesR' ns = mkCmd $ \c -> insertNodesR ns c
 411
 412 insertNodes :: [NodeWrite'] -> Connection -> IO Int64
 413 insertNodes ns conn = runInsertMany conn nodeTable' (map node2row ns)
 414
 415 insertNodesR :: [NodeWrite'] -> Connection -> IO [Int]
 416 insertNodesR ns conn = runInsertManyReturning conn nodeTable' (map node2row ns) (\(i,_,_,_,_,_,_) -> i)
 417                        -------------------------
 418 insertNodesWithParent :: Maybe ParentId -> [NodeWrite'] -> Connection -> IO Int64
 419 insertNodesWithParent pid ns conn = insertNodes (map (set node_parentId pid) ns) conn
 420
 421 insertNodesWithParentR :: Maybe ParentId -> [NodeWrite'] -> Connection -> IO [Int]
 422 insertNodesWithParentR pid ns conn = insertNodesR (map (set node_parentId pid) ns) conn
 423 ------------------------------------------------------------------------
 424 -- TODO Hierachy of Nodes
 425 -- post and get same types Node' and update if changes
 426
 427 {- TODO semantic to achieve
 428 post c uid pid [ Node' NodeCorpus "name" "{}" []
 429                , Node' NodeFolder "name" "{}" [Node' NodeCorpus "test 2" "" [ Node' NodeDocument "title" "metaData" []
 430                                                                     , Node' NodeDocument "title" "jsonData" []
 431                                                                     ]
 432                                           ]
 433                ]
 434 -}
 435 ------------------------------------------------------------------------
 436
 437 -- TODO
 438 -- currently this function remove the child relation
 439 -- needs a Temporary type between Node' and NodeWriteT
 440 node2table :: UserId -> Maybe ParentId -> Node' -> NodeWriteT
 441 node2table uid pid (Node' nt txt v []) = ( Nothing, (pgInt4$ nodeTypeId nt), (pgInt4 uid), (fmap pgInt4 pid)
 442                                          , pgStrictText txt, Nothing, pgStrictJSONB $ DB.pack $ DBL.unpack $ encode v)
 443 node2table _ _ (Node' _ _ _ _) = panic "node2table: should not happen, Tree insert not implemented yet"
 444
 445
 446 data Node' = Node' { _n_type :: NodeType
 447                    , _n_name :: Text
 448                    , _n_data :: Value
 449                    , _n_children :: [Node']
 450                    } deriving (Show)
 451
 452
 453 type NodeWriteT =  ( Maybe (Column PGInt4)
 454                    ,        Column PGInt4
 455                    ,        Column PGInt4
 456                    , Maybe (Column PGInt4)
 457                    ,        Column PGText
 458                    , Maybe (Column PGTimestamptz)
 459                    ,        Column PGJsonb
 460                    )
 461
 462
 463 mkNode' :: [NodeWriteT] -> Cmd Int64
 464 mkNode' ns = mkCmd $ \conn -> runInsertMany conn nodeTable' ns
 465
 466 mkNodeR' :: [NodeWriteT] -> Cmd [Int]
 467 mkNodeR' ns = mkCmd $ \conn -> runInsertManyReturning conn nodeTable' ns (\(i,_,_,_,_,_,_) -> i)
 468
 469 ------------------------------------------------------------------------
 470
 471 data NewNode = NewNode { _newNodeId :: Int
 472                        , _newNodeChildren :: [Int] }
 473
 474 -- | postNode
 475 postNode :: UserId -> Maybe ParentId -> Node' -> Cmd NewNode
 476 postNode uid pid (Node' nt txt v []) = do
 477   pids <- mkNodeR' [node2table uid pid (Node' nt txt v [])]
 478   case pids of
 479     [pid] -> pure $ NewNode pid []
 480     _ -> panic "postNode: only one pid expected"
 481
 482 postNode uid pid (Node' NodeCorpus txt v ns) = do
 483   NewNode pid' _ <- postNode uid pid (Node' NodeCorpus txt v [])
 484   pids  <- mkNodeR' (concat $ map (\n -> [childWith uid pid' n]) ns)
 485   pure $ NewNode pid' pids
 486
 487 postNode uid pid (Node' NodeAnnuaire txt v ns) = do
 488   NewNode pid' _ <- postNode uid pid (Node' NodeAnnuaire txt v [])
 489   pids  <- mkNodeR' (concat $ map (\n -> [childWith uid pid' n]) ns)
 490   pure $ NewNode pid' pids
 491 postNode _ _ (Node' _ _ _ _) = panic "TODO: postNode for this type not implemented yet"
 492
 493
 494 childWith :: UserId -> ParentId -> Node' -> NodeWriteT
 495 childWith uId pId (Node' NodeDocument txt v []) = node2table uId (Just pId) (Node' NodeDocument txt v [])
 496 childWith uId pId (Node' NodeContact  txt v []) = node2table uId (Just pId) (Node' NodeContact txt v [])
 497 childWith _   _   (Node' _        _   _ _) = panic "This NodeType can not be a child"
 498
 499
 500 -- TODO: remove hardcoded userId (with Reader)
 501 -- TODO: user Reader in the API and adapt this function
 502 userId :: Int
 503 userId = 1
 504
 505 mk :: Connection -> NodeType -> Maybe ParentId -> Text -> IO [Int]
 506 mk c nt pId name  = mk' c nt userId pId name
 507
 508 mk' :: Connection -> NodeType -> UserId -> Maybe ParentId -> Text -> IO [Int]
 509 mk' c nt uId pId name  = map fromIntegral <$> insertNodesWithParentR pId [node nt name hd pId uId] c
 510   where
 511     hd = HyperdataUser . Just . pack $ show EN
 512
 513 type Name = Text
 514
 515 mk'' :: NodeType -> Maybe ParentId -> UserId -> Name -> Cmd [Int]
 516 mk'' NodeUser Nothing uId name  = mkCmd $ \c -> mk' c NodeUser uId Nothing name
 517 mk'' NodeUser _       _   _     = panic "NodeUser do not have any parent"
 518 mk'' _        Nothing _   _     = panic "NodeType does   have a   parent"
 519 mk'' nt       pId     uId name  = mkCmd $ \c -> mk' c nt uId pId name
 520
 521
 522 mkRoot :: Username -> UserId -> Cmd [Int]
 523 mkRoot uname uId = case uId > 0 of
 524                False -> panic "UserId <= 0"
 525                True  -> mk'' NodeUser Nothing uId uname
 526
 527 mkCorpus :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> Cmd [Int]
 528 mkCorpus n h p u = insertNodesR' [nodeCorpusW n h p u]
 529
 530 mkList :: ParentId -> UserId -> Cmd [Int]
 531 mkList p u = insertNodesR' [nodeListW Nothing Nothing p u]
 532
 533 mkGraph :: ParentId -> UserId -> Cmd [Int]
 534 mkGraph p u = insertNodesR' [nodeGraphW Nothing Nothing p u]
 535
 536 mkDashboard :: ParentId -> UserId -> Cmd [Int]
 537 mkDashboard p u = insertNodesR' [nodeDashboardW Nothing Nothing p u]
 538
 539 mkAnnuaire :: ParentId -> UserId -> Cmd [Int]
 540 mkAnnuaire p u = insertNodesR' [nodeAnnuaireW Nothing Nothing p u]
 541
 542 -- | Default CorpusId Master and ListId Master
 543