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

[FIX] Unary document upload

parent 233f89cc
...@@ -8,32 +8,35 @@ module Gargantext.API.Node.DocumentUpload where ...@@ -8,32 +8,35 @@ module Gargantext.API.Node.DocumentUpload where
import Control.Lens (makeLenses, view) import Control.Lens (makeLenses, view)
import Data.Aeson import Data.Aeson
import Data.Swagger (ToSchema) import Data.Swagger (ToSchema)
import qualified Data.Text as T
import Data.Time.Clock
import Data.Time.Calendar
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Servant import Servant
import Servant.Job.Async import Servant.Job.Async
import qualified Data.Text as T
import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs) import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
import Gargantext.API.Job (jobLogSuccess) import Gargantext.API.Job (jobLogSuccess)
import Gargantext.API.Prelude import Gargantext.API.Prelude
import Gargantext.Core (Lang(..)) import Gargantext.Core (Lang(..))
import Gargantext.Core.Text.Terms (TermType(..)) import Gargantext.Core.Text.Corpus.Parsers.Date (dateSplit)
import Gargantext.Core.Types.Individu (User(..))
import Gargantext.Core.Utils.Prefix (unCapitalize, dropPrefix) import Gargantext.Core.Utils.Prefix (unCapitalize, dropPrefix)
import Gargantext.Database.Action.Flow (flowDataText, DataText(..))
import Gargantext.Database.Action.Flow.Types 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 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.Admin.Types.Node
import Gargantext.Database.Query.Table.Node (getClosestParentIdByType') import Gargantext.Database.Query.Table.Node (getClosestParentIdByType')
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Database.Admin.Types.Hyperdata.Corpus (HyperdataCorpus(..))
data DocumentUpload = DocumentUpload data DocumentUpload = DocumentUpload
{ _du_abstract :: T.Text { _du_abstract :: T.Text
, _du_authors :: T.Text , _du_authors :: T.Text
, _du_sources :: T.Text , _du_sources :: T.Text
, _du_title :: T.Text } , _du_title :: T.Text
, _du_date :: T.Text
}
deriving (Generic) deriving (Generic)
$(makeLenses ''DocumentUpload) $(makeLenses ''DocumentUpload)
...@@ -75,7 +78,7 @@ documentUpload :: (FlowCmdM env err m) ...@@ -75,7 +78,7 @@ documentUpload :: (FlowCmdM env err m)
-> DocumentUpload -> DocumentUpload
-> (JobLog -> m ()) -> (JobLog -> m ())
-> m JobLog -> m JobLog
documentUpload uId nId doc logStatus = do documentUpload _uId nId doc logStatus = do
let jl = JobLog { _scst_succeeded = Just 0 let jl = JobLog { _scst_succeeded = Just 0
, _scst_failed = Just 0 , _scst_failed = Just 0
, _scst_remaining = Just 1 , _scst_remaining = Just 1
...@@ -85,9 +88,12 @@ documentUpload uId nId doc logStatus = do ...@@ -85,9 +88,12 @@ documentUpload uId nId doc logStatus = do
let cId = case mcId of let cId = case mcId of
Just c -> c Just c -> c
Nothing -> panic $ T.pack $ "[G.A.N.DU] Node has no corpus parent: " <> show nId Nothing -> panic $ T.pack $ "[G.A.N.DU] Node has no corpus parent: " <> show nId
(theFullDate, (year, month, day)) <- liftBase
$ dateSplit EN
$ Just
$ view du_date doc <> "T:0:0:0"
(year, month, day) <- liftBase $ getCurrentTime >>= return . toGregorian . utctDay
let nowS = T.pack $ show year <> "-" <> show month <> "-" <> show day
let hd = HyperdataDocument { _hd_bdd = Nothing let hd = HyperdataDocument { _hd_bdd = Nothing
, _hd_doi = Nothing , _hd_doi = Nothing
, _hd_url = Nothing , _hd_url = Nothing
...@@ -97,16 +103,18 @@ documentUpload uId nId doc logStatus = do ...@@ -97,16 +103,18 @@ documentUpload uId nId doc logStatus = do
, _hd_title = Just $ view du_title doc , _hd_title = Just $ view du_title doc
, _hd_authors = Just $ view du_authors doc , _hd_authors = Just $ view du_authors doc
, _hd_institutes = Nothing , _hd_institutes = Nothing
, _hd_source = Just $ view du_sources doc , _hd_source = Just $ view du_sources doc
, _hd_abstract = Just $ view du_abstract doc , _hd_abstract = Just $ view du_abstract doc
, _hd_publication_date = Just nowS , _hd_publication_date = fmap (T.pack . show) theFullDate
, _hd_publication_year = Just $ fromIntegral year , _hd_publication_year = year
, _hd_publication_month = Just month , _hd_publication_month = month
, _hd_publication_day = Just day , _hd_publication_day = day
, _hd_publication_hour = Nothing , _hd_publication_hour = Nothing
, _hd_publication_minute = Nothing , _hd_publication_minute = Nothing
, _hd_publication_second = Nothing , _hd_publication_second = Nothing
, _hd_language_iso2 = Just $ T.pack $ show EN } , _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 pure $ jobLogSuccess jl
...@@ -14,14 +14,14 @@ Portability : POSIX ...@@ -14,14 +14,14 @@ Portability : POSIX
module Gargantext.Core.Methods.Distances module Gargantext.Core.Methods.Distances
where where
-- import Debug.Trace (trace) import Debug.Trace (trace)
import Data.Aeson import Data.Aeson
import Data.Array.Accelerate (Matrix) import Data.Array.Accelerate (Matrix)
import Data.Swagger import Data.Swagger
import GHC.Generics (Generic) import GHC.Generics (Generic)
import Gargantext.Core.Methods.Distances.Accelerate.Conditional (measureConditional) import Gargantext.Core.Methods.Distances.Accelerate.Conditional (measureConditional)
import Gargantext.Core.Methods.Distances.Accelerate.Distributional (logDistributional) 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 Prelude (Enum, Bounded, minBound, maxBound)
import Test.QuickCheck (elements) import Test.QuickCheck (elements)
import Test.QuickCheck.Arbitrary import Test.QuickCheck.Arbitrary
...@@ -31,8 +31,10 @@ data Distance = Conditional | Distributional ...@@ -31,8 +31,10 @@ data Distance = Conditional | Distributional
deriving (Show, Eq) deriving (Show, Eq)
measure :: Distance -> Matrix Int -> Matrix Double measure :: Distance -> Matrix Int -> Matrix Double
measure Conditional = measureConditional measure Conditional x = measureConditional x
measure Distributional = logDistributional measure Distributional x = trace (show y) $ y
where
y = logDistributional x
------------------------------------------------------------------------ ------------------------------------------------------------------------
withMetric :: GraphMetric -> Distance withMetric :: GraphMetric -> Distance
......
...@@ -77,7 +77,6 @@ groupEdges m = fromListWith (<>) ...@@ -77,7 +77,6 @@ groupEdges m = fromListWith (<>)
. toList . toList
-- | TODO : sortOn Confluence -- | TODO : sortOn Confluence
filterComs :: (Ord n1, Eq n2) filterComs :: (Ord n1, Eq n2)
=> p => p
-> Map (n2, n2) [(a3, n1)] -> Map (n2, n2) [(a3, n1)]
......
...@@ -67,7 +67,7 @@ cooc2graph' distance threshold myCooc ...@@ -67,7 +67,7 @@ cooc2graph' distance threshold myCooc
myCooc' = toIndex ti myCooc myCooc' = toIndex ti myCooc
data PartitionMethod = Louvain | Spinglass data PartitionMethod = Louvain | Spinglass | Bac
-- | coocurrences graph computation -- | coocurrences graph computation
cooc2graphWith :: PartitionMethod cooc2graphWith :: PartitionMethod
...@@ -77,6 +77,7 @@ cooc2graphWith :: PartitionMethod ...@@ -77,6 +77,7 @@ cooc2graphWith :: PartitionMethod
-> IO Graph -> IO Graph
cooc2graphWith Louvain = undefined -- TODO use IGraph bindings cooc2graphWith Louvain = undefined -- TODO use IGraph bindings
cooc2graphWith Spinglass = cooc2graphWith' (spinglass 1) cooc2graphWith Spinglass = cooc2graphWith' (spinglass 1)
cooc2graphWith Bac = undefined -- cooc2graphWith' BAC.defaultClustering
cooc2graph'' :: Ord t => Distance cooc2graph'' :: Ord t => Distance
-> Double -> Double
...@@ -179,7 +180,6 @@ cooc2graphWith' doPartitions distance threshold myCooc = do ...@@ -179,7 +180,6 @@ cooc2graphWith' doPartitions distance threshold myCooc = do
pure $ data2graph (Map.toList $ Map.mapKeys unNgramsTerm ti) pure $ data2graph (Map.toList $ Map.mapKeys unNgramsTerm ti)
myCooc' bridgeness' confluence' partitions myCooc' bridgeness' confluence' partitions
------------------------------------------------------------------------ ------------------------------------------------------------------------
------------------------------------------------------------------------ ------------------------------------------------------------------------
data ClustersParams = ClustersParams { bridgness :: Double data ClustersParams = ClustersParams { bridgness :: Double
......
...@@ -27,8 +27,10 @@ import Gargantext.Prelude ...@@ -27,8 +27,10 @@ import Gargantext.Prelude
sendMail :: (HasNodeError err, CmdM env err m) => User -> m () sendMail :: (HasNodeError err, CmdM env err m) => User -> m ()
sendMail u = do sendMail u = do
cfg <- view $ mailSettings cfg <- view $ mailSettings
userLight <- getUserLightDB u userLight <- getUserLightDB u
mail cfg (MailInfo { mailInfo_username = userLight_username userLight mail cfg (MailInfo { mailInfo_username = userLight_username userLight
, mailInfo_address = userLight_email userLight }) , mailInfo_address = userLight_email userLight
}
)
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