Portability : POSIX
-}
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE Arrows #-}
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.Prelude (Cmd)
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.Utils (hash)
+import Gargantext.Prelude.Crypto.Hash (hash)
import Gargantext.Database.Prelude
import Control.Lens (view)
-import Gargantext.Config (GargConfig(..))
+import Gargantext.Prelude.Config (GargConfig(..))
------------------------------------------------------------------------
-- | TODO mk all others nodes
-mkNodeWithParent :: (HasNodeError err)
+mkNodeWithParent :: (HasNodeError err, HasDBid NodeType)
=> NodeType
-> Maybe ParentId
-> UserId
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)
+mkNodeWithParent_ConfigureHyperdata :: (HasNodeError err, HasDBid NodeType)
=> NodeType
-> Maybe ParentId
-> UserId
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)
+mkNodeWithParent_ConfigureHyperdata' :: (HasNodeError err, HasDBid NodeType)
=> NodeType
-> Maybe ParentId
-> UserId
-> 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
+ 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
- config <- view hasConfig
+ cfg <- view hasConfig
u <- case nt of
- NodeFrameWrite -> pure $ _gc_frame_write_url config
- NodeFrameCalc -> pure $ _gc_frame_calc_url config
+ 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 config
+ s = _gc_secretkey cfg
hd = HyperdataFrame u (hash $ s <> (cs $ show n))
_ <- updateHyperdata n hd
pure [n]