{-| Module : Gargantext.Database.Schema.Node Description : Main requests of Node to the database Copyright : (c) CNRS, 2017-Present License : AGPL + CECILL v3 Maintainer : team@gargantext.org Stability : experimental Portability : POSIX -} {-# LANGUAGE Arrows #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} module Gargantext.Database.Schema.Node where import Codec.CBOR.JSON qualified as CBOR import Codec.Serialise import Control.Lens hiding (elements, (&)) import Data.Aeson (ToJSON, toJSON, parseJSON, FromJSON) import Gargantext.Database.Schema.Prelude import Gargantext.Prelude (NFData(..)) import Prelude hiding (null, id, map, sum) import Data.Aeson.Types (parseEither) ------------------------------------------------------------------------ -- Main polymorphic Node definition data NodePoly id hash_id typename user_id parent_id name date hyperdata = Node { _node_id :: !id , _node_hash_id :: !hash_id , _node_typename :: !typename , _node_user_id :: !user_id , _node_parent_id :: !parent_id , _node_name :: !name , _node_date :: !date , _node_hyperdata :: !hyperdata } deriving (Show, Generic) instance (NFData i, NFData h, NFData t, NFData u, NFData p, NFData n, NFData d, NFData hy) => NFData (NodePoly i h t u p n d hy) where instance ( Serialise i , Serialise h , Serialise t , Serialise u , Serialise p , Serialise n , Serialise d , ToJSON json , FromJSON json ) => Serialise (NodePoly i h t u p n d json) where encode Node{..} = encode _node_id <> encode _node_hash_id <> encode _node_typename <> encode _node_user_id <> encode _node_parent_id <> encode _node_name <> encode _node_date <> CBOR.encodeValue (toJSON _node_hyperdata) decode = do _node_id <- decode _node_hash_id <- decode _node_typename <- decode _node_user_id <- decode _node_parent_id <- decode _node_name <- decode _node_date <- decode mb_node_hyperdata <- parseEither parseJSON <$> CBOR.decodeValue False case mb_node_hyperdata of Left err -> fail err Right _node_hyperdata -> pure Node{..} ------------------------------------------------------------------------ -- Automatic instances derivation $(deriveJSON (unPrefix "_node_") ''NodePoly) $(makeLenses ''NodePoly) $(makeAdaptorAndInstance "pNode" ''NodePoly) $(makeLensesWith abbreviatedFields ''NodePoly) nodeTable :: Table NodeWrite NodeRead nodeTable = Table "nodes" (pNode Node { _node_id = optionalTableField "id" , _node_hash_id = optionalTableField "hash_id" , _node_typename = requiredTableField "typename" , _node_user_id = requiredTableField "user_id" , _node_parent_id = optionalTableField "parent_id" , _node_name = requiredTableField "name" , _node_date = optionalTableField "date" , _node_hyperdata = requiredTableField "hyperdata" -- ignoring ts_vector field here } ) queryNodeTable :: Query NodeRead queryNodeTable = selectTable nodeTable ------------------------------------------------------------------------ type NodeHWrite a = NodePoly (Maybe (Field SqlInt4) ) (Maybe (Field SqlText) ) (Field SqlInt4) (Field SqlInt4) (Maybe (Field SqlInt4) ) (Field SqlText) (Maybe (Field SqlTimestamptz)) (Field a) type NodeHRead a = NodePoly (Field SqlInt4 ) (Field SqlText ) (Field SqlInt4 ) (Field SqlInt4 ) (Field SqlInt4 ) (Field SqlText ) (Field SqlTimestamptz ) (Field a ) ------------------------------------------------------------------------ type NodeWrite = NodeHWrite SqlJsonb type NodeRead = NodeHRead SqlJsonb ------------------------------------------------------------------------ -- | Node(Read|Write)Search is slower than Node(Write|Read) use it -- for full text search only type NodeSearchWrite = NodePolySearch (Maybe (Field SqlInt4) ) (Field SqlInt4 ) (Field SqlInt4 ) (FieldNullable SqlInt4) (Field SqlText ) (Maybe (Field SqlTimestamptz)) (Field SqlJsonb ) (Maybe (Field SqlTSVector) ) type NodeSearchRead = NodePolySearch (Field SqlInt4 ) (Field SqlInt4 ) (Field SqlInt4 ) (FieldNullable SqlInt4 ) (Field SqlText ) (Field SqlTimestamptz ) (Field SqlJsonb ) (Field SqlTSVector ) data NodePolySearch id typename user_id parent_id name date hyperdata search = NodeSearch { _ns_id :: id , _ns_typename :: typename , _ns_user_id :: user_id -- , nodeUniqId :: shaId , _ns_parent_id :: parent_id , _ns_name :: name , _ns_date :: date , _ns_hyperdata :: hyperdata , _ns_search :: search } deriving (Show, Generic) $(makeAdaptorAndInstance "pNodeSearch" ''NodePolySearch) $(makeLensesWith abbreviatedFields ''NodePolySearch) $(deriveJSON (unPrefix "_ns_") ''NodePolySearch) $(makeLenses ''NodePolySearch) nodeTableSearch :: Table NodeSearchWrite NodeSearchRead nodeTableSearch = Table "nodes" ( pNodeSearch NodeSearch { _ns_id = optionalTableField "id" , _ns_typename = requiredTableField "typename" , _ns_user_id = requiredTableField "user_id" , _ns_parent_id = requiredTableField "parent_id" , _ns_name = requiredTableField "name" , _ns_date = optionalTableField "date" , _ns_hyperdata = requiredTableField "hyperdata" , _ns_search = optionalTableField "search" } ) ------------------------------------------------------------------------