[Database] Clean tables.

src/Gargantext/API/Node.hs

@@ -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"
-  
-  pure graph
-
+  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

src/Gargantext/Database/Flow.hs

@@ -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 =
 
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
-

src/Gargantext/Database/Node/Children.hs

@@ -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

src/Gargantext/Database/Schema/Node.hs

@@ -140,6 +140,9 @@ instance QueryRunnerColumnDefault PGTSVector (Maybe TSVector)
   where
     queryRunnerColumnDefault = fieldQueryRunnerColumn
 
+instance QueryRunnerColumnDefault PGInt4 (Maybe NodeParentId)
+  where
+    queryRunnerColumnDefault = fieldQueryRunnerColumn
 
 ------------------------------------------------------------------------
 
@@ -152,29 +155,29 @@ $(makeLensesWith abbreviatedFields ''NodePoly)
 $(makeAdaptorAndInstance "pNodeSearch" ''NodePolySearch)
 $(makeLensesWith abbreviatedFields ''NodePolySearch)
 
-type NodeWrite = NodePoly  (Maybe (Column  PGInt4              ))
-                                  (Column  PGInt4               )
-                                  (Column  PGInt4               )
-                                  (Column (Nullable PGInt4     ))
-                                  (Column (PGText              ))
-                                  (Maybe  (Column PGTimestamptz))
-                                  (Column  PGJsonb              )
+type NodeWrite = NodePoly  (Maybe (Column  PGInt4       ))
+                                  (Column  PGInt4       )
+                                  (Column  PGInt4       )
+                           (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 PGTimestamptz     )
-                          (Column PGJsonb) 
+type NodeRead = NodePoly  (Column PGInt4        )
+                          (Column PGInt4        )
+                          (Column PGInt4        )
+                          (Column PGInt4        )
+                          (Column PGText        )
+                          (Column PGTimestamptz )
+                          (Column PGJsonb       )
 
 
-type NodeReadNull = NodePoly  (Column  (Nullable PGInt4           ))
-                              (Column  (Nullable PGInt4           ))
-                              (Column  (Nullable PGInt4           ))
+type NodeReadNull = NodePoly  (Column (Nullable PGInt4 ))
                               (Column (Nullable PGInt4 ))
-                              (Column (Nullable PGText          ))
-                              (Column (Nullable PGTimestamptz     ))
+                              (Column (Nullable PGInt4 ))
+                              (Column (Nullable PGInt4 ))
+                              (Column (Nullable PGText ))
+                              (Column (Nullable PGTimestamptz ))
                               (Column (Nullable PGJsonb))
 
 nodeTable :: Table NodeWrite NodeRead
@@ -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

src/Gargantext/Database/Schema/User.hs

@@ -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
 
 
-

src/Gargantext/Database/Schema/schema.sql

 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"
 
 CREATE TABLE public.auth_user (
     id SERIAL,
-    password character varying(128) NOT NULL,
-    last_login timestamp with time zone,
+    password     character varying(128) NOT NULL,
+    last_login   timestamp with time zone,
     is_superuser boolean NOT NULL,
-    username character varying(150) NOT NULL,
-    first_name character varying(30) NOT NULL,
-    last_name character varying(30) NOT NULL,
-    email character varying(254) NOT NULL,
-    is_staff boolean NOT NULL,
-    is_active boolean NOT NULL,
+    username     character varying(150) NOT NULL,
+    first_name   character varying(30) NOT NULL,
+    last_name    character varying(30) NOT NULL,
+    email        character varying(254) NOT NULL,
+    is_staff     boolean NOT NULL,
+    is_active    boolean NOT NULL,
     date_joined timestamp with time zone DEFAULT now() NOT NULL,
     PRIMARY KEY (id)
 );

src/Gargantext/Database/Utils.hs

@@ -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
+
+

src/Gargantext/Text/Flow.hs

@@ -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 ?"