Commit f4838983 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[Database] Clean tables.

parent b13b85bf
......@@ -86,16 +86,12 @@ nodesAPI ids = deleteNodes ids
-- | TODO: access by admin only
-- To manager the Users roots
type Roots = Get '[JSON] [NodeAny]
:<|> Post '[JSON] Int -- TODO
:<|> Put '[JSON] Int -- TODO
:<|> Delete '[JSON] Int -- TODO
-- | TODO: access by admin only
roots :: GargServer Roots
roots = (liftIO (putStrLn ( "/user" :: Text)) >> getNodesWithParentId 0 Nothing)
:<|> pure (panic "not implemented yet") -- TODO
:<|> pure (panic "not implemented yet") -- TODO
:<|> pure (panic "not implemented yet") -- TODO
:<|> pure (panic "not implemented yet") -- TODO use patch map to update what we need
-------------------------------------------------------------------
-- | Node API Types management
......@@ -260,11 +256,11 @@ graphAPI nId = do
, LegendField 2 "#0048BA" "Label 2"
]
graph <- set graph_metadata (Just metadata) <$> maybe defaultGraph identity <$> readGraphFromJson "purescript-gargantext/dist/examples/imtNew.json"
graph <- set graph_metadata (Just metadata)
<$> maybe defaultGraph identity
<$> readGraphFromJson "purescript-gargantext/dist/examples/imtNew.json"
pure graph
-- t <- textFlow (Mono EN) (Contexts contextText)
-- liftIO $ liftIO $ pure $ maybe t identity maybeGraph
-- TODO what do we get about the node? to replace contextText
......
......@@ -211,8 +211,8 @@ toInserted = DM.fromList . map (\r -> (reUniqId r, r) )
. filter (\r -> reInserted r == True)
data DocumentWithId =
DocumentWithId { documentId :: NodeId
, documentData :: HyperdataDocument
DocumentWithId { documentId :: !NodeId
, documentData :: !HyperdataDocument
} deriving (Show)
mergeData :: Map HashId ReturnId -> Map HashId HyperdataDocument -> [DocumentWithId]
......@@ -226,8 +226,8 @@ mergeData rs = catMaybes . map toDocumentWithId . DM.toList
data DocumentIdWithNgrams =
DocumentIdWithNgrams
{ documentWithId :: DocumentWithId
, document_ngrams :: Map (NgramsT Ngrams) Int
{ documentWithId :: !DocumentWithId
, document_ngrams :: !(Map (NgramsT Ngrams) Int)
} deriving (Show)
-- TODO add Terms (Title + Abstract)
......@@ -327,4 +327,3 @@ insertLists lId lngs =
------------------------------------------------------------------------
------------------------------------------------------------------------
......@@ -47,7 +47,7 @@ selectChildren parentId maybeNodeType = proc () -> do
let nodeType = maybe 0 nodeTypeId maybeNodeType
restrict -< typeName .== pgInt4 nodeType
restrict -< (.||) (parent_id .== (toNullable $ pgInt4 parentId))
restrict -< (.||) (parent_id .== (pgInt4 parentId))
( (.&&) (n1id .== pgInt4 parentId)
(n2id .== nId))
returnA -< row
......
......@@ -140,6 +140,9 @@ instance QueryRunnerColumnDefault PGTSVector (Maybe TSVector)
where
queryRunnerColumnDefault = fieldQueryRunnerColumn
instance QueryRunnerColumnDefault PGInt4 (Maybe NodeParentId)
where
queryRunnerColumnDefault = fieldQueryRunnerColumn
------------------------------------------------------------------------
......@@ -155,18 +158,18 @@ $(makeLensesWith abbreviatedFields ''NodePolySearch)
type NodeWrite = NodePoly (Maybe (Column PGInt4 ))
(Column PGInt4 )
(Column PGInt4 )
(Column (Nullable PGInt4 ))
(Column (PGText ))
(Maybe (Column PGInt4 ))
(Column PGText )
(Maybe (Column PGTimestamptz))
(Column PGJsonb )
type NodeRead = NodePoly (Column PGInt4 )
(Column PGInt4 )
(Column PGInt4 )
(Column (Nullable PGInt4 ))
(Column (PGText ))
(Column PGInt4 )
(Column PGText )
(Column PGTimestamptz )
(Column PGJsonb)
(Column PGJsonb )
type NodeReadNull = NodePoly (Column (Nullable PGInt4 ))
......@@ -182,7 +185,7 @@ nodeTable = Table "nodes" (pNode Node { _node_id = optional "id"
, _node_typename = required "typename"
, _node_userId = required "user_id"
, _node_parentId = required "parent_id"
, _node_parentId = optional "parent_id"
, _node_name = required "name"
, _node_date = optional "date"
......@@ -306,7 +309,7 @@ selectNodesWith' :: ParentId -> Maybe NodeType -> Query NodeRead
selectNodesWith' parentId maybeNodeType = proc () -> do
node <- (proc () -> do
row@(Node _ typeId _ parentId' _ _ _) <- queryNodeTable -< ()
restrict -< parentId' .== (toNullable $ pgInt4 parentId)
restrict -< parentId' .== (pgInt4 parentId)
let typeId' = maybe 0 nodeTypeId maybeNodeType
......@@ -359,9 +362,7 @@ getCorporaWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeCorpus)
selectNodesWithParentID :: Int -> Query NodeRead
selectNodesWithParentID n = proc () -> do
row@(Node _ _ _ parent_id _ _ _) <- queryNodeTable -< ()
restrict -< if n > 0
then parent_id .== (toNullable $ pgInt4 n)
else isNull parent_id
restrict -< parent_id .== (pgInt4 n)
returnA -< row
selectNodesWithType :: Column PGInt4 -> Query NodeRead
......
......@@ -103,7 +103,7 @@ userTable = Table "auth_user" (pUser User { user_id = optional "id"
)
-- TODO: on conflict, nice message
insertUsers :: [UserWrite] -> Cmd Int64
insertUsers :: [UserWrite] -> Cmd err Int64
insertUsers us = mkCmd $ \c -> runInsertMany c userTable us
gargantuaUser :: UserWrite
......@@ -167,4 +167,3 @@ getUser :: Username -> Cmd err (Maybe UserLight)
getUser u = userLightWithUsername u <$> usersLight
CREATE EXTENSION IF NOT EXISTS plpgsql WITH SCHEMA pg_catalog;
COMMENT ON EXTENSION plpgsql IS 'PL/pgSQL procedural language';
CREATE EXTENSION IF NOT EXISTS acl WITH SCHEMA public;
-- needed for rights management
-- CREATE EXTENSION IF NOT EXISTS acl WITH SCHEMA public;
-- CREATE USER WITH ...
-- createdb "gargandb"
......
......@@ -84,6 +84,7 @@ formatPGSQuery q a = mkCmd $ \conn -> PGS.formatQuery conn q a
runPGSQuery :: (PGS.ToRow a, PGS.FromRow b) => PGS.Query -> a -> Cmd err [b]
runPGSQuery q a = mkCmd $ \conn -> PGS.query conn q a
------------------------------------------------------------------------
databaseParameters :: FilePath -> IO PGS.ConnectInfo
......@@ -107,9 +108,6 @@ databaseParameters fp = do
connectGargandb :: FilePath -> IO Connection
connectGargandb fp = databaseParameters fp >>= \params -> connect params
printSql :: Default Unpackspec a a => Query a -> IO ()
printSql = putStrLn . maybe "Empty query" identity . showSqlForPostgres
fromField' :: (Typeable b, FromJSON b) => Field -> Maybe DB.ByteString -> Conversion b
fromField' field mb = do
v <- fromField field mb
......@@ -119,5 +117,7 @@ fromField' field mb = do
Success a -> pure a
Error _err -> returnError ConversionFailed field "cannot parse hyperdata"
-- | Opaleye leftJoin* functions
-- TODO add here from Node.hs
printSqlOpa :: Default Unpackspec a a => Query a -> IO ()
printSqlOpa = putStrLn . maybe "Empty query" identity . showSqlForPostgres
......@@ -13,6 +13,7 @@ From text to viz, all the flow of texts in Gargantext.
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Gargantext.Text.Flow
where
......@@ -60,7 +61,7 @@ import Data.Graph.Clustering.Louvain.CplusPlus (cLouvain, l_community_id)
contextText :: [T.Text]
contextText = map T.pack ["The dog is an animal."
contextText = ["The dog is an animal."
,"The bird is an animal."
,"The dog is an animal."
,"The animal is a bird or a dog ?"
......
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