API.purs 2.95 KB
Newer Older
1 2
module Gargantext.Components.GraphExplorer.API where

3 4
import Gargantext.Prelude

arturo's avatar
arturo committed
5
import Data.Maybe (Maybe(..))
6
import Gargantext.Components.GraphExplorer.Types as GET
7
import Gargantext.Config.REST (AffRESTError)
8
import Gargantext.Core.NgramsTable.Types as CNT
9
import Gargantext.Hooks.Sigmax.Types as SigmaxT
arturo's avatar
arturo committed
10
import Gargantext.Routes (SessionRoute(..))
11
import Gargantext.Routes as GR
12
import Gargantext.Sessions (Session, get, post)
13
import Gargantext.Types as GT
arturo's avatar
arturo committed
14 15
import Gargantext.Types as Types
import Gargantext.Utils.Toestand as T2
16 17

type GraphAsyncUpdateParams =
18
  ( graphId :: Int
19 20 21 22
  , listId :: Int
  , nodes :: Array (Record SigmaxT.Node)
  , session :: Session
  , termList :: GT.TermList
23
  , version :: CNT.Version
24 25
  )

26
graphAsyncUpdate :: Record GraphAsyncUpdateParams -> AffRESTError GT.AsyncTaskWithType
27
graphAsyncUpdate { graphId, listId, nodes, session, termList, version } = do
28 29
  eTask <- post session p q
  pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.GraphRecompute }) <$> eTask
30
  where
31
    p = GR.GraphAPI graphId $ GT.asyncTaskTypePath GT.GraphRecompute
32 33 34 35 36
    q = { listId
        , nodes
        , termList
        , version
        }
37 38

type GraphAsyncRecomputeParams =
39
  ( graphId :: Int
40 41 42
  , session :: Session
  )

43
graphAsyncRecompute :: Record GraphAsyncRecomputeParams -> AffRESTError GT.AsyncTaskWithType
44
graphAsyncRecompute { graphId, session } = do
45 46
  eTask <- post session p q
  pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.GraphRecompute }) <$> eTask
47
  where
48
    p = GR.GraphAPI graphId $ GT.asyncTaskTypePath GT.GraphRecompute
49 50 51
    q = {}

type QueryProgressParams =
52
  ( graphId :: Int
53 54 55 56
  , session :: Session
  , taskId  :: String
  )

57
queryProgress :: Record QueryProgressParams -> AffRESTError GT.AsyncProgress
58 59
queryProgress { graphId, session, taskId } = do
  get session $ GR.GraphAPI graphId $ "async/" <> taskId <> "/poll"
60 61

type GraphVersions =
62
  ( gv_graph :: Maybe Int
63 64 65 66
  , gv_repo :: Int
  )

type GraphVersionsParams =
67
  ( graphId :: Int
68 69 70
  , session :: Session
  )

71
graphVersions :: Record GraphVersionsParams -> AffRESTError (Record GraphVersions)
72 73 74
graphVersions { graphId, session }  = get session $ GR.GraphAPI graphId $ "versions"

type UpdateGraphVersionsParams =
75
  ( graphId :: Int
76 77 78
  , session :: Session
  )

79
updateGraphVersions :: Record UpdateGraphVersionsParams -> AffRESTError GET.GraphData
80
updateGraphVersions { graphId, session } = post session (GR.GraphAPI graphId $ "versions") {}
81 82

type CloneGraphParams =
83
  ( hyperdataGraph :: GET.HyperdataGraph
84 85 86 87
  , id :: Int
  , session :: Session
  )

88
cloneGraph :: Record CloneGraphParams -> AffRESTError Int
89
cloneGraph { hyperdataGraph, id, session } = post session (GR.GraphAPI id $ "clone") hyperdataGraph
arturo's avatar
arturo committed
90 91 92 93 94 95 96 97

-----------------------------------------------

getNodes :: Session -> T2.Reload -> GET.GraphId -> AffRESTError GET.HyperdataGraph
getNodes session graphVersion graphId =
  get session $ NodeAPI Types.Graph
                        (Just graphId)
                        ("?version=" <> (show graphVersion))