Skip to content

P
purescript-gargantext
Unverified Commit 652ae8e2 authored by Nicolas Pouillard's avatar Nicolas Pouillard
Browse files
Options

Copy the Corpus page (Docs&Ngrams) for Contacts

parent d898d51d
Hide whitespace changes
Inline Side-by-side
Showing with 1239 additions and 426 deletions
src/Gargantext/Components/Tab.purs
View file @ 652ae8e2
......@@ -13,7 +13,7 @@ import Thermite ( PerformAction, Render, Spec
, _render, modifyState, focus
, simpleSpec, withState)
type State = Int
type State = { activeTab :: Int }
data Action = ChangeTab Int
......@@ -22,16 +22,16 @@ tabs :: forall state props action.
-> List (Tuple String (Spec state props action))
-> Spec state props action
tabs l p ls = withState \st ->
let {activeTab} = view l st in
fold
[ focus l p $ simpleSpec performAction (render (activeTab st) ls)
, wrapper $ fold $ mapWithIndex ( tab (activeTab st)) ls
[ focus l p $ simpleSpec performAction (render activeTab ls)
, wrapper $ fold $ mapWithIndex ( tab activeTab) ls
]
where
performAction :: forall props.
PerformAction State props Action
performAction (ChangeTab i) _ _ =
void $ modifyState $ const i
activeTab = view l
performAction (ChangeTab activeTab) _ _ =
void $ modifyState $ const {activeTab}
wrapper = over _render \render d p s c ->
[div [className "tab-content"] $ render d p s c]
......@@ -49,7 +49,7 @@ tab sid iid (Tuple name spec) = over _render tabRender spec
render :: forall state props action.
State -> List (Tuple String (Spec state props action))
Int -> List (Tuple String (Spec state props action))
-> Render State props Action
render at ls d p s c =
[ nav []
......
src/Gargantext/Config.purs
View file @ 652ae8e2
......@@ -98,10 +98,18 @@ endBaseUrl end c = (endOf end c).baseUrl
endPathUrl :: End -> EndConfig -> Path -> Maybe Id -> UrlPath
endPathUrl end = pathUrl <<< endOf end
tabTypeDocs :: TabType -> UrlPath
tabTypeDocs (TabCorpus t) = "table?view=" <> show t
tabTypeDocs (TabPairing t) = "pairing?view=" <> show t
tabTypeNgrams :: TabType -> UrlPath
tabTypeNgrams (TabCorpus t) = "listGet?ngramsType=" <> show t
tabTypeNgrams (TabPairing t) = "listGet?ngramsType=" <> show t -- TODO
pathUrl :: Config -> Path -> Maybe Id -> UrlPath
pathUrl c (Tab t o l s) i =
pathUrl c (NodeAPI Node) i <>
"/" <> "table?view=" <> show t <> "&offset=" <> show o
"/" <> tabTypeDocs t <> "&offset=" <> show o
<> "&limit=" <> show l <> os
where
os = maybe "" (\x -> "&order=" <> show x) s
......@@ -112,7 +120,7 @@ pathUrl c (Children n o l s) i =
where
os = maybe "" (\x -> "&order=" <> show x) s
pathUrl c (Ngrams t listid) i =
pathUrl c (NodeAPI Node) i <> "/" <> "listGet?ngramsType=" <> show t <> listid'
pathUrl c (NodeAPI Node) i <> "/" <> tabTypeNgrams t <> listid'
where
listid' = maybe "" (\x -> "&list=" <> show x) listid
pathUrl c Auth Nothing = c.prePath <> "auth"
......@@ -171,13 +179,11 @@ instance showNodeType :: Show NodeType where
show Nodes = "Nodes"
show Tree = "NodeTree"
data Path
= Auth
| Tab TabType Offset Limit (Maybe OrderBy)
| Children NodeType Offset Limit (Maybe OrderBy)
| Ngrams TabType (Maybe TermList)
| Ngrams TabType (Maybe TermList)
| NodeAPI NodeType
data End = Back | Front
......@@ -201,15 +207,31 @@ instance showApiVersion :: Show ApiVersion where
show V11 = "v1.1"
------------------------------------------------------------
data TabType = TabDocs | TabTerms | TabSources | TabAuthors | TabInstitutes | TabTrash
data CTabNgramType = CTabTerms | CTabSources | CTabAuthors | CTabInstitutes
instance showCTabNgramType :: Show CTabNgramType where
show CTabTerms = "Terms"
show CTabSources = "Sources"
show CTabAuthors = "Authors"
show CTabInstitutes = "Institutes"
data PTabNgramType = PTabPatents | PTabBooks | PTabCommunication
instance showPTabNgramType :: Show PTabNgramType where
show PTabPatents = "Patents"
show PTabBooks = "Books"
show PTabCommunication = "Communication"
data TabSubType a = TabDocs | TabNgramType a | TabTrash
instance showTabSubType :: Show a => Show (TabSubType a) where
show TabDocs = "Docs"
show (TabNgramType a) = show a
show TabTrash = "Trash"
instance showTabType :: Show TabType where
show TabDocs = "Docs"
show TabTerms = "Terms"
show TabSources = "Sources"
show TabAuthors = "Authors"
show TabInstitutes = "Institutes"
show TabTrash = "Trash"
data TabType
= TabCorpus (TabSubType CTabNgramType)
| TabPairing (TabSubType PTabNgramType)
------------------------------------------------------------
nodeTypeUrl :: NodeType -> Url
......
src/Gargantext/Pages/Annuaire/User/Brevets.purs deleted 100644 → 0
View file @ d898d51d
module Gargantext.Pages.Annuaire.User.Brevets where
import Prelude
import Thermite (Render, Spec, defaultPerformAction, simpleSpec)
brevetsSpec :: Spec {} {} Void
brevetsSpec = simpleSpec defaultPerformAction render
where
render :: Render {} {} Void
render dispatch _ state _ =
[]
src/Gargantext/Pages/Annuaire/User/Contacts/API.purs deleted 100644 → 0
View file @ d898d51d
module Gargantext.Pages.Annuaire.User.Contacts.API where
import Control.Monad.Trans.Class (lift)
import Data.Either (Either(..))
import Data.Lens ((?~))
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Thermite (StateCoTransformer, modifyState)
import Gargantext.Config (toUrl, NodeType(..), End(..))
import Gargantext.Config.REST (get)
import Gargantext.Prelude
import Gargantext.Pages.Annuaire.User.Contacts.Types (Action(..), State, Contact, _contact)
import Thermite (PerformAction, modifyState)
getContact :: Maybe Int -> Aff Contact
getContact id = get $ toUrl Back Node id
fetchContact :: Int -> StateCoTransformer State Unit
fetchContact contactId = do
contact <- lift $ getContact (Just contactId)
void $ modifyState $ _contact ?~ contact
logs "Fetching contact..."
src/Gargantext/Pages/Annuaire/User/Contacts/Specs.purs
View file @ 652ae8e2
module Gargantext.Pages.Annuaire.User.Contacts.Specs
(module Gargantext.Pages.Annuaire.User.Contacts.Specs.Renders,
brevetSpec,
projectSpec,
facets,
layoutUser)
(layoutUser)
where
import Data.List (fromFoldable)
import Data.Tuple (Tuple(..))
import Thermite (Render, PerformAction, Spec, focus, noState, defaultPerformAction, simpleSpec)
import Data.List (List, zipWith, catMaybes, toUnfoldable)
import Data.Map (Map, empty, keys, values, lookup)
import Data.Array (head)
import Data.Semigroup ((<>))
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Set (toUnfoldable) as S
import Data.Tuple (Tuple(..), uncurry)
import Data.Unfoldable (class Unfoldable)
import Data.Maybe (Maybe(..))
import Data.Newtype (unwrap)
import Data.String (joinWith)
import Effect.Aff (Aff)
import Thermite (Render, Spec, defaultPerformAction, simpleSpec, createClass)
import React as React
import React (ReactClass, ReactElement)
import React.DOM (div, h3, img, li, span, text, ul, text)
import React.DOM.Props (_id, className, src)
import Gargantext.Prelude
import Gargantext.Components.Tab as Tab
import Gargantext.Pages.Annuaire.User.Brevets as B
import Gargantext.Pages.Annuaire.User.Contacts.Specs.Documents as P
import Gargantext.Pages.Annuaire.User.Contacts.Types (Action(..), State, _tablens, _tabAction)
import Gargantext.Pages.Annuaire.User.Contacts.API (fetchContact)
import Gargantext.Pages.Annuaire.User.Contacts.Specs.Renders (render)
layoutUser :: Spec State {} Action
layoutUser = simpleSpec performAction render
import Gargantext.Config (toUrl, End(..), NodeType(..))
import Gargantext.Config.REST (get)
import Gargantext.Components.Loader as Loader
import Gargantext.Pages.Annuaire.User.Contacts.Types
import Gargantext.Pages.Annuaire.User.Contacts.Tabs.Specs as Tabs
--type Props = Loader.InnerProps Int Contact
display :: String -> Array ReactElement -> Array ReactElement
display title elems =
[ div [className "container-fluid"]
[ div [className "row", _id "contact-page-header"]
[ div [className "col-md-6"] [ h3 [] [text title] ]
, div [className "col-md-8"] []
, div [className "col-md-2"] [ span [] [text ""] ]
]
, div [className "row", _id "contact-page-info"]
[ div [className "col-md-12"]
[ div [className "row"]
[ div [className "col-md-2"]
--[ ]
[ img [src "/images/Gargantextuel-212x300.jpg"] ]
, div [className "col-md-1"] []
, div [className "col-md-8"] elems
]
]
]
]
]
mapMyMap :: forall k v x f. Ord k => Unfoldable f => (k -> v -> x) -> Map k v -> f x
mapMyMap f m = toUnfoldable
$ zipWith f mapKeys
(catMaybes $ flip lookup m <$> mapKeys)
where mapKeys = S.toUnfoldable $ keys m
infixl 4 mapMyMap as <.~$>
getFirstName obj = fromMaybe "Empty title" $ getFirstName' <$> obj
getFirstName' = fromMaybe "Empty first name" <<< _.firstName <<< unwrap
getLastName obj = fromMaybe "Empty title" $ getLastName' <$> obj
getLastName' = fromMaybe "Empty last name" <<< _.lastName <<< unwrap
-- | ContactWhere infos
-- TODO factor below
getRole :: Array ContactWhere -> String
getRole obj = joinWith ", " $ getRole' <$> obj
getRole' = fromMaybe "no role" <<< _.role <<< unwrap
getOrga :: Array ContactWhere -> String
getOrga = maybe "Emtpy Contact-Where" getOrga' <<< head
where
getOrga' :: ContactWhere -> String
getOrga' obj = joinWith ", " $ (\(ContactWhere {organization: o}) ->o) obj
getDept :: Array ContactWhere -> String
getDept = maybe "Empty Department" getDept' <<< head
where
getDept' :: ContactWhere -> String
getDept' obj = joinWith ", " $ (\(ContactWhere {labTeamDepts: l}) ->l) obj
getOffice :: Array ContactWhere -> String
getOffice = fromMaybe "Empty Office"
<<< maybe Nothing (\(ContactWhere {office:x}) -> x)
<<< head
getCity :: Array ContactWhere -> String
getCity = fromMaybe "Empty City"
<<< maybe Nothing (\(ContactWhere {city:x}) -> x)
<<< head
getCountry :: Array ContactWhere -> String
getCountry = fromMaybe "Empty Country"
<<< maybe Nothing (\(ContactWhere {country:x}) -> x)
<<< head
-- | ContactWhere / Touch infos
getTouch :: Array ContactWhere -> Maybe ContactTouch
getTouch = maybe Nothing (\(ContactWhere {touch:x}) -> x) <<< head
getPhone :: Array ContactWhere -> String
getPhone obj = fromMaybe "" $ getPhone' <$> (getTouch obj)
getPhone' :: ContactTouch -> String
getPhone' = fromMaybe "no phone" <<< _.phone <<< unwrap
getMail :: Array ContactWhere -> String
getMail obj = fromMaybe "" $ getMail' <$> (getTouch obj)
getMail' :: ContactTouch -> String
getMail' = fromMaybe "no mail" <<< _.mail <<< unwrap
-- | TODO format data in better design (UI) shape
contactInfos :: HyperdataContact -> Array ReactElement
contactInfos (HyperdataContact {who:who, ou:ou}) =
[ ul [className "list-group"] (infoRender (Tuple "Last Name" $ " " <> getLastName who))
, ul [className "list-group"] (infoRender (Tuple "First name" $ " " <> getFirstName who))
, ul [className "list-group"] (infoRender (Tuple "Organization" $ " " <> getOrga ou ))
, ul [className "list-group"] (infoRender (Tuple "Lab/Team/Dept"$ " " <> getOrga ou ))
, ul [className "list-group"] (infoRender (Tuple "Office" $ " " <> getOffice ou ))
, ul [className "list-group"] (infoRender (Tuple "City" $ " " <> getCity ou ))
, ul [className "list-group"] (infoRender (Tuple "Country" $ " " <> getCountry ou ))
, ul [className "list-group"] (infoRender (Tuple "Role" $ " " <> getRole ou ))
, ul [className "list-group"] (infoRender (Tuple "Phone" $ " " <> getPhone ou ))
, ul [className "list-group"] (infoRender (Tuple "Mail" $ " " <> getMail ou ))
]
{- $
listInfo <.~$> hyperdata
where
performAction :: PerformAction State {} Action
performAction (FetchContact contactId) _ _ = fetchContact contactId
performAction (TabA _) _ _ = pure unit
checkMaybe (Nothing) = empty
checkMaybe (Just (HyperData a)) = a
-}
listInfo :: Tuple String String -> ReactElement
listInfo s = listElement $ infoRender s
brevetSpec :: Spec State {} Action
brevetSpec = noState B.brevetsSpec
listElement :: Array ReactElement -> ReactElement
listElement = li [className "list-group-item justify-content-between"]
projets :: Spec {} {} Void
projets = simpleSpec defaultPerformAction render
infoRender :: Tuple String String -> Array ReactElement
infoRender (Tuple title content) =
[ span [className "badge badge-default badge-pill"] [text title]
, span [] [text content]
]
layoutUser :: Spec {} {nodeId :: Int} Void
layoutUser = simpleSpec defaultPerformAction render
where
render :: Render {} {nodeId :: Int} Void
render _ {nodeId} _ _ =
[ contactLoader { path: nodeId
, component: createClass "LayoutUser" layoutUser' (const {})
} ]
layoutUser' :: Spec {} Props Void
layoutUser' = simpleSpec defaultPerformAction render
<> Tabs.pureTabs
where
render :: Render {} {} Void
render dispatch _ state _ =
[]
projectSpec :: Spec State {} Action
projectSpec = noState projets
publicationSpec :: Spec State {} Action
publicationSpec = noState P.publicationSpec
facets :: Spec State {} Action
facets = Tab.tabs _tablens _tabAction $ fromFoldable
[ Tuple "Publications (12)" publicationSpec
, Tuple "Brevets (2)" brevetSpec
, Tuple "Projets IMT (5)" projectSpec
]
render :: Render {} Props Void
render dispatch {loaded: Contact {name, hyperdata}} _ _ =
[ div [className "col-md-12"] $
display (fromMaybe "no name" name) (contactInfos hyperdata)
]
getContact :: Int -> Aff Contact
getContact id = get $ toUrl Back Node $ Just id
contactLoaderClass :: ReactClass (Loader.Props Int Contact)
contactLoaderClass = Loader.createLoaderClass "ContactLoader" getContact
contactLoader :: Loader.Props' Int Contact -> ReactElement
contactLoader props = React.createElement contactLoaderClass props []
src/Gargantext/Pages/Annuaire/User/Contacts/Specs/Documents.purs deleted 100644 → 0
View file @ d898d51d
module Gargantext.Pages.Annuaire.User.Contacts.Specs.Documents where
import Prelude
import React.DOM (table, tbody, td, text, th, thead, tr)
import React.DOM.Props (className, scope)
import Thermite (Render, Spec, defaultPerformAction, simpleSpec)
publicationSpec :: Spec {} {} Void
publicationSpec = simpleSpec defaultPerformAction render
where
render :: Render {} {} Void
render dispatch _ state _ =
[ table [ className "table"]
[ thead [ className "thead-dark"]
[ tr []
[ th [ scope "col"] [ text "Date" ]
, th [ scope "col"] [ text "Description" ]
, th [ scope "col"] [ text "Projects" ]
, th [ scope "col"] [ text "Favorite" ]
, th [ scope "col"] [ text "Delete" ]
]
]
, tbody []
[ tr [] [ td [] [ text "2012/03/06"]
, td [] [ text "Big data and text mining"]
, td [] [ text "European funds"]
, td [] [ text "True"]
, td [] [ text "False"]
]
, tr [] [ td [] [ text "2013/03/06"]
, td [] [ text "Cryptography"]
, td [] [ text "French funds"]
, td [] [ text "True"]
, td [] [ text "False"]
]
, tr [] [ td [] [ text "2013/03/06"]
, td [] [ text "Artificial Intelligence"]
, td [] [ text "Not found"]
, td [] [ text "True"]
, td [] [ text "False"]
]
]
]
]
src/Gargantext/Pages/Annuaire/User/Contacts/Specs/Renders.purs deleted 100644 → 0
View file @ d898d51d
module Gargantext.Pages.Annuaire.User.Contacts.Specs.Renders
where
import Gargantext.Pages.Annuaire.User.Contacts.Types
import Prelude (map)
import Data.List (List, zipWith, catMaybes, toUnfoldable)
import Data.Map (Map, empty, keys, values, lookup)
import Data.Array (head)
import Data.Semigroup ((<>))
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Set (toUnfoldable) as S
import Data.Tuple (Tuple(..), uncurry)
import Data.Unfoldable (class Unfoldable)
import Prelude (identity)
import Prelude (($), (<<<), (<$>), flip, class Ord)
import React (ReactElement)
import React.DOM (div, h3, img, li, span, text, ul, text)
import React.DOM.Props (_id, className, src)
import Thermite (Render)
import Data.Newtype (unwrap)
import Data.String
render :: Render State {} Action
render dispatch _ state _ =
[
div [className "col-md-12"]
$ case state.contact of
(Just (Contact contact)) -> display (fromMaybe "no name" contact.name) (contactInfos contact.hyperdata)
Nothing -> display "Contact not found" []
]
display :: String -> Array ReactElement -> Array ReactElement
display title elems =
[ div [className "container-fluid"]
[ div [className "row", _id "contact-page-header"]
[ div [className "col-md-6"] [ h3 [] [text title] ]
, div [className "col-md-8"] []
, div [className "col-md-2"] [ span [] [text ""] ]
]
, div [className "row", _id "contact-page-info"]
[ div [className "col-md-12"]
[ div [className "row"]
[ div [className "col-md-2"]
--[ ]
[ img [src "/images/Gargantextuel-212x300.jpg"] ]
, div [className "col-md-1"] []
, div [className "col-md-8"] elems
]
]
]
]
]
mapMyMap :: forall k v x f. Ord k => Unfoldable f => (k -> v -> x) -> Map k v -> f x
mapMyMap f m = toUnfoldable
$ zipWith f mapKeys
(catMaybes $ flip lookup m <$> mapKeys)
where mapKeys = S.toUnfoldable $ keys m
infixl 4 mapMyMap as <.~$>
getFirstName obj = fromMaybe "Empty title" $ getFirstName' <$> obj
getFirstName' = fromMaybe "Empty first name" <<< _.firstName <<< unwrap
getLastName obj = fromMaybe "Empty title" $ getLastName' <$> obj
getLastName' = fromMaybe "Empty last name" <<< _.lastName <<< unwrap
-- | ContactWhere infos
-- TODO factor below
getRole :: Array ContactWhere -> String
getRole obj = joinWith ", " $ getRole' <$> obj
getRole' = fromMaybe "no role" <<< _.role <<< unwrap
getOrga :: Array ContactWhere -> String
getOrga = maybe "Emtpy Contact-Where" getOrga' <<< head
where
getOrga' :: ContactWhere -> String
getOrga' obj = joinWith ", " $ (\(ContactWhere {organization: o}) ->o) obj
getDept :: Array ContactWhere -> String
getDept = maybe "Empty Department" getDept' <<< head
where
getDept' :: ContactWhere -> String
getDept' obj = joinWith ", " $ (\(ContactWhere {labTeamDepts: l}) ->l) obj
getOffice :: Array ContactWhere -> String
getOffice = fromMaybe "Empty Office"
<<< maybe Nothing (\(ContactWhere {office:x}) -> x)
<<< head
getCity :: Array ContactWhere -> String
getCity = fromMaybe "Empty City"
<<< maybe Nothing (\(ContactWhere {city:x}) -> x)
<<< head
getCountry :: Array ContactWhere -> String
getCountry = fromMaybe "Empty Country"
<<< maybe Nothing (\(ContactWhere {country:x}) -> x)
<<< head
-- | ContactWhere / Touch infos
getTouch :: Array ContactWhere -> Maybe ContactTouch
getTouch = maybe Nothing (\(ContactWhere {touch:x}) -> x) <<< head
getPhone :: Array ContactWhere -> String
getPhone obj = fromMaybe "" $ getPhone' <$> (getTouch obj)
getPhone' :: ContactTouch -> String
getPhone' = fromMaybe "no phone" <<< _.phone <<< unwrap
getMail :: Array ContactWhere -> String
getMail obj = fromMaybe "" $ getMail' <$> (getTouch obj)
getMail' :: ContactTouch -> String
getMail' = fromMaybe "no mail" <<< _.mail <<< unwrap
-- | TODO format data in better design (UI) shape
contactInfos :: HyperdataContact -> Array ReactElement
contactInfos (HyperdataContact {who:who, ou:ou}) =
[ ul [className "list-group"] (infoRender (Tuple "Last Name" $ " " <> getLastName who))
, ul [className "list-group"] (infoRender (Tuple "First name" $ " " <> getFirstName who))
, ul [className "list-group"] (infoRender (Tuple "Organization" $ " " <> getOrga ou ))
, ul [className "list-group"] (infoRender (Tuple "Lab/Team/Dept"$ " " <> getOrga ou ))
, ul [className "list-group"] (infoRender (Tuple "Office" $ " " <> getOffice ou ))
, ul [className "list-group"] (infoRender (Tuple "City" $ " " <> getCity ou ))
, ul [className "list-group"] (infoRender (Tuple "Country" $ " " <> getCountry ou ))
, ul [className "list-group"] (infoRender (Tuple "Role" $ " " <> getRole ou ))
, ul [className "list-group"] (infoRender (Tuple "Phone" $ " " <> getPhone ou ))
, ul [className "list-group"] (infoRender (Tuple "Mail" $ " " <> getMail ou ))
]
{- $
listInfo <.~$> hyperdata
where
checkMaybe (Nothing) = empty
checkMaybe (Just (HyperData a)) = a
-}
listInfo :: Tuple String String -> ReactElement
listInfo s = listElement $ infoRender s
listElement :: Array ReactElement -> ReactElement
listElement = li [className "list-group-item justify-content-between"]
infoRender :: Tuple String String -> Array ReactElement
infoRender (Tuple title content) =
[ span [className "badge badge-default badge-pill"] [text title]
, span [] [text content]
]
src/Gargantext/Pages/Annuaire/User/Contacts/Tabs/Documents.purs 0 → 100644
View file @ 652ae8e2
-- TODO copy of Gargantext.Pages.Corpus.Tabs.Documents
module Gargantext.Pages.Annuaire.User.Contacts.Tabs.Documents where
import Data.Array (take, drop)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.?), (:=), (~>))
import Affjax (defaultRequest, request)
import Affjax.RequestBody (RequestBody(..))
import Affjax.ResponseFormat (printResponseFormatError)
import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, (.?), (:=), (~>))
import Data.Array (drop, take, (:))
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(..), maybe)
import Data.Set (Set)
import Data.Set as Set
import Data.Tuple (Tuple(..))
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import React as React
import React (ReactClass, ReactElement, Children)
------------------------------------------------------------------------
import Gargantext.Prelude
import Gargantext.Config (Path(..), NodeType(..), TabType(..), TabSubType(..), toUrl, End(..), OrderBy(..))
import Gargantext.Config.REST (get, put, post, deleteWithBody)
import Gargantext.Utils.DecodeMaybe ((.|))
import Gargantext.Components.Charts.Options.ECharts (chart)
import Gargantext.Components.Loader as Loader
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Table as T
import Gargantext.Pages.Corpus.Dashboard (globalPublis)
import Gargantext.Pages.Annuaire.User.Contacts.Types (Contact, Props)
import Gargantext.Utils.DecodeMaybe ((.|))
import React.DOM (a, br', button, div, i, input, p, text)
import React.DOM.Props (_type, className, href, name, onClick, placeholder, style, value)
import Thermite (PerformAction, Render, Spec, defaultPerformAction, modifyState_, simpleSpec, hideState)
------------------------------------------------------------------------
-- TODO: Pagination Details are not available from the BackEnd
-- TODO: Search is pending
-- TODO: Fav is pending
-- TODO: Sort is Pending
-- TODO: Filter is Pending
-- TODO: When a pagination link is clicked, reload data.
type State =
{ documentIdsToDelete :: Set Int
}
initialState :: State
initialState =
{ documentIdsToDelete: mempty
}
data Action
= MarkFavorites (Array Int)
| ToggleDocumentToDelete Int
| Trash
newtype DocumentsView
= DocumentsView
{ _id :: Int
, url :: String
, date :: String
, title :: String
, source :: String
, fav :: Boolean
, ngramCount :: Int
, delete :: Boolean
}
derive instance genericDocumentsView :: Generic DocumentsView _
instance showDocumentsView :: Show DocumentsView where
show = genericShow
newtype Response = Response
{ cid :: Int
, created :: String
, hyperdata :: Hyperdata
, favorite :: Boolean
, ngramCount :: Int
}
newtype Hyperdata = Hyperdata
{ title :: String
, source :: String
}
--instance decodeHyperdata :: DecodeJson Hyperdata where
-- decodeJson json = do
-- obj <- decodeJson json
-- title <- obj .? "title"
-- source <- obj .? "source"
-- pure $ Hyperdata { title,source }
--instance decodeResponse :: DecodeJson Response where
-- decodeJson json = do
-- obj <- decodeJson json
-- cid <- obj .? "id"
-- created <- obj .? "created"
-- favorite <- obj .? "favorite"
-- ngramCount <- obj .? "ngramCount"
-- hyperdata <- obj .? "hyperdata"
-- pure $ Response { cid, created, favorite, ngramCount, hyperdata }
instance decodeHyperdata :: DecodeJson Hyperdata where
decodeJson json = do
obj <- decodeJson json
title <- obj .| "title"
source <- obj .| "source"
pure $ Hyperdata { title,source }
instance decodeResponse :: DecodeJson Response where
decodeJson json = do
obj <- decodeJson json
cid <- obj .? "id"
created <- pure "2018"
--created <- obj .? "date"
favorite <- pure true
ngramCount <- obj .? "id"
hyperdata <- obj .? "hyperdata"
pure $ Response { cid, created, favorite, ngramCount, hyperdata }
-- | Filter
filterSpec :: Spec State Props Action
filterSpec = simpleSpec defaultPerformAction render
where
render d p s c = [div [] [ text " Filter "
, input []
]]
docViewSpec :: Spec {} Props Void
docViewSpec = hideState (const initialState) layoutDocview
-- | Main layout of the Documents Tab of an Annuaire
layoutDocview :: Spec State Props Action
layoutDocview = simpleSpec performAction render
where
performAction :: PerformAction State Props Action
performAction (MarkFavorites nids) {path : nodeId} _ =
void $ lift $ putFavorites nodeId (FavoriteQuery {favorites: nids})
--TODO add array of delete rows here
performAction (ToggleDocumentToDelete nid) _ _ =
modifyState_ \state -> state {documentIdsToDelete = toggleSet nid state.documentIdsToDelete}
performAction Trash {path: nodeId} {documentIdsToDelete} =
void $ lift $ deleteDocuments nodeId (DeleteDocumentQuery {documents: Set.toUnfoldable documentIdsToDelete})
-- TODO: what to do now that the documents are deleted
-- * should we reload? NO (if you change page, yes and come back yes)
-- * should we locally update our data? YES
-- * should we reset documentIdsToDelete? YES
-- * if so, how to un-check the checkboxes since the inputs are uncontrolled?
-- + There is no need to uncheck them if they disapear because we
-- either reload or local update our data. YES
-- + Sync the checked value using (why check, just reset documentsIdsToDelete)
-- `checked: Set.member n state.documentIdsToDelete`
render :: Render State Props Action
render dispatch {path: nodeId, loaded: contact} _ _ =
[ p [] []
, div [ style {textAlign : "center"}] [input [placeholder "Filter here"]]
, br'
, div [className "container1"]
[ div [className "row"]
[ chart globalPublis
, div [className "col-md-12"]
[ pageLoader
{ path: initialPageParams nodeId
, contact
, dispatch
}
]
, div [className "col-md-12"]
[ button [ style {backgroundColor: "peru", padding : "9px", color : "white", border : "white", float: "right"}
, onClick $ (\_ -> dispatch Trash)
]
[ i [className "glyphitem glyphicon glyphicon-trash", style {marginRight : "9px"}] []
, text "Trash it !"
]
]
]
]
]
mock :: Boolean
mock = false
type PageParams = {nodeId :: Int, params :: T.Params}
initialPageParams :: Int -> PageParams
initialPageParams nodeId = {nodeId, params: T.initialParams}
loadPage :: PageParams -> Aff (Array DocumentsView)
loadPage {nodeId, params: {limit, offset, orderBy}} = do
logs "loading documents page: loadPage with Offset and limit"
--res <- get $ toUrl Back (Children Url_Document offset limit) nodeId
res <- get $ toUrl Back (Tab (TabPairing TabDocs) offset limit (convOrderBy <$> orderBy)) (Just nodeId)
let docs = res2corpus <$> res
--_ <- logs "Ok: loading page documents"
--_ <- logs $ map show docs
pure $
if mock then take limit $ drop offset sampleData else
docs
where
res2corpus :: Response -> DocumentsView
res2corpus (Response r) =
DocumentsView { _id : r.cid
, url : ""
, date : r.created
, title : (\(Hyperdata hr) -> hr.title) r.hyperdata
, source : (\(Hyperdata hr) -> hr.source) r.hyperdata
, fav : r.favorite
, ngramCount : r.ngramCount
, delete : false
}
convOrderBy (T.ASC (T.ColumnName "Date")) = DateAsc
convOrderBy (T.DESC (T.ColumnName "Date")) = DateDesc
convOrderBy (T.ASC (T.ColumnName "Title")) = TitleAsc
convOrderBy (T.DESC (T.ColumnName "Title")) = TitleDesc
convOrderBy _ = DateAsc -- TODO
type PageLoaderProps row =
{ path :: PageParams
, contact :: Contact
, dispatch :: Action -> Effect Unit
| row
}
renderPage :: forall props path.
Render (Loader.State {nodeId :: Int | path} (Array DocumentsView))
{ contact :: Contact
, dispatch :: Action -> Effect Unit
| props
}
(Loader.Action PageParams)
renderPage _ _ {loaded: Nothing} _ = [] -- TODO loading spinner
renderPage loaderDispatch {contact, dispatch} {currentPath: {nodeId}, loaded: Just res} _ =
[ T.tableElt
{ rows
, setParams: \params -> liftEffect $ loaderDispatch (Loader.SetPath {nodeId, params})
, container: T.defaultContainer { title: "Documents" }
, colNames:
T.ColumnName <$>
[ ""
, "Date"
, "Title"
, "Source"
, "Delete"
]
, totalRecords: 47361 -- TODO
}
]
where
fa true = "fas "
fa false = "far "
rows = (\(DocumentsView r) ->
{ row:
[ div []
[ a [className $ fa r.fav <> "fa-star" ,onClick $ (\_->
dispatch $ MarkFavorites [r._id])] []
]
-- TODO show date: Year-Month-Day only
, if (r.delete) then
div [ style {textDecoration : "line-through"}][text r.date]
else
div [ ][text r.date]
, if (r.delete) then
a [ href (toUrl Front Url_Document (Just r._id)), style {textDecoration : "line-through"} ] [ text r.title ]
else
a [ href (toUrl Front Url_Document (Just r._id)) ] [ text r.title ]
, if (r.delete) then
div [style {textDecoration : "line-through"}] [ text r.source]
else
div [] [ text r.source]
, input [ _type "checkbox", onClick $ (\_ -> dispatch $ ToggleDocumentToDelete r._id)]
]
, delete: true
}) <$> res
pageLoaderClass :: ReactClass (PageLoaderProps (children :: Children))
pageLoaderClass = Loader.createLoaderClass' "PageLoader" loadPage renderPage
pageLoader :: PageLoaderProps () -> ReactElement
pageLoader props = React.createElement pageLoaderClass props []
---------------------------------------------------------
sampleData' :: DocumentsView
sampleData' = DocumentsView {_id : 1, url : "", date : "date3", title : "title", source : "source", fav : false, ngramCount : 1, delete : false}
sampleData :: Array DocumentsView
--sampleData = replicate 10 sampleData'
sampleData = map (\(Tuple t s) -> DocumentsView {_id : 1, url : "", date : "2017", title: t, source: s, fav : false, ngramCount : 10, delete : false}) sampleDocuments
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"]
newtype SearchQuery = SearchQuery
{
query :: Array String
, parent_id :: Int
}
instance encodeJsonSQuery :: EncodeJson SearchQuery where
encodeJson (SearchQuery post)
= "query" := post.query
~> "parent_id" := post.parent_id
~> jsonEmptyObject
searchResults :: SearchQuery -> Aff Int
searchResults squery = post "http://localhost:8008/count" unit
-- TODO
newtype FavoriteQuery = FavoriteQuery
{ favorites :: Array Int
}
instance encodeJsonFQuery :: EncodeJson FavoriteQuery where
encodeJson (FavoriteQuery post)
= "favorites" := post.favorites
~> jsonEmptyObject
newtype DeleteDocumentQuery = DeleteDocumentQuery
{
documents :: Array Int
}
instance encodeJsonDDQuery :: EncodeJson DeleteDocumentQuery where
encodeJson (DeleteDocumentQuery post)
= "documents" := post.documents
~> jsonEmptyObject
putFavorites :: Int -> FavoriteQuery -> Aff (Array Int)
putFavorites nodeId = put (toUrl Back Node (Just nodeId) <> "/favorites")
deleteFavorites :: Int -> FavoriteQuery -> Aff (Array Int)
deleteFavorites nodeId = deleteWithBody (toUrl Back Node (Just nodeId) <> "/favorites")
deleteDocuments :: Int -> DeleteDocumentQuery -> Aff (Array Int)
deleteDocuments nodeId = deleteWithBody (toUrl Back Node (Just nodeId) <> "/documents")
-- TODO: not optimal but Data.Set lacks some function (Set.alter)
toggleSet :: forall a. Ord a => a -> Set a -> Set a
toggleSet a s
| Set.member a s = Set.delete a s
| otherwise = Set.insert a s
src/Gargantext/Pages/Annuaire/User/Contacts/Tabs/Ngrams/NgramsTable.purs 0 → 100644
View file @ 652ae8e2
-- TODO copy of Gargantext.Pages.Corpus.Tabs.Ngrams.NgramsTable where
module Gargantext.Pages.Annuaire.User.Contacts.Tabs.Ngrams.NgramsTable
(Mode(..), ngramsTableSpec)
where
import Control.Monad.State (class MonadState, execState)
import Data.Argonaut (class DecodeJson, decodeJson, (.?), (.??))
import Data.Array (filter, toUnfoldable)
import Data.Either (Either(..))
import Data.Foldable
import Data.FoldableWithIndex
import Data.FunctorWithIndex
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Newtype (class Newtype, unwrap)
import Data.Lens (Lens', Prism', Iso', lens, over, prism, (^.), (^..), (%~), (.=), use, (<>~))
import Data.Lens.Common (_Just)
import Data.Lens.At (class At, at)
import Data.Lens.Index (class Index, ix)
import Data.Lens.Fold (folded)
import Data.Lens.Getter (to)
import Data.Lens.Record (prop)
import Data.Lens.Iso (re)
import Data.Lens.Iso.Newtype (_Newtype)
import Data.List (List)
import Data.List as List
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..), maybe)
import Data.Traversable (class Traversable, traverse, traverse_, sequence)
import Data.TraversableWithIndex (class TraversableWithIndex, traverseWithIndex)
import Data.Set (Set)
import Data.Set as Set
import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..), uncurry)
import Data.Void (Void)
import Data.Unit (Unit)
import Effect (Effect)
import Effect.Aff (Aff)
import React (ReactElement, ReactClass, Children)
import React as React
import React.DOM hiding (style, map)
import React.DOM.Props (_id, _type, checked, className, href, name, onChange, onClick, onInput, placeholder, scope, selected, style, value)
import React.DOM.Props as DOM
import Thermite (PerformAction, Spec, StateCoTransformer, Render, _render, modifyState_, defaultPerformAction, focusState, hideState, simpleSpec, createClass)
import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Types
import Gargantext.Components.Table as T
import Gargantext.Prelude
import Gargantext.Config
import Gargantext.Config.REST
import Gargantext.Pages.Annuaire.User.Contacts.Types (Contact)
import Gargantext.Components.Loader as Loader
type Props = Loader.InnerProps Int Contact ( mode :: Mode )
type PageParams = {nodeId :: Int, params :: T.Params, mode :: Mode}
type Props' = Loader.InnerProps PageParams NgramsTable ()
type NgramsTerm = String
newtype NgramsElement = NgramsElement
{ ngrams :: NgramsTerm
, list :: TermList
, occurrences :: Int
, parent :: Maybe NgramsTerm
, children :: Set NgramsTerm
}
_parent = prop (SProxy :: SProxy "parent")
_children :: forall row. Lens' { children :: Set NgramsTerm | row } (Set NgramsTerm)
_children = prop (SProxy :: SProxy "children")
derive instance newtypeNgramsElement :: Newtype NgramsElement _
_NgramsElement :: Iso' NgramsElement _
_NgramsElement = _Newtype
instance decodeJsonNgramsElement :: DecodeJson NgramsElement where
decodeJson json = do
obj <- decodeJson json
ngrams <- obj .? "ngrams"
list <- obj .? "list"
occurrences <- obj .? "occurrences"
parent <- obj .?? "parent"
children' <- obj .? "children"
let children = Set.fromFoldable (children' :: Array NgramsTerm)
pure $ NgramsElement {ngrams, list, occurrences, parent, children}
-- type NgramsTable = Array (NTree NgramsElement)
-- type NgramsTable = Array NgramsElement
newtype NgramsTable = NgramsTable (Map NgramsTerm NgramsElement)
derive instance newtypeNgramsTable :: Newtype NgramsTable _
_NgramsTable :: Iso' NgramsTable (Map NgramsTerm NgramsElement)
_NgramsTable = _Newtype
instance indexNgramsTable :: Index NgramsTable String NgramsElement where
ix k = _NgramsTable <<< ix k
instance atNgramsTable :: At NgramsTable String NgramsElement where
at k = _NgramsTable <<< at k
instance decodeJsonNgramsTable :: DecodeJson NgramsTable where
decodeJson json = do
elements <- decodeJson json
pure $ NgramsTable
$ Map.fromFoldable
$ f <$> (elements :: Array NgramsElement)
where
f e@(NgramsElement e') = Tuple e'.ngrams e
data Replace a
= Keep
| Replace { old :: a, new :: a }
replace :: forall a. Eq a => a -> a -> Replace a
replace old new
| old == new = Keep
| otherwise = Replace { old, new }
instance semigroupReplace :: Semigroup (Replace a) where
append Keep p = p
append p Keep = p
append (Replace { old: _m, new }) (Replace { old, new: _m' }) =
-- assert _m == _m'
Replace { old, new }
instance semigroupMonoid :: Monoid (Replace a) where
mempty = Keep
applyReplace :: forall a. Eq a => Replace a -> a -> a
applyReplace Keep a = a
applyReplace (Replace { old, new }) a
| a == old = new
| otherwise = a
-- Representing a PatchSet as `Map a Boolean` would have the advantage
-- of enforcing rem and add to be disjoint.
newtype PatchSet a = PatchSet
{ rem :: Set a
, add :: Set a
}
instance semigroupPatchSet :: Ord a => Semigroup (PatchSet a) where
append (PatchSet p) (PatchSet q) = PatchSet
{ rem: q.rem <> p.rem
, add: Set.difference q.add p.rem <> p.add
}
instance monoidPatchSet :: Ord a => Monoid (PatchSet a) where
mempty = PatchSet { rem: Set.empty, add: Set.empty }
applyPatchSet :: forall a. Ord a => PatchSet a -> Set a -> Set a
applyPatchSet (PatchSet p) s = Set.difference s p.rem <> p.add
patchSetFromMap :: forall a. Ord a => Map a Boolean -> PatchSet a
patchSetFromMap m = PatchSet { rem: Map.keys (Map.filter not m)
, add: Map.keys (Map.filter identity m) }
-- TODO Map.partition would be nice here
newtype NgramsPatch = NgramsPatch
{ patch_children :: PatchSet NgramsTerm
, patch_list :: Replace TermList
}
instance semigroupNgramsPatch :: Semigroup NgramsPatch where
append (NgramsPatch p) (NgramsPatch q) = NgramsPatch
{ patch_children: p.patch_children <> q.patch_children
, patch_list: p.patch_list <> q.patch_list
}
instance monoidNgramsPatch :: Monoid NgramsPatch where
mempty = NgramsPatch { patch_children: mempty, patch_list: mempty }
applyNgramsPatch :: NgramsPatch -> NgramsElement -> NgramsElement
applyNgramsPatch (NgramsPatch p) (NgramsElement e) = NgramsElement
{ ngrams: e.ngrams
, list: applyReplace p.patch_list e.list
, occurrences: e.occurrences -- TODO: is this correct ?
, parent: e.parent
, children: applyPatchSet p.patch_children e.children
}
newtype PatchMap k p = PatchMap (Map k p)
instance semigroupPatchMap :: (Ord k, Semigroup p) => Semigroup (PatchMap k p) where
append (PatchMap p) (PatchMap q) = PatchMap (Map.unionWith append p q)
instance monoidPatchMap :: (Ord k, Semigroup p) => Monoid (PatchMap k p) where
mempty = PatchMap Map.empty
derive instance newtypePatchMap :: Newtype (PatchMap k p) _
_PatchMap :: forall k p. Iso' (PatchMap k p) (Map k p)
_PatchMap = _Newtype
instance functorPatchMap :: Functor (PatchMap k) where
map f (PatchMap m) = PatchMap (map f m)
instance functorWithIndexPatchMap :: FunctorWithIndex k (PatchMap k) where
mapWithIndex f (PatchMap m) = PatchMap (mapWithIndex f m)
instance foldlablePatchMap :: Foldable (PatchMap k) where
foldr f z (PatchMap m) = foldr f z m
foldl f z (PatchMap m) = foldl f z m
foldMap f (PatchMap m) = foldMap f m
instance foldlableWithIndexPatchMap :: FoldableWithIndex k (PatchMap k) where
foldrWithIndex f z (PatchMap m) = foldrWithIndex f z m
foldlWithIndex f z (PatchMap m) = foldlWithIndex f z m
foldMapWithIndex f (PatchMap m) = foldMapWithIndex f m
instance traversablePatchMap :: Traversable (PatchMap k) where
traverse f (PatchMap m) = PatchMap <$> traverse f m
sequence (PatchMap m) = PatchMap <$> sequence m
instance traversableWithIndexPatchMap :: TraversableWithIndex k (PatchMap k) where
traverseWithIndex f (PatchMap m) = PatchMap <$> traverseWithIndex f m
applyPatchMap :: forall k p v. Ord k => (p -> v -> v) -> PatchMap k p -> Map k v -> Map k v
applyPatchMap applyPatchValue (PatchMap p) = mapWithIndex f
where
f k v =
case Map.lookup k p of
Nothing -> v
Just pv -> applyPatchValue pv v
type NgramsTablePatch = PatchMap NgramsTerm NgramsPatch
type ReParent a = forall m. MonadState NgramsTable m => a -> m Unit
reParent :: Maybe NgramsTerm -> ReParent NgramsTerm
reParent parent child =
at child <<< _Just <<< _NgramsElement <<< _parent .= parent
-- reParentNgramsPatch :: NgramsTerm -> ReParent NgramsPatch
-- ^ GHC would have accepted this type. Here reParentNgramsPatch checks but
-- not its usage in reParentNgramsTablePatch.
reParentNgramsPatch :: forall m. MonadState NgramsTable m
=> NgramsTerm -> NgramsPatch -> m Unit
reParentNgramsPatch parent (NgramsPatch {patch_children: PatchSet {rem, add}}) = do
traverse_ (reParent Nothing) rem
traverse_ (reParent $ Just parent) add
reParentNgramsTablePatch :: ReParent NgramsTablePatch
reParentNgramsTablePatch = void <<< traverseWithIndex reParentNgramsPatch
applyNgramsTablePatch :: NgramsTablePatch -> NgramsTable -> NgramsTable
applyNgramsTablePatch p (NgramsTable m) =
execState (reParentNgramsTablePatch p) $
NgramsTable $ applyPatchMap applyNgramsPatch p m
-- TODO: update the .root fields...
-- See ROOT-UPDATE
type State =
{ ngramsTablePatch :: NgramsTablePatch
, ngramsParent :: Maybe NgramsTerm -- Nothing means we are not currently grouping terms
, ngramsChildren :: Map NgramsTerm Boolean
-- ^ Used only when grouping.
-- This updates the children of `ngramsParent`,
-- ngrams set to `true` are to be added, and `false` to
-- be removed.
, searchQuery :: String
, termListFilter :: Maybe TermList -- Nothing means all
, termTypeFilter :: Maybe TermType -- Nothing means all
}
_ngramsChildren = prop (SProxy :: SProxy "ngramsChildren")
initialState :: forall props. props -> State
initialState _ =
{ ngramsTablePatch: mempty
, ngramsParent: Nothing
, ngramsChildren: mempty
, searchQuery: ""
, termListFilter: Nothing
, termTypeFilter: Nothing
}
data Action
= SetTermListItem NgramsTerm (Replace TermList)
| SetParentResetChildren (Maybe NgramsTerm)
-- ^ This sets `ngramsParent` and resets `ngramsChildren`.
| ToggleChild Boolean NgramsTerm
-- ^ Toggles the NgramsTerm in the `PatchSet` `ngramsChildren`.
-- If the `Boolean` is `true` it means we want to add it if it is not here,
-- if it is `false` it is meant to be removed if not here.
| AddTermChildren -- NgramsTable
-- ^ The NgramsTable argument is here as a cache of `ngramsTablePatch`
-- applied to `initTable`.
-- TODO more docs
| SetTermListFilter (Maybe TermList)
| SetTermTypeFilter (Maybe TermType)
| SetSearchQuery String
data Mode = Patents | Books | Communication
derive instance genericMode :: Generic Mode _
instance showMode :: Show Mode where
show = genericShow
derive instance eqMode :: Eq Mode
type Dispatch = Action -> Effect Unit
tableContainer :: { searchQuery :: String
, dispatch :: Dispatch
, ngramsParent :: Maybe NgramsTerm
, ngramsChildren :: Map NgramsTerm Boolean
, ngramsTable :: NgramsTable
}
-> T.TableContainerProps -> Array ReactElement
tableContainer {searchQuery, dispatch, ngramsParent, ngramsChildren, ngramsTable: ngramsTableCache} props =
[ div [className "container-fluid"]
[ div [className "jumbotron1"]
[ div [className "row"]
[ div [className "panel panel-default"]
[ div [className "panel-heading"]
[ h2 [className "panel-title", style {textAlign : "center"}]
[ span [className "glyphicon glyphicon-hand-down"] []
, text "Extracted Terms"
]
, div [className "row"]
[ div [className "savediv pull-left col-md-2", style { marginTop :"1.5em"}]
[ span [className "needsaveicon glyphicon glyphicon-import"] []
, button [_id "ImportListOrSaveAll", className "btn btn-warning", style {fontSize : "120%"}]
[ text "Import a Termlist" ]
]
, div [className "col-md-4", style {marginTop : "37px"}]
[ input [ className "form-control "
, _id "id_password"
, name "search", placeholder "Search"
, _type "value"
, value searchQuery
, onInput \e -> dispatch (SetSearchQuery (unsafeEventValue e))
]
]
, div [_id "filter_terms", className "col-md-6", style{ marginTop : "2.1em",paddingLeft :"1em"}]
[ div [className "row", style {marginTop : "6px"}]
[ div [className "col-md-3"]
[ select [ _id "picklistmenu"
, className "form-control custom-select"
, onChange (\e -> dispatch (SetTermListFilter $ readTermList $ unsafeEventValue e))
] $ map optps1 termLists
]
, div [className "col-md-3"]
[ select [ _id "picktermtype"
, className "form-control custom-select"
, style {marginLeft : "1em"}
, onChange (\e -> dispatch (SetTermTypeFilter $ readTermType $ unsafeEventValue e))
] $ map optps1 termTypes
]
, div [className "col-md-3"] [ props.pageSizeControl ]
]
]
, div [className "col-md-6", style {marginTop : "24px", marginBottom : "14px"}]
[ props.pageSizeDescription
, props.paginationLinks
]
]
]
, div [] (maybe [] (\ngrams ->
let
ngramsTable =
ngramsTableCache # at ngrams
<<< _Just
<<< _NgramsElement
<<< _children
%~ applyPatchSet (patchSetFromMap ngramsChildren)
ngramsClick child
| child == ngrams = Nothing
| otherwise = Just $ dispatch $ ToggleChild false child
in
[ p[] [text $ "Editing " <> ngrams]
, renderNgramsTree { ngramsTable, ngrams, ngramsStyle: [], ngramsClick }
, button [className "btn btn-primary", onClick $ const $ dispatch $ AddTermChildren] [text "Save"]
, button [className "btn btn-secondary", onClick $ const $ dispatch $ SetParentResetChildren Nothing] [text "Cancel"]
]) ngramsParent)
, div [ _id "terms_table", className "panel-body" ]
[ table [ className "table able table-bordered" ]
[ thead [ className "tableHeader table-bordered"] [props.tableHead]
, tbody [] props.tableBody
]
]
]
]
]
]
]
commitPatch :: NgramsTablePatch -> StateCoTransformer State Unit
commitPatch pt = modifyState_ $ \s -> s { ngramsTablePatch = pt <> s.ngramsTablePatch }
toggleMap :: forall a. a -> Maybe a -> Maybe a
toggleMap _ (Just _) = Nothing
toggleMap b Nothing = Just b
ngramsTableSpec' :: Spec State Props' Action
ngramsTableSpec' = simpleSpec performAction render
where
setParentResetChildren :: Maybe NgramsTerm -> State -> State
setParentResetChildren p = _ { ngramsParent = p, ngramsChildren = mempty }
performAction :: PerformAction State Props' Action
performAction (SetTermListFilter c) _ _ = modifyState_ $ _ { termListFilter = c }
performAction (SetTermTypeFilter c) _ _ = modifyState_ $ _ { termTypeFilter = c }
performAction (SetSearchQuery s) _ _ = modifyState_ $ _ { searchQuery = s }
performAction (SetParentResetChildren p) _ _ =
modifyState_ $ setParentResetChildren p
performAction (ToggleChild b c) _ _ =
modifyState_ $ _ngramsChildren <<< at c %~ toggleMap b
performAction (SetTermListItem n pl) _ _ = commitPatch pt
where
pe = NgramsPatch { patch_list: pl, patch_children: mempty }
pt = PatchMap $ Map.singleton n pe
performAction AddTermChildren _ {ngramsParent: Nothing} =
-- impossible but harmless
pure unit
performAction AddTermChildren _
{ ngramsParent: Just parent
, ngramsChildren
, ngramsTablePatch
} = do
modifyState_ $ setParentResetChildren Nothing
commitPatch pt
where
pc = patchSetFromMap ngramsChildren
pe = NgramsPatch { patch_list: mempty, patch_children: pc }
pt = PatchMap $ Map.fromFoldable [Tuple parent pe]
-- TODO ROOT-UPDATE
-- patch the root of the child to be equal to the root of the parent.
render :: Render State Props' Action
render dispatch { path: {nodeId, mode}
, loaded: initTable
, dispatch: loaderDispatch }
{ ngramsTablePatch, ngramsParent, ngramsChildren, searchQuery }
_reactChildren =
[ T.tableElt
{ rows
, setParams: \params -> loaderDispatch (Loader.SetPath {nodeId, params, mode})
, container: tableContainer {searchQuery, dispatch, ngramsParent, ngramsChildren, ngramsTable}
, colNames:
T.ColumnName <$>
[ "Graph"
, "Stop"
, "Terms"
, "Occurences (nb)"
]
, totalRecords: 47361 -- TODO
}
]
where
ngramsTable = applyNgramsTablePatch ngramsTablePatch initTable
rows = convertRow <$> Map.toUnfoldable (Map.filter displayRow (ngramsTable ^. _NgramsTable))
isRoot (NgramsElement e) = e.parent == Nothing
-- TODO: There is a missing case where we display a row that we should not.
-- Assumptions:
-- * cats -> cat -> animal
-- * We are editing cats: ngramsParent == Just "cats"
-- * animal should not be listed since this would create a cycle!
displayRow e@(NgramsElement {ngrams, children, parent}) =
isRoot e
-- ^ Display only nodes with parents
&& (ngramsChildren ^. at ngrams /= Just true)
-- ^ and which are not scheduled to be added already.
&& (case ngramsParent of
Just p ->
ngrams /= p &&
-- ^ and which is not the node being currently edited.
not (Set.member p children)
-- ^ ... or one of its children.
Nothing -> true)
|| -- Unless they are scheduled to be removed.
(ngramsChildren ^. at ngrams == Just false)
convertRow (Tuple ngrams (NgramsElement { occurrences, list })) =
{ row:
renderNgramsItem { ngramsTable, ngrams, occurrences, ngramsParent, termList: list, dispatch }
, delete: false
}
initialPageParams :: Int -> Mode -> PageParams
initialPageParams nodeId mode = {nodeId, params: T.initialParams, mode}
type PageLoaderProps =
{ path :: PageParams
--, annuaireInfo :: Maybe (NodePoly AnnuaireInfo)
}
getTable :: PTabNgramType -> Maybe Int -> Aff NgramsTable
getTable tab = get <<< toUrl Back (Ngrams (TabPairing (TabNgramType tab)) Nothing)
modeTabType :: Mode -> PTabNgramType
modeTabType Patents = PTabPatents
modeTabType Books = PTabBooks
modeTabType Communication = PTabCommunication
loadPage :: PageParams -> Aff NgramsTable
loadPage {nodeId, mode} = getTable (modeTabType mode) (Just nodeId) -- TODO this ignores params
ngramsLoaderClass :: Loader.LoaderClass PageParams NgramsTable
ngramsLoaderClass = Loader.createLoaderClass "NgramsLoader" loadPage
ngramsLoader :: Loader.Props' PageParams NgramsTable -> ReactElement
ngramsLoader props = React.createElement ngramsLoaderClass props []
ngramsTableSpec :: Spec {} Props Void
ngramsTableSpec = simpleSpec defaultPerformAction render
where
render :: Render {} Props Void
render _ {path: nodeId, mode} _ _ =
-- TODO: ignored ignored loaded: annuaireInfo
[ ngramsLoader { path: initialPageParams nodeId mode
, component: createClass "NgramsTableLayout" ngramsTableSpec' initialState
} ]
tree :: { ngramsTable :: NgramsTable
, ngramsStyle :: Array DOM.Props
, ngramsClick :: NgramsTerm -> Maybe (Effect Unit)
} -> NgramsTerm -> ReactElement
tree params@{ngramsTable, ngramsStyle, ngramsClick} label =
li [ style {width : "100%"} ]
[ i icon []
, tag [text $ " " <> label]
, forest cs
]
where
tag =
case ngramsClick label of
Just effect ->
a (ngramsStyle <> [onClick $ const effect])
Nothing ->
span ngramsStyle
leaf = List.null cs
icon = gray <> [className $ "fas fa-caret-" <> if open then "down" else "right"]
open = not leaf || false {- TODO -}
gray = if leaf then [style {color: "#adb5bd"}] else []
cs = ngramsTable ^.. ix label <<< _NgramsElement <<< _children <<< folded
forest = ul [] <<< map (tree params) <<< List.toUnfoldable
renderNgramsTree :: { ngrams :: NgramsTerm
, ngramsTable :: NgramsTable
, ngramsStyle :: Array DOM.Props
, ngramsClick :: NgramsTerm -> Maybe (Effect Unit)
} -> ReactElement
renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick } =
ul [] [
span [className "tree"] [tree {ngramsTable, ngramsStyle, ngramsClick} ngrams]
]
renderNgramsItem :: { ngrams :: NgramsTerm
, ngramsTable :: NgramsTable
, occurrences :: Int
, termList :: TermList
, ngramsParent :: Maybe NgramsTerm
, dispatch :: Action -> Effect Unit
} -> Array ReactElement
renderNgramsItem { ngramsTable, ngrams, occurrences, termList, ngramsParent, dispatch } =
[ checkbox GraphTerm
, checkbox StopTerm
, if ngramsParent == Nothing
then renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick }
else
a [onClick $ const $ dispatch $ ToggleChild true ngrams]
[ i [className "fas fa-plus"] []
, span ngramsStyle [text $ " " <> ngrams]
]
, text $ show occurrences
]
where
ngramsStyle = [termStyle termList]
ngramsClick = Just <<< dispatch <<< SetParentResetChildren <<< Just
checkbox termList' =
let chkd = termList == termList'
termList'' = if chkd then CandidateTerm else termList'
in
input
[ _type "checkbox"
, className "checkbox"
, checked chkd
-- , title "Mark as completed"
, onChange $ const $ setTermList (replace termList termList'')
]
setTermList Keep = pure unit
setTermList rep@(Replace {old,new}) = dispatch $ SetTermListItem ngrams rep
termStyle :: TermList -> DOM.Props
termStyle GraphTerm = style {color: "green"}
termStyle StopTerm = style {color: "red", textDecoration : "line-through"}
termStyle CandidateTerm = style {color: "black"}
optps1 :: forall a. Show a => { desc :: String, mval :: Maybe a } -> ReactElement
optps1 { desc, mval } = option [value val] [text desc]
where
val = maybe "" show mval
unsafeEventValue :: forall event. event -> String
unsafeEventValue e = (unsafeCoerce e).target.value
src/Gargantext/Pages/Annuaire/User/Contacts/Tabs/Specs.purs 0 → 100644
View file @ 652ae8e2
-- TODO copy of Gargantext.Pages.Corpus.Tabs.Specs
module Gargantext.Pages.Annuaire.User.Contacts.Tabs.Specs where
import Prelude hiding (div)
import Data.List (fromFoldable)
import Data.Tuple (Tuple(..))
import Gargantext.Pages.Annuaire.User.Contacts.Types (Props)
import Gargantext.Pages.Annuaire.User.Contacts.Tabs.Documents as DV
import Gargantext.Pages.Annuaire.User.Contacts.Tabs.Ngrams.NgramsTable as NV
import Gargantext.Components.Tab as Tab
import Thermite (Spec, focus, hideState, noState, cmapProps)
pureTabs :: Spec {} Props Void
pureTabs = hideState (const {activeTab: 0}) statefulTabs
statefulTabs :: Spec Tab.State Props Tab.Action
statefulTabs =
Tab.tabs identity identity $ fromFoldable
[ Tuple "Documents" $ noState DV.docViewSpec
, Tuple "Patents" $ ngramsViewSpec {mode: NV.Patents}
, Tuple "Books" $ ngramsViewSpec {mode: NV.Books}
, Tuple "Communication" $ ngramsViewSpec {mode: NV.Communication}
, Tuple "Trash" $ noState DV.docViewSpec -- TODO pass-in trash mode
]
ngramsViewSpec :: {mode :: NV.Mode} -> Spec Tab.State Props Tab.Action
ngramsViewSpec {mode} =
cmapProps (\{loaded, path, dispatch} -> {mode,loaded,path, dispatch})
(noState NV.ngramsTableSpec)
src/Gargantext/Pages/Annuaire/User/Contacts/Types.purs
View file @ 652ae8e2
......@@ -11,10 +11,12 @@ import Data.Map (Map(..))
import React (ReactElement)
import React.DOM (div)
import Gargantext.Components.Loader as Loader
import Gargantext.Components.Tab as Tab
import Gargantext.Utils.DecodeMaybe ((.?|))
import Data.Newtype
-- TODO: should it be a NodePoly HyperdataContact ?
newtype Contact = Contact {
id :: Int
, typename :: Maybe Int
......@@ -166,29 +168,5 @@ instance decodeUser :: DecodeJson Contact where
, hyperdata
}
data Action
= TabA Tab.Action
| FetchContact Int
type State =
{ activeTab :: Int
, contact :: Maybe Contact
}
initialState :: State
initialState =
{ activeTab : 0
, contact: Nothing
}
_contact :: Lens' State (Maybe Contact)
_contact = lens (\s -> s.contact) (\s ss -> s{contact = ss})
_tablens :: Lens' State Tab.State
_tablens = lens (\s -> s.activeTab) (\s ss -> s {activeTab = ss})
_tabAction :: Prism' Action Tab.Action
_tabAction = prism TabA \ action ->
case action of
TabA laction -> Right laction
_-> Left action
type PropsRow = Loader.InnerPropsRow Int Contact ()
type Props = Record PropsRow
src/Gargantext/Pages/Corpus.purs
View file @ 652ae8e2
......@@ -19,33 +19,10 @@ import Gargantext.Config (toUrl, NodeType(..), End(..))
import Gargantext.Config.REST (get)
import Gargantext.Pages.Corpus.Tabs.Types (CorpusInfo(..))
import Gargantext.Pages.Corpus.Tabs.Types (Props) as Tabs
import Gargantext.Pages.Corpus.Tabs.States (State, initialState) as Tabs
import Gargantext.Pages.Corpus.Tabs.Actions (Action) as Tabs
import Gargantext.Pages.Corpus.Tabs.Specs (statefulTabs) as Tabs
import Gargantext.Pages.Corpus.Tabs.Specs (pureTabs) as Tabs
-------------------------------------------------------------------
type Props = Tabs.Props
type State = { tabsView :: Tabs.State
}
initialState :: Props -> State
initialState _props =
{ tabsView : Tabs.initialState {} }
------------------------------------------------------------------------
_tabsView :: forall a b. Lens' { tabsView :: a | b } a
_tabsView = lens (\s -> s.tabsView) (\s ss -> s{tabsView = ss})
------------------------------------------------------------------------
data Action
= TabsA Tabs.Action
_tabsAction :: Prism' Action Tabs.Action
_tabsAction = prism TabsA \ action ->
case action of
TabsA taction -> Right taction
-- _-> Left action
------------------------------------------------------------------------
layout :: Spec {} {nodeId :: Int} Void
layout = simpleSpec defaultPerformAction render
......@@ -53,12 +30,11 @@ layout = simpleSpec defaultPerformAction render
render :: Render {} {nodeId :: Int} Void
render _ {nodeId} _ _ =
[ corpusLoader { path: nodeId
, component: createClass "Layout" layout' initialState
, component: createClass "Layout" layout' (const {})
} ]
layout' :: Spec State Props Action
layout' = noState corpusHeaderSpec
<> focus _tabsView _tabsAction Tabs.statefulTabs
layout' :: Spec {} Props Void
layout' = corpusHeaderSpec <> Tabs.pureTabs
corpusHeaderSpec :: Spec {} Props Void
corpusHeaderSpec = simpleSpec defaultPerformAction render
......
src/Gargantext/Pages/Corpus/Tabs.purs
View file @ 652ae8e2
module Gargantext.Pages.Corpus.Tabs
( module Gargantext.Pages.Corpus.Tabs.States
, module Gargantext.Pages.Corpus.Tabs.Actions
, module Gargantext.Pages.Corpus.Tabs.Specs
( module Gargantext.Pages.Corpus.Tabs.Specs
) where
import Gargantext.Pages.Corpus.Tabs.States
import Gargantext.Pages.Corpus.Tabs.Actions
import Gargantext.Pages.Corpus.Tabs.Specs
src/Gargantext/Pages/Corpus/Tabs/Actions.purs deleted 100644 → 0
View file @ d898d51d
module Gargantext.Pages.Corpus.Tabs.Actions where
import Data.Lens (Prism', prism)
import Data.Either (Either(..))
import Gargantext.Components.Tab as Tab
data Action
= TabAction Tab.Action -- = ChangeTab which is only used locally
_TabAction :: Prism' Action Tab.Action
_TabAction = prism TabAction \ action ->
case action of
TabAction laction -> Right laction
_-> Left action
src/Gargantext/Pages/Corpus/Tabs/Documents.purs
View file @ 652ae8e2
......@@ -25,12 +25,11 @@ import React as React
import React (ReactClass, ReactElement, Children)
------------------------------------------------------------------------
import Gargantext.Prelude
import Gargantext.Config (Path(..), NodeType(..), TabType(..), toUrl, End(..), OrderBy(..))
import Gargantext.Config (Path(..), NodeType(..), TabSubType(..), TabType(..), toUrl, End(..), OrderBy(..))
import Gargantext.Config.REST (get, put, post, deleteWithBody)
import Gargantext.Utils.DecodeMaybe ((.|))
import Gargantext.Components.Charts.Options.ECharts (chart)
import Gargantext.Components.Loader as Loader
import Gargantext.Components.Table as T
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Table as T
import Gargantext.Pages.Corpus.Dashboard (globalPublis)
......@@ -74,9 +73,9 @@ newtype DocumentsView
}
derive instance genericCorpus :: Generic DocumentsView _
derive instance genericDocumentsView :: Generic DocumentsView _
instance showCorpus :: Show DocumentsView where
instance showDocumentsView :: Show DocumentsView where
show = genericShow
......@@ -203,7 +202,7 @@ loadPage :: PageParams -> Aff (Array DocumentsView)
loadPage {nodeId, params: {limit, offset, orderBy}} = do
logs "loading documents page: loadPage with Offset and limit"
--res <- get $ toUrl Back (Children Url_Document offset limit) nodeId
res <- get $ toUrl Back (Tab TabDocs offset limit (convOrderBy <$> orderBy)) (Just nodeId)
res <- get $ toUrl Back (Tab (TabCorpus TabDocs) offset limit (convOrderBy <$> orderBy)) (Just nodeId)
let docs = res2corpus <$> res
--_ <- logs "Ok: loading page documents"
--_ <- logs $ map show docs
......
src/Gargantext/Pages/Corpus/Tabs/Ngrams/NgramsTable.purs
View file @ 652ae8e2
module Gargantext.Pages.Corpus.Tabs.Ngrams.NgramsTable where
module Gargantext.Pages.Corpus.Tabs.Ngrams.NgramsTable
(Mode(..), ngramsTableSpec)
where
import Control.Monad.State (class MonadState, execState)
import Data.Argonaut (class DecodeJson, decodeJson, (.?), (.??))
......@@ -490,14 +491,14 @@ type PageLoaderProps =
--, corpusInfo :: Maybe (NodePoly CorpusInfo)
}
getTable :: TabType -> Maybe Int -> Aff NgramsTable
getTable tab = get <<< toUrl Back (Ngrams tab Nothing)
getTable :: CTabNgramType -> Maybe Int -> Aff NgramsTable
getTable tab = get <<< toUrl Back (Ngrams (TabCorpus (TabNgramType tab)) Nothing)
modeTabType :: Mode -> TabType
modeTabType Authors = TabAuthors
modeTabType Sources = TabSources
modeTabType Institutes = TabInstitutes
modeTabType Terms = TabTerms
modeTabType :: Mode -> CTabNgramType
modeTabType Authors = CTabAuthors
modeTabType Sources = CTabSources
modeTabType Institutes = CTabInstitutes
modeTabType Terms = CTabTerms
loadPage :: PageParams -> Aff NgramsTable
loadPage {nodeId, mode} = getTable (modeTabType mode) (Just nodeId) -- TODO this ignores params
......
src/Gargantext/Pages/Corpus/Tabs/Specs.purs
View file @ 652ae8e2
......@@ -6,21 +6,18 @@ import Data.List (fromFoldable)
import Data.Tuple (Tuple(..))
import Gargantext.Pages.Corpus.Tabs.Types (Props)
import Gargantext.Pages.Corpus.Tabs.States (State(), initialState, _activeTab)
import Gargantext.Pages.Corpus.Tabs.Actions (Action(), _TabAction)
import Gargantext.Pages.Corpus.Tabs.Documents as DV
import Gargantext.Pages.Corpus.Tabs.Ngrams.NgramsTable as NV
import Gargantext.Components.Tab as Tab
import Thermite (Spec, focus, hideState, noState, cmapProps)
pureTabs :: Spec {} Props Void
pureTabs = hideState (const {activeTab: 0}) statefulTabs
-- pureTabs :: Spec {} Props Void
-- pureTabs = hideState initialState statefulTabs
statefulTabs :: Spec State Props Action
statefulTabs :: Spec Tab.State Props Tab.Action
statefulTabs =
Tab.tabs _activeTab _TabAction $ fromFoldable
Tab.tabs identity identity $ fromFoldable
[ Tuple "Documents" $ noState DV.docViewSpec
, Tuple "Authors" $ ngramsViewSpec {mode: NV.Authors}
, Tuple "Sources" $ ngramsViewSpec {mode: NV.Sources}
......@@ -29,7 +26,7 @@ statefulTabs =
, Tuple "Trash" $ noState DV.docViewSpec -- TODO pass-in trash mode
]
ngramsViewSpec :: {mode :: NV.Mode} -> Spec State Props Action
ngramsViewSpec :: {mode :: NV.Mode} -> Spec Tab.State Props Tab.Action
ngramsViewSpec {mode} =
cmapProps (\{loaded, path, dispatch} -> {mode,loaded,path, dispatch})
(noState NV.ngramsTableSpec)
src/Gargantext/Pages/Corpus/Tabs/States.purs deleted 100644 → 0
View file @ d898d51d
module Gargantext.Pages.Corpus.Tabs.States where
import Data.Lens (Lens', lens)
import Gargantext.Components.Tab as Tab
type State =
{ activeTab :: Int
}
initialState :: {} -> State
initialState _ =
{ activeTab: 0
}
_activeTab :: Lens' State Tab.State
_activeTab = lens _.activeTab (\s ss -> s {activeTab = ss})
src/Gargantext/Pages/Layout.purs
View file @ 652ae8e2
......@@ -10,7 +10,6 @@ import Gargantext.Pages.Corpus.Document as Document
import Gargantext.Pages.Corpus.Graph as GE
-- import Gargantext.Pages.Corpus.Tabs.Terms.NgramsTable as NG
import Gargantext.Pages.Annuaire.User.Contacts as C
-- import Gargantext.Pages.Home as L
-- import Gargantext.Pages.Layout.Specs.Search as S
import Gargantext.Router (Routes(..))
......@@ -40,13 +39,9 @@ dispatchAction dispatcher _ SearchView = do
dispatchAction dispatcher _ (UserPage id) = do
dispatcher $ SetRoute $ UserPage id
-- dispatcher $ UserPageA TODO
dispatcher $ UserPageA $ C.FetchContact id
dispatchAction dispatcher _ (ContactPage id) = do
dispatcher $ SetRoute $ ContactPage id
-- dispatcher $ UserPageA TODO
dispatcher $ UserPageA $ C.FetchContact id
dispatchAction dispatcher _ (Annuaire id) = do
dispatcher $ SetRoute $ Annuaire id
......
src/Gargantext/Pages/Layout/Actions.purs
View file @ 652ae8e2
......@@ -12,7 +12,6 @@ import Routing.Hash (setHash)
import Gargantext.Components.Login as LN
import Gargantext.Components.Modals.Modal (modalShow)
import Gargantext.Pages.Annuaire as Annuaire
import Gargantext.Pages.Annuaire.User.Contacts as C
import Gargantext.Pages.Corpus.Document as D
import Gargantext.Pages.Corpus.Graph as GE
import Gargantext.Pages.Layout.Specs.AddCorpus as AC
......@@ -32,7 +31,6 @@ data Action
| GraphExplorerA GE.Action
| DocumentViewA D.Action
| AnnuaireAction Annuaire.Action
| UserPageA C.Action
| Go
| ShowLogin
| Logout
......@@ -76,7 +74,6 @@ performAction Go _ _ = void do
performAction (LoginA _) _ _ = pure unit
performAction (AddCorpusA _) _ _ = pure unit
performAction (SearchA _) _ _ = pure unit
performAction (UserPageA _) _ _ = pure unit
performAction (DocumentViewA _) _ _ = pure unit
performAction (GraphExplorerA _) _ _ = pure unit
performAction (AnnuaireAction _) _ _ = pure unit
......@@ -101,12 +98,6 @@ _searchAction = prism SearchA \action ->
SearchA caction -> Right caction
_-> Left action
_userPageAction :: Prism' Action C.Action
_userPageAction = prism UserPageA \action ->
case action of
UserPageA caction -> Right caction
_-> Left action
_annuaireAction :: Prism' Action Annuaire.Action
_annuaireAction = prism AnnuaireAction \action ->
case action of
......
src/Gargantext/Pages/Layout/Specs.purs
View file @ 652ae8e2
......@@ -23,10 +23,10 @@ import Gargantext.Pages.Corpus.Document as Annotation
import Gargantext.Pages.Corpus.Dashboard as Dsh
import Gargantext.Pages.Corpus.Graph as GE
import Gargantext.Pages.Home as L
import Gargantext.Pages.Layout.Actions (Action(..), _addCorpusAction, _documentViewAction, _graphExplorerAction, _loginAction, _searchAction, _userPageAction, performAction)
import Gargantext.Pages.Layout.Actions (Action(..), _addCorpusAction, _documentViewAction, _graphExplorerAction, _loginAction, _searchAction, performAction)
import Gargantext.Pages.Layout.Specs.AddCorpus as AC
import Gargantext.Pages.Layout.Specs.Search as S
import Gargantext.Pages.Layout.States (AppState, _addCorpusState, _documentViewState, _graphExplorerState, _loginState, _searchState, _userPageState)
import Gargantext.Pages.Layout.States (AppState, _addCorpusState, _documentViewState, _graphExplorerState, _loginState, _searchState)
import Gargantext.Router (Routes(..))
layoutSpec :: Spec AppState {} Action
......@@ -63,8 +63,8 @@ pagesComponent s = case s.currentRoute of
selectSpec Dashboard = layout0 $ noState Dsh.layoutDashboard
selectSpec (Annuaire i) = layout0 $ cmapProps (const {annuaireId: i}) $ noState A.layout
selectSpec (UserPage i) = layout0 $ focus _userPageState _userPageAction C.layoutUser
selectSpec (ContactPage i) = layout0 $ focus _userPageState _userPageAction C.layoutUser
selectSpec (UserPage i) = layout0 $ cmapProps (const {nodeId: i}) $ noState C.layoutUser
selectSpec (ContactPage i) = layout0 $ cmapProps (const {nodeId: i}) $ noState C.layoutUser
-- selectSpec _ = simpleSpec defaultPerformAction defaultRender
......
src/Gargantext/Pages/Layout/States.purs
View file @ 652ae8e2
......@@ -9,7 +9,6 @@ import Gargantext.Components.Login as LN
import Gargantext.Pages.Corpus.Document as D
import Gargantext.Pages.Corpus.Graph as GE
import Gargantext.Pages.Annuaire.User.Contacts as C
import Gargantext.Pages.Layout.Specs.AddCorpus as AC
import Gargantext.Pages.Layout.Specs.Search as S
import Gargantext.Router (Routes(..))
......@@ -19,7 +18,6 @@ type AppState =
, loginState :: LN.State
, addCorpusState :: AC.State
, searchState :: S.State
, userPageState :: C.State
, documentState :: D.State
, search :: String
, showLogin :: Boolean
......@@ -36,7 +34,6 @@ initAppState = do
, loginState
, addCorpusState : AC.initialState
, searchState : S.initialState
, userPageState : C.initialState
, documentState : D.initialState {}
, search : ""
, showLogin : false
......@@ -55,9 +52,6 @@ _addCorpusState = lens (\s -> s.addCorpusState) (\s ss -> s{addCorpusState = ss}
_searchState :: Lens' AppState S.State
_searchState = lens (\s -> s.searchState) (\s ss -> s{searchState = ss})
_userPageState :: Lens' AppState C.State
_userPageState = lens (\s -> s.userPageState) (\s ss -> s{userPageState = ss})
_documentViewState :: Lens' AppState D.State
_documentViewState = lens (\s -> s.documentState) (\s ss -> s{documentState = ss})
......
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