[FIX] Unary document upload

src/Gargantext/API/Node/DocumentUpload.hs

@@ -8,32 +8,35 @@ module Gargantext.API.Node.DocumentUpload where
 import Control.Lens (makeLenses, view)
 import Data.Aeson
 import Data.Swagger (ToSchema)
-import qualified Data.Text as T
-import Data.Time.Clock
-import Data.Time.Calendar
 import GHC.Generics (Generic)
 import Servant
 import Servant.Job.Async
+import qualified Data.Text as T
 
 import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
 import Gargantext.API.Job (jobLogSuccess)
 import Gargantext.API.Prelude
 import Gargantext.Core (Lang(..))
-import Gargantext.Core.Text.Terms (TermType(..))
-import Gargantext.Core.Types.Individu (User(..))
+import Gargantext.Core.Text.Corpus.Parsers.Date (dateSplit)
 import Gargantext.Core.Utils.Prefix (unCapitalize, dropPrefix)
-import Gargantext.Database.Action.Flow (flowDataText, DataText(..))
 import Gargantext.Database.Action.Flow.Types
+import Gargantext.Core.Text.Terms (TermType(..))
+import Gargantext.Database.Action.Flow (insertMasterDocs)
 import Gargantext.Database.Admin.Types.Hyperdata.Document (HyperdataDocument(..))
+import qualified Gargantext.Database.Query.Table.Node.Document.Add  as Doc  (add)
 import Gargantext.Database.Admin.Types.Node
 import Gargantext.Database.Query.Table.Node (getClosestParentIdByType')
 import Gargantext.Prelude
+import Gargantext.Database.Admin.Types.Hyperdata.Corpus (HyperdataCorpus(..))
+
 
 data DocumentUpload = DocumentUpload
   { _du_abstract :: T.Text
   , _du_authors  :: T.Text
   , _du_sources  :: T.Text
-  , _du_title    :: T.Text }
+  , _du_title    :: T.Text 
+  , _du_date     :: T.Text 
+  }
   deriving (Generic)
 
 $(makeLenses ''DocumentUpload)
@@ -75,7 +78,7 @@ documentUpload :: (FlowCmdM env err m)
                -> DocumentUpload
                -> (JobLog -> m ())
                -> m JobLog
