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 selectRootUsername :: Username -> Query NodeRead
 211 selectRootUsername username = proc () -> do
 212     row <- queryNodeTable -< ()
 213     restrict -< _node_typename row .== (pgInt4 $ nodeTypeId NodeUser)
 214     restrict -< _node_name   row .== (pgStrictText username)
 215     returnA -< row
 216
 217 getRootUsername :: Username -> Connection -> IO [Node HyperdataUser]
 218 getRootUsername uname conn = runQuery conn (selectRootUsername uname)
 219
 220 ------------------------------------------------------------------------
 221 selectRootUser :: UserId -> Query NodeRead
 222 selectRootUser userId = proc () -> do
 223     row <- queryNodeTable -< ()
 224     restrict -< _node_userId   row .== (pgInt4 userId)
 225     restrict -< _node_typename row .== (pgInt4 $ nodeTypeId NodeUser)
 226     returnA -< row
 227
 228 getRoot :: UserId -> Cmd [Node HyperdataUser]
 229 getRoot userId = mkCmd $ \conn -> runQuery conn (selectRootUser userId)
 230 ------------------------------------------------------------------------
 231
 232 -- | order by publication date
 233 -- Favorites (Bool), node_ngrams
 234 selectNodesWith :: ParentId     -> Maybe NodeType
 235                 -> Maybe Offset -> Maybe Limit   -> Query NodeRead
 236 selectNodesWith parentId maybeNodeType maybeOffset maybeLimit =
 237         --offset' maybeOffset $ limit' maybeLimit $ orderBy (asc (hyperdataDocument_Publication_date . node_hyperdata)) $ selectNodesWith' parentId typeId
 238         limit' maybeLimit $ offset' maybeOffset $ orderBy (asc _node_id) $ selectNodesWith' parentId maybeNodeType
 239
 240 selectNodesWith' :: ParentId -> Maybe NodeType -> Query NodeRead
 241 selectNodesWith' parentId maybeNodeType = proc () -> do
 242     node <- (proc () -> do
 243       row@(Node _ typeId _ parentId' _ _ _) <- queryNodeTable -< ()
 244       restrict -< parentId' .== (toNullable $ pgInt4 parentId)
 245
 246       let typeId' = maybe 0 nodeTypeId maybeNodeType
 247
 248       restrict -< if typeId' > 0
 249                      then typeId   .== (pgInt4 (typeId' :: Int))
 250                      else (pgBool True)
 251       returnA  -< row ) -< ()
 252     returnA -< node
 253
 254
 255 --type Cmd' a = forall m. (MonadReader env m, HasConnection env, MonadIO m) => m a
 256
 257
 258 -- deleteNode :: (MonadReader Connection m, MonadIO m) => Int -> m Int
 259 -- deleteNode :: Int -> Cmd' Int
 260
 261 deleteNode :: Int -> Cmd Int
 262 deleteNode n = mkCmd $ \conn ->
 263   fromIntegral <$> runDelete conn nodeTable
 264                  (\(Node n_id _ _ _ _ _ _) -> n_id .== pgInt4 n)
 265
 266 deleteNodes :: [Int] -> Cmd Int
 267 deleteNodes ns = mkCmd $ \conn ->
 268   fromIntegral <$> runDelete conn nodeTable
 269                    (\(Node n_id _ _ _ _ _ _) -> in_ ((map pgInt4 ns)) n_id)
 270
 271
 272 getNodesWith :: JSONB a => Connection -> Int -> proxy a -> Maybe NodeType
 273              -> Maybe Offset -> Maybe Limit -> IO [Node a]
 274 getNodesWith conn parentId _ nodeType maybeOffset maybeLimit =
 275     runQuery conn $ selectNodesWith
 276                   parentId nodeType maybeOffset maybeLimit
 277
 278
 279 -- NP check type
 280 getNodesWithParentId :: Int
 281                      -> Maybe Text -> Connection -> IO [NodeAny]
 282 getNodesWithParentId n _ conn = runQuery conn $ selectNodesWithParentID n
 283
 284 getNodesWithParentId' :: Int
 285                      -> Maybe Text -> Connection -> IO [NodeAny]
 286 getNodesWithParentId' n _ conn = runQuery conn $ selectNodesWithParentID n
 287
 288
 289 ------------------------------------------------------------------------
 290 getDocumentsV3WithParentId :: Connection -> Int -> IO [Node HyperdataDocumentV3]
 291 getDocumentsV3WithParentId conn n = runQuery conn $ selectNodesWith' n (Just NodeDocument)
 292
 293 getDocumentsWithParentId :: Connection -> Int -> IO [Node HyperdataDocument]
 294 getDocumentsWithParentId conn n = runQuery conn $ selectNodesWith' n (Just NodeDocument)
 295
 296 getListsWithParentId :: Connection -> Int -> IO [Node HyperdataList]
 297 getListsWithParentId conn n = runQuery conn $ selectNodesWith' n (Just NodeList)
 298
 299 ------------------------------------------------------------------------
 300 selectNodesWithParentID :: Int -> Query NodeRead
 301 selectNodesWithParentID n = proc () -> do
 302     row@(Node _ _ _ parent_id _ _ _) <- queryNodeTable -< ()
 303     restrict -< if n > 0
 304       then parent_id .== (toNullable $ pgInt4 n)
 305       else isNull parent_id
 306     returnA -< row
 307
 308 selectNodesWithType :: Column PGInt4 -> Query NodeRead
 309 selectNodesWithType type_id = proc () -> do
 310     row@(Node _ tn _ _ _ _ _) <- queryNodeTable -< ()
 311     restrict -< tn .== type_id
 312     returnA -< row
 313
 314 type JSONB = QueryRunnerColumnDefault PGJsonb
 315
 316 getNode :: JSONB a => Connection -> Int -> proxy a -> IO (Node a)
 317 getNode conn id _ = do
 318     fromMaybe (error $ "Node does node exist: " <> show id) . headMay <$> runQuery conn (limit 1 $ selectNode (pgInt4 id))
 319
 320 getNodesWithType :: Connection -> Column PGInt4 -> IO [Node HyperdataDocument]
 321 getNodesWithType conn type_id = do
 322     runQuery conn $ selectNodesWithType type_id
 323
 324 ------------------------------------------------------------------------
 325 -- WIP
 326 -- TODO Classe HasDefault where
 327 -- default NodeType = Hyperdata
 328 ------------------------------------------------------------------------
 329 type NodeWrite' = NodePoly (Maybe Int) Int Int (Maybe ParentId) Text (Maybe UTCTime) ByteString
 330 ------------------------------------------------------------------------
 331 defaultUser :: HyperdataUser
 332 defaultUser = HyperdataUser (Just $ (pack . show) EN)
 333
 334 nodeUserW :: Maybe Name -> Maybe HyperdataUser -> UserId -> NodeWrite'
 335 nodeUserW maybeName maybeHyperdata = node NodeUser name user Nothing
 336   where
 337     name = maybe "User" identity maybeName
 338     user = maybe defaultUser identity maybeHyperdata
 339 ------------------------------------------------------------------------
 340 defaultFolder :: HyperdataFolder
 341 defaultFolder = HyperdataFolder (Just "Markdown Description")
 342
 343 nodeFolderW :: Maybe Name -> Maybe HyperdataFolder -> ParentId -> UserId -> NodeWrite'
 344 nodeFolderW maybeName maybeFolder pid = node NodeFolder name folder (Just pid)
 345   where
 346     name   = maybe "Folder" identity maybeName
 347     folder = maybe defaultFolder identity maybeFolder
 348 ------------------------------------------------------------------------
 349 nodeCorpusW :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> NodeWrite'
 350 nodeCorpusW maybeName maybeCorpus pId = node NodeCorpus name corpus (Just pId)
 351   where
 352     name   = maybe "Corpus" identity maybeName
 353     corpus = maybe defaultCorpus identity maybeCorpus
 354                    --------------------------
 355 defaultDocument :: HyperdataDocument
 356 defaultDocument = hyperdataDocument
 357
 358 nodeDocumentW :: Maybe Name -> Maybe HyperdataDocument -> CorpusId -> UserId -> NodeWrite'
 359 nodeDocumentW maybeName maybeDocument cId = node NodeDocument name doc (Just cId)
 360   where
 361     name = maybe "Document" identity maybeName
 362     doc  = maybe defaultDocument identity maybeDocument
 363 ------------------------------------------------------------------------
 364 defaultAnnuaire :: HyperdataAnnuaire
 365 defaultAnnuaire = HyperdataAnnuaire (Just "Title") (Just "Description")
 366
 367 nodeAnnuaireW :: Maybe Name -> Maybe HyperdataAnnuaire -> ParentId -> UserId -> NodeWrite'
 368 nodeAnnuaireW maybeName maybeAnnuaire pId = node NodeAnnuaire name annuaire (Just pId)
 369   where
 370     name     = maybe "Annuaire" identity maybeName
 371     annuaire = maybe defaultAnnuaire identity maybeAnnuaire
 372                    --------------------------
 373 defaultContact :: HyperdataContact
 374 defaultContact = HyperdataContact (Just "Name") (Just "email@here")
 375
 376 nodeContactW :: Maybe Name -> Maybe HyperdataContact -> AnnuaireId -> UserId -> NodeWrite'
 377 nodeContactW maybeName maybeContact aId = node NodeContact name contact (Just aId)
 378   where
 379     name    = maybe "Contact" identity maybeName
 380     contact = maybe defaultContact identity maybeContact
 381 ------------------------------------------------------------------------
 382 arbitraryList :: HyperdataList
 383 arbitraryList = HyperdataList (Just "Preferences")
 384
 385 nodeListW :: Maybe Name -> Maybe HyperdataList -> ParentId -> UserId -> NodeWrite'
 386 nodeListW maybeName maybeList pId = node NodeList name list (Just pId)
 387   where
 388     name = maybe "Listes" identity maybeName
 389     list = maybe arbitraryList identity maybeList
 390
 391 ------------------------------------------------------------------------
 392 node :: (ToJSON a, Hyperdata a) => NodeType -> Name -> a -> Maybe ParentId -> UserId -> NodeWrite'
 393 node nodeType name hyperData parentId userId = Node Nothing typeId userId parentId name Nothing byteData
 394   where
 395     typeId = nodeTypeId nodeType
 396     byteData = DB.pack . DBL.unpack $ encode hyperData
 397
 398                   -------------------------------
 399 node2row :: (Functor maybe1, Functor maybe2, Functor maybe3) =>
 400               NodePoly (maybe2 Int)                      Int            Int  (maybe1           Int)
 401                                 Text        (maybe3 UTCTime)             ByteString
 402                     -> (maybe2 (Column PGInt4), Column PGInt4, Column PGInt4, maybe1 (Column PGInt4)
 403                      , Column PGText, maybe3 (Column PGTimestamptz), Column PGJsonb)
 404 node2row (Node id tn ud pid nm dt hp) = ((pgInt4    <$> id)
 405                                         ,(pgInt4        tn)
 406                                         ,(pgInt4        ud)
 407                                         ,(pgInt4   <$> pid)
 408                                         ,(pgStrictText  nm)
 409                                         ,(pgUTCTime <$> dt)
 410                                         ,(pgStrictJSONB hp)
 411                                         )
 412 ------------------------------------------------------------------------
 413 insertNodesR' :: [NodeWrite'] -> Cmd [Int]
 414 insertNodesR' ns = mkCmd $ \c -> insertNodesR ns c
 415
 416 insertNodes :: [NodeWrite'] -> Connection -> IO Int64
 417 insertNodes ns conn = runInsertMany conn nodeTable' (map node2row ns)
 418
 419 insertNodesR :: [NodeWrite'] -> Connection -> IO [Int]
 420 insertNodesR ns conn = runInsertManyReturning conn nodeTable' (map node2row ns) (\(i,_,_,_,_,_,_) -> i)
 421                        -------------------------
 422 insertNodesWithParent :: Maybe ParentId -> [NodeWrite'] -> Connection -> IO Int64
 423 insertNodesWithParent pid ns conn = insertNodes (map (set node_parentId pid) ns) conn
 424
 425 insertNodesWithParentR :: Maybe ParentId -> [NodeWrite'] -> Connection -> IO [Int]
 426 insertNodesWithParentR pid ns conn = insertNodesR (map (set node_parentId pid) ns) conn
 427 ------------------------------------------------------------------------
 428 -- TODO Hierachy of Nodes
 429 -- post and get same types Node' and update if changes
 430
 431 {- TODO semantic to achieve
 432 post c uid pid [ Node' NodeCorpus "name" "{}" []
 433                , Node' NodeFolder "name" "{}" [Node' NodeCorpus "test 2" "" [ Node' NodeDocument "title" "metaData" []
 434                                                                     , Node' NodeDocument "title" "jsonData" []
 435                                                                     ]
 436                                           ]
 437                ]
 438 -}
 439 ------------------------------------------------------------------------
 440
 441 -- TODO
 442 -- currently this function remove the child relation
 443 -- needs a Temporary type between Node' and NodeWriteT
 444 node2table :: UserId -> Maybe ParentId -> Node' -> NodeWriteT
 445 node2table uid pid (Node' nt txt v []) = ( Nothing, (pgInt4$ nodeTypeId nt), (pgInt4 uid), (fmap pgInt4 pid)
 446                                          , pgStrictText txt, Nothing, pgStrictJSONB $ DB.pack $ DBL.unpack $ encode v)
 447 node2table _ _ (Node' _ _ _ _) = panic "node2table: should not happen, Tree insert not implemented yet"
 448
 449
 450 data Node' = Node' { _n_type :: NodeType
 451                    , _n_name :: Text
 452                    , _n_data :: Value
 453                    , _n_children :: [Node']
 454                    } deriving (Show)
 455
 456
 457 type NodeWriteT =  ( Maybe (Column PGInt4)
 458                    ,        Column PGInt4
 459                    ,        Column PGInt4
 460                    , Maybe (Column PGInt4)
 461                    ,        Column PGText
 462                    , Maybe (Column PGTimestamptz)
 463                    ,        Column PGJsonb
 464                    )
 465
 466
 467 mkNode' :: [NodeWriteT] -> Cmd Int64
 468 mkNode' ns = mkCmd $ \conn -> runInsertMany conn nodeTable' ns
 469
 470 mkNodeR' :: [NodeWriteT] -> Cmd [Int]
 471 mkNodeR' ns = mkCmd $ \conn -> runInsertManyReturning conn nodeTable' ns (\(i,_,_,_,_,_,_) -> i)
 472
 473 ------------------------------------------------------------------------
 474
 475 data NewNode = NewNode { _newNodeId :: Int
 476                        , _newNodeChildren :: [Int] }
 477
 478 -- | postNode
 479 postNode :: UserId -> Maybe ParentId -> Node' -> Cmd NewNode
 480 postNode uid pid (Node' nt txt v []) = do
 481   pids <- mkNodeR' [node2table uid pid (Node' nt txt v [])]
 482   case pids of
 483     [pid] -> pure $ NewNode pid []
 484     _ -> panic "postNode: only one pid expected"
 485
 486 postNode uid pid (Node' NodeCorpus txt v ns) = do
 487   NewNode pid' _ <- postNode uid pid (Node' NodeCorpus txt v [])
 488   pids  <- mkNodeR' (concat $ map (\n -> [childWith uid pid' n]) ns)
 489   pure $ NewNode pid' pids
 490
 491 postNode uid pid (Node' NodeAnnuaire txt v ns) = do
 492   NewNode pid' _ <- postNode uid pid (Node' NodeAnnuaire txt v [])
 493   pids  <- mkNodeR' (concat $ map (\n -> [childWith uid pid' n]) ns)
 494   pure $ NewNode pid' pids
 495 postNode _ _ (Node' _ _ _ _) = panic "TODO: postNode for this type not implemented yet"
 496
 497
 498 childWith :: UserId -> ParentId -> Node' -> NodeWriteT
 499 childWith uId pId (Node' NodeDocument txt v []) = node2table uId (Just pId) (Node' NodeDocument txt v [])
 500 childWith uId pId (Node' NodeContact  txt v []) = node2table uId (Just pId) (Node' NodeContact txt v [])
 501 childWith _   _   (Node' _        _   _ _) = panic "This NodeType can not be a child"
 502
 503
 504 -- TODO: remove hardcoded userId (with Reader)
 505 -- TODO: user Reader in the API and adapt this function
 506 userId :: Int
 507 userId = 1
 508
 509 mk :: Connection -> NodeType -> Maybe ParentId -> Text -> IO [Int]
 510 mk c nt pId name  = mk' c nt userId pId name
 511
 512 mk' :: Connection -> NodeType -> UserId -> Maybe ParentId -> Text -> IO [Int]
 513 mk' c nt uId pId name  = map fromIntegral <$> insertNodesWithParentR pId [node nt name hd pId uId] c
 514   where
 515     hd = HyperdataUser . Just . pack $ show EN
 516
 517 type Name = Text
 518
 519 mk'' :: NodeType -> Maybe ParentId -> UserId -> Name -> Cmd [Int]
 520 mk'' NodeUser Nothing uId name  = mkCmd $ \c -> mk' c NodeUser uId Nothing name
 521 mk'' NodeUser _       _   _     = panic "NodeUser do not have any parent"
 522 mk'' _        Nothing _   _     = panic "NodeType does   have a   parent"
 523 mk'' nt       pId     uId name  = mkCmd $ \c -> mk' c nt uId pId name
 524
 525 type Username = Text
 526
 527 mkRoot :: Username -> UserId -> Cmd [Int]
 528 mkRoot uname uId = case uId > 0 of
 529                False -> panic "UserId <= 0"
 530                True  -> mk'' NodeUser Nothing uId uname
 531
 532 mkCorpus :: Maybe Name -> Maybe HyperdataCorpus -> ParentId -> UserId -> Cmd [Int]
 533 mkCorpus n h p u = insertNodesR' [nodeCorpusW n h p u]
 534
 535 mkList :: ParentId -> UserId -> Cmd [Int]
 536 mkList p u = insertNodesR' [nodeListW Nothing Nothing p u]
 537