src/Gargantext/Database/Schema/Node.hs

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