[REFACTOR] Generalize the use Config.REST. Avoid using Either for errors in Aff.

parent 2e019d7c
module Gargantext.Components.Login where module Gargantext.Components.Login where
import Affjax (defaultRequest, printResponseFormatError, request) import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.?), (:=), (~>))
import Affjax.RequestBody (RequestBody(..))
import Affjax.RequestHeader (RequestHeader(..))
import Affjax.ResponseFormat as ResponseFormat
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, stringify, (.?), (:=), (~>))
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Lens (over) import Data.Lens (over)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe)
import Data.MediaType.Common (applicationJSON)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
...@@ -23,6 +16,7 @@ import Web.Storage.Storage (getItem, setItem) ...@@ -23,6 +16,7 @@ import Web.Storage.Storage (getItem, setItem)
------------------------------------------------------------------------ ------------------------------------------------------------------------
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Config.REST (post)
import Gargantext.Components.Modals.Modal (modalHide) import Gargantext.Components.Modals.Modal (modalHide)
-- TODO: ask for login (modal) or account creation after 15 mn when user -- TODO: ask for login (modal) or account creation after 15 mn when user
...@@ -230,37 +224,8 @@ newtype LoginReq = LoginReq ...@@ -230,37 +224,8 @@ newtype LoginReq = LoginReq
, password :: String , password :: String
} }
loginReq :: LoginReq -> Aff (Either String LoginRes) loginReq :: LoginReq -> Aff LoginRes
loginReq encodeData = loginReq = post "https://dev.gargantext.org/api/auth/token"
let
setting =
defaultRequest
{ url = "https://dev.gargantext.org/api/auth/token"
, method = Left POST
, responseFormat = ResponseFormat.json
, headers =
[ ContentType applicationJSON
, Accept applicationJSON
]
, content = Just $ Json $ encodeJson encodeData
}
in
do
affResp <- request setting
case affResp.body of
Left err -> do
logs $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
logs $ "POST method Completed"
logs $ "GET /api response: " <> stringify json
let obj = decodeJson json
case obj of
Left e ->
logs $ "Error Decoding : " <> show e
Right (LoginRes res1) ->
liftEffect $ setToken res1.token
pure obj
instance decodeLoginRes :: DecodeJson LoginRes where instance decodeLoginRes :: DecodeJson LoginRes where
decodeJson json = do decodeJson json = do
......
...@@ -20,7 +20,7 @@ type Rows = Array { row :: Array ReactElement ...@@ -20,7 +20,7 @@ type Rows = Array { row :: Array ReactElement
, delete :: Boolean , delete :: Boolean
} }
type LoadRows = { offset :: Int, limit :: Int } -> Aff (Either String Rows) type LoadRows = { offset :: Int, limit :: Int } -> Aff Rows
type Props' = type Props' =
( title :: String ( title :: String
...@@ -101,11 +101,8 @@ loadAndSetRows :: {loadRows :: LoadRows} -> State -> StateCoTransformer State Un ...@@ -101,11 +101,8 @@ loadAndSetRows :: {loadRows :: LoadRows} -> State -> StateCoTransformer State Un
loadAndSetRows {loadRows} {pageSize, currentPage} = do loadAndSetRows {loadRows} {pageSize, currentPage} = do
let limit = pageSizes2Int pageSize let limit = pageSizes2Int pageSize
offset = limit * (currentPage - 1) offset = limit * (currentPage - 1)
x <- lift $ loadRows {offset, limit} rows <- lift $ loadRows {offset, limit}
case x of void $ modifyState (_ { rows = Just rows })
Left err -> logs err
Right rows ->
void $ modifyState (_ { rows = Just rows })
tableClass :: ReactClass {children :: Children | Props'} tableClass :: ReactClass {children :: Children | Props'}
tableClass = tableClass =
......
module Gargantext.Components.Tree where module Gargantext.Components.Tree where
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..))
import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift) import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (class DecodeJson, class EncodeJson, Json, decodeJson, encodeJson, jsonEmptyObject, (.?), (:=), (~>)) import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.?), (:=), (~>))
import Data.Argonaut.Core (Json)
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Data.Traversable (traverse)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Prelude (identity) import Prelude (identity)
import React (ReactElement) import React (ReactElement)
import React.DOM (a, button, div, h5, i, input, li, span, text, ul) import React.DOM (a, button, div, h5, i, input, li, text, ul)
import React.DOM.Props (Props, _type, className, href, onClick, onInput, placeholder, style, value) import React.DOM.Props (Props, _type, className, href, onClick, onInput, placeholder, style, value)
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec) import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
import Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Config (NodeType(..), readNodeType, toUrl, readNodeType, End(..), ApiVersion, defaultRoot) import Gargantext.Config.REST (get, put, post, delete)
import Gargantext.Config (NodeType(..), toUrl, End(..), defaultRoot)
type Name = String type Name = String
type Open = Boolean type Open = Boolean
...@@ -127,10 +122,8 @@ treeview = simpleSpec performAction render ...@@ -127,10 +122,8 @@ treeview = simpleSpec performAction render
performAction ShowPopOver _ _ = void $ performAction ShowPopOver _ _ = void $
modifyState $ \(NTree (LNode lnode) ary) -> NTree (LNode $ lnode { popOver = true }) ary modifyState $ \(NTree (LNode lnode) ary) -> NTree (LNode $ lnode { popOver = true }) ary
performAction Submit _ s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) ary) = void $ do performAction Submit _ s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) ary) = void $ do
s' <- lift $ renameNode id $ RenameValue { name : getRenameNodeValue s} d <- lift $ renameNode id $ RenameValue { name : getRenameNodeValue s}
case s' of modifyState identity -- TODO why ???
Left err -> modifyState identity
Right d -> modifyState identity
performAction (RenameNode r) _ _ = void $ performAction (RenameNode r) _ _ = void $
modifyState $ \(NTree (LNode lnode) ary) -> NTree (LNode $ lnode { renameNodeValue = r }) ary modifyState $ \(NTree (LNode lnode) ary) -> NTree (LNode $ lnode { renameNodeValue = r }) ary
-- performAction Initialize _ _ = void $ do -- performAction Initialize _ _ = void $ do
...@@ -268,24 +261,8 @@ instance decodeJsonFTree :: DecodeJson (NTree LNode) where ...@@ -268,24 +261,8 @@ instance decodeJsonFTree :: DecodeJson (NTree LNode) where
nodes' <- decodeJson nodes nodes' <- decodeJson nodes
pure $ NTree node' nodes' pure $ NTree node' nodes'
loadDefaultNode :: Aff (Either String (NTree LNode)) loadDefaultNode :: Aff (NTree LNode)
loadDefaultNode = do loadDefaultNode = get $ toUrl Back Tree defaultRoot
res <- request $ defaultRequest
{ url = toUrl Back Tree defaultRoot
, responseFormat = ResponseFormat.json
, method = Left GET
, headers = []
}
case res.body of
Left err -> do
_ <- logs $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- logs $ show a.status
--_ <- logs $ show a.headers
--_ <- logs $ show a.body
let obj = decodeJson json
pure obj
----- TREE CRUD Operations ----- TREE CRUD Operations
...@@ -300,96 +277,25 @@ instance encodeJsonRenameValue :: EncodeJson RenameValue where ...@@ -300,96 +277,25 @@ instance encodeJsonRenameValue :: EncodeJson RenameValue where
~> jsonEmptyObject ~> jsonEmptyObject
renameNode :: Int -> RenameValue -> Aff (Either String (Int)) --- need to change return type herre renameNode :: Int -> RenameValue -> Aff Int --- need to change return type herre
renameNode renameNodeId reqbody = do renameNode renameNodeId reqbody =
res <- request $ defaultRequest put ("http://localhost:8008/api/v1.0/node/" <> show renameNodeId <> "/rename")
{ url = "http://localhost:8008/api/v1.0/node/" <> show renameNodeId <> "/rename" reqbody
, responseFormat = ResponseFormat.json
, method = Left PUT
, headers = []
, content = Just $ Json $ encodeJson reqbody
}
case res.body of
Left err -> do
_ <- logs $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- logs $ show a.status
--_ <- logs $ show a.headers
--_ <- logs $ show a.body
let obj = decodeJson json
pure obj
deleteNode :: Aff (Either String (Int))
deleteNode = do
res <- request $ defaultRequest
{ url = toUrl Back Tree 1
, responseFormat = ResponseFormat.json
, method = Left DELETE
, headers = []
}
case res.body of
Left err -> do
_ <- logs $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- logs $ show a.status
--_ <- logs $ show a.headers
--_ <- logs $ show a.body
let obj = decodeJson json
pure obj
deleteNodes :: String -> Aff (Either String Int)
deleteNodes reqbody = do
res <- request $ defaultRequest
{ url = toUrl Back Tree 1
, responseFormat = ResponseFormat.json
, method = Left DELETE
, headers = []
, content = Just $ Json $ encodeJson reqbody
}
case res.body of
Left err -> do
_ <- logs $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- logs $ show a.status
--_ <- logs $ show a.headers
--_ <- logs $ show a.body
let obj = decodeJson json
pure obj
createNode :: String -> Aff (Either String (Int))
createNode reqbody= do
res <- request $ defaultRequest
{ url = toUrl Back Tree 1
, responseFormat = ResponseFormat.json
, method = Left POST
, headers = []
, content = Just $ Json $ encodeJson reqbody
}
case res.body of
Left err -> do
_ <- logs $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- logs $ show a.status
--_ <- logs $ show a.headers
--_ <- logs $ show a.body
let obj = decodeJson json
pure obj
deleteNode :: Int -> Aff Int
deleteNode = delete <<< toUrl Back Tree
-- See https://stackoverflow.com/questions/21863326/delete-multiple-records-using-rest
-- As of now I would recommend simply issuing many requests.
-- In a second time implement a set of end points for batch edition.
deleteNodes :: Array Int -> Aff (Array Int)
deleteNodes = traverse deleteNode
createNode :: String -> Aff Int
createNode reqbody = post (toUrl Back Tree 1) reqbody
fnTransform :: LNode -> FTree fnTransform :: LNode -> FTree
fnTransform n = NTree n [] fnTransform n = NTree n []
unsafeEventValue :: forall event. event -> String unsafeEventValue :: forall event. event -> String
unsafeEventValue e = (unsafeCoerce e).target.value unsafeEventValue e = (unsafeCoerce e).target.value
module Gargantext.Config.REST where module Gargantext.Config.REST where
import Prelude
import Affjax (defaultRequest, printResponseFormatError, request) import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..))
import Affjax.RequestHeader (RequestHeader(..)) import Affjax.RequestHeader (RequestHeader(..))
import Affjax.ResponseFormat as ResponseFormat import Affjax.ResponseFormat as ResponseFormat
import Data.Argonaut (class DecodeJson, decodeJson) import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.HTTP.Method (Method(..)) import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(..))
import Data.MediaType.Common (applicationJSON) import Data.MediaType.Common (applicationJSON)
import Effect.Aff (Aff) import Effect.Aff (Aff, throwError)
import Effect.Exception (error)
get :: forall t31. DecodeJson t31 => String ->
Aff (Either String t31) import Gargantext.Prelude
get url = do
affResp <- request defaultRequest send :: forall a b. EncodeJson a => DecodeJson b =>
{ method = Left GET Method -> String -> Maybe a -> Aff b
, url = url send m url reqbody = do
, responseFormat = ResponseFormat.json affResp <- request $ defaultRequest
, headers = [ ContentType applicationJSON { url = url
, Accept applicationJSON , responseFormat = ResponseFormat.json
-- , RequestHeader "Authorization" $ "Bearer " <> token , method = Left m
] , headers = [ ContentType applicationJSON
} , Accept applicationJSON
-- , RequestHeader "Authorization" $ "Bearer " <> token
]
, content = (Json <<< encodeJson) <$> reqbody
}
case affResp.body of case affResp.body of
Left err -> do Left err -> do
pure $ Left $ printResponseFormatError err _ <- logs $ printResponseFormatError err
Right a -> do throwError $ error $ printResponseFormatError err
let res = decodeJson a Right json -> do
pure res --_ <- logs $ show json.status
--_ <- logs $ show json.headers
--_ <- logs $ show json.body
case decodeJson json of
Left err -> throwError $ error $ "decodeJson affResp.body: " <> err
Right b -> pure b
noReqBody :: Maybe Unit
noReqBody = Nothing
get :: forall a. DecodeJson a => String -> Aff a
get url = send GET url noReqBody
put :: forall a b. EncodeJson a => DecodeJson b => String -> a -> Aff b
put url = send PUT url <<< Just
delete :: forall a. DecodeJson a => String -> Aff a
delete url = send DELETE url noReqBody
post :: forall a b. EncodeJson a => DecodeJson b => String -> a -> Aff b
post url = send POST url <<< Just
...@@ -81,18 +81,11 @@ layoutAnnuaire = simpleSpec performAction render ...@@ -81,18 +81,11 @@ layoutAnnuaire = simpleSpec performAction render
where where
performAction :: PerformAction State {} Action performAction :: PerformAction State {} Action
performAction (Load aId) _ _ = do performAction (Load aId) _ _ = do
eitherInfo <- lift $ getInfo aId info' <- lift $ getInfo aId
_ <- case eitherInfo of void $ modifyState $ _info ?~ info'
(Right info') -> void $ modifyState $ _info ?~ info' table' <- lift $ getTable aId
(Left err) -> do
logs err
eitherTable <- lift $ getTable aId
logs "Feching Table" logs "Feching Table"
_ <- case eitherTable of void $ modifyState $ _table ?~ table'
(Right table') -> void $ modifyState $ _table ?~ table'
(Left err) -> do
logs err
logs "Annuaire page fetched." logs "Annuaire page fetched."
performAction (ChangePageSize _) _ _ = pure unit -- TODO performAction (ChangePageSize _) _ _ = pure unit -- TODO
performAction (ChangePage _) _ _ = pure unit -- TODO performAction (ChangePage _) _ _ = pure unit -- TODO
...@@ -191,10 +184,10 @@ instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where ...@@ -191,10 +184,10 @@ instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where
rows <- decodeJson json rows <- decodeJson json
pure $ AnnuaireTable { annuaireTable : rows} pure $ AnnuaireTable { annuaireTable : rows}
------------------------------------------------------------------------ ------------------------------------------------------------------------
getTable :: Int -> Aff (Either String AnnuaireTable) getTable :: Int -> Aff AnnuaireTable
getTable id = get $ toUrl Back (Children 0 10) id getTable id = get $ toUrl Back (Children 0 10) id
getInfo :: Int -> Aff (Either String AnnuaireInfo) getInfo :: Int -> Aff AnnuaireInfo
getInfo id = get $ toUrl Back Node id getInfo id = get $ toUrl Back Node id
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
_table :: Lens' State (Maybe AnnuaireTable) _table :: Lens' State (Maybe AnnuaireTable)
......
...@@ -14,14 +14,11 @@ import Gargantext.Config.REST (get) ...@@ -14,14 +14,11 @@ import Gargantext.Config.REST (get)
import Gargantext.Pages.Annuaire.User.Users.Types (Action(..), State, User, _user) import Gargantext.Pages.Annuaire.User.Users.Types (Action(..), State, User, _user)
import Gargantext.Prelude import Gargantext.Prelude
getUser :: Int -> Aff (Either String User) getUser :: Int -> Aff User
getUser id = get $ toUrl Back Node id getUser id = get $ toUrl Back Node id
fetchUser :: Int -> StateCoTransformer State Unit fetchUser :: Int -> StateCoTransformer State Unit
fetchUser userId = do fetchUser userId = do
value <- lift $ getUser userId user <- lift $ getUser userId
_ <- case value of void $ modifyState $ _user ?~ user
(Right user) -> void $ modifyState $ _user ?~ user
(Left err) -> do
logs err
logs "Fetching user..." logs "Fetching user..."
...@@ -148,12 +148,9 @@ corpusHeaderSpec = simpleSpec performAction render ...@@ -148,12 +148,9 @@ corpusHeaderSpec = simpleSpec performAction render
------------------------------------------------------------------------ ------------------------------------------------------------------------
performAction :: PerformAction HeaderState {} HeaderAction performAction :: PerformAction HeaderState {} HeaderAction
performAction (Load nId) _ _ = do performAction (Load nId) _ _ = do
eitherInfo <- lift $ getNode nId node <- lift $ getNode nId
_ <- case eitherInfo of void $ modifyState $ _info ?~ node
(Right node') -> void $ modifyState $ _info ?~ node'
(Left err) -> do
logs err
logs $ "Node Corpus fetched." logs $ "Node Corpus fetched."
getNode :: Int -> Aff (Either String (NodePoly CorpusInfo)) getNode :: Int -> Aff (NodePoly CorpusInfo)
getNode id = get $ toUrl Back Node id getNode = get <<< toUrl Back Node
...@@ -261,17 +261,14 @@ instance decodeDocument :: DecodeJson Document ...@@ -261,17 +261,14 @@ instance decodeDocument :: DecodeJson Document
------------------------------------------------------------------------ ------------------------------------------------------------------------
performAction :: PerformAction State {} Action performAction :: PerformAction State {} Action
performAction (Load nId) _ _ = do performAction (Load nId) _ _ = do
eitherInfo <- lift $ getNode nId node <- lift $ getNode nId
_ <- case eitherInfo of void $ modifyState $ _document ?~ node
(Right node) -> void $ modifyState $ _document ?~ node
(Left err) -> do
logs err
logs $ "Node Document " <> show nId <> " fetched." logs $ "Node Document " <> show nId <> " fetched."
performAction (ChangeString ps) _ _ = pure unit performAction (ChangeString ps) _ _ = pure unit
performAction (SetInput ps) _ _ = void <$> modifyState $ _ { inputValue = ps } performAction (SetInput ps) _ _ = void <$> modifyState $ _ { inputValue = ps }
getNode :: Int -> Aff (Either String (NodePoly DocumentV3)) getNode :: Int -> Aff (NodePoly DocumentV3)
getNode id = get $ toUrl Back Node id getNode = get <<< toUrl Back Node
_document :: Lens' State (Maybe (NodePoly DocumentV3)) _document :: Lens' State (Maybe (NodePoly DocumentV3))
_document = lens (\s -> s.document) (\s ss -> s{document = ss}) _document = lens (\s -> s.document) (\s ss -> s{document = ss})
......
module Gargantext.Pages.Corpus.Graph where module Gargantext.Pages.Corpus.Graph where
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestHeader (RequestHeader(..))
import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift) import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (decodeJson, stringify)
import Data.Array (length, mapWithIndex, (!!)) import Data.Array (length, mapWithIndex, (!!))
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Int (toNumber) import Data.Int (toNumber)
import Data.Maybe (Maybe(..), fromJust) import Data.Maybe (Maybe(..), fromJust)
import Data.MediaType.Common (applicationJSON)
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Math (cos, sin) import Math (cos, sin)
...@@ -22,6 +16,7 @@ import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec) ...@@ -22,6 +16,7 @@ import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
import Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Config.REST (get)
import Gargantext.Components.GraphExplorer.Sigmajs (Color(Color), SigmaEasing, SigmaGraphData(SigmaGraphData), SigmaNode, SigmaSettings, canvas, edgeShape, edgeShapes, forceAtlas2, sStyle, sigma, sigmaEasing, sigmaEdge, sigmaEnableWebGL, sigmaNode, sigmaSettings) import Gargantext.Components.GraphExplorer.Sigmajs (Color(Color), SigmaEasing, SigmaGraphData(SigmaGraphData), SigmaNode, SigmaSettings, canvas, edgeShape, edgeShapes, forceAtlas2, sStyle, sigma, sigmaEasing, sigmaEdge, sigmaEnableWebGL, sigmaNode, sigmaSettings)
import Gargantext.Components.GraphExplorer.Types (Cluster(..), Edge(..), GraphData(..), Legend(..), Node(..), getLegendData) import Gargantext.Components.GraphExplorer.Types (Cluster(..), Edge(..), GraphData(..), Legend(..), Node(..), getLegendData)
import Gargantext.Utils (getter) import Gargantext.Utils (getter)
...@@ -65,11 +60,9 @@ performAction (LoadGraph fp) _ _ = void do ...@@ -65,11 +60,9 @@ performAction (LoadGraph fp) _ _ = void do
_ -> do _ -> do
_ <- modifyState \(State s) -> State s {filePath = fp, sigmaGraphData = Nothing} _ <- modifyState \(State s) -> State s {filePath = fp, sigmaGraphData = Nothing}
gd <- lift $ getGraphData fp gd <- lift $ getGraphData fp
case gd of -- TODO: here one might `catchError getGraphData` to visually empty the
Left err -> do -- graph.
modifyState \(State s) -> State s {filePath = fp, graphData = GraphData {nodes : [], edges : []}} modifyState \(State s) -> State s {filePath = fp, graphData = gd, sigmaGraphData = Just $ convert gd, legendData = getLegendData gd}
Right gd' -> do
modifyState \(State s) -> State s {filePath = fp, graphData = gd', sigmaGraphData = Just $ convert gd', legendData = getLegendData gd'}
performAction (SelectNode node) _ _ = void do performAction (SelectNode node) _ _ = void do
modifyState $ \(State s) -> State s {selectedNode = pure node} modifyState $ \(State s) -> State s {selectedNode = pure node}
...@@ -220,27 +213,8 @@ mySettings = sigmaSettings { verbose : true ...@@ -220,27 +213,8 @@ mySettings = sigmaSettings { verbose : true
-- loadJSON {path : "http://localhost:2015/examples/sites_coords.json"} -- loadJSON {path : "http://localhost:2015/examples/sites_coords.json"}
getGraphData :: String -> Aff (Either String GraphData) getGraphData :: String -> Aff GraphData
getGraphData fp = do getGraphData fp = get $ "http://localhost:2015/examples/" <> fp
resp <- request defaultRequest
{ url =("http://localhost:2015/examples/" <> fp)
, method = Left GET
, responseFormat = ResponseFormat.json
, headers =
[ ContentType applicationJSON
, Accept applicationJSON
]
}
case resp.body of
Left err -> do
logs $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
logs $ stringify json
let gd = decodeJson json
pure gd
defaultPalette :: Array Color defaultPalette :: Array Color
defaultPalette = map Color defaultPalette' defaultPalette = map Color defaultPalette'
......
module Gargantext.Pages.Corpus.Tabs.Documents where module Gargantext.Pages.Corpus.Tabs.Documents where
import Data.Maybe (Maybe(..), maybe) import Data.Array (take, drop)
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.ResponseFormat as ResponseFormat
import Data.Array (take, drop, length)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.?), (:=), (~>)) import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.?), (:=), (~>))
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.HTTP.Method (Method(..))
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import React.DOM (a, br', div, input, p, text) import React.DOM (a, br', div, input, p, text)
import React.DOM.Props (_type, className, href) import React.DOM.Props (_type, className, href)
import Thermite (PerformAction, Render, Spec, modifyState, defaultPerformAction, simpleSpec) import Thermite (Render, Spec, defaultPerformAction, simpleSpec)
------------------------------------------------------------------------ ------------------------------------------------------------------------
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Config (NodeType(..), toUrl, End(..)) import Gargantext.Config (NodeType(..), toUrl, End(..))
import Gargantext.Config.REST (get) import Gargantext.Config.REST (get, post)
import Gargantext.Utils.DecodeMaybe ((.|)) import Gargantext.Utils.DecodeMaybe ((.|))
import Gargantext.Components.Charts.Options.ECharts (chart) import Gargantext.Components.Charts.Options.ECharts (chart)
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
...@@ -153,57 +148,46 @@ layoutDocview = simpleSpec absurd render ...@@ -153,57 +148,46 @@ layoutDocview = simpleSpec absurd render
loadRows {offset, limit} = do loadRows {offset, limit} = do
_ <- logs "loading documents page" _ <- logs "loading documents page"
res <- loadPage {nodeId,offset,limit} res <- loadPage {nodeId,offset,limit}
case res of _ <- logs "OK: loading page documents."
Left err -> do pure $
_ <- logs $ "Error: loading page documents:" <> show err (\(DocumentsView r) ->
pure $ Left err { row:
Right resData -> do [ div [className $ fa r.fav <> "fa-star"] []
_ <- logs "OK: loading page documents." -- TODO show date: Year-Month-Day only
pure $ Right $ , text r.date
(\(DocumentsView r) -> , a [ href (toUrl Front Url_Document r._id) ] [ text r.title ]
{ row: , text r.source
[ div [className $ fa r.fav <> "fa-star"] [] , input [ _type "checkbox"]
-- TODO show date: Year-Month-Day only ]
, text r.date , delete: false
, a [ href (toUrl Front Url_Document r._id) ] [ text r.title ] }) <$> res
, text r.source
, input [ _type "checkbox"]
]
, delete: false
}) <$> resData
fa true = "fas " fa true = "fas "
fa false = "far " fa false = "far "
mock :: Boolean mock :: Boolean
mock = false mock = false
loadPage :: {nodeId :: Int, limit :: Int, offset :: Int} -> Aff (Either String (Array DocumentsView)) loadPage :: {nodeId :: Int, limit :: Int, offset :: Int} -> Aff (Array DocumentsView)
loadPage {nodeId, limit, offset} = do loadPage {nodeId, limit, offset} = do
logs "loading documents page: loadPage with Offset and limit" logs "loading documents page: loadPage with Offset and limit"
res <- get $ toUrl Back (Children offset limit) nodeId res <- get $ toUrl Back (Children offset limit) nodeId
case res of let docs = res2corpus <$> res
Left err -> do _ <- logs "Ok: loading page documents"
_ <- logs "Err: loading page documents" _ <- logs $ map show docs
_ <- logs err pure $
pure $ Left $ show err if mock then take limit $ drop offset sampleData else
Right resData -> do docs
let docs = res2corpus <$> resData where
_ <- logs "Ok: loading page documents" res2corpus :: Response -> DocumentsView
_ <- logs $ map show docs res2corpus (Response r) =
pure $ Right $ DocumentsView { _id : r.cid
if mock then take limit $ drop offset sampleData else , url : ""
docs , date : r.created
where , title : (\(Hyperdata hr) -> hr.title) r.hyperdata
res2corpus :: Response -> DocumentsView , source : (\(Hyperdata hr) -> hr.source) r.hyperdata
res2corpus (Response r) = , fav : r.favorite
DocumentsView { _id : r.cid , ngramCount : r.ngramCount
, url : "" }
, date : r.created
, title : (\(Hyperdata hr) -> hr.title) r.hyperdata
, source : (\(Hyperdata hr) -> hr.source) r.hyperdata
, fav : r.favorite
, ngramCount : r.ngramCount
}
--------------------------------------------------------- ---------------------------------------------------------
...@@ -235,21 +219,6 @@ instance encodeJsonSQuery :: EncodeJson SearchQuery where ...@@ -235,21 +219,6 @@ instance encodeJsonSQuery :: EncodeJson SearchQuery where
searchResults :: SearchQuery -> Aff (Either String (Int)) searchResults :: SearchQuery -> Aff Int
searchResults squery = do searchResults squery = post "http://localhost:8008/count" unit
res <- request $ defaultRequest -- TODO
{ url = "http://localhost:8008/count"
, responseFormat = ResponseFormat.json
, method = Left POST
, headers = []
}
case res.body of
Left err -> do
_ <- logs $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- logs a.status
--_ <- logs a.headers
--_ <- logs a.body
let obj = decodeJson json
pure obj
...@@ -6,7 +6,6 @@ import Control.Monad.Cont.Trans (lift) ...@@ -6,7 +6,6 @@ import Control.Monad.Cont.Trans (lift)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Lens (Prism', prism) import Data.Lens (Prism', prism)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Console (log)
import Thermite (PerformAction, modifyState) import Thermite (PerformAction, modifyState)
import Gargantext.Components.Login as LN import Gargantext.Components.Login as LN
...@@ -16,7 +15,6 @@ import Gargantext.Pages.Annuaire as Annuaire ...@@ -16,7 +15,6 @@ import Gargantext.Pages.Annuaire as Annuaire
import Gargantext.Pages.Annuaire.User.Users as U import Gargantext.Pages.Annuaire.User.Users as U
import Gargantext.Pages.Corpus as Corpus import Gargantext.Pages.Corpus as Corpus
import Gargantext.Pages.Corpus.Document as D import Gargantext.Pages.Corpus.Document as D
import Gargantext.Pages.Corpus.Tabs.Documents as DV
import Gargantext.Pages.Corpus.Graph as GE import Gargantext.Pages.Corpus.Graph as GE
import Gargantext.Pages.Layout.Specs.AddCorpus as AC import Gargantext.Pages.Layout.Specs.AddCorpus as AC
import Gargantext.Pages.Layout.Specs.Search as S import Gargantext.Pages.Layout.Specs.Search as S
...@@ -72,12 +70,7 @@ performAction Initialize _ state = void do ...@@ -72,12 +70,7 @@ performAction Initialize _ state = void do
case state.initialized of case state.initialized of
false -> do false -> do
lnodes <- lift $ Tree.loadDefaultNode lnodes <- lift $ Tree.loadDefaultNode
case lnodes of void $ modifyState $ _ { initialized = true, ntreeState = lnodes }
Left err -> do
pure unit
Right d -> do
_ <- modifyState $ _ { initialized = true, ntreeState = d}
pure unit
_ -> do _ -> do
pure unit pure unit
......
module Gargantext.Pages.Layout.Specs.AddCorpus.Actions where module Gargantext.Pages.Layout.Specs.AddCorpus.Actions where
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..))
import Affjax.RequestHeader (RequestHeader(..))
import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift) import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, stringify, (:=), (~>)) import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(Just))
import Data.MediaType.Common (applicationJSON)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Console (log)
import Routing.Hash (setHash) import Routing.Hash (setHash)
import Thermite (PerformAction, modifyState) import Thermite (PerformAction, modifyState)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Config.REST (post)
import Gargantext.Components.Modals.Modal (modalHide) import Gargantext.Components.Modals.Modal (modalHide)
import Gargantext.Pages.Layout.Specs.AddCorpus.States (Response, State) import Gargantext.Pages.Layout.Specs.AddCorpus.States (Response, State)
...@@ -35,10 +27,7 @@ performAction (UnselectDatabase unselected) _ _ = void do ...@@ -35,10 +27,7 @@ performAction (UnselectDatabase unselected) _ _ = void do
performAction (LoadDatabaseDetails) _ _ = do performAction (LoadDatabaseDetails) _ _ = do
res <- lift $ getDatabaseDetails $ QueryString { query_query: "string",query_name: ["Pubmed"]} res <- lift $ getDatabaseDetails $ QueryString { query_query: "string",query_name: ["Pubmed"]}
case res of void $ modifyState $ _ {response = res}
Left err -> pure unit
Right resData -> do
void $ modifyState $ _ {response = resData}
performAction GO _ _ = do performAction GO _ _ = do
liftEffect $ setHash "/corpus" liftEffect $ setHash "/corpus"
...@@ -68,25 +57,7 @@ instance encodeJsonQueryString :: EncodeJson QueryString where ...@@ -68,25 +57,7 @@ instance encodeJsonQueryString :: EncodeJson QueryString where
~> "query_name" := obj.query_name ~> "query_name" := obj.query_name
~> jsonEmptyObject ~> jsonEmptyObject
getDatabaseDetails :: QueryString -> Aff (Either String (Array Response)) getDatabaseDetails :: QueryString -> Aff (Array Response)
getDatabaseDetails reqBody = do getDatabaseDetails reqBody = do
let token = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJleHAiOjE1MTk5OTg1ODMsInVzZXJfaWQiOjUsImVtYWlsIjoiYWxleGFuZHJlLmRlbGFub2VAaXNjcGlmLmZyIiwidXNlcm5hbWUiOiJkZXZlbG9wZXIifQ.Os-3wuFNSmRIxCZi98oFNBu2zqGc0McO-dgDayozHJg" -- TODO let token = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJleHAiOjE1MTk5OTg1ODMsInVzZXJfaWQiOjUsImVtYWlsIjoiYWxleGFuZHJlLmRlbGFub2VAaXNjcGlmLmZyIiwidXNlcm5hbWUiOiJkZXZlbG9wZXIifQ.Os-3wuFNSmRIxCZi98oFNBu2zqGc0McO-dgDayozHJg"
affResp <- request $ defaultRequest post "http://localhost:8009/count" reqBody
{ method = Left POST
, responseFormat = ResponseFormat.json
, url = "http://localhost:8009/count"
, headers = [ ContentType applicationJSON
, Accept applicationJSON
-- , RequestHeader "Authorization" $ "Bearer " <> token
]
, content = Just $ Json $ encodeJson reqBody
}
case affResp.body of
Left err -> do
logs $ "error" <> printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
logs $ "POST method Completed"
logs $ "GET /api response: " <> stringify json
let obj = decodeJson json
pure obj
module Gargantext.Pages.Layout.Specs.AddCorpus.Specs where module Gargantext.Pages.Layout.Specs.AddCorpus.Specs where
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..))
import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, (.?), (:=), (~>))
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Lens (over) import Data.Lens (over)
import Data.Maybe (Maybe(Just))
import Data.MediaType.Common (applicationJSON)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Gargantext.Components.Modals.Modal (modalHide)
import React (ReactElement) import React (ReactElement)
import React.DOM (button, div, h3, h5, li, span, text, ul) import React.DOM (button, div, h3, h5, li, span, text, ul)
import React.DOM.Props (_data, _id, _type, aria, className, onClick, role) import React.DOM.Props (_data, _id, _type, aria, className, onClick, role)
import Thermite (PerformAction, Render, Spec, _render, simpleSpec) import Thermite (Render, Spec, _render, simpleSpec)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Pages.Layout.Specs.AddCorpus.Actions import Gargantext.Config.REST (post)
import Gargantext.Pages.Layout.Specs.AddCorpus.States import Gargantext.Pages.Layout.Specs.AddCorpus.Actions (Action(..), performAction)
import Gargantext.Pages.Layout.Specs.AddCorpus.States (Query, Response(..), State)
modalSpec :: Boolean -> String -> Spec State {} Action -> Spec State {} Action modalSpec :: Boolean -> String -> Spec State {} Action -> Spec State {} Action
modalSpec sm t = over _render \render d p s c -> modalSpec sm t = over _render \render d p s c ->
...@@ -124,22 +113,5 @@ layoutAddcorpus = simpleSpec performAction render ...@@ -124,22 +113,5 @@ layoutAddcorpus = simpleSpec performAction render
countResults :: Query -> Aff (Either String (Int)) countResults :: Query -> Aff Int
countResults query = do countResults = post "http://localhost:8008/count"
res <- request $ defaultRequest
{ url = "http://localhost:8008/count"
, responseFormat = ResponseFormat.json
, method = Left POST
, headers = []
, content = Just $ Json $ encodeJson query
}
case res.body of
Left err -> do
_ <- logs $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- logs $ show a.status
--_ <- logs $ show a.headers
--_ <- logs $ show a.body
let obj = decodeJson json
pure obj
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