[DB.Schema.Node] hash_id column added to Node only

src/Gargantext/Core/Flow/Types.hs

@@ -19,7 +19,6 @@ import Data.Map (Map)
 import Data.Maybe (Maybe)
 -- import Control.Applicative
 import Gargantext.Core.Text (HasText(..))
-import Gargantext.Core.Types.Main (HashId)
 import Gargantext.Database.Admin.Types.Hyperdata
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Schema.Ngrams (Ngrams, NgramsType)

src/Gargantext/Core/Types/Main.hs

@@ -49,8 +49,6 @@ instance ToSchema NodeTree where
 
 --data Classification = Favorites | MyClassifcation
 
-type HashId   = Text
-
 type TypeId     = Int
 -- TODO multiple ListType declaration, remove it
 data ListType  =  StopTerm | CandidateTerm | MapTerm

src/Gargantext/Database/Action/Flow/Utils.hs

@@ -49,7 +49,7 @@ toMaps :: Hyperdata a
        -> Map (NgramsT Ngrams) (Map NodeId Int)
 toMaps fun ns = mapNodeIdNgrams $ documentIdWithNgrams fun ns'
   where
-    ns' = map (\(Node nId _ _ _ _ _ json) -> DocumentWithId nId json) ns
+    ns' = map (\(Node nId _ _ _ _ _ _ json) -> DocumentWithId nId json) ns
 
 mapNodeIdNgrams :: Hyperdata a
                 => [DocumentIdWithNgrams a]

src/Gargantext/Database/Admin/Types/Node.hs

@@ -51,10 +51,10 @@ import Gargantext.Prelude
 
 type UserId = Int
 type MasterUserId = UserId
-
+type HashId = Text
 ------------------------------------------------------------------------
 -- | NodePoly indicates that Node has a Polymorphism Type
-type Node json   = NodePoly NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json
+type Node json   = NodePoly NodeId HashId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json
 
 -- | NodeSearch (queries)
 -- type NodeSearch json   = NodePolySearch NodeId NodeTypeId UserId (Maybe ParentId) NodeName UTCTime json (Maybe TSVector)
@@ -62,7 +62,7 @@ type Node json   = NodePoly NodeId NodeTypeId UserId (Maybe ParentId) NodeName U
 ------------------------------------------------------------------------
 
 instance (Typeable hyperdata, ToSchema hyperdata) =>
