Skip to content

P
purescript-gargantext
Commit 11f4718e authored by Nicolas Pouillard's avatar Nicolas Pouillard
Browse files
Options

Auth: Rework the get/put/post... to pass session

parent 6cbaad00
Show whitespace changes
Inline Side-by-side
Showing with 233 additions and 986 deletions
src/Gargantext/Components/DocsTable.purs
View file @ 11f4718e
...@@ -24,15 +24,13 @@ import Effect.Class (liftEffect) ...@@ -24,15 +24,13 @@ import Effect.Class (liftEffect)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
------------------------------------------------------------------------ ------------------------------------------------------------------------
import Gargantext.Config.REST (post, delete)
import Gargantext.Components.Search.Types (Category(..), CategoryQuery(..), favCategory, trashCategory, decodeCategory, putCategories) import Gargantext.Components.Search.Types (Category(..), CategoryQuery(..), favCategory, trashCategory, decodeCategory, putCategories)
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Routes (SessionRoute(NodeAPI)) import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, sessionId) import Gargantext.Sessions (Session, sessionId, post, delete)
import Gargantext.Types (NodeType(..), OrderBy(..), TabType, TabPostQuery(..)) import Gargantext.Types (NodeType(..), OrderBy(..), TabType, TabPostQuery(..))
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -223,8 +221,8 @@ loadPage :: Session -> PageParams -> Aff (Array DocumentsView) ...@@ -223,8 +221,8 @@ loadPage :: Session -> PageParams -> Aff (Array DocumentsView)
loadPage session {nodeId, tabType, query, listId, corpusId, params: {limit, offset, orderBy}} = do loadPage session {nodeId, tabType, query, listId, corpusId, params: {limit, offset, orderBy}} = do
liftEffect $ log "loading documents page: loadPage with Offset and limit" liftEffect $ log "loading documents page: loadPage with Offset and limit"
-- res <- get $ toUrl endConfigStateful Back (Tab tabType offset limit (convOrderBy <$> orderBy)) (Just nodeId) -- res <- get $ toUrl endConfigStateful Back (Tab tabType offset limit (convOrderBy <$> orderBy)) (Just nodeId)
let url2 = (url session (NodeAPI Node (Just nodeId))) <> "/table" let p = NodeAPI Node (Just nodeId) "table"
res <- post url2 $ TabPostQuery { res <- post session p $ TabPostQuery {
offset offset
, limit , limit
, orderBy: convOrderBy orderBy , orderBy: convOrderBy orderBy
...@@ -337,29 +335,27 @@ sampleDocuments :: Array (Tuple String String) ...@@ -337,29 +335,27 @@ sampleDocuments :: Array (Tuple String String)
sampleDocuments = [Tuple "Macroscopic dynamics of the fusion process" "Journal de Physique Lettres",Tuple "Effects of static and cyclic fatigue at high temperature upon reaction bonded silicon nitride" "Journal de Physique Colloques",Tuple "Reliability of metal/glass-ceramic junctions made by solid state bonding" "Journal de Physique Colloques",Tuple "High temperature mechanical properties and intergranular structure of sialons" "Journal de Physique Colloques",Tuple "SOLUTIONS OF THE LANDAU-VLASOV EQUATION IN NUCLEAR PHYSICS" "Journal de Physique Colloques",Tuple "A STUDY ON THE FUSION REACTION 139La + 12C AT 50 MeV/u WITH THE VUU EQUATION" "Journal de Physique Colloques",Tuple "Atomic structure of \"vitreous\" interfacial films in sialon" "Journal de Physique Colloques",Tuple "MICROSTRUCTURAL AND ANALYTICAL CHARACTERIZATION OF Al2O3/Al-Mg COMPOSITE INTERFACES" "Journal de Physique Colloques",Tuple "Development of oxidation resistant high temperature NbTiAl alloys and intermetallics" "Journal de Physique IV Colloque",Tuple "Determination of brazed joint constitutive law by inverse method" "Journal de Physique IV Colloque",Tuple "Two dimensional estimates from ocean SAR images" "Nonlinear Processes in Geophysics",Tuple "Comparison Between New Carbon Nanostructures Produced by Plasma with Industrial Carbon Black Grades" "Journal de Physique III",Tuple "<i>Letter to the Editor:</i> SCIPION, a new flexible ionospheric sounder in Senegal" "Annales Geophysicae",Tuple "Is reducibility in nuclear multifragmentation related to thermal scaling?" "Physics Letters B",Tuple "Independence of fragment charge distributions of the size of heavy multifragmenting sources" "Physics Letters B",Tuple "Hard photons and neutral pions as probes of hot and dense nuclear matter" "Nuclear Physics A",Tuple "Surveying the nuclear caloric curve" "Physics Letters B",Tuple "A hot expanding source in 50 A MeV Xe+Sn central reactions" "Physics Letters B"] sampleDocuments = [Tuple "Macroscopic dynamics of the fusion process" "Journal de Physique Lettres",Tuple "Effects of static and cyclic fatigue at high temperature upon reaction bonded silicon nitride" "Journal de Physique Colloques",Tuple "Reliability of metal/glass-ceramic junctions made by solid state bonding" "Journal de Physique Colloques",Tuple "High temperature mechanical properties and intergranular structure of sialons" "Journal de Physique Colloques",Tuple "SOLUTIONS OF THE LANDAU-VLASOV EQUATION IN NUCLEAR PHYSICS" "Journal de Physique Colloques",Tuple "A STUDY ON THE FUSION REACTION 139La + 12C AT 50 MeV/u WITH THE VUU EQUATION" "Journal de Physique Colloques",Tuple "Atomic structure of \"vitreous\" interfacial films in sialon" "Journal de Physique Colloques",Tuple "MICROSTRUCTURAL AND ANALYTICAL CHARACTERIZATION OF Al2O3/Al-Mg COMPOSITE INTERFACES" "Journal de Physique Colloques",Tuple "Development of oxidation resistant high temperature NbTiAl alloys and intermetallics" "Journal de Physique IV Colloque",Tuple "Determination of brazed joint constitutive law by inverse method" "Journal de Physique IV Colloque",Tuple "Two dimensional estimates from ocean SAR images" "Nonlinear Processes in Geophysics",Tuple "Comparison Between New Carbon Nanostructures Produced by Plasma with Industrial Carbon Black Grades" "Journal de Physique III",Tuple "<i>Letter to the Editor:</i> SCIPION, a new flexible ionospheric sounder in Senegal" "Annales Geophysicae",Tuple "Is reducibility in nuclear multifragmentation related to thermal scaling?" "Physics Letters B",Tuple "Independence of fragment charge distributions of the size of heavy multifragmenting sources" "Physics Letters B",Tuple "Hard photons and neutral pions as probes of hot and dense nuclear matter" "Nuclear Physics A",Tuple "Surveying the nuclear caloric curve" "Physics Letters B",Tuple "A hot expanding source in 50 A MeV Xe+Sn central reactions" "Physics Letters B"]
newtype SearchQuery = SearchQuery newtype SearchQuery = SearchQuery
{ { query :: Array String
query :: Array String
, parent_id :: Int , parent_id :: Int
} }
instance encodeJsonSQuery :: EncodeJson SearchQuery where instance encodeJsonSQuery :: EncodeJson SearchQuery where
encodeJson (SearchQuery post) encodeJson (SearchQuery {query, parent_id})
= "query" := post.query = "query" := query
~> "parent_id" := post.parent_id ~> "parent_id" := parent_id
~> jsonEmptyObject ~> jsonEmptyObject
searchResults :: SearchQuery -> Aff Int searchResults :: SearchQuery -> Aff Int
searchResults squery = post "http://localhost:8008/count" unit searchResults squery = pure 42 -- TODO post "http://localhost:8008/count" unit
-- TODO
documentsUrl :: Session -> Int -> String documentsRoute :: Int -> SessionRoute
documentsUrl session nodeId = url session (NodeAPI Node (Just nodeId)) <> "/documents" documentsRoute nodeId = NodeAPI Node (Just nodeId) "documents"
deleteAllDocuments :: Session -> Int -> Aff (Array Int) deleteAllDocuments :: Session -> Int -> Aff (Array Int)
deleteAllDocuments session = delete <<< documentsUrl session deleteAllDocuments session = delete session <<< documentsRoute
-- TODO: not optimal but Data.Set lacks some function (Set.alter) -- TODO: not optimal but Data.Set lacks some function (Set.alter)
toggleSet :: forall a. Ord a => a -> Set a -> Set a toggleSet :: forall a. Ord a => a -> Set a -> Set a
......
src/Gargantext/Components/FacetsTable.purs
View file @ 11f4718e
...@@ -20,13 +20,12 @@ import Effect.Aff (Aff, launchAff_) ...@@ -20,13 +20,12 @@ import Effect.Aff (Aff, launchAff_)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
------------------------------------------------------------------------ ------------------------------------------------------------------------
import Gargantext.Config.REST (post, deleteWithBody)
import Gargantext.Ends (url) import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Search.Types (Category(..), CategoryQuery(..), favCategory, decodeCategory, putCategories) import Gargantext.Components.Search.Types (Category(..), CategoryQuery(..), favCategory, decodeCategory, putCategories)
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Routes (SessionRoute(Search,NodeAPI)) import Gargantext.Routes (SessionRoute(Search,NodeAPI))
import Gargantext.Sessions (Session, sessionId) import Gargantext.Sessions (Session, sessionId, post, deleteWithBody)
import Gargantext.Types (NodeType(..), OrderBy(..), NodePath(..)) import Gargantext.Types (NodeType(..), OrderBy(..), NodePath(..))
import Gargantext.Utils (toggleSet) import Gargantext.Utils (toggleSet)
import Gargantext.Utils.DecodeMaybe ((.|)) import Gargantext.Utils.DecodeMaybe ((.|))
...@@ -43,8 +42,8 @@ type TextQuery = Array (Array String) ...@@ -43,8 +42,8 @@ type TextQuery = Array (Array String)
newtype SearchQuery = SearchQuery { query :: TextQuery } newtype SearchQuery = SearchQuery { query :: TextQuery }
instance encodeJsonSearchQuery :: EncodeJson SearchQuery where instance encodeJsonSearchQuery :: EncodeJson SearchQuery where
encodeJson (SearchQuery post) encodeJson (SearchQuery {query})
= "query" := post.query !! 0 -- TODO anoe = "query" := query !! 0 -- TODO anoe
~> jsonEmptyObject ~> jsonEmptyObject
newtype SearchResults = SearchResults { results :: Array Response } newtype SearchResults = SearchResults { results :: Array Response }
...@@ -234,8 +233,8 @@ initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, que ...@@ -234,8 +233,8 @@ initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, que
loadPage :: PagePath -> Aff (Array DocumentsView) loadPage :: PagePath -> Aff (Array DocumentsView)
loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy}} = do loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy}} = do
liftEffect $ log "loading documents page: loadPage with Offset and limit" liftEffect $ log "loading documents page: loadPage with Offset and limit"
let url2 = url session $ Search { listId, offset, limit, orderBy: convOrderBy <$> orderBy } (Just nodeId) let p = Search { listId, offset, limit, orderBy: convOrderBy <$> orderBy } (Just nodeId)
SearchResults res <- post url2 $ SearchQuery {query} SearchResults res <- post session p $ SearchQuery {query}
pure $ res2corpus <$> res.results pure $ res2corpus <$> res.results
where where
res2corpus :: Response -> DocumentsView res2corpus :: Response -> DocumentsView
...@@ -319,11 +318,10 @@ pageCpt = R.staticComponent "G.C.FacetsTable.Page" cpt ...@@ -319,11 +318,10 @@ pageCpt = R.staticComponent "G.C.FacetsTable.Page" cpt
newtype DeleteDocumentQuery = DeleteDocumentQuery { documents :: Array Int } newtype DeleteDocumentQuery = DeleteDocumentQuery { documents :: Array Int }
instance encodeJsonDDQuery :: EncodeJson DeleteDocumentQuery where instance encodeJsonDDQuery :: EncodeJson DeleteDocumentQuery where
encodeJson (DeleteDocumentQuery post) = encodeJson (DeleteDocumentQuery {documents}) =
"documents" := post.documents ~> jsonEmptyObject "documents" := documents ~> jsonEmptyObject
deleteDocuments :: Session -> Int -> DeleteDocumentQuery -> Aff (Array Int) deleteDocuments :: Session -> Int -> DeleteDocumentQuery -> Aff (Array Int)
deleteDocuments session nodeId = deleteDocuments session nodeId =
deleteWithBody $ deleteWithBody session $ NodeAPI Node (Just nodeId) "documents"
(url session $ NodeAPI Node $ Just nodeId) <> "/documents"
src/Gargantext/Components/Forest/Tree.purs
View file @ 11f4718e
...@@ -26,12 +26,11 @@ import Web.File.File (toBlob) ...@@ -26,12 +26,11 @@ import Web.File.File (toBlob)
import Web.File.FileList (FileList, item) import Web.File.FileList (FileList, item)
import Web.File.FileReader.Aff (readAsText) import Web.File.FileReader.Aff (readAsText)
import Gargantext.Config.REST (get, put, post, postWwwUrlencoded, delete)
import Gargantext.Ends (Frontends, url) import Gargantext.Ends (Frontends, url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Routes (AppRoute, SessionRoute(..)) import Gargantext.Routes (AppRoute, SessionRoute(..))
import Gargantext.Sessions (Session, sessionId) import Gargantext.Sessions (Session, sessionId, get, put, post, postWwwUrlencoded, delete)
import Gargantext.Types (class ToQuery, toQuery, NodeType(..), NodePath(..), readNodeType) import Gargantext.Types (class ToQuery, toQuery, NodeType(..), NodePath(..), readNodeType)
import Gargantext.Utils (id) import Gargantext.Utils (id)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -668,7 +667,7 @@ nodeText p = R.createElement el p [] ...@@ -668,7 +667,7 @@ nodeText p = R.createElement el p []
-- END node text -- END node text
loadNode :: Session -> ID -> Aff FTree loadNode :: Session -> ID -> Aff FTree
loadNode session = get <<< url session <<< NodeAPI Tree <<< Just loadNode session nodeId = get session $ NodeAPI Tree (Just nodeId) ""
----- TREE CRUD Operations ----- TREE CRUD Operations
...@@ -695,21 +694,18 @@ instance encodeJsonCreateValue :: EncodeJson CreateValue where ...@@ -695,21 +694,18 @@ instance encodeJsonCreateValue :: EncodeJson CreateValue where
~> jsonEmptyObject ~> jsonEmptyObject
createNode :: Session -> ID -> CreateValue -> Aff ID createNode :: Session -> ID -> CreateValue -> Aff ID
--createNode = post $ urlPlease Back $ "new" createNode session parentId = post session $ NodeAPI Node (Just parentId) ""
createNode session parentId = post $ url session (NodeAPI Node $ Just parentId)
renameNode :: Session -> ID -> RenameValue -> Aff (Array ID) renameNode :: Session -> ID -> RenameValue -> Aff (Array ID)
renameNode session renameNodeId = put $ url session (NodeAPI Node $ Just renameNodeId) <> "/rename" renameNode session renameNodeId = put session $ NodeAPI Node (Just renameNodeId) "rename"
deleteNode :: Session -> ID -> Aff ID deleteNode :: Session -> ID -> Aff ID
deleteNode session = delete <<< url session <<< NodeAPI Node <<< Just deleteNode session nodeId = delete session $ NodeAPI Node (Just nodeId) ""
newtype FileUploadQuery = FileUploadQuery { newtype FileUploadQuery = FileUploadQuery {
fileType :: FileType fileType :: FileType
} }
derive instance newtypeSearchQuery :: Newtype FileUploadQuery _ derive instance newtypeSearchQuery :: Newtype FileUploadQuery _
instance fileUploadQueryToQuery :: ToQuery FileUploadQuery where instance fileUploadQueryToQuery :: ToQuery FileUploadQuery where
toQuery (FileUploadQuery {fileType}) = toQuery (FileUploadQuery {fileType}) =
QP.print id id $ QP.QueryPairs $ QP.print id id $ QP.QueryPairs $
...@@ -718,10 +714,11 @@ instance fileUploadQueryToQuery :: ToQuery FileUploadQuery where ...@@ -718,10 +714,11 @@ instance fileUploadQueryToQuery :: ToQuery FileUploadQuery where
pair k v = [ QP.keyFromString k /\ (Just $ QP.valueFromString $ show v) ] pair k v = [ QP.keyFromString k /\ (Just $ QP.valueFromString $ show v) ]
uploadFile :: Session -> ID -> FileType -> UploadFileContents -> Aff (Array FileHash) uploadFile :: Session -> ID -> FileType -> UploadFileContents -> Aff (Array FileHash)
uploadFile session id fileType (UploadFileContents fileContents) = postWwwUrlencoded url2 fileContents uploadFile session id fileType (UploadFileContents fileContents) =
postWwwUrlencoded session p fileContents
where where
q = FileUploadQuery { fileType: fileType } q = FileUploadQuery { fileType: fileType }
url2 = url session (NodeAPI Node (Just id)) <> "/upload" <> Q.print (toQuery q) p = NodeAPI Node (Just id) $ "upload" <> Q.print (toQuery q)
fnTransform :: LNode -> FTree fnTransform :: LNode -> FTree
fnTransform n = NTree n [] fnTransform n = NTree n []
src/Gargantext/Components/GraphExplorer.purs
View file @ 11f4718e
...@@ -22,10 +22,9 @@ import Gargantext.Components.GraphExplorer.ToggleButton as Toggle ...@@ -22,10 +22,9 @@ import Gargantext.Components.GraphExplorer.ToggleButton as Toggle
import Gargantext.Components.GraphExplorer.Types as GET import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.Graph as Graph import Gargantext.Components.Graph as Graph
import Gargantext.Components.Forest (forest) import Gargantext.Components.Forest (forest)
import Gargantext.Config.REST (get) import Gargantext.Ends (Frontends)
import Gargantext.Ends (Frontends, url)
import Gargantext.Routes (SessionRoute(NodeAPI), AppRoute) import Gargantext.Routes (SessionRoute(NodeAPI), AppRoute)
import Gargantext.Sessions (Session, Sessions(..)) import Gargantext.Sessions (Session, Sessions(..), get)
import Gargantext.Types (NodeType(Graph)) import Gargantext.Types (NodeType(Graph))
type GraphId = Int type GraphId = Int
...@@ -289,4 +288,4 @@ defaultPalette = ["#5fa571","#ab9ba2","#da876d","#bdd3ff","#b399df","#ffdfed","# ...@@ -289,4 +288,4 @@ defaultPalette = ["#5fa571","#ab9ba2","#da876d","#bdd3ff","#b399df","#ffdfed","#
getNodes :: Session -> GraphId -> Aff GET.GraphData getNodes :: Session -> GraphId -> Aff GET.GraphData
getNodes session graphId = get $ url session $ NodeAPI Graph (Just graphId) getNodes session graphId = get session $ NodeAPI Graph (Just graphId) ""
src/Gargantext/Components/NgramsTable/Core.purs
View file @ 11f4718e
...@@ -85,12 +85,11 @@ import Thermite (StateCoTransformer, modifyState_) ...@@ -85,12 +85,11 @@ import Thermite (StateCoTransformer, modifyState_)
import Partial (crashWith) import Partial (crashWith)
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import Gargantext.Config.REST (get, put, post)
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Components.OldLoader as Loader import Gargantext.Components.OldLoader as Loader
import Gargantext.Ends (url) import Gargantext.Ends (url)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session, get, put, post)
import Gargantext.Types (OrderBy(..), CTabNgramType(..), TabType, TermList(..), TermSize) import Gargantext.Types (OrderBy(..), CTabNgramType(..), TabType, TermList(..), TermSize)
import Gargantext.Utils.KarpRabin (indicesOfAny) import Gargantext.Utils.KarpRabin (indicesOfAny)
...@@ -568,9 +567,9 @@ type CoreState s = ...@@ -568,9 +567,9 @@ type CoreState s =
postNewNgrams :: forall s. Session -> Array NgramsTerm -> Maybe TermList -> CoreParams s -> Aff Unit postNewNgrams :: forall s. Session -> Array NgramsTerm -> Maybe TermList -> CoreParams s -> Aff Unit
postNewNgrams session newNgrams mayList {nodeId, listIds, tabType} = postNewNgrams session newNgrams mayList {nodeId, listIds, tabType} =
when (not (A.null newNgrams)) $ do when (not (A.null newNgrams)) $ do
(_ :: Array Unit) <- post (url session put) newNgrams (_ :: Array Unit) <- post session p newNgrams
pure unit pure unit
where put = PutNgrams tabType (head listIds) mayList (Just nodeId) where p = PutNgrams tabType (head listIds) mayList (Just nodeId)
postNewElems :: forall s. Session -> NewElems -> CoreParams s -> Aff Unit postNewElems :: forall s. Session -> NewElems -> CoreParams s -> Aff Unit
postNewElems session newElems params = void $ traverseWithIndex postNewElem newElems postNewElems session newElems params = void $ traverseWithIndex postNewElem newElems
...@@ -582,7 +581,7 @@ addNewNgram ntype ngrams list = { ngramsPatches: mempty ...@@ -582,7 +581,7 @@ addNewNgram ntype ngrams list = { ngramsPatches: mempty
, ngramsNewElems: Map.singleton (normNgram ntype ngrams) list } , ngramsNewElems: Map.singleton (normNgram ntype ngrams) list }
putNgramsPatches :: Session -> {nodeId :: Int, listIds :: Array Int, tabType :: TabType} -> Versioned NgramsPatches -> Aff (Versioned NgramsPatches) putNgramsPatches :: Session -> {nodeId :: Int, listIds :: Array Int, tabType :: TabType} -> Versioned NgramsPatches -> Aff (Versioned NgramsPatches)
putNgramsPatches session {nodeId, listIds, tabType} = put $ url session putNgrams putNgramsPatches session {nodeId, listIds, tabType} = put session putNgrams
where putNgrams = PutNgrams tabType (head listIds) Nothing (Just nodeId) where putNgrams = PutNgrams tabType (head listIds) Nothing (Just nodeId)
commitPatch :: forall s. Session -> {nodeId :: Int, listIds :: Array Int, tabType :: TabType} commitPatch :: forall s. Session -> {nodeId :: Int, listIds :: Array Int, tabType :: TabType}
...@@ -601,13 +600,12 @@ loadNgramsTable :: Session -> PageParams -> Aff VersionedNgramsTable ...@@ -601,13 +600,12 @@ loadNgramsTable :: Session -> PageParams -> Aff VersionedNgramsTable
loadNgramsTable session loadNgramsTable session
{ nodeId, listIds, termListFilter, termSizeFilter { nodeId, listIds, termListFilter, termSizeFilter
, searchQuery, tabType, params: {offset, limit, orderBy}} , searchQuery, tabType, params: {offset, limit, orderBy}}
= get $ url session query = get session query
where query = GetNgrams { tabType, offset, limit, listIds where query = GetNgrams { tabType, offset, limit, listIds
, orderBy: convOrderBy <$> orderBy , orderBy: convOrderBy <$> orderBy
, termListFilter, termSizeFilter , termListFilter, termSizeFilter
, searchQuery } (Just nodeId) , searchQuery } (Just nodeId)
convOrderBy :: T.OrderByDirection T.ColumnName -> OrderBy convOrderBy :: T.OrderByDirection T.ColumnName -> OrderBy
convOrderBy (T.ASC (T.ColumnName "Score (Occurrences)")) = ScoreAsc convOrderBy (T.ASC (T.ColumnName "Score (Occurrences)")) = ScoreAsc
convOrderBy (T.DESC (T.ColumnName "Score (Occurrences)")) = ScoreDesc convOrderBy (T.DESC (T.ColumnName "Score (Occurrences)")) = ScoreDesc
......
src/Gargantext/Components/Nodes/Annuaire.purs
View file @ 11f4718e
...@@ -13,9 +13,8 @@ import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (Contact(..), Hy ...@@ -13,9 +13,8 @@ import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (Contact(..), Hy
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Ends (url) import Gargantext.Ends (url)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, sessionId) import Gargantext.Sessions (Session, sessionId, get)
import Gargantext.Types (NodePath(..), NodeType(..)) import Gargantext.Types (NodePath(..), NodeType(..))
import Gargantext.Config.REST (get)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
newtype IndividuView = newtype IndividuView =
...@@ -186,7 +185,7 @@ instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where ...@@ -186,7 +185,7 @@ instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where
loadPage :: Session -> PagePath -> Aff AnnuaireTable loadPage :: Session -> PagePath -> Aff AnnuaireTable
loadPage session {nodeId, params: { offset, limit, orderBy }} = loadPage session {nodeId, params: { offset, limit, orderBy }} =
get $ url session children get session children
-- TODO orderBy -- TODO orderBy
-- where -- where
-- convOrderBy (T.ASC (T.ColumnName "Name")) = NameAsc -- convOrderBy (T.ASC (T.ColumnName "Name")) = NameAsc
...@@ -198,5 +197,5 @@ loadPage session {nodeId, params: { offset, limit, orderBy }} = ...@@ -198,5 +197,5 @@ loadPage session {nodeId, params: { offset, limit, orderBy }} =
children = Children NodeContact offset limit Nothing {-(convOrderBy <$> orderBy)-} (Just nodeId) children = Children NodeContact offset limit Nothing {-(convOrderBy <$> orderBy)-} (Just nodeId)
getAnnuaireInfo :: Session -> Int -> Aff AnnuaireInfo getAnnuaireInfo :: Session -> Int -> Aff AnnuaireInfo
getAnnuaireInfo session id = get $ url session (NodeAPI Node (Just id)) getAnnuaireInfo session id = get session (NodeAPI Node (Just id) "")
src/Gargantext/Components/Nodes/Annuaire/User/Contacts.purs
View file @ 11f4718e
...@@ -13,15 +13,13 @@ import Data.String (joinWith) ...@@ -13,15 +13,13 @@ import Data.String (joinWith)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Config.REST (get)
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types
( Contact(..), ContactData, ContactTouch(..), ContactWhere(..) ( Contact(..), ContactData, ContactTouch(..), ContactWhere(..)
, ContactWho(..), HyperData(..), HyperdataContact(..) ) , ContactWho(..), HyperData(..), HyperdataContact(..) )
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session, get)
import Gargantext.Types (NodeType(..)) import Gargantext.Types (NodeType(..))
display :: String -> Array R.Element -> R.Element display :: String -> Array R.Element -> R.Element
...@@ -142,7 +140,7 @@ userLayoutCpt = R.hooksComponent "G.P.Annuaire.UserLayout" cpt ...@@ -142,7 +140,7 @@ userLayoutCpt = R.hooksComponent "G.P.Annuaire.UserLayout" cpt
-- | toUrl to get data -- | toUrl to get data
getContact :: Session -> Int -> Aff ContactData getContact :: Session -> Int -> Aff ContactData
getContact session id = do getContact session id = do
contactNode <- get $ url session (NodeAPI NodeContact (Just id)) contactNode <- get session $ NodeAPI NodeContact (Just id) ""
-- TODO: we need a default list for the pairings -- TODO: we need a default list for the pairings
--defaultListIds <- get $ toUrl endConfigStateful Back (Children NodeList 0 1 Nothing) $ Just id --defaultListIds <- get $ toUrl endConfigStateful Back (Children NodeList 0 1 Nothing) $ Just id
--case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of --case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of
......
src/Gargantext/Components/Nodes/Corpus.purs
View file @ 11f4718e
module Gargantext.Components.Nodes.Corpus where module Gargantext.Components.Nodes.Corpus where
import Prelude ((<<<))
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.??))
import Data.Array (head)
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff, throwError)
import Effect.Exception (error)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.Node (NodePoly(..), HyperdataList)
import Gargantext.Types (NodeType(..))
import Gargantext.Routes (SessionRoute(NodeAPI, Children))
import Gargantext.Sessions (Session, get)
type Props = ( nodeId :: Int ) type Props = ( nodeId :: Int )
...@@ -15,3 +26,64 @@ corpusLayoutCpt = R.staticComponent "G.P.Corpus.corpusLayout" cpt ...@@ -15,3 +26,64 @@ corpusLayoutCpt = R.staticComponent "G.P.Corpus.corpusLayout" cpt
H.div {} H.div {}
[ H.h1 {} [H.text "Corpus Description"] [ H.h1 {} [H.text "Corpus Description"]
, H.p {} [H.text "Soon: corpus synthesis here (when all others charts/features will be stabilized)."] ] , H.p {} [H.text "Soon: corpus synthesis here (when all others charts/features will be stabilized)."] ]
newtype CorpusInfo =
CorpusInfo
{ title :: String
, desc :: String
, query :: String
, authors :: String
, chart :: (Maybe (Array Number))
, totalRecords :: Int }
hyperdataDefault :: CorpusInfo
hyperdataDefault =
CorpusInfo
{ title : "Default title"
, desc : " Default desc"
, query : " Default Query"
, authors : " Author(s): default"
, chart : Nothing
, totalRecords : 0 }
corpusInfoDefault :: NodePoly CorpusInfo
corpusInfoDefault =
NodePoly
{ id : 0
, typename : 0
, userId : 0
, parentId : 0
, name : "Default name"
, date : " Default date"
, hyperdata : hyperdataDefault }
instance decodeCorpusInfo :: DecodeJson CorpusInfo where
decodeJson json = do
obj <- decodeJson json
title <- obj .: "title"
desc <- obj .: "desc"
query <- obj .: "query"
authors <- obj .: "authors"
chart <- obj .?? "chart"
let totalRecords = 47361 -- TODO
pure $ CorpusInfo {title, desc, query, authors, chart, totalRecords}
type CorpusData = { corpusId :: Int
, corpusNode :: NodePoly CorpusInfo
, defaultListId :: Int}
loadCorpus :: { session :: Session, nodeId :: Int } -> Aff CorpusData
loadCorpus {session, nodeId: listId} = do
-- fetch corpus via lists parentId
(NodePoly {parentId: corpusId} :: NodePoly {}) <- get session nodePolyRoute
corpusNode <- get session $ corpusNodeRoute corpusId ""
defaultListIds <- get session $ defaultListIdsRoute corpusId
case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of
Just (NodePoly { id: defaultListId }) ->
pure {corpusId, corpusNode, defaultListId}
Nothing ->
throwError $ error "Missing default list"
where
nodePolyRoute = NodeAPI Corpus (Just listId) ""
corpusNodeRoute = NodeAPI Corpus <<< Just
defaultListIdsRoute = Children NodeList 0 1 Nothing <<< Just
src/Gargantext/Components/Nodes/Corpus/Chart/Histo.purs
View file @ 11f4718e
...@@ -4,7 +4,6 @@ import Prelude (bind, map, pure, ($)) ...@@ -4,7 +4,6 @@ import Prelude (bind, map, pure, ($))
import Data.Argonaut (class DecodeJson, decodeJson, (.:)) import Data.Argonaut (class DecodeJson, decodeJson, (.:))
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Config.REST (get)
import Reactix as R import Reactix as R
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis') import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis')
...@@ -16,7 +15,7 @@ import Gargantext.Ends (url) ...@@ -16,7 +15,7 @@ import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..), TabType) import Gargantext.Types (ChartType(..), TabType)
type Path = { corpusId :: Int, tabType :: TabType } type Path = { corpusId :: Int, tabType :: TabType }
...@@ -55,7 +54,7 @@ chartOptions (HistoMetrics { dates: dates', count: count'}) = Options ...@@ -55,7 +54,7 @@ chartOptions (HistoMetrics { dates: dates', count: count'}) = Options
getMetrics :: Session -> Path -> Aff HistoMetrics getMetrics :: Session -> Path -> Aff HistoMetrics
getMetrics session {corpusId, tabType} = do getMetrics session {corpusId, tabType} = do
ChartMetrics ms <- get $ url session chart ChartMetrics ms <- get session chart
pure ms."data" pure ms."data"
where chart = Chart {chartType: Histo, tabType: tabType} (Just corpusId) where chart = Chart {chartType: Histo, tabType: tabType} (Just corpusId)
......
src/Gargantext/Components/Nodes/Corpus/Chart/Metrics.purs
View file @ 11f4718e
...@@ -7,7 +7,6 @@ import Data.Map (Map) ...@@ -7,7 +7,6 @@ import Data.Map (Map)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Config.REST (get)
import Reactix as R import Reactix as R
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, yAxis') import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, yAxis')
...@@ -20,7 +19,7 @@ import Gargantext.Ends (url) ...@@ -20,7 +19,7 @@ import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session, get)
import Gargantext.Types (TabType, TermList(..)) import Gargantext.Types (TabType, TermList(..))
type Path = type Path =
...@@ -96,7 +95,7 @@ scatterOptions metrics' = Options ...@@ -96,7 +95,7 @@ scatterOptions metrics' = Options
getMetrics :: Session -> Path -> Aff Loaded getMetrics :: Session -> Path -> Aff Loaded
getMetrics session {corpusId, listId, limit, tabType} = do getMetrics session {corpusId, listId, limit, tabType} = do
Metrics ms <- get $ url session metrics' Metrics ms <- get session metrics'
pure ms."data" pure ms."data"
where metrics' = CorpusMetrics {listId, tabType, limit} (Just corpusId) where metrics' = CorpusMetrics {listId, tabType, limit} (Just corpusId)
......
src/Gargantext/Components/Nodes/Corpus/Chart/Pie.purs
View file @ 11f4718e
...@@ -8,7 +8,6 @@ import Data.Maybe (Maybe(..)) ...@@ -8,7 +8,6 @@ import Data.Maybe (Maybe(..))
import Data.String (take, joinWith, Pattern(..), split, length) import Data.String (take, joinWith, Pattern(..), split, length)
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Config.REST (get)
import Reactix as R import Reactix as R
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis') import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis')
...@@ -20,7 +19,7 @@ import Gargantext.Ends (url) ...@@ -20,7 +19,7 @@ import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..), TabType) import Gargantext.Types (ChartType(..), TabType)
type Path = type Path =
...@@ -80,7 +79,7 @@ chartOptionsPie (HistoMetrics { dates: dates', count: count'}) = Options ...@@ -80,7 +79,7 @@ chartOptionsPie (HistoMetrics { dates: dates', count: count'}) = Options
getMetrics :: Session -> Path -> Aff HistoMetrics getMetrics :: Session -> Path -> Aff HistoMetrics
getMetrics session {corpusId, tabType:tabType} = do getMetrics session {corpusId, tabType:tabType} = do
ChartMetrics ms <- get $ url session chart ChartMetrics ms <- get session chart
pure ms."data" pure ms."data"
where chart = Chart {chartType: ChartPie, tabType: tabType} (Just corpusId) where chart = Chart {chartType: ChartPie, tabType: tabType} (Just corpusId)
......
src/Gargantext/Components/Nodes/Corpus/Chart/Tree.purs
View file @ 11f4718e
...@@ -7,7 +7,6 @@ import Effect.Aff (Aff) ...@@ -7,7 +7,6 @@ import Effect.Aff (Aff)
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Config.REST (get)
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis') import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis')
import Gargantext.Components.Charts.Options.Series (TreeNode, Trees(..), mkTree) import Gargantext.Components.Charts.Options.Series (TreeNode, Trees(..), mkTree)
import Gargantext.Components.Charts.Options.Font (mkTooltip, templateFormatter) import Gargantext.Components.Charts.Options.Font (mkTooltip, templateFormatter)
...@@ -15,7 +14,7 @@ import Gargantext.Ends (url) ...@@ -15,7 +14,7 @@ import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..), TabType) import Gargantext.Types (ChartType(..), TabType)
type Path = type Path =
...@@ -54,7 +53,7 @@ scatterOptions nodes = Options ...@@ -54,7 +53,7 @@ scatterOptions nodes = Options
getMetrics :: Session -> Path -> Aff Loaded getMetrics :: Session -> Path -> Aff Loaded
getMetrics session {corpusId, listId, limit, tabType} = do getMetrics session {corpusId, listId, limit, tabType} = do
Metrics ms <- get $ url session chart Metrics ms <- get session chart
pure ms."data" pure ms."data"
where where
chart = Chart {chartType : ChartTree, tabType: tabType} (Just corpusId) chart = Chart {chartType : ChartTree, tabType: tabType} (Just corpusId)
......
src/Gargantext/Components/Nodes/Corpus/Document.purs
View file @ 11f4718e
...@@ -12,7 +12,6 @@ import React.DOM.Props (className) ...@@ -12,7 +12,6 @@ import React.DOM.Props (className)
import Reactix as R import Reactix as R
import Thermite (PerformAction, Render, Spec, simpleSpec, createClass) import Thermite (PerformAction, Render, Spec, simpleSpec, createClass)
import Gargantext.Config.REST (get)
import Gargantext.Components.AutoUpdate (autoUpdateElt) import Gargantext.Components.AutoUpdate (autoUpdateElt)
import Gargantext.Components.Node (NodePoly(..)) import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.NgramsTable.Core import Gargantext.Components.NgramsTable.Core
...@@ -23,7 +22,7 @@ import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField ...@@ -23,7 +22,7 @@ import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField
import Gargantext.Ends (url) import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session, get)
import Gargantext.Types (CTabNgramType(..), NodeType(..), TabSubType(..), TabType(..), TermList) import Gargantext.Types (CTabNgramType(..), NodeType(..), TabSubType(..), TabType(..), TermList)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -369,7 +368,7 @@ documentLayoutCpt = R.hooksComponent "G.P.Corpus.Document.documentLayout" cpt ...@@ -369,7 +368,7 @@ documentLayoutCpt = R.hooksComponent "G.P.Corpus.Document.documentLayout" cpt
------------------------------------------------------------------------ ------------------------------------------------------------------------
loadDocument :: Session -> Int -> Aff NodeDocument loadDocument :: Session -> Int -> Aff NodeDocument
loadDocument session = get <<< url session <<< NodeAPI Node <<< Just loadDocument session nodeId = get session $ NodeAPI Node (Just nodeId) ""
loadData :: Session -> DocPath -> Aff LoadedData loadData :: Session -> DocPath -> Aff LoadedData
loadData session {nodeId, listIds, tabType} = do loadData session {nodeId, listIds, tabType} = do
......
src/Gargantext/Components/Nodes/Lists.purs
View file @ 11f4718e
module Gargantext.Components.Nodes.Lists where module Gargantext.Components.Nodes.Lists where
import Prelude ((<<<))
import Data.Array (head)
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff, throwError)
import Effect.Exception (error)
import Reactix as R import Reactix as R
-------------------------------------------------------- --------------------------------------------------------
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.Node (NodePoly(..), HyperdataList) import Gargantext.Components.Nodes.Corpus (CorpusInfo(..), loadCorpus)
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Table as Table import Gargantext.Components.Table as Table
import Gargantext.Config.REST (get)
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Nodes.Lists.Tabs as Tabs import Gargantext.Components.Nodes.Lists.Tabs as Tabs
import Gargantext.Routes (SessionRoute(NodeAPI, Children))
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (NodeType(..))
------------------------------------------------------------------------ ------------------------------------------------------------------------
type Props = ( nodeId :: Int, session :: Session ) type Props = ( session :: Session, nodeId :: Int )
listsLayout :: Record Props -> R.Element listsLayout :: Record Props -> R.Element
listsLayout props = R.createElement listsLayoutCpt props [] listsLayout props = R.createElement listsLayoutCpt props []
...@@ -28,29 +20,13 @@ listsLayout props = R.createElement listsLayoutCpt props [] ...@@ -28,29 +20,13 @@ listsLayout props = R.createElement listsLayoutCpt props []
listsLayoutCpt :: R.Component Props listsLayoutCpt :: R.Component Props
listsLayoutCpt = R.hooksComponent "G.P.Lists.listsLayout" cpt listsLayoutCpt = R.hooksComponent "G.P.Lists.listsLayout" cpt
where where
cpt {nodeId, session} _ = cpt path@{session} _ =
useLoader nodeId (getCorpus session) $ useLoader path loadCorpus $
\corpusData@{corpusId, defaultListId, corpusNode: NodePoly poly} -> \corpusData@{corpusId, defaultListId, corpusNode: NodePoly poly} ->
let { name, date, hyperdata: Tabs.CorpusInfo corpus } = poly let { name, date, hyperdata: CorpusInfo corpus } = poly
{ desc, query, authors: user } = corpus in { desc, query, authors: user } = corpus in
R.fragment R.fragment
[ Table.tableHeaderLayout [ Table.tableHeaderLayout
{ title: "Corpus " <> name, desc, query, user, date } { title: "Corpus " <> name, desc, query, user, date }
, Tabs.tabs {session, corpusId, corpusData}] , Tabs.tabs {session, corpusId, corpusData}]
------------------------------------------------------------------------ ------------------------------------------------------------------------
getCorpus :: Session -> Int -> Aff Tabs.CorpusData
getCorpus session listId = do
-- fetch corpus via lists parentId
(NodePoly {parentId: corpusId} :: NodePoly {}) <- get nodePolyUrl
corpusNode <- get $ corpusNodeUrl corpusId
defaultListIds <- get $ defaultListIdsUrl corpusId
case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of
Just (NodePoly { id: defaultListId }) ->
pure {corpusId, corpusNode, defaultListId}
Nothing ->
throwError $ error "Missing default list"
where
nodePolyUrl = url session (NodeAPI Corpus (Just listId))
corpusNodeUrl = url session <<< NodeAPI Corpus <<< Just
defaultListIdsUrl = url session <<< Children NodeList 0 1 Nothing <<< Just
src/Gargantext/Components/Nodes/Lists/Tabs.purs
View file @ 11f4718e
module Gargantext.Components.Nodes.Lists.Tabs where module Gargantext.Components.Nodes.Lists.Tabs where
import Prelude import Prelude
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.??))
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.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Reactix as R import Reactix as R
import Gargantext.Components.NgramsTable as NT import Gargantext.Components.NgramsTable as NT
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Tab as Tab import Gargantext.Components.Tab as Tab
import Gargantext.Components.Nodes.Corpus (CorpusData)
import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics) import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie, bar) import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie, bar)
import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree) import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree)
...@@ -73,50 +72,3 @@ ngramsViewCpt = R.staticComponent "ListsNgramsView" cpt ...@@ -73,50 +72,3 @@ ngramsViewCpt = R.staticComponent "ListsNgramsView" cpt
chart Sources = bar {session, path} chart Sources = bar {session, path}
chart Institutes = tree {session, path: path2} chart Institutes = tree {session, path: path2}
chart Terms = metrics {session, path: path2} chart Terms = metrics {session, path: path2}
newtype CorpusInfo =
CorpusInfo
{ title :: String
, desc :: String
, query :: String
, authors :: String
, chart :: (Maybe (Array Number))
, totalRecords :: Int }
hyperdataDefault :: CorpusInfo
hyperdataDefault =
CorpusInfo
{ title : "Default title"
, desc : " Default desc"
, query : " Default Query"
, authors : " Author(s): default"
, chart : Nothing
, totalRecords : 0 }
corpusInfoDefault :: NodePoly CorpusInfo
corpusInfoDefault =
NodePoly
{ id : 0
, typename : 0
, userId : 0
, parentId : 0
, name : "Default name"
, date : " Default date"
, hyperdata : hyperdataDefault }
instance decodeCorpusInfo :: DecodeJson CorpusInfo where
decodeJson json = do
obj <- decodeJson json
title <- obj .: "title"
desc <- obj .: "desc"
query <- obj .: "query"
authors <- obj .: "authors"
chart <- obj .?? "chart"
let totalRecords = 47361 -- TODO
pure $ CorpusInfo {title, desc, query, authors, chart, totalRecords}
type CorpusData = { corpusId :: Int
, corpusNode :: NodePoly CorpusInfo
, defaultListId :: Int}
src/Gargantext/Components/Nodes/Texts.purs
View file @ 11f4718e
module Gargantext.Components.Nodes.Texts where module Gargantext.Components.Nodes.Texts where
import Prelude ((<<<))
import Data.Array (head)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import DOM.Simple.Console (log2)
import Effect.Class (liftEffect)
import Effect.Aff (Aff, throwError)
import Effect.Exception (error)
import Reactix as R import Reactix as R
-------------------------------------------------------- --------------------------------------------------------
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.Loader (loader) import Gargantext.Components.Loader (loader)
import Gargantext.Components.Node (NodePoly(..), HyperdataList) import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Table as Table import Gargantext.Components.Table as Table
import Gargantext.Config.REST (get)
import Gargantext.Ends (url)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.Nodes.Texts.Tabs (CorpusData, CorpusInfo(..)) import Gargantext.Components.Nodes.Corpus (CorpusInfo(..), loadCorpus)
import Gargantext.Components.Nodes.Texts.Tabs as Tabs import Gargantext.Components.Nodes.Texts.Tabs as Tabs
import Gargantext.Routes (SessionRoute(NodeAPI, Children))
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (NodeType(..)) import Gargantext.Types (NodeType(..))
...@@ -41,23 +32,3 @@ textsLayoutCpt = R.hooksComponent "G.P.Texts.textsLayout" cpt where ...@@ -41,23 +32,3 @@ textsLayoutCpt = R.hooksComponent "G.P.Texts.textsLayout" cpt where
tabs = Tabs.tabs {session, corpusId, corpusData} tabs = Tabs.tabs {session, corpusId, corpusData}
title = "Corpus " <> name title = "Corpus " <> name
headerProps = { title, desc, query, date, user } headerProps = { title, desc, query, date, user }
------------------------------------------------------------------------
loadCorpus :: Record Props -> Aff CorpusData
loadCorpus {session, nodeId} = do
liftEffect $ log2 "nodepolyurl: " nodePolyUrl
-- fetch corpus via texts parentId
(NodePoly {parentId: corpusId} :: NodePoly {}) <- get nodePolyUrl
liftEffect $ log2 "corpusnodeurl: " $ corpusNodeUrl corpusId
corpusNode <- get $ corpusNodeUrl corpusId
liftEffect $ log2 "defaultlistidsurl: " $ defaultListIdsUrl corpusId
defaultListIds <- get $ defaultListIdsUrl corpusId
case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of
Just (NodePoly { id: defaultListId }) ->
pure {corpusId, corpusNode, defaultListId}
Nothing ->
throwError $ error "Missing default list"
where
nodePolyUrl = url session $ NodeAPI Corpus (Just nodeId)
corpusNodeUrl = url session <<< NodeAPI Corpus <<< Just
defaultListIdsUrl = url session <<< Children NodeList 0 1 Nothing <<< Just
src/Gargantext/Components/Nodes/Texts/Tabs.purs
View file @ 11f4718e
...@@ -13,6 +13,7 @@ import Reactix.DOM.HTML as H ...@@ -13,6 +13,7 @@ import Reactix.DOM.HTML as H
import Gargantext.Components.DocsTable as DT import Gargantext.Components.DocsTable as DT
import Gargantext.Components.Node (NodePoly(..)) import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Tab as Tab import Gargantext.Components.Tab as Tab
import Gargantext.Components.Nodes.Corpus (CorpusData)
import Gargantext.Components.Nodes.Corpus.Chart.Histo (histo) import Gargantext.Components.Nodes.Corpus.Chart.Histo (histo)
import Gargantext.Sessions (Session) import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType(..), TabSubType(..), TabType(..)) import Gargantext.Types (CTabNgramType(..), TabSubType(..), TabType(..))
...@@ -117,45 +118,5 @@ docViewCpt = R.hooksComponent "DocViewWithCorpus" cpt ...@@ -117,45 +118,5 @@ docViewCpt = R.hooksComponent "DocViewWithCorpus" cpt
, showSearch: true , showSearch: true
, session } , session }
newtype CorpusInfo = CorpusInfo { title :: String
, desc :: String
, query :: String
, authors :: String
, chart :: (Maybe (Array Number))
, totalRecords :: Int
}
corpusInfoDefault :: NodePoly CorpusInfo
corpusInfoDefault = NodePoly { id : 0
, typename : 0
, userId : 0
, parentId : 0
, name : "Default name"
, date : " Default date"
, hyperdata : CorpusInfo
{ title : "Default title"
, desc : " Default desc"
, query : " Default Query"
, authors : " Author(s): default"
, chart : Nothing
, totalRecords : 0
}
}
instance decodeCorpusInfo :: DecodeJson CorpusInfo where
decodeJson json = do
obj <- decodeJson json
title <- obj .: "title"
desc <- obj .: "desc"
query <- obj .: "query"
authors <- obj .: "authors"
chart <- obj .?? "chart"
let totalRecords = 47361 -- TODO
pure $ CorpusInfo {title, desc, query, authors, chart, totalRecords}
type CorpusData = { corpusId :: Int
, corpusNode :: NodePoly CorpusInfo
, defaultListId :: Int}
src/Gargantext/Components/Search/Types.purs
View file @ 11f4718e
...@@ -10,10 +10,9 @@ import Data.Newtype (class Newtype) ...@@ -10,10 +10,9 @@ import Data.Newtype (class Newtype)
import Data.Tuple (Tuple) import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Config.REST (post, put) import Gargantext.Ends (class ToUrl, backendUrl)
import Gargantext.Ends (class ToUrl, backendUrl, url)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session(..)) import Gargantext.Sessions (Session(..), post, put)
import Gargantext.Types (class ToQuery, toQuery, NodeType(..)) import Gargantext.Types (class ToQuery, toQuery, NodeType(..))
import Gargantext.Utils (id) import Gargantext.Utils (id)
import URI.Extra.QueryPairs as QP import URI.Extra.QueryPairs as QP
...@@ -170,12 +169,12 @@ instance encodeJsonCategoryQuery :: EncodeJson CategoryQuery where ...@@ -170,12 +169,12 @@ instance encodeJsonCategoryQuery :: EncodeJson CategoryQuery where
~> "ntc_category" := encodeJson post.category ~> "ntc_category" := encodeJson post.category
~> jsonEmptyObject ~> jsonEmptyObject
categoryUrl :: Session -> Int -> String categoryRoute :: Int -> SessionRoute
categoryUrl session nodeId = url session (NodeAPI Node $ Just nodeId) <> "/category" categoryRoute nodeId = NodeAPI Node (Just nodeId) "category"
putCategories :: Session -> Int -> CategoryQuery -> Aff (Array Int) putCategories :: Session -> Int -> CategoryQuery -> Aff (Array Int)
putCategories session nodeId = put $ categoryUrl session nodeId putCategories session nodeId = put session $ categoryRoute nodeId
performSearch :: forall a. DecodeJson a => Session -> SearchQuery -> Aff a performSearch :: forall a. DecodeJson a => Session -> SearchQuery -> Aff a
performSearch session q = post (url session q) q performSearch session q = post session q q
src/Gargantext/Components/Tree.purs deleted 100644 → 0
View file @ 6cbaad00
module Gargantext.Components.Tree where
import Prelude hiding (div)
import DOM.Simple.Console (log2)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Array (filter)
import Data.FunctorWithIndex (mapWithIndex)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..), fromJust)
import Data.Newtype (class Newtype)
import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff, runAff)
import Effect.Class (liftEffect)
import Effect.Uncurried (mkEffectFn1)
import FFI.Simple ((..))
import Partial.Unsafe (unsafePartial)
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import URI.Extra.QueryPairs as QP
import URI.Query as Q
import Web.File.File (toBlob)
import Web.File.FileList (FileList, item)
import Web.File.FileReader.Aff (readAsText)
import Gargantext.Config.REST (get, put, post, postWwwUrlencoded, delete)
import Gargantext.Ends (Frontends, url)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as Routes
import Gargantext.Routes (AppRoute, SessionRoute(..))
import Gargantext.Sessions (Session, sessionId)
import Gargantext.Types (class ToQuery, toQuery, NodeType(..), NodePath(..), readNodeType)
import Gargantext.Utils (id)
import Gargantext.Utils.Reactix as R2
type Name = String
type Open = Boolean
type URL = String
type ID = Int
type Reload = Int
data NodePopup = CreatePopup | NodePopup
type Props = ( root :: ID
, mCurrentRoute :: Maybe AppRoute
, session :: Session
, frontends :: Frontends
)
type TreeViewProps = ( tree :: FTree
, mCurrentRoute :: Maybe AppRoute
, frontends :: Frontends
, session :: Session
)
data NTree a = NTree a (Array (NTree a))
instance ntreeFunctor :: Functor NTree where
map f (NTree x ary) = NTree (f x) (map (map f) ary)
-- Keep only the nodes matching the predicate.
-- The root of the tree is always kept.
filterNTree :: forall a. (a -> Boolean) -> NTree a -> NTree a
filterNTree p (NTree x ary) =
NTree x $ map (filterNTree p) $ filter (\(NTree a _) -> p a) ary
newtype LNode = LNode { id :: ID
, name :: Name
, nodeType :: NodeType
}
derive instance newtypeLNode :: Newtype LNode _
instance decodeJsonLNode :: DecodeJson LNode where
decodeJson json = do
obj <- decodeJson json
id_ <- obj .: "id"
name <- obj .: "name"
nodeType <- obj .: "type"
pure $ LNode { id : id_
, name
, nodeType}
instance decodeJsonFTree :: DecodeJson (NTree LNode) where
decodeJson json = do
obj <- decodeJson json
node <- obj .: "node"
nodes <- obj .: "children"
node' <- decodeJson node
nodes' <- decodeJson nodes
pure $ NTree node' nodes'
type FTree = NTree LNode
-- file upload types
data FileType = CSV | PresseRIS
derive instance genericFileType :: Generic FileType _
instance eqFileType :: Eq FileType where
eq = genericEq
instance showFileType :: Show FileType where
show = genericShow
readFileType :: String -> Maybe FileType
readFileType "CSV" = Just CSV
readFileType "PresseRIS" = Just PresseRIS
readFileType _ = Nothing
newtype UploadFileContents = UploadFileContents String
data DroppedFile = DroppedFile {
contents :: UploadFileContents
, fileType :: Maybe FileType
}
type FileHash = String
data Action = Submit String
| DeleteNode
| CreateSubmit String NodeType
| UploadFile FileType UploadFileContents
type Tree = { tree :: FTree }
mapFTree :: (FTree -> FTree) -> Tree -> Tree
mapFTree f s@{tree} = s {tree = f tree}
performAction :: Session -> R.State Int -> R.State Tree -> Action -> Aff Unit
performAction session (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) DeleteNode = do
void $ deleteNode session id
liftEffect $ setReload (_ + 1)
performAction session _ ({tree: NTree (LNode {id}) _} /\ setTree) (Submit name) = do
void $ renameNode session id $ RenameValue {name}
liftEffect $ setTree $ \s@{tree: NTree (LNode node) arr} -> s {tree = NTree (LNode node {name = name}) arr}
performAction session (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) (CreateSubmit name nodeType) = do
void $ createNode session id $ CreateValue {name, nodeType}
liftEffect $ setReload (_ + 1)
performAction session _ ({tree: NTree (LNode {id}) _} /\ _) (UploadFile fileType contents) = do
hashes <- uploadFile session id fileType contents
liftEffect $ log2 "uploaded:" hashes
------------------------------------------------------------------------
mCorpusId :: Maybe AppRoute -> Maybe Int
mCorpusId (Just (Routes.Corpus _ id)) = Just id
mCorpusId (Just (Routes.CorpusDocument _ id _ _)) = Just id
mCorpusId _ = Nothing
treeView :: Record Props -> R.Element
treeView props = R.createElement treeViewCpt props []
treeViewCpt :: R.Component Props
treeViewCpt = R.hooksComponent "G.C.Tree.treeView" cpt
where
cpt props _children = do
-- NOTE: this is a hack to reload the tree view on demand
reload <- R.useState' (0 :: Reload)
pure $ treeLoadView reload props
treeLoadView :: R.State Reload -> Record Props -> R.Element
treeLoadView reload p = R.createElement el p []
where
el = R.hooksComponent "TreeLoadView" cpt
cpt {root, mCurrentRoute, session, frontends} _ = do
useLoader root (loadNode session) $ \loaded ->
loadedTreeView reload {tree: loaded, mCurrentRoute, session, frontends}
loadedTreeView :: R.State Reload -> Record TreeViewProps -> R.Element
loadedTreeView reload p = R.createElement el p []
where
el = R.hooksComponent "LoadedTreeView" cpt
cpt {tree, mCurrentRoute, session, frontends} _ = do
treeState <- R.useState' {tree}
pure $ H.div {className: "tree"}
[ toHtml reload treeState session frontends mCurrentRoute ]
-- START toHtml
toHtml :: R.State Reload -> R.State Tree -> Session -> Frontends -> Maybe AppRoute -> R.Element
toHtml reload treeState@({tree: (NTree (LNode {id, name, nodeType}) ary)} /\ _) session frontends mCurrentRoute = R.createElement el {} []
where
el = R.hooksComponent "NodeView" cpt
pAction = performAction session reload treeState
cpt props _ = do
folderOpen <- R.useState' true
let withId (NTree (LNode {id: id'}) _) = id'
pure $ H.ul {}
[ H.li {}
( [ nodeMainSpan pAction {id, name, nodeType, mCurrentRoute} folderOpen session frontends ]
<> childNodes session frontends reload folderOpen mCurrentRoute ary
)
]
type NodeMainSpanProps =
( id :: ID
, name :: Name
, nodeType :: NodeType
, mCurrentRoute :: Maybe AppRoute
)
nodeMainSpan :: (Action -> Aff Unit)
-> Record NodeMainSpanProps
-> R.State Boolean
-> Session
-> Frontends
-> R.Element
nodeMainSpan d p folderOpen session frontends = R.createElement el p []
where
el = R.hooksComponent "NodeMainSpan" cpt
cpt {id, name, nodeType, mCurrentRoute} _ = do
-- only 1 popup at a time is allowed to be opened
popupOpen <- R.useState' (Nothing :: Maybe NodePopup)
droppedFile <- R.useState' (Nothing :: Maybe DroppedFile)
isDragOver <- R.useState' false
pure $ H.span (dropProps droppedFile isDragOver)
[ folderIcon folderOpen
, H.a { href: (url frontends (NodePath (sessionId session) nodeType (Just id)))
, style: {marginLeft: "22px"}
}
[ nodeText {isSelected: (mCorpusId mCurrentRoute) == (Just id), name:name'} ]
, popOverIcon popupOpen
, nodePopupView d {id, name} popupOpen
, createNodeView d {id, name} popupOpen
, fileTypeView d {id} droppedFile isDragOver
]
where
name' = if nodeType == NodeUser then show session else name
folderIcon folderOpen'@(open /\ _) =
H.a {onClick: R2.effToggler folderOpen'}
[ H.i {className: fldr open} [] ]
popOverIcon (popOver /\ setPopOver) =
H.a { className: "glyphicon glyphicon-cog"
, id: "rename-leaf"
, on: { click: \_ -> setPopOver $ toggle }
} []
where
toggle Nothing = Just NodePopup
toggle _ = Nothing
dropProps droppedFile isDragOver =
{ className: dropClass droppedFile isDragOver
, on: { drop: dropHandler droppedFile
, dragOver: onDragOverHandler isDragOver
, dragLeave: onDragLeave isDragOver } }
dropClass (Just _ /\ _) _ = "file-dropped"
dropClass _ (true /\ _) = "file-dropped"
dropClass (Nothing /\ _) _ = ""
dropHandler (_ /\ setDroppedFile) e = unsafePartial $ do
let ff = fromJust $ item 0 $ ((e .. "dataTransfer" .. "files") :: FileList)
liftEffect $ log2 "drop:" ff
-- prevent redirection when file is dropped
E.preventDefault e
E.stopPropagation e
let blob = toBlob $ ff
void $ runAff (\_ -> pure unit) do
contents <- readAsText blob
liftEffect $ setDroppedFile $ const $ Just $ DroppedFile {contents: (UploadFileContents contents), fileType: Just CSV}
onDragOverHandler (_ /\ setIsDragOver) e = do
-- prevent redirection when file is dropped
-- https://stackoverflow.com/a/6756680/941471
E.preventDefault e
E.stopPropagation e
setIsDragOver $ const true
onDragLeave (_ /\ setIsDragOver) _ = setIsDragOver $ const false
fldr :: Boolean -> String
fldr open = if open
then "glyphicon glyphicon-folder-open"
else "glyphicon glyphicon-folder-close"
childNodes :: Session -> Frontends
-> R.State Reload -> R.State Boolean
-> Maybe AppRoute -> Array FTree
-> Array R.Element
childNodes _ _ _ _ _ [] = []
childNodes _ _ _ (false /\ _) _ _ = []
childNodes session frontends reload (true /\ _) route ary =
mapWithIndex (\index tree -> childNode {tree, session, frontends, reload, route, key: index}) ary
type ChildProps = ( tree :: FTree, session :: Session, frontends :: Frontends, key :: Int, reload :: R.State Reload, route :: Maybe AppRoute )
childNode :: Record ChildProps -> R.Element
childNode props = R.createElement childNodeCpt props []
childNodeCpt :: R.Component ChildProps
childNodeCpt = R.hooksComponent "G.C.Tree.childNode" cpt where
cpt {tree, reload, session, frontends, route} _ = do
treeState <- R.useState' {tree}
pure $ toHtml reload treeState session frontends route
-- END toHtml
-- START Popup View
type NodePopupProps =
( id :: ID
, name :: Name)
nodePopupView :: (Action -> Aff Unit)
-> Record NodePopupProps
-> R.State (Maybe NodePopup)
-> R.Element
nodePopupView d p (Just NodePopup /\ setPopupOpen) = R.createElement el p []
where
el = R.hooksComponent "NodePopupView" cpt
cpt {id, name} _ = do
renameBoxOpen <- R.useState' false
pure $ H.div tooltipProps $
[ H.div {id: "arrow"} []
, H.div { className: "panel panel-default"
, style: { border:"1px solid rgba(0,0,0,0.2)"
, boxShadow : "0 2px 5px rgba(0,0,0,0.2)"}
}
[ panelHeading renameBoxOpen
, panelBody
]
]
where
tooltipProps = { className: ""
, id: "node-popup-tooltip"
, title: "Node settings"
, data: {toggle: "tooltip", placement: "right"}
}
iconAStyle = {color:"black", paddingTop: "6px", paddingBottom: "6px"}
rowClass true = "col-md-10"
rowClass false = "col-md-8"
panelHeading renameBoxOpen@(open /\ _) =
H.div {className: "panel-heading"}
[ H.div {className: "row" }
[ H.div {className: rowClass open} [ renameBox d {id, name} renameBoxOpen ]
, editIcon renameBoxOpen
, H.div {className: "col-md-2"}
[ H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove-circle"
, onClick: mkEffectFn1 $ \_ -> setPopupOpen $ const Nothing
, title: "Close"} []
]
]
]
glyphicon t = "glyphitem glyphicon glyphicon-" <> t
editIcon (false /\ setRenameBoxOpen) =
H.div {className: "col-md-2"}
[ H.a {style: {color: "black"}
, className: "btn glyphitem glyphicon glyphicon-pencil"
, id: "rename1"
, title: "Rename"
, onClick: mkEffectFn1 $ \_ -> setRenameBoxOpen $ const true
}
[]
]
editIcon (true /\ _) = H.div {} []
panelBody =
H.div {className: "panel-body"
, style: { display:"flex"
, justifyContent : "center"
, backgroundColor: "white"
, border: "none"}}
[ createButton
, H.div {className: "col-md-4"}
[ H.a {style: iconAStyle
, className: (glyphicon "download")
, id: "download"
, title: "Download [WIP]"}
[]
]
, H.div {className: "col-md-4"}
[ H.a {style: iconAStyle
, className: (glyphicon "upload")
, id: "upload"
, title: "Upload [WIP]"}
[]
]
, H.div {className: "col-md-4"}
[ H.a {style: iconAStyle
, className: (glyphicon "refresh")
, id: "refresh"
, title: "Refresh [WIP]"}
[]
]
, H.div {className: "col-md-4"}
[ H.a {style: iconAStyle
, className: (glyphicon "trash")
, id: "rename2"
, title: "Delete"
, onClick: mkEffectFn1 $ \_ -> launchAff $ d $ DeleteNode}
[]
]
]
where
createButton =
H.div {className: "col-md-4"}
[ H.a {style: iconAStyle
, className: (glyphicon "plus")
, id: "create"
, title: "Create"
, onClick: mkEffectFn1 $ \_ -> setPopupOpen $ const $ Just CreatePopup
}
[]
]
nodePopupView _ p _ = R.createElement el p []
where
el = R.hooksComponent "CreateNodeView" cpt
cpt _ _ = pure $ H.div {} []
-- END Popup View
-- START Rename Box
type RenameBoxProps =
( id :: ID
, name :: Name)
renameBox :: (Action -> Aff Unit) -> Record RenameBoxProps -> R.State Boolean -> R.Element
renameBox d p (true /\ setRenameBoxOpen) = R.createElement el p []
where
el = R.hooksComponent "RenameBox" cpt
cpt {id, name} _ = do
renameNodeName <- R.useState' name
pure $ H.div {className: "from-group row-no-padding"}
[ renameInput renameNodeName
, renameBtn renameNodeName
, cancelBtn
]
where
renameInput (_ /\ setRenameNodeName) =
H.div {className: "col-md-8"}
[ H.input { type: "text"
, placeholder: "Rename Node"
, defaultValue: name
, className: "form-control"
, onInput: mkEffectFn1 $ \e -> setRenameNodeName $ const $ e .. "target" .. "value"
}
]
renameBtn (newName /\ _) =
H.a {className: "btn glyphitem glyphicon glyphicon-ok col-md-2 pull-left"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> do
setRenameBoxOpen $ const false
launchAff $ d $ Submit newName
, title: "Rename"
} []
cancelBtn =
H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove col-md-2 pull-left"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> setRenameBoxOpen $ const false
, title: "Cancel"
} []
renameBox _ p (false /\ _) = R.createElement el p []
where
el = R.hooksComponent "RenameBox" cpt
cpt {name} _ = pure $ H.div {} [ H.text name ]
-- END Rename Box
-- START Create Node
type CreateNodeProps =
( id :: ID
, name :: Name)
createNodeView :: (Action -> Aff Unit) -> Record CreateNodeProps -> R.State (Maybe NodePopup) -> R.Element
createNodeView d p (Just CreatePopup /\ setPopupOpen) = R.createElement el p []
where
el = R.hooksComponent "CreateNodeView" cpt
cpt {id, name} _ = do
nodeName <- R.useState' ""
nodeType <- R.useState' Corpus
pure $ H.div tooltipProps $
[ H.div {className: "panel panel-default"}
[ panelHeading
, panelBody nodeName nodeType
, panelFooter nodeName nodeType
]
]
where
tooltipProps = { className: ""
, id: "create-node-tooltip"
, title: "Create new node"
, data: {toggle: "tooltip", placement: "right"}
}
panelHeading =
H.div {className: "panel-heading"}
[ H.div {className: "row"}
[ H.div {className: "col-md-10"}
[ H.h5 {} [H.text "Create Node"] ]
, H.div {className: "col-md-2"}
[ H.a { className: "btn text-danger glyphitem glyphicon glyphicon-remove-circle"
, onClick: mkEffectFn1 $ \_ -> setPopupOpen $ const Nothing
, title: "Close"} []
]
]
]
panelBody :: R.State String -> R.State NodeType -> R.Element
panelBody (_ /\ setNodeName) (nt /\ setNodeType) =
H.div {className: "panel-body"}
[ H.div {className: "row"}
[ H.div {className: "col-md-12"}
[ H.form {className: "form-horizontal"}
[ H.div {className: "form-group"}
[ H.input { type: "text"
, placeholder: "Node name"
, defaultValue: name
, className: "form-control"
, onInput: mkEffectFn1 $ \e -> setNodeName $ const $ e .. "target" .. "value"
}
]
, H.div {className: "form-group"}
[ R2.select { className: "form-control"
, onChange: mkEffectFn1 $ \e -> setNodeType $ const $ readNodeType $ e .. "target" .. "value"
}
(map renderOption [Corpus, Folder])
]
]
]
]
]
renderOption (opt :: NodeType) = H.option {} [ H.text $ show opt ]
panelFooter :: R.State String -> R.State NodeType -> R.Element
panelFooter (name' /\ _) (nt /\ _) =
H.div {className: "panel-footer"}
[ H.button {className: "btn btn-success"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> do
setPopupOpen $ const Nothing
launchAff $ d $ CreateSubmit name' nt
} [H.text "Create"]
]
createNodeView _ _ _ = R.createElement el {} []
where
el = R.hooksComponent "CreateNodeView" cpt
cpt props _ = pure $ H.div {} []
-- END Create Node
-- START File Type View
type FileTypeProps =
( id :: ID )
fileTypeView :: (Action -> Aff Unit) -> Record FileTypeProps -> R.State (Maybe DroppedFile) -> R.State Boolean -> R.Element
fileTypeView d p (Just (DroppedFile {contents, fileType}) /\ setDroppedFile) (_ /\ setIsDragOver) = R.createElement el p []
where
el = R.hooksComponent "FileTypeView" cpt
cpt {id} _ = do
pure $ H.div tooltipProps $
[ H.div {className: "panel panel-default"}
[ panelHeading
, panelBody
, panelFooter
]
]
where
tooltipProps = { className: ""
, id: "file-type-tooltip"
, title: "Choose file type"
, data: {toggle: "tooltip", placement: "right"}
}
panelHeading =
H.div {className: "panel-heading"}
[ H.div {className: "row"}
[ H.div {className: "col-md-10"}
[ H.h5 {} [H.text "Choose file type"] ]
, H.div {className: "col-md-2"}
[ H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove-circle"
, onClick: mkEffectFn1 $ \_ -> do
setDroppedFile $ const Nothing
setIsDragOver $ const false
, title: "Close"} []
]
]
]
panelBody =
H.div {className: "panel-body"}
[ R2.select {className: "col-md-12 form-control"
, onChange: onChange}
(map renderOption [CSV, PresseRIS])
]
where
onChange = mkEffectFn1 $ \e ->
setDroppedFile $ const $ Just $ DroppedFile $ {contents, fileType: readFileType $ e .. "target" .. "value"}
renderOption opt = H.option {} [ H.text $ show opt ]
panelFooter =
H.div {className: "panel-footer"}
[
case fileType of
Just ft ->
H.button {className: "btn btn-success"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> do
setDroppedFile $ const Nothing
launchAff $ d $ UploadFile ft contents
} [H.text "Upload"]
Nothing ->
H.button {className: "btn btn-success disabled"
, type: "button"
} [H.text "Upload"]
]
fileTypeView _ _ (Nothing /\ _) _ = R.createElement el {} []
where
el = R.hooksComponent "FileTypeView" cpt
cpt props _ = pure $ H.div {} []
-- END File Type View
-- START node text
type NodeTextProps =
( isSelected :: Boolean
, name :: Name )
nodeText :: Record NodeTextProps -> R.Element
nodeText p = R.createElement el p []
where
el = R.hooksComponent "NodeText" cpt
cpt {isSelected: true, name} _ = do
pure $ H.u {} [H.b {} [H.text ("| " <> name <> " | ")]]
cpt {isSelected: false, name} _ = do
pure $ H.text (name <> " ")
-- END node text
loadNode :: Session -> ID -> Aff FTree
loadNode session = get <<< url session <<< NodeAPI Tree <<< Just
----- TREE CRUD Operations
newtype RenameValue = RenameValue
{
name :: Name
}
instance encodeJsonRenameValue :: EncodeJson RenameValue where
encodeJson (RenameValue {name})
= "r_name" := name
~> jsonEmptyObject
newtype CreateValue = CreateValue
{
name :: Name
, nodeType :: NodeType
}
instance encodeJsonCreateValue :: EncodeJson CreateValue where
encodeJson (CreateValue {name, nodeType})
= "pn_name" := name
~> "pn_typename" := nodeType
~> jsonEmptyObject
createNode :: Session -> ID -> CreateValue -> Aff ID
--createNode = post $ urlPlease Back $ "new"
createNode session parentId = post $ url session (NodeAPI Node $ Just parentId)
renameNode :: Session -> ID -> RenameValue -> Aff (Array ID)
renameNode session renameNodeId = put $ url session (NodeAPI Node $ Just renameNodeId) <> "/rename"
deleteNode :: Session -> ID -> Aff ID
deleteNode session = delete <<< url session <<< NodeAPI Node <<< Just
newtype FileUploadQuery = FileUploadQuery {
fileType :: FileType
}
derive instance newtypeSearchQuery :: Newtype FileUploadQuery _
instance fileUploadQueryToQuery :: ToQuery FileUploadQuery where
toQuery (FileUploadQuery {fileType}) =
QP.print id id $ QP.QueryPairs $
pair "fileType" fileType
where pair :: forall a. Show a => String -> a -> Array (Tuple QP.Key (Maybe QP.Value))
pair k v = [ QP.keyFromString k /\ (Just $ QP.valueFromString $ show v) ]
uploadFile :: Session -> ID -> FileType -> UploadFileContents -> Aff (Array FileHash)
uploadFile session id fileType (UploadFileContents fileContents) = postWwwUrlencoded url2 fileContents
where
q = FileUploadQuery { fileType: fileType }
url2 = url session (NodeAPI Node (Just id)) <> "/upload" <> Q.print (toQuery q)
fnTransform :: LNode -> FTree
fnTransform n = NTree n []
src/Gargantext/Config/REST.purs
View file @ 11f4718e
module Gargantext.Config.REST where module Gargantext.Config.REST where
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Ends
import Affjax (defaultRequest, printResponseFormatError, request) import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..), string) import Affjax.RequestBody (RequestBody(..), string)
...@@ -11,20 +12,26 @@ import Data.Either (Either(..)) ...@@ -11,20 +12,26 @@ import Data.Either (Either(..))
import Data.HTTP.Method (Method(..)) import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.MediaType.Common (applicationFormURLEncoded, applicationJSON) import Data.MediaType.Common (applicationFormURLEncoded, applicationJSON)
import Data.Foldable (foldMap)
import Effect.Aff (Aff, throwError) import Effect.Aff (Aff, throwError)
import Effect.Exception (error) import Effect.Exception (error)
type Token = String
-- TODO too much duplicate code in `postWwwUrlencoded`
send :: forall a b. EncodeJson a => DecodeJson b => send :: forall a b. EncodeJson a => DecodeJson b =>
Method -> String -> Maybe a -> Aff b Method -> Maybe Token -> String -> Maybe a -> Aff b
send m url reqbody = do send m mtoken url reqbody = do
affResp <- request $ defaultRequest affResp <- request $ defaultRequest
{ url = url { url = url
, responseFormat = ResponseFormat.json , responseFormat = ResponseFormat.json
, method = Left m , method = Left m
, headers = [ ContentType applicationJSON , headers = [ ContentType applicationJSON
, Accept applicationJSON , Accept applicationJSON
-- , RequestHeader "Authorization" $ "Bearer " <> token ] <>
] foldMap (\token ->
[RequestHeader "Authorization" $ "Bearer " <> token]
) mtoken
, content = (Json <<< encodeJson) <$> reqbody , content = (Json <<< encodeJson) <$> reqbody
} }
case affResp.body of case affResp.body of
...@@ -42,32 +49,36 @@ send m url reqbody = do ...@@ -42,32 +49,36 @@ send m url reqbody = do
noReqBody :: Maybe Unit noReqBody :: Maybe Unit
noReqBody = Nothing noReqBody = Nothing
get :: forall a. DecodeJson a => String -> Aff a get :: forall a. DecodeJson a => Maybe Token -> String -> Aff a
get url = send GET url noReqBody get mtoken url = send GET mtoken url noReqBody
put :: forall a b. EncodeJson a => DecodeJson b => String -> a -> Aff b put :: forall a b. EncodeJson a => DecodeJson b => Maybe Token -> String -> a -> Aff b
put url = send PUT url <<< Just put mtoken url = send PUT mtoken url <<< Just
delete :: forall a. DecodeJson a => String -> Aff a delete :: forall a. DecodeJson a => Maybe Token -> String -> Aff a
delete url = send DELETE url noReqBody delete mtoken url = send DELETE mtoken url noReqBody
-- This might not be a good idea: -- This might not be a good idea:
-- https://stackoverflow.com/questions/14323716/restful-alternatives-to-delete-request-body -- https://stackoverflow.com/questions/14323716/restful-alternatives-to-delete-request-body
deleteWithBody :: forall a b. EncodeJson a => DecodeJson b => String -> a -> Aff b deleteWithBody :: forall a b. EncodeJson a => DecodeJson b => Maybe Token -> String -> a -> Aff b
deleteWithBody url = send DELETE url <<< Just deleteWithBody mtoken url = send DELETE mtoken url <<< Just
post :: forall a b. EncodeJson a => DecodeJson b => String -> a -> Aff b post :: forall a b. EncodeJson a => DecodeJson b => Maybe Token -> String -> a -> Aff b
post url = send POST url <<< Just post mtoken url = send POST mtoken url <<< Just
postWwwUrlencoded :: forall b. DecodeJson b => String -> String -> Aff b -- TODO too much duplicate code with `send`
postWwwUrlencoded url body = do postWwwUrlencoded :: forall b. DecodeJson b => Maybe Token -> String -> String -> Aff b
postWwwUrlencoded mtoken url body = do
affResp <- request $ defaultRequest affResp <- request $ defaultRequest
{ url = url { url = url
, responseFormat = ResponseFormat.json , responseFormat = ResponseFormat.json
, method = Left POST , method = Left POST
, headers = [ ContentType applicationFormURLEncoded , headers = [ ContentType applicationFormURLEncoded
, Accept applicationJSON , Accept applicationJSON
] ] <>
foldMap (\token ->
[RequestHeader "Authorization" $ "Bearer " <> token]
) mtoken
, content = Just $ string body , content = Just $ string body
} }
case affResp.body of case affResp.body of
......
src/Gargantext/Ends.purs
View file @ 11f4718e
...@@ -3,7 +3,7 @@ module Gargantext.Ends ...@@ -3,7 +3,7 @@ module Gargantext.Ends
-- ( ) -- ( )
where where
import Prelude (class Eq, class Show, identity, show, ($), (<>), bind, pure) import Prelude (class Eq, class Show, identity, show, ($), (<>), bind, pure, (<<<), (==))
import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson, (:=), (~>), jsonEmptyObject, (.:)) import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, encodeJson, (:=), (~>), jsonEmptyObject, (.:))
import Data.Foldable (foldMap) import Data.Foldable (foldMap)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
...@@ -114,13 +114,12 @@ staticUrl :: Frontends -> String -> String ...@@ -114,13 +114,12 @@ staticUrl :: Frontends -> String -> String
staticUrl (Frontends {static}) = frontendUrl static staticUrl (Frontends {static}) = frontendUrl static
sessionPath :: R.SessionRoute -> String sessionPath :: R.SessionRoute -> String
sessionPath (R.Tab t i) = sessionPath (R.NodeAPI Node i) <> "/" <> showTabType' t sessionPath (R.Tab t i) = sessionPath (R.NodeAPI Node i (showTabType' t))
sessionPath (R.Children n o l s i) = root <> "children?type=" <> show n <> offsetUrl o <> limitUrl l <> orderUrl s sessionPath (R.Children n o l s i) = sessionPath (R.NodeAPI Node i ("children?type=" <> show n <> offsetUrl o <> limitUrl l <> orderUrl s))
where root = sessionPath (R.NodeAPI Node i) <> "/" sessionPath (R.NodeAPI Phylo pId p) = "phyloscape?nodeId=" <> (show $ maybe 0 identity pId) <> p
sessionPath (R.NodeAPI Phylo pId) = "phyloscape?nodeId=" <> (show $ maybe 0 identity pId)
sessionPath (R.GetNgrams opts i) = sessionPath (R.GetNgrams opts i) =
base opts.tabType base opts.tabType
<> "/ngrams?ngramsType=" $ "ngrams?ngramsType="
<> showTabType' opts.tabType <> showTabType' opts.tabType
<> offsetUrl opts.offset <> offsetUrl opts.offset
<> limitUrl opts.limit <> limitUrl opts.limit
...@@ -130,35 +129,39 @@ sessionPath (R.GetNgrams opts i) = ...@@ -130,35 +129,39 @@ sessionPath (R.GetNgrams opts i) =
<> foldMap termSizeFilter opts.termSizeFilter <> foldMap termSizeFilter opts.termSizeFilter
<> search opts.searchQuery <> search opts.searchQuery
where where
base (TabCorpus _) = sessionPath (R.NodeAPI Node i) base (TabCorpus _) = sessionPath <<< R.NodeAPI Node i
base _ = sessionPath (R.NodeAPI Url_Document i) base _ = sessionPath <<< R.NodeAPI Url_Document i
termSizeFilter MonoTerm = "&minTermSize=0&maxTermSize=1" termSizeFilter MonoTerm = "&minTermSize=0&maxTermSize=1"
termSizeFilter MultiTerm = "&minTermSize=2" termSizeFilter MultiTerm = "&minTermSize=2"
search "" = "" search "" = ""
search s = "&search=" <> s search s = "&search=" <> s
sessionPath (R.ListDocument lId dId) = sessionPath (R.ListDocument lId dId) =
sessionPath (R.NodeAPI NodeList lId) <> "/document/" <> (show $ maybe 0 identity dId) sessionPath $ R.NodeAPI NodeList lId ("document/" <> (show $ maybe 0 identity dId))
sessionPath (R.PutNgrams t listId termList i) = sessionPath (R.PutNgrams t listId termList i) =
sessionPath (R.NodeAPI Node i) sessionPath $ R.NodeAPI Node i
<> "/ngrams?ngramsType=" $ "ngrams?ngramsType="
<> showTabType' t <> showTabType' t
<> maybe "" (\x -> "&list=" <> show x) listId <> maybe "" (\x -> "&list=" <> show x) listId
<> foldMap (\x -> "&listType=" <> show x) termList <> foldMap (\x -> "&listType=" <> show x) termList
sessionPath (R.NodeAPI nt i) = nodeTypePath nt <> (maybe "" (\i' -> "/" <> show i') i) sessionPath (R.NodeAPI nt i p) = nodeTypePath nt
<> (maybe "" (\i' -> "/" <> show i') i)
<> (if p == "" then "" else "/" <> p)
sessionPath (R.Search {listId,limit,offset,orderBy} i) = sessionPath (R.Search {listId,limit,offset,orderBy} i) =
sessionPath (R.NodeAPI Corpus i) sessionPath $ R.NodeAPI Corpus i
<> "/search?list_id=" <> show listId $ "search?list_id=" <> show listId
<> offsetUrl offset <> offsetUrl offset
<> limitUrl limit <> limitUrl limit
<> orderUrl orderBy <> orderUrl orderBy
sessionPath (R.CorpusMetrics {tabType, listId, limit} i) = sessionPath (R.CorpusMetrics {tabType, listId, limit} i) =
sessionPath (R.NodeAPI Corpus i) <> "/metrics" sessionPath $ R.NodeAPI Corpus i
$ "metrics"
<> "?ngrams=" <> show listId <> "?ngrams=" <> show listId
<> "&ngramsType=" <> showTabType' tabType <> "&ngramsType=" <> showTabType' tabType
<> maybe "" (\x -> "&limit=" <> show x) limit <> maybe "" (\x -> "&limit=" <> show x) limit
-- TODO fix this url path -- TODO fix this url path
sessionPath (R.Chart {chartType, tabType} i) = sessionPath (R.Chart {chartType, tabType} i) =
sessionPath (R.NodeAPI Corpus i) <> "/" <> show chartType sessionPath $ R.NodeAPI Corpus i
$ show chartType
<> "?ngramsType=" <> showTabType' tabType <> "?ngramsType=" <> showTabType' tabType
<> "&listType=GraphTerm" -- <> show listId <> "&listType=GraphTerm" -- <> show listId
-- <> maybe "" (\x -> "&limit=" <> show x) limit -- <> maybe "" (\x -> "&limit=" <> show x) limit
......
src/Gargantext/Routes.purs
View file @ 11f4718e
...@@ -25,7 +25,7 @@ data SessionRoute ...@@ -25,7 +25,7 @@ data SessionRoute
| GetNgrams NgramsGetOpts (Maybe Id) | GetNgrams NgramsGetOpts (Maybe Id)
| PutNgrams TabType (Maybe ListId) (Maybe TermList) (Maybe Id) | PutNgrams TabType (Maybe ListId) (Maybe TermList) (Maybe Id)
-- ^ This name is not good. In particular this URL is used both in PUT and POST. -- ^ This name is not good. In particular this URL is used both in PUT and POST.
| NodeAPI NodeType (Maybe Id) | NodeAPI NodeType (Maybe Id) String
| ListDocument (Maybe ListId) (Maybe Id) | ListDocument (Maybe ListId) (Maybe Id)
| Search SearchOpts (Maybe Id) | Search SearchOpts (Maybe Id)
| CorpusMetrics CorpusMetricOpts (Maybe Id) | CorpusMetrics CorpusMetricOpts (Maybe Id)
......
src/Gargantext/Sessions.purs
View file @ 11f4718e
...@@ -20,7 +20,7 @@ import Web.HTML.Window (localStorage) ...@@ -20,7 +20,7 @@ import Web.HTML.Window (localStorage)
import Web.Storage.Storage (removeItem) -- (getItem, setItem, removeItem) import Web.Storage.Storage (removeItem) -- (getItem, setItem, removeItem)
import Gargantext.Components.Login.Types import Gargantext.Components.Login.Types
(AuthRequest(..), AuthResponse(..), AuthInvalid(..), AuthData(..)) (AuthRequest(..), AuthResponse(..), AuthInvalid(..), AuthData(..))
import Gargantext.Config.REST (post) import Gargantext.Config.REST as REST
import Gargantext.Ends (class ToUrl, Backend, backendUrl, toUrl, sessionPath) import Gargantext.Ends (class ToUrl, Backend, backendUrl, toUrl, sessionPath)
import Gargantext.Routes (SessionRoute) import Gargantext.Routes (SessionRoute)
import Gargantext.Types (NodePath, SessionId(..), nodePath) import Gargantext.Types (NodePath, SessionId(..), nodePath)
...@@ -127,13 +127,13 @@ tryCons s ss = try (lookup sid ss) where ...@@ -127,13 +127,13 @@ tryCons s ss = try (lookup sid ss) where
try Nothing = Right (cons s ss) try Nothing = Right (cons s ss)
try _ = Left unit try _ = Left unit
delete :: SessionId -> Sessions -> Sessions remove :: SessionId -> Sessions -> Sessions
delete sid (Sessions ss) = Sessions (Seq.filter f ss) where remove sid (Sessions ss) = Sessions (Seq.filter f ss) where
f s = sid /= sessionId s f s = sid /= sessionId s
tryDelete :: SessionId -> Sessions -> Either Unit Sessions tryRemove :: SessionId -> Sessions -> Either Unit Sessions
tryDelete sid old@(Sessions ss) = ret where tryRemove sid old@(Sessions ss) = ret where
new = delete sid old new = remove sid old
ret ret
| new == old = Left unit | new == old = Left unit
| otherwise = Right new | otherwise = Right new
...@@ -148,7 +148,7 @@ act ss (Login s) = ...@@ -148,7 +148,7 @@ act ss (Login s) =
Right new -> pure new Right new -> pure new
_ -> pure ss <* log2 "Cannot overwrite existing session: " (sessionId s) _ -> pure ss <* log2 "Cannot overwrite existing session: " (sessionId s)
act old@(Sessions ss) (Logout s) = act old@(Sessions ss) (Logout s) =
case tryDelete (sessionId s) old of case tryRemove (sessionId s) old of
Right new -> pure $ new Right new -> pure $ new
_ -> pure old <* log2 "Logged out of stale session:" (sessionId s) _ -> pure old <* log2 "Logged out of stale session:" (sessionId s)
...@@ -185,10 +185,30 @@ saveSessions sessions = effect *> pure sessions ...@@ -185,10 +185,30 @@ saveSessions sessions = effect *> pure sessions
postAuthRequest :: Backend -> AuthRequest -> Aff (Either String Session) postAuthRequest :: Backend -> AuthRequest -> Aff (Either String Session)
postAuthRequest backend ar@(AuthRequest {username}) = postAuthRequest backend ar@(AuthRequest {username}) =
decode <$> post (toUrl backend "auth") ar decode <$> REST.post Nothing (toUrl backend "auth") ar
where where
decode (AuthResponse ar2) decode (AuthResponse ar2)
| {inval: Just (AuthInvalid {message})} <- ar2 = Left message | {inval: Just (AuthInvalid {message})} <- ar2 = Left message
| {valid: Just (AuthData {token, tree_id})} <- ar2 = | {valid: Just (AuthData {token, tree_id})} <- ar2 =
Right $ Session { backend, username, token, treeId: tree_id } Right $ Session { backend, username, token, treeId: tree_id }
| otherwise = Left "Invalid response from server" | otherwise = Left "Invalid response from server"
get :: forall a p. DecodeJson a => ToUrl Session p => Session -> p -> Aff a
get session@(Session {token}) p = REST.get (Just token) (toUrl session p)
put :: forall a b p. EncodeJson a => DecodeJson b => ToUrl Session p => Session -> p -> a -> Aff b
put session@(Session {token}) p = REST.put (Just token) (toUrl session p)
delete :: forall a p. DecodeJson a => ToUrl Session p => Session -> p -> Aff 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. EncodeJson a => DecodeJson b => ToUrl Session p => Session -> p -> a -> Aff b
deleteWithBody session@(Session {token}) p = REST.deleteWithBody (Just token) (toUrl session p)
post :: forall a b p. EncodeJson a => DecodeJson b => ToUrl Session p => Session -> p -> a -> Aff b
post session@(Session {token}) p = REST.post (Just token) (toUrl session p)
postWwwUrlencoded :: forall b p. DecodeJson b => ToUrl Session p => Session -> p -> String -> Aff b
postWwwUrlencoded session@(Session {token}) p = REST.postWwwUrlencoded (Just token) (toUrl session p)
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