Skip to content

haskell-gargantext
haskell-gargantext
Commit ee353325 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

Merge branch 'dev-doc-create-endpoint' into 'dev' 

Dev doc create endpoint

See merge request !64
parents f5bb8c77 43f3d9cd
Pipeline #1998 failed with stage
    in 10 minutes and 23 seconds
    Hide whitespace changes
    Inline Side-by-side
    Showing with 145 additions and 24 deletions
    src/Gargantext/API/Node.hs
    View file @ ee353325
    ......@@ -46,7 +46,6 @@ import Gargantext.API.Metrics
    import Gargantext.API.Ngrams (TableNgramsApi, apiNgramsTableCorpus)
    import Gargantext.API.Ngrams.Types (TabType(..))
    import Gargantext.API.Node.File
    import Gargantext.API.Node.FrameCalcUpload (FrameCalcUploadAPI, frameCalcUploadAPI)
    import Gargantext.API.Node.New
    import Gargantext.API.Prelude
    import Gargantext.API.Table
    ......@@ -69,6 +68,8 @@ import Gargantext.Database.Query.Tree (tree, TreeMode(..))
    import Gargantext.Prelude
    import Gargantext.Core.Viz.Phylo.Legacy.LegacyAPI (PhyloAPI, phyloAPI)
    import qualified Gargantext.API.Node.DocumentsFromWriteNodes as DocumentsFromWriteNodes
    import qualified Gargantext.API.Node.DocumentUpload as DocumentUpload
    import qualified Gargantext.API.Node.FrameCalcUpload as FrameCalcUpload
    import qualified Gargantext.API.Node.Share as Share
    import qualified Gargantext.API.Node.Update as Update
    import qualified Gargantext.API.Search as Search
    ......@@ -125,7 +126,7 @@ type NodeAPI a = Get '[JSON] (Node a)
    :<|> "rename" :> RenameApi
    :<|> PostNodeApi -- TODO move to children POST
    :<|> PostNodeAsync
    :<|> FrameCalcUploadAPI
    :<|> FrameCalcUpload.API
    :<|> ReqBody '[JSON] a :> Put '[JSON] Int
    :<|> "update" :> Update.API
    :<|> Delete '[JSON] Int
    ......@@ -159,6 +160,7 @@ type NodeAPI a = Get '[JSON] (Node a)
    :<|> "async" :> FileAsyncApi
    :<|> "documents-from-write-nodes" :> DocumentsFromWriteNodes.API
    :<|> DocumentUpload.API
    -- TODO-ACCESS: check userId CanRenameNode nodeId
    -- TODO-EVENTS: NodeRenamed RenameNode or re-use some more general NodeEdited...
    ......@@ -210,7 +212,7 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode
    :<|> rename id'
    :<|> postNode uId id'
    :<|> postNodeAsyncAPI uId id'
    :<|> frameCalcUploadAPI uId id'
    :<|> FrameCalcUpload.api uId id'
    :<|> putNode id'
    :<|> Update.api uId id'
    :<|> Action.deleteNode (RootId $ NodeId uId) id'
    ......@@ -244,6 +246,7 @@ nodeAPI p uId id' = withAccess (Proxy :: Proxy (NodeAPI a)) Proxy uId (PathNode
    :<|> fileAsyncApi uId id'
    :<|> DocumentsFromWriteNodes.api uId id'
    :<|> DocumentUpload.api uId id'
    ------------------------------------------------------------------------
    ......
    src/Gargantext/API/Node/DocumentUpload.hs 0 → 100644
    View file @ ee353325
    {-# LANGUAGE AllowAmbiguousTypes #-}
    {-# LANGUAGE MonoLocalBinds #-}
    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE TypeOperators #-}
    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 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.Utils.Prefix (unCapitalize, dropPrefix)
    import Gargantext.Database.Action.Flow (flowDataText, DataText(..))
    import Gargantext.Database.Action.Flow.Types
    import Gargantext.Database.Admin.Types.Hyperdata.Document (HyperdataDocument(..))
    import Gargantext.Database.Admin.Types.Node
    import Gargantext.Database.Query.Table.Node (getClosestParentIdByType')
    import Gargantext.Prelude
    data DocumentUpload = DocumentUpload
    { _du_abstract :: T.Text
    , _du_authors :: T.Text
    , _du_sources :: T.Text
    , _du_title :: T.Text }
    deriving (Generic)
    $(makeLenses ''DocumentUpload)
    instance ToSchema DocumentUpload
    instance FromJSON DocumentUpload
    where
    parseJSON = genericParseJSON
    ( defaultOptions { sumEncoding = ObjectWithSingleField
    , fieldLabelModifier = unCapitalize . dropPrefix "_du_"
    , omitNothingFields = True
    }
    )
    instance ToJSON DocumentUpload
    where
    toJSON = genericToJSON
    ( defaultOptions { sumEncoding = ObjectWithSingleField
    , fieldLabelModifier = unCapitalize . dropPrefix "_du_"
    , omitNothingFields = True
    }
    )
    type API = Summary " Document upload"
    :> "document"
    :> "upload"
    :> "async"
    :> AsyncJobs JobLog '[JSON] DocumentUpload JobLog
    api :: UserId -> NodeId -> GargServer API
    api uId nId =
    serveJobsAPI $
    JobFunction (\q log' -> do
    documentUpload uId nId q (liftBase . log')
    )
    documentUpload :: (FlowCmdM env err m)
    => UserId
    -> NodeId
    -> DocumentUpload
    -> (JobLog -> m ())
    -> m JobLog
    documentUpload uId nId doc logStatus = do
    let jl = JobLog { _scst_succeeded = Just 0
    , _scst_failed = Just 0
    , _scst_remaining = Just 1
    , _scst_events = Just [] }
    logStatus jl
    mcId <- getClosestParentIdByType' nId NodeCorpus
    let cId = case mcId of
    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
    let hd = HyperdataDocument { _hd_bdd = Nothing
    , _hd_doi = Nothing
    , _hd_url = Nothing
    , _hd_uniqId = Nothing
    , _hd_uniqIdBdd = Nothing
    , _hd_page = Nothing
    , _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_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
    pure $ jobLogSuccess jl
    src/Gargantext/API/Node/DocumentsFromWriteNodes.hs
    View file @ ee353325
    ......@@ -12,7 +12,6 @@ Portability : POSIX
    {-# LANGUAGE MonoLocalBinds #-}
    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE TypeOperators #-}
    {-# OPTIONS_GHC -fno-warn-orphans #-}
    module Gargantext.API.Node.DocumentsFromWriteNodes
    where
    ......@@ -24,6 +23,7 @@ import Data.Swagger
    import qualified Data.Text as T
    import Gargantext.API.Admin.Orchestrator.Types (JobLog(..), AsyncJobs)
    import Gargantext.API.Admin.Types (HasSettings)
    import Gargantext.API.Job (jobLogSuccess, jobLogFailTotalWithMessage)
    import Gargantext.API.Prelude (GargServer)
    import Gargantext.Core (Lang(..))
    import Gargantext.Core.Text.Corpus.Parsers.FrameWrite
    ......@@ -71,15 +71,20 @@ documentsFromWriteNodes :: (HasSettings env, FlowCmdM env err m)
    -> (JobLog -> m ())
    -> m JobLog
    documentsFromWriteNodes uId nId _p logStatus = do
    logStatus JobLog { _scst_succeeded = Just 1
    , _scst_failed = Just 0
    , _scst_remaining = Just 1
    , _scst_events = Just []
    }
    let jobLog = JobLog { _scst_succeeded = Just 1
    , _scst_failed = Just 0
    , _scst_remaining = Just 1
    , _scst_events = Just []
    }
    logStatus jobLog
    mcId <- getClosestParentIdByType' nId NodeCorpus
    let cId = maybe (panic "[G.A.N.DFWN] Node has no parent") identity mcId
    cId <- case mcId of
    Just cId -> pure cId
    Nothing -> do
    let msg = T.pack $ "[G.A.N.DFWN] Node has no corpus parent: " <> show nId
    logStatus $ jobLogFailTotalWithMessage msg jobLog
    panic msg
    frameWriteIds <- getChildrenByType nId NodeFrameWrite
    ......@@ -97,11 +102,7 @@ documentsFromWriteNodes uId nId _p logStatus = do
    _ <- flowDataText (RootId (NodeId uId)) (DataNew [parsed]) (Multi EN) cId Nothing
    pure JobLog { _scst_succeeded = Just 2
    , _scst_failed = Just 0
    , _scst_remaining = Just 0
    , _scst_events = Just []
    }
    pure $ jobLogSuccess jobLog
    ------------------------------------------------------------------------
    hyperdataDocumentFromFrameWrite :: (HyperdataFrame, T.Text) -> Either T.Text HyperdataDocument
    hyperdataDocumentFromFrameWrite (HyperdataFrame { _hf_base, _hf_frame_id }, contents) =
    ......
    src/Gargantext/API/Node/FrameCalcUpload.hs
    View file @ ee353325
    ......@@ -40,14 +40,14 @@ instance FromJSON FrameCalcUpload
    instance ToJSON FrameCalcUpload
    instance ToSchema FrameCalcUpload
    type FrameCalcUploadAPI = Summary " FrameCalc upload"
    :> "add"
    :> "framecalc"
    :> "async"
    :> AsyncJobs JobLog '[JSON] FrameCalcUpload JobLog
    frameCalcUploadAPI :: UserId -> NodeId -> GargServer FrameCalcUploadAPI
    frameCalcUploadAPI uId nId =
    type API = Summary " FrameCalc upload"
    :> "add"
    :> "framecalc"
    :> "async"
    :> AsyncJobs JobLog '[JSON] FrameCalcUpload JobLog
    api :: UserId -> NodeId -> GargServer API
    api uId nId =
    serveJobsAPI $
    JobFunction (\p logs ->
    frameCalcUploadAsync uId nId p (liftBase . logs) (jobLogInit 5)
    ......
    src/Gargantext/API/Swagger.hs
    View file @ ee353325
    {-# OPTIONS_GHC -freduction-depth=400 #-}
    {-|
    Module : Gargantext.API.Swagger
    Description : Swagger API generation
    ......
    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