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