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