src/Gargantext/Database/Action/Node.hs

   1 {-|
   2 Module      : Gargantext.Database.Action.Node
   3 Description :
   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 ConstraintKinds        #-}
  16 {-# LANGUAGE FunctionalDependencies #-}
  17 {-# LANGUAGE TemplateHaskell        #-}
  18 {-# LANGUAGE TypeFamilies           #-}
  19
  20 module Gargantext.Database.Action.Node
  21   where
  22
  23 import Gargantext.Core.Types (Name)
  24 import Gargantext.Database.Admin.Types.Hyperdata
  25 import Gargantext.Database.Admin.Types.Node
  26 import Gargantext.Database.Prelude (Cmd)
  27 import Gargantext.Database.Query.Table.Node
  28 import Gargantext.Database.Query.Table.Node.Error
  29 import Gargantext.Database.Query.Table.Node.User
  30 import Gargantext.Prelude
  31 import Gargantext.Prelude.Utils (sha)
  32 import Gargantext.Database.Prelude
  33 import Control.Lens (view)
  34 import Gargantext.Config (GargConfig(..))
  35
  36 ------------------------------------------------------------------------
  37 -- | TODO mk all others nodes
  38 mkNodeWithParent :: (HasNodeError err)
  39                  => NodeType
  40                  -> Maybe ParentId
  41                  -> UserId
  42                  -> Name
  43                  -> Cmd err [NodeId]
  44 mkNodeWithParent NodeUser (Just _) _   _    = nodeError UserNoParent
  45
  46 ------------------------------------------------------------------------
  47 mkNodeWithParent NodeUser Nothing uId name =
  48   insertNodesWithParentR Nothing [node NodeUser name fake_HyperdataUser Nothing uId]
  49
  50 mkNodeWithParent _ Nothing _ _ = nodeError HasParent
  51 ------------------------------------------------------------------------
  52 mkNodeWithParent NodeFolder (Just i) uId name =
  53    insertNodesWithParentR (Just i) [node NodeFolder name hd Nothing uId]
  54     where
  55       hd = defaultFolder
  56
  57 mkNodeWithParent NodeFolderPrivate (Just i) uId _ =
  58    insertNodesWithParentR (Just i) [node NodeFolderPrivate "Private" hd Nothing uId]
  59     where
  60       hd = defaultFolder
  61
  62 mkNodeWithParent NodeFolderShared (Just i) uId _ =
  63    insertNodesWithParentR (Just i) [node NodeFolderShared "Shared" hd Nothing uId]
  64     where
  65       hd = defaultFolder
  66
  67 mkNodeWithParent NodeFolderPublic (Just i) uId _ =
  68    insertNodesWithParentR (Just i) [node NodeFolderPublic "Public" hd Nothing uId]
  69     where
  70       hd = defaultFolder
  71
  72 mkNodeWithParent NodeTeam (Just i) uId name =
  73    insertNodesWithParentR (Just i) [node NodeTeam name hd Nothing uId]
  74     where
  75       hd = defaultFolder
  76 ------------------------------------------------------------------------
  77 mkNodeWithParent NodeCorpus (Just i) uId name =
  78    insertNodesWithParentR (Just i) [node NodeCorpus name hd Nothing uId]
  79     where
  80       hd = defaultCorpus
  81
  82 mkNodeWithParent NodeAnnuaire (Just i) uId name =
  83    insertNodesWithParentR (Just i) [node NodeAnnuaire name hd Nothing uId]
  84     where
  85       hd = defaultAnnuaire
  86
  87 mkNodeWithParent NodeList (Just i) uId name =
  88    insertNodesWithParentR (Just i) [node NodeList name hd Nothing uId]
  89     where
  90       hd = defaultAnnuaire
  91
  92 mkNodeWithParent NodeGraph (Just i) uId _name =
  93    insertNodesWithParentR (Just i) [node NodeGraph "Graph" hd Nothing uId]
  94     where
  95       hd = arbitraryGraph
  96
  97 mkNodeWithParent NodeFrameWrite (Just i) uId name = do
  98   config <- view hasConfig
  99   let
 100     u = _gc_frame_write_url config
 101     s = _gc_secretkey config
 102     hd = HyperdataFrame u (sha $ s <> (cs $ show i))
 103   insertNodesWithParentR (Just i) [node NodeFrameWrite name hd Nothing uId]
 104
 105 mkNodeWithParent NodeFrameCalc (Just i) uId name = do
 106   config <- view hasConfig
 107   let
 108     u = _gc_frame_calc_url config
 109     s = _gc_secretkey config
 110     hd = HyperdataFrame u (sha $ s <> (cs $ show i))
 111
 112   insertNodesWithParentR (Just i) [node NodeFrameCalc name hd Nothing uId]
 113
 114 mkNodeWithParent _ _ _ _       = nodeError NotImplYet
 115