-documentUpload uId nId doc logStatus = do
+documentUpload _uId nId doc logStatus = do
   let jl = JobLog { _scst_succeeded = Just 0
                   , _scst_failed    = Just 0
                   , _scst_remaining = Just 1
@@ -86,8 +89,11 @@ documentUpload uId nId doc logStatus = do
         Just c  -> c
         Nothing -> panic $ T.pack $ "[G.A.N.DU] Node has no corpus parent: " <> show nId
  
-  (year, month, day) <- liftBase $ getCurrentTime >>= return . toGregorian . utctDay
-  let nowS = T.pack $ show year <> "-" <> show month <> "-" <> show day
+  (theFullDate, (year, month, day)) <- liftBase
+                                 $ dateSplit EN 
+                                 $ Just
+                                 $ view du_date doc <> "T:0:0:0"
+
   let hd = HyperdataDocument { _hd_bdd = Nothing
                              , _hd_doi = Nothing
                              , _hd_url = Nothing
@@ -99,14 +105,16 @@ documentUpload uId nId doc logStatus = do
                              , _hd_institutes = Nothing
                              , _hd_source             = Just $ view du_sources doc
                              , _hd_abstract           = Just $ view du_abstract doc
-                             , _hd_publication_date = Just nowS
-                             , _hd_publication_year = Just $ fromIntegral year
-                             , _hd_publication_month = Just month
-                             , _hd_publication_day = Just day
+                             , _hd_publication_date   = fmap (T.pack . show) theFullDate
+                             , _hd_publication_year   = year
+                             , _hd_publication_month  = month
+                             , _hd_publication_day    = day
                              , _hd_publication_hour   = Nothing
                              , _hd_publication_minute = Nothing
                              , _hd_publication_second = Nothing
                              , _hd_language_iso2 = Just $ T.pack $ show EN }
-  _ <- flowDataText (RootId (NodeId uId)) (DataNew [[hd]]) (Multi EN) cId Nothing logStatus
+  
+  docIds <- insertMasterDocs (Nothing :: Maybe HyperdataCorpus) (Multi EN) [hd]
+  _ <- Doc.add cId docIds
 
   pure $ jobLogSuccess jl

src/Gargantext/Core/Methods/Distances.hs

@@ -14,14 +14,14 @@ Portability : POSIX
 module Gargantext.Core.Methods.Distances
   where
 
--- import Debug.Trace (trace)
+import Debug.Trace (trace)
 import Data.Aeson
 import Data.Array.Accelerate (Matrix)
 import Data.Swagger
 import GHC.Generics (Generic)
 import Gargantext.Core.Methods.Distances.Accelerate.Conditional (measureConditional)
 import Gargantext.Core.Methods.Distances.Accelerate.Distributional (logDistributional)
-import Gargantext.Prelude (Ord, Eq, Int, Double, Show{-, ($), show-})
+import Gargantext.Prelude (Ord, Eq, Int, Double, Show, ($), show)
 import Prelude (Enum, Bounded, minBound, maxBound)
 import Test.QuickCheck (elements)
 import Test.QuickCheck.Arbitrary
@@ -31,8 +31,10 @@ data Distance = Conditional | Distributional
   deriving (Show, Eq)
 
 measure :: Distance -> Matrix Int -> Matrix Double
-measure Conditional    = measureConditional
-measure Distributional = logDistributional
+measure Conditional    x = measureConditional x
+measure Distributional x = trace (show y) $ y
+  where
+    y = logDistributional x
 
 ------------------------------------------------------------------------
 withMetric :: GraphMetric -> Distance

src/Gargantext/Core/Viz/Graph/Bridgeness.hs

@@ -77,7 +77,6 @@ groupEdges m = fromListWith (<>)
              . toList
 
 -- | TODO : sortOn Confluence
-
 filterComs :: (Ord n1, Eq n2) 
            => p
            -> Map (n2, n2) [(a3, n1)]

src/Gargantext/Core/Viz/Graph/Tools.hs

@@ -67,7 +67,7 @@ cooc2graph' distance threshold myCooc
         myCooc' = toIndex ti myCooc
 
 
-data PartitionMethod = Louvain | Spinglass
+data PartitionMethod = Louvain | Spinglass | Bac
 
 -- | coocurrences graph computation
 cooc2graphWith :: PartitionMethod
@@ -77,6 +77,7 @@ cooc2graphWith :: PartitionMethod
                -> IO Graph
 cooc2graphWith Louvain   = undefined -- TODO use IGraph bindings
 cooc2graphWith Spinglass = cooc2graphWith' (spinglass 1)
+cooc2graphWith Bac       = undefined -- cooc2graphWith' BAC.defaultClustering
 
 cooc2graph'' :: Ord t => Distance
                       -> Double
@@ -179,7 +180,6 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
   pure $ data2graph (Map.toList $ Map.mapKeys unNgramsTerm ti)
                     myCooc' bridgeness' confluence' partitions
 
-
 ------------------------------------------------------------------------
 ------------------------------------------------------------------------
 data ClustersParams = ClustersParams { bridgness :: Double

src/Gargantext/Database/Action/Mail.hs

@@ -30,5 +30,7 @@ sendMail u = do
   cfg       <- view $ mailSettings
   userLight <- getUserLightDB u
   mail cfg (MailInfo { mailInfo_username = userLight_username userLight
-                                , mailInfo_address = userLight_email userLight })
+                     , mailInfo_address  = userLight_email    userLight
+                     }
+           )