[hyperdata] HyperdataC class to unify things better

parent 70073361
Pipeline #4416 passed with stage
in 29 seconds
......@@ -21,14 +21,9 @@ Script to start gargantext with different modes (Dev, Prod, Mock).
module Main where
import Data.Maybe (fromMaybe)
import Data.Text (unpack)
import Data.Version (showVersion)
import Database.PostgreSQL.Simple.SqlQQ (sql)
import GHC.IO.Exception (IOException)
import Gargantext.API (startGargantext, Mode(..)) -- , startGargantextMock)
import Gargantext.API.Admin.EnvTypes (DevEnv)
import Gargantext.API.Dev (withDevEnv, runCmdDev)
import Gargantext.Prelude
import Options.Generic
import System.Exit (exitSuccess)
......
......@@ -192,10 +192,7 @@ nodeNodeAPI p uId cId nId = withAccess (Proxy :: Proxy (NodeNodeAPI a)) Proxy uI
------------------------------------------------------------------------
-- TODO: make the NodeId type indexed by `a`, then we no longer need the proxy.
nodeAPI :: forall proxy a.
( JSONB a
, FromJSON a
, ToJSON a
, Hyperdata a
( HyperdataC a
) => proxy a
-> UserId
-> NodeId
......@@ -349,7 +346,7 @@ treeFlatAPI = tree_flat
rename :: NodeId -> RenameNode -> Cmd err [Int]
rename nId (RenameNode name') = U.update (U.Rename nId name')
putNode :: forall err a. (HasNodeError err, JSONB a, ToJSON a, Hyperdata a)
putNode :: forall err a. (HasNodeError err, HyperdataC a)
=> NodeId
-> a
-> Cmd err Int
......
......@@ -41,7 +41,7 @@ import Gargantext.Database.Admin.Types.Hyperdata.Folder
import Gargantext.Database.Admin.Types.Hyperdata.Frame
import Gargantext.Database.Admin.Types.Hyperdata.List
import Gargantext.Database.Admin.Types.Hyperdata.Model
import Gargantext.Database.Admin.Types.Hyperdata.Prelude (Hyperdata)
import Gargantext.Database.Admin.Types.Hyperdata.Prelude (Hyperdata, HyperdataC)
import Gargantext.Database.Admin.Types.Hyperdata.Texts
import Gargantext.Database.Admin.Types.Hyperdata.Phylo
import Gargantext.Database.Admin.Types.Hyperdata.User
......
{-# LANGUAGE ConstraintKinds #-}
{-|
Module : Gargantext.Database.Admin.Types.Hyperdata.Prelude
Description :
......@@ -29,6 +31,7 @@ module Gargantext.Database.Admin.Types.Hyperdata.Prelude
, module Test.QuickCheck
, module Test.QuickCheck.Arbitrary
, Hyperdata
, HyperdataC
, Chart(..)
)
where
......@@ -46,7 +49,7 @@ import Database.PostgreSQL.Simple.FromField (FromField, fromField)
import Database.PostgreSQL.Simple.ToField (ToField, toField, toJSONField)
import GHC.Generics (Generic)
import Gargantext.Core.Utils.Prefix (unPrefix, unPrefixSwagger, wellNamedSchema)
import Gargantext.Database.Prelude (fromField')
import Gargantext.Database.Prelude (fromField', JSONB)
import Gargantext.Prelude
import Opaleye (DefaultFromField, defaultFromField, Nullable, SqlJsonb, fromPGSFromField)
import Test.QuickCheck (elements)
......@@ -56,6 +59,12 @@ import Test.QuickCheck.Arbitrary hiding (vector)
-- Only Hyperdata types should be member of this type class.
class Hyperdata a
type HyperdataC a = ( Hyperdata a
, JSONB a
, ToJSON a
, FromJSON a
, FromField a )
data Chart =
CDocsHistogram
......
......@@ -16,24 +16,24 @@ module Gargantext.Database.Query.Table.Node.UpdateOpaleye
where
import Opaleye
import Data.Aeson (encode, ToJSON)
import Data.Aeson (encode)
import Gargantext.Core
import Gargantext.Prelude
import Gargantext.Database.Schema.Node
import Gargantext.Database.Admin.Types.Hyperdata
import Gargantext.Database.Admin.Types.Node
import Gargantext.Database.Prelude (Cmd, mkCmd, JSONB)
import Gargantext.Database.Prelude (Cmd, mkCmd)
import Gargantext.Database.Query.Table.Node
import Gargantext.Database.Query.Table.Node.Error
import Debug.Trace (trace)
updateHyperdata :: (ToJSON a, Hyperdata a) => NodeId -> a -> Cmd err Int64
updateHyperdata :: HyperdataC a => NodeId -> a -> Cmd err Int64
updateHyperdata i h = mkCmd $ \c -> putStrLn "before runUpdate_" >>
runUpdate_ c (updateHyperdataQuery i h) >>= \res ->
putStrLn "after runUpdate_" >> return res
updateHyperdataQuery :: (ToJSON a, Hyperdata a) => NodeId -> a -> Update Int64
updateHyperdataQuery :: HyperdataC a => NodeId -> a -> Update Int64
updateHyperdataQuery i h = seq h' $ trace "updateHyperdataQuery: encoded JSON" $ Update
{ uTable = nodeTable
, uUpdateWith = updateEasy (\ (Node { .. })
......@@ -47,20 +47,16 @@ updateHyperdataQuery i h = seq h' $ trace "updateHyperdataQuery: encoded JSON" $
----------------------------------------------------------------------------------
updateNodesWithType :: ( HasNodeError err
, JSONB a
, ToJSON a
, Hyperdata a
, HasDBid NodeType
, HyperdataC a
) => NodeType -> proxy a -> (a -> a) -> Cmd err [Int64]
updateNodesWithType nt p f = do
ns <- getNodesWithType nt p
mapM (\n -> updateHyperdata (_node_id n) (f $ _node_hyperdata n)) ns
updateNodeWithType :: ( HasNodeError err
, JSONB a
, ToJSON a
, Hyperdata a
, HasDBid NodeType
, HyperdataC a
) => NodeId
-> NodeType
-> proxy a
......@@ -73,9 +69,7 @@ updateNodeWithType nId nt p f = do
-- | In case the Hyperdata Types are not compatible
updateNodesWithType_ :: ( HasNodeError err
, JSONB a
, ToJSON a
, Hyperdata a
, HyperdataC a
, HasDBid NodeType
) => NodeType -> a -> Cmd err [Int64]
updateNodesWithType_ nt h = do
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment