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
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
......@@ -85,9 +88,12 @@ documentUpload uId nId doc logStatus = do
let cId = case mcId of
Just c -> c
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
, _hd_doi = Nothing
, _hd_url = Nothing
......@@ -97,16 +103,18 @@ documentUpload uId nId doc logStatus = do
, _hd_title = Just $ view du_title doc
, _hd_authors = Just $ view du_authors doc
, _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_hour = Nothing
, _hd_source = Just $ view du_sources doc
, _hd_abstract = Just $ view du_abstract doc
, _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
......@@ -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
......
......@@ -77,7 +77,6 @@ groupEdges m = fromListWith (<>)
. toList
-- | TODO : sortOn Confluence
filterComs :: (Ord n1, Eq n2)
=> p
-> Map (n2, n2) [(a3, n1)]
......
......@@ -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
......
......@@ -27,8 +27,10 @@ import Gargantext.Prelude
sendMail :: (HasNodeError err, CmdM env err m) => User -> m ()
sendMail u = do
cfg <- view $ mailSettings
cfg <- view $ mailSettings
userLight <- getUserLightDB u
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