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