-         ToSchema (NodePoly NodeId NodeTypeId
+         ToSchema (NodePoly NodeId HashId NodeTypeId
                             (Maybe UserId)
                             ParentId NodeName
                             UTCTime hyperdata
@@ -70,7 +70,7 @@ instance (Typeable hyperdata, ToSchema hyperdata) =>
   declareNamedSchema = wellNamedSchema "_node_"
 
 instance (Typeable hyperdata, ToSchema hyperdata) =>
-         ToSchema (NodePoly NodeId NodeTypeId
+         ToSchema (NodePoly NodeId HashId NodeTypeId
                             UserId
                             (Maybe ParentId) NodeName
                             UTCTime hyperdata
@@ -95,15 +95,16 @@ instance (Typeable hyperdata, ToSchema hyperdata) =>
 
 instance (Arbitrary hyperdata
          ,Arbitrary nodeId
+         ,Arbitrary hashId
          ,Arbitrary nodeTypeId
          ,Arbitrary userId
          ,Arbitrary nodeParentId
-         ) => Arbitrary (NodePoly nodeId nodeTypeId userId nodeParentId
+         ) => Arbitrary (NodePoly nodeId hashId nodeTypeId userId nodeParentId
                                   NodeName UTCTime hyperdata) where
     --arbitrary = Node 1 1 (Just 1) 1 "name" (jour 2018 01 01) (arbitrary) (Just "")
     arbitrary = Node <$> arbitrary <*> arbitrary <*> arbitrary
                      <*> arbitrary <*> arbitrary <*> arbitrary
-                     <*> arbitrary
+                     <*> arbitrary <*> arbitrary
 
 instance (Arbitrary hyperdata
          ,Arbitrary nodeId

src/Gargantext/Database/Query/Table/Node.hs

@@ -73,7 +73,7 @@ selectNodesWith parentId maybeNodeType maybeOffset maybeLimit =
 selectNodesWith' :: ParentId -> Maybe NodeType -> Query NodeRead
 selectNodesWith' parentId maybeNodeType = proc () -> do
     node <- (proc () -> do
-      row@(Node _ typeId _ parentId' _ _ _) <- queryNodeTable -< ()
+      row@(Node _ _ typeId _ parentId' _ _ _) <- queryNodeTable -< ()
       restrict -< parentId' .== (pgNodeId parentId)
 
       let typeId' = maybe 0 nodeTypeId maybeNodeType
@@ -87,12 +87,12 @@ selectNodesWith' parentId maybeNodeType = proc () -> do
 deleteNode :: NodeId -> Cmd err Int
 deleteNode n = mkCmd $ \conn ->
   fromIntegral <$> runDelete conn nodeTable
-                 (\(Node n_id _ _ _ _ _ _) -> n_id .== pgNodeId n)
+                 (\(Node n_id _ _ _ _ _ _ _) -> n_id .== pgNodeId n)
 
 deleteNodes :: [NodeId] -> Cmd err Int
 deleteNodes ns = mkCmd $ \conn ->
   fromIntegral <$> runDelete conn nodeTable
-                   (\(Node n_id _ _ _ _ _ _) -> in_ ((map pgNodeId ns)) n_id)
+                   (\(Node n_id _ _ _ _ _ _ _) -> in_ ((map pgNodeId ns)) n_id)
 
 -- TODO: NodeType should match with `a'
 getNodesWith :: JSONB a => NodeId -> proxy a -> Maybe NodeType
@@ -153,13 +153,13 @@ getCorporaWithParentId n = runOpaQuery $ selectNodesWith' n (Just NodeCorpus)
 ------------------------------------------------------------------------
 selectNodesWithParentID :: NodeId -> Query NodeRead
 selectNodesWithParentID n = proc () -> do
-    row@(Node _ _ _ parent_id _ _ _) <- queryNodeTable -< ()
+    row@(Node _ _ _ _ parent_id _ _ _) <- queryNodeTable -< ()
     restrict -< parent_id .== (pgNodeId n)
     returnA -< row
 
 selectNodesWithType :: Column PGInt4 -> Query NodeRead
 selectNodesWithType type_id = proc () -> do
-    row@(Node _ tn _ _ _ _ _) <- queryNodeTable -< ()
+    row@(Node _ _ tn _ _ _ _ _) <- queryNodeTable -< ()
     restrict -< tn .== type_id
     returnA -< row
 
@@ -205,7 +205,7 @@ node :: (ToJSON a, Hyperdata a)
      -> UserId
      -> NodeWrite
 node nodeType name hyperData parentId userId =
-  Node Nothing
+  Node Nothing Nothing
        (pgInt4 typeId)
        (pgInt4 userId)
        (pgNodeId <$> parentId)
@@ -238,7 +238,7 @@ insertNodes' ns = mkCmd $ \conn -> runInsert_ conn
 
 insertNodesR :: [NodeWrite] -> Cmd err [NodeId]
 insertNodesR ns = mkCmd $ \conn ->
-  runInsert_ conn (Insert nodeTable ns (rReturning (\(Node i _ _ _ _ _ _) -> i)) Nothing)
+  runInsert_ conn (Insert nodeTable ns (rReturning (\(Node i _ _ _ _ _ _ _) -> i)) Nothing)
 
 insertNodesWithParent :: Maybe ParentId -> [NodeWrite] -> Cmd err Int64
 insertNodesWithParent pid ns = insertNodes (set node_parentId (pgNodeId <$> pid) <$> ns)
@@ -251,7 +251,7 @@ insertNodesWithParentR pid ns = insertNodesR (set node_parentId (pgNodeId <$> pi
 -- needs a Temporary type between Node' and NodeWriteT
 
 node2table :: UserId -> Maybe ParentId -> Node' -> NodeWrite
-node2table uid pid (Node' nt txt v []) = Node Nothing (pgInt4 $ nodeTypeId nt) (pgInt4 uid) (fmap pgNodeId pid) (pgStrictText txt) Nothing (pgStrictJSONB $ cs $ encode v)
+node2table uid pid (Node' nt txt v []) = Node Nothing Nothing (pgInt4 $ nodeTypeId nt) (pgInt4 uid) (fmap pgNodeId pid) (pgStrictText txt) Nothing (pgStrictJSONB $ cs $ encode v)
 node2table _ _ (Node' _ _ _ _) = panic "node2table: should not happen, Tree insert not implemented yet"
 
 

src/Gargantext/Database/Query/Table/Node/Children.hs

@@ -72,7 +72,7 @@ selectChildren :: ParentId
                -> Maybe NodeType
                -> Query NodeRead
 selectChildren parentId maybeNodeType = proc () -> do
-    row@(Node nId typeName _ parent_id _ _ _) <- queryNodeTable -< ()
+    row@(Node nId _ typeName _ parent_id _ _ _) <- queryNodeTable -< ()
     (NodeNode n1id n2id _ _) <- queryNodeNodeTable -< ()
 
     let nodeType = maybe 0 nodeTypeId maybeNodeType

src/Gargantext/Database/Query/Table/Node/UpdateOpaleye.hs

@@ -30,8 +30,8 @@ updateHyperdata i h = mkCmd $ \c -> runUpdate_ c (updateHyperdataQuery i h)
 updateHyperdataQuery :: ToJSON a => NodeId -> a -> Update Int64
 updateHyperdataQuery i h = Update
    { uTable      = nodeTable
-   , uUpdateWith = updateEasy (\  (Node _ni _nt _nu _np _nn _nd _h)
-                                -> Node _ni _nt _nu _np _nn _nd h'
+   , uUpdateWith = updateEasy (\  (Node _ni _nh _nt _nu _np _nn _nd _h)
+                                -> Node _ni _nh _nt _nu _np _nn _nd h'
                               )
    , uWhere      = (\row -> _node_id row .== pgNodeId i )
    , uReturning  = rCount

src/Gargantext/Database/Schema/Node.hs

@@ -26,6 +26,7 @@ import Prelude hiding (null, id, map, sum)
 ------------------------------------------------------------------------
 -- Main polymorphic Node definition
 data NodePoly id
+              hash_id
               typename
               userId
               parentId
@@ -33,6 +34,7 @@ data NodePoly id
               date
               hyperdata  =
      Node { _node_id        :: !id
+          , _node_hash_id   :: !hash_id
           , _node_typename  :: !typename
 
           , _node_userId    :: !userId
@@ -54,6 +56,7 @@ $(makeLensesWith abbreviatedFields ''NodePoly)
 
 nodeTable :: Table NodeWrite NodeRead
 nodeTable = Table "nodes" (pNode Node { _node_id         = optional "id"
+                                      , _node_hash_id    = optional "hash_id"
                                       , _node_typename   = required "typename"
                                       , _node_userId     = required "user_id"
 
@@ -70,6 +73,7 @@ queryNodeTable :: Query NodeRead
 queryNodeTable = queryTable nodeTable
 ------------------------------------------------------------------------
 type NodeWrite = NodePoly (Maybe (Column PGInt4)      )
+                          (Maybe (Column PGText)      )
                                  (Column PGInt4)
                                  (Column PGInt4)
                           (Maybe (Column PGInt4)      )
@@ -78,6 +82,7 @@ type NodeWrite = NodePoly (Maybe (Column PGInt4)      )
                                  (Column PGJsonb)
 
 type NodeRead = NodePoly (Column PGInt4        )
+                         (Column PGText        )
                          (Column PGInt4        )
                          (Column PGInt4        )
                          (Column PGInt4        )
@@ -86,6 +91,7 @@ type NodeRead = NodePoly (Column PGInt4        )
                          (Column PGJsonb       )
 
 type NodeReadNull = NodePoly (Column (Nullable PGInt4))
+                             (Column (Nullable PGText))
                              (Column (Nullable PGInt4))
                              (Column (Nullable PGInt4))
                              (Column (Nullable PGInt4))