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