Commit bd44a928 authored by Alexandre Delanoë's avatar Alexandre Delanoë

Merge branch 'dev-community' into dev-merge

parents 50bd539c e6f129de
-- TODO: this module should be replaced by FacetsTable
module Gargantext.Components.Category where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>), encodeJson)
import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.Lens ((^.))
import Data.Lens.At (at)
import Data.Lens.Record (prop)
import Data.List as L
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe, isJust)
import Data.Ord.Down (Down(..))
import Data.Set (Set)
import Data.Set as Set
import Data.String as Str
import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..), fst)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Event as DE
import Effect (Effect)
import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
------------------------------------------------------------------------
import Gargantext.Prelude
import Gargantext.Ends (Frontends, url)
import Gargantext.Hooks.Loader (useLoaderWithCacheAPI, HashedResponse(..))
import Gargantext.Utils.List (sortWith) as L
import Gargantext.Utils.Reactix as R2
import Gargantext.Routes as Routes
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, sessionId, get, delete, put)
import Gargantext.Types (NodeType(..), OrderBy(..), TableResult, TabType, showTabType')
import Gargantext.Utils.CacheAPI as GUC
------------------------------------------------------------------------
data Category = Trash | UnRead | Checked | Topic | Favorite
categories :: Array Category
categories = [Trash, UnRead, Checked, Topic, Favorite]
derive instance genericFavorite :: Generic Category _
instance showCategory :: Show Category where
show = genericShow
instance eqCategory :: Eq Category where
eq = genericEq
instance decodeJsonCategory :: DecodeJson Category where
decodeJson json = do
obj <- decodeJson json
pure $ decodeCategory obj
instance encodeJsonCategory :: EncodeJson Category where
encodeJson cat = encodeJson (cat2score cat)
favCategory :: Category -> Category
favCategory Favorite = Topic
favCategory _ = Favorite
trashCategory :: Category -> Category
trashCategory _ = Trash
-- TODO: ?
--trashCategory Trash = UnRead
decodeCategory :: Int -> Category
decodeCategory 0 = Trash
decodeCategory 1 = UnRead
decodeCategory 2 = Checked
decodeCategory 3 = Topic
decodeCategory 4 = Favorite
decodeCategory _ = UnRead
cat2score :: Category -> Int
cat2score Trash = 0
cat2score UnRead = 1
cat2score Checked = 2
cat2score Topic = 3
cat2score Favorite = 4
-- caroussel :: Category -> R.Element
caroussel session nodeId setLocalCategories r cat = H.div {className:"flex"} divs
where
divs = map (\c -> if cat == c
then
H.div { className : icon c (cat == c) } []
else
H.div { className : icon c (cat == c)
, on: { click: onClick c}
} []
) (caroussel' cat)
caroussel' :: Category -> Array Category
caroussel' Trash = A.take 2 categories
caroussel' c = A.take 3 $ A.drop (cat2score c - 1 ) categories
onClick c = \_-> do
setLocalCategories $ Map.insert r._id c
void $ launchAff $ putCategories session nodeId $ CategoryQuery {nodeIds: [r._id], category: c}
icon :: Category -> Boolean -> String
icon cat b = btn b $ "glyphicon glyphicon-" <> (color $ size b $ icon' cat b)
where
icon' :: Category -> Boolean -> String
icon' Trash false = "remove"
icon' Trash true = "remove-sign"
icon' UnRead true = "question-sign"
icon' UnRead false = "question-sign"
icon' Checked true = "ok-sign"
icon' Checked false = "ok"
icon' Topic true = "star"
icon' Topic false = "star-empty"
icon' Favorite true = "heart"
icon' Favorite false = "heart-empty"
size :: Boolean -> String -> String
size true s = s <> " btn-lg"
size false s = s <> " btn-xs"
color :: String -> String
color x = x <> " text-primary"
btn :: Boolean -> String -> String
btn true s = s
btn false s = "btn " <> s
newtype CategoryQuery = CategoryQuery {
nodeIds :: Array Int
, category :: Category
}
instance encodeJsonCategoryQuery :: EncodeJson CategoryQuery where
encodeJson (CategoryQuery post) =
"ntc_nodesId" := post.nodeIds
~> "ntc_category" := encodeJson post.category
~> jsonEmptyObject
categoryRoute :: Int -> SessionRoute
categoryRoute nodeId = NodeAPI Node (Just nodeId) "category"
putCategories :: Session -> Int -> CategoryQuery -> Aff (Array Int)
putCategories session nodeId = put session $ categoryRoute nodeId
...@@ -28,7 +28,7 @@ import Reactix as R ...@@ -28,7 +28,7 @@ import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
------------------------------------------------------------------------ ------------------------------------------------------------------------
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.Category
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Ends (Frontends, url) import Gargantext.Ends (Frontends, url)
import Gargantext.Hooks.Loader (useLoaderWithCacheAPI, HashedResponse(..)) import Gargantext.Hooks.Loader (useLoaderWithCacheAPI, HashedResponse(..))
...@@ -41,117 +41,6 @@ import Gargantext.Types (NodeType(..), OrderBy(..), TableResult, TabType, showTa ...@@ -41,117 +41,6 @@ import Gargantext.Types (NodeType(..), OrderBy(..), TableResult, TabType, showTa
import Gargantext.Utils.CacheAPI as GUC import Gargantext.Utils.CacheAPI as GUC
------------------------------------------------------------------------ ------------------------------------------------------------------------
data Category = Trash | UnRead | Checked | Topic | Favorite
categories :: Array Category
categories = [Trash, UnRead, Checked, Topic, Favorite]
derive instance genericFavorite :: Generic Category _
instance showCategory :: Show Category where
show = genericShow
instance eqCategory :: Eq Category where
eq = genericEq
instance decodeJsonCategory :: DecodeJson Category where
decodeJson json = do
obj <- decodeJson json
pure $ decodeCategory obj
instance encodeJsonCategory :: EncodeJson Category where
encodeJson cat = encodeJson (cat2score cat)
favCategory :: Category -> Category
favCategory Favorite = Topic
favCategory _ = Favorite
trashCategory :: Category -> Category
trashCategory _ = Trash
-- TODO: ?
--trashCategory Trash = UnRead
decodeCategory :: Int -> Category
decodeCategory 0 = Trash
decodeCategory 1 = UnRead
decodeCategory 2 = Checked
decodeCategory 3 = Topic
decodeCategory 4 = Favorite
decodeCategory _ = UnRead
cat2score :: Category -> Int
cat2score Trash = 0
cat2score UnRead = 1
cat2score Checked = 2
cat2score Topic = 3
cat2score Favorite = 4
-- caroussel :: Category -> R.Element
caroussel session nodeId setLocalCategories r cat = H.div {className:"flex"} divs
where
divs = map (\c -> if cat == c
then
H.div { className : icon c (cat == c) } []
else
H.div { className : icon c (cat == c)
, on: { click: onClick c}
} []
) (caroussel' cat)
caroussel' :: Category -> Array Category
caroussel' Trash = A.take 2 categories
caroussel' c = A.take 3 $ A.drop (cat2score c - 1 ) categories
onClick c = \_-> do
setLocalCategories $ Map.insert r._id c
void $ launchAff $ putCategories session nodeId $ CategoryQuery {nodeIds: [r._id], category: c}
icon :: Category -> Boolean -> String
icon cat b = btn b $ "glyphicon glyphicon-" <> (color $ size b $ icon' cat b)
where
icon' :: Category -> Boolean -> String
icon' Trash false = "remove"
icon' Trash true = "remove-sign"
icon' UnRead true = "question-sign"
icon' UnRead false = "question-sign"
icon' Checked true = "ok-sign"
icon' Checked false = "ok"
icon' Topic true = "star"
icon' Topic false = "star-empty"
icon' Favorite true = "heart"
icon' Favorite false = "heart-empty"
size :: Boolean -> String -> String
size true s = s <> " btn-lg"
size false s = s <> " btn-xs"
color :: String -> String
color x = x <> " text-primary"
btn :: Boolean -> String -> String
btn true s = s
btn false s = "btn " <> s
newtype CategoryQuery = CategoryQuery {
nodeIds :: Array Int
, category :: Category
}
instance encodeJsonCategoryQuery :: EncodeJson CategoryQuery where
encodeJson (CategoryQuery post) =
"ntc_nodesId" := post.nodeIds
~> "ntc_category" := encodeJson post.category
~> jsonEmptyObject
categoryRoute :: Int -> SessionRoute
categoryRoute nodeId = NodeAPI Node (Just nodeId) "category"
putCategories :: Session -> Int -> CategoryQuery -> Aff (Array Int)
putCategories session nodeId = put session $ categoryRoute nodeId
type TotalRecords = Int type TotalRecords = Int
type LayoutProps = type LayoutProps =
...@@ -198,10 +87,16 @@ newtype DocumentsView ...@@ -198,10 +87,16 @@ newtype DocumentsView
, url :: String , url :: String
} }
{-
derive instance genericDocumentsView :: Generic DocumentsView _ derive instance genericDocumentsView :: Generic DocumentsView _
instance showDocumentsView :: Show DocumentsView where instance showDocumentsView :: Show DocumentsView where
show = genericShow show = genericShow
instance decodeJsonSearchType :: Argonaut.DecodeJson SearchType where
decodeJson = genericSumDecodeJson
instance encodeJsonSearchType :: Argonaut.EncodeJson SearchType where
encodeJson = genericSumEncodeJson
-}
instance decodeDocumentsView :: DecodeJson DocumentsView where instance decodeDocumentsView :: DecodeJson DocumentsView where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
...@@ -230,6 +125,7 @@ newtype Response = Response ...@@ -230,6 +125,7 @@ newtype Response = Response
, hyperdata :: Hyperdata , hyperdata :: Hyperdata
, category :: Category , category :: Category
, ngramCount :: Int , ngramCount :: Int
, title :: String
} }
...@@ -252,10 +148,11 @@ instance decodeResponse :: DecodeJson Response where ...@@ -252,10 +148,11 @@ instance decodeResponse :: DecodeJson Response where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
cid <- obj .: "id" cid <- obj .: "id"
favorite <- obj .: "favorite" category <- obj .: "category"
ngramCount <- obj .: "id" ngramCount <- obj .: "id"
title <- obj .: "title"
hyperdata <- obj .: "hyperdata" hyperdata <- obj .: "hyperdata"
pure $ Response { cid, category: decodeCategory favorite, ngramCount, hyperdata } pure $ Response { cid, title, category: decodeCategory category, ngramCount, hyperdata }
docViewLayout :: Record LayoutProps -> R.Element docViewLayout :: Record LayoutProps -> R.Element
......
...@@ -3,26 +3,25 @@ ...@@ -3,26 +3,25 @@
-- has not been ported to this module yet. -- has not been ported to this module yet.
module Gargantext.Components.FacetsTable where module Gargantext.Components.FacetsTable where
import Prelude ------------------------------------------------------------------------
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>)) import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Array (concat, filter) import Data.Array (concat, filter)
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.List as L import Data.List as L
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Set (Set) import Data.Set (Set)
import Data.String as String
import Data.Set as Set import Data.Set as Set
import Data.Tuple (fst, snd) import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff_) import Effect.Aff (Aff, launchAff_)
import Reactix as R import Gargantext.Components.Category (Category(..), CategoryQuery(..), favCategory, decodeCategory, putCategories)
import Reactix.DOM.HTML as H import Gargantext.Components.Search
------------------------------------------------------------------------ import Gargantext.Components.Table as T
import Gargantext.Ends (url, Frontends) import Gargantext.Ends (url, Frontends)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Components.DocsTable (Category(..), CategoryQuery(..), favCategory, decodeCategory, putCategories)
import Gargantext.Components.Table as T
import Gargantext.Routes (SessionRoute(Search, NodeAPI)) import Gargantext.Routes (SessionRoute(Search, NodeAPI))
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId, post, deleteWithBody) import Gargantext.Sessions (Session, sessionId, post, deleteWithBody)
...@@ -30,38 +29,18 @@ import Gargantext.Types (NodeType(..), OrderBy(..), NodePath(..), NodeID) ...@@ -30,38 +29,18 @@ import Gargantext.Types (NodeType(..), OrderBy(..), NodePath(..), NodeID)
import Gargantext.Utils (toggleSet, zeroPad) import Gargantext.Utils (toggleSet, zeroPad)
import Gargantext.Utils.DecodeMaybe ((.|)) import Gargantext.Utils.DecodeMaybe ((.|))
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Prelude
import Reactix as R
import Reactix.DOM.HTML as H
------------------------------------------------------------------------ ------------------------------------------------------------------------
type TotalRecords = Int
-- Example:
-- [["machine","learning"],["artificial","intelligence"]]
-- This searches for documents with "machine learning" or "artificial intelligence"
type TextQuery = Array (Array String)
newtype SearchQuery = SearchQuery { query :: TextQuery }
instance encodeJsonSearchQuery :: EncodeJson SearchQuery where
encodeJson (SearchQuery {query})
-- = "query" := query !! 0 -- TODO anoe
= "query" := concat query
~> jsonEmptyObject
newtype SearchResults = SearchResults { results :: Array Response }
instance decodeSearchResults :: DecodeJson SearchResults where
decodeJson json = do
obj <- decodeJson json
results <- obj .: "results"
pure $ SearchResults {results}
type Props = type Props =
( chart :: R.Element ( chart :: R.Element
, container :: Record T.TableContainerProps -> R.Element , container :: Record T.TableContainerProps -> R.Element
, frontends :: Frontends , frontends :: Frontends
, listId :: Int , listId :: Int
, nodeId :: Int , nodeId :: Int
, query :: TextQuery , query :: SearchQuery
, session :: Session , session :: Session
, totalRecords :: Int , totalRecords :: Int
) )
...@@ -72,7 +51,10 @@ type Deletions = { pending :: Set Int, deleted :: Set Int } ...@@ -72,7 +51,10 @@ type Deletions = { pending :: Set Int, deleted :: Set Int }
initialDeletions :: Deletions initialDeletions :: Deletions
initialDeletions = { pending: mempty, deleted: mempty } initialDeletions = { pending: mempty, deleted: mempty }
newtype Pair = Pair { id :: Int, label :: String } newtype Pair =
Pair { id :: Int
, label :: String
}
derive instance genericPair :: Generic Pair _ derive instance genericPair :: Generic Pair _
...@@ -104,75 +86,6 @@ derive instance genericDocumentsView :: Generic DocumentsView _ ...@@ -104,75 +86,6 @@ derive instance genericDocumentsView :: Generic DocumentsView _
instance showDocumentsView :: Show DocumentsView where instance showDocumentsView :: Show DocumentsView where
show = genericShow show = genericShow
newtype Response = Response
{ id :: Int
, created :: String
, hyperdata :: Hyperdata
, category :: Category
, ngramCount :: Int
-- , date :: String
-- , score :: Int
-- , pairs :: Array Pair
}
newtype Hyperdata = Hyperdata
{ authors :: String
, title :: String
, source :: String
, publication_year :: Int
, publication_month :: Int
, publication_day :: Int
}
--instance decodeHyperdata :: DecodeJson Hyperdata where
-- decodeJson json = do
-- obj <- decodeJson json
-- title <- obj .: "title"
-- source <- obj .: "source"
-- pure $ Hyperdata { title,source }
instance decodePair :: DecodeJson Pair where
decodeJson json = do
obj <- decodeJson json
id <- obj .: "id"
label <- obj .: "label"
pure $ Pair { id, label }
instance decodeHyperdata :: DecodeJson Hyperdata where
decodeJson json = do
obj <- decodeJson json
authors <- obj .| "authors"
title <- obj .| "title"
source <- obj .| "source"
publication_year <- obj .: "publication_year"
publication_month <- obj .: "publication_month"
publication_day <- obj .: "publication_day"
pure $ Hyperdata { authors, title, source, publication_year, publication_month, publication_day }
{-
instance decodeResponse :: DecodeJson Response where
decodeJson json = do
obj <- decodeJson json
id <- obj .: "id"
-- date <- obj .: "date" -- TODO
date <- pure "2018"
score <- obj .: "score"
hyperdata <- obj .: "hyperdata"
pairs <- obj .: "pairs"
pure $ Response { id, date, score, hyperdata, pairs }
-}
instance decodeResponse :: DecodeJson Response where
decodeJson json = do
obj <- decodeJson json
id <- obj .: "id"
created <- obj .: "created"
hyperdata <- obj .: "hyperdata"
favorite <- obj .: "favorite"
--ngramCount <- obj .: "ngramCount"
let ngramCount = 1
pure $ Response { id, created, hyperdata, category: decodeCategory favorite, ngramCount}
-- | Main layout of the Documents Tab of a Corpus -- | Main layout of the Documents Tab of a Corpus
docView :: Record Props -> R.Element docView :: Record Props -> R.Element
docView props = R.createElement docViewCpt props [] docView props = R.createElement docViewCpt props []
...@@ -217,7 +130,7 @@ performDeletions session nodeId (deletions /\ setDeletions) = ...@@ -217,7 +130,7 @@ performDeletions session nodeId (deletions /\ setDeletions) =
markCategory :: Session -> NodeID -> Category -> Array NodeID -> Effect Unit markCategory :: Session -> NodeID -> Category -> Array NodeID -> Effect Unit
markCategory session nodeId category nids = markCategory session nodeId category nids =
void $ launchAff_ $putCategories session nodeId (CategoryQuery q) void $ launchAff_ $ putCategories session nodeId (CategoryQuery q)
where -- TODO add array of delete rows here where -- TODO add array of delete rows here
q = {nodeIds: nids, category: favCategory category} q = {nodeIds: nids, category: favCategory category}
...@@ -249,35 +162,26 @@ docViewGraphCpt = R.hooksComponent "FacetsDocViewGraph" cpt ...@@ -249,35 +162,26 @@ docViewGraphCpt = R.hooksComponent "FacetsDocViewGraph" cpt
, H.button { style: buttonStyle, on: { click: performClick } } , H.button { style: buttonStyle, on: { click: performClick } }
[ H.i { className: "glyphitem glyphicon glyphicon-trash" [ H.i { className: "glyphitem glyphicon glyphicon-trash"
, style: { marginRight : "9px" } } [] , style: { marginRight : "9px" } } []
, H.text "Delete document!" ] ] ] ] ] , H.text "Delete document!"
]
]
]
]
]
type PagePath = {nodeId :: Int, listId :: Int, query :: TextQuery, params :: T.Params, session :: Session} type PagePath = { nodeId :: Int
, listId :: Int
, query :: SearchQuery
, params :: T.Params
, session :: Session
}
initialPagePath :: {session :: Session, nodeId :: Int, listId :: Int, query :: TextQuery} -> PagePath initialPagePath :: {session :: Session, nodeId :: Int, listId :: Int, query :: SearchQuery} -> PagePath
initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, query, params: T.initialParams} initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, query, params: T.initialParams}
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, searchType}} = do
let p = Search { listId, offset, limit, orderBy: convOrderBy <$> orderBy } (Just nodeId) let
SearchResults res <- post session p $ SearchQuery {query}
pure $ res2corpus <$> res.results
where
res2corpus :: Response -> DocumentsView
res2corpus (Response { id, created: date, ngramCount: score, category
, hyperdata: Hyperdata {authors, title, source, publication_year, publication_month, publication_day} }) =
DocumentsView { id
, date
, title
, source
, score
, authors
, category
, pairs: []
, delete: false
, publication_year
, publication_month
, publication_day
}
convOrderBy (T.ASC (T.ColumnName "Date")) = DateAsc convOrderBy (T.ASC (T.ColumnName "Date")) = DateAsc
convOrderBy (T.DESC (T.ColumnName "Date")) = DateDesc convOrderBy (T.DESC (T.ColumnName "Date")) = DateDesc
convOrderBy (T.ASC (T.ColumnName "Title")) = TitleAsc convOrderBy (T.ASC (T.ColumnName "Title")) = TitleAsc
...@@ -286,6 +190,89 @@ loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy}} = do ...@@ -286,6 +190,89 @@ loadPage {session, nodeId, listId, query, params: {limit, offset, orderBy}} = do
convOrderBy (T.DESC (T.ColumnName "Source")) = SourceDesc convOrderBy (T.DESC (T.ColumnName "Source")) = SourceDesc
convOrderBy _ = DateAsc -- TODO convOrderBy _ = DateAsc -- TODO
p = Search { listId, offset, limit, orderBy: convOrderBy <$> orderBy } (Just nodeId)
--SearchResult {result} <- post session p $ SearchQuery {query: concat query, expected:searchType}
SearchResult {result} <- post session p query
-- $ SearchQuery {query: concat query, expected: SearchDoc}
pure $ case result of
SearchResultDoc {docs} -> docs2view docs
SearchResultContact {contacts} -> contacts2view contacts
errMessage -> err2view errMessage
docs2view :: Array Document -> Array DocumentsView
docs2view docs = map toView docs
where
toView :: Document -> DocumentsView
toView ( Document { id
, created: date
, hyperdata: HyperdataRowDocument { authors
, title
, source
, publication_year
, publication_month
, publication_day
}
, category
, score
}
) = DocumentsView { id
, date
, title: fromMaybe "Title" title
, source: fromMaybe "Source" source
, score
, authors: fromMaybe "Authors" authors
, category: decodeCategory category
, pairs: []
, delete: false
, publication_year : fromMaybe 2020 publication_year
, publication_month: fromMaybe 1 publication_month
, publication_day : fromMaybe 1 publication_day
}
contacts2view contacts = map toView contacts
where
toView :: Contact -> DocumentsView
toView (Contact { c_id
, c_created: date
, c_hyperdata: HyperdataRowContact { firstname
, lastname
, labs
}
, c_score
}
) = DocumentsView { id: c_id
, date
, title : firstname <> lastname
, source: labs
, score: c_score
, authors: labs
, category: decodeCategory 1
, pairs: []
, delete: false
, publication_year: 2020
, publication_month: 10
, publication_day: 1
}
err2view message =
[DocumentsView { id: 1
, date: "2020-01-01"
, title : "SearchNoResult"
, source: "Source"
, score: 1
, authors: "Authors"
, category: decodeCategory 1
, pairs: []
, delete: false
, publication_year: 2020
, publication_month: 10
, publication_day: 1
}
]
type PageLayoutProps = type PageLayoutProps =
( frontends :: Frontends ( frontends :: Frontends
, totalRecords :: Int , totalRecords :: Int
......
...@@ -24,6 +24,7 @@ import Gargantext.Components.Forest.Tree.Node.Action.Merge (mergeNodeReq) ...@@ -24,6 +24,7 @@ import Gargantext.Components.Forest.Tree.Node.Action.Merge (mergeNodeReq)
import Gargantext.Components.Forest.Tree.Node.Action.Link (linkNodeReq) import Gargantext.Components.Forest.Tree.Node.Action.Link (linkNodeReq)
import Gargantext.Components.Forest.Tree.Node.Action.Rename (RenameValue(..), rename) import Gargantext.Components.Forest.Tree.Node.Action.Rename (RenameValue(..), rename)
import Gargantext.Components.Forest.Tree.Node.Action.Share as Share import Gargantext.Components.Forest.Tree.Node.Action.Share as Share
import Gargantext.Components.Forest.Tree.Node.Action.Contact as Contact
import Gargantext.Components.Forest.Tree.Node.Action.Update (updateRequest) import Gargantext.Components.Forest.Tree.Node.Action.Update (updateRequest)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile) import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile)
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..)) import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..))
...@@ -289,6 +290,7 @@ performAction (ShareTeam username) p@{ reload: (_ /\ setReload) ...@@ -289,6 +290,7 @@ performAction (ShareTeam username) p@{ reload: (_ /\ setReload)
do do
void $ Share.shareReq session id $ Share.ShareTeamParams {username} void $ Share.shareReq session id $ Share.ShareTeamParams {username}
performAction (SharePublic {params}) p@{ session performAction (SharePublic {params}) p@{ session
, openNodes: (_ /\ setOpenNodes) , openNodes: (_ /\ setOpenNodes)
} = } =
...@@ -299,6 +301,15 @@ performAction (SharePublic {params}) p@{ session ...@@ -299,6 +301,15 @@ performAction (SharePublic {params}) p@{ session
liftEffect $ setOpenNodes (Set.insert (mkNodeId session out)) liftEffect $ setOpenNodes (Set.insert (mkNodeId session out))
performAction RefreshTree p performAction RefreshTree p
performAction (AddContact params) p@{ reload: (_ /\ setReload)
, session
, tree: (NTree (LNode {id}) _)
} =
void $ Contact.contactReq session id params
------- -------
performAction (AddNode name nodeType) p@{ openNodes: (_ /\ setOpenNodes) performAction (AddNode name nodeType) p@{ openNodes: (_ /\ setOpenNodes)
, reload: (_ /\ setReload) , reload: (_ /\ setReload)
......
...@@ -9,7 +9,7 @@ import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut, S ...@@ -9,7 +9,7 @@ import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut, S
import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction(..), glyphiconNodeAction) import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction(..), glyphiconNodeAction)
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType, UploadFileContents) import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType, UploadFileContents)
import Gargantext.Components.Forest.Tree.Node.Action.Update.Types (UpdateNodeParams) import Gargantext.Components.Forest.Tree.Node.Action.Update.Types (UpdateNodeParams)
import Gargantext.Components.Forest.Tree.Node.Action.Contact.Types (AddContactParams)
type Props = type Props =
( dispatch :: Action -> Aff Unit ( dispatch :: Action -> Aff Unit
...@@ -29,6 +29,7 @@ data Action = AddNode String GT.NodeType ...@@ -29,6 +29,7 @@ data Action = AddNode String GT.NodeType
| RefreshTree | RefreshTree
| ShareTeam String | ShareTeam String
| AddContact AddContactParams
| SharePublic {params :: Maybe SubTreeOut} | SharePublic {params :: Maybe SubTreeOut}
| MoveNode {params :: Maybe SubTreeOut} | MoveNode {params :: Maybe SubTreeOut}
| MergeNode {params :: Maybe SubTreeOut} | MergeNode {params :: Maybe SubTreeOut}
...@@ -58,6 +59,7 @@ instance showShow :: Show Action where ...@@ -58,6 +59,7 @@ instance showShow :: Show Action where
show (RenameNode _ )= "RenameNode" show (RenameNode _ )= "RenameNode"
show (UpdateNode _ )= "UpdateNode" show (UpdateNode _ )= "UpdateNode"
show (ShareTeam _ )= "ShareTeam" show (ShareTeam _ )= "ShareTeam"
show (AddContact _ )= "AddContact"
show (SharePublic _ )= "SharePublic" show (SharePublic _ )= "SharePublic"
show (DoSearch _ )= "SearchQuery" show (DoSearch _ )= "SearchQuery"
show (UploadFile _ _ _ _)= "UploadFile" show (UploadFile _ _ _ _)= "UploadFile"
...@@ -75,6 +77,7 @@ icon (DeleteNode _) = glyphiconNodeAction Delete ...@@ -75,6 +77,7 @@ icon (DeleteNode _) = glyphiconNodeAction Delete
icon (RenameNode _) = glyphiconNodeAction Config icon (RenameNode _) = glyphiconNodeAction Config
icon (UpdateNode _) = glyphiconNodeAction Refresh icon (UpdateNode _) = glyphiconNodeAction Refresh
icon (ShareTeam _) = glyphiconNodeAction Share icon (ShareTeam _) = glyphiconNodeAction Share
icon (AddContact _) = glyphiconNodeAction Share
icon (SharePublic _ ) = glyphiconNodeAction (Publish { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }}) icon (SharePublic _ ) = glyphiconNodeAction (Publish { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (DoSearch _) = glyphiconNodeAction SearchBox icon (DoSearch _) = glyphiconNodeAction SearchBox
icon (UploadFile _ _ _ _) = glyphiconNodeAction Upload icon (UploadFile _ _ _ _) = glyphiconNodeAction Upload
...@@ -94,6 +97,7 @@ text (DeleteNode _ )= "Delete !" ...@@ -94,6 +97,7 @@ text (DeleteNode _ )= "Delete !"
text (RenameNode _ )= "Rename !" text (RenameNode _ )= "Rename !"
text (UpdateNode _ )= "Update !" text (UpdateNode _ )= "Update !"
text (ShareTeam _ )= "Share with team !" text (ShareTeam _ )= "Share with team !"
text (AddContact _ )= "Add contact !"
text (SharePublic _ )= "Publish !" text (SharePublic _ )= "Publish !"
text (DoSearch _ )= "Launch search !" text (DoSearch _ )= "Launch search !"
text (UploadFile _ _ _ _)= "Upload File !" text (UploadFile _ _ _ _)= "Upload File !"
......
module Gargantext.Components.Forest.Tree.Node.Action.Contact where
import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff)
import Effect.Uncurried (mkEffectFn1)
import Gargantext.Components.Forest.Tree.Node.Action (Action)
import Gargantext.Components.Forest.Tree.Node.Action.Contact.Types (AddContactParams(..))
-- import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Prelude (Unit, bind, const, discard, pure, (<<<), (<>))
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
import Gargantext.Types (ID)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Prelude (($))
import Reactix as R
import Reactix.DOM.HTML as H
------------------------------------------------------------------------
contactReq :: Session -> ID -> AddContactParams -> Aff ID
contactReq session nodeId =
post session $ GR.NodeAPI GT.Annuaire (Just nodeId) "contact"
------------------------------------------------------------------------
type TextInputBoxProps =
( id :: ID
, dispatch :: Action -> Aff Unit
, params :: Record AddContactProps
, isOpen :: R.State Boolean
, boxName :: String
, boxAction :: AddContactParams -> Action
)
type AddContactProps = ( firstname :: String, lastname :: String)
textInputBox :: Record TextInputBoxProps -> R.Element
textInputBox p@{ boxName, boxAction, dispatch, isOpen: (true /\ setIsOpen), params } = R.createElement el p []
where
{firstname, lastname} = params
el = R.hooksComponent (boxName <> "Box") cpt
cpt {id, params:params'} _ = do
let {firstname, lastname} = params'
stateFirstname <- R.useState' firstname
stateLastname <- R.useState' lastname
pure $ H.div {className: "from-group row-no-padding"}
[ textInput stateFirstname firstname
, textInput stateLastname lastname
, submitBtn stateFirstname stateLastname
, cancelBtn
]
where
textInput (_ /\ set) default =
H.div {className: "col-md-8"}
[ H.input { type: "text"
, placeholder: (boxName <> " Node")
, defaultValue: default
, className: "form-control"
, onInput: mkEffectFn1 $ set
<<< const
<<< R2.unsafeEventValue
}
]
submitBtn (val1 /\ _) (val2 /\ _) =
H.a {className: "btn glyphitem glyphicon glyphicon-ok col-md-2 pull-left"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> do
setIsOpen $ const false
launchAff $ dispatch ( boxAction (AddContactParams {firstname:val1, lastname:val2} ))
, title: "Submit"
} []
cancelBtn =
H.a {className: "btn text-danger glyphitem glyphicon glyphicon-remove col-md-2 pull-left"
, type: "button"
, onClick: mkEffectFn1 $ \_ -> setIsOpen $ const false
, title: "Cancel"
} []
textInputBox p@{ boxName, isOpen: (false /\ _) } = R.createElement el p []
where
el = R.hooksComponent (boxName <> "Box") cpt
cpt {} _ = pure $ H.div {} []
module Gargantext.Components.Forest.Tree.Node.Action.Contact.Types where
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Prelude (($))
import Reactix as R
import Gargantext.Types as GT
import Gargantext.Types (ID)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Gargantext.Prelude
import Gargantext.Sessions (Session, put_)
import Gargantext.Types as GT
import Reactix as R
import Reactix.DOM.HTML as H
import Data.Argonaut as Argonaut
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson, genericEnumDecodeJson, genericEnumEncodeJson)
import Data.Maybe (Maybe(..))
import Gargantext.Prelude (class Eq, class Read, class Show)
------------------------------------------------------------------------
data AddContactParams =
AddContactParams { firstname :: String
, lastname :: String
}
derive instance eqAddContactParams :: Eq AddContactParams
derive instance genericAddContactParams :: Generic AddContactParams _
instance showAddContactParams :: Show AddContactParams where
show = genericShow
instance decodeJsonAddContactParams :: Argonaut.DecodeJson AddContactParams where
decodeJson = genericSumDecodeJson
instance encodeJsonAddContactParams :: Argonaut.EncodeJson AddContactParams where
encodeJson = genericSumEncodeJson
------------------------------------------------------------------------
...@@ -16,7 +16,7 @@ import Reactix.DOM.HTML as H ...@@ -16,7 +16,7 @@ import Reactix.DOM.HTML as H
linkNodeReq :: Session -> GT.ID -> GT.ID -> Aff (Array GT.ID) linkNodeReq :: Session -> GT.ID -> GT.ID -> Aff (Array GT.ID)
linkNodeReq session fromId toId = linkNodeReq session fromId toId =
put_ session $ NodeAPI GT.Node (Just fromId) ("link/" <> show toId) put_ session $ NodeAPI GT.Node (Just fromId) ("pairWith/" <> show toId)
linkNode :: Record SubTreeParamsIn -> R.Element linkNode :: Record SubTreeParamsIn -> R.Element
linkNode p = R.createElement linkNodeCpt p [] linkNode p = R.createElement linkNodeCpt p []
......
...@@ -24,7 +24,7 @@ newtype RenameValue = RenameValue ...@@ -24,7 +24,7 @@ newtype RenameValue = RenameValue
instance encodeJsonRenameValue :: EncodeJson RenameValue where instance encodeJsonRenameValue :: EncodeJson RenameValue where
encodeJson (RenameValue {text}) encodeJson (RenameValue {text})
= "r_name" := text = "name" := text
~> jsonEmptyObject ~> jsonEmptyObject
------------------------------------------------------------------------ ------------------------------------------------------------------------
module Gargantext.Components.Forest.Tree.Node.Action.Share where module Gargantext.Components.Forest.Tree.Node.Action.Share where
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>)) import Data.Argonaut as Argonaut
import Data.Maybe (Maybe(..)) import Data.Generic.Rep (class Generic)
import Effect.Aff (Aff) import Data.Generic.Rep.Show (genericShow)
import Prelude (($))
import Reactix as R
import Gargantext.Components.Forest.Tree.Node.Action (Action)
import Gargantext.Components.Forest.Tree.Node.Action as Action
import Gargantext.Types as GT
import Gargantext.Types (ID)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
import Gargantext.Components.Forest.Tree.Node.Tools as Tools
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Components.Forest.Tree.Node.Action (Action) import Gargantext.Components.Forest.Tree.Node.Action (Action)
import Gargantext.Components.Forest.Tree.Node.Action as Action import Gargantext.Components.Forest.Tree.Node.Action as Action
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel) import Gargantext.Components.Forest.Tree.Node.Tools as Tools
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn) import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Prelude import Gargantext.Prelude (class Eq, class Show, bind, pure)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes as GR
import Gargantext.Sessions (Session, put_) import Gargantext.Sessions (Session, post)
import Gargantext.Types (ID)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson)
import Prelude (($))
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Data.Argonaut as Argonaut
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson, genericEnumDecodeJson, genericEnumEncodeJson)
import Data.Maybe (Maybe(..))
import Gargantext.Prelude (class Eq, class Read, class Show)
------------------------------------------------------------------------ ------------------------------------------------------------------------
shareReq :: Session -> ID -> ShareNodeParams -> Aff ID shareReq :: Session -> ID -> ShareNodeParams -> Aff ID
shareReq session nodeId = shareReq session nodeId =
...@@ -76,11 +62,11 @@ shareNodeCpt = R.hooksComponent "G.C.F.T.N.A.M.shareNode" cpt ...@@ -76,11 +62,11 @@ shareNodeCpt = R.hooksComponent "G.C.F.T.N.A.M.shareNode" cpt
let button = case valAction of let button = case valAction of
Action.SharePublic {params} -> case params of Action.SharePublic {params} -> case params of
Just val -> submitButton (Action.SharePublic {params: Just val}) dispatch Just val -> Tools.submitButton (Action.SharePublic {params: Just val}) dispatch
Nothing -> H.div {} [] Nothing -> H.div {} []
_ -> H.div {} [] _ -> H.div {} []
pure $ panel [ subTreeView { action pure $ Tools.panel [ subTreeView { action
, dispatch , dispatch
, id , id
, nodeType , nodeType
......
...@@ -34,6 +34,11 @@ actionUpload NodeList id session dispatch = ...@@ -34,6 +34,11 @@ actionUpload NodeList id session dispatch =
actionUpload Corpus id session dispatch = actionUpload Corpus id session dispatch =
pure $ uploadFileView {dispatch, id, nodeType: Corpus, session} pure $ uploadFileView {dispatch, id, nodeType: Corpus, session}
{-
actionUpload Annuaire id session dispatch =
pure $ uploadFileView {dispatch, id, nodeType: Annuaire, session}
-}
actionUpload _ _ _ _ = actionUpload _ _ _ _ =
pure $ fragmentPT $ "Soon, upload for this NodeType." pure $ fragmentPT $ "Soon, upload for this NodeType."
...@@ -276,7 +281,11 @@ uploadFile session nodeType id fileType {mName, contents: UploadFileContents con ...@@ -276,7 +281,11 @@ uploadFile session nodeType id fileType {mName, contents: UploadFileContents con
where where
q = FileUploadQuery { fileType: fileType } q = FileUploadQuery { fileType: fileType }
--p = NodeAPI GT.Corpus (Just id) $ "add/file/async/nobody" <> Q.print (toQuery q) --p = NodeAPI GT.Corpus (Just id) $ "add/file/async/nobody" <> Q.print (toQuery q)
p = GR.NodeAPI nodeType (Just id) $ GT.asyncTaskTypePath GT.Form p = case nodeType of
Corpus -> GR.NodeAPI nodeType (Just id) $ GT.asyncTaskTypePath GT.Form
Annuaire -> GR.NodeAPI nodeType (Just id) "annuaire"
_ -> GR.NodeAPI nodeType (Just id) ""
bodyParams = [ Tuple "_wf_data" (Just contents) bodyParams = [ Tuple "_wf_data" (Just contents)
, Tuple "_wf_filetype" (Just $ show fileType) , Tuple "_wf_filetype" (Just $ show fileType)
, Tuple "_wf_name" mName , Tuple "_wf_name" mName
......
...@@ -11,7 +11,7 @@ import Reactix as R ...@@ -11,7 +11,7 @@ import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action (Action) import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup(..), addNodeView) import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup(..), addNodeView)
import Gargantext.Components.Forest.Tree.Node.Action.Delete (actionDelete) import Gargantext.Components.Forest.Tree.Node.Action.Delete (actionDelete)
import Gargantext.Components.Forest.Tree.Node.Action.Documentation (actionDoc) import Gargantext.Components.Forest.Tree.Node.Action.Documentation (actionDoc)
...@@ -20,6 +20,7 @@ import Gargantext.Components.Forest.Tree.Node.Action.Rename (renameAction) ...@@ -20,6 +20,7 @@ import Gargantext.Components.Forest.Tree.Node.Action.Rename (renameAction)
import Gargantext.Components.Forest.Tree.Node.Action.Search (actionSearch) import Gargantext.Components.Forest.Tree.Node.Action.Search (actionSearch)
import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField (defaultSearch) import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField (defaultSearch)
import Gargantext.Components.Forest.Tree.Node.Action.Share as Share import Gargantext.Components.Forest.Tree.Node.Action.Share as Share
import Gargantext.Components.Forest.Tree.Node.Action.Contact as Contact
import Gargantext.Components.Forest.Tree.Node.Action.Update (update) import Gargantext.Components.Forest.Tree.Node.Action.Update (update)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (actionUpload) import Gargantext.Components.Forest.Tree.Node.Action.Upload (actionUpload)
import Gargantext.Components.Forest.Tree.Node.Action.Move (moveNode) import Gargantext.Components.Forest.Tree.Node.Action.Move (moveNode)
...@@ -298,6 +299,18 @@ panelActionCpt = R.hooksComponent "G.C.F.T.N.B.panelAction" cpt ...@@ -298,6 +299,18 @@ panelActionCpt = R.hooksComponent "G.C.F.T.N.B.panelAction" cpt
} }
] ]
cpt {action : AddingContact, dispatch, id, name } _ = do
isOpen <- R.useState' true
pure $ Contact.textInputBox { id
, dispatch
, isOpen
, boxName:"addContact"
, params : {firstname:"First Name", lastname: "Last Name"}
, boxAction: \p -> AddContact p
}
cpt {action : Publish {subTreeParams}, dispatch, id, nodeType, session } _ = do cpt {action : Publish {subTreeParams}, dispatch, id, nodeType, session } _ = do
pure $ Share.shareNode {dispatch, id, nodeType, session, subTreeParams} pure $ Share.shareNode {dispatch, id, nodeType, session, subTreeParams}
......
...@@ -26,6 +26,7 @@ data NodeAction = Documentation NodeType ...@@ -26,6 +26,7 @@ data NodeAction = Documentation NodeType
| Move { subTreeParams :: SubTreeParams } | Move { subTreeParams :: SubTreeParams }
| Link { subTreeParams :: SubTreeParams } | Link { subTreeParams :: SubTreeParams }
| Clone | Clone
| AddingContact
------------------------------------------------------------------------ ------------------------------------------------------------------------
instance eqNodeAction :: Eq NodeAction where instance eqNodeAction :: Eq NodeAction where
...@@ -43,6 +44,7 @@ instance eqNodeAction :: Eq NodeAction where ...@@ -43,6 +44,7 @@ instance eqNodeAction :: Eq NodeAction where
eq (Merge x) (Merge y) = x == y eq (Merge x) (Merge y) = x == y
eq Config Config = true eq Config Config = true
eq (Publish x) (Publish y) = x == y eq (Publish x) (Publish y) = x == y
eq AddingContact AddingContact = true
eq _ _ = false eq _ _ = false
instance showNodeAction :: Show NodeAction where instance showNodeAction :: Show NodeAction where
...@@ -60,6 +62,7 @@ instance showNodeAction :: Show NodeAction where ...@@ -60,6 +62,7 @@ instance showNodeAction :: Show NodeAction where
show (Add xs) = foldl (\a b -> a <> show b) "Add " xs show (Add xs) = foldl (\a b -> a <> show b) "Add " xs
show (Merge t) = "Merge with subtree" <> show t show (Merge t) = "Merge with subtree" <> show t
show (Publish x) = "Publish" <> show x show (Publish x) = "Publish" <> show x
show AddingContact = "AddingContact"
glyphiconNodeAction :: NodeAction -> String glyphiconNodeAction :: NodeAction -> String
glyphiconNodeAction (Documentation _) = "question-circle" glyphiconNodeAction (Documentation _) = "question-circle"
...@@ -73,6 +76,7 @@ glyphiconNodeAction (Merge _) = "random" ...@@ -73,6 +76,7 @@ glyphiconNodeAction (Merge _) = "random"
glyphiconNodeAction Refresh = "refresh" glyphiconNodeAction Refresh = "refresh"
glyphiconNodeAction Config = "wrench" glyphiconNodeAction Config = "wrench"
glyphiconNodeAction Share = "user-plus" glyphiconNodeAction Share = "user-plus"
glyphiconNodeAction AddingContact = "user-plus"
glyphiconNodeAction (Move _) = "share-square-o" glyphiconNodeAction (Move _) = "share-square-o"
glyphiconNodeAction (Publish _) = fldr FolderPublic true glyphiconNodeAction (Publish _) = fldr FolderPublic true
glyphiconNodeAction _ = "" glyphiconNodeAction _ = ""
...@@ -184,7 +188,7 @@ settingsBox Texts = ...@@ -184,7 +188,7 @@ settingsBox Texts =
, buttons : [ Refresh , buttons : [ Refresh
, Upload , Upload
, Download , Download
-- , Delete , Delete
] ]
} }
...@@ -265,6 +269,7 @@ settingsBox Annuaire = ...@@ -265,6 +269,7 @@ settingsBox Annuaire =
, edit : true , edit : true
, doc : Documentation Annuaire , doc : Documentation Annuaire
, buttons : [ Upload , buttons : [ Upload
, AddingContact
, Move moveParameters , Move moveParameters
, Delete , Delete
] ]
......
...@@ -3,7 +3,7 @@ module Gargantext.Components.GraphExplorer.Sidebar ...@@ -3,7 +3,7 @@ module Gargantext.Components.GraphExplorer.Sidebar
where where
import Control.Parallel (parTraverse) import Control.Parallel (parTraverse)
import Data.Array (head, last) import Data.Array (head, last, concat)
import Data.Int (fromString) import Data.Int (fromString)
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..), fromJust) import Data.Maybe (Maybe(..), fromJust)
...@@ -14,6 +14,7 @@ import Data.Tuple.Nested ((/\)) ...@@ -14,6 +14,7 @@ import Data.Tuple.Nested ((/\))
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff_) import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Gargantext.Components.Search (SearchType(..), SearchQuery(..))
import Gargantext.Components.GraphExplorer.Types as GET import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.GraphExplorer.Types (SidePanelState(..), SideTab(..)) import Gargantext.Components.GraphExplorer.Types (SidePanelState(..), SideTab(..))
import Gargantext.Components.GraphExplorer.Legend as Legend import Gargantext.Components.GraphExplorer.Legend as Legend
...@@ -102,7 +103,8 @@ sideTab (Opened SideTabData) props = ...@@ -102,7 +103,8 @@ sideTab (Opened SideTabData) props =
] ]
, RH.div { className: "col-md-12", id: "query" } , RH.div { className: "col-md-12", id: "query" }
[ query props.frontends [ query SearchDoc
props.frontends
props.metaData props.metaData
props.session props.session
nodesMap nodesMap
...@@ -149,11 +151,19 @@ sideTab (Opened SideTabData) props = ...@@ -149,11 +151,19 @@ sideTab (Opened SideTabData) props =
snd props'.selectedNodeIds $ const SigmaxT.emptyNodeIds snd props'.selectedNodeIds $ const SigmaxT.emptyNodeIds
sideTab (Opened SideTabCommunity) props =
RH.div { className: "col-md-12", id: "query" }
[ query SearchContact
props.frontends
props.metaData
props.session
(SigmaxT.nodesGraphMap props.graph)
props.selectedNodeIds
]
sideTab _ _ = H.div {} [] sideTab _ _ = H.div {} []
------------------------------------------- -------------------------------------------
badge :: R.State SigmaxT.NodeIds -> Record SigmaxT.Node -> R.Element badge :: R.State SigmaxT.NodeIds -> Record SigmaxT.Node -> R.Element
badge (_ /\ setNodeIds) {id, label} = badge (_ /\ setNodeIds) {id, label} =
...@@ -192,7 +202,11 @@ deleteNodes { graphId, metaData, nodes, session, termList, treeReload } = do ...@@ -192,7 +202,11 @@ deleteNodes { graphId, metaData, nodes, session, termList, treeReload } = do
Just (NTC.Versioned patch) -> do Just (NTC.Versioned patch) -> do
liftEffect $ snd treeReload $ (+) 1 liftEffect $ snd treeReload $ (+) 1
deleteNode :: TermList -> Session -> GET.MetaData -> Record SigmaxT.Node -> Aff NTC.VersionedNgramsPatches deleteNode :: TermList
-> Session
-> GET.MetaData
-> Record SigmaxT.Node
-> Aff NTC.VersionedNgramsPatches
deleteNode termList session (GET.MetaData metaData) node = NTC.putNgramsPatches coreParams versioned deleteNode termList session (GET.MetaData metaData) node = NTC.putNgramsPatches coreParams versioned
where where
nodeId :: Int nodeId :: Int
...@@ -222,15 +236,24 @@ deleteNode termList session (GET.MetaData metaData) node = NTC.putNgramsPatches ...@@ -222,15 +236,24 @@ deleteNode termList session (GET.MetaData metaData) node = NTC.putNgramsPatches
patch_list :: NTC.Replace TermList patch_list :: NTC.Replace TermList
patch_list = NTC.Replace { new: termList, old: MapTerm } patch_list = NTC.Replace { new: termList, old: MapTerm }
query :: Frontends -> GET.MetaData -> Session -> SigmaxT.NodesMap -> R.State SigmaxT.NodeIds -> R.Element query :: SearchType
query _ _ _ _ (selectedNodeIds /\ _) | Set.isEmpty selectedNodeIds = RH.div {} [] -> Frontends
query frontends (GET.MetaData metaData) session nodesMap (selectedNodeIds /\ _) = -> GET.MetaData
-> Session
-> SigmaxT.NodesMap
-> R.State SigmaxT.NodeIds
-> R.Element
query _ _ _ _ _ (selectedNodeIds /\ _) | Set.isEmpty selectedNodeIds = RH.div {} []
query searchType frontends (GET.MetaData metaData) session nodesMap (selectedNodeIds /\ _) =
query' (head metaData.corpusId) query' (head metaData.corpusId)
where where
query' Nothing = RH.div {} [] query' Nothing = RH.div {} []
query' (Just corpusId) = CGT.tabs { frontends query' (Just corpusId) =
CGT.tabs { frontends
, session , session
, query: toQuery <$> Set.toUnfoldable selectedNodeIds , query: SearchQuery { query : concat $ toQuery <$> Set.toUnfoldable selectedNodeIds
, expected: searchType
}
, sides: [side corpusId] , sides: [side corpusId]
} }
...@@ -255,5 +278,3 @@ query frontends (GET.MetaData metaData) session nodesMap (selectedNodeIds /\ _) ...@@ -255,5 +278,3 @@ query frontends (GET.MetaData metaData) session nodesMap (selectedNodeIds /\ _)
] ]
-} -}
module Gargantext.Components.Nodes.Annuaire where module Gargantext.Components.Nodes.Annuaire where
import Prelude (bind, const, identity, pure, ($), (<$>), (<>))
import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?)) import Data.Argonaut (class DecodeJson, decodeJson, (.:), (.:?))
import Data.Array as A import Data.Array as A
import Data.List as L import Data.List as L
...@@ -8,17 +7,17 @@ import Data.Maybe (Maybe(..), maybe, fromMaybe) ...@@ -8,17 +7,17 @@ import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Data.Tuple (fst, snd) import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types as CT import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types as CT
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Ends (url, Frontends) import Gargantext.Ends (url, Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..)) import Gargantext.Routes (SessionRoute(..))
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId, get) import Gargantext.Sessions (Session, sessionId, get)
import Gargantext.Types (NodeType(..), AffTableResult, TableResult) import Gargantext.Types (NodeType(..), AffTableResult, TableResult)
import Gargantext.Hooks.Loader (useLoader) import Prelude (bind, const, identity, pure, ($), (<$>), (<>))
import Reactix as R
import Reactix.DOM.HTML as H
newtype IndividuView = newtype IndividuView =
CorpusView CorpusView
...@@ -102,7 +101,7 @@ type PageProps = ...@@ -102,7 +101,7 @@ type PageProps =
, frontends :: Frontends , frontends :: Frontends
, pagePath :: R.State PagePath , pagePath :: R.State PagePath
-- , info :: AnnuaireInfo -- , info :: AnnuaireInfo
, table :: TableResult CT.Contact , table :: TableResult CT.NodeContact
) )
page :: Record PageProps -> R.Element page :: Record PageProps -> R.Element
...@@ -123,7 +122,7 @@ pageCpt = R.hooksComponent "LoadedAnnuairePage" cpt ...@@ -123,7 +122,7 @@ pageCpt = R.hooksComponent "LoadedAnnuairePage" cpt
, session } , session }
, delete: false }) <$> L.fromFoldable docs , delete: false }) <$> L.fromFoldable docs
container = T.defaultContainer { title: "Annuaire" } -- TODO container = T.defaultContainer { title: "Annuaire" } -- TODO
colNames = T.ColumnName <$> [ "", "Name", "Company", "Service", "Role"] colNames = T.ColumnName <$> [ "", "First Name", "Last Name", "Company", "Lab", "Role"]
wrapColElts = const identity wrapColElts = const identity
setParams f = snd pagePath $ \pp@{params: ps} -> setParams f = snd pagePath $ \pp@{params: ps} ->
pp {params = f ps} pp {params = f ps}
...@@ -132,9 +131,8 @@ pageCpt = R.hooksComponent "LoadedAnnuairePage" cpt ...@@ -132,9 +131,8 @@ pageCpt = R.hooksComponent "LoadedAnnuairePage" cpt
type AnnuaireId = Int type AnnuaireId = Int
type ContactCellsProps = type ContactCellsProps =
( ( annuaireId :: AnnuaireId
annuaireId :: AnnuaireId , contact :: CT.NodeContact
, contact :: CT.Contact
, frontends :: Frontends , frontends :: Frontends
, session :: Session , session :: Session
) )
...@@ -146,32 +144,41 @@ contactCellsCpt :: R.Component ContactCellsProps ...@@ -146,32 +144,41 @@ contactCellsCpt :: R.Component ContactCellsProps
contactCellsCpt = R.hooksComponent "G.C.N.A.contactCells" cpt contactCellsCpt = R.hooksComponent "G.C.N.A.contactCells" cpt
where where
cpt { annuaireId cpt { annuaireId
, contact: (CT.Contact { id, hyperdata: (CT.HyperdataUser {shared: Nothing}) }) , contact: (CT.NodeContact { id, hyperdata: (CT.HyperdataContact {who : Nothing}) })
, frontends , frontends
, session } _ = , session } _ =
pure $ T.makeRow [ pure $ T.makeRow [ H.text ""
H.text "" , H.span {} [ H.text "Name" ]
, H.span {} [ H.text "name" ]
--, H.a { href, target: "blank" } [ H.text $ fromMaybe "name" contact.title ] --, H.a { href, target: "blank" } [ H.text $ fromMaybe "name" contact.title ]
, H.text "No ContactWhere" , H.text "No ContactWhere"
, H.text "No ContactWhereDept" , H.text "No ContactWhereDept"
, H.div {className: "nooverflow"} , H.div { className: "nooverflow"}
[ H.text "No ContactWhereRole" ] [ H.text "No ContactWhereRole" ]
] ]
cpt { annuaireId cpt { annuaireId
, contact: (CT.Contact { id , contact: (CT.NodeContact { id
, hyperdata: (CT.HyperdataUser {shared: Just (CT.HyperdataContact contact@{who, ou})}) }) , hyperdata: ( CT.HyperdataContact { who : Just (CT.ContactWho { firstName
, lastName
}
)
}
)
}
)
, frontends , frontends
, session } _ = , session } _ = do
pure $ T.makeRow [ pure $ T.makeRow [
H.text "" H.text ""
, H.a { href } [ H.text $ fromMaybe "name" contact.title ] , H.text $ fromMaybe "First Name" firstName
, H.text $ fromMaybe "First Name" lastName
, H.text "CNRS"
-- , H.a { href } [ H.text $ fromMaybe "name" contact.title ]
--, H.a { href, target: "blank" } [ H.text $ fromMaybe "name" contact.title ] --, H.a { href, target: "blank" } [ H.text $ fromMaybe "name" contact.title ]
, H.text $ maybe "No ContactWhere" contactWhereOrg (A.head $ ou) --, H.text $ maybe "No ContactWhere" contactWhereOrg (A.head $ ou)
, H.text $ maybe "No ContactWhereDept" contactWhereDept (A.head $ ou) -- , H.text $ maybe "No ContactWhereDept" contactWhereDept (A.head $ ou)
, H.div {className: "nooverflow"} [ -- , H.div {className: "nooverflow"} [
H.text $ maybe "No ContactWhereRole" contactWhereRole (A.head $ ou) -- H.text $ maybe "No ContactWhereRole" contactWhereRole (A.head $ ou)
]
] ]
where where
--nodepath = NodePath (sessionId session) NodeContact (Just id) --nodepath = NodePath (sessionId session) NodeContact (Just id)
...@@ -238,7 +245,7 @@ instance decodeAnnuaireInfo :: DecodeJson AnnuaireInfo where ...@@ -238,7 +245,7 @@ instance decodeAnnuaireInfo :: DecodeJson AnnuaireInfo where
------------------------------------------------------------------------ ------------------------------------------------------------------------
loadPage :: Session -> PagePath -> AffTableResult CT.Contact loadPage :: Session -> PagePath -> AffTableResult CT.NodeContact
loadPage session {nodeId, params: { offset, limit, orderBy }} = loadPage session {nodeId, params: { offset, limit, orderBy }} =
get session children get session children
-- TODO orderBy -- TODO orderBy
......
...@@ -4,26 +4,25 @@ module Gargantext.Components.Nodes.Annuaire.User.Contacts ...@@ -4,26 +4,25 @@ module Gargantext.Components.Nodes.Annuaire.User.Contacts
, userLayout ) , userLayout )
where where
import DOM.Simple.Console (log2)
import Data.Lens as L import Data.Lens as L
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (Tuple(..), fst, snd) import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect) import Effect (Effect)
import Effect.Class (liftEffect)
import Effect.Aff (Aff, launchAff_) import Effect.Aff (Aff, launchAff_)
import Reactix as R import Effect.Class (liftEffect)
import Reactix.DOM.HTML as H
import Gargantext.Prelude (Unit, bind, const, discard, pure, show, unit, ($), (+), (<$>), (<<<), (<>), (==))
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (Contact(..), ContactData, ContactTouch(..), ContactWhere(..), ContactWho(..), HyperdataContact(..), HyperdataUser(..), _city, _country, _firstName, _labTeamDeptsJoinComma, _lastName, _mail, _office, _organizationJoinComma, _ouFirst, _phone, _role, _shared, _touch, _who, defaultContactTouch, defaultContactWhere, defaultContactWho, defaultHyperdataContact, defaultHyperdataUser)
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs import Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs as Tabs
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (Contact(..), ContactData, ContactTouch(..), ContactWhere(..), ContactWho(..), HyperdataContact(..), HyperdataUser(..), _city, _country, _firstName, _labTeamDeptsJoinComma, _lastName, _mail, _office, _organizationJoinComma, _ouFirst, _phone, _role, _shared, _touch, _who, defaultContactTouch, defaultContactWhere, defaultContactWho, defaultHyperdataContact, defaultHyperdataUser)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader) import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Unit, bind, const, discard, pure, show, unit, ($), (+), (<$>), (<<<), (<>), (==))
import Gargantext.Routes as Routes import Gargantext.Routes as Routes
import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session, get, put) import Gargantext.Sessions (Session, get, put)
import Gargantext.Types (NodeType(..)) import Gargantext.Types (NodeType(..))
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
display :: String -> Array R.Element -> R.Element display :: String -> Array R.Element -> R.Element
display title elems = display title elems =
...@@ -68,8 +67,7 @@ contactInfoItems = ...@@ -68,8 +67,7 @@ contactInfoItems =
type HyperdataUserLens = L.ALens' HyperdataUser String type HyperdataUserLens = L.ALens' HyperdataUser String
type ContactInfoItemProps = type ContactInfoItemProps =
( ( hyperdata :: HyperdataUser
hyperdata :: HyperdataUser
, label :: String , label :: String
, lens :: HyperdataUserLens , lens :: HyperdataUserLens
, onUpdateHyperdata :: HyperdataUser -> Effect Unit , onUpdateHyperdata :: HyperdataUser -> Effect Unit
......
module Gargantext.Components.Nodes.Annuaire.User.Contacts.Types where module Gargantext.Components.Nodes.Annuaire.User.Contacts.Types where
import Prelude import Prelude (bind, pure, ($))
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, (.:), (.:!), (.:?), (:=), (~>), jsonEmptyObject)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (.:!), (.:?), (:=), (~>), jsonEmptyObject)
import Data.Array as A import Data.Array as A
import Data.Lens import Data.Lens
import Data.Maybe (Maybe(..), fromMaybe) import Data.Maybe (Maybe(..), fromMaybe)
import Data.Map (Map)
import Data.String as S import Data.String as S
import Data.Tuple (Tuple(..))
import Gargantext.Utils.DecodeMaybe ((.?|)) import Gargantext.Utils.DecodeMaybe ((.?|))
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
-- TODO: should it be a NodePoly HyperdataContact ? -- TODO: should it be a NodePoly HyperdataContact ?
newtype NodeContact =
NodeContact
{ id :: Int
, date :: Maybe String
, hyperdata :: HyperdataContact
, name :: Maybe String
, parentId :: Maybe Int
, typename :: Maybe Int
, userId :: Maybe Int
}
instance decodeNodeContact :: DecodeJson NodeContact where
decodeJson json = do
obj <- decodeJson json
date <- obj .?| "date"
hyperdata <- obj .: "hyperdata"
id <- obj .: "id"
name <- obj .:! "name"
parentId <- obj .?| "parentId"
typename <- obj .?| "typename"
userId <- obj .:! "userId"
pure $ NodeContact { id
, date
, hyperdata
, name
, parentId
, typename
, userId
}
derive instance newtypeNodeContact :: Newtype NodeContact _
newtype Contact = newtype Contact =
Contact Contact
{ id :: Int { id :: Int
...@@ -24,6 +56,8 @@ newtype Contact = ...@@ -24,6 +56,8 @@ newtype Contact =
, userId :: Maybe Int , userId :: Maybe Int
} }
instance decodeUser :: DecodeJson Contact where instance decodeUser :: DecodeJson Contact where
decodeJson json = do decodeJson json = do
obj <- decodeJson json obj <- decodeJson json
...@@ -35,8 +69,7 @@ instance decodeUser :: DecodeJson Contact where ...@@ -35,8 +69,7 @@ instance decodeUser :: DecodeJson Contact where
typename <- obj .?| "typename" typename <- obj .?| "typename"
userId <- obj .:! "userId" userId <- obj .:! "userId"
pure $ Contact { pure $ Contact { id
id
, date , date
, hyperdata , hyperdata
, name , name
...@@ -53,7 +86,8 @@ newtype ContactWho = ...@@ -53,7 +86,8 @@ newtype ContactWho =
, firstName :: Maybe String , firstName :: Maybe String
, lastName :: Maybe String , lastName :: Maybe String
, keywords :: (Array String) , keywords :: (Array String)
, freetags :: (Array String) } , freetags :: (Array String)
}
derive instance newtypeContactWho :: Newtype ContactWho _ derive instance newtypeContactWho :: Newtype ContactWho _
...@@ -214,7 +248,7 @@ instance decodeHyperdataContact :: DecodeJson HyperdataContact ...@@ -214,7 +248,7 @@ instance decodeHyperdataContact :: DecodeJson HyperdataContact
title <- obj .:? "title" title <- obj .:? "title"
uniqId <- obj .:? "uniqId" uniqId <- obj .:? "uniqId"
uniqIdBdd <- obj .:? "uniqIdBdd" uniqIdBdd <- obj .:? "uniqIdBdd"
who <- obj .:? "who" who <- obj .:! "who"
let ou' = fromMaybe [] ou let ou' = fromMaybe [] ou
...@@ -235,8 +269,7 @@ instance encodeHyperdataContact :: EncodeJson HyperdataContact ...@@ -235,8 +269,7 @@ instance encodeHyperdataContact :: EncodeJson HyperdataContact
defaultHyperdataContact :: HyperdataContact defaultHyperdataContact :: HyperdataContact
defaultHyperdataContact = defaultHyperdataContact =
HyperdataContact { HyperdataContact { bdd: Nothing
bdd: Nothing
, who: Nothing , who: Nothing
, ou: [] , ou: []
, title: Nothing , title: Nothing
...@@ -246,7 +279,6 @@ defaultHyperdataContact = ...@@ -246,7 +279,6 @@ defaultHyperdataContact =
, uniqIdBdd: Nothing , uniqIdBdd: Nothing
} }
newtype HyperdataUser = newtype HyperdataUser =
HyperdataUser { HyperdataUser {
shared :: Maybe HyperdataContact shared :: Maybe HyperdataContact
......
...@@ -13,6 +13,7 @@ import Reactix as R ...@@ -13,6 +13,7 @@ import Reactix as R
import Thermite (PerformAction, Render, Spec, simpleSpec, createClass) import Thermite (PerformAction, Render, Spec, simpleSpec, createClass)
import Gargantext.Components.AutoUpdate (autoUpdateElt) import Gargantext.Components.AutoUpdate (autoUpdateElt)
import Gargantext.Components.Search (SearchType(..))
import Gargantext.Components.Node (NodePoly(..)) import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.NgramsTable.Core import Gargantext.Components.NgramsTable.Core
( CoreState, NgramsPatch(..), NgramsTerm, Replace, Versioned(..) ( CoreState, NgramsPatch(..), NgramsTerm, Replace, Versioned(..)
...@@ -389,7 +390,7 @@ loadData {session, nodeId, listIds, tabType} = do ...@@ -389,7 +390,7 @@ loadData {session, nodeId, listIds, tabType} = do
{ session { session
, nodeId , nodeId
, listIds , listIds
, params: { offset : 0, limit : 100, orderBy: Nothing} , params: { offset : 0, limit : 100, orderBy: Nothing, searchType: SearchDoc}
, tabType , tabType
, searchQuery: "" , searchQuery: ""
, termListFilter: Nothing , termListFilter: Nothing
......
...@@ -5,7 +5,8 @@ import Data.Array (fromFoldable) ...@@ -5,7 +5,8 @@ import Data.Array (fromFoldable)
import Data.Tuple (Tuple(..), fst) import Data.Tuple (Tuple(..), fst)
import Reactix as R import Reactix as R
import Gargantext.Components.GraphExplorer.Types (GraphSideCorpus(..)) import Gargantext.Components.GraphExplorer.Types (GraphSideCorpus(..))
import Gargantext.Components.FacetsTable (TextQuery, docView) import Gargantext.Components.FacetsTable (docView)
import Gargantext.Components.Search (SearchQuery)
import Gargantext.Components.Table as T import Gargantext.Components.Table as T
import Gargantext.Components.Tab as Tab import Gargantext.Components.Tab as Tab
import Gargantext.Ends (Frontends) import Gargantext.Ends (Frontends)
...@@ -13,7 +14,7 @@ import Gargantext.Sessions (Session) ...@@ -13,7 +14,7 @@ import Gargantext.Sessions (Session)
type Props = type Props =
( frontends :: Frontends ( frontends :: Frontends
, query :: TextQuery , query :: SearchQuery
, session :: Session , session :: Session
, sides :: Array GraphSideCorpus , sides :: Array GraphSideCorpus
) )
...@@ -31,7 +32,7 @@ tabsCpt = R.hooksComponent "G.P.Corpus.Graph.Tabs.tabs" cpt ...@@ -31,7 +32,7 @@ tabsCpt = R.hooksComponent "G.P.Corpus.Graph.Tabs.tabs" cpt
where where
tabs' = fromFoldable $ tab frontends session query <$> sides tabs' = fromFoldable $ tab frontends session query <$> sides
tab :: Frontends -> Session -> TextQuery -> GraphSideCorpus -> Tuple String R.Element tab :: Frontends -> Session -> SearchQuery -> GraphSideCorpus -> Tuple String R.Element
tab frontends session query (GraphSideCorpus {corpusId: nodeId, corpusLabel, listId}) = tab frontends session query (GraphSideCorpus {corpusId: nodeId, corpusLabel, listId}) =
Tuple corpusLabel (docView dvProps) Tuple corpusLabel (docView dvProps)
where where
......
module Gargantext.Components.Search where
------------------------------------------------------------------------
import Data.Argonaut as Argonaut
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson, genericEnumDecodeJson, genericEnumEncodeJson)
import Gargantext.Components.Category (Category)
import Data.Maybe (Maybe(..))
import Gargantext.Prelude (class Eq, class Read, class Show)
-- Example:
-- [["machine","learning"],["artificial","intelligence"]]
-- This searches for documents with "machine learning" or "artificial intelligence"
type TextQuery = Array (Array String)
------------------------------------------------------------------------
data SearchType = SearchDoc | SearchContact
derive instance eqSearchType :: Eq SearchType
derive instance genericSearchType :: Generic SearchType _
instance showSearchType :: Show SearchType where
show = genericShow
instance decodeJsonSearchType :: Argonaut.DecodeJson SearchType where
decodeJson = genericEnumDecodeJson
instance encodeJsonSearchType :: Argonaut.EncodeJson SearchType where
encodeJson = genericEnumEncodeJson
------------------------------------------------------------------------
data SearchQuery =
SearchQuery { query :: Array String
, expected :: SearchType
}
derive instance eqSearchQuery :: Eq SearchQuery
derive instance genericSearchQuery :: Generic SearchQuery _
instance showSearchQuery :: Show SearchQuery where
show = genericShow
instance decodeJsonSearchQuery :: Argonaut.DecodeJson SearchQuery where
decodeJson = genericSumDecodeJson
instance encodeJsonSearchQuery :: Argonaut.EncodeJson SearchQuery where
encodeJson = genericSumEncodeJson
------------------------------------------------------------------------
------------------------------------------------------------------------
data SearchResult = SearchResult { result :: SearchResultTypes }
derive instance eqSearchResult :: Eq SearchResult
derive instance genericSearchResult :: Generic SearchResult _
instance showSearchResult :: Show SearchResult where
show = genericShow
instance decodeJsonSearchResult :: Argonaut.DecodeJson SearchResult where
decodeJson = genericSumDecodeJson
instance encodeJsonSearchResult :: Argonaut.EncodeJson SearchResult where
encodeJson = genericSumEncodeJson
------------------------------------------------------------------------
data SearchResultTypes =
SearchResultDoc { docs :: Array Document}
| SearchNoResult { message :: String }
| SearchResultContact { contacts :: Array Contact }
derive instance eqSearchResultTypes :: Eq SearchResultTypes
derive instance genericSearchResultTypes :: Generic SearchResultTypes _
instance showSearchResultTypes :: Show SearchResultTypes where
show = genericShow
instance decodeJsonSearchResultTypes :: Argonaut.DecodeJson SearchResultTypes where
decodeJson = genericSumDecodeJson
instance encodeJsonSearchResultTypes :: Argonaut.EncodeJson SearchResultTypes where
encodeJson = genericSumEncodeJson
------------------------------------------------------------------------
data Document =
Document { id :: Int
, created :: String
, title :: String
, hyperdata :: HyperdataRowDocument
, category :: Int
, score :: Int
}
derive instance eqDocument :: Eq Document
derive instance genericDocument :: Generic Document _
instance showDocument :: Show Document where
show = genericShow
instance decodeJsonDocument :: Argonaut.DecodeJson Document where
decodeJson = genericSumDecodeJson
instance encodeJsonDocument :: Argonaut.EncodeJson Document where
encodeJson = genericSumEncodeJson
------------------------------------------------------------------------
newtype HyperdataRowDocument =
HyperdataRowDocument { bdd :: Maybe String
, doi :: Maybe String
, url :: Maybe String
, uniqId :: Maybe String
, uniqIdBdd :: Maybe String
, page :: Maybe Int
, title :: Maybe String
, authors :: Maybe String
, institutes :: Maybe String
, source :: Maybe String
, abstract :: Maybe String
, publication_date :: Maybe String
, publication_year :: Maybe Int
, publication_month :: Maybe Int
, publication_day :: Maybe Int
, publication_hour :: Maybe Int
, publication_minute :: Maybe Int
, publication_second :: Maybe Int
, language_iso2 :: Maybe String
}
derive instance eqHyperdataRowDocument :: Eq HyperdataRowDocument
derive instance genericHyperdataRowDocument :: Generic HyperdataRowDocument _
instance showHyperdataRowDocument :: Show HyperdataRowDocument where
show = genericShow
instance decodeJsonHyperdataRowDocument :: Argonaut.DecodeJson HyperdataRowDocument where
decodeJson = genericSumDecodeJson
instance encodeJsonHyperdataRowDocument :: Argonaut.EncodeJson HyperdataRowDocument where
encodeJson = genericSumEncodeJson
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
data Contact =
Contact { c_id :: Int
, c_created :: String
, c_hyperdata :: HyperdataRowContact
, c_score :: Int
}
derive instance eqContact :: Eq Contact
derive instance genericContact :: Generic Contact _
instance showContact :: Show Contact where
show = genericShow
instance decodeJsonContact :: Argonaut.DecodeJson Contact where
decodeJson = genericSumDecodeJson
instance encodeJsonContact :: Argonaut.EncodeJson Contact where
encodeJson = genericSumEncodeJson
data HyperdataRowContact =
HyperdataRowContact { firstname :: String
, lastname :: String
, labs :: String
}
derive instance eqHyperdataRowContact :: Eq HyperdataRowContact
derive instance genericHyperdataRowContact :: Generic HyperdataRowContact _
instance showHyperdataRowContact :: Show HyperdataRowContact where
show = genericShow
instance decodeJsonHyperdataRowContact :: Argonaut.DecodeJson HyperdataRowContact where
decodeJson = genericSumDecodeJson
instance encodeJsonHyperdataRowContact :: Argonaut.EncodeJson HyperdataRowContact where
encodeJson = genericSumEncodeJson
data HyperdataContact =
HyperdataContact { bdd :: Maybe String
, who :: Maybe ContactWho
, "where" :: Array ContactWhere
, title :: Maybe String
, source :: Maybe String
, lastValidation :: Maybe String
, uniqIdBdd :: Maybe String
, uniqId :: Maybe String
}
derive instance eqHyperdataContact :: Eq HyperdataContact
derive instance genericHyperdataContact :: Generic HyperdataContact _
instance showHyperdataContact :: Show HyperdataContact where
show = genericShow
instance decodeJsonHyperdataContact :: Argonaut.DecodeJson HyperdataContact where
decodeJson = genericSumDecodeJson
instance encodeJsonHyperdataContact :: Argonaut.EncodeJson HyperdataContact where
encodeJson = genericSumEncodeJson
-------
data ContactWho =
ContactWho { id :: Maybe String
, firstName :: Maybe String
, lastName :: Maybe String
, keywords :: Array String
, freetags :: Array String
}
derive instance eqContactWho :: Eq ContactWho
derive instance genericContactWho :: Generic ContactWho _
instance showContactWho :: Show ContactWho where
show = genericShow
instance decodeJsonContactWho :: Argonaut.DecodeJson ContactWho where
decodeJson = genericSumDecodeJson
instance encodeJsonContactWho :: Argonaut.EncodeJson ContactWho where
encodeJson = genericSumEncodeJson
data ContactWhere =
ContactWhere { organization :: Array String
, labTeamDepts :: Array String
, role :: Maybe String
, office :: Maybe String
, country :: Maybe String
, city :: Maybe String
, touch :: Maybe ContactTouch
, entry :: Maybe String
, exit :: Maybe String
}
derive instance eqContactWhere :: Eq ContactWhere
derive instance genericContactWhere :: Generic ContactWhere _
instance showContactWhere :: Show ContactWhere where
show = genericShow
instance decodeJsonContactWhere :: Argonaut.DecodeJson ContactWhere where
decodeJson = genericSumDecodeJson
instance encodeJsonContactWhere :: Argonaut.EncodeJson ContactWhere where
encodeJson = genericSumEncodeJson
data ContactTouch =
ContactTouch { mail :: Maybe String
, phone :: Maybe String
, url :: Maybe String
}
derive instance eqContactTouch :: Eq ContactTouch
derive instance genericContactTouch :: Generic ContactTouch _
instance showContactTouch :: Show ContactTouch where
show = genericShow
instance decodeJsonContactTouch :: Argonaut.DecodeJson ContactTouch where
decodeJson = genericSumDecodeJson
instance encodeJsonContactTouch :: Argonaut.EncodeJson ContactTouch where
encodeJson = genericSumEncodeJson
...@@ -13,6 +13,7 @@ import Reactix as R ...@@ -13,6 +13,7 @@ import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reactix (effectLink) import Gargantext.Utils.Reactix (effectLink)
import Gargantext.Components.Search
type TableContainerProps = type TableContainerProps =
( pageSizeControl :: R.Element ( pageSizeControl :: R.Element
...@@ -27,7 +28,11 @@ type Rows = L.List Row ...@@ -27,7 +28,11 @@ type Rows = L.List Row
type OrderBy = Maybe (OrderByDirection ColumnName) type OrderBy = Maybe (OrderByDirection ColumnName)
type Params = { offset :: Int, limit :: Int, orderBy :: OrderBy } type Params = { offset :: Int
, limit :: Int
, orderBy :: OrderBy
, searchType :: SearchType
}
newtype ColumnName = ColumnName String newtype ColumnName = ColumnName String
...@@ -64,16 +69,17 @@ type State = ...@@ -64,16 +69,17 @@ type State =
{ page :: Int { page :: Int
, pageSize :: PageSizes , pageSize :: PageSizes
, orderBy :: OrderBy , orderBy :: OrderBy
, searchType :: SearchType
} }
paramsState :: Params -> State paramsState :: Params -> State
paramsState {offset, limit, orderBy} = {pageSize, page, orderBy} paramsState {offset, limit, orderBy, searchType} = {pageSize, page, orderBy, searchType}
where where
pageSize = int2PageSizes limit pageSize = int2PageSizes limit
page = offset / limit + 1 page = offset / limit + 1
stateParams :: State -> Params stateParams :: State -> Params
stateParams {pageSize, page, orderBy} = {offset, limit, orderBy} stateParams {pageSize, page, orderBy, searchType} = {offset, limit, orderBy, searchType}
where where
limit = pageSizes2Int pageSize limit = pageSizes2Int pageSize
offset = limit * (page - 1) offset = limit * (page - 1)
...@@ -87,7 +93,7 @@ type TableHeaderLayoutProps = ...@@ -87,7 +93,7 @@ type TableHeaderLayoutProps =
) )
initialParams :: Params initialParams :: Params
initialParams = stateParams {page: 1, pageSize: PS10, orderBy: Nothing} initialParams = stateParams {page: 1, pageSize: PS10, orderBy: Nothing, searchType: SearchDoc}
-- TODO: Not sure this is the right place for this -- TODO: Not sure this is the right place for this
tableHeaderLayout :: Record TableHeaderLayoutProps -> R.Element tableHeaderLayout :: Record TableHeaderLayoutProps -> R.Element
......
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