Commit 4500b970 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[DB] NodesNgramsRepo.

parent f1f4726a
......@@ -71,6 +71,8 @@ import GHC.Generics (Generic)
import Gargantext.Core.Utils.Prefix (unPrefix)
-- import Gargantext.Database.Schema.Ngrams (NgramsTypeId, ngramsTypeId, NgramsTableData(..))
import Gargantext.Database.Schema.Ngrams (NgramsType)
import Gargantext.Database.Utils (fromField')
import Database.PostgreSQL.Simple.FromField (FromField, fromField)
import qualified Gargantext.Database.Schema.Ngrams as Ngrams
-- import Gargantext.Database.Schema.NodeNgram hiding (Action)
import Gargantext.Prelude
......@@ -404,6 +406,14 @@ instance Action NgramsPatch (Maybe NgramsElement) where
newtype NgramsTablePatch = NgramsTablePatch (PatchMap NgramsTerm NgramsPatch)
deriving (Eq, Show, Generic, ToJSON, FromJSON, Semigroup, Monoid, Validity, Transformable)
instance FromField NgramsTablePatch
where
fromField = fromField'
instance FromField (PatchMap NgramsType (PatchMap NodeId NgramsTablePatch))
where
fromField = fromField'
--instance (Ord k, Action pv (Maybe v)) => Action (PatchMap k pv) (Map k v) where
--
type instance ConflictResolution NgramsTablePatch =
......@@ -722,28 +732,4 @@ getTableNgrams _cId maybeTabType listIds mlimit moffset = do
getTableNgrams' listIds ngramsType
& mapped . v_data . _NgramsTable %~ (take limit_ . drop offset_)
{-
v <- view repoVar
repo <- liftIO $ readMVar v
let ngrams = repo ^.. r_state
. at listId . _Just
. at ngramsType . _Just
. taking limit_ (dropping offset_ each)
let ngrams' = case List.null ngrams of
True -> [] -- buildRepoFromDb (TODO sync with DB at shutdown)
False -> ngrams
pure $ Versioned (repo ^. r_version) (NgramsTable ngrams')
-}
{-
buildRepoFromDb listId = do
ngramsTableDatas <-
Ngrams.getNgramsTableDb NodeDocument ngramsType (Ngrams.NgramsTableParam listId cId) limit_ offset_
-- printDebug "ngramsTableDatas" ngramsTableDatas
pure $ Versioned 1 $ NgramsTable (toNgramsElement ngramsTableDatas)
-}
......@@ -349,4 +349,3 @@ insertLists lId lngs = insertNodeNgrams [ NodeNgram lId (_ngramsId ng) Nothing (
| (l,(ngt, ng)) <- lngs
]
------------------------------------------------------------------------
......@@ -25,6 +25,7 @@ Ngrams connection to the Database.
module Gargantext.Database.Schema.Ngrams where
import Data.Aeson (FromJSON, FromJSONKey)
import Control.Lens (makeLenses, view, over)
import Control.Monad (mzero)
import Data.ByteString.Internal (ByteString)
......@@ -100,7 +101,10 @@ dbGetNgramsDb = runOpaQuery queryNgramsTable
-- ngrams in authors field of document has Authors Type
-- ngrams in text (title or abstract) of documents has Terms Type
data NgramsType = Authors | Institutes | Sources | NgramsTerms
deriving (Eq, Show, Ord, Enum, Bounded)
deriving (Eq, Show, Ord, Enum, Bounded, Generic)
instance FromJSON NgramsType
instance FromJSONKey NgramsType
newtype NgramsTypeId = NgramsTypeId Int
deriving (Eq, Show, Ord, Num)
......
......@@ -155,16 +155,17 @@ instance QueryRunnerColumnDefault PGInt4 NodeId
------------------------------------------------------------------------
$(makeAdaptorAndInstance "pNode" ''NodePoly)
$(makeLensesWith abbreviatedFields ''NodePoly)
$(makeAdaptorAndInstance "pNodeSearch" ''NodePolySearch)
$(makeLensesWith abbreviatedFields ''NodePolySearch)
type NodeWrite = NodePoly (Maybe (Column PGInt4 ))
(Column PGInt4 )
(Column PGInt4 )
(Maybe (Column PGInt4 ))
(Column PGText )
type NodeWrite = NodePoly (Maybe (Column PGInt4) )
(Column PGInt4)
(Column PGInt4)
(Maybe (Column PGInt4) )
(Column PGText)
(Maybe (Column PGTimestamptz))
(Column PGJsonb )
(Column PGJsonb)
type NodeRead = NodePoly (Column PGInt4 )
(Column PGInt4 )
......@@ -174,12 +175,12 @@ type NodeRead = NodePoly (Column PGInt4 )
(Column PGTimestamptz )
(Column PGJsonb )
type NodeReadNull = NodePoly (Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGText ))
(Column (Nullable PGTimestamptz ))
type NodeReadNull = NodePoly (Column (Nullable PGInt4))
(Column (Nullable PGInt4))
(Column (Nullable PGInt4))
(Column (Nullable PGInt4))
(Column (Nullable PGText))
(Column (Nullable PGTimestamptz))
(Column (Nullable PGJsonb))
nodeTable :: Table NodeWrite NodeRead
......@@ -201,32 +202,38 @@ queryNodeTable = queryTable nodeTable
------------------------------------------------------------------------
-- | Node(Read|Write)Search is slower than Node(Write|Read) use it
-- for full text search only
type NodeSearchWrite = NodePolySearch (Maybe (Column PGInt4 ))
type NodeSearchWrite =
NodePolySearch
(Maybe (Column PGInt4) )
(Column PGInt4 )
(Column PGInt4 )
(Column (Nullable PGInt4 ))
(Column (PGText ))
(Column (Nullable PGInt4) )
(Column PGText )
(Maybe (Column PGTimestamptz))
(Column PGJsonb )
(Maybe (Column PGTSVector))
(Maybe (Column PGTSVector) )
type NodeSearchRead = NodePolySearch (Column PGInt4 )
type NodeSearchRead =
NodePolySearch
(Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column (Nullable PGInt4 ))
(Column (PGText ))
(Column PGText )
(Column PGTimestamptz )
(Column PGJsonb)
(Column PGTSVector)
type NodeSearchReadNull = NodePolySearch (Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGInt4 ))
(Column (Nullable PGText ))
(Column (Nullable PGTimestamptz ))
(Column (Nullable PGJsonb))
(Column (Nullable PGTSVector))
(Column PGJsonb )
(Column PGTSVector )
type NodeSearchReadNull =
NodePolySearch
(Column (Nullable PGInt4) )
(Column (Nullable PGInt4) )
(Column (Nullable PGInt4) )
(Column (Nullable PGInt4) )
(Column (Nullable PGText) )
(Column (Nullable PGTimestamptz))
(Column (Nullable PGJsonb) )
(Column (Nullable PGTSVector) )
--{-
nodeTableSearch :: Table NodeSearchWrite NodeSearchRead
......@@ -336,7 +343,8 @@ type JSONB = QueryRunnerColumnDefault PGJsonb
getNode :: JSONB a => NodeId -> proxy a -> Cmd err (Node a)
getNode nId _ = do
fromMaybe (error $ "Node does node exist: " <> show nId) . headMay <$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
fromMaybe (error $ "Node does node exist: " <> show nId) . headMay
<$> runOpaQuery (limit 1 $ selectNode (pgNodeId nId))
getNodesWithType :: Column PGInt4 -> Cmd err [Node HyperdataDocument]
getNodesWithType = runOpaQuery . selectNodesWithType
......
CREATE EXTENSION IF NOT EXISTS plpgsql WITH SCHEMA pg_catalog;
COMMENT ON EXTENSION plpgsql IS 'PL/pgSQL procedural language';
-- needed for rights management
-- CREATE EXTENSION IF NOT EXISTS acl WITH SCHEMA public;
-- CREATE USER WITH ...
-- createdb "gargandb"
......@@ -23,6 +21,7 @@ CREATE TABLE public.auth_user (
ALTER TABLE public.auth_user OWNER TO gargantua;
-- TODO add publication_date
-- TODO typename -> type_id
CREATE TABLE public.nodes (
......@@ -40,7 +39,6 @@ CREATE TABLE public.nodes (
ALTER TABLE public.nodes OWNER TO gargantua;
CREATE TABLE public.ngrams (
id SERIAL,
terms character varying(255),
......@@ -49,7 +47,9 @@ CREATE TABLE public.ngrams (
);
ALTER TABLE public.ngrams OWNER TO gargantua;
-- TODO: delete ID
--------------------------------------------------------------
--------------------------------------------------------------
-- TODO: delete delete this table
CREATE TABLE public.nodes_ngrams (
id SERIAL,
node_id integer NOT NULL,
......@@ -64,11 +64,19 @@ CREATE TABLE public.nodes_ngrams (
-- PRIMARY KEY (node_id,ngrams_id)
);
ALTER TABLE public.nodes_ngrams OWNER TO gargantua;
--------------------------------------------------------------
CREATE TABLE public.nodes_ngrams_repo (
version integer NOT NULL,
patches jsonb DEFAULT '{}'::jsonb NOT NULL,
PRIMARY KEY (version)
);
ALTER TABLE public.nodes_ngrams_repo OWNER TO gargantua;
--------------------------------------------------------------
--
-- Name: nodes_ngrams_ngrams; Type: TABLE; Schema: public; Owner: gargantua
--
-- TODO: delete delete this table
CREATE TABLE public.nodes_ngrams_ngrams (
node_id integer NOT NULL REFERENCES public.nodes(id) ON DELETE CASCADE,
ngram1_id integer NOT NULL REFERENCES public.ngrams(id) ON DELETE CASCADE,
......@@ -79,7 +87,7 @@ CREATE TABLE public.nodes_ngrams_ngrams (
ALTER TABLE public.nodes_ngrams_ngrams OWNER TO gargantua;
---------------------------------------------------------
CREATE TABLE public.nodes_nodes (
node1_id integer NOT NULL,
node2_id integer NOT NULL,
......@@ -89,8 +97,23 @@ CREATE TABLE public.nodes_nodes (
PRIMARY KEY (node1_id, node2_id)
);
ALTER TABLE public.nodes_nodes OWNER TO gargantua;
---------------------------------------------------------
-- If needed for rights management at row level
-- CREATE EXTENSION IF NOT EXISTS acl WITH SCHEMA public;
CREATE TABLE public.rights (
user_id INTEGER NOT NULL REFERENCES public.auth_user(id) ON DELETE CASCADE,
node_id INTEGER NOT NULL REFERENCES public.nodes(id) ON DELETE CASCADE,
rights INTEGER NOT NULL,
PRIMARY KEY (user_id, node_id)
);
ALTER TABLE public.rights OWNER TO gargantua;
CREATE INDEX rights_userId_nodeId ON public.rights USING btree (user_id,node_id);
------------------------------------------------------------
-- INDEXES
CREATE UNIQUE INDEX ON public.auth_user(username);
......
......@@ -28,8 +28,7 @@ import Prelude (Enum, Bounded, minBound, maxBound)
import GHC.Generics (Generic)
import Control.Lens hiding (elements)
import qualified Control.Lens as L
import Control.Lens hiding (elements, (&))
import Control.Applicative ((<*>))
import Control.Monad (mzero)
......@@ -41,7 +40,7 @@ import Data.ByteString.Lazy (ByteString)
import Data.Either
import Data.Eq (Eq)
import Data.Monoid (mempty)
import Data.Text (Text, unpack)
import Data.Text (Text, unpack, pack)
import Data.Time (UTCTime)
import Data.Time.Segment (jour, timesAfter, Granularity(D))
import Data.Swagger
......@@ -74,6 +73,7 @@ instance FromField NodeId where
instance ToJSON NodeId
instance FromJSON NodeId
instance FromJSONKey NodeId
instance ToSchema NodeId
instance FromHttpApiData NodeId where
......@@ -237,11 +237,8 @@ instance ToSchema Event where
declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
------------------------------------------------------------------------
type Text' = Text
instance Arbitrary Text' where
arbitrary = elements ["ici", "la"]
instance Arbitrary Text where
arbitrary = elements $ map (\c -> pack [c]) ['a'..'z']
data Resource = Resource { resource_path :: Maybe Text
, resource_scraper :: Maybe Text
......@@ -500,27 +497,24 @@ docExample = "{\"doi\":\"sdfds\",\"publication_day\":6,\"language_iso2\":\"en\",
instance ToSchema HyperdataCorpus where
declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
L.& mapped.schema.description ?~ "a corpus"
L.& mapped.schema.example ?~ toJSON hyperdataCorpus
& mapped.schema.description ?~ "a corpus"
& mapped.schema.example ?~ toJSON hyperdataCorpus
instance ToSchema HyperdataAnnuaire where
declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
L.& mapped.schema.description ?~ "an annuaire"
L.& mapped.schema.example ?~ toJSON hyperdataAnnuaire
& mapped.schema.description ?~ "an annuaire"
& mapped.schema.example ?~ toJSON hyperdataAnnuaire
instance ToSchema HyperdataDocument where
declareNamedSchema proxy = genericDeclareNamedSchema defaultSchemaOptions proxy
L.& mapped.schema.description ?~ "a document"
L.& mapped.schema.example ?~ toJSON hyperdataDocument
& mapped.schema.description ?~ "a document"
& mapped.schema.example ?~ toJSON hyperdataDocument
instance ToSchema HyperdataAny where
declareNamedSchema proxy =
pure $ genericNameSchema defaultSchemaOptions proxy mempty
L.& schema.description ?~ "a node"
L.& schema.example ?~ emptyObject -- TODO
& schema.description ?~ "a node"
& schema.example ?~ emptyObject -- TODO
instance ToSchema hyperdata =>
......
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