Verified Commit 3d4b9b63 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Merge branch 'dev' into dev-hackathon-fixes

parents 6631fad8 c00418cc
Pipeline #3568 canceled with stage
## Version 0.0.6.9.0 ## Version 0.0.6.9.0
* [FRONT][FIX] Ngrams Table, removing useless columns
* [BACK][FIX] Duplicates
* [FRONT][FIX] Node Selection Indicator * [FRONT][FIX] Node Selection Indicator
* [FRONT][FIX] Just a little warning specifying a bug on <ReactTooltip> * [FRONT][FIX] Just a little warning specifying a bug on <ReactTooltip>
* [FRONT][FEAT] Graph Explorer fixes (labels, Sigma JS parameters) * [FRONT][FEAT] Graph Explorer fixes (labels, Sigma JS parameters)
......
...@@ -28,7 +28,6 @@ import qualified Data.List as List ...@@ -28,7 +28,6 @@ import qualified Data.List as List
-- https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/331 -- https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/331
-- title : everything above the first ==
-- Authors : default : anonymous ; except if the following line is encountered ^@@authors: FirstName1, LastName1 ; FirstName2, LastName2 ; etc. -- Authors : default : anonymous ; except if the following line is encountered ^@@authors: FirstName1, LastName1 ; FirstName2, LastName2 ; etc.
-- date : default : date of last change except if the following line is encountered ^@@date: 2021-09-10 -- date : default : date of last change except if the following line is encountered ^@@date: 2021-09-10
-- source: Name of the root node except if the following line is encountered ^@@source: -- source: Name of the root node except if the following line is encountered ^@@source:
......
...@@ -34,7 +34,7 @@ import Graph.Types (ClusterNode(..)) ...@@ -34,7 +34,7 @@ import Graph.Types (ClusterNode(..))
-- import qualified Data.IntMap as IntMap -- import qualified Data.IntMap as IntMap
import qualified Data.List as List import qualified Data.List as List
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Set as Set -- import qualified Data.Set as Set
---------------------------------------------------------------------- ----------------------------------------------------------------------
...@@ -61,13 +61,15 @@ type Confluence = Map (NodeId, NodeId) Double ...@@ -61,13 +61,15 @@ type Confluence = Map (NodeId, NodeId) Double
bridgeness :: Bridgeness bridgeness :: Bridgeness
-> Map (NodeId, NodeId) Double -> Map (NodeId, NodeId) Double
-> Map (NodeId, NodeId) Double -> Map (NodeId, NodeId) Double
bridgeness (Bridgeness_Advanced sim c) m = Map.fromList bridgeness (Bridgeness_Advanced _sim c) m = Map.fromList
$ map (\(ks, (v1,_v2)) -> (ks,v1)) $ map (\(ks, (v1,_v2)) -> (ks,v1))
$ List.take (if sim == Conditional then 2*n else 3*n) -- $ List.take (if sim == Conditional then 2*n else 3*n)
$ List.sortOn (Down . (snd . snd)) $ List.sortOn (Down . (snd . snd))
$ Map.toList $ Map.toList
$ trace ("bridgeness3 m c" <> show (m,c)) $ Map.intersectionWithKey (\k v1 v2 -> trace ("intersectionWithKey " <> (show (k, v1, v2))) (v1, v2)) m c $ trace ("bridgeness3 m c" <> show (m,c)) $ Map.intersectionWithKey (\k v1 v2 -> trace ("intersectionWithKey " <> (show (k, v1, v2))) (v1, v2)) m c
where
{-
where
!m' = Map.toList m !m' = Map.toList m
n :: Int n :: Int
!n = trace ("bridgeness m size: " <> (show $ List.length m')) !n = trace ("bridgeness m size: " <> (show $ List.length m'))
...@@ -78,6 +80,8 @@ bridgeness (Bridgeness_Advanced sim c) m = Map.fromList ...@@ -78,6 +80,8 @@ bridgeness (Bridgeness_Advanced sim c) m = Map.fromList
nodesNumber = Set.size $ Set.fromList $ as <> bs nodesNumber = Set.size $ Set.fromList $ as <> bs
where where
(as, bs) = List.unzip $ Map.keys m (as, bs) = List.unzip $ Map.keys m
-}
bridgeness (Bridgeness_Basic ns b) m = Map.fromList bridgeness (Bridgeness_Basic ns b) m = Map.fromList
$ List.concat $ List.concat
......
...@@ -41,6 +41,7 @@ type FlowCmdM env err m = ...@@ -41,6 +41,7 @@ type FlowCmdM env err m =
type FlowCorpus a = ( AddUniqId a type FlowCorpus a = ( AddUniqId a
, UniqId a , UniqId a
, UniqParameters a
, InsertDb a , InsertDb a
, ExtractNgramsT a , ExtractNgramsT a
, HasText a , HasText a
...@@ -50,5 +51,6 @@ type FlowCorpus a = ( AddUniqId a ...@@ -50,5 +51,6 @@ type FlowCorpus a = ( AddUniqId a
type FlowInsertDB a = ( AddUniqId a type FlowInsertDB a = ( AddUniqId a
, UniqId a , UniqId a
, UniqParameters a
, InsertDb a , InsertDb a
) )
...@@ -57,7 +57,7 @@ module Gargantext.Database.Query.Table.Node.Document.Insert ...@@ -57,7 +57,7 @@ module Gargantext.Database.Query.Table.Node.Document.Insert
import Control.Lens (set, view) import Control.Lens (set, view)
import Control.Lens.Cons import Control.Lens.Cons
import Control.Lens.Prism import Control.Lens.Prism
import Data.Aeson (toJSON, encode, ToJSON) import Data.Aeson (toJSON, ToJSON)
import Data.Char (isAlpha) import Data.Char (isAlpha)
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Text (Text) import Data.Text (Text)
...@@ -111,7 +111,7 @@ instance InsertDb HyperdataDocument ...@@ -111,7 +111,7 @@ instance InsertDb HyperdataDocument
, toField p , toField p
, toField $ maybe "No Title" (DT.take 255) (_hd_title h) , toField $ maybe "No Title" (DT.take 255) (_hd_title h)
, toField $ _hd_publication_date h -- TODO USE UTCTime , toField $ _hd_publication_date h -- TODO USE UTCTime
, (toField . toJSON) h , (toField . toJSON) (addUniqId h)
] ]
instance InsertDb HyperdataContact instance InsertDb HyperdataContact
...@@ -122,7 +122,7 @@ instance InsertDb HyperdataContact ...@@ -122,7 +122,7 @@ instance InsertDb HyperdataContact
, toField p , toField p
, toField $ maybe "Contact" (DT.take 255) (Just "Name") -- (_hc_name h) , toField $ maybe "Contact" (DT.take 255) (Just "Name") -- (_hc_name h)
, toField $ jour 0 1 1 -- TODO put default date , toField $ jour 0 1 1 -- TODO put default date
, (toField . toJSON) h , (toField . toJSON) (addUniqId h)
] ]
instance ToJSON a => InsertDb (Node a) instance ToJSON a => InsertDb (Node a)
...@@ -197,6 +197,10 @@ class AddUniqId a ...@@ -197,6 +197,10 @@ class AddUniqId a
where where
addUniqId :: a -> a addUniqId :: a -> a
class UniqParameters a
where
uniqParameters :: ParentId -> a -> Text
instance AddUniqId HyperdataDocument instance AddUniqId HyperdataDocument
where where
addUniqId = addUniqIdsDoc addUniqId = addUniqIdsDoc
...@@ -208,46 +212,36 @@ instance AddUniqId HyperdataDocument ...@@ -208,46 +212,36 @@ instance AddUniqId HyperdataDocument
shaUni = hash $ DT.concat $ map ($ doc) shaParametersDoc shaUni = hash $ DT.concat $ map ($ doc) shaParametersDoc
shaBdd = hash $ DT.concat $ map ($ doc) ([(\d -> maybeText (_hd_bdd d))] <> shaParametersDoc) shaBdd = hash $ DT.concat $ map ($ doc) ([(\d -> maybeText (_hd_bdd d))] <> shaParametersDoc)
shaParametersDoc :: [(HyperdataDocument -> Text)] shaParametersDoc :: [(HyperdataDocument -> Text)]
shaParametersDoc = [ \d -> filterText $ maybeText (_hd_title d) shaParametersDoc = [ \d -> filterText $ maybeText (_hd_title d)
, \d -> filterText $ maybeText (_hd_abstract d) , \d -> filterText $ maybeText (_hd_abstract d)
, \d -> filterText $ maybeText (_hd_source d) , \d -> filterText $ maybeText (_hd_source d)
, \d -> maybeText (_hd_publication_date d) -- , \d -> maybeText (_hd_publication_date d)
] ]
instance UniqParameters HyperdataDocument
where
uniqParameters _ h = filterText $ DT.concat $ map maybeText $ [_hd_title h, _hd_abstract h, _hd_source h]
instance UniqParameters HyperdataContact
where
uniqParameters _ _ = ""
instance UniqParameters (Node a)
where
uniqParameters _ _ = undefined
filterText :: Text -> Text filterText :: Text -> Text
filterText = DT.toLower . (DT.filter isAlpha) filterText = DT.toLower . (DT.filter isAlpha)
-- TODO put this elsewhere (fix bin/gargantext-init/Main.hs too)
secret :: Text
secret = "Database secret to change"
instance (AddUniqId a, ToJSON a, HasDBid NodeType) => AddUniqId (Node a) instance (UniqParameters a, ToJSON a, HasDBid NodeType) => AddUniqId (Node a)
where where
addUniqId (Node nid _ t u p n d h) = Node nid hashId t u p n d h addUniqId (Node nid _ t u p n d h) = Node nid (Just newHash) t u p n d h
where where
hashId = Just $ "\\x" <> (hash $ DT.concat params) newHash = "\\x" <> (hash $ uniqParameters (fromMaybe 0 p) h)
params = [ secret
, cs $ show $ toDBid NodeDocument
, n
, cs $ show p
, cs $ encode h
]
{-
addUniqId n@(Node nid _ t u p n d h) =
case n of
Node HyperdataDocument -> Node nid hashId t u p n d h
where
hashId = "\\x" <> (hash $ DT.concat params)
params = [ secret
, cs $ show $ toDBid NodeDocument
, n
, cs $ show p
, cs $ encode h
]
_ -> undefined
-}
--------------------------------------------------------------------------- ---------------------------------------------------------------------------
-- * Uniqueness of document definition -- * Uniqueness of document definition
......
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