Skip to content

P
purescript-gargantext
Commit 034ea2e7 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski
Browse files
Options

[REST] refactored rest responses to Either RESTError a 

This way we can have a handle of the errors in the high-level
components. Before they were implicitly discarded.
parent b2eab45c
Hide whitespace changes
Inline Side-by-side
Showing with 709 additions and 570 deletions
src/Gargantext/Components/App/Data.purs
View file @ 034ea2e7
module Gargantext.Components.App.Data (App, Boxes, emptyApp) where
import Data.Set as Set
import Data.Maybe (Maybe(..))
import Data.Set as Set
import Toestand as T
import Gargantext.Prelude
......@@ -15,11 +15,12 @@ import Gargantext.Routes (AppRoute(Home))
import Gargantext.Sessions as Sessions
import Gargantext.Sessions (Session, Sessions)
import Gargantext.Sessions.Types (OpenNodes(..))
import Gargantext.Types (Handed(RightHanded), SidePanelState(..))
import Gargantext.Types (FrontendError, Handed(RightHanded), SidePanelState(..))
import Gargantext.Utils.Toestand as T2
type App =
{ backend :: Maybe Backend
, errors :: Array FrontendError
, forestOpen :: OpenNodes
, graphVersion :: T2.Reload
, handed :: Handed
......@@ -42,6 +43,7 @@ type App =
emptyApp :: App
emptyApp =
{ backend : Nothing
, errors : []
, forestOpen : OpenNodes $ Set.empty
, graphVersion : T2.newReload
, handed : RightHanded
......@@ -63,6 +65,7 @@ emptyApp =
type Boxes =
{ backend :: T.Box (Maybe Backend)
, errors :: T.Box (Array FrontendError)
, forestOpen :: T.Box OpenNodes
, graphVersion :: T2.ReloadS
, handed :: T.Box Handed
......
src/Gargantext/Components/Category.purs
View file @ 034ea2e7
-- TODO: this module should be replaced by FacetsTable
module Gargantext.Components.Category where
import Gargantext.Prelude
import Data.Array as A
import Data.Either (Either)
import Data.Generic.Rep (class Generic)
import Data.Map as Map
import Data.Maybe (Maybe(..))
......@@ -10,16 +13,13 @@ import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Gargantext.Prelude
import Gargantext.Components.Category.Types
( Category(..), Star(..), cat2score, categories, clickAgain, star2score, stars )
import Gargantext.Components.DocsTable.Types
( DocumentsView(..), LocalCategories, LocalUserScore )
import Gargantext.Utils.Reactix as R2
import Gargantext.Components.Category.Types (Category(..), Star(..), cat2score, categories, clickAgain, star2score, stars)
import Gargantext.Components.DocsTable.Types (DocumentsView(..), LocalCategories, LocalUserScore)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, put)
import Gargantext.Types (NodeID, NodeType(..))
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Category"
......@@ -63,7 +63,7 @@ instance JSON.WriteForeign RatingQuery where
writeImpl (RatingQuery post) = JSON.writeImpl { ntc_nodesId: post.nodeIds
, ntc_category: post.rating }
putRating :: Session -> Int -> RatingQuery -> Aff (Array Int)
putRating :: Session -> Int -> RatingQuery -> Aff (Either RESTError (Array Int))
putRating session nodeId = put session $ ratingRoute where
ratingRoute = NodeAPI Node (Just nodeId) "category"
......@@ -147,5 +147,5 @@ instance JSON.WriteForeign CategoryQuery where
categoryRoute :: Int -> SessionRoute
categoryRoute nodeId = NodeAPI Node (Just nodeId) "category"
putCategories :: Session -> Int -> CategoryQuery -> Aff (Array Int)
putCategories :: Session -> Int -> CategoryQuery -> Aff (Either RESTError (Array Int))
putCategories session nodeId = put session $ categoryRoute nodeId
src/Gargantext/Components/DocsTable.purs
View file @ 034ea2e7
-- TODO: this module should be replaced by FacetsTable
module Gargantext.Components.DocsTable where
import Gargantext.Prelude
import Prelude
import Control.Monad.Error.Class (throwError)
import DOM.Simple.Console (log2)
import DOM.Simple.Event as DE
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
import Data.Array as A
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Lens ((^.))
import Data.Lens.At (at)
import Data.Lens.Record (prop)
import Data.Map as Map
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe, isJust, maybe)
import Data.Newtype (class Newtype)
import Data.Ord.Down (Down(..))
import Data.Set (Set)
import Data.Set as Set
import Data.Set as Set
import Data.String as Str
import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..))
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Aff (Aff, error, launchAff_)
import Effect.Class (liftEffect)
import Gargantext.Components.Category (rating)
import Gargantext.Components.Category.Types (Star(..))
import Gargantext.Components.DocsTable.Types (DocumentsView(..), Hyperdata(..), LocalUserScore, Query, Response(..), Year, sampleData)
import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Nodes.Texts.Types as TextsT
import Gargantext.Components.Table as TT
import Gargantext.Components.Table.Types as TT
import Gargantext.Components.Table as TT
import Gargantext.Components.Table.Types as TT
import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (Frontends, url)
import Gargantext.Hooks.Loader (useLoader, useLoaderWithCacheAPI, HashedResponse(..))
import Gargantext.Prelude
import Gargantext.Prelude (class Ord, Unit, bind, const, discard, identity, mempty, otherwise, pure, show, unit, ($), (/=), (<$>), (<<<), (<>), (==))
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Routes as Routes
......@@ -41,7 +46,6 @@ import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.QueryString (joinQueryStrings, mQueryParam, mQueryParamS, queryParam, queryParamS)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Prelude
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
......@@ -221,9 +225,9 @@ type PageParams = {
, yearFilter :: Maybe Year
}
getPageHash :: Session -> PageParams -> Aff String
getPageHash session { nodeId, tabType } = do
(get session $ tableHashRoute nodeId tabType) :: Aff String
getPageHash :: Session -> PageParams -> Aff (Either RESTError String)
getPageHash session { nodeId, tabType } =
get session $ tableHashRoute nodeId tabType
convOrderBy :: Maybe (TT.OrderByDirection TT.ColumnName) -> Maybe OrderBy
convOrderBy (Just (TT.ASC (TT.ColumnName "Date"))) = Just DateAsc
......@@ -261,7 +265,6 @@ filterDocsByYear year docs = A.filter filterFunc docs
pageLayout :: R2.Component PageLayoutProps
pageLayout = R.createElement pageLayoutCpt
pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = here.component "pageLayout" cpt where
cpt props@{ cacheState
......@@ -318,12 +321,12 @@ pageLayoutCpt = here.component "pageLayout" cpt where
paramsS' <- T.useLive T.unequal paramsS
let loader p = do
let route = tableRouteWithPage (p { params = paramsS', query = query })
res <- get session $ route
eRes <- get session $ route
liftEffect $ do
here.log2 "table route" route
here.log2 "table res" res
pure $ handleResponse res
render (Tuple count documents) = pagePaintRaw { documents
here.log2 "table res" eRes
pure $ handleResponse <$> eRes
let render (Tuple count documents) = pagePaintRaw { documents
, layout: props { params = paramsS'
, totalRecords = count }
, localCategories
......@@ -562,7 +565,7 @@ tableRouteWithPage { listId, nodeId, params: { limit, offset, orderBy, searchTyp
q = queryParamS "query" query
y = mQueryParam "year" yearFilter
deleteAllDocuments :: Session -> Int -> Aff (Array Int)
deleteAllDocuments :: Session -> Int -> Aff (Either RESTError (Array Int))
deleteAllDocuments session = delete session <<< documentsRoute
-- TODO: not optimal but Data.Set lacks some function (Set.alter)
......
src/Gargantext/Components/FacetsTable.purs
View file @ 034ea2e7
......@@ -3,16 +3,18 @@
-- has not been ported to this module yet.
module Gargantext.Components.FacetsTable where
import Data.Generic.Rep (class Generic)
import Gargantext.Prelude
import Data.Either (Either(..))
import Data.Eq.Generic (genericEq)
import Data.Show.Generic (genericShow)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Newtype (class Newtype)
import Data.Sequence (Seq)
import Data.Sequence as Seq
import Data.Set (Set)
import Data.Set as Set
import Data.Tuple (fst, snd)
import Data.Show.Generic (genericShow)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
......@@ -21,16 +23,12 @@ import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.Category (CategoryQuery(..), putCategories)
import Gargantext.Components.Category.Types (Category(..), decodeCategory, favCategory)
import Gargantext.Components.Search
( Contact(..), Document(..), HyperdataRowContact(..), HyperdataRowDocument(..)
, SearchQuery, SearchResult(..), SearchResultTypes(..) )
import Gargantext.Components.Search (Contact(..), Document(..), HyperdataRowContact(..), HyperdataRowDocument(..), SearchQuery, SearchResult(..), SearchResultTypes(..))
import Gargantext.Components.Table as T
import Gargantext.Components.Table.Types as T
import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (url, Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(Search, NodeAPI))
......@@ -153,12 +151,6 @@ docViewCpt = here.component "docView" cpt
]
-} ]
]
where
buttonStyle = { backgroundColor: "peru"
, border: "white"
, color: "white"
, float: "right"
, padding: "9px" }
performDeletions :: Session -> Int -> T.Box Deletions -> Deletions -> Effect Unit
performDeletions session nodeId deletions deletions' = do
......@@ -221,8 +213,8 @@ type PagePath = { nodeId :: Int
initialPagePath :: {session :: Session, nodeId :: Int, listId :: Int, query :: SearchQuery} -> PagePath
initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, query, params: T.initialParams}
loadPage :: PagePath -> Aff Rows
loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy, searchType}} = do
loadPage :: PagePath -> Aff (Either RESTError Rows)
loadPage { session, nodeId, listId, query, params: {limit, offset, orderBy }} = do
let
convOrderBy (T.ASC (T.ColumnName "Date")) = DateAsc
convOrderBy (T.DESC (T.ColumnName "Date")) = DateDesc
......@@ -235,12 +227,15 @@ loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy, searc
p = Search { listId, offset, limit, orderBy: convOrderBy <$> orderBy } (Just nodeId)
--SearchResult {result} <- post session p $ SearchQuery {query: concat query, expected:searchType}
SearchResult {result} <- post session p query
-- $ SearchQuery {query: concat query, expected: SearchDoc}
pure $ case result of
SearchResultDoc {docs} -> Docs {docs: doc2view <$> Seq.fromFoldable docs}
SearchResultContact {contacts} -> Contacts {contacts: contact2view <$> Seq.fromFoldable contacts}
errMessage -> Docs {docs: Seq.fromFoldable [err2view errMessage]} -- TODO better error view
eSearchResult <- post session p query
case eSearchResult of
Left err -> pure $ Left err
Right (SearchResult {result}) ->
-- $ SearchQuery {query: concat query, expected: SearchDoc}
pure $ Right $ case result of
SearchResultDoc {docs} -> Docs {docs: doc2view <$> Seq.fromFoldable docs}
SearchResultContact {contacts} -> Contacts {contacts: contact2view <$> Seq.fromFoldable contacts}
errMessage -> Docs {docs: Seq.fromFoldable [err2view errMessage]} -- TODO better error view
doc2view :: Document -> DocumentsView
doc2view ( Document { id
......@@ -417,7 +412,7 @@ derive instance Generic DeleteDocumentQuery _
derive instance Newtype DeleteDocumentQuery _
derive newtype instance JSON.WriteForeign DeleteDocumentQuery
deleteDocuments :: Session -> Int -> DeleteDocumentQuery -> Aff (Array Int)
deleteDocuments :: Session -> Int -> DeleteDocumentQuery -> Aff (Either RESTError (Array Int))
deleteDocuments session nodeId =
deleteWithBody session $ NodeAPI Node (Just nodeId) "documents"
src/Gargantext/Components/FolderView.purs
View file @ 034ea2e7
module Gargantext.Components.FolderView where
import DOM.Simple.Console (log, log2)
import Control.Monad.Error.Class (throwError)
import Data.Array as A
import Data.Either (Either(..))
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Nullable (null)
import Data.Traversable (traverse_)
import DOM.Simple.Console (log, log2)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Aff (Aff, error)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode)
......@@ -23,6 +30,7 @@ import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadArbitraryFile
import Gargantext.Components.Forest.Tree.Node.Box (nodePopupView)
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..), fTreeID)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Ordering, Unit, bind, compare, discard, pure, unit, void, ($), (<$>), (<>))
import Gargantext.Routes (AppRoute(Home), SessionRoute(..), appPath, nodeTypeAppRoute)
......@@ -32,10 +40,6 @@ import Gargantext.Types as GT
import Gargantext.Utils.Popover as Popover
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
foreign import back :: Effect Unit
foreign import link :: String -> Effect Unit
......@@ -246,7 +250,7 @@ type LoadProps =
reload :: T2.Reload
)
loadFolders :: Record LoadProps -> Aff FTree
loadFolders :: Record LoadProps -> Aff (Either RESTError FTree)
loadFolders {nodeId, session} = get session $ TreeFirstLevel (Just nodeId) ""
type PerformActionProps =
......@@ -295,7 +299,7 @@ performAction = performAction' where
_ -> void $ deleteNode p.session nt id
refreshFolders p
doSearch task p@{ tasks, nodeId: id } = liftEffect $ do
doSearch task { tasks, nodeId: id } = liftEffect $ do
GAT.insert id task tasks
log2 "[performAction] DoSearch task:" task
......@@ -323,12 +327,15 @@ performAction = performAction' where
log2 "[performAction] UploadFile, uploaded, task:" task
uploadArbitraryFile' mName blob p@{ tasks, nodeId: id } = do
task <- uploadArbitraryFile p.session id { blob, mName }
liftEffect $ do
GAT.insert id task tasks
log2 "[performAction] UploadArbitraryFile, uploaded, task:" task
moveNode params p@{ session } = traverse_ f params where
eTask <- uploadArbitraryFile p.session id { blob, mName }
case eTask of
Left _err -> throwError $ error "[uploadArbitraryFile] RESTError"
Right task -> do
liftEffect $ do
GAT.insert id task tasks
log2 "[performAction] UploadArbitraryFile, uploaded, task:" task
moveNode params p = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
void $ moveNodeReq p.session in' out
refreshFolders p
......
src/Gargantext/Components/Forest/Tree.purs
View file @ 034ea2e7
......@@ -2,12 +2,14 @@ module Gargantext.Components.Forest.Tree where
import Gargantext.Prelude
import Control.Monad.Error.Class (throwError)
import Data.Array as A
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Data.Traversable (traverse_, traverse)
import DOM.Simple.Console (log, log2)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Aff (Aff, error)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
......@@ -30,6 +32,7 @@ import Gargantext.Components.Forest.Tree.Node.Action.Update (updateRequest)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile, uploadArbitraryFile)
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..), fTreeID)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (AppRoute)
......@@ -83,10 +86,10 @@ treeLoaderCpt = here.component "treeLoader" cpt where
common = RecordE.pick p :: Record Common
extra = { tree: tree', reloadTree: p.reload, session }
getNodeTree :: Session -> ID -> Aff FTree
getNodeTree :: Session -> ID -> Aff (Either RESTError FTree)
getNodeTree session nodeId = get session $ GR.NodeAPI GT.Tree (Just nodeId) ""
getNodeTreeFirstLevel :: Session -> ID -> Aff FTree
getNodeTreeFirstLevel :: Session -> ID -> Aff (Either RESTError FTree)
getNodeTreeFirstLevel session nodeId = get session $ GR.TreeFirstLevel (Just nodeId) ""
type NodeProps = ( reloadTree :: T2.ReloadS, session :: Session | Common )
......@@ -244,10 +247,13 @@ uploadFile' nodeType fileType mName contents p@{ tasks, tree: (NTree (LNode { id
log2 "[performAction] UploadFile, uploaded, task:" task
uploadArbitraryFile' mName blob p@{ tasks, tree: (NTree (LNode { id }) _) } = do
task <- uploadArbitraryFile p.session id { blob, mName }
liftEffect $ do
GAT.insert id task tasks
log2 "[performAction] UploadArbitraryFile, uploaded, task:" task
eTask <- uploadArbitraryFile p.session id { blob, mName }
case eTask of
Left err -> throwError $ error $ "[uploadArbitraryFile'] RESTError"
Right task -> do
liftEffect $ do
GAT.insert id task tasks
log2 "[performAction] UploadArbitraryFile, uploaded, task:" task
moveNode params p@{ forestOpen, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
......
src/Gargantext/Components/Forest/Tree/Node/Action/Add.purs
View file @ 034ea2e7
module Gargantext.Components.Forest.Tree.Node.Action.Add where
import Gargantext.Prelude
import Control.Monad.Error.Class (throwError)
import Data.Array (head, length)
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..), fromMaybe, isJust)
import Data.Newtype (class Newtype)
import Data.String (Pattern(..), indexOf)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Aff (Aff, error, launchAff_)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
import Web.HTML (window)
import Web.HTML.Navigator (userAgent)
import Web.HTML.Window (navigator)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox)
import Gargantext.Components.Forest.Tree.Node.Tools (formChoiceSafe, panel, submitButton)
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Lang (Lang(..), translate)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
import Gargantext.Types (NodeType(..), charCodeIcon)
import Gargantext.Types as GT
import Gargantext.Utils (nbsp)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
import Web.HTML (window)
import Web.HTML.Navigator (userAgent)
import Web.HTML.Window (navigator)
import Gargantext.Prelude
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Add"
addNode :: Session -> GT.ID -> AddNodeValue -> Aff (Array GT.ID)
addNode :: Session -> GT.ID -> AddNodeValue -> Aff (Either RESTError (Array GT.ID))
addNode session parentId = post session $ GR.NodeAPI GT.Node (Just parentId) ""
addNodeAsync :: Session
......@@ -40,9 +45,12 @@ addNodeAsync :: Session
-> AddNodeValue
-> Aff GT.AsyncTaskWithType
addNodeAsync session parentId q = do
task <- post session p q
pure $ GT.AsyncTaskWithType {task, typ: GT.AddNode}
where p = GR.NodeAPI GT.Node (Just parentId) (GT.asyncTaskTypePath GT.AddNode)
eTask :: Either RESTError GT.AsyncTask <- post session p q
case eTask of
Left _err -> liftEffect $ throwError $ error "[addNodeAsync] RESTError"
Right task -> pure $ GT.AsyncTaskWithType { task, typ: GT.AddNode }
where
p = GR.NodeAPI GT.Node (Just parentId) (GT.asyncTaskTypePath GT.AddNode)
----------------------------------------------------------------------
-- TODO AddNodeParams
......
src/Gargantext/Components/Forest/Tree/Node/Action/Contact.purs
View file @ 034ea2e7
......@@ -2,6 +2,7 @@ module Gargantext.Components.Forest.Tree.Node.Action.Contact where
import Prelude
import Data.Either (Either)
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff, launchAff)
import Formula as F
......@@ -11,6 +12,7 @@ import Toestand as T
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Contact.Types (AddContactParams(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
import Gargantext.Types (ID)
......@@ -20,7 +22,7 @@ import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Contact"
contactReq :: Session -> ID -> AddContactParams -> Aff ID
contactReq :: Session -> ID -> AddContactParams -> Aff (Either RESTError ID)
contactReq session nodeId =
post session $ GR.NodeAPI GT.Annuaire (Just nodeId) "contact"
......@@ -56,8 +58,8 @@ textInputBox :: R2.Leaf TextInputBoxProps
textInputBox props = R.createElement textInputBoxCpt props []
textInputBoxCpt :: R.Component TextInputBoxProps
textInputBoxCpt = here.component "textInputBox" cpt where
cpt p@{ boxName, boxAction, dispatch, isOpen
, params: { firstname, lastname } } _ =
cpt { boxName, boxAction, dispatch, isOpen
, params: { firstname, lastname } } _ =
content <$> T.useLive T.unequal isOpen
<*> T.useBox firstname <*> T.useBox lastname
where
......
src/Gargantext/Components/Forest/Tree/Node/Action/Delete.purs
View file @ 034ea2e7
module Gargantext.Components.Forest.Tree.Node.Action.Delete
where
import Gargantext.Prelude
import Data.Either (Either)
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, delete, put_)
import Gargantext.Types as GT
import Gargantext.Types (NodeType(..))
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
here :: R2.Here
......@@ -21,7 +23,7 @@ here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Delete"
-- TODO Delete with asyncTaskWithType
deleteNode :: Session -> NodeType -> GT.ID -> Aff GT.ID
deleteNode :: Session -> NodeType -> GT.ID -> Aff (Either RESTError GT.ID)
deleteNode session nt nodeId = delete session $ NodeAPI GT.Node (Just nodeId) ""
{-
......@@ -32,7 +34,7 @@ deleteNode session nt nodeId = delete session $ NodeAPI GT.Node (Just nodeId) ""
-}
type ParentID = GT.ID
unpublishNode :: Session -> Maybe ParentID -> GT.ID -> Aff GT.ID
unpublishNode :: Session -> Maybe ParentID -> GT.ID -> Aff (Either RESTError GT.ID)
unpublishNode s p n = put_ s $ NodeAPI GT.Node p ("unpublish/" <> show n)
......
src/Gargantext/Components/Forest/Tree/Node/Action/Link.purs
View file @ 034ea2e7
module Gargantext.Components.Forest.Tree.Node.Action.Link where
import Gargantext.Prelude
import Control.Monad.Error.Class (throwError)
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Show.Generic (genericShow)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Data.Tuple.Nested ((/\))
import Data.Show.Generic (genericShow)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
......@@ -14,10 +18,10 @@ import Toestand as T
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Prelude
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, post)
import Gargantext.Types as GT
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
here :: R2.Here
......@@ -33,9 +37,11 @@ derive newtype instance JSON.WriteForeign LinkNodeReq
linkNodeReq :: Session -> Maybe GT.NodeType -> GT.ID -> GT.ID -> Aff GT.AsyncTaskWithType
linkNodeReq session nt fromId toId = do
task <- post session (NodeAPI GT.Node (Just fromId) "update")
(LinkNodeReq { nodeType: linkNodeType nt, id: toId })
pure $ GT.AsyncTaskWithType {task, typ: GT.UpdateNode }
eTask :: Either RESTError GT.AsyncTask <- post session (NodeAPI GT.Node (Just fromId) "update")
(LinkNodeReq { nodeType: linkNodeType nt, id: toId })
case eTask of
Left _err -> liftEffect $ throwError $ error "[linkNodeReq] RESTError"
Right task -> pure $ GT.AsyncTaskWithType { task, typ: GT.UpdateNode }
linkNodeType :: Maybe GT.NodeType -> GT.NodeType
linkNodeType (Just GT.Corpus) = GT.Annuaire
......@@ -48,7 +54,7 @@ linkNode = R.createElement linkNodeCpt
linkNodeCpt :: R.Component SubTreeParamsIn
linkNodeCpt = here.component "linkNode" cpt
where
cpt p@{dispatch, subTreeParams, id, nodeType, session, handed} _ = do
cpt { dispatch, handed, id, nodeType, session, subTreeParams } _ = do
action <- T.useBox (LinkNode { nodeType: Nothing, params: Nothing})
action' <- T.useLive T.unequal action
......
src/Gargantext/Components/Forest/Tree/Node/Action/Merge.purs
View file @ 034ea2e7
module Gargantext.Components.Forest.Tree.Node.Action.Merge where
import Gargantext.Prelude
import Data.Either (Either)
import Data.Maybe (Maybe(..))
import Data.Set as Set
import Effect.Aff (Aff)
......@@ -10,16 +13,16 @@ import Toestand as T
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel, checkbox, checkboxesListGroup)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Prelude
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, put_)
import Gargantext.Types as GT
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Merge"
mergeNodeReq :: Session -> GT.ID -> GT.ID -> Aff (Array GT.ID)
mergeNodeReq :: Session -> GT.ID -> GT.ID -> Aff (Either RESTError (Array GT.ID))
mergeNodeReq session fromId toId =
put_ session $ NodeAPI GT.Node (Just fromId) ("merge/" <> show toId)
......@@ -28,7 +31,7 @@ mergeNode = R.createElement mergeNodeCpt
mergeNodeCpt :: R.Component SubTreeParamsIn
mergeNodeCpt = here.component "mergeNode" cpt
where
cpt p@{dispatch, subTreeParams, id, nodeType, session, handed} _ = do
cpt {dispatch, subTreeParams, id, nodeType, session, handed} _ = do
action <- T.useBox (MergeNode { params: Nothing })
action' <- T.useLive T.unequal action
......
src/Gargantext/Components/Forest/Tree/Node/Action/Move.purs
View file @ 034ea2e7
module Gargantext.Components.Forest.Tree.Node.Action.Move where
import Gargantext.Prelude
import Data.Either (Either)
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, put_)
import Gargantext.Types as GT
......@@ -19,7 +21,7 @@ import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Move"
moveNodeReq :: Session -> GT.ID -> GT.ID -> Aff (Array GT.ID)
moveNodeReq :: Session -> GT.ID -> GT.ID -> Aff (Either RESTError (Array GT.ID))
moveNodeReq session fromId toId =
put_ session $ NodeAPI GT.Node (Just fromId) ("move/" <> show toId)
......
src/Gargantext/Components/Forest/Tree/Node/Action/Rename.purs
View file @ 034ea2e7
module Gargantext.Components.Forest.Tree.Node.Action.Rename where
import Data.Either (Either)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
......@@ -8,14 +10,15 @@ import Simple.JSON as JSON
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action
import Gargantext.Types as GT
import Gargantext.Types (ID)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, put)
import Gargantext.Types (ID)
import Gargantext.Types as GT
------------------------------------------------------------------------
rename :: Session -> ID -> RenameValue -> Aff (Array ID)
rename :: Session -> ID -> RenameValue -> Aff (Either RESTError (Array ID))
rename session renameNodeId =
put session $ GR.NodeAPI GT.Node (Just renameNodeId) "rename"
......
src/Gargantext/Components/Forest/Tree/Node/Action/Search/Types.purs
View file @ 034ea2e7
module Gargantext.Components.Forest.Tree.Node.Action.Search.Types where
import Control.Monad.Error.Class (throwError)
import Data.Array (concat)
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Newtype (class Newtype)
......@@ -9,15 +11,17 @@ import Data.Set as Set
import Data.String as String
import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Effect.Aff (Aff, error)
import Effect.Class (liftEffect)
import Simple.JSON as JSON
import Simple.JSON.Generics as JSONG
import URI.Extra.QueryPairs as QP
import URI.Query as Q
import Gargantext.Prelude
import Gargantext.Components.Lang
import Gargantext.Components.Lang (Lang)
import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (class ToUrl, backendUrl)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session(..), post)
......@@ -368,7 +372,9 @@ instance JSON.WriteForeign SearchQuery where
performSearch :: Session -> Int -> SearchQuery -> Aff GT.AsyncTaskWithType
performSearch session nodeId q = do
task <- post session p q
pure $ GT.AsyncTaskWithType {task, typ: GT.Query}
eTask :: Either RESTError GT.AsyncTask <- post session p q
case eTask of
Left _err -> liftEffect $ throwError $ error "[performSearch] RESTError"
Right task -> pure $ GT.AsyncTaskWithType { task, typ: GT.Query }
where
p = GR.NodeAPI GT.Corpus (Just nodeId) $ GT.asyncTaskTypePath GT.Query
src/Gargantext/Components/Forest/Tree/Node/Action/Share.purs
View file @ 034ea2e7
module Gargantext.Components.Forest.Tree.Node.Action.Share where
import Data.Either (Either)
import Data.Generic.Rep (class Generic)
import Data.Show.Generic (genericShow)
import Data.Maybe (Maybe(..))
import Data.Show.Generic (genericShow)
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
......@@ -16,7 +17,7 @@ import Gargantext.Components.Forest.Tree.Node.Action (Action)
import Gargantext.Components.Forest.Tree.Node.Action as Action
import Gargantext.Components.Forest.Tree.Node.Tools as Tools
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Prelude (class Eq, class Show, bind, pure, Unit)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
import Gargantext.Types (ID)
......@@ -27,7 +28,7 @@ here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Share"
------------------------------------------------------------------------
shareReq :: Session -> ID -> ShareNodeParams -> Aff ID
shareReq :: Session -> ID -> ShareNodeParams -> Aff (Either RESTError ID)
shareReq session nodeId =
post session $ GR.NodeAPI GT.Node (Just nodeId) "share"
......@@ -70,7 +71,7 @@ publishNode = R.createElement publishNodeCpt
publishNodeCpt :: R.Component SubTreeParamsIn
publishNodeCpt = here.component "publishNode" cpt
where
cpt p@{dispatch, subTreeParams, id, nodeType, session, handed} _ = do
cpt { dispatch, handed, id, nodeType, session, subTreeParams } _ = do
action <- T.useBox (Action.SharePublic { params: Nothing })
action' <- T.useLive T.unequal action
......
src/Gargantext/Components/Forest/Tree/Node/Action/Update.purs
View file @ 034ea2e7
module Gargantext.Components.Forest.Tree.Node.Action.Update where
import Gargantext.Components.Forest.Tree.Node.Action.Update.Types
import Control.Monad.Error.Class (throwError)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
......@@ -11,7 +13,9 @@ import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Update.Types
import Gargantext.Components.Forest.Tree.Node.Tools (formChoiceSafe, submitButton, panel)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
import Gargantext.Types (NodeType(..), ID)
......@@ -23,8 +27,10 @@ here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Update"
updateRequest :: UpdateNodeParams -> Session -> ID -> Aff GT.AsyncTaskWithType
updateRequest updateNodeParams session nodeId = do
task <- post session p updateNodeParams
pure $ GT.AsyncTaskWithType {task, typ: GT.UpdateNode }
eTask :: Either RESTError GT.AsyncTask <- post session p updateNodeParams
case eTask of
Left _err -> liftEffect $ throwError $ error "[updateRequest] RESTError"
Right task -> pure $ GT.AsyncTaskWithType { task, typ: GT.UpdateNode }
where
p = GR.NodeAPI GT.Node (Just nodeId) "update"
......@@ -37,11 +43,11 @@ update :: R2.Component UpdateProps
update = R.createElement updateCpt
updateCpt :: R.Component UpdateProps
updateCpt = here.component "update" cpt where
cpt props@{ dispatch, nodeType: Dashboard } _ = pure $ updateDashboard props []
cpt props@{ dispatch, nodeType: Graph } _ = pure $ updateGraph props []
cpt props@{ dispatch, nodeType: NodeList } _ = pure $ updateNodeList props []
cpt props@{ dispatch, nodeType: Texts } _ = pure $ updateTexts props []
cpt props@{ dispatch, nodeType: _ } _ = pure $ updateOther props []
cpt props@{ nodeType: Dashboard } _ = pure $ updateDashboard props []
cpt props@{ nodeType: Graph } _ = pure $ updateGraph props []
cpt props@{ nodeType: NodeList } _ = pure $ updateNodeList props []
cpt props@{ nodeType: Texts } _ = pure $ updateTexts props []
cpt props@{ nodeType: _ } _ = pure $ updateOther props []
updateDashboard :: R2.Component UpdateProps
updateDashboard = R.createElement updateDashboardCpt
......@@ -99,7 +105,7 @@ updateOther :: R2.Component UpdateProps
updateOther = R.createElement updateOtherCpt
updateOtherCpt :: R.Component UpdateProps
updateOtherCpt = here.component "updateOther" cpt where
cpt { dispatch } _ = do
cpt _ _ = do
pure $ H.div {} []
-- fragmentPT $ "Update " <> show nodeType
src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs
View file @ 034ea2e7
module Gargantext.Components.Forest.Tree.Node.Action.Upload where
import Data.Either (fromRight')
import Data.Generic.Rep (class Generic)
import Gargantext.Prelude
import Control.Monad.Error.Class (throwError)
import DOM.Simple.Console (log2)
import Data.Either (Either(..), fromRight')
import Data.Eq.Generic (genericEq)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..), fromJust, fromMaybe)
import Data.Newtype (class Newtype)
import Data.String.Regex as DSR
import Data.String.Regex.Flags as DSRF
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect)
import Partial.Unsafe (unsafePartial, unsafeCrashWith)
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import URI.Extra.QueryPairs as QP
-- import Web.File.Blob (Blob)
import Web.File.FileReader.Aff (readAsDataURL)
import Gargantext.Prelude
import Effect.Exception (error)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..), Props)
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileBlob(..), readUFBAsText)
import Gargantext.Components.Forest.Tree.Node.Tools (fragmentPT, formChoiceSafe, panel)
import Gargantext.Components.Lang (Lang(..))
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, postWwwUrlencoded, post)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, postWwwUrlencoded)
import Gargantext.Types (NodeType(..), ID)
import Gargantext.Types as GT
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Partial.Unsafe (unsafePartial, unsafeCrashWith)
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import URI.Extra.QueryPairs as QP
import Web.File.FileReader.Aff (readAsDataURL)
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Upload"
......@@ -52,7 +53,7 @@ actionUploadCpt :: R.Component ActionUpload
actionUploadCpt = here.component "actionUpload" cpt where
cpt { nodeType: Corpus, dispatch, id, session } _ = pure $ uploadFileView {dispatch, id, nodeType: GT.Corpus, session}
cpt { nodeType: NodeList, dispatch, id, session } _ = pure $ uploadTermListView {dispatch, id, nodeType: GT.NodeList, session}
cpt props@{ nodeType: _, dispatch, id, session } _ = pure $ actionUploadOther props []
cpt props@{ nodeType: _ } _ = pure $ actionUploadOther props []
{-
actionUpload Annuaire id session dispatch =
......@@ -139,12 +140,6 @@ uploadFileViewCpt = here.component "uploadFileView" cpt
]
pure $ panel bodies footer
renderOptionFT :: FileType -> R.Element
renderOptionFT opt = H.option {} [ H.text $ show opt ]
renderOptionLang :: Lang -> R.Element
renderOptionLang opt = H.option {} [ H.text $ show opt ]
onChangeContents :: forall e. T.Box (Maybe UploadFile) -> E.SyntheticEvent_ e -> Effect Unit
onChangeContents mFile e = do
let mF = R2.inputFileNameWithBlob 0 e
......@@ -329,8 +324,10 @@ uploadFile session NodeList id JSON { mName, contents } = do
-}
uploadFile session nodeType id fileType { mName, contents } = do
-- contents <- readAsText blob
task <- postWwwUrlencoded session p bodyParams
pure $ GT.AsyncTaskWithType {task, typ: GT.Form}
eTask :: Either RESTError GT.AsyncTask <- postWwwUrlencoded session p bodyParams
case eTask of
Left _err -> liftEffect $ throwError $ error "[uploadFile] RESTError"
Right task -> pure $ GT.AsyncTaskWithType { task, typ: GT.Form }
--postMultipartFormData session p fileContents
where
p = case nodeType of
......@@ -351,7 +348,7 @@ uploadFile session nodeType id fileType { mName, contents } = do
uploadArbitraryFile :: Session
-> ID
-> {blob :: UploadFileBlob, mName :: Maybe String}
-> Aff GT.AsyncTaskWithType
-> Aff (Either RESTError GT.AsyncTaskWithType)
uploadArbitraryFile session id {mName, blob: UploadFileBlob blob} = do
contents <- readAsDataURL blob
uploadArbitraryDataURL session id mName contents
......@@ -360,12 +357,12 @@ uploadArbitraryDataURL :: Session
-> ID
-> Maybe String
-> String
-> Aff GT.AsyncTaskWithType
-> Aff (Either RESTError GT.AsyncTaskWithType)
uploadArbitraryDataURL session id mName contents' = do
let re = fromRight' (\_ -> unsafeCrashWith "Unexpected Left") $ DSR.regex "data:.*;base64," DSRF.noFlags
contents = DSR.replace re "" contents'
task <- postWwwUrlencoded session p (bodyParams contents)
pure $ GT.AsyncTaskWithType { task, typ: GT.Form }
eTask :: Either RESTError GT.AsyncTask <- postWwwUrlencoded session p (bodyParams contents)
pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.Form }) <$> eTask
where
p = GR.NodeAPI GT.Node (Just id) $ GT.asyncTaskTypePath GT.UploadFile
......@@ -447,7 +444,6 @@ uploadTermButtonCpt :: R.Component UploadTermButtonProps
uploadTermButtonCpt = here.component "uploadTermButton" cpt
where
cpt { dispatch
, id
, mFile
, nodeType
, uploadType } _ = do
......
src/Gargantext/Components/Forest/Tree/Node/Tools/ProgressBar.purs
View file @ 034ea2e7
module Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar where
import Gargantext.Prelude
import Control.Monad.Error.Class (throwError)
import Data.Either (Either(..))
import Data.Int (fromNumber)
import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Aff (Aff, error, launchAff_)
import Effect.Class (liftEffect)
import Effect.Timer (clearInterval, setInterval)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Prelude
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar"
......@@ -34,13 +37,11 @@ type Props = (
asyncProgressBar :: R2.Component Props
asyncProgressBar = R.createElement asyncProgressBarCpt
asyncProgressBarCpt :: R.Component Props
asyncProgressBarCpt = here.component "asyncProgressBar" cpt
where
cpt props@{ asyncTask: (GT.AsyncTaskWithType {task: GT.AsyncTask {id}})
, barType
, nodeId
, onFinish
} _ = do
progress <- T.useBox 0.0
......@@ -49,16 +50,20 @@ asyncProgressBarCpt = here.component "asyncProgressBar" cpt
R.useEffectOnce' $ do
intervalId <- setInterval 1000 $ do
launchAff_ $ do
asyncProgress@(GT.AsyncProgress {status}) <- queryProgress props
liftEffect do
T.write_ (min 100.0 $ GT.progressPercent asyncProgress) progress
if (status == GT.IsFinished) || (status == GT.IsKilled) || (status == GT.IsFailure) then do
_ <- case R.readRef intervalIdRef of
Nothing -> pure unit
Just iid -> clearInterval iid
onFinish unit
else
pure unit
eAsyncProgress <- queryProgress props
case eAsyncProgress of
Left _err -> throwError $ error "[asyncProgressBar] RESTError"
Right asyncProgress -> do
let GT.AsyncProgress { status } = asyncProgress
liftEffect do
T.write_ (min 100.0 $ GT.progressPercent asyncProgress) progress
if (status == GT.IsFinished) || (status == GT.IsKilled) || (status == GT.IsFailure) then do
_ <- case R.readRef intervalIdRef of
Nothing -> pure unit
Just iid -> clearInterval iid
onFinish unit
else
pure unit
R.setRef intervalIdRef $ Just intervalId
......@@ -104,7 +109,7 @@ progressIndicatorCpt = here.component "progressIndicator" cpt
Nothing -> 0
Just x -> x
queryProgress :: Record Props -> Aff GT.AsyncProgress
queryProgress :: Record Props -> Aff (Either RESTError GT.AsyncProgress)
queryProgress { asyncTask: GT.AsyncTaskWithType { task: GT.AsyncTask {id}
, typ
}
......
src/Gargantext/Components/Forest/Tree/Node/Tools/SubTree.purs
View file @ 034ea2e7
module Gargantext.Components.Forest.Tree.Node.Tools.SubTree where
import Gargantext.Prelude
import Data.Array as A
import Data.Either (Either)
import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action (Props, Action, subTreeOut, setTreeOut)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeParams(..), SubTreeOut(..))
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..))
import Gargantext.Components.Forest.Tree.Node.Tools (nodeText)
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..))
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeParams(..), SubTreeOut(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session(..), get)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools.SubTree"
......@@ -42,14 +42,14 @@ subTreeView = R.createElement subTreeViewCpt
subTreeViewCpt :: R.Component SubTreeParamsProps
subTreeViewCpt = here.component "subTreeView" cpt
where
cpt params@{ action
, dispatch
, handed
, id
, nodeType
, session
, subTreeParams
} _ = do
cpt { action
, dispatch
, handed
, id
, nodeType
, session
, subTreeParams
} _ = do
let
SubTreeParams {showtypes} = subTreeParams
-- (valAction /\ setAction) = action
......@@ -67,12 +67,12 @@ subTreeViewCpt = here.component "subTreeView" cpt
, tree
} []
loadSubTree :: Array GT.NodeType -> Session -> Aff FTree
loadSubTree :: Array GT.NodeType -> Session -> Aff (Either RESTError FTree)
loadSubTree nodetypes session = getSubTree session treeId nodetypes
where
Session { treeId } = session
getSubTree :: Session -> Int -> Array GT.NodeType -> Aff FTree
getSubTree :: Session -> Int -> Array GT.NodeType -> Aff (Either RESTError FTree)
getSubTree session treeId showtypes = get session $ GR.NodeAPI GT.Tree (Just treeId) nodeTypes
where
nodeTypes = A.foldl (\a b -> a <> "type=" <> show b <> "&") "?" showtypes
......@@ -88,7 +88,7 @@ subTreeViewLoaded = R.createElement subTreeViewLoadedCpt
subTreeViewLoadedCpt :: R.Component CorpusTreeProps
subTreeViewLoadedCpt = here.component "subTreeViewLoaded" cpt
where
cpt p@{ dispatch, handed, id, nodeType, session, tree } _ = do
cpt p@{ handed } _ = do
let pRender = Record.merge { render: subTreeTreeView } p
pure $ H.div {className:"tree"}
......@@ -108,7 +108,6 @@ subTreeTreeView = R2.ntCreateElement subTreeTreeViewCpt
subTreeTreeViewCpt :: R2.NTComponent CorpusTreeRenderProps
subTreeTreeViewCpt = here.ntComponent "subTreeTreeView" cpt where
cpt (CorpusTreeRenderProps p@{ action
, dispatch
, handed
, id
, render
......@@ -142,7 +141,6 @@ subTreeTreeViewCpt = here.ntComponent "subTreeTreeView" cpt where
sortedAry = A.sortWith (\(NTree (LNode {id:id'}) _) -> id')
$ A.filter (\(NTree (LNode {id:id'}) _) -> id'/= id) ary
validNodeType = (A.elem nodeType valitypes) && (id /= targetId)
clickable = if validNodeType then "clickable" else ""
isSelected n action' = case (subTreeOut action') of
Nothing -> false
(Just (SubTreeOut {out})) -> n == out
src/Gargantext/Components/GraphExplorer.purs
View file @ 034ea2e7
module Gargantext.Components.GraphExplorer where
import Gargantext.Prelude hiding (max, min)
import Data.Array as A
import Data.Either (Either)
import Data.FoldableWithIndex (foldMapWithIndex)
import Data.Int (toNumber)
import Data.Map as Map
......@@ -19,13 +22,12 @@ import Record as Record
import Record.Extra as RX
import Toestand as T
import Gargantext.Prelude hiding (max,min)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Graph as Graph
import Gargantext.Components.GraphExplorer.Controls as Controls
import Gargantext.Components.GraphExplorer.Sidebar.Types as GEST
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Config.REST (RESTError)
import Gargantext.Data.Louvain as Louvain
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Hooks.Sigmax.Types as SigmaxT
......@@ -105,7 +107,7 @@ explorerCpt = here.component "explorer" cpt
, session
} _ = do
{ mMetaData } <- GEST.focusedSidePanel sidePanelGraph
graphVersion' <- T.useLive T.unequal graphVersion
_graphVersion' <- T.useLive T.unequal graphVersion
handed' <- T.useLive T.unequal handed
mMetaData' <- T.useLive T.unequal mMetaData
......@@ -115,7 +117,7 @@ explorerCpt = here.component "explorer" cpt
then SigmaxT.InitialRunning
else SigmaxT.InitialStopped
dataRef <- R.useRef graph
_dataRef <- R.useRef graph
graphRef <- R.useRef null
controls <- Controls.useGraphControls { forceAtlasS
, graph
......@@ -285,7 +287,7 @@ modeGraphType Types.Sources = "star"
modeGraphType Types.Terms = "def"
getNodes :: Session -> T2.Reload -> GET.GraphId -> Aff GET.HyperdataGraph
getNodes :: Session -> T2.Reload -> GET.GraphId -> Aff (Either RESTError GET.HyperdataGraph)
getNodes session graphVersion graphId =
get session $ NodeAPI Types.Graph
(Just graphId)
......@@ -305,8 +307,7 @@ transformGraph graph { edgeConfluence'
, edgeWeight'
, nodeSize'
, removedNodeIds'
, selectedNodeIds'
, showEdges' } = SigmaxT.Graph {nodes: newNodes, edges: newEdges}
, selectedNodeIds' } = SigmaxT.Graph {nodes: newNodes, edges: newEdges}
where
edges = SigmaxT.graphEdges graph
nodes = SigmaxT.graphNodes graph
......@@ -325,18 +326,10 @@ transformGraph graph { edgeConfluence'
newNodes = Seq.filter nodeFilter $ Seq.map (nodeMarked <<< nodeHideSize) nodes
newEdges = Seq.filter (edgeInGraph $ Set.fromFoldable $ Seq.map _.id newNodes) newEdges'
edgeFilter e = true
edgeFilter _e = true
nodeFilter n = nodeRemovedFilter n
nodeSizeFilter :: Record SigmaxT.Node -> Boolean
nodeSizeFilter node@{ size } = Range.within nodeSize' size
nodeRemovedFilter node@{ id } = not $ Set.member id removedNodeIds'
edgeConfluenceFilter :: Record SigmaxT.Edge -> Boolean
edgeConfluenceFilter edge@{ confluence } = Range.within edgeConfluence' confluence
edgeWeightFilter :: Record SigmaxT.Edge -> Boolean
edgeWeightFilter edge@{ weightIdx } = Range.within edgeWeight' $ toNumber weightIdx
nodeRemovedFilter { id } = not $ Set.member id removedNodeIds'
edgeHideConfluence :: Record SigmaxT.Edge -> Record SigmaxT.Edge
edgeHideConfluence edge@{ confluence } =
......@@ -352,13 +345,6 @@ transformGraph graph { edgeConfluence'
else
edge { hidden = true }
edgeShowFilter :: Record SigmaxT.Edge -> Record SigmaxT.Edge
edgeShowFilter edge =
if SigmaxT.edgeStateHidden showEdges' then
edge { hidden = true }
else
edge
edgeInGraph :: SigmaxT.NodeIds -> Record SigmaxT.Edge -> Boolean
edgeInGraph nodeIds e = (Set.member e.source nodeIds) && (Set.member e.target nodeIds)
......
src/Gargantext/Components/GraphExplorer/API.purs
View file @ 034ea2e7
module Gargantext.Components.GraphExplorer.API where
import Gargantext.Prelude
import Data.Either (Either(..))
import Data.Maybe (Maybe)
import Effect.Aff (Aff)
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Sigmax.Types as SigmaxT
import Gargantext.Prelude
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, get, post)
import Gargantext.Types as GT
......@@ -20,10 +22,10 @@ type GraphAsyncUpdateParams =
, version :: NTC.Version
)
graphAsyncUpdate :: Record GraphAsyncUpdateParams -> Aff GT.AsyncTaskWithType
graphAsyncUpdate :: Record GraphAsyncUpdateParams -> Aff (Either RESTError GT.AsyncTaskWithType)
graphAsyncUpdate { graphId, listId, nodes, session, termList, version } = do
task <- post session p q
pure $ GT.AsyncTaskWithType { task, typ: GT.GraphRecompute }
eTask <- post session p q
pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.GraphRecompute }) <$> eTask
where
p = GR.GraphAPI graphId $ GT.asyncTaskTypePath GT.GraphRecompute
q = { listId
......@@ -37,10 +39,10 @@ type GraphAsyncRecomputeParams =
, session :: Session
)
graphAsyncRecompute :: Record GraphAsyncRecomputeParams -> Aff GT.AsyncTaskWithType
graphAsyncRecompute :: Record GraphAsyncRecomputeParams -> Aff (Either RESTError GT.AsyncTaskWithType)
graphAsyncRecompute { graphId, session } = do
task <- post session p q
pure $ GT.AsyncTaskWithType { task, typ: GT.GraphRecompute }
eTask <- post session p q
pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.GraphRecompute }) <$> eTask
where
p = GR.GraphAPI graphId $ GT.asyncTaskTypePath GT.GraphRecompute
q = {}
......@@ -51,7 +53,7 @@ type QueryProgressParams =
, taskId :: String
)
queryProgress :: Record QueryProgressParams -> Aff GT.AsyncProgress
queryProgress :: Record QueryProgressParams -> Aff (Either RESTError GT.AsyncProgress)
queryProgress { graphId, session, taskId } = do
get session $ GR.GraphAPI graphId $ "async/" <> taskId <> "/poll"
......@@ -65,7 +67,7 @@ type GraphVersionsParams =
, session :: Session
)
graphVersions :: Record GraphVersionsParams -> Aff (Record GraphVersions)
graphVersions :: Record GraphVersionsParams -> Aff (Either RESTError (Record GraphVersions))
graphVersions { graphId, session } = get session $ GR.GraphAPI graphId $ "versions"
type UpdateGraphVersionsParams =
......@@ -73,7 +75,7 @@ type UpdateGraphVersionsParams =
, session :: Session
)
updateGraphVersions :: Record UpdateGraphVersionsParams -> Aff GET.GraphData
updateGraphVersions :: Record UpdateGraphVersionsParams -> Aff (Either RESTError GET.GraphData)
updateGraphVersions { graphId, session } = post session (GR.GraphAPI graphId $ "versions") {}
type CloneGraphParams =
......@@ -82,5 +84,5 @@ type CloneGraphParams =
, session :: Session
)
cloneGraph :: Record CloneGraphParams -> Aff Int
cloneGraph :: Record CloneGraphParams -> Aff (Either RESTError Int)
cloneGraph { hyperdataGraph, id, session } = post session (GR.GraphAPI id $ "clone") hyperdataGraph
src/Gargantext/Components/GraphExplorer/Button.purs
View file @ 034ea2e7
......@@ -3,11 +3,13 @@ module Gargantext.Components.GraphExplorer.Button
import Prelude
import Data.Either (Either(..))
import Data.Enum (fromEnum)
import Data.Maybe (Maybe(..))
import Data.DateTime as DDT
import Data.DateTime.Instant as DDI
import Data.String as DS
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
......@@ -19,6 +21,7 @@ import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadArbitraryData
import Gargantext.Components.GraphExplorer.API (cloneGraph)
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.GraphExplorer.Utils as GEU
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Sessions (Session)
......@@ -93,9 +96,14 @@ cameraButton { id
_ -> GET.Camera { ratio: 1.0, x: 0.0, y: 0.0 }
let hyperdataGraph' = GET.HyperdataGraph { graph: graphData, mCamera: Just camera }
launchAff_ $ do
clonedGraphId <- cloneGraph { id, hyperdataGraph: hyperdataGraph', session }
ret <- uploadArbitraryDataURL session clonedGraphId (Just $ nowStr <> "-" <> "screenshot.png") screen
liftEffect $ T2.reload reloadForest
pure ret
eClonedGraphId <- cloneGraph { id, hyperdataGraph: hyperdataGraph', session }
case eClonedGraphId of
Left err -> liftEffect $ log2 "[cameraButton] RESTError" err
Right clonedGraphId -> do
eRet <- uploadArbitraryDataURL session clonedGraphId (Just $ nowStr <> "-" <> "screenshot.png") screen
case eRet of
Left err -> liftEffect $ log2 "[cameraButton] RESTError" err
Right _ret -> do
liftEffect $ T2.reload reloadForest
, text: "Screenshot"
}
src/Gargantext/Components/GraphExplorer/Sidebar.purs
View file @ 034ea2e7
......@@ -2,33 +2,28 @@ module Gargantext.Components.GraphExplorer.Sidebar
-- (Props, sidebar)
where
import Gargantext.Prelude
import Control.Monad.Error.Class (throwError)
import Control.Parallel (parTraverse)
import Data.Array (head, last, concat)
import Data.Either (Either(..))
import Data.Int (fromString)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromJust)
import Data.Sequence as Seq
import Data.Set as Set
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Aff (Aff, error, launchAff_)
import Effect.Class (liftEffect)
import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as RH
import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RX
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.Lang (Lang(..))
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.GraphExplorer.Legend as Legend
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.Lang (Lang(..))
import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Components.Nodes.Corpus.Graph.Tabs (tabs) as CGT
import Gargantext.Components.RandomText (words)
import Gargantext.Components.Search (SearchType(..), SearchQuery(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Data.Array (mapMaybe)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Sigmax.Types as SigmaxT
......@@ -36,6 +31,13 @@ import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType, NodeID, TabSubType(..), TabType(..), TermList(..), modeTabType)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as H
import Reactix.DOM.HTML as RH
import Record as Record
import Record.Extra as RX
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.Sidebar"
......@@ -318,13 +320,14 @@ type SendPatches =
)
sendPatches :: Record SendPatches -> Effect Unit
sendPatches { graphId, metaData, nodes, session, termList, reloadForest } = do
sendPatches { metaData, nodes, session, termList, reloadForest } = do
launchAff_ do
patches <- (parTraverse (sendPatch termList session metaData) nodes) :: Aff (Array NTC.VersionedNgramsPatches)
patches <- (parTraverse (sendPatch termList session metaData) nodes) -- :: Aff (Array NTC.VersionedNgramsPatches)
let mPatch = last patches
case mPatch of
Nothing -> pure unit
Just (NTC.Versioned patch) -> do
Just (Left _err) -> throwError $ error $ "[sendPatches] RESTError"
Just (Right (NTC.Versioned _patch)) -> do
liftEffect $ T2.reload reloadForest
-- Why is this called delete node?
......@@ -332,11 +335,14 @@ sendPatch :: TermList
-> Session
-> GET.MetaData
-> Record SigmaxT.Node
-> Aff NTC.VersionedNgramsPatches
-> Aff (Either RESTError NTC.VersionedNgramsPatches)
sendPatch termList session (GET.MetaData metaData) node = do
ret <- NTC.putNgramsPatches coreParams versioned
task <- NTC.postNgramsChartsAsync coreParams -- TODO add task
pure ret
eRet <- NTC.putNgramsPatches coreParams versioned
case eRet of
Left err -> pure $ Left err
Right ret -> do
task <- NTC.postNgramsChartsAsync coreParams -- TODO add task
pure $ Right ret
where
nodeId :: NodeID
nodeId = unsafePartial $ fromJust $ fromString node.id
......
src/Gargantext/Components/NgramsTable.purs
View file @ 034ea2e7
......@@ -4,7 +4,10 @@ module Gargantext.Components.NgramsTable
, mainNgramsTable
) where
import Gargantext.Prelude
import Data.Array as A
import Data.Either (Either(..))
import Data.FunctorWithIndex (mapWithIndex)
import Data.Lens (Lens', to, (%~), (.~), (^.), (^?), view)
import Data.Lens.At (at)
......@@ -28,20 +31,18 @@ import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Prelude
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.AutoUpdate (autoUpdateElt)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Table as TT
import Gargantext.Components.Table.Types as TT
import Gargantext.Components.NgramsTable.Components as NTC
import Gargantext.Components.NgramsTable.Core (Action(..), CoreAction(..), CoreState, Dispatch, NgramsElement(..), NgramsPatch(..), NgramsTable, NgramsTerm, PageParams, PatchMap(..), Version, Versioned(..), VersionedNgramsTable, VersionedWithCountNgramsTable, _NgramsElement, _NgramsRepoElement, _NgramsTable, _children, _list, _ngrams, _ngrams_repo_elements, _ngrams_scores, _occurrences, _root, addNewNgramA, applyNgramsPatches, applyPatchSet, chartsAfterSync, commitPatch, convOrderBy, coreDispatch, filterTermSize, fromNgramsPatches, ngramsRepoElementToNgramsElement, ngramsTermText, normNgram, patchSetFromMap, replace, rootsOf, singletonNgramsTablePatch, syncResetButtons, toVersioned)
import Gargantext.Components.NgramsTable.Loader (useLoaderWithCacheAPI)
import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Table as TT
import Gargantext.Components.Table.Types as TT
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..)) as R
import Gargantext.Sessions (Session, get)
import Gargantext.Types (CTabNgramType, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, termLists, termSizes)
......@@ -113,7 +114,6 @@ type TableContainerProps =
tableContainer :: Record TableContainerProps -> Record TT.TableContainerProps -> R.Element
tableContainer p q = R.createElement (tableContainerCpt p) q []
tableContainerCpt :: Record TableContainerProps -> R.Component TT.TableContainerProps
tableContainerCpt { dispatch
, ngramsChildren
......@@ -277,7 +277,6 @@ type Props =
loadedNgramsTable :: R2.Component Props
loadedNgramsTable = R.createElement loadedNgramsTableCpt
loadedNgramsTableCpt :: R.Component Props
loadedNgramsTableCpt = here.component "loadedNgramsTable" cpt where
cpt props@{ afterSync
......@@ -534,7 +533,6 @@ type MainNgramsTableProps = (
mainNgramsTable :: R2.Component MainNgramsTableProps
mainNgramsTable = R.createElement mainNgramsTableCpt
mainNgramsTableCpt :: R.Component MainNgramsTableProps
mainNgramsTableCpt = here.component "mainNgramsTable" cpt
where
......@@ -588,7 +586,7 @@ mainNgramsTableCpt = here.component "mainNgramsTable" cpt
versionEndpoint { defaultListId, path: { nodeId, tabType, session } } _ = get session $ R.GetNgramsTableVersion { listId: defaultListId, tabType } (Just nodeId)
-- NOTE With cache off
loader :: PageParams -> Aff VersionedWithCountNgramsTable
loader :: PageParams -> Aff (Either RESTError VersionedWithCountNgramsTable)
loader path@{ listIds
, nodeId
, params: { limit, offset, orderBy }
......
src/Gargantext/Components/NgramsTable/API.purs
View file @ 034ea2e7
module Gargantext.Components.NgramsTable.API where
import Data.Either (Either)
import Effect.Aff (Aff)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
import Gargantext.Types as GT
......@@ -13,5 +16,6 @@ type UpdateNodeListParams =
, session :: Session
)
updateNodeList :: Record UpdateNodeListParams -> Aff Int
updateNodeList { listId, nodeId, nodeType, session } = post session (GR.RecomputeNgrams nodeType nodeId listId) {}
updateNodeList :: Record UpdateNodeListParams -> Aff (Either RESTError Int)
updateNodeList { listId, nodeId, nodeType, session } =
post session (GR.RecomputeNgrams nodeType nodeId listId) {}
src/Gargantext/Components/NgramsTable/Core.purs
View file @ 034ea2e7
......@@ -12,7 +12,7 @@ module Gargantext.Components.NgramsTable.Core
, NgramsPatch(..)
, NgramsPatches
, _NgramsTable
, NgramsTerm
, NgramsTerm(..)
, normNgram
, ngramsTermText
, findNgramRoot
......@@ -23,7 +23,7 @@ module Gargantext.Components.NgramsTable.Core
, VersionedWithCount(..)
, toVersioned
, VersionedNgramsPatches
, AsyncNgramsChartsUpdate
, AsyncNgramsChartsUpdate(..)
, VersionedNgramsTable
, VersionedWithCountNgramsTable
, NgramsTablePatch
......@@ -79,18 +79,18 @@ module Gargantext.Components.NgramsTable.Core
)
where
import Gargantext.Prelude
import Control.Monad.Error.Class (throwError)
import Control.Monad.State (class MonadState, execState)
import Data.Array (head)
import Data.Array as A
import Data.Bifunctor (lmap)
import Data.Either (Either(..))
import Data.Eq.Generic (genericEq)
import Data.Foldable (class Foldable, foldMap, foldl, foldr)
import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex, foldlWithIndex, foldrWithIndex)
--import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex)
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Ord.Generic (genericCompare)
import Data.Show.Generic (genericShow)
import Data.Lens (Iso', Lens', use, view, (%=), (%~), (.~), (?=), (^?))
import Data.Lens.At (class At, at)
import Data.Lens.Common (_Just)
......@@ -103,11 +103,12 @@ import Data.List as L
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe, fromMaybe', isJust)
import Data.Monoid (class Monoid)
import Data.Monoid.Additive (Additive(..))
import Data.Newtype (class Newtype)
import Data.Ord.Generic (genericCompare)
import Data.Set (Set)
import Data.Set as Set
import Data.Show.Generic (genericShow)
import Data.String as S
import Data.String.Common as DSC
import Data.String.Regex (Regex, regex, replace) as R
......@@ -117,36 +118,34 @@ import Data.Symbol (SProxy(..))
import Data.These (These(..))
import Data.Traversable (for, traverse_, traverse)
import Data.TraversableWithIndex (traverseWithIndex)
import Data.Tuple (Tuple(..), snd)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log, log2)
import Effect.Aff (Aff, launchAff_)
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (Aff, error, launchAff_)
import Effect.Class (liftEffect)
import Effect.Exception.Unsafe (unsafeThrow)
import FFI.Simple.Functions (delay)
import Foreign as F
import Foreign.Object as FO
import FFI.Simple.Functions (delay)
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Partial (crashWith)
import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
import Gargantext.Prelude
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Table as T
import Gargantext.Components.Table as T
import Gargantext.Components.Table.Types as T
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get, post, put)
import Gargantext.Types (AsyncTaskType(..), AsyncTaskWithType(..), CTabNgramType(..), ListId, OrderBy(..), ScoreType(..), TabSubType(..), TabType(..), TermList(..), TermSize(..))
import Gargantext.Types (AsyncTask, AsyncTaskType(..), AsyncTaskWithType(..), CTabNgramType(..), ListId, OrderBy(..), ScoreType(..), TabSubType(..), TabType(..), TermList(..), TermSize(..))
import Gargantext.Utils.Either (eitherMap)
import Gargantext.Utils.KarpRabin (indicesOfAny)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.NgramsTable.Core"
......@@ -905,7 +904,7 @@ setTermListP ngram patch_list = singletonNgramsTablePatch ngram pe
setTermListA :: NgramsTerm -> Replace TermList -> CoreAction
setTermListA ngram termList = CommitPatch $ setTermListP ngram termList
putNgramsPatches :: forall s. CoreParams s -> VersionedNgramsPatches -> Aff VersionedNgramsPatches
putNgramsPatches :: forall s. CoreParams s -> VersionedNgramsPatches -> Aff (Either RESTError VersionedNgramsPatches)
putNgramsPatches { listIds, nodeId, session, tabType } = put session putNgrams
where putNgrams = PutNgrams tabType (head listIds) Nothing (Just nodeId)
......@@ -918,22 +917,25 @@ syncPatches props state callback = do
when (isEmptyNgramsTablePatch ngramsStagePatch) $ do
let pt = Versioned { data: ngramsPatches, version: ngramsVersion }
launchAff_ $ do
Versioned { data: newPatch, version: newVersion } <- putNgramsPatches props pt
callback unit
liftEffect $ do
log2 "[syncPatches] setting state, newVersion" newVersion
T.modify_ (\s ->
-- I think that sometimes this setState does not fully go through.
-- This is an issue because the version number does not get updated and the subsequent calls
-- can mess up the patches.
s {
ngramsLocalPatch = fromNgramsPatches mempty
, ngramsStagePatch = fromNgramsPatches mempty
, ngramsValidPatch = fromNgramsPatches newPatch <> ngramsLocalPatch <> s.ngramsValidPatch
ePatches <- putNgramsPatches props pt
case ePatches of
Left err -> liftEffect $ log2 "[syncPatches] RESTError" err
Right (Versioned { data: newPatch, version: newVersion }) -> do
callback unit
liftEffect $ do
log2 "[syncPatches] setting state, newVersion" newVersion
T.modify_ (\s ->
-- I think that sometimes this setState does not fully go through.
-- This is an issue because the version number does not get updated and the subsequent calls
-- can mess up the patches.
s {
ngramsLocalPatch = fromNgramsPatches mempty
, ngramsStagePatch = fromNgramsPatches mempty
, ngramsValidPatch = fromNgramsPatches newPatch <> ngramsLocalPatch <> s.ngramsValidPatch
-- First the already valid patch, then the local patch, then the newly received newPatch.
, ngramsVersion = newVersion
}) state
log2 "[syncPatches] ngramsVersion" newVersion
, ngramsVersion = newVersion
}) state
log2 "[syncPatches] ngramsVersion" newVersion
pure unit
{-
......@@ -967,7 +969,7 @@ commitPatch tablePatch state = do
T.modify_ (\s -> s { ngramsLocalPatch = tablePatch <> s.ngramsLocalPatch }) state
-- First we apply the patches we have locally and then the new patch (tablePatch).
loadNgramsTable :: PageParams -> Aff VersionedNgramsTable
loadNgramsTable :: PageParams -> Aff (Either RESTError VersionedNgramsTable)
loadNgramsTable
{ nodeId, listIds, termListFilter, termSizeFilter, session, scoreType
, searchQuery, tabType, params: {offset, limit, orderBy}}
......@@ -986,7 +988,7 @@ loadNgramsTable
type NgramsListByTabType = Map TabType VersionedNgramsTable
loadNgramsTableAll :: PageParams -> Aff NgramsListByTabType
loadNgramsTableAll :: PageParams -> Aff (Either RESTError NgramsListByTabType)
loadNgramsTableAll { nodeId, listIds, session, scoreType } = do
let
cTagNgramTypes =
......@@ -997,11 +999,13 @@ loadNgramsTableAll { nodeId, listIds, session, scoreType } = do
]
query tabType = GetNgramsTableAll { listIds, tabType } (Just nodeId)
Map.fromFoldable <$> for cTagNgramTypes \cTagNgramType -> do
ret <- Map.fromFoldable <$> for cTagNgramTypes \cTagNgramType -> do
let tabType = TabCorpus $ TabNgramType cTagNgramType
result :: VersionedNgramsTable <- get session $ query tabType
result :: Either RESTError VersionedNgramsTable <- get session $ query tabType
pure $ Tuple tabType result
pure $ eitherMap ret
convOrderBy :: T.OrderByDirection T.ColumnName -> OrderBy
convOrderBy (T.ASC (T.ColumnName "Score")) = ScoreAsc
convOrderBy (T.DESC (T.ColumnName "Score")) = ScoreDesc
......@@ -1124,8 +1128,10 @@ chartsAfterSync path'@{ nodeId } tasks _ = do
postNgramsChartsAsync :: forall s. CoreParams s -> Aff AsyncTaskWithType
postNgramsChartsAsync { listIds, nodeId, session, tabType } = do
task <- post session putNgramsAsync acu
pure $ AsyncTaskWithType { task, typ: UpdateNgramsCharts }
eTask :: Either RESTError AsyncTask <- post session putNgramsAsync acu
case eTask of
Left _err -> liftEffect $ throwError $ error "[postNgramsChartsAsync] RESTError"
Right task -> pure $ AsyncTaskWithType { task, typ: UpdateNgramsCharts }
where
acu = AsyncNgramsChartsUpdate { listId: head listIds
, tabType }
......
src/Gargantext/Components/NgramsTable/Loader.purs
View file @ 034ea2e7
module Gargantext.Components.NgramsTable.Loader where
import Gargantext.Prelude
import Data.Either (Either(..))
import Data.Maybe (Maybe(..), maybe, isJust)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff_, throwError)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Reactix as R
import Simple.JSON as JSON
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.LoadingSpinner (loadingSpinner)
import Gargantext.Components.NgramsTable.Core (Version, Versioned(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Utils.CacheAPI as GUC
import Reactix as R
import Simple.JSON as JSON
import Toestand as T
cacheName :: String
......@@ -26,7 +25,7 @@ clearCache _ = GUC.delete $ GUC.CacheName cacheName
type LoaderWithCacheAPIProps path res ret = (
cacheEndpoint :: path -> Aff Version
cacheEndpoint :: path -> Aff (Either RESTError Version)
, handleResponse :: Versioned res -> ret
, mkRequest :: path -> GUC.Request
, path :: path
......@@ -49,7 +48,7 @@ useLoaderWithCacheAPI { cacheEndpoint, handleResponse, mkRequest, path, renderer
pure $ maybe (loadingSpinner {}) renderer state'
type LoaderWithCacheAPIEffectProps path res ret = (
cacheEndpoint :: path -> Aff Version
cacheEndpoint :: path -> Aff (Either RESTError Version)
, handleResponse :: Versioned res -> ret
, mkRequest :: path -> GUC.Request
, path :: path
......@@ -79,19 +78,22 @@ useCachedAPILoaderEffect { cacheEndpoint
cache <- GUC.openCache $ GUC.CacheName cacheName
-- TODO Parallelize?
vr@(Versioned { version, "data": d }) <- GUC.cachedJson cache req
cacheReal <- cacheEndpoint path
val <- if version == cacheReal then
pure vr
else do
-- liftEffect $ do
-- log "[useCachedAPILoaderEffect] versions dont match"
-- log2 "[useCachedAPILoaderEffect] cached version" version
-- log2 "[useCachedAPILoaderEffect] real version" cacheReal
_ <- GUC.deleteReq cache req
vr'@(Versioned { version: version', data: _ }) <- GUC.cachedJson cache req
if version' == cacheReal then
pure vr'
else
throwError $ error $ "[NgramsTable.Loader] Fetched clean cache but hashes don't match: " <> show version <> " != " <> show cacheReal
liftEffect $ do
T.write_ (Just $ handleResponse val) state
eCacheReal <- cacheEndpoint path
case eCacheReal of
Left err -> throwError $ error $ "[useCachedAPILoaderEffect] RESTError"
Right cacheReal -> do
val <- if version == cacheReal then
pure vr
else do
-- liftEffect $ do
-- log "[useCachedAPILoaderEffect] versions dont match"
-- log2 "[useCachedAPILoaderEffect] cached version" version
-- log2 "[useCachedAPILoaderEffect] real version" cacheReal
_ <- GUC.deleteReq cache req
vr'@(Versioned { version: version', data: _ }) <- GUC.cachedJson cache req
if version' == cacheReal then
pure vr'
else
throwError $ error $ "[useCachedAPILoaderEffect] Fetched clean cache but hashes don't match: " <> show version <> " != " <> show cacheReal
liftEffect $ do
T.write_ (Just $ handleResponse val) state
src/Gargantext/Components/Nodes/Annuaire.purs
View file @ 034ea2e7
......@@ -3,6 +3,7 @@ module Gargantext.Components.Nodes.Annuaire
where
import Data.Array as A
import Data.Either (Either)
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Maybe (Maybe(..), maybe, fromMaybe)
......@@ -23,12 +24,13 @@ import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types as CT
import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Table (defaultContainer, initialParams, makeRow, table, tableHeaderLayout) as TT
import Gargantext.Components.Table.Types (ColumnName(..), Params) as TT
import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (url, Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId, get)
import Gargantext.Types (NodeType(..), AffTableResult, TableResult)
import Gargantext.Types (NodeType(..), AffETableResult, TableResult)
import Gargantext.Utils.Reactix as R2
here :: R2.Here
......@@ -120,7 +122,6 @@ annuaireCpt = here.component "annuaire" cpt
, pageLayout { info, session, pagePath, frontends} ]
where
date = "Last update: " <> date'
style = {width: "250px", display: "inline-block"}
initialPagePath nodeId = {nodeId, params: TT.initialParams}
type PagePath = { nodeId :: Int, params :: TT.Params }
......@@ -138,7 +139,7 @@ pageLayout props = R.createElement pageLayoutCpt props []
pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = here.component "pageLayout" cpt
where
cpt { info, frontends, pagePath, session } _ = do
cpt { frontends, pagePath, session } _ = do
pagePath' <- T.useLive T.unequal pagePath
useLoader pagePath' (loadPage session) $
......@@ -175,8 +176,8 @@ pageCpt = here.component "page" cpt
}
where
rows pagePath' = (row pagePath') <$> Seq.fromFoldable docs
row pagePath'@{ nodeId } contact = { row: contactCells { annuaireId: nodeId, frontends, contact, session }
, delete: false }
row { nodeId } contact = { row: contactCells { annuaireId: nodeId, frontends, contact, session }
, delete: false }
container = TT.defaultContainer { title: "Annuaire" } -- TODO
colNames = TT.ColumnName <$> [ "", "First Name", "Last Name", "Company", "Role"]
wrapColElts = const identity
......@@ -194,9 +195,8 @@ contactCells :: Record ContactCellsProps -> R.Element
contactCells p = R.createElement contactCellsCpt p []
contactCellsCpt :: R.Component ContactCellsProps
contactCellsCpt = here.component "contactCells" cpt where
cpt { annuaireId, frontends, session
, contact: CT.NodeContact
{ id, hyperdata: CT.HyperdataContact { who : Nothing }}} _ =
cpt { contact: CT.NodeContact
{ hyperdata: CT.HyperdataContact { who : Nothing } } } _ =
pure $ TT.makeRow
[ H.text ""
, H.span {} [ H.text "Name" ]
......@@ -224,9 +224,6 @@ contactCellsCpt = here.component "contactCells" cpt where
-- H.text $ maybe "No ContactWhereRole" contactWhereRole (A.head $ ou)
]
where
--nodepath = NodePath (sessionId session) NodeContact (Just id)
nodepath = Routes.ContactPage (sessionId session) annuaireId id
href = url frontends nodepath
contactUrl aId id' = url frontends $ Routes.ContactPage (sessionId session) aId id'
contactWhereOrg (CT.ContactWhere { organization: [] }) = "No Organization"
contactWhereOrg (CT.ContactWhere { organization: orga }) =
......@@ -234,8 +231,6 @@ contactCellsCpt = here.component "contactCells" cpt where
contactWhereDept (CT.ContactWhere { labTeamDepts : [] }) = "Empty Dept"
contactWhereDept (CT.ContactWhere { labTeamDepts : dept }) =
fromMaybe "No Dept (list)" (A.head dept)
contactWhereRole (CT.ContactWhere { role: Nothing }) = "Empty Role"
contactWhereRole (CT.ContactWhere { role: Just role }) = role
newtype HyperdataAnnuaire = HyperdataAnnuaire
{ title :: Maybe String
......@@ -278,8 +273,8 @@ instance JSON.ReadForeign AnnuaireInfo where
------------------------------------------------------------------------
loadPage :: Session -> PagePath -> AffTableResult CT.NodeContact
loadPage session {nodeId, params: { offset, limit, orderBy }} =
loadPage :: Session -> PagePath -> AffETableResult CT.NodeContact
loadPage session {nodeId, params: { offset, limit }} =
get session children
-- TODO orderBy
-- where
......@@ -291,6 +286,6 @@ loadPage session {nodeId, params: { offset, limit, orderBy }} =
where
children = Children NodeContact offset limit Nothing {-(convOrderBy <$> orderBy)-} (Just nodeId)
getAnnuaireInfo :: Session -> Int -> Aff AnnuaireInfo
getAnnuaireInfo :: Session -> Int -> Aff (Either RESTError AnnuaireInfo)
getAnnuaireInfo session id = get session (NodeAPI Node (Just id) "")
src/Gargantext/Components/Nodes/Annuaire/User.purs
View file @ 034ea2e7
......@@ -4,7 +4,7 @@ module Gargantext.Components.Nodes.Annuaire.User
)
where
import Gargantext.Prelude (Unit, bind, discard, pure, show, ($), (<$>), (<<<), (<>))
import Data.Either (Either(..))
import Data.Lens as L
import Data.Maybe (Maybe(..), fromMaybe)
import Effect (Effect)
......@@ -14,12 +14,15 @@ import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Prelude
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (Contact(..), ContactData, ContactTouch(..), ContactWhere(..), ContactWho(..), HyperdataContact(..), HyperdataUser(..), _city, _country, _firstName, _labTeamDeptsJoinComma, _lastName, _mail, _office, _organizationJoinComma, _ouFirst, _phone, _role, _shared, _touch, _who, defaultContactTouch, defaultContactWhere, defaultContactWho, defaultHyperdataContact, defaultHyperdataUser)
import Gargantext.Components.Nodes.Annuaire.Tabs as Tabs
import Gargantext.Components.Nodes.Lists.Types as LT
import Gargantext.Components.Nodes.Texts.Types as TT
import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as Routes
......@@ -91,7 +94,6 @@ type ContactInfoItemProps =
contactInfoItem :: Record ContactInfoItemProps -> R.Element
contactInfoItem props = R.createElement contactInfoItemCpt props []
contactInfoItemCpt :: R.Component ContactInfoItemProps
contactInfoItemCpt = here.component "contactInfoItem" cpt
where
......@@ -172,7 +174,6 @@ type KeyLayoutProps = (
userLayout :: R2.Component LayoutProps
userLayout = R.createElement userLayoutCpt
userLayoutCpt :: R.Component LayoutProps
userLayoutCpt = here.component "userLayout" cpt
where
......@@ -200,7 +201,6 @@ userLayoutCpt = here.component "userLayout" cpt
userLayoutWithKey :: Record KeyLayoutProps -> R.Element
userLayoutWithKey props = R.createElement userLayoutWithKeyCpt props []
userLayoutWithKeyCpt :: R.Component KeyLayoutProps
userLayoutWithKeyCpt = here.component "userLayoutWithKey" cpt
where
......@@ -243,9 +243,9 @@ userLayoutWithKeyCpt = here.component "userLayoutWithKey" cpt
liftEffect $ T2.reload reload
-- | toUrl to get data XXX
getContact :: Session -> Int -> Aff ContactData
getContact :: Session -> Int -> Aff (Either RESTError ContactData)
getContact session id = do
contactNode :: Contact <- get session $ Routes.NodeAPI Node (Just id) ""
eContactNode <- get session $ Routes.NodeAPI Node (Just id) ""
-- TODO: we need a default list for the pairings
--defaultListIds <- get $ toUrl endConfigStateful Back (Children NodeList 0 1 Nothing) $ Just id
--case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of
......@@ -253,14 +253,14 @@ getContact session id = do
-- pure {contactNode, defaultListId}
-- Nothing ->
-- throwError $ error "Missing default list"
pure {contactNode, defaultListId: 424242}
pure $ (\contactNode -> { contactNode, defaultListId: 424242 }) <$> eContactNode
getUserWithReload :: { nodeId :: Int
, reload :: T2.Reload
, session :: Session} -> Aff ContactData
, session :: Session} -> Aff (Either RESTError ContactData)
getUserWithReload {nodeId, session} = getContact session nodeId
saveContactHyperdata :: Session -> Int -> HyperdataUser -> Aff Int
saveContactHyperdata :: Session -> Int -> HyperdataUser -> Aff (Either RESTError Int)
saveContactHyperdata session id h = do
put session (Routes.NodeAPI Node (Just id) "") h
src/Gargantext/Components/Nodes/Annuaire/User/Contact.purs
View file @ 034ea2e7
......@@ -3,11 +3,9 @@ module Gargantext.Components.Nodes.Annuaire.User.Contact
, contactLayout
) where
import Gargantext.Prelude
( Unit, bind, const, discard, pure, show, ($), (<$>), (*>), (<<<), (<>) )
import Data.Either (Either)
import Data.Lens as L
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
......@@ -15,6 +13,8 @@ import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Prelude
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs
......@@ -27,6 +27,7 @@ import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types
, defaultContactWho, defaultHyperdataContact, defaultHyperdataUser )
import Gargantext.Components.Nodes.Lists.Types as LT
import Gargantext.Components.Nodes.Texts.Types as TT
import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as Routes
......@@ -138,9 +139,6 @@ contactInfoItemCpt = here.component "contactInfoItem" cpt
let newHyperdata = (L.over cLens (\_ -> R.readRef valueRef) hyperdata) :: HyperdataContact
onUpdateHyperdata newHyperdata
listElement :: Array R.Element -> R.Element
listElement = H.li { className: "list-group-item justify-content-between" }
type BasicProps =
( frontends :: Frontends
, nodeId :: Int
......@@ -159,7 +157,7 @@ type LayoutProps = ( session :: Session | ReloadProps )
type KeyLayoutProps = ( key :: String, session :: Session | ReloadProps )
saveContactHyperdata :: Session -> Int -> HyperdataContact -> Aff Int
saveContactHyperdata :: Session -> Int -> HyperdataContact -> Aff (Either RESTError Int)
saveContactHyperdata session id = put session (Routes.NodeAPI Node (Just id) "")
type AnnuaireLayoutProps = ( annuaireId :: Int, session :: Session | ReloadProps )
......@@ -234,9 +232,9 @@ contactLayoutWithKeyCpt = here.component "contactLayoutWithKey" cpt where
launchAff_ $
saveContactHyperdata session nodeId hd *> liftEffect (T2.reload reload)
getAnnuaireContact :: Session -> Int -> Int -> Aff ContactData'
getAnnuaireContact :: Session -> Int -> Int -> Aff (Either RESTError ContactData')
getAnnuaireContact session annuaireId id = do
contactNode :: Contact' <- get session $ Routes.NodeAPI Annuaire (Just annuaireId) $ show id
eContactNode <- get session $ Routes.NodeAPI Annuaire (Just annuaireId) $ show id
-- TODO: we need a default list for the pairings
--defaultListIds <- get $ toUrl endConfigStateful Back (Children NodeList 0 1 Nothing) $ Just id
--case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of
......@@ -244,4 +242,4 @@ getAnnuaireContact session annuaireId id = do
-- pure {contactNode, defaultListId}
-- Nothing ->
-- throwError $ error "Missing default list"
pure {contactNode, defaultListId: 424242}
pure $ (\contactNode -> { contactNode, defaultListId: 424242 }) <$> eContactNode
src/Gargantext/Components/Nodes/Corpus.purs
View file @ 034ea2e7
......@@ -2,12 +2,11 @@ module Gargantext.Components.Nodes.Corpus where
import Data.Array as A
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Show.Generic (genericShow)
import Data.Generic.Rep (class Generic)
import Data.List as List
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (Tuple(..))
import Data.Show.Generic (genericShow)
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (Aff, launchAff_, throwError)
......@@ -25,12 +24,13 @@ import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Node (NodePoly(..), HyperdataList)
import Gargantext.Components.Nodes.Corpus.Types (CorpusData, Hyperdata(..))
import Gargantext.Components.Nodes.Types (FTField, FTFieldList(..), FTFieldWithIndex, FTFieldsWithIndex(..), Field(..), FieldType(..), Hash, Index, defaultField, defaultHaskell', defaultJSON', defaultMarkdown', defaultPython')
import Gargantext.Config.REST (RESTError)
import Gargantext.Data.Array as GDA
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (class Eq, class Show, Unit, bind, discard, pure, show, unit, ($), (+), (-), (<), (<$>), (<<<), (<>), (==), (>))
import Gargantext.Routes (SessionRoute(Children, NodeAPI))
import Gargantext.Sessions (Session, get, put, sessionId)
import Gargantext.Types (AffTableResult, NodeType(..))
import Gargantext.Types (AffETableResult, NodeType(..))
import Gargantext.Utils.Crypto as Crypto
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
......@@ -172,10 +172,14 @@ corpusLayoutViewCpt = here.component "corpusLayoutView" cpt
, session :: Session } -> e -> Effect Unit
onClickSave {fields: FTFieldsWithIndex fields, nodeId, reload, session} _ = do
launchAff_ do
saveCorpus $ { hyperdata: Hyperdata {fields: FTFieldList $ (_.ftField) <$> fields}
, nodeId
, session }
liftEffect $ T2.reload reload
res <- saveCorpus $ { hyperdata: Hyperdata {fields: FTFieldList $ (_.ftField) <$> fields}
, nodeId
, session }
liftEffect $ do
_ <- case res of
Left err -> log2 "[corpusLayoutView] onClickSave RESTError" err
_ -> pure unit
T2.reload reload
onClickAdd :: forall e. T.Box FTFieldsWithIndex -> e -> Effect Unit
onClickAdd fieldsS _ = do
......@@ -453,11 +457,11 @@ type LoadProps =
, session :: Session
)
loadCorpus' :: Record LoadProps -> Aff (NodePoly Hyperdata)
loadCorpus' :: Record LoadProps -> Aff (Either RESTError (NodePoly Hyperdata))
loadCorpus' {nodeId, session} = get session $ NodeAPI Corpus (Just nodeId) ""
-- Just to make reloading effective
loadCorpusWithReload :: { reload :: T2.Reload | LoadProps } -> Aff (NodePoly Hyperdata)
loadCorpusWithReload :: { reload :: T2.Reload | LoadProps } -> Aff (Either RESTError (NodePoly Hyperdata))
loadCorpusWithReload {nodeId, session} = loadCorpus' {nodeId, session}
type SaveProps = (
......@@ -465,41 +469,69 @@ type SaveProps = (
| LoadProps
)
saveCorpus :: Record SaveProps -> Aff Unit
saveCorpus :: Record SaveProps -> Aff (Either RESTError Int)
saveCorpus {hyperdata, nodeId, session} = do
_id <- (put session (NodeAPI Corpus (Just nodeId) "") hyperdata) :: Aff Int
pure unit
put session (NodeAPI Corpus (Just nodeId) "") hyperdata
loadCorpus :: Record LoadProps -> Aff CorpusData
loadCorpus :: Record LoadProps -> Aff (Either RESTError CorpusData)
loadCorpus {nodeId, session} = do
-- fetch corpus via lists parentId
(NodePoly {parentId: corpusId} :: NodePoly {}) <- get session nodePolyRoute
corpusNode <- get session $ corpusNodeRoute corpusId ""
defaultListIds <- (get session $ defaultListIdsRoute corpusId)
:: forall a. JSON.ReadForeign a => AffTableResult (NodePoly a)
case (A.head defaultListIds.docs :: Maybe (NodePoly HyperdataList)) of
Just (NodePoly { id: defaultListId }) ->
pure {corpusId, corpusNode, defaultListId}
Nothing ->
throwError $ error "Missing default list"
res <- get session nodePolyRoute
case res of
Left err -> pure $ Left err
Right (NodePoly {parentId: corpusId} :: NodePoly {}) -> do
eCorpusNode <- get session $ corpusNodeRoute corpusId ""
eDefaultListIds <- (get session $ defaultListIdsRoute corpusId)
:: forall a. JSON.ReadForeign a => AffETableResult (NodePoly a)
case eCorpusNode of
Left err -> pure $ Left err
Right corpusNode -> do
case eDefaultListIds of
Left err -> pure $ Left err
Right defaultListIds -> do
case (A.head defaultListIds.docs :: Maybe (NodePoly HyperdataList)) of
Just (NodePoly { id: defaultListId }) ->
pure $ Right { corpusId, corpusNode, defaultListId }
Nothing ->
throwError $ error "Missing default list"
-- (NodePoly {parentId: corpusId} :: NodePoly {}) <- get session nodePolyRoute
-- corpusNode <- get session $ corpusNodeRoute corpusId ""
-- defaultListIds <- (get session $ defaultListIdsRoute corpusId)
-- :: forall a. JSON.ReadForeign a => AffTableResult (NodePoly a)
-- case (A.head defaultListIds.docs :: Maybe (NodePoly HyperdataList)) of
-- Just (NodePoly { id: defaultListId }) ->
-- pure {corpusId, corpusNode, defaultListId}
-- Nothing ->
-- throwError $ error "Missing default list"
where
nodePolyRoute = NodeAPI Corpus (Just nodeId) ""
corpusNodeRoute = NodeAPI Corpus <<< Just
defaultListIdsRoute = Children NodeList 0 1 Nothing <<< Just
loadCorpusWithChild :: Record LoadProps -> Aff CorpusData
loadCorpusWithChild :: Record LoadProps -> Aff (Either RESTError CorpusData)
loadCorpusWithChild { nodeId: childId, session } = do
-- fetch corpus via lists parentId
(NodePoly {parentId: corpusId} :: NodePoly {}) <- get session $ listNodeRoute childId ""
corpusNode <- get session $ corpusNodeRoute corpusId ""
defaultListIds <- (get session $ defaultListIdsRoute corpusId)
:: forall a. JSON.ReadForeign a => AffTableResult (NodePoly a)
case (A.head defaultListIds.docs :: Maybe (NodePoly HyperdataList)) of
Just (NodePoly { id: defaultListId }) ->
pure { corpusId, corpusNode, defaultListId }
Nothing ->
throwError $ error "Missing default list"
eListNode <- get session $ listNodeRoute childId ""
case eListNode of
Left err -> pure $ Left err
Right listNode -> do
let (NodePoly {parentId: corpusId} :: NodePoly {}) = listNode
eCorpusNode <- get session $ corpusNodeRoute corpusId ""
case eCorpusNode of
Left err -> pure $ Left err
Right corpusNode -> do
eDefaultListIds <- (get session $ defaultListIdsRoute corpusId)
:: forall a. JSON.ReadForeign a => AffETableResult (NodePoly a)
case eDefaultListIds of
Left err -> pure $ Left err
Right defaultListIds -> do
case (A.head defaultListIds.docs :: Maybe (NodePoly HyperdataList)) of
Just (NodePoly { id: defaultListId }) ->
pure $ Right { corpusId, corpusNode, defaultListId }
Nothing ->
throwError $ error "Missing default list"
where
corpusNodeRoute = NodeAPI Corpus <<< Just
listNodeRoute = NodeAPI Node <<< Just
......@@ -514,7 +546,7 @@ type LoadWithReloadProps =
-- Just to make reloading effective
loadCorpusWithChildAndReload :: Record LoadWithReloadProps -> Aff CorpusData
loadCorpusWithChildAndReload :: Record LoadWithReloadProps -> Aff (Either RESTError CorpusData)
loadCorpusWithChildAndReload {nodeId, reload, session} = loadCorpusWithChild {nodeId, session}
data ViewType = Code | Folders
......
src/Gargantext/Components/Nodes/Corpus/Chart/API.purs
View file @ 034ea2e7
module Gargantext.Components.Nodes.Corpus.Chart.API where
import Data.Either (Either)
import Effect.Aff (Aff)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, post)
import Gargantext.Types as T
recomputeChart :: Session -> T.ChartType -> T.CTabNgramType -> Int -> Int -> Aff (Array Int)
recomputeChart :: Session -> T.ChartType -> T.CTabNgramType -> Int -> Int -> Aff (Either RESTError (Array Int))
recomputeChart session chartType ngramType corpusId listId =
post session (RecomputeListChart chartType ngramType corpusId listId) {}
src/Gargantext/Components/Nodes/Corpus/Chart/Common.purs
View file @ 034ea2e7
module Gargantext.Components.Nodes.Corpus.Chart.Common where
import Data.Tuple (fst)
import Data.Either (Either)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Reactix as R
......@@ -10,6 +10,7 @@ import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.Nodes.Corpus.Chart.Types (MetricsProps, ReloadPath)
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (HashedResponse, useLoader, useLoaderWithCacheAPI)
import Gargantext.Utils.Crypto (Hash)
import Gargantext.Sessions (Session)
......@@ -20,7 +21,7 @@ here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus.Chart.Common"
type MetricsLoadViewProps a = (
getMetrics :: Session -> ReloadPath -> Aff a
getMetrics :: Session -> ReloadPath -> Aff (Either RESTError a)
, loaded :: Record MetricsProps -> a -> R.Element
| MetricsProps
)
......@@ -30,7 +31,6 @@ cacheName = "metrics"
metricsLoadView :: forall a. Eq a => Record (MetricsLoadViewProps a) -> R.Element
metricsLoadView p = R.createElement metricsLoadViewCpt p []
metricsLoadViewCpt :: forall a. Eq a => R.Component (MetricsLoadViewProps a)
metricsLoadViewCpt = here.component "metricsLoadView" cpt
where
......@@ -41,7 +41,7 @@ metricsLoadViewCpt = here.component "metricsLoadView" cpt
loaded { path, reload, session, onClick, onInit } l
type MetricsWithCacheLoadViewProps res ret = (
getMetricsHash :: Session -> ReloadPath -> Aff Hash
getMetricsHash :: Session -> ReloadPath -> Aff (Either RESTError Hash)
, handleResponse :: HashedResponse res -> ret
, loaded :: Record MetricsProps -> ret -> R.Element
, mkRequest :: ReloadPath -> GUC.Request
......@@ -52,7 +52,6 @@ metricsWithCacheLoadView :: forall res ret.
Eq ret => JSON.ReadForeign res =>
Record (MetricsWithCacheLoadViewProps res ret) -> R.Element
metricsWithCacheLoadView p = R.createElement metricsWithCacheLoadViewCpt p []
metricsWithCacheLoadViewCpt :: forall res ret.
Eq ret => JSON.ReadForeign res =>
R.Component (MetricsWithCacheLoadViewProps res ret)
......
src/Gargantext/Components/Nodes/Corpus/Chart/Histo.purs
View file @ 034ea2e7
module Gargantext.Components.Nodes.Corpus.Chart.Histo where
import Data.Either (Either)
import Data.Eq.Generic (genericEq)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Gargantext.Components.Charts.Options.Color (grey)
import Gargantext.Components.Charts.Options.Color (grey, blue, green)
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
import Gargantext.Components.Charts.Options.Color (grey, blue)
import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis')
import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter)
import Gargantext.Components.Charts.Options.Legend (LegendMode(..), selectedMode)
import Gargantext.Components.Charts.Options.Series (seriesBarD1)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types (MetricsProps, Path, Props, ReloadPath)
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (HashedResponse(..))
import Gargantext.Prelude (class Eq, bind, map, pure, ($), (==))
import Gargantext.Routes (SessionRoute(..))
......@@ -23,10 +28,6 @@ import Gargantext.Types (ChartType(..))
import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus.Chart.Histo"
......@@ -75,8 +76,8 @@ chartOptions { onClick, onInit } (HistoMetrics { dates: dates', count: count'})
map mapSeriesBar count'
]
getMetricsHash :: Session -> ReloadPath -> Aff String
getMetricsHash session (_ /\ { corpusId, limit, listId, tabType }) = do
getMetricsHash :: Session -> ReloadPath -> Aff (Either RESTError String)
getMetricsHash session (_ /\ { corpusId, listId, tabType }) = do
get session $ ChartHash { chartType: Histo, listId: mListId, tabType } (Just corpusId)
where
mListId = if listId == 0 then Nothing else (Just listId)
......@@ -90,7 +91,7 @@ handleResponse :: HashedResponse ChartMetrics -> HistoMetrics
handleResponse (HashedResponse { value: ChartMetrics ms }) = ms."data"
mkRequest :: Session -> ReloadPath -> GUC.Request
mkRequest session (_ /\ path@{ corpusId, limit, listId, tabType }) = GUC.makeGetRequest session $ chartUrl path
mkRequest session (_ /\ path) = GUC.makeGetRequest session $ chartUrl path
histo :: Record Props -> R.Element
histo props = R.createElement histoCpt props []
......@@ -114,7 +115,7 @@ histoCpt = here.component "histo" cpt
}
loaded :: Record MetricsProps -> HistoMetrics -> R.Element
loaded p@{ path, reload, session } l =
loaded p l =
H.div {} [
{- U.reloadButton reload
, U.chartUpdateButton { chartType: Histo, path, reload, session }
......
src/Gargantext/Components/Nodes/Corpus/Chart/Metrics.purs
View file @ 034ea2e7
module Gargantext.Components.Nodes.Corpus.Chart.Metrics where
import Data.Generic.Rep (class Generic)
import Data.Either (Either)
import Data.Eq.Generic (genericEq)
import Data.Map as Map
import Data.Map (Map)
......@@ -25,6 +26,7 @@ import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types
(MetricsProps, Path, Props, ReloadPath)
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (HashedResponse(..))
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
......@@ -93,7 +95,7 @@ scatterOptions { onClick, onInit } metrics' = Options
}
--}
getMetricsHash :: Session -> ReloadPath -> Aff String
getMetricsHash :: Session -> ReloadPath -> Aff (Either RESTError String)
getMetricsHash session (_ /\ { corpusId, listId, tabType }) =
get session $ CorpusMetricsHash { listId, tabType } (Just corpusId)
......@@ -104,7 +106,7 @@ handleResponse :: HashedResponse Metrics -> Loaded
handleResponse (HashedResponse { value: Metrics ms }) = ms."data"
mkRequest :: Session -> ReloadPath -> GUC.Request
mkRequest session (_ /\ path@{ corpusId, limit, listId, tabType }) = GUC.makeGetRequest session $ chartUrl path
mkRequest session (_ /\ path) = GUC.makeGetRequest session $ chartUrl path
metrics :: Record Props -> R.Element
metrics props = R.createElement metricsCpt props []
......@@ -129,7 +131,7 @@ metricsCpt = here.component "etrics" cpt
loaded :: Record MetricsProps -> Loaded -> R.Element
loaded p@{ path, reload, session } loaded' =
loaded p loaded' =
H.div {} [
{- U.reloadButton reload
, U.chartUpdateButton { chartType: Scatter, path, reload, session }
......
src/Gargantext/Components/Nodes/Corpus/Chart/Pie.purs
View file @ 034ea2e7
......@@ -3,6 +3,7 @@ module Gargantext.Components.Nodes.Corpus.Chart.Pie where
import Data.Array (zip, filter)
import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Either (Either)
import Data.Eq.Generic (genericEq)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
......@@ -22,6 +23,7 @@ import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis')
import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter)
import Gargantext.Components.Charts.Options.Series (seriesBarD1, seriesPieD1)
import Gargantext.Config.REST (RESTError)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types
(MetricsProps, Path, Props, ReloadPath)
......@@ -82,7 +84,7 @@ chartOptionsPie { onClick, onInit } (HistoMetrics { dates: dates', count: count'
, onInit
}
getMetricsHash :: Session -> ReloadPath -> Aff String
getMetricsHash :: Session -> ReloadPath -> Aff (Either RESTError String)
getMetricsHash session (_ /\ { corpusId, limit, listId, tabType }) = do
get session $ ChartHash { chartType: ChartPie, listId: mListId, tabType } (Just corpusId)
where
......
src/Gargantext/Components/Nodes/Corpus/Chart/Tree.purs
View file @ 034ea2e7
module Gargantext.Components.Nodes.Corpus.Chart.Tree where
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
......@@ -17,6 +18,7 @@ import Gargantext.Components.Charts.Options.Series (TreeNode, Trees(..), mkTree)
import Gargantext.Components.Charts.Options.Font (mkTooltip, templateFormatter)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types (MetricsProps, Path, Props, ReloadPath)
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (HashedResponse(..))
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
......@@ -54,7 +56,7 @@ scatterOptions { onClick, onInit } nodes = Options
}
getMetricsHash :: Session -> ReloadPath -> Aff String
getMetricsHash :: Session -> ReloadPath -> Aff (Either RESTError String)
getMetricsHash session (_ /\ { corpusId, limit, listId, tabType }) = do
get session $ ChartHash { chartType: ChartTree, listId: mListId, tabType } (Just corpusId)
where
......
src/Gargantext/Components/Nodes/Corpus/Dashboard.purs
View file @ 034ea2e7
module Gargantext.Components.Nodes.Corpus.Dashboard where
import Gargantext.Prelude (Unit, bind, discard, pure, read, show, unit, ($), (<$>), (<>), (==))
import Data.Array as A
import Data.Either (Either(..))
import Data.List as List
import Data.Maybe (Maybe(..), fromMaybe)
import DOM.Simple.Console (log, log2)
import Effect (Effect)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
......@@ -12,11 +12,13 @@ import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Components.Forest.Tree (doSearch)
import Gargantext.Components.Nodes.Corpus (fieldsCodeEditor)
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.Components.Nodes.Dashboard.Types as DT
import Gargantext.Components.Nodes.Types (FTFieldList(..), FTFieldsWithIndex(..), defaultField)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Unit, bind, discard, pure, read, show, unit, ($), (<$>), (<>), (==))
import Gargantext.Sessions (Session, sessionId)
import Gargantext.Types (NodeID)
import Gargantext.Utils.Reactix as R2
......@@ -65,10 +67,14 @@ dashboardLayoutWithKeyCpt = here.component "dashboardLayoutWithKey" cpt
, fields :: FTFieldList } -> Effect Unit
onChange nodeId' reload (DT.Hyperdata h) { charts, fields } = do
launchAff_ do
DT.saveDashboard { hyperdata: DT.Hyperdata $ h { charts = charts, fields = fields }
, nodeId:nodeId'
, session }
liftEffect $ T2.reload reload
res <- DT.saveDashboard { hyperdata: DT.Hyperdata $ h { charts = charts, fields = fields }
, nodeId:nodeId'
, session }
liftEffect $ do
_ <- case res of
Left err -> log2 "[dashboardLayoutWithKey] onChange RESTError" err
_ -> pure unit
T2.reload reload
type LoadedProps =
( charts :: Array P.PredefinedChart
......
src/Gargantext/Components/Nodes/Corpus/Document.purs
View file @ 034ea2e7
......@@ -2,6 +2,7 @@ module Gargantext.Components.Nodes.Corpus.Document where
--import Data.Argonaut (encodeJson) -- DEBUG
--import Data.Argonaut.Core (stringifyWithIndent) -- DEBUG
import Data.Either (Either(..))
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
......@@ -21,6 +22,7 @@ import Gargantext.Components.NgramsTable.Core
( CoreAction(..), Versioned(..), addNewNgramA, applyNgramsPatches, coreDispatch, loadNgramsTable
, replace, setTermListA, syncResetButtons, findNgramRoot )
import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get, sessionId)
......@@ -156,21 +158,24 @@ documentLayoutWithKeyCpt = here.component "documentLayoutWithKey" cpt
------------------------------------------------------------------------
loadDocument :: Session -> Int -> Aff NodeDocument
loadDocument :: Session -> Int -> Aff (Either RESTError NodeDocument)
loadDocument session nodeId = get session $ NodeAPI Node (Just nodeId) ""
loadData :: DocPath -> Aff LoadedData
loadData :: DocPath -> Aff (Either RESTError LoadedData)
loadData { listIds, nodeId, session, tabType } = do
document <- loadDocument session nodeId
ngramsTable <- loadNgramsTable
{ listIds
, nodeId
, params: { offset : 0, limit : 100, orderBy: Nothing, searchType: SearchDoc}
, scoreType: Occurrences
, searchQuery: ""
, session
, tabType
, termListFilter: Nothing
, termSizeFilter: Nothing
}
pure { document, ngramsTable }
eDocument <- loadDocument session nodeId
case eDocument of
Left err -> pure $ Left err
Right document -> do
eNgramsTable <- loadNgramsTable
{ listIds
, nodeId
, params: { offset : 0, limit : 100, orderBy: Nothing, searchType: SearchDoc}
, scoreType: Occurrences
, searchQuery: ""
, session
, tabType
, termListFilter: Nothing
, termSizeFilter: Nothing
}
pure $ (\ngramsTable -> { document, ngramsTable }) <$> eNgramsTable
src/Gargantext/Components/Nodes/Dashboard/Types.purs
View file @ 034ea2e7
......@@ -2,19 +2,19 @@ module Gargantext.Components.Nodes.Dashboard.Types where
import Gargantext.Prelude
import Data.Either (Either)
import Data.Eq.Generic (genericEq)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Effect.Aff (Aff)
import Simple.JSON as JSON
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.Components.Nodes.Types (FTFieldList)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, get, put)
import Gargantext.Types (NodeType(..))
import Simple.JSON as JSON
type Preferences = Maybe String
......@@ -40,19 +40,18 @@ instance Eq Hyperdata where
type LoadProps = ( nodeId :: Int, session :: Session )
loadDashboard' :: Record LoadProps -> Aff DashboardData
loadDashboard' :: Record LoadProps -> Aff (Either RESTError DashboardData)
loadDashboard' {nodeId, session} = get session $ NodeAPI Node (Just nodeId) ""
-- Just to make reloading effective
loadDashboardWithReload :: {reload :: Int | LoadProps} -> Aff DashboardData
loadDashboardWithReload :: {reload :: Int | LoadProps} -> Aff (Either RESTError DashboardData)
loadDashboardWithReload {nodeId, session} = loadDashboard' {nodeId, session}
type SaveProps = ( hyperdata :: Hyperdata | LoadProps )
saveDashboard :: Record SaveProps -> Aff Unit
saveDashboard :: Record SaveProps -> Aff (Either RESTError Int)
saveDashboard {hyperdata, nodeId, session} = do
_id <- (put session (NodeAPI Node (Just nodeId) "") hyperdata) :: Aff Int
pure unit
put session (NodeAPI Node (Just nodeId) "") hyperdata
newtype DashboardData =
DashboardData
......
src/Gargantext/Components/Nodes/File.purs
View file @ 034ea2e7
module Gargantext.Components.Nodes.File where
import Data.Generic.Rep (class Generic)
import Data.Either (Either(..))
import Data.Eq.Generic (genericEq)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
......@@ -10,10 +11,12 @@ import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Gargantext.Prelude
import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (toUrl)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get, sessionId)
import Gargantext.Sessions (Session, get)
import Gargantext.Types (NodeType(..), NodeID)
import Gargantext.Utils.Reactix as R2
......@@ -49,16 +52,14 @@ type FileLayoutProps = ( nodeId :: NodeID, session :: Session )
fileLayout :: R2.Leaf FileLayoutProps
fileLayout props = R.createElement fileLayoutCpt props []
fileLayoutCpt :: R.Component FileLayoutProps
fileLayoutCpt = here.component "fileLayout" cpt where
cpt { nodeId, session } _ = do
useLoader nodeId (loadFile session) onLoad
where
onLoad loaded = fileLayoutLoaded { loaded, nodeId, session }
key = show (sessionId session) <> "-" <> show nodeId
loadFile :: Session -> NodeID -> Aff File
loadFile :: Session -> NodeID -> Aff (Either RESTError File)
loadFile session nodeId = get session $ NodeAPI Node (Just nodeId) ""
type FileLayoutLoadedProps =
......@@ -68,7 +69,6 @@ type FileLayoutLoadedProps =
fileLayoutLoaded :: Record FileLayoutLoadedProps -> R.Element
fileLayoutLoaded props = R.createElement fileLayoutLoadedCpt props []
fileLayoutLoadedCpt :: R.Component FileLayoutLoadedProps
fileLayoutLoadedCpt = here.component "fileLayoutLoaded" cpt where
cpt { loaded: File { hyperdata: HyperdataFile hyperdata }, nodeId, session } _ = do
......
src/Gargantext/Components/Nodes/Frame.purs
View file @ 034ea2e7
......@@ -2,15 +2,14 @@ module Gargantext.Components.Nodes.Frame where
import Gargantext.Prelude
import Data.Argonaut (decodeJson, (.:))
import Data.Argonaut as Argonaut
import DOM.Simple as DOM
import Data.Either (Either)
import Data.Eq.Generic (genericEq)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Data.Nullable (Nullable, null, toMaybe)
import Data.Show.Generic (genericShow)
import DOM.Simple as DOM
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
......@@ -20,6 +19,7 @@ import Web.URL as WURL
import Gargantext.Components.FolderView as FV
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, get, sessionId)
......@@ -93,10 +93,8 @@ frameLayoutViewCpt :: R.Component ViewProps
frameLayoutViewCpt = here.component "frameLayoutView" cpt
where
cpt { frame: NodePoly { hyperdata: Hyperdata { base, frame_id }}
, nodeId
, nodeType
, reload
, session } _ = do
, reload } _ = do
case nodeType of
NodeFrameVisio ->
case WURL.fromAbsolute base of
......@@ -128,10 +126,7 @@ nodeFrameVisioCpt :: R.Component NodeFrameVisioProps
nodeFrameVisioCpt = here.component "nodeFrameVisio" cpt
where
cpt { frame_id
, reload
, url } _ = do
-- api = new JitsiMeetExternalAPI("visio.gargantext.org", {roomName: frame_id})
api <- T.useBox (Nothing :: Maybe JM.JitsiMeet)
ref <- R.useRef (null :: Nullable DOM.Element)
R.useEffect' $ do
......@@ -152,9 +147,9 @@ type ReloadProps = ( nodeId :: Int
, reload :: T2.Reload
, session :: Session )
loadframe' :: Record LoadProps -> Aff (NodePoly Hyperdata)
loadframe' :: Record LoadProps -> Aff (Either RESTError (NodePoly Hyperdata))
loadframe' { nodeId, session } = get session $ NodeAPI Node (Just nodeId) ""
-- Just to make reloading effective
loadframeWithReload :: Record ReloadProps -> Aff (NodePoly Hyperdata)
loadframeWithReload :: Record ReloadProps -> Aff (Either RESTError (NodePoly Hyperdata))
loadframeWithReload { nodeId, session } = loadframe' { nodeId, session }
src/Gargantext/Components/Nodes/Home/Public.purs
View file @ 034ea2e7
module Gargantext.Components.Nodes.Home.Public where
import Data.Either (Either)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Data.Show.Generic (genericShow)
import Data.String (take)
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Simple.JSON.Generics as JSONG
import Gargantext.Config (publicBackend)
import Gargantext.Config.REST (get)
import Gargantext.Config.REST (get, RESTError)
import Gargantext.Ends (backendUrl)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Simple.JSON.Generics as JSONG
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Home.Public"
......@@ -44,7 +46,7 @@ type LoadData = ()
type LoadProps = (reload :: Int)
-- | WIP still finding the right way to chose the default public backend
loadPublicData :: Record LoadProps -> Aff (Array PublicData)
loadPublicData :: Record LoadProps -> Aff (Either RESTError (Array PublicData))
loadPublicData _l = do
-- This solution is error prone (url needs to be cleaned)
--backend <- liftEffect public
......@@ -76,7 +78,6 @@ renderPublicCpt = here.component "renderPublic" cpt where
publicLayout :: Record PublicDataProps -> R.Element
publicLayout props = R.createElement publicLayoutCpt props []
publicLayoutCpt :: R.Component PublicDataProps
publicLayoutCpt = here.component "publicLayout" cpt
where
......
src/Gargantext/Components/Router.purs
View file @ 034ea2e7
......@@ -5,6 +5,12 @@ import Gargantext.Prelude
import Data.Array as A
import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RE
import Toestand as T
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Footer (footer)
import Gargantext.Components.Forest as Forest
......@@ -36,11 +42,6 @@ import Gargantext.Sessions (Session, WithSession)
import Gargantext.Sessions as Sessions
import Gargantext.Types (CorpusId, Handed(..), ListId, NodeID, NodeType(..), SessionId, SidePanelState(..), reverseHanded)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RE
import Toestand as T
here :: R2.Here
......
src/Gargantext/Config/REST.purs
View file @ 034ea2e7
module Gargantext.Config.REST where
import Affjax (defaultRequest, printError, request)
import Affjax.RequestBody (RequestBody(..), formData, formURLEncoded, string)
import Gargantext.Prelude
import Affjax (defaultRequest, request)
import Affjax as Affjax
import Affjax.RequestBody (formData, formURLEncoded, string)
import Affjax.RequestHeader as ARH
import Affjax.ResponseFormat as ResponseFormat
import DOM.Simple.Console (log, log2)
import DOM.Simple.Console (log2)
import Data.Argonaut.Core as AC
import Data.Either (Either(..))
import Data.Foldable (foldMap)
import Data.FormURLEncoded as FormURLEncoded
import Data.Generic.Rep (class Generic)
import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(..))
import Data.MediaType.Common (applicationFormURLEncoded, applicationJSON, multipartFormData)
import Data.Tuple (Tuple(..))
import DOM.Simple.Console (log2)
import Effect.Aff (Aff, throwError)
import Data.Tuple (Tuple)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Milkis as Milkis
import Unsafe.Coerce (unsafeCoerce)
import Foreign as Foreign
import Simple.JSON as JSON
import Web.XHR.FormData as XHRFormData
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2
type Token = String
readJSONOrFail affResp =
data RESTError =
SendResponseError Affjax.Error
| ReadJSONError Foreign.MultipleErrors
derive instance Generic RESTError _
instance Eq RESTError where
-- this is crude but we need it only because of useLoader
eq _ _ = false
readJSON :: forall a b. JSON.ReadForeign a =>
Either Affjax.Error
{ body :: AC.Json
| b
} -> Either RESTError a
readJSON affResp =
case affResp of
Left err -> do
_ <- liftEffect $ log $ printError err
throwError $ error $ printError err
-- _ <- liftEffect $ log $ printError err
--throwError $ error $ printError err
Left $ SendResponseError err
Right resp -> do
--_ <- liftEffect $ log json.status
--_ <- liftEffect $ log json.headers
--_ <- liftEffect $ log json.body
case JSON.readJSON (AC.stringify resp.body) of
Left err -> throwError $ error $ "decodeJson affResp.body: " <> show err
Right b -> pure b
case (JSON.readJSON $ AC.stringify resp.body) of
Left err -> Left $ ReadJSONError err
Right r -> Right r
-- readJSONOrFail affResp = do
-- case readJSON affResp of
-- Left err -> throwError $ error $ "decodeJson affResp.body: " <> show err
-- Right b -> pure b
-- TODO too much duplicate code in `postWwwUrlencoded`
send :: forall body res. JSON.WriteForeign body => JSON.ReadForeign res =>
Method -> Maybe Token -> String -> Maybe body -> Aff res
Method -> Maybe Token -> String -> Maybe body -> Aff (Either RESTError res)
send m mtoken url reqbody = do
let req = defaultRequest
{ url = url
......@@ -62,36 +82,37 @@ send m mtoken url reqbody = do
let cookie = "JWT-Cookie=" <> token <> "; Path=/;" --" HttpOnly; Secure; SameSite=Lax"
R2.setCookie cookie
affResp <- request req
readJSONOrFail affResp
liftEffect $ log2 "affResp" affResp
pure $ readJSON affResp
noReqBody :: Maybe String
noReqBody = Just ""
--noReqBody = Nothing
get :: forall a. JSON.ReadForeign a => Maybe Token -> String -> Aff a
get :: forall a. JSON.ReadForeign a => Maybe Token -> String -> Aff (Either RESTError a)
get mtoken url = send GET mtoken url noReqBody
put :: forall a b. JSON.WriteForeign a => JSON.ReadForeign b => Maybe Token -> String -> a -> Aff b
put :: forall a b. JSON.WriteForeign a => JSON.ReadForeign b => Maybe Token -> String -> a -> Aff (Either RESTError b)
put mtoken url = send PUT mtoken url <<< Just
put_ :: forall a. JSON.ReadForeign a => Maybe Token -> String -> Aff a
put_ :: forall a. JSON.ReadForeign a => Maybe Token -> String -> Aff (Either RESTError a)
put_ mtoken url = send PUT mtoken url noReqBody
delete :: forall a. JSON.ReadForeign a => Maybe Token -> String -> Aff a
delete :: forall a. JSON.ReadForeign a => Maybe Token -> String -> Aff (Either RESTError a)
delete mtoken url = send DELETE mtoken url noReqBody
-- This might not be a good idea:
-- https://stackoverflow.com/questions/14323716/restful-alternatives-to-delete-request-body
deleteWithBody :: forall a b. JSON.WriteForeign a => JSON.ReadForeign b => Maybe Token -> String -> a -> Aff b
deleteWithBody :: forall a b. JSON.WriteForeign a => JSON.ReadForeign b => Maybe Token -> String -> a -> Aff (Either RESTError b)
deleteWithBody mtoken url = send DELETE mtoken url <<< Just
post :: forall a b. JSON.WriteForeign a => JSON.ReadForeign b => Maybe Token -> String -> a -> Aff b
post :: forall a b. JSON.WriteForeign a => JSON.ReadForeign b => Maybe Token -> String -> a -> Aff (Either RESTError b)
post mtoken url = send POST mtoken url <<< Just
type FormDataParams = Array (Tuple String (Maybe String))
-- TODO too much duplicate code with `send`
postWwwUrlencoded :: forall b. JSON.ReadForeign b => Maybe Token -> String -> FormDataParams -> Aff b
postWwwUrlencoded :: forall b. JSON.ReadForeign b => Maybe Token -> String -> FormDataParams -> Aff (Either RESTError b)
postWwwUrlencoded mtoken url bodyParams = do
affResp <- request $ defaultRequest
{ url = url
......@@ -105,11 +126,11 @@ postWwwUrlencoded mtoken url bodyParams = do
) mtoken
, content = Just $ formURLEncoded urlEncodedBody
}
readJSONOrFail affResp
pure $ readJSON affResp
where
urlEncodedBody = FormURLEncoded.fromArray bodyParams
postMultipartFormData :: forall b. JSON.ReadForeign b => Maybe Token -> String -> String -> Aff b
postMultipartFormData :: forall b. JSON.ReadForeign b => Maybe Token -> String -> String -> Aff (Either RESTError b)
postMultipartFormData mtoken url body = do
fd <- liftEffect $ XHRFormData.new
_ <- liftEffect $ XHRFormData.append (XHRFormData.EntryName "body") body fd
......@@ -125,4 +146,4 @@ postMultipartFormData mtoken url body = do
) mtoken
, content = Just $ formData fd
}
readJSONOrFail affResp
pure $ readJSON affResp
src/Gargantext/Hooks/Loader.purs
View file @ 034ea2e7
module Gargantext.Hooks.Loader where
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..), isJust, maybe)
import Data.Newtype (class Newtype)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff_, throwError)
import Effect.Class (liftEffect)
import Effect.Exception (error)
......@@ -13,6 +12,7 @@ import Simple.JSON as JSON
import Toestand as T
import Gargantext.Components.LoadingSpinner (loadingSpinner)
import Gargantext.Config.REST (RESTError)
import Gargantext.Prelude
import Gargantext.Utils.Crypto (Hash)
import Gargantext.Utils.CacheAPI as GUC
......@@ -30,7 +30,7 @@ clearCache _ = GUC.delete $ GUC.CacheName cacheName
useLoader :: forall path st. Eq path => Eq st
=> path
-> (path -> Aff st)
-> (path -> Aff (Either RESTError st))
-> (st -> R.Element)
-> R.Hooks R.Element
useLoader path loader' render = do
......@@ -61,7 +61,7 @@ loaderCpt = here.component "loader" cpt
useLoaderEffect :: forall st path. Eq path => Eq st =>
path
-> T.Box (Maybe st)
-> (path -> Aff st)
-> (path -> Aff (Either RESTError st))
-> R.Hooks Unit
useLoaderEffect path state loader = do
state' <- T.useLive T.unequal state
......@@ -75,7 +75,9 @@ useLoaderEffect path state loader = do
R.setRef oPath path
R2.affEffect "G.H.Loader.useLoaderEffect" $ do
l <- loader path
liftEffect $ T.write_ (Just l) state
case l of
Left _err -> throwError $ error "[useLoaderEffect] RESTError"
Right l' -> liftEffect $ T.write_ (Just l') state
newtype HashedResponse a = HashedResponse { hash :: Hash, value :: a }
......@@ -85,7 +87,7 @@ derive newtype instance JSON.ReadForeign a => JSON.ReadForeign (HashedResponse a
derive newtype instance JSON.WriteForeign a => JSON.WriteForeign (HashedResponse a)
type LoaderWithCacheAPIProps path res ret = (
cacheEndpoint :: path -> Aff Hash
cacheEndpoint :: path -> Aff (Either RESTError Hash)
, handleResponse :: HashedResponse res -> ret
, mkRequest :: path -> GUC.Request
, path :: path
......@@ -109,7 +111,7 @@ useLoaderWithCacheAPI { cacheEndpoint, handleResponse, mkRequest, path, renderer
pure $ maybe (loadingSpinner {}) renderer state'
type LoaderWithCacheAPIEffectProps path res ret = (
cacheEndpoint :: path -> Aff Hash
cacheEndpoint :: path -> Aff (Either RESTError Hash)
, handleResponse :: HashedResponse res -> ret
, mkRequest :: path -> GUC.Request
, path :: path
......@@ -141,14 +143,17 @@ useCachedAPILoaderEffect { cacheEndpoint
-- TODO Parallelize?
hr@(HashedResponse { hash, value }) <- GUC.cachedJson cache req
cacheReal <- cacheEndpoint path
val <- if hash == cacheReal then
pure hr
else do
_ <- GUC.deleteReq cache req
hr'@(HashedResponse { hash: h }) <- GUC.cachedJson cache req
if h == cacheReal then
pure hr'
else
throwError $ error $ "[Hooks.Loader] Fetched clean cache but hashes don't match: " <> h <> " != " <> cacheReal
liftEffect $ do
T.write_ (Just $ handleResponse val) state
case cacheReal of
Left _err -> throwError $ error $ "[useCachedAPILoaderEffect] RESTError"
Right cacheReal' -> do
val <- if hash == cacheReal' then
pure hr
else do
_ <- GUC.deleteReq cache req
hr'@(HashedResponse { hash: h }) <- GUC.cachedJson cache req
if h == cacheReal' then
pure hr'
else
throwError $ error $ "[Hooks.Loader] Fetched clean cache but hashes don't match: " <> h <> " != " <> cacheReal'
liftEffect $ do
T.write_ (Just $ handleResponse val) state
src/Gargantext/Sessions.purs
View file @ 034ea2e7
......@@ -28,9 +28,6 @@ import Gargantext.Ends (class ToUrl, Backend, toUrl)
import Gargantext.Sessions.Types (Session(..), Sessions(..), OpenNodes, NodeId, mkNodeId, sessionUrl, sessionId, empty, null, unSessions, lookup, cons, tryCons, update, remove, tryRemove)
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Sessions"
type WithSession c =
( session :: Session
| c )
......@@ -113,44 +110,42 @@ saveSessions sessions = effect *> pure sessions where
| null sessions = rem
| otherwise = set (JSON.writeJSON sessions)
updateSession :: Session -> Effect Unit
updateSession s = do
ss <- loadSessions
_ <- saveSessions $ update s ss
pure unit
postAuthRequest :: Backend -> AuthRequest -> Aff (Either String Session)
postAuthRequest backend ar@(AuthRequest {username}) =
decode <$> REST.post Nothing (toUrl backend "auth") ar
where
decode (AuthResponse ar2)
decode (Left _err) = Left "Error when sending REST.post"
decode (Right (AuthResponse ar2))
| {inval: Just (AuthInvalid {message})} <- ar2 = Left message
| {valid: Just (AuthData {token, tree_id})} <- ar2 =
Right $ Session { backend, caches: Map.empty, token, treeId: tree_id, username }
| otherwise = Left "Invalid response from server"
get :: forall a p. JSON.ReadForeign a => ToUrl Session p => Session -> p -> Aff a
get :: forall a p. JSON.ReadForeign a => ToUrl Session p =>
Session -> p -> Aff (Either REST.RESTError a)
get session@(Session {token}) p = REST.get (Just token) (toUrl session p)
put :: forall a b p. JSON.WriteForeign a => JSON.ReadForeign b => ToUrl Session p => Session -> p -> a -> Aff b
put :: forall a b p. JSON.WriteForeign a => JSON.ReadForeign b => ToUrl Session p =>
Session -> p -> a -> Aff (Either REST.RESTError b)
put session@(Session {token}) p = REST.put (Just token) (toUrl session p)
put_ :: forall b p. JSON.ReadForeign b => ToUrl Session p => Session -> p -> Aff b
put_ :: forall b p. JSON.ReadForeign b => ToUrl Session p => Session -> p -> Aff (Either REST.RESTError b)
put_ session@(Session {token}) p = REST.put_ (Just token) (toUrl session p)
delete :: forall a p. JSON.ReadForeign a => ToUrl Session p => Session -> p -> Aff a
delete :: forall a p. JSON.ReadForeign a => ToUrl Session p =>
Session -> p -> Aff (Either REST.RESTError a)
delete session@(Session {token}) p = REST.delete (Just token) (toUrl session p)
-- This might not be a good idea:
-- https://stackoverflow.com/questions/14323716/restful-alternatives-to-delete-request-body
deleteWithBody :: forall a b p. JSON.WriteForeign a => JSON.ReadForeign b => ToUrl Session p => Session -> p -> a -> Aff b
deleteWithBody :: forall a b p. JSON.WriteForeign a => JSON.ReadForeign b => ToUrl Session p =>
Session -> p -> a -> Aff (Either REST.RESTError b)
deleteWithBody session@(Session {token}) p = REST.deleteWithBody (Just token) (toUrl session p)
post :: forall a b p. JSON.WriteForeign a => JSON.ReadForeign b => ToUrl Session p => Session -> p -> a -> Aff b
post :: forall a b p. JSON.WriteForeign a => JSON.ReadForeign b => ToUrl Session p =>
Session -> p -> a -> Aff (Either REST.RESTError b)
post session@(Session {token}) p = REST.post (Just token) (toUrl session p)
postWwwUrlencoded :: forall b p. JSON.ReadForeign b => ToUrl Session p => Session -> p -> REST.FormDataParams -> Aff b
postWwwUrlencoded :: forall b p. JSON.ReadForeign b => ToUrl Session p =>
Session -> p -> REST.FormDataParams -> Aff (Either REST.RESTError b)
postWwwUrlencoded session@(Session {token}) p = REST.postWwwUrlencoded (Just token) (toUrl session p)
postMultipartFormData :: forall b p. JSON.ReadForeign b => ToUrl Session p => Session -> p -> String -> Aff b
postMultipartFormData session@(Session {token}) p = REST.postMultipartFormData (Just token) (toUrl session p)
src/Gargantext/Types.purs
View file @ 034ea2e7
module Gargantext.Types where
import Gargantext.Prelude
import CSS.Cursor (Cursor(..))
import Data.Array as A
import Data.Either (Either)
import Data.Eq.Generic (genericEq)
import Data.Generic.Rep (class Generic)
import Data.Int (toNumber)
......@@ -11,15 +15,16 @@ import Data.Show.Generic (genericShow)
import Data.String as S
import Effect.Aff (Aff)
import Foreign as F
import Gargantext.Components.Lang (class Translate, Lang(..))
import Gargantext.Prelude
import Gargantext.Utils.Glyphicon (classNamePrefix, glyphiconToCharCode)
import Prim.Row (class Union)
import Reactix as R
import Simple.JSON as JSON
import Simple.JSON.Generics as JSONG
import URI.Query (Query)
import Gargantext.Components.Lang (class Translate, Lang(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Utils.Glyphicon (classNamePrefix, glyphiconToCharCode)
data Handed = LeftHanded | RightHanded
switchHanded :: forall a. a -> a -> Handed -> a
......@@ -621,6 +626,7 @@ instance DecodeJson TabType where
type TableResult a = {count :: Int, docs :: Array a}
type AffTableResult a = Aff (TableResult a)
type AffETableResult a = Aff (Either RESTError (TableResult a))
data Mode = Authors
| Sources
......@@ -771,3 +777,9 @@ toggleSidePanelState :: SidePanelState -> SidePanelState
toggleSidePanelState InitialClosed = Opened
toggleSidePanelState Closed = Opened
toggleSidePanelState Opened = Closed
---------------------------------------------------------------------------
newtype FrontendError = FrontendError
{ error :: String
}
src/Gargantext/Version.purs
View file @ 034ea2e7
module Gargantext.Version where
import Prelude
import DOM.Simple.Console (log2)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Prelude
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
......@@ -22,7 +24,7 @@ type Version = String
foreign import version :: Version
getBackendVersion :: Session -> Aff Version
getBackendVersion :: Session -> Aff (Either REST.RESTError Version)
getBackendVersion (Session { backend }) = REST.get Nothing (toUrl backend "version")
......@@ -33,7 +35,6 @@ type VersionProps =
versionView :: R2.Component VersionProps
versionView = R.createElement versionCpt
versionCpt :: R.Component VersionProps
versionCpt = here.component "version" cpt
where
......@@ -44,7 +45,9 @@ versionCpt = here.component "version" cpt
R.useEffect' $ do
launchAff_ $ do
v <- getBackendVersion session
liftEffect $ T.write_ v versionBack
case v of
Right v' -> liftEffect $ T.write_ v' versionBack
Left err -> liftEffect $ log2 "[version] error" err
pure $ case version == versionBack' of
true -> H.a { className: "fa fa-check-circle-o"
......
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