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

[Database] Clean tables.

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