1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
{-|
Module : Gargantext.Database.Action.Node
Description :
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
module Gargantext.Database.Action.Node
where
import Gargantext.Core
import Gargantext.Core.Types (Name)
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Hyperdata.Default
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Query.Table.Node
import Gargantext.Database.Query.Table.Node.Error
import Gargantext.Database.Query.Table.Node.UpdateOpaleye (updateHyperdata)
import Gargantext.Prelude
import Gargantext.Prelude.Crypto.Hash (hash)
import Gargantext.Database.Prelude
import Control.Lens (view)
import Gargantext.Prelude.Config (GargConfig(..))
------------------------------------------------------------------------
-- | TODO mk all others nodes
mkNodeWithParent :: (HasNodeError err, HasDBid NodeType)
=> NodeType
-> Maybe ParentId
-> UserId
-> Name
-> Cmd err [NodeId]
mkNodeWithParent NodeUser (Just _) _ _ = nodeError UserNoParent
------------------------------------------------------------------------
-- | MkNode, insert and eventually configure Hyperdata
mkNodeWithParent NodeUser Nothing uId name =
insertNodesWithParentR Nothing [node NodeUser name defaultHyperdataUser Nothing uId]
mkNodeWithParent _ Nothing _ _ = nodeError HasParent
------------------------------------------------------------------------
mkNodeWithParent NodeFrameWrite i u n =
mkNodeWithParent_ConfigureHyperdata NodeFrameWrite i u n
mkNodeWithParent NodeFrameCalc i u n =
mkNodeWithParent_ConfigureHyperdata NodeFrameCalc i u n
mkNodeWithParent NodeFrameVisio i u n =
mkNodeWithParent_ConfigureHyperdata NodeFrameVisio i u n
mkNodeWithParent NodeFrameNotebook i u n =
mkNodeWithParent_ConfigureHyperdata NodeFrameNotebook i u n
mkNodeWithParent nt (Just pId) uId name = insertNode nt (Just name) Nothing pId uId
-- mkNodeWithParent _ _ _ _ = errorWith "[G.D.A.Node.mkNodeWithParent] nees parent"
-- | Sugar to create a node, get its NodeId and update its Hyperdata after
mkNodeWithParent_ConfigureHyperdata :: (HasNodeError err, HasDBid NodeType)
=> NodeType
-> Maybe ParentId
-> UserId
-> Name
-> Cmd err [NodeId]
mkNodeWithParent_ConfigureHyperdata NodeFrameWrite (Just i) uId name =
mkNodeWithParent_ConfigureHyperdata' NodeFrameWrite (Just i) uId name
mkNodeWithParent_ConfigureHyperdata NodeFrameCalc (Just i) uId name =
mkNodeWithParent_ConfigureHyperdata' NodeFrameCalc (Just i) uId name
mkNodeWithParent_ConfigureHyperdata NodeFrameVisio (Just i) uId name =
mkNodeWithParent_ConfigureHyperdata' NodeFrameVisio (Just i) uId name
mkNodeWithParent_ConfigureHyperdata NodeFrameNotebook (Just i) uId name =
insertNode NodeFrameNotebook (Just "Notebook")
(Just $ DefaultFrameCode $ HyperdataFrame { _hf_base = "Codebook"
, _hf_frame_id = name }) i uId
mkNodeWithParent_ConfigureHyperdata _ _ _ _ = nodeError NotImplYet
-- | Function not exposed
mkNodeWithParent_ConfigureHyperdata' :: (HasNodeError err, HasDBid NodeType)
=> NodeType
-> Maybe ParentId
-> UserId
-> Name
-> Cmd err [NodeId]
mkNodeWithParent_ConfigureHyperdata' nt (Just i) uId name = do
maybeNodeId <- case nt of
NodeFrameWrite -> insertNode NodeFrameWrite (Just name) Nothing i uId
NodeFrameCalc -> insertNode NodeFrameCalc (Just name) Nothing i uId
NodeFrameVisio -> insertNode NodeFrameVisio (Just name) Nothing i uId
_ -> nodeError NeedsConfiguration
case maybeNodeId of
[] -> nodeError (DoesNotExist i)
[n] -> do
cfg <- view hasConfig
u <- case nt of
NodeFrameWrite -> pure $ _gc_frame_write_url cfg
NodeFrameCalc -> pure $ _gc_frame_calc_url cfg
NodeFrameVisio -> pure $ _gc_frame_visio_url cfg
_ -> nodeError NeedsConfiguration
let
s = _gc_secretkey cfg
hd = HyperdataFrame u (hash $ s <> (cs $ show n))
_ <- updateHyperdata n hd
pure [n]
(_:_:_) -> nodeError MkNode
mkNodeWithParent_ConfigureHyperdata' _ _ _ _ = nodeError HasParent