pax_global_header 0000666 0000000 0000000 00000000064 14111104351 0014501 g ustar 00root root 0000000 0000000 52 comment=1450f95fd332af37a214c0f0a0fb123c88604dc3
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/ 0000775 0000000 0000000 00000000000 14111104351 0023521 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/ 0000775 0000000 0000000 00000000000 14111104351 0024310 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/ 0000775 0000000 0000000 00000000000 14111104351 0026414 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/AsyncTasks.purs 0000664 0000000 0000000 00000007171 14111104351 0031420 0 ustar 00root root 0000000 0000000 module Gargantext.AsyncTasks where
import Gargantext.Prelude
import Data.Array as A
import Data.Either (Either(..))
import Data.Map as Map
import Data.Maybe (Maybe(..), maybe, fromMaybe)
import DOM.Simple.Console (log2)
import Effect (Effect)
import Reactix as R
import Simple.JSON as JSON
import Toestand as T
import Web.Storage.Storage as WSS
import Gargantext.Types as GT
import Gargantext.Utils as GU
import Gargantext.Utils.JSON as GUJ
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
localStorageKey :: String
localStorageKey = "garg-async-tasks"
type TaskList = Array GT.AsyncTaskWithType
newtype Storage = Storage (Map.Map GT.NodeID TaskList)
instance JSON.ReadForeign Storage where
readImpl f = do
m <- GUJ.readMapInt f
pure $ Storage m
empty :: Storage
empty = Storage $ Map.empty
getAsyncTasks :: Effect Storage
getAsyncTasks = R2.getls >>= WSS.getItem localStorageKey >>= handleMaybe
where
handleMaybe (Just val) = handleEither (parse val)
handleMaybe Nothing = pure empty
-- either parsing or decoding could fail, hence two errors
handleEither (Left err) = err *> pure empty
handleEither (Right ss) = pure ss
parse s = GU.mapLeft (log2 "Error parsing serialised sessions:") (JSON.readJSON s)
getTasks :: GT.NodeID -> Storage -> TaskList
getTasks nodeId (Storage storage) = fromMaybe [] $ Map.lookup nodeId storage
setTasks :: GT.NodeID -> TaskList -> Storage -> Storage
setTasks id tasks (Storage s) = Storage $ Map.insert id tasks s
focus :: GT.NodeID -> T.Box Storage -> R.Hooks (T.Box TaskList)
focus id tasks = T.useFocused (getTasks id) (setTasks id) tasks
removeTaskFromList :: TaskList -> GT.AsyncTaskWithType -> TaskList
removeTaskFromList ts (GT.AsyncTaskWithType { task: GT.AsyncTask { id: id' } }) =
A.filter (\(GT.AsyncTaskWithType { task: GT.AsyncTask { id: id'' } }) -> id' /= id'') ts
type ReductorProps = (
reloadForest :: T2.ReloadS
, reloadRoot :: T2.ReloadS
, storage :: Storage
)
insert :: GT.NodeID -> GT.AsyncTaskWithType -> T.Box Storage -> Effect Unit
insert id task storage = T.modify_ newStorage storage
where
newStorage (Storage s) = Storage $ Map.alter (maybe (Just [task]) (\ts -> Just $ A.cons task ts)) id s
finish :: GT.NodeID -> GT.AsyncTaskWithType -> T.Box Storage -> Effect Unit
finish id task storage = remove id task storage
remove :: GT.NodeID -> GT.AsyncTaskWithType -> T.Box Storage -> Effect Unit
remove id task storage = T.modify_ newStorage storage
where
newStorage (Storage s) = Storage $ Map.alter (maybe Nothing $ (\ts -> Just $ removeTaskFromList ts task)) id s
-- When a task is finished: which tasks cause forest or app reload
asyncTaskTriggersAppReload :: GT.AsyncTaskType -> Boolean
asyncTaskTriggersAppReload _ = false
asyncTaskTTriggersAppReload :: GT.AsyncTaskWithType -> Boolean
asyncTaskTTriggersAppReload (GT.AsyncTaskWithType { typ }) = asyncTaskTriggersAppReload typ
asyncTaskTriggersMainPageReload :: GT.AsyncTaskType -> Boolean
asyncTaskTriggersMainPageReload GT.UpdateNgramsCharts = true
asyncTaskTriggersMainPageReload _ = false
asyncTaskTTriggersMainPageReload :: GT.AsyncTaskWithType -> Boolean
asyncTaskTTriggersMainPageReload (GT.AsyncTaskWithType { typ }) = asyncTaskTriggersMainPageReload typ
asyncTaskTriggersTreeReload :: GT.AsyncTaskType -> Boolean
asyncTaskTriggersTreeReload GT.Form = true
asyncTaskTriggersTreeReload GT.UploadFile = true
asyncTaskTriggersTreeReload _ = false
asyncTaskTTriggersTreeReload :: GT.AsyncTaskWithType -> Boolean
asyncTaskTTriggersTreeReload (GT.AsyncTaskWithType { typ }) = asyncTaskTriggersTreeReload typ
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Classes.purs 0000664 0000000 0000000 00000000131 14111104351 0030717 0 ustar 00root root 0000000 0000000 module Gargantext.Classes where
textCenter = "text-center"
formControl = "formControl"
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/ 0000775 0000000 0000000 00000000000 14111104351 0030541 5 ustar 00root root 0000000 0000000 Annotation/ 0000775 0000000 0000000 00000000000 14111104351 0032574 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components AnnotatedField.purs 0000664 0000000 0000000 00000015442 14111104351 0036376 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Annotation -- | The AnnotatedField Component is for colouring ngrams that appear in a text
-- |
-- | Given an array of ngrams and a text, it:
-- |
-- | 1. Searches the text for the ngrams
-- | 2. Renders each the resulting runs according to the Maybe TermList they appear in
-- |
-- | Notes:
-- |
-- | 1. We must only re-search the text when the ngrams change for performance
-- | 2. We will need a more ambitious search algorithm for skipgrams.
module Gargantext.Components.Annotation.AnnotatedField where
import Data.Array as A
import Data.List (List(..), (:))
import Data.Maybe ( Maybe(..), maybe )
import Data.String.Common ( joinWith )
import Data.Tuple (Tuple(..), snd)
import Data.Tuple.Nested ( (/\) )
import DOM.Simple.Event as DE
import Effect (Effect)
import Reactix as R
import Reactix.DOM.HTML as HTML
import Reactix.SyntheticEvent as E
import Record as Record
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.Annotation.Menu ( annotationMenuWrapper, AnnotationMenu, MenuType(..) )
import Gargantext.Components.Annotation.Utils (termClass)
import Gargantext.Components.NgramsTable.Core (NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams, normNgram)
import Gargantext.Types (CTabNgramType(..), TermList)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Selection as Sel
here :: R2.Here
here = R2.here "Gargantext.Components.Annotation.AnnotatedField"
type Props =
( ngrams :: NgramsTable
, setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit
, text :: Maybe String
)
type MouseEvent = E.SyntheticEvent DE.MouseEvent
-- UNUSED
-- defaultProps :: Record Props
-- defaultProps = { ngrams: NgramsTable Map.empty, text: Nothing, setTermList: \_ _ _ -> pure unit }
annotatedField :: R2.Component Props
annotatedField = R.createElement annotatedFieldCpt
annotatedFieldCpt :: R.Component Props
annotatedFieldCpt = here.component "annotatedField" cpt where
cpt props _ = do
menuRef <- R.useRef (Nothing :: Maybe (Record AnnotationMenu))
redrawMenu <- T.useBox false
pure $ annotatedFieldInner (Record.merge { menuRef, redrawMenu } props)
type InnerProps =
(
menuRef :: R.Ref (Maybe (Record AnnotationMenu))
, redrawMenu :: T.Box Boolean
| Props
)
annotatedFieldInner :: R2.Leaf InnerProps
annotatedFieldInner p = R.createElement annotatedFieldInnerCpt p []
annotatedFieldInnerCpt :: R.Component InnerProps
annotatedFieldInnerCpt = here.component "annotatedFieldInner" cpt where
cpt { menuRef, ngrams, redrawMenu, setTermList, text: fieldText } _ = do
redrawMenu' <- T.useLive T.unequal redrawMenu
-- menu <- T.useBox (Nothing :: Maybe (Record AnnotationMenu))
let wrap (text /\ list) = { list
, onSelect: onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList }
, text }
pure $ HTML.div { className: "annotated-field-wrapper" }
[ annotationMenuWrapper { menuRef }
, HTML.div { className: "annotated-field-runs" }
((\p -> annotateRun p []) <$> wrap <$> compile ngrams fieldText)
]
compile :: NgramsTable -> Maybe String -> Array (Tuple String (List (Tuple NgramsTerm TermList)))
compile ngrams = maybe [] (highlightNgrams CTabTerms ngrams)
-- Runs
onAnnotationSelect :: forall e. DE.IsMouseEvent e => { menuRef :: R.Ref (Maybe (Record AnnotationMenu))
, ngrams :: NgramsTable
, redrawMenu :: T.Box Boolean
, setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit }
-> Maybe (Tuple NgramsTerm TermList) -> E.SyntheticEvent e -> Effect Unit
onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList } Nothing event = do
s <- Sel.getSelection
case s of
Just sel -> do
case Sel.selectionToString sel of
"" -> hideMenu { menuRef, redrawMenu }
sel' -> do
showMenu { event
, getList: findNgramTermList ngrams
, menuRef
, menuType: NewNgram
, ngram: normNgram CTabTerms sel'
, redrawMenu
, setTermList }
Nothing -> hideMenu { menuRef, redrawMenu }
onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList } (Just (Tuple ngram list)) event = do
showMenu { event
, getList: const (Just list)
, menuRef
, menuType: SetTermListItem
, ngram
, redrawMenu
, setTermList }
-- showMenu :: forall p e. DE.IsMouseEvent e => { event :: E.SyntheticEvent e | p } -> Effect Unit
showMenu :: forall e. DE.IsMouseEvent e => { event :: E.SyntheticEvent e
, getList :: NgramsTerm -> Maybe TermList
, menuRef :: R.Ref (Maybe (Record AnnotationMenu))
, menuType :: MenuType
, ngram :: NgramsTerm
, redrawMenu :: T.Box Boolean
, setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit }
-> Effect Unit
showMenu { event, getList, menuRef, menuType, ngram, redrawMenu, setTermList } = do
let x = E.clientX event
y = E.clientY event
-- n = normNgram CTabTerms text
list = getList ngram
-- redrawMenu = T.modify not redrawMenu
setList t = do
setTermList ngram list t
hideMenu { menuRef, redrawMenu }
E.preventDefault event
--range <- Sel.getRange sel 0
--here.log2 "selection range" $ Sel.rangeToTuple range
let menu = Just
{ list
, menuType
, onClose: hideMenu { menuRef, redrawMenu }
, redrawMenu
, setList
, x
, y }
R.setRef menuRef menu
T.modify_ not redrawMenu
hideMenu { menuRef, redrawMenu } = do
R.setRef menuRef Nothing
T.modify_ not redrawMenu
type Run =
( list :: List (Tuple NgramsTerm TermList)
, onSelect :: Maybe (Tuple NgramsTerm TermList) -> MouseEvent -> Effect Unit
, text :: String
)
annotateRun :: R2.Component Run
annotateRun = R.createElement annotatedRunCpt
annotatedRunCpt :: R.Component Run
annotatedRunCpt = here.component "annotatedRun" cpt
where
cpt { list, onSelect, text } _ = do
let el = case list of
Nil -> HTML.span { on: { mouseUp: onSelect Nothing } } [ HTML.text text ]
lst@(( ngram /\ list' ) : otherLists) ->
let bgClasses = joinWith " " $ A.fromFoldable $ termClass <<< snd <$> lst
className = "annotation-run " <> bgClasses
in
HTML.span { className
, on: { click: onSelect (Just (ngram /\ list')) } } [ HTML.text text ]
pure $ el
Menu.purs 0000664 0000000 0000000 00000007350 14111104351 0034420 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Annotation -- | A ContextMenU that allows you to add terms to a list
module Gargantext.Components.Annotation.Menu where
import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Maybe (Maybe(..))
import Effect (Effect)
import Effect.Uncurried (mkEffectFn1)
import Reactix as R
import Reactix.DOM.HTML as HTML
import Toestand as T
import Gargantext.Prelude
import Gargantext.Types (TermList(..), termListName)
import Gargantext.Components.Annotation.Utils (termBootstrapClass)
import Gargantext.Components.ContextMenu.ContextMenu as CM
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Annotation.Menu"
data MenuType = NewNgram | SetTermListItem
derive instance Generic MenuType _
instance Eq MenuType where
eq = genericEq
type Props =
( list :: Maybe TermList
, menuType :: MenuType
, setList :: TermList -> Effect Unit -- not a state hook setter
)
type AnnotationMenu = (
onClose :: Effect Unit
, redrawMenu :: T.Box Boolean
, x :: Number
, y :: Number
| Props
)
type AnnotationMenuWrapper =
(
menuRef :: R.Ref (Maybe (Record AnnotationMenu))
)
eqAnnotationMenu :: Record AnnotationMenu -> Record AnnotationMenu -> Boolean
eqAnnotationMenu new old = new.list == old.list &&
new.menuType == old.menuType &&
new.x == old.x &&
new.y == old.y
eqAnnotationMenuWrapper :: { new :: Maybe (Record AnnotationMenu)
, old :: Maybe (Record AnnotationMenu) } -> Effect Boolean
eqAnnotationMenuWrapper { new: Nothing, old: Nothing } = pure $ true
eqAnnotationMenuWrapper { new: Nothing, old: Just _ } = pure $ false
eqAnnotationMenuWrapper { new: Just _, old: Nothing } = pure $ false
eqAnnotationMenuWrapper { new: Just n, old: Just o } = pure $ eqAnnotationMenu n o
annotationMenuWrapper :: R2.Leaf AnnotationMenuWrapper
annotationMenuWrapper p = R.createElement annotationMenuWrapperCpt p []
annotationMenuWrapperCpt :: R.Component AnnotationMenuWrapper
annotationMenuWrapperCpt = here.component "annotationMenuWrapper" cpt where
cpt { menuRef } _ = do
case R.readRef menuRef of
Nothing -> pure $ HTML.div {} []
Just menu -> pure $ annotationMenu menu
-- | An Annotation Menu is parameterised by a Maybe Termlist of the
-- | TermList the currently selected text belongs to
annotationMenu :: R2.Leaf AnnotationMenu
annotationMenu p = R.createElement annotationMenuCpt p []
annotationMenuCpt :: R.Component AnnotationMenu
annotationMenuCpt = here.component "annotationMenu" cpt where
cpt { x, y, list, menuType, onClose, redrawMenu, setList } _ = do
redrawMenu' <- T.useLive T.unequal redrawMenu
pure $ CM.contextMenu {x, y, onClose} [
annotationMenuInner { list, menuType, setList }
]
annotationMenuInner :: R2.Leaf Props
annotationMenuInner p = R.createElement annotationMenuInnerCpt p []
annotationMenuInnerCpt :: R.Component Props
annotationMenuInnerCpt = here.component "annotationMenuInner" cpt where
cpt props _ = pure $ R.fragment $ A.mapMaybe (addToList props) [ MapTerm, CandidateTerm, StopTerm ]
-- | Given the TermList to render the item for zand the Maybe TermList the item may belong to, possibly render the menuItem
addToList :: Record Props -> TermList -> Maybe R.Element
addToList {list: Just t'} t
| t == t' = Nothing
addToList {menuType, setList} t = Just $ CM.contextMenuItem {} [ link ]
where
link = HTML.a { on: { click }, className: className } [ HTML.text (label menuType) ]
label NewNgram = "Add to " <> termListName t
label SetTermListItem = "Change to " <> termListName t
className = "list-group-item list-group-item-" <> (termBootstrapClass t)
click _ = setList t
Utils.purs 0000664 0000000 0000000 00000000701 14111104351 0034605 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Annotation module Gargantext.Components.Annotation.Utils where
import Gargantext.Types ( TermList(..) )
termClass :: TermList -> String
termClass CandidateTerm = "candidate-term"
termClass MapTerm = "graph-term"
termClass StopTerm = "stop-term"
termBootstrapClass :: TermList -> String
-- termBootstrapClass CandidateTerm = "warning"
termBootstrapClass MapTerm = "success"
termBootstrapClass StopTerm = "danger"
termBootstrapClass CandidateTerm = "primary"
App.purs 0000664 0000000 0000000 00000002631 14111104351 0032117 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components module Gargantext.Components.App (app) where
import Reactix as R
import Toestand as T
import Gargantext.Prelude
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.App.Data (emptyApp)
import Gargantext.Components.Router (router)
import Gargantext.Hooks (useHashRouter)
import Gargantext.Router as Router
import Gargantext.Sessions as Sessions
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.App"
app :: R2.Component ()
app = R.createElement appCpt
appCpt :: R.Component ()
appCpt = here.component "app" cpt where
cpt _ _ = do
box <- T.useBox emptyApp -- global data
boxes <- T.useFocusedFields box {} -- read-write access for children
-- tasks <- T.useBox Nothing -- storage for asynchronous tasks reductor
R.useEffectOnce' $ do
void $ Sessions.load boxes.sessions
-- tasks <- GAT.useTasks boxes.reloadRoot boxes.reloadForest
R.useEffectOnce' $ do
tasksStorage <- GAT.getAsyncTasks
T.write_ tasksStorage boxes.tasks
-- R.useEffectOnce' $ do
-- T.write (Just tasksReductor) tasks
R.useEffectOnce' $ do
R2.loadLocalStorageState R2.openNodesKey boxes.forestOpen
T.listen (R2.listenLocalStorageState R2.openNodesKey) boxes.forestOpen
useHashRouter Router.router boxes.route -- Install router to window
pure $ router { boxes } -- Render router component
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/App/ 0000775 0000000 0000000 00000000000 14111104351 0031261 5 ustar 00root root 0000000 0000000 Data.purs 0000664 0000000 0000000 00000005516 14111104351 0032775 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/App module Gargantext.Components.App.Data (App, Boxes, emptyApp) where
import Gargantext.Prelude
import Data.Maybe (Maybe(..))
import Data.Set as Set
import Toestand as T
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.GraphExplorer.Sidebar.Types as GEST
import Gargantext.Components.Nodes.Lists.Types as ListsT
import Gargantext.Components.Nodes.Texts.Types as TextsT
import Gargantext.Ends (Backend)
import Gargantext.Routes (AppRoute(Home))
import Gargantext.Sessions (Session, Sessions)
import Gargantext.Sessions as Sessions
import Gargantext.Sessions.Types (OpenNodes(..))
import Gargantext.Types (FrontendError, Handed(RightHanded), SidePanelState(..))
import Gargantext.Utils.Toestand as T2
type App =
{ backend :: Maybe Backend
, errors :: Array FrontendError
, forestOpen :: OpenNodes
, graphVersion :: T2.Reload
, handed :: Handed
, reloadForest :: T2.Reload
, reloadMainPage :: T2.Reload
, reloadRoot :: T2.Reload
, route :: AppRoute
, session :: Maybe Session
, sessions :: Sessions
, showCorpus :: Boolean
, showLogin :: Boolean
, showTree :: Boolean
, sidePanelGraph :: Maybe (Record GEST.SidePanel)
, sidePanelLists :: Maybe (Record ListsT.SidePanel)
, sidePanelTexts :: Maybe (Record TextsT.SidePanel)
, sidePanelState :: SidePanelState
, tasks :: GAT.Storage
}
emptyApp :: App
emptyApp =
{ backend : Nothing
, errors : []
, forestOpen : OpenNodes $ Set.empty
, graphVersion : T2.newReload
, handed : RightHanded
, reloadForest : T2.newReload
, reloadMainPage : T2.newReload
, reloadRoot : T2.newReload
, route : Home
, session : Nothing
, sessions : Sessions.empty
, showCorpus : false
, showLogin : false
, showTree : true
, sidePanelGraph : GEST.initialSidePanel
, sidePanelLists : ListsT.initialSidePanel
, sidePanelTexts : TextsT.initialSidePanel
, sidePanelState : InitialClosed
, tasks : GAT.empty
}
type Boxes =
{ backend :: T.Box (Maybe Backend)
, errors :: T.Box (Array FrontendError)
, forestOpen :: T.Box OpenNodes
, graphVersion :: T2.ReloadS
, handed :: T.Box Handed
, reloadForest :: T2.ReloadS
, reloadMainPage :: T2.ReloadS
, reloadRoot :: T2.ReloadS
, route :: T.Box AppRoute
, session :: T.Box (Maybe Session)
, sessions :: T.Box Sessions
, showCorpus :: T.Box Boolean
, showLogin :: T.Box Boolean
, showTree :: T.Box Boolean
, sidePanelGraph :: T.Box (Maybe (Record GEST.SidePanel))
, sidePanelLists :: T.Box (Maybe (Record ListsT.SidePanel))
, sidePanelTexts :: T.Box (Maybe (Record TextsT.SidePanel))
, sidePanelState :: T.Box SidePanelState
, tasks :: T.Box GAT.Storage
}
AutoUpdate.purs 0000664 0000000 0000000 00000004020 14111104351 0033444 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components module Gargantext.Components.AutoUpdate where
import Data.Maybe (Maybe(..))
import Data.Traversable (traverse_)
import React as React
import React (ReactClass, ReactElement, Children)
import React.DOM (div')
import Effect (Effect)
import Effect.Timer (IntervalId, TimeoutId, setInterval, clearInterval, setTimeout, clearTimeout)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2
here = R2.here "Gargantext.Components.AutoUpdate"
data Action = Update
type PropsRow =
( duration :: Int
, effect :: Effect Unit
)
type Props = { | PropsRow }
type State = { intervalId :: Maybe IntervalId }
autoUpdateClass :: ReactClass { children :: Children | PropsRow }
autoUpdateClass =
React.component "AutoUpdate"
(\this -> do
pure { state: {intervalId: Nothing}
, render: pure $ div' []
, componentDidMount: do
{duration, effect} <- React.getProps this
intervalId <- setInterval duration effect
React.setState this {intervalId: Just intervalId}
, componentWillUnmount: do
{intervalId} <- React.getState this
traverse_ clearInterval intervalId
})
autoUpdateElt :: Props -> ReactElement
autoUpdateElt props = React.createElement autoUpdateClass props []
autoUpdate :: Record PropsRow -> R.Element
autoUpdate props = R.createElement autoUpdateCpt props []
autoUpdateCpt :: R.Component PropsRow
autoUpdateCpt = here.component "autoUpdate" cpt
where
cpt { duration, effect } _ = do
intervalRef <- R.useRef Nothing
R.useEffect' $ do
let mInterval = R.readRef intervalRef
case mInterval of
Nothing -> do
intervalId <- setInterval duration effect
R.setRef intervalRef $ Just intervalId
Just intervalId -> do
clearInterval intervalId
intervalId <- setInterval duration effect
R.setRef intervalRef $ Just intervalId
pure $ H.div {} []
Category.purs 0000664 0000000 0000000 00000012276 14111104351 0033162 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components -- TODO: this module should be replaced by FacetsTable
module Gargantext.Components.Category where
import Gargantext.Prelude
import Data.Array as A
import Data.Either (Either)
import Data.Generic.Rep (class Generic)
import Data.Map as Map
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff, launchAff)
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Gargantext.Components.Category.Types (Category(..), Star(..), cat2score, categories, clickAgain, star2score, stars)
import Gargantext.Components.DocsTable.Types (DocumentsView(..), LocalCategories, LocalUserScore)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, put)
import Gargantext.Types (NodeID, NodeType(..))
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Category"
type RatingProps =
( score :: Star
, nodeId :: NodeID
, row :: DocumentsView
, session :: Session
, setLocalCategories :: R.Setter LocalUserScore
)
rating :: R2.Component RatingProps
rating = R.createElement ratingCpt
ratingCpt :: R.Component RatingProps
ratingCpt = here.component "rating" cpt where
cpt { nodeId, row: DocumentsView r, score, session, setLocalCategories } _ =
pure $ H.div { className:"flex" } divs where
divs = map (\s -> H.div { className : icon' score s
, on: { click: onClick s } } []) stars
icon' Star_0 Star_0 = "fa fa-times-circle"
icon' _ Star_0 = "fa fa-times"
icon' c s = if star2score c < star2score s then "fa fa-star-o" else "fa fa-star"
onClick c _ = do
let c' = if score == c
then clickAgain c
else c
setLocalCategories $ Map.insert r._id c'
void $ launchAff
$ putRating session nodeId
$ RatingQuery { nodeIds: [r._id], rating: c' }
newtype RatingQuery =
RatingQuery { nodeIds :: Array Int
, rating :: Star
}
derive instance Generic RatingQuery _
instance JSON.WriteForeign RatingQuery where
writeImpl (RatingQuery post) = JSON.writeImpl { ntc_nodesId: post.nodeIds
, ntc_category: post.rating }
putRating :: Session -> Int -> RatingQuery -> Aff (Either RESTError (Array Int))
putRating session nodeId = put session $ ratingRoute where
ratingRoute = NodeAPI Node (Just nodeId) "category"
type CarousselProps =
( category :: Category
, nodeId :: NodeID
, row :: DocumentsView
, session :: Session
, setLocalCategories :: R.Setter LocalCategories
)
caroussel :: R2.Component CarousselProps
caroussel = R.createElement carousselCpt
carousselCpt :: R.Component CarousselProps
carousselCpt = here.component "caroussel" cpt
where
cpt { category, nodeId, row: DocumentsView r, session, setLocalCategories } _ = do
pure $ H.div {className:"flex"} divs
where
divs = map (\c -> if category == c
then
H.div { className : icon c (category == c) } []
else
H.div { className : icon c (category == c)
, on: { click: onClick c}
} []
) (caroussel' category)
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 $ "fa fa-" <> (color $ size b $ icon' cat b)
where
icon' :: Category -> Boolean -> String
icon' Trash false = "times"
icon' Trash true = "times-circle"
icon' UnRead false = "question"
icon' UnRead true = "question-circle"
icon' Checked false = "check"
icon' Checked true = "check-circle"
icon' Topic false = "star-o"
icon' Topic true = "star"
icon' Favorite false = "heart-o"
icon' Favorite true = "heart"
size :: Boolean -> String -> String
size true s = s <> " btn-lg"
size false s = s <> " btn-sm"
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
}
derive instance Generic CategoryQuery _
instance JSON.WriteForeign CategoryQuery where
writeImpl (CategoryQuery post) = JSON.writeImpl { ntc_nodesId: post.nodeIds
, ntc_category: post.category }
categoryRoute :: Int -> SessionRoute
categoryRoute nodeId = NodeAPI Node (Just nodeId) "category"
putCategories :: Session -> Int -> CategoryQuery -> Aff (Either RESTError (Array Int))
putCategories session nodeId = put session $ categoryRoute nodeId
Category/ 0000775 0000000 0000000 00000000000 14111104351 0032237 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components Types.purs 0000664 0000000 0000000 00000004247 14111104351 0034265 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Category module Gargantext.Components.Category.Types where
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Show.Generic (genericShow)
import Simple.JSON as JSON
import Gargantext.Prelude
------------------------------------------------------------------------
data Star = Star_0 | Star_1 | Star_2 | Star_3 | Star_4
stars :: Array Star
stars = [Star_0, Star_1, Star_2, Star_3, Star_4]
derive instance Generic Star _
instance Show Star where show = genericShow
instance Eq Star where eq = genericEq
instance JSON.ReadForeign Star where
readImpl f = do
inst <- JSON.readImpl f
pure $ decodeStar inst
instance JSON.WriteForeign Star where writeImpl = JSON.writeImpl <<< star2score
decodeStar :: Int -> Star
decodeStar 0 = Star_0
decodeStar 1 = Star_1
decodeStar 2 = Star_2
decodeStar 3 = Star_3
decodeStar 4 = Star_4
decodeStar _ = Star_4
star2score :: Star -> Int
star2score Star_0 = 0
star2score Star_1 = 1
star2score Star_2 = 2
star2score Star_3 = 3
star2score Star_4 = 4
clickAgain :: Star -> Star
clickAgain Star_0 = Star_1
clickAgain s = decodeStar (star2score s - 1)
------------------------------------------------------------------------
data Category = Trash | UnRead | Checked | Topic | Favorite
categories :: Array Category
categories = [Trash, UnRead, Checked, Topic, Favorite]
derive instance Generic Category _
instance Show Category where show = genericShow
instance Eq Category where eq = genericEq
instance JSON.ReadForeign Category where
readImpl f = do
inst <- JSON.readImpl f
pure $ decodeCategory inst
instance JSON.WriteForeign Category where writeImpl = JSON.writeImpl <<< cat2score
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
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Charts/0000775 0000000 0000000 00000000000 14111104351 0031765 5 ustar 00root root 0000000 0000000 Options/ 0000775 0000000 0000000 00000000000 14111104351 0033341 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Charts Color.purs 0000664 0000000 0000000 00000001570 14111104351 0035335 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Charts/Options module Gargantext.Components.Charts.Options.Color
( Color
, stringColor
, cssColor
, transparent
, red
, blue
, magenta
, violet
, black
, grey
, green
) where
import Prelude
import CSS as CSS
import Color (rgba)
import Unsafe.Coerce (unsafeCoerce)
data Color
stringColor :: String -> Color
stringColor = unsafeCoerce
cssColor :: CSS.Color -> Color
cssColor = stringColor <<< CSS.toHexString
transparent :: Color
transparent = cssColor $ rgba 255 255 255 0.0
red :: Color
red = stringColor "red"
blue :: Color
blue = cssColor $ rgba 100 150 200 0.0
-- stringColor "blue"
magenta :: Color
magenta = stringColor "magenta"
violet :: Color
violet = cssColor CSS.violet
black :: Color
black = stringColor "black"
grey :: Color
grey = stringColor "grey"
green :: Color
green = stringColor "green"
Data.purs 0000664 0000000 0000000 00000002721 14111104351 0035127 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Charts/Options module Gargantext.Components.Charts.Options.Data where
import Gargantext.Components.Charts.Options.Font (TextStyle, Icon, ItemStyle)
import Gargantext.Components.Charts.Options.Legend (SelectedMode)
import Gargantext.Types (class Optional)
import Record.Unsafe (unsafeSet)
import Unsafe.Coerce (unsafeCoerce)
type DataLegend =
{ name :: String
, icon :: Icon
, textStyle :: TextStyle
}
type DataAxis = Array String
{- value :: String
, textStyle :: TextStyle
-}
type RequiredData v o =
{ value :: v
| o
}
type OptionalData =
( name :: String
, symbolSize :: Number
, itemStyle :: ItemStyle
-- ^ the style setting about single data point(bubble).
, label :: { show :: Boolean }
, emphasis :: { itemStyle :: ItemStyle }
, selectedMode :: SelectedMode
, select :: { itemStyle :: ItemStyle }
-- ^ need "selectedMode" to be defined
)
type DataSerie v = RequiredData v OptionalData
dataSerie :: forall v o. Optional o OptionalData => RequiredData v o -> DataSerie v
dataSerie = unsafeCoerce
dataSerieV :: forall v. v -> DataSerie v
dataSerieV value = dataSerie {value}
type DataD1 = DataSerie Number
type DataD2 = DataSerie (Array Number)
dataD1 :: forall o. Optional o OptionalData => Record o -> Number -> DataD1
dataD1 o x = unsafeCoerce (unsafeSet "value" x o)
dataD2 :: forall o. Optional o OptionalData => Record o -> Number -> Number -> DataD2
dataD2 o x y = unsafeCoerce (unsafeSet "value" [x,y] o)
ECharts.js 0000664 0000000 0000000 00000001420 14111104351 0035225 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Charts/Options "use strict";
var ReactEcharts = require("echarts-for-react");
exports.eChartsClass = ReactEcharts.default;
/**
* @XXX "echarts-for-react" unsuitable to proper PureScript implementation
* regarding event listeners
* @name listenerFn1
* @param {function} fn
* @returns
*/
exports.listenerFn1 = function(fn) {
return function() {
var args = Array.prototype.slice.call(arguments);
fn(args[0])()
}
};
/**
* @link https://echarts.apache.org/en/api.html#echartsInstance.dispatchAction
* @name dispatchAction
* @param {object} eChartsInstance instanceof ECharts
* @param {object} opts
* @returns
*/
exports.dispatchAction = function(eChartsInstance) {
return function(opts) {
return function() {
eChartsInstance.dispatchAction(opts);
}
}
}
ECharts.purs 0000664 0000000 0000000 00000021325 14111104351 0035610 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Charts/Options module Gargantext.Components.Charts.Options.ECharts where
import CSS.Common (normal)
import CSS.FontStyle (FontStyle(..))
import Data.Maybe (Maybe(..))
import Data.Nullable (toMaybe)
import Effect (Effect)
import Gargantext.Components.Charts.Options.Color (transparent, violet, black)
import Gargantext.Components.Charts.Options.Data (DataLegend, dataSerie)
import Gargantext.Components.Charts.Options.Font (IconOptions(..), Shape(..), TextStyle, chartFontStyle, chartFontWeight, icon, mkTooltip, Tooltip, mkToolBox)
import Gargantext.Components.Charts.Options.Legend (legendType, LegendMode(..), PlainOrScroll(..), selectedMode, Orientation(..), orient)
import Gargantext.Components.Charts.Options.Position (Align(..), LeftRelativePosition(..), TopRelativePosition(..), numberPosition, percentPosition, relativePosition)
import Gargantext.Components.Charts.Options.Series (Series, seriesPieD1)
import Gargantext.Components.Charts.Options.Type (DataZoom, EChartsInstance, Echarts, Legend, MouseEvent, Option, Title, XAxis, YAxis, EChartRef, xAxis, yAxis)
import Gargantext.Utils.Reactix as R2
import Prelude
import React (ReactClass, unsafeCreateElementDynamic)
import Reactix as R
import Record.Extra as RX
import Unsafe.Coerce (unsafeCoerce)
foreign import eChartsClass :: ReactClass Echarts
foreign import listenerFn1 :: forall evt. (evt -> Effect Unit) -> Effect Unit
-- | https://echarts.apache.org/v4/en/api.html#echartsInstance.dispatchAction
foreign import dispatchAction :: forall payload. EChartsInstance -> payload -> Effect Unit
chart :: Options -> R.Element
chart = echarts <<< chartWith
chartWith :: Options -> Echarts
chartWith options =
{ option : opts options
--, className : Nothing
--, style : Nothing
--, theme : Nothing
--, group : Nothing
--, initOpts : Nothing
--, notMerge : Nothing
--, lazyUpdate: Nothing
--, loading : Nothing
--, optsLoading: Nothing
--, onReady : Nothing
--, resizable : Nothing
, onEvents : getEvents options
, ref : refListener options
}
where
getEvents (Options { onClick }) =
{ click: listenerFn1 \e -> case onClick of
-- sanitize parsing (see MouseEvent comment)
Just fn -> RX.pick (e :: MouseEvent) # fn
Nothing -> pure unit
}
refListener (Options { onInit }) = case onInit of
Nothing -> pure unit
Just fn -> listenerFn1 (_ # fn # execOnInit)
execOnInit fn = toMaybe >>> case _ of
Nothing -> pure unit
-- Just (ref :: Record EChartRef) -> fn =<< ref.getEchartsInstance
-- ^ this line can break for some reasons... (see Issue #312)
Just (ref :: Record EChartRef) -> do
i <- ref.getEchartsInstance
fn i
echarts :: Echarts -> R.Element
echarts c = R2.buff $ unsafeCreateElementDynamic (unsafeCoerce eChartsClass) c []
type MainTitle = String
type SubTitle = String
title :: MainTitle -> SubTitle -> Title
title mainTitle subTitle =
{
id: ""
,show: true
,text: mainTitle
,link: ""
,target: "blank"
,textStyle: textStyle
,subtext: subTitle
,sublink: ""
,subtarget: "blank"
,subtextStyle: textStyle2
,padding: 10.0
,itemGap: 0.0
,zlevel: 2.0
,z: 2.0
,left: relativePosition (Relative RightPos)
,top: relativePosition (Relative Top)
,right: numberPosition 60.0
,bottom: percentPosition 40.0
,backgroundColor: transparent
,borderColor: transparent
,borderWidth: 0.0
,borderRadius: 0.0
,shadowBlur: 0.0
,shadowColor: transparent
,shadowOffsetX: 0.0
,shadowOffsetY: 0.0
}
legend :: Legend
legend =
{
id: "Muda"
,"type": legendType Plain
, show: true
, zlevel: 0.0
, z: 2.0
, left: relativePosition Auto
, top: relativePosition Auto
, right: relativePosition Auto
, bottom: relativePosition Auto
, width: relativePosition Auto
, height: relativePosition Auto
, orient: orient Horizontal
, align: relativePosition Auto
, padding: 5.0
, itemGap: 10.0
, itemWidth: 25.0
, itemHeight: 14.0
--, formatter: Nothing
, selectedMode: selectedMode $ Bool true
, inactiveColor: violet
--- selected: Nothing
, textStyle: textStyle
, "data": [data1]
}
data1 :: DataLegend
data1 = {name: "Map terms coverage", icon: icon $ Shape Circle, textStyle: textStyle'}
data2 :: DataLegend
data2 = {name: "Favorites", icon: icon $ Shape Circle, textStyle: textStyle'}
data3 :: DataLegend
data3 = {name: "Test", icon: icon $ Shape Diamond, textStyle: textStyle'}
yAxisVoid :: YAxis
yAxisVoid = yAxis
{ "type": ""
, name: ""
, min: 0
, position: ""
, axisLabel: {formatter: ""}
, show: false
}
xAxis' :: Array String -> XAxis
xAxis' [] = unsafeCoerce {show:false}
xAxis' xs = xAxis
{ "data": xs
, "type": "category"
, axisTick: {alignWithLabel: true}
, show: true
, axisLabel: {formatter: "{value}"}
}
-- TODO try to use Optional
yAxis' :: { position :: String
, show :: Boolean
, min :: Int
} -> YAxis
yAxis' {position, show, min} = yAxis
{ "type": "value"
, name: ""
, min: min
, axisLabel: {formatter: "{value}"}
, position
, show
}
data Options = Options
{ mainTitle :: MainTitle
, subTitle :: SubTitle
, xAxis :: XAxis
, yAxis :: YAxis
, series :: Array Series
, addZoom :: Boolean
, tooltip :: Tooltip
, onClick :: Maybe (MouseEvent -> Effect Unit)
-- (?) `onInit` custom listener
--
-- * in addition of the already existing `onReady` native listener
-- which is executed on chart mount, but does not provide any arg
-- * the React library also contained another native listener as
-- `ref`, which adds the React Ref of the mounted chart
-- * this additional `onInit` is executed after the "Apache Echarts"
-- has been "initialised" (see more details [1]),
-- it intends to return the `eChartsInstance` used for every
-- library actions
--
-- [1] https://echarts.apache.org/v4/en/api.html#echarts.init
, onInit :: Maybe (EChartsInstance -> Effect Unit)
}
tooltipTriggerAxis :: Tooltip
tooltipTriggerAxis = mkTooltip { trigger: "axis"}
opts :: Options -> Option
opts (Options { mainTitle
, subTitle
, xAxis
, yAxis
, series
, tooltip
, addZoom
}) =
{ title: title mainTitle subTitle
, legend
, tooltip
, grid: {containLabel: true}
, series
, xAxis
, yAxis
, dataZoom: if addZoom then [zoom Slider, zoom Inside] else []
, children : unsafeCoerce [] -- TODO
, toolbox: mkToolBox
}
data Zoom = Slider | Inside
instance Show Zoom where
show Slider = "slider"
show Inside = "inside"
zoom :: Zoom -> DataZoom
zoom z = {
"type": show z
,xAxisIndex: 0
,filterMode: "empty"
,start: 0
,end: 100
}
seriesPie :: Series
seriesPie = seriesPieD1
{ name: "Pie name" }
(dataSerie <$> [ {name: "t1", value: 50.0}
, {name: "t2", value: 45.0}
, {name: "t3", value: 65.0}
, {name: "t4", value: 15.0}
, {name: "t5", value: 23.0}
])
textStyle2 :: TextStyle
textStyle2 =
{ color: black
, fontStyle: chartFontStyle Italic
, fontWeight: chartFontWeight normal
, fontFamily: "sans-serif"
, fontSize: 11
, align: relativePosition $ Relative RightPos
, verticalAlign: relativePosition $ Relative Bottom
, lineHeight: percentPosition 0.0
, width: percentPosition 100.0
, height: percentPosition 100.0
, textBorderColor: black
, textBorderWidth: 0.0
, textShadowColor: black
, textShadowBlur: black
, textShadowOffsetX: 0.0
, textShadowOffsetY: 0.0
}
textStyle' :: TextStyle
textStyle' =
{ color: black
, fontStyle: chartFontStyle normal
, fontWeight: chartFontWeight normal
, fontFamily: "sans-serif"
, fontSize: 15
, align: relativePosition $ Relative LeftPos
, verticalAlign: relativePosition $ Relative Top
, lineHeight: percentPosition 0.0
, width: percentPosition 100.0
, height: percentPosition 100.0
, textBorderColor: black
, textBorderWidth: 1.0
, textShadowColor: black
, textShadowBlur: black
, textShadowOffsetX: 0.0
, textShadowOffsetY: 0.0
}
textStyle :: TextStyle
textStyle =
{ color: black
, fontStyle: chartFontStyle normal
, fontWeight: chartFontWeight normal
, fontFamily: "sans-serif"
, fontSize: 10
, align: relativePosition $ Relative LeftPos
, verticalAlign: relativePosition $ Relative Top
, lineHeight: percentPosition 10.0
, width: percentPosition 100.0
, height: percentPosition 100.0
, textBorderColor: black
, textBorderWidth: 1.0
, textShadowColor: black
, textShadowBlur: black
, textShadowOffsetX: 0.0
, textShadowOffsetY: 0.0
}
Font.purs 0000664 0000000 0000000 00000011060 14111104351 0035160 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Charts/Options module Gargantext.Components.Charts.Options.Font
( ItemStyle
, ItemStyleOptional
, itemStyle
, TextStyle
, ChartFontStyle()
, chartFontStyle
, ChartFontWeight()
, chartFontWeight
, Icon()
, ImageURL(..)
, Shape(..)
, IconOptions(..)
, icon
, Formatter
, templateFormatter
, Tooltip
, TooltipOptional
, mkTooltip
, ToolBox
, mkToolBox
, Feature
, DataView
, MagicType
, Save
, Restore
, Brush
) where
import Prelude (Unit, ($), (<<<), (<>))
import Data.Generic.Rep
import Data.Show.Generic (genericShow)
import CSS (FontWeight(..), Prefixed(..), Value(..))
import CSS.FontStyle (FontStyle(..))
import Data.String (toLower)
import Gargantext.Components.Charts.Options.Color (Color)
import Gargantext.Components.Charts.Options.Position (LeftRelativePosition, Position, TopRelativePosition)
import Gargantext.Types (class Optional)
import Unsafe.Coerce (unsafeCoerce)
type TextStyle =
{ color :: Color
, fontStyle :: ChartFontStyle
, fontWeight :: ChartFontWeight
, fontFamily :: String
, fontSize :: Int
, align :: Position LeftRelativePosition
, verticalAlign :: Position TopRelativePosition
, lineHeight :: Position Unit
, width :: Position Unit
, height :: Position Unit
, textBorderColor :: Color
, textBorderWidth :: Number
, textShadowColor :: Color
, textShadowBlur :: Color
, textShadowOffsetX :: Number
, textShadowOffsetY :: Number
}
newtype ChartFontStyle = ChartFontStyle String
chartFontStyle :: FontStyle -> ChartFontStyle
chartFontStyle Italic = ChartFontStyle "italic"
chartFontStyle (Oblique _) = ChartFontStyle "oblique"
chartFontStyle _ = ChartFontStyle "normal"
newtype ChartFontWeight = ChartFontWeight String
chartFontWeight :: FontWeight -> ChartFontWeight
chartFontWeight (FontWeight (Value (Plain "bold"))) = ChartFontWeight "bold"
chartFontWeight (FontWeight (Value (Plain "bolder"))) = ChartFontWeight "bolder"
chartFontWeight (FontWeight (Value (Plain "lighter"))) = ChartFontWeight "lighter"
chartFontWeight _ = ChartFontWeight "normal"
newtype Icon = Icon String
newtype ImageURL = ImageURL String
data Shape = Circle | Rect | RoundRect | Triangle | Diamond | Pin | Arrow
derive instance Generic Shape _
data IconOptions = Shape Shape | Image ImageURL
icon :: IconOptions -> Icon
icon (Shape s) = Icon <<< toLower $ genericShow s
icon (Image (ImageURL url)) = Icon $ "image://" <> url
data ItemStyle
type ItemStyleOptional =
( color :: Color
)
itemStyle :: forall o. Optional o ItemStyleOptional => Record o -> ItemStyle
itemStyle = unsafeCoerce
data Formatter
templateFormatter :: String -> Formatter
templateFormatter = unsafeCoerce
-- TODO callbackFormatter :: (...) -> Formatter
data Tooltip
type TooltipOptional =
( trigger :: String
-- ^ Not all tooltips support triggers.
-- Grid and legend tooltips : yes
-- Series : no
, show :: Boolean
, formatter :: Formatter
)
-----------------------------------------------------------------
-- | ToolBox
mkToolBox :: ToolBox
mkToolBox = { feature: { dataView : { show: true, readOnly : false, title : "Data"}
, saveAsImage : { show : true, pixelRatio : 10, title : "Image"}
--, magicType : { show : true, "type" : ["line", "bar", "pie", "stack", "tiled"], title : "Type"}
--, restore : {show : true, title : "Restore"}
--, brush : {"type" : ["rect", "polygon", "lineX", "lineY", "keep", "clear"]}
}
, orient : "vertical"
}
---------------------------------------
type ToolBox = { feature :: Feature
, orient :: String}
type Feature = { dataView :: DataView
, saveAsImage :: Save
--, magicType :: MagicType
--, restore :: Restore
--, brush :: Brush
}
---------------------------------------
type Save = { show :: Boolean
, pixelRatio :: Int
, title :: String
}
type Restore = { show :: Boolean
, title :: String}
type MagicType = { show :: Boolean
, "type" :: Array String -- TODO use line bar types
, title :: String
}
---------------------------------------
type DataView = { show :: Boolean
, readOnly :: Boolean
, title :: String
}
type Brush = { "type" :: Array String }
---------------------------------------
mkTooltip :: forall o. Optional o TooltipOptional => Record o -> Tooltip
mkTooltip = unsafeCoerce
Legend.purs 0000664 0000000 0000000 00000002270 14111104351 0035453 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Charts/Options module Gargantext.Components.Charts.Options.Legend
(
LegendType(..),
PlainOrScroll(..),
legendType,
Orient(),
Orientation(..),
orient,
SelectedMode(),
LegendMode(..),
selectedMode
) where
import Prelude (class Show, show, (<<<))
import Data.Generic.Rep (class Generic)
import Data.Show.Generic
import Data.String (toLower)
import Unsafe.Coerce (unsafeCoerce)
newtype LegendType = LegendType String
data PlainOrScroll = Plain | Scroll
instance Show PlainOrScroll where
show (Plain) = "plain"
show (Scroll) = "scroll"
legendType :: PlainOrScroll -> LegendType
legendType = LegendType <<< toLower <<< show
newtype Orient = Orient String
data Orientation = Horizontal | Vertical
derive instance Generic Orientation _
orient :: Orientation -> Orient
orient = Orient <<< toLower <<< genericShow
foreign import data SelectedMode :: Type
data LegendMode = Bool Boolean | Single | Multiple
derive instance Generic LegendMode _
selectedMode :: LegendMode -> SelectedMode
selectedMode (Bool b) = unsafeCoerce b
selectedMode (Single) = unsafeCoerce "single"
selectedMode (Multiple) = unsafeCoerce "multiple"
Position.purs 0000664 0000000 0000000 00000003000 14111104351 0036051 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Charts/Options module Gargantext.Components.Charts.Options.Position
(
Position(),
numberPosition,
percentPosition,
relativePosition,
Align(..),
TopRelativePosition(..),
LeftRelativePosition(..)
) where
import Prelude
import Unsafe.Coerce (unsafeCoerce)
-- | The type `Position` is made to render a css position.
-- | It should be either a `Number`, a `"Number%"` or a `Position` type (`TopRelativePosition` for exemple)
-- | To construct such a type you will have to use one of the smart constructor
foreign import data Position :: Type -> Type
-- | Smart constructor to build a JS Number
numberPosition :: forall r. Number -> Position r
numberPosition = unsafeCoerce
-- | Smart constructor to build a JS Percent
percentPosition :: forall r. Number -> Position r
percentPosition n = unsafeCoerce $ (show n) <> "%"
-- | Smart constructor to build a JS String giving position's detail ("top", "left", ...)
relativePosition :: forall a. Show a => Align a -> Position a
relativePosition (Auto) = unsafeCoerce "auto"
relativePosition (Relative r) = unsafeCoerce $ show r
data Align p = Auto | Relative p
data TopRelativePosition = Top | Middle | Bottom
instance Show TopRelativePosition
where show (Top) = "top"
show (Middle) = "middle"
show (Bottom) = "bottom"
data LeftRelativePosition = LeftPos | Center | RightPos
instance Show LeftRelativePosition
where show (LeftPos) = "left"
show (Center) = "center"
show (RightPos) = "right"
Series.purs 0000664 0000000 0000000 00000016524 14111104351 0035516 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Charts/Options module Gargantext.Components.Charts.Options.Series where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (~>), (:=))
import Data.Argonaut.Core (jsonEmptyObject)
import Data.Array (foldl)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..), maybe)
import Data.Newtype (class Newtype)
import Data.Symbol (SProxy(..))
import Gargantext.Components.Charts.Options.Data (DataD1, DataD2)
import Gargantext.Components.Charts.Options.Data (DataD1, DataD2)
import Gargantext.Components.Charts.Options.Font (ItemStyle, Tooltip)
import Gargantext.Components.Charts.Options.Font (ItemStyle, Tooltip)
import Gargantext.Components.Charts.Options.Legend (SelectedMode)
import Gargantext.Prelude
import Gargantext.Types (class Optional)
import Prelude (class Eq, class Show, bind, map, pure, show, ($), (+), (<<<), (<>), eq)
import Record as Record
import Record.Unsafe (unsafeSet)
import Simple.JSON as JSON
import Unsafe.Coerce (unsafeCoerce)
newtype SeriesType = SeriesType String
type SeriesName = String
data Chart = Line
| Bar | PictorialBar
| Pie
| Scatter | EffectScatter
| Radar
| Trees
| Sunburst
| Boxplot
| Candlestick
| Heatmap
| Map
| Parallel
| Lines
| Graph
| Sankey
| Funnel
| Gauge
| ThemeRiver
-- Trees
instance Show Chart where
show Bar = "bar"
show EffectScatter = "effectScatter" -- ^ https://ecomfe.github.io/echarts-examples/public/editor.html?c=scatter-effect
show Funnel = "funnel"
show Heatmap = "heatmap"
show Line = "line"
show Pie = "pie"
show Sankey = "sankey"
show Scatter = "scatter" -- ^ https://ecomfe.github.io/echarts-examples/public/editor.html?c=scatter-simple
show Sunburst = "sunburst"
show _ = "not implemented yet: should throw error here"
seriesType :: Chart -> SeriesType
seriesType = SeriesType <<< show
-- | Scatter Dimension 2 data
type OptionalSeries =
( name :: String
, symbolSize :: Number
, itemStyle :: ItemStyle
-- ^ Graphic style of, *emphasis* is the style when it is highlighted, like being hovered by mouse, or highlighted via legend connect.
-- https://ecomfe.github.io/echarts-doc/public/en/option.html#series-scatter.itemStyle
, tooltip :: Tooltip
, emphasis :: { itemStyle :: ItemStyle }
, selectedMode :: SelectedMode
, select :: { itemStyle :: ItemStyle }
-- ^ need "selectedMode" to be defined
-- many more...
)
data Series
unsafeSeries :: forall o. Record o -> Series
unsafeSeries = unsafeCoerce
type RequiredSeriesD1 o =
{ "type" :: SeriesType
, "data" :: Array DataD1
| o
}
seriesD1 :: forall o. Optional o OptionalSeries => RequiredSeriesD1 o -> Series
seriesD1 = unsafeSeries
seriesFunnelD1 :: forall o. Optional o OptionalSeries => Record o -> Array DataD1 -> Series
seriesFunnelD1 o ds = unsafeSeries (unsafeSet "data" ds (unsafeSet "type" (seriesType Funnel) o))
seriesBarD1 :: forall o. Optional o OptionalSeries => Record o -> Array DataD1 -> Series
seriesBarD1 o ds = unsafeSeries (unsafeSet "data" ds (unsafeSet "type" (seriesType Bar) o))
seriesPieD1 :: forall o. Optional o OptionalSeries => Record o -> Array DataD1 -> Series
seriesPieD1 o ds = unsafeSeries (unsafeSet "data" ds (unsafeSet "type" (seriesType Pie) o))
type RequiredSeriesD2 o =
{ "data" :: Array DataD2
, "type" :: SeriesType
| o
}
seriesD2 :: forall o. Optional o OptionalSeries => RequiredSeriesD2 o -> Series
seriesD2 = unsafeSeries
seriesScatterD2 :: forall o. Optional o OptionalSeries => Record o -> Array DataD2 -> Series
seriesScatterD2 o ds =
unsafeCoerce (unsafeSet "data" ds (unsafeSet "type" (seriesType Scatter) o))
type Node = { name :: String}
type Link = { source :: String
, target :: String
, value :: Number
}
-- | Sankey Chart
-- https://ecomfe.github.io/echarts-examples/public/editor.html?c=sankey-simple
type RequiredSankey o =
{ "data" :: Array Node
, links :: Array Link
| o
}
type OptionalSankey =
( layout :: String
)
seriesSankey :: forall o. Optional o OptionalSankey => RequiredSankey o -> Series
seriesSankey o = unsafeSeries ((unsafeCoerce o) { "type" = seriesType Sankey })
-- | * Trees Chart
-- All these Trees are hierarchical Trees structure (or diagram)
-- https://en.wikipedia.org/wiki/Tree_structure
-- Tree types
data Trees = TreeLine | TreeRadial | TreeMap
instance Show Trees where
show TreeLine = "tree" -- ^ https://ecomfe.github.io/echarts-examples/public/editor.html?c=tree-radial
show TreeRadial = "tree" -- ^ https://ecomfe.github.io/echarts-examples/public/editor.html?c=scatter-simple
show TreeMap = "treemap" -- ^ https://ecomfe.github.io/echarts-examples/public/editor.html?c=treemap-simple
-- TreeLine is a 1-Dimension horizontal hierchical Tree
-- TreeRadial is 1-Dimension radial (as circle) Tree with no surface meaning
-- https://en.wikipedia.org/wiki/Radial_tree
-- https://ecomfe.github.io/echarts-examples/public/editor.html?c=tree-radial
-- TreeMap is a is 2-Dimension Tree with surface meaning
-- TreeMap example implementation:
-- https://ecomfe.github.io/echarts-examples/public/editor.html?c=treemap-simple
type RequiredTree o =
{ "type" :: SeriesType
, "data" :: Array TreeNode
| o
}
type OptionalTree =
( layout :: String
)
seriesTree :: forall o. Optional o OptionalTree => RequiredTree o -> Series
seriesTree = unsafeSeries
mkTree :: Trees -> Array TreeNode -> Series
mkTree t ts = seriesTree { "type" : SeriesType (show t)
, "data" : map (toJsTree Nothing) ts
, layout : layout
}
where
layout = case t of
TreeRadial -> "radial"
_ -> "none"
-- ** Data Structure of the Trees
data TreeData = Array TreeNode
treeValue :: TreeNode -> Int
treeValue (TreeNode x) = foldl (+) 0 $ [x.value] <> map treeValue x.children
toJsTree :: Maybe String -> TreeNode -> TreeNode
toJsTree maybeSurname (TreeNode x) =
unsafeCoerce { name : name
, value : foldl (+) 0 $ [x.value] <> map treeValue x.children
, children : (map (toJsTree (Just name)) x.children)
}
where
name = maybe "" (\x' -> x' <> ">") maybeSurname <> x.name
newtype TreeNode = TreeNode {
children :: Array TreeNode
, name :: String
, value :: Int
}
derive instance Generic TreeNode _
derive instance Newtype TreeNode _
derive instance Eq TreeNode
instance JSON.ReadForeign TreeNode where
readImpl f = do
inst <- JSON.readImpl f
pure $ TreeNode $ Record.rename labelP nameP inst
instance JSON.WriteForeign TreeNode where
writeImpl (TreeNode t) = JSON.writeImpl $ Record.rename nameP labelP t
treeNode :: String -> Int -> Array TreeNode -> TreeNode
treeNode n v ts = TreeNode {name : n, value:v, children:ts}
treeLeaf :: String -> Int -> TreeNode
treeLeaf n v = TreeNode { name : n, value : v, children : []}
nameP = SProxy :: SProxy "name"
labelP = SProxy :: SProxy "label"
-- | TODO
-- https://ecomfe.github.io/echarts-examples/public/data/asset/data/life-expectancy-table.json
-- https://ecomfe.github.io/echarts-examples/public/editor.html?c=scatter3D-dataset&gl=1
Type.purs 0000664 0000000 0000000 00000015144 14111104351 0035202 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Charts/Options module Gargantext.Components.Charts.Options.Type where
import Prelude
import Data.Nullable (Nullable)
import Effect (Effect)
import Gargantext.Components.Charts.Options.Color (Color)
import Gargantext.Components.Charts.Options.Data (DataLegend)
import Gargantext.Components.Charts.Options.Font (TextStyle, Tooltip, ToolBox)
import Gargantext.Components.Charts.Options.Legend (LegendType, Orient, SelectedMode)
import Gargantext.Components.Charts.Options.Position (LeftRelativePosition, Position, TopRelativePosition)
import Gargantext.Components.Charts.Options.Series (Series)
import Gargantext.Types (class Optional)
import React as R
import Unsafe.Coerce (unsafeCoerce)
-- | https://echarts.apache.org/en/api.html#echartsInstance
foreign import data EChartsInstance :: Type
newtype ChartAlign = ChartAlign String
-- TODO: Maybe is not working here => use Optional
type Echarts =
{ option :: Option -- PropTypes.object.isRequired,
--, className :: Maybe String
--, style :: Maybe String -- objealect-black-altdarkmincnaquadahherry-blossomect,
--, theme :: Maybe String
--, group :: Maybe String
--, initOpts :: Maybe String -- PropTypes.object,
--, notMerge :: Maybe Boolean
--, lazyUpdate :: Maybe Boolean
--, loading :: Maybe Boolean
--, optsLoading :: Maybe OptsLoading -- PropTypes.object,
--, onReady :: Maybe String -- PropTypes.func,
--, resizable :: Maybe Boolean -- PropTypes.bool,
, onEvents :: OnEvents -- PropTypes.object
, ref :: Effect Unit
}
type Option =
{ title :: Title
, legend :: Legend
, tooltip :: Tooltip
, grid :: Grid
, xAxis :: XAxis
, yAxis :: YAxis
, series :: Array Series
, dataZoom :: Array DataZoom
, children :: R.Children
, toolbox :: ToolBox
}
type Title =
{ id :: String -- None by default
, show :: Boolean -- default True
, text :: String -- default ''
, link :: String -- default ''
, target :: String -- default 'blank'
, textStyle :: TextStyle
, subtext :: String -- default ''
, sublink :: String -- default ''
, subtarget :: String -- default 'blank'
, subtextStyle :: TextStyle
, padding :: Number -- default '5'
, itemGap :: Number -- default '10'
, zlevel :: Number -- default '0'
, z :: Number -- default '2'
, left :: Position LeftRelativePosition -- default 'auto'
, top :: Position TopRelativePosition -- default 'auto'
, right :: Position Unit -- default 'auto'
, bottom :: Position Unit -- default 'auto'
, backgroundColor :: Color -- default 'transparent''
, borderColor :: Color -- default '#ccc'
, borderWidth :: Number -- default '1'
, borderRadius :: Number -- default 0; data NumberOrArray = Number | Array Number
, shadowBlur :: Number
, shadowColor :: Color
, shadowOffsetX :: Number
, shadowOffsetY :: Number
}
type OptsLoading =
{ text :: String
, color :: Color --- color
, textColor :: Color --color
, maskColor :: Color --color
, zlevel :: Int
}
type DataZoom =
{"type" :: String
, xAxisIndex :: Int
, filterMode :: String
, start :: Int
, end :: Int
}
type Grid =
{containLabel :: Boolean
}
type Legend =
{
id :: String
, "type" :: LegendType
, show :: Boolean
, zlevel :: Number
, z :: Number
, left :: Position LeftRelativePosition -- default 'auto
, top :: Position TopRelativePosition
, right :: Position Unit
, bottom :: Position Unit
, width :: Position Unit
, height :: Position Unit
, orient :: Orient
, align :: Position LeftRelativePosition
, padding :: Number
, itemGap :: Number
, itemWidth :: Number
, itemHeight :: Number
--, formatter :: Maybe String
, selectedMode :: SelectedMode
, inactiveColor :: Color
--, selected :: Maybe String -- object
, textStyle :: TextStyle
, "data" :: Array DataLegend
}
type AxisTick =
{ alignWithLabel :: Boolean
}
data XAxis
type XAxisOptional =
( "data" :: Array String -- DataAxis
, "type" :: String
, axisTick :: AxisTick
, name :: String
, min :: Int
, position :: String
, axisLabel :: AxisLabel
, show :: Boolean
)
xAxis :: forall o. Optional o XAxisOptional => Record o -> XAxis
xAxis = unsafeCoerce
data YAxis
type YAxisOptional =
( "type" :: String
, name :: String
, min :: Int
, position :: String
, axisLabel :: AxisLabel
, show :: Boolean
)
yAxis :: forall o. Optional o YAxisOptional => Record o -> YAxis
yAxis = unsafeCoerce
type AxisLabel =
{ formatter :: String -- string or function
}
type Rich = {}
---
-- | @XXX "echarts-for-react" third party library does not have an event
-- | dictionary
-- | these values had been picked from what we gather in the dist file
-- | "echarts/dist/echarts.common.js" and
-- | https://echarts.apache.org/en/api.html#events
type OnEvents =
{ click :: Effect Unit
-- ...
}
-- | @XXX "echarts-for-react" third party library bases on "apache-echarts"
-- | does not have strongly typed signature, nor determined arity
-- | (actual runtime event contains more key than what their docs describe)
-- |
-- | https://echarts.apache.org/en/api.html#events.Mouse%20events
type MouseEvent =
{ borderColor :: Nullable String
, color :: String
, componentIndex :: Int
, componentSubType :: String
, componentTyp :: String
-- , data :: -- Object
, dataIndex :: Int
, dataType :: Nullable String
-- , dimensionNames :: -- Array
-- , encore :: -- Object
-- , event :: -- instanceof Event
-- , marker :: -- String
, name :: String
, seriesId :: Nullable String
, seriesIndex :: Int
, seriesName :: String
, seriesType :: String
, type :: String
, value :: String -- or Array ??
}
----
-- | @XXX partial definition given by the third library author
-- | POJO containing a mix of ReactElement field and custom method attached
-- |
-- | https://github.com/hustcc/echarts-for-react#component-api--echarts-api
type EChartRef =
( getEchartsInstance :: Effect EChartsInstance
-- ...
)
----
-- | As "dispatchAction" call has a variadic arity, we can dissociate a type
-- | where the cliked item (bar, pie section, etc.) need this dispatchAction
-- | To do so, we have to trimmed its given properties to match this example [1]
-- |
-- | [1] https://echarts.apache.org/en/api.html#action.highlight
type EChartActionData =
( dataIndex :: Int
, name :: String
, seriesId :: Nullable String
, seriesIndex :: Int
, seriesName :: String
, type :: String
)
CodeEditor.purs 0000664 0000000 0000000 00000026233 14111104351 0033424 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components module Gargantext.Components.CodeEditor where
import DOM.Simple.Types (Element)
import Data.Argonaut.Parser (jsonParser)
import Data.Either (either, Either(..))
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Show.Generic (genericShow)
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable, null, toMaybe)
import Data.String.Utils (endsWith)
import Effect (Effect)
import FFI.Simple ((.=))
import Reactix as R
import Reactix.DOM.HTML as H
import Text.Markdown.SlamDown.Parser (parseMd)
import Text.Markdown.SlamDown.Smolder as MD
import Text.Markdown.SlamDown.Syntax (SlamDownP)
import Text.Smolder.Renderer.String as Smolder
import Toestand as T
import Gargantext.Prelude
import Gargantext.Utils.HighlightJS as HLJS
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.CodeEditor"
type Code = String
type Html = String
type Error = String
type ElRef = R.Ref (Nullable Element)
data CodeType = Haskell | JSON | Markdown | Python
derive instance Generic CodeType _
instance Eq CodeType where
eq = genericEq
instance Show CodeType where
show = genericShow
data ViewType = Code | Preview | Both
derive instance Generic ViewType _
instance Eq ViewType where
eq = genericEq
instance Show ViewType where
show = genericShow
type Props =
( code :: Code
, defaultCodeType :: CodeType
, onChange :: CodeType -> Code -> Effect Unit
)
-- Fixes newlines in code
-- This is useful eg for proper rendering of the textarea overlay
codeNlFix :: CodeType -> Code -> Code
codeNlFix _ "" = " "
codeNlFix _ c = if endsWith "\n" c then (c <> " ") else c
render :: CodeType -> Code -> Either Error Html
render Haskell code = Right $ renderHaskell $ codeNlFix Haskell code
render Python code = Right $ renderPython $ codeNlFix Python code
render JSON code = result
where
parsedE = jsonParser code
result = case parsedE of
Left err -> Left err
Right parsed -> Right $ R2.stringify parsed 2
render Markdown code = Right $ renderMd $ codeNlFix Markdown code
previewPostProcess :: CodeType -> Element -> Effect Unit
previewPostProcess Haskell htmlEl = do
HLJS.highlightBlock htmlEl
previewPostProcess Python htmlEl = do
HLJS.highlightBlock htmlEl
previewPostProcess JSON htmlEl = do
HLJS.highlightBlock htmlEl
previewPostProcess Markdown _ = pure unit
-- TODO Replace with markdown-it?
-- https://pursuit.purescript.org/packages/purescript-markdown-it
renderMd' :: forall e. MD.ToMarkupOptions e -> String -> String
renderMd' options input =
either identity (MD.toMarkup' options >>> Smolder.render)
(parseMd input :: Either String (SlamDownP String))
renderMd :: String -> String
renderMd = renderMd' MD.defaultToMarkupOptions
renderHaskell :: String -> String
renderHaskell s = s
renderPython :: String -> String
renderPython s = s
codeEditor :: Record Props -> R.Element
codeEditor p = R.createElement codeEditorCpt p []
-- The code editor contains 3 components:
-- - a hidden textarea
-- - textarea code overlay
-- - html preview
-- The overlay is to provide seamless syntax highlighting on top of the textarea.
-- I took the idea from: https://github.com/satya164/react-simple-code-editor
codeEditorCpt :: R.Component Props
codeEditorCpt = here.component "codeEditor" cpt
where
cpt {code, defaultCodeType, onChange} _ = do
controls <- initControls code defaultCodeType
codeS' <- T.useLive T.unequal controls.codeS
codeType' <- T.useLive T.unequal controls.codeType
viewType' <- T.useLive T.unequal controls.viewType
R.useEffect2' codeS' codeType' $ do
setCodeOverlay controls.codeOverlayElRef codeType' codeS'
renderHtml codeS' codeType' controls.htmlElRef controls.error
pure $ H.div { className: "code-editor" }
[ toolbar { controls, onChange }
, H.div { className: "row error" }
[ errorComponent {error: controls.error} ]
, H.div { className: "row editor" }
[ H.div { className: "code-area " <> (codeHidden viewType') }
[ H.div { className: "code-container" }
[ H.textarea { defaultValue: codeS'
, on: { change: onEditChange controls.codeS codeType' onChange }
, placeholder: "Type some code..."
, ref: controls.codeElRef } [ ]
, H.pre { className: (langClass codeType')
-- , contentEditable: "true"
, ref: controls.codeOverlayElRef
, rows: 30
--, on: { input: onEditChange (fst codeType) codeElRef htmlRef codeRef error }
} []
]
]
, H.div { className: "v-divider " <> (dividerHidden viewType') } [ H.text " " ]
, H.div { className: "html " <> (langClass codeType') <> (previewHidden viewType')
, ref: controls.htmlElRef
} []
]
]
codeHidden :: ViewType -> String
codeHidden Code = ""
codeHidden Both = ""
codeHidden _ = " d-none"
dividerHidden :: ViewType -> String
dividerHidden Both = ""
dividerHidden _ = " d-none"
langClass :: CodeType -> String
langClass Haskell = " language-haskell"
langClass JSON = " language-json"
langClass Markdown = " language-md"
langClass Python = " language-python"
previewHidden :: ViewType -> String
previewHidden Preview = ""
previewHidden Both = ""
previewHidden _ = " d-none"
onEditChange :: forall e. T.Box Code -> CodeType -> OnChangeCodeType -> e -> Effect Unit
onEditChange codeS codeType onChange e = do
let code = R.unsafeEventValue e
T.write_ code codeS
onChange codeType code
setCodeOverlay :: ElRef -> CodeType -> Code -> Effect Unit
setCodeOverlay codeOverlayElRef codeType code = do
let mCodeOverlayEl = toMaybe $ R.readRef codeOverlayElRef
_ <- case mCodeOverlayEl of
Nothing -> pure unit
Just codeOverlayEl -> do
_ <- pure $ (codeOverlayEl .= "innerText") $ codeNlFix codeType code
HLJS.highlightBlock codeOverlayEl
pure unit
pure unit
renderHtml :: Code -> CodeType -> ElRef -> T.Box (Maybe Error) -> Effect Unit
renderHtml code codeType htmlElRef error =
case (toMaybe $ R.readRef htmlElRef) of
Nothing -> pure unit
Just htmlEl -> do
case render codeType code of
Left err -> do
T.write_ (Just err) error
Right rendered -> do
T.write_ Nothing error
_ <- pure $ (htmlEl .= "innerHTML") rendered
previewPostProcess codeType htmlEl
pure unit
type OnChangeCodeType = CodeType -> Code -> Effect Unit
type ToolbarProps = (
controls :: Record Controls
, onChange :: OnChangeCodeType
)
toolbar :: Record ToolbarProps -> R.Element
toolbar p = R.createElement toolbarCpt p []
toolbarCpt :: R.Component ToolbarProps
toolbarCpt = here.component "toolbar" cpt
where
cpt { controls: { codeS, codeType, viewType }
, onChange } _ = do
codeS' <- T.useLive T.unequal codeS
codeType' <- T.useLive T.unequal codeType
pure $
H.div { className: "row toolbar" }
[ H.div { className: "col-2" }
[ codeTypeSelector {
codeType
-- Handle rerendering of preview when viewType changed
, onChange: \ct -> onChange ct codeS'
}
]
, H.div { className: "col-1" }
[ viewTypeSelector {state: viewType} [] ]
]
type ErrorComponentProps =
(
error :: T.Box (Maybe Error)
)
errorComponent :: Record ErrorComponentProps -> R.Element
errorComponent p = R.createElement errorComponentCpt p []
errorComponentCpt :: R.Component ErrorComponentProps
errorComponentCpt = here.component "errorComponent" cpt
where
cpt { error } _ = do
error' <- T.useLive T.unequal error
pure $ case error' of
Nothing -> H.div {} []
Just err -> H.div { className: "text-danger" } [ H.text err ]
type CodeTypeSelectorProps =
(
codeType :: T.Box CodeType
, onChange :: CodeType -> Effect Unit
)
codeTypeSelector :: Record CodeTypeSelectorProps -> R.Element
codeTypeSelector p = R.createElement codeTypeSelectorCpt p []
codeTypeSelectorCpt :: R.Component CodeTypeSelectorProps
codeTypeSelectorCpt = here.component "codeTypeSelector" cpt
where
cpt { codeType, onChange } _ = do
codeType' <- T.useLive T.unequal codeType
pure $ R2.select { className: "form-control"
, defaultValue: show codeType'
, on: { change: onSelectChange codeType onChange }
, style: { width: "150px" }
}
(option <$> [JSON, Markdown, Haskell, Python])
option :: CodeType -> R.Element
option value = H.option { value: show value } [ H.text $ show value ]
onSelectChange :: forall e. T.Box CodeType -> (CodeType -> Effect Unit) -> e -> Effect Unit
onSelectChange codeType onChange e = do
let ct = case value of
"Haskell" -> Haskell
"JSON" -> JSON
"Markdown" -> Markdown
"Python" -> Python
_ -> Markdown
T.write_ ct codeType
onChange ct
where
value = R.unsafeEventValue e
type ViewTypeSelectorProps =
(
state :: T.Box ViewType
)
viewTypeSelector :: R2.Component ViewTypeSelectorProps
viewTypeSelector = R.createElement viewTypeSelectorCpt
viewTypeSelectorCpt :: R.Component ViewTypeSelectorProps
viewTypeSelectorCpt = here.component "viewTypeSelector" cpt
where
cpt { state } _ = do
state' <- T.useLive T.unequal state
pure $ H.div { className: "btn-group"
, role: "group" } [
viewTypeButton Code state' state
, viewTypeButton Both state' state
, viewTypeButton Preview state' state
]
viewTypeButton viewType state' state =
H.button { className: "btn btn-primary" <> active
, on: { click: \_ -> T.write viewType state }
, type: "button"
} [
H.i { className: "fa " <> (icon viewType) } []
]
where
active = if viewType == state' then " active" else ""
icon Preview = "fa-eye"
icon Both = "fa-columns"
icon Code = "fa-pencil"
type Controls =
(
codeElRef :: R.Ref (Nullable Element)
, codeS :: T.Box Code
, codeType :: T.Box CodeType
, codeOverlayElRef :: R.Ref (Nullable Element)
, error :: T.Box (Maybe Error)
, htmlElRef :: R.Ref (Nullable Element)
, viewType :: T.Box ViewType
)
initControls :: Code -> CodeType -> R.Hooks (Record Controls)
initControls code defaultCodeType = do
htmlElRef <- R.useRef null
codeS <- T.useBox code
codeElRef <- R.useRef null
codeOverlayElRef <- R.useRef null
codeType <- T.useBox defaultCodeType
error <- T.useBox Nothing
viewType <- T.useBox Preview
pure $ {
codeElRef
, codeS
, codeType
, codeOverlayElRef
, error
, htmlElRef
, viewType
}
reinitControls :: Record Controls -> Code -> CodeType -> Effect Unit
reinitControls c@{ codeType, codeS, error } code defaultCodeType = do
T.write_ defaultCodeType codeType
T.write_ code codeS
T.write_ Nothing error
ContextMenu/ 0000775 0000000 0000000 00000000000 14111104351 0032733 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components ContextMenu.purs 0000664 0000000 0000000 00000010767 14111104351 0036132 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/ContextMenu -- | The ContextMenu component renders a generic context menu
module Gargantext.Components.ContextMenu.ContextMenu where
-- (MenuProps, Action(..), separator) where
import Data.Maybe ( Maybe(..) )
import Data.Nullable ( Nullable, null, toMaybe )
import Data.Traversable ( traverse_ )
import DOM.Simple as DOM
import DOM.Simple.Event as DE
import DOM.Simple.EventListener ( Callback, callback )
import DOM.Simple.Element as Element
import DOM.Simple.Window ( window )
import DOM.Simple.Document ( document )
import DOM.Simple.Types ( DOMRect )
import Effect (Effect)
import FFI.Simple ((..))
import Reactix as R
import Reactix.DOM.HTML as HTML
import Toestand as T
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.ContextMenu.ContextMenu"
type Props t = (
onClose :: Effect Unit
, x :: Number
, y :: Number
)
contextMenu :: forall t. R2.Component (Props t)
contextMenu = R.createElement contextMenuCpt
contextMenuCpt :: forall t. R.Component (Props t)
contextMenuCpt = here.component "contextMenu" cpt
where
cpt menu@{ onClose, x, y } children = do
host <- R2.getPortalHost
root <- R.useRef null
-- NOTE: Just some dummy width/height here, it should be set properly in the effect function later
rect <- T.useBox $ Just $ R2.domRectFromRect { x, y, width: 100.0, height: 100.0 }
rect' <- T.useLive T.unequal rect
R.useLayoutEffect1 (R.readRef root) $ do
traverse_
(\r -> T.write_ (Just (Element.boundingRect r)) rect)
(toMaybe $ R.readRef root)
pure $ pure unit
R.useLayoutEffect2 (R.readRef root) rect' (contextMenuEffect onClose root)
let cs = [
HTML.div { className: "popover-content" }
[ HTML.div { className: "card" }
[ HTML.ul { className: "list-group" }
children
]
]
]
pure $ R.createPortal [ elems root menu rect' $ cs ] host
elems ref menu (Just rect) = HTML.div
{ ref
, key: "context-menu"
, className: "context-menu"
, style: position menu rect
, data: { placement: "right", toggle: "popover" }
}
elems ref menu Nothing = HTML.div
{ ref
, key: "context-menu"
, className: "context-menu"
, data: { placement: "right", toggle: "popover" }
}
contextMenuEffect
:: forall t.
Effect Unit
-> R.Ref (Nullable DOM.Element)
-> Effect (Effect Unit)
contextMenuEffect onClose rootRef =
case R.readNullableRef rootRef of
Just root -> do
let onClick = documentClickHandler onClose root
let onScroll = documentScrollHandler onClose
DOM.addEventListener document "click" onClick
DOM.addEventListener document "scroll" onScroll
pure $ do
DOM.removeEventListener document "click" onClick
DOM.removeEventListener document "scroll" onScroll
Nothing -> pure R.nothing
documentClickHandler :: Effect Unit -> DOM.Element -> Callback DE.MouseEvent
documentClickHandler onClose menu =
R2.named "hideMenuOnClickOutside" $ callback $ \e -> do
when (R2.mouseClickInElement e menu) $ do
here.log "mouse in element"
onClose
documentScrollHandler :: Effect Unit -> Callback DE.MouseEvent
documentScrollHandler onClose =
R2.named "hideMenuOnScroll" $ callback $ \e -> onClose
position :: forall t. Record (Props t) -> DOMRect -> { left :: Number, top :: Number }
position mouse {width: menuWidth, height: menuHeight} = {left, top}
where left = if isRight then mouse.x else mouse.x - menuWidth
top = if isAbove then mouse.y else mouse.y - menuHeight
isRight = screenWidth - mouse.x > menuWidth -- is there enough space to show above
isAbove = screenHeight - mouse.y > menuHeight -- is there enough space to show to the right?
screenWidth = window .. "innerWidth"
screenHeight = window .. "innerHeight"
contextMenuItem :: R2.Component ()
contextMenuItem = R.createElement contextMenuItemCpt
contextMenuItemCpt :: R.Component ()
contextMenuItemCpt = here.component "contextMenuItem" cpt
where
cpt _props children = pure $ HTML.li { className: "context-menu-item" } children
-- -- CSS Classes
-- menuClass :: String
-- menuClass = "context-menu"
-- menuShownClass :: String
-- menuShownClass = "context-menu-shown"
-- menuHiddenClass :: String
-- menuHiddenClass = "context-menu-hidden"
-- itemClass :: String
-- itemClass = "context-menu-item"
-- separatorClass :: String
-- separatorClass = "context-menu-item"
SimpleItem.purs 0000664 0000000 0000000 00000006203 14111104351 0035717 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/ContextMenu -- | The SimpleItem is a simple context menu item consisting of a link
-- | It handles automatically closing the context menu for you
module Gargantext.Component.ContextMenu.SimpleItem where
-- (MenuProps, Action(..), separator) where
import Prelude hiding (div)
-- separator :: ReactElement
-- separator = div [ className "context-menu-separator" ] []
-- type State' = { open :: Boolean }
-- newtype State = State State'
-- defaultState :: State
-- defaultState = State { open: false }
-- type MenuProps = { classes :: String }
-- type ItemProps p = { hideMenu :: Effect () | p }
-- data Action = Show | Hide
-- menuClass :: String
-- menuClass = "context-menu"
-- menuShownClass :: String
-- menuShownClass = "context-menu-shown"
-- menuHiddenClass :: String
-- menuHiddenClass = "context-menu-hidden"
-- itemClass :: String
-- itemClass = "context-menu-item"
-- contextMenu :: MenuProps -> Array ReactElement -> ReactElement
-- contextMenu = createElement contextMenuClass
-- -- TODO: register callbacks
-- componentDidMount :: Effect Unit
-- componentDidMount = pure unit
-- -- TODO: unregister callbacks
-- componentWillUnmount :: Effect Unit
-- componentWillUnmount = pure unit
-- --
-- childRender :: forall s p a. Spec s p a -> Spec s p a
-- childRender = over _render (\c -> wrapItem <<< c)
-- -- | Wraps an item in an li tag with the item classname
-- wrapItem :: ReactElement -> ReactElement
-- wrapItem = wrap $ li [ className itemClass ]
-- renderMenuItem :: Render State MenuItem Action MenuItem
-- renderMenuItem _ Separator _ _ = li [ className "menu-item-separator" ]
-- renderMenuItem d (MenuItem i) _ _ = wrap outer inner
-- where outer = li [ className "context-menu-item" ]
-- inner = a [ onClick callback, style i.style ] [text i.label]
-- callback _ = d Hide *> i.callback
-- -- TODO: Aria and accessibility
-- renderMenu :: Render State MenuProps Action
-- renderMenu d m s c = pure $ wrap outer $ ul' inner
-- where outer = div [className (classes s.open m.classes)]
-- inner = map (\i -> renderMenuItem d i ) c
-- visibilityClass :: Boolean -> String
-- visibilityClass true = contextMenuShown
-- visibilityClass false = contextMenuHidden
-- classes :: Boolean -> String -> String
-- classes visible user = joinWith " " [menuClass, visibilityClass visible, user]
-- -- Class
-- contextMenuClass :: ReactClass (WithChildren State')
-- contextMenuClass = component "ContextMenu" createContextMenuClass
-- createContextMenuClass ::
-- forall given snapshot spec.
-- ReactComponentSpec MenuProps State snapshot given spec
-- => ReactClassConstructor MenuProps State given
-- -> ReactClass MenuProps
-- createContextMenuClass this = pure
-- { state: defaultState
-- , render: renderMenu
-- , componentDidMount: componentDidMount
-- , componentWillUnmount: componentWillUnmount
-- }
-- type Label = String
-- type ClassName = String
-- -- Items
-- simpleItem :: Label -> ClassName -> Effect Unit -> Effect Unit -> ReactElement
-- simpleItem label cls cb hide = a [ onClick (hide *> cb), className cls ] [ text label ]
-- separator :: ReactElement
-- separator = li [ className "menu-item-separator" ] []
DocsTable.purs 0000664 0000000 0000000 00000051313 14111104351 0033240 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components -- TODO: this module should be replaced by FacetsTable
module Gargantext.Components.DocsTable where
import Gargantext.Prelude
import DOM.Simple.Console (log2)
import DOM.Simple.Event as DE
import Data.Array as A
import Data.Either (Either)
import Data.Generic.Rep (class Generic)
import Data.Lens ((^.))
import Data.Lens.At (at)
import Data.Lens.Record (prop)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe, isJust, maybe)
import Data.Newtype (class Newtype)
import Data.Ord.Down (Down(..))
import Data.Set (Set)
import Data.Set as Set
import Data.String as Str
import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..))
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Category (rating)
import Gargantext.Components.Category.Types (Star(..))
import Gargantext.Components.DocsTable.Types (DocumentsView(..), Hyperdata(..), LocalUserScore, Query, Response(..), Year, sampleData)
import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Nodes.Texts.Types as TextsT
import Gargantext.Components.Table as TT
import Gargantext.Components.Table.Types as TT
import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (Frontends, url)
import Gargantext.Hooks.Loader (useLoader, useLoaderWithCacheAPI, HashedResponse(..))
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId, get, delete)
import Gargantext.Types (ListId, NodeID, NodeType(..), OrderBy(..), SidePanelState(..), TabSubType, TabType, TableResult, showTabType')
import Gargantext.Utils (sortWith)
import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.QueryString (joinQueryStrings, mQueryParam, mQueryParamS, queryParam, queryParamS)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.DocsTable"
type TotalRecords = Int
type Path a =
( corpusId :: Int
, listId :: Int
, frontends :: Frontends
, session :: Session
, tabType :: TabSubType a
)
type CommonProps =
( boxes :: Boxes
, cacheState :: T.Box NT.CacheState
, frontends :: Frontends
, listId :: Int
, mCorpusId :: Maybe Int
, nodeId :: Int
, session :: Session
, sidePanel :: T.Box (Maybe (Record TextsT.SidePanel))
, tabType :: TabType
-- ^ tabType is not ideal here since it is too much entangled with tabs and
-- ngramtable. Let's see how this evolves. )
, totalRecords :: Int
, yearFilter :: T.Box (Maybe Year)
)
type LayoutProps =
( chart :: R.Element
, showSearch :: Boolean
| CommonProps
-- , path :: Record (Path a)
)
type PageLayoutProps =
( key :: String -- NOTE Necessary to clear the component when cache state changes
, params :: TT.Params
, query :: Query
| CommonProps
)
_documentIdsDeleted = prop (SProxy :: SProxy "documentIdsDeleted")
_localCategories = prop (SProxy :: SProxy "localCategories")
docViewLayout :: Record LayoutProps -> R.Element
docViewLayout props = R.createElement docViewLayoutCpt props []
docViewLayoutCpt :: R.Component LayoutProps
docViewLayoutCpt = here.component "docViewLayout" cpt
where
cpt layout _children = do
query <- T.useBox ""
let params = TT.initialParams
pure $ docView { layout, params, query } []
type Props = (
layout :: Record LayoutProps
, params :: TT.Params
, query :: T.Box Query
)
docView :: R2.Component Props
docView = R.createElement docViewCpt
docViewCpt :: R.Component Props
docViewCpt = here.component "docView" cpt where
cpt { layout: { boxes
, cacheState
, chart
, frontends
, listId
, mCorpusId
, nodeId
, session
, showSearch
, sidePanel
, tabType
, totalRecords
, yearFilter
}
, params
, query
} _ = do
cacheState' <- T.useLive T.unequal cacheState
query' <- T.useLive T.unequal query
pure $ H.div { className: "doc-table-doc-view container1" }
[ R2.row
[ chart
, if showSearch then searchBar { query } [] else H.div {} []
, H.div {className: "col-md-12"}
[ pageLayout { boxes
, cacheState
, frontends
, key: "docView-" <> (show cacheState')
, listId
, mCorpusId
, nodeId
, params
, query: query'
, session
, sidePanel
, tabType
, totalRecords
, yearFilter
} [] ] ] ]
type SearchBarProps =
( query :: T.Box Query )
searchBar :: R2.Component SearchBarProps
searchBar = R.createElement searchBarCpt
searchBarCpt :: R.Component SearchBarProps
searchBarCpt = here.component "searchBar" cpt
where
cpt { query } _children = do
query' <- T.useLive T.unequal query
queryText <- T.useBox query'
queryText' <- T.useLive T.unequal queryText
pure $ H.div {className: "col-md-12 row"}
[ H.div {className: "col-md-3"} []
, H.div {className: "col-md-1"} [if query' /= "" then (clearButton query) else H.div {} []]
, H.div {className: "col-md-3 form-group"}
[ H.input { className: "form-control"
, defaultValue: query'
, on: { change: onSearchChange queryText
, keyUp: onSearchKeyup query queryText' }
, placeholder: query'
, type: "text" }
]
, H.div {className: "col-md-1"} [ searchButton query queryText' ]
]
onSearchChange :: forall e. T.Box Query -> e -> Effect Unit
onSearchChange queryText e =
T.write_ (R.unsafeEventValue e) queryText
onSearchKeyup :: T.Box Query -> Query -> DE.KeyboardEvent -> Effect Unit
onSearchKeyup query queryText e =
if DE.key e == "Enter" then
T.write_ queryText query
else
pure unit
searchButton query queryText' =
H.button { className: "btn btn-primary"
, on: { click: \e -> T.write_ queryText' query }
, type: "submit" }
[ H.span {className: "fa fa-search"} [] ]
clearButton query =
H.button { className: "btn btn-danger"
, on: { click: \e -> T.write_ "" query } }
[ H.span {className: "fa fa-times"} [] ]
mock :: Boolean
mock = false
type PageParams = {
listId :: Int
, mCorpusId :: Maybe Int
, nodeId :: Int
, tabType :: TabType
, query :: Query
, params :: TT.Params
, yearFilter :: Maybe Year
}
getPageHash :: Session -> PageParams -> Aff (Either RESTError String)
getPageHash session { nodeId, tabType } =
get session $ tableHashRoute nodeId tabType
convOrderBy :: Maybe (TT.OrderByDirection TT.ColumnName) -> Maybe OrderBy
convOrderBy (Just (TT.ASC (TT.ColumnName "Date"))) = Just DateAsc
convOrderBy (Just (TT.DESC (TT.ColumnName "Date"))) = Just DateDesc
convOrderBy (Just (TT.ASC (TT.ColumnName "Title"))) = Just TitleAsc
convOrderBy (Just (TT.DESC (TT.ColumnName "Title"))) = Just TitleDesc
convOrderBy (Just (TT.ASC (TT.ColumnName "Source"))) = Just SourceAsc
convOrderBy (Just (TT.DESC (TT.ColumnName "Source"))) = Just SourceDesc
convOrderBy _ = Nothing
res2corpus :: Response -> DocumentsView
res2corpus (Response r) =
DocumentsView { _id : r.cid
, category : r.category
, date : (\(Hyperdata hr) -> hr.pub_year) r.hyperdata
, ngramCount : r.ngramCount
, score : r.score
, source : (\(Hyperdata hr) -> hr.source) r.hyperdata
, title : (\(Hyperdata hr) -> hr.title) r.hyperdata
, url : ""
}
filterDocs :: Query -> Array Response -> Array Response
filterDocs query docs = A.filter filterFunc docs
where
filterFunc :: Response -> Boolean
filterFunc (Response { hyperdata: Hyperdata { title } }) =
isJust $ Str.indexOf (Str.Pattern $ Str.toLower query) $ Str.toLower title
filterDocsByYear :: Year -> Array Response -> Array Response
filterDocsByYear year docs = A.filter filterFunc docs
where
filterFunc :: Response -> Boolean
filterFunc (Response { hyperdata: Hyperdata { pub_year } }) = eq year $ show pub_year
pageLayout :: R2.Component PageLayoutProps
pageLayout = R.createElement pageLayoutCpt
pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = here.component "pageLayout" cpt where
cpt props@{ boxes
, cacheState
, listId
, mCorpusId
, nodeId
, params
, query
, session
, tabType
, yearFilter
} _ = do
cacheState' <- T.useLive T.unequal cacheState
yearFilter' <- T.useLive T.unequal yearFilter
let path = { listId, mCorpusId, nodeId, params, query, tabType, yearFilter: yearFilter' }
handleResponse :: HashedResponse (TableResult Response) -> Tuple Int (Array DocumentsView)
handleResponse (HashedResponse { hash, value: res }) = ret
where
filters = filterDocs query
>>> \res' -> case yearFilter' of
Nothing -> res'
Just year -> filterDocsByYear year res'
docs = res2corpus <$> filters res.docs
ret = if mock then
--Tuple 0 (take limit $ drop offset sampleData)
Tuple 0 sampleData
else
Tuple res.count docs
case cacheState' of
NT.CacheOn -> do
let paint (Tuple count docs) = page { boxes
, documents: docs
, layout: props { totalRecords = count }
, params } []
mkRequest :: PageParams -> GUC.Request
mkRequest p = GUC.makeGetRequest session $ tableRoute p
useLoaderWithCacheAPI
{ boxes
, cacheEndpoint: getPageHash session
, handleResponse
, mkRequest
, path
, renderer: paint
}
NT.CacheOff -> do
localCategories <- T.useBox (Map.empty :: LocalUserScore)
paramsS <- T.useBox params
paramsS' <- T.useLive T.unequal paramsS
let loader p = do
let route = tableRouteWithPage (p { params = paramsS', query = query })
eRes <- get session $ route
liftEffect $ do
here.log2 "table route" route
here.log2 "table res" eRes
pure $ handleResponse <$> eRes
let render (Tuple count documents) = pagePaintRaw { documents
, layout: props { params = paramsS'
, totalRecords = count }
, localCategories
, params: paramsS } []
let errorHandler err = here.log2 "[pageLayout] RESTError" err
useLoader { errorHandler
, path: path { params = paramsS' }
, loader
, render }
type PageProps =
( boxes :: Boxes
, documents :: Array DocumentsView
, layout :: Record PageLayoutProps
, params :: TT.Params
)
page :: R2.Component PageProps
page = R.createElement pageCpt
pageCpt :: R.Component PageProps
pageCpt = here.component "pageCpt" cpt where
cpt { documents, layout, params } _ = do
paramsS <- T.useBox params
pure $ pagePaint { documents, layout, params: paramsS } []
type PagePaintProps = (
documents :: Array DocumentsView
, layout :: Record PageLayoutProps
, params :: T.Box TT.Params
)
pagePaint :: R2.Component PagePaintProps
pagePaint = R.createElement pagePaintCpt
pagePaintCpt :: R.Component PagePaintProps
pagePaintCpt = here.component "pagePaintCpt" cpt
where
cpt { documents, layout, params } _ = do
params' <- T.useLive T.unequal params
localCategories <- T.useBox (Map.empty :: LocalUserScore)
pure $ pagePaintRaw { documents: A.fromFoldable (filteredRows params')
, layout
, localCategories
, params } []
where
orderWith { orderBy } =
case convOrderBy orderBy of
Just DateAsc -> sortWith \(DocumentsView { date }) -> date
Just DateDesc -> sortWith \(DocumentsView { date }) -> Down date
Just SourceAsc -> sortWith \(DocumentsView { source }) -> Str.toLower source
Just SourceDesc -> sortWith \(DocumentsView { source }) -> Down $ Str.toLower source
Just TitleAsc -> sortWith \(DocumentsView { title }) -> Str.toLower title
Just TitleDesc -> sortWith \(DocumentsView { title }) -> Down $ Str.toLower title
_ -> identity -- the server ordering is enough here
filteredRows params' = TT.filterRows { params: params' } $ (orderWith params') $ A.toUnfoldable documents
type PagePaintRawProps =
( documents :: Array DocumentsView
, layout :: Record PageLayoutProps
, localCategories :: T.Box LocalUserScore
, params :: T.Box TT.Params
)
pagePaintRaw :: R2.Component PagePaintRawProps
pagePaintRaw = R.createElement pagePaintRawCpt
pagePaintRawCpt :: R.Component PagePaintRawProps
pagePaintRawCpt = here.component "pagePaintRawCpt" cpt where
cpt { documents
, layout: { boxes
, frontends
, listId
, mCorpusId
, nodeId
, session
, sidePanel
, totalRecords }
, localCategories
, params } _ = do
mCurrentDocId <- T.useFocused
(maybe Nothing _.mCurrentDocId)
(\val -> maybe Nothing (\sp -> Just $ sp { mCurrentDocId = val })) sidePanel
mCurrentDocId' <- T.useLive T.unequal mCurrentDocId
localCategories' <- T.useLive T.unequal localCategories
pure $ TT.table
{ colNames
, container: TT.defaultContainer
, params
, rows: rows localCategories' mCurrentDocId'
, syncResetButton : [ H.div {} [] ]
, totalRecords
, wrapColElts
}
where
sid = sessionId session
trashClassName Star_0 _ = "trash"
trashClassName _ true = "active"
trashClassName _ false = ""
corpusDocument
| Just cid <- mCorpusId = Routes.CorpusDocument sid cid listId
| otherwise = Routes.Document sid listId
colNames = TT.ColumnName <$> [ "Show", "Tag", "Date", "Title", "Source", "Score" ]
wrapColElts = const identity
rows localCategories' mCurrentDocId' = row <$> A.toUnfoldable documents
where
row dv@(DocumentsView r@{ _id, category }) =
{ row:
TT.makeRow [ -- H.div {} [ H.a { className, style, on: {click: click Favorite} } [] ]
H.div { className: "" }
[ docChooser { boxes
, listId
, mCorpusId
, nodeId: r._id
, sidePanel } []
]
--, H.div { className: "column-tag flex" } [ caroussel { category: cat, nodeId, row: dv, session, setLocalCategories } [] ]
, H.div { className: "column-tag flex" }
[ rating { nodeId
, row: dv
, score: cat
, setLocalCategories: \lc -> T.modify_ lc localCategories
, session } [] ]
--, H.input { type: "checkbox", defaultValue: checked, on: {click: click Trash} }
-- TODO show date: Year-Month-Day only
, H.div { className: tClassName } [ R2.showText r.date ]
, H.div { className: tClassName }
[ H.a { href: url frontends $ corpusDocument r._id, target: "_blank"}
[ H.text r.title ]
]
, H.div { className: tClassName } [ H.text $ if r.source == "" then "Source" else r.source ]
, H.div {} [ H.text $ maybe "-" show r.ngramCount ]
]
, delete: true }
where
cat = fromMaybe category (localCategories' ^. at _id)
-- checked = Star_1 == cat
selected = mCurrentDocId' == Just r._id
tClassName = trashClassName cat selected
type DocChooser = (
boxes :: Boxes
, listId :: ListId
, mCorpusId :: Maybe NodeID
, nodeId :: NodeID
, sidePanel :: T.Box (Maybe (Record TextsT.SidePanel))
)
docChooser :: R2.Component DocChooser
docChooser = R.createElement docChooserCpt
docChooserCpt :: R.Component DocChooser
docChooserCpt = here.component "docChooser" cpt
where
cpt { mCorpusId: Nothing } _ = do
pure $ H.div {} []
cpt { boxes: { sidePanelState }
, listId
, mCorpusId: Just corpusId
, nodeId
, sidePanel } _ = do
mCurrentDocId <- T.useFocused
(maybe Nothing _.mCurrentDocId)
(\val -> maybe Nothing (\sp -> Just $ sp { mCurrentDocId = val })) sidePanel
mCurrentDocId' <- T.useLive T.unequal mCurrentDocId
let selected = mCurrentDocId' == Just nodeId
eyeClass = if selected then "fa-eye" else "fa-eye-slash"
pure $ H.div { className: "btn" } [
H.span { className: "fa " <> eyeClass
, on: { click: onClick selected } } []
]
where
onClick selected _ = do
-- log2 "[docChooser] onClick, listId" listId
-- log2 "[docChooser] onClick, corpusId" corpusId
-- log2 "[docChooser] onClick, nodeId" nodeId
-- R2.callTrigger triggerAnnotatedDocIdChange { corpusId, listId, nodeId }
-- T2.reload tableReload
if selected then do
T.write_ Nothing sidePanel
T.write_ Closed sidePanelState
else do
T.write_ (Just { corpusId: corpusId
, listId: listId
, mCurrentDocId: Just nodeId
, nodeId: nodeId }) sidePanel
T.write_ Opened sidePanelState
log2 "[docChooser] sidePanel opened" sidePanelState
newtype SearchQuery = SearchQuery {
parent_id :: Int
, query :: Array String
}
derive instance Generic SearchQuery _
derive instance Newtype SearchQuery _
derive newtype instance JSON.ReadForeign SearchQuery
documentsRoute :: Int -> SessionRoute
documentsRoute nodeId = NodeAPI Node (Just nodeId) "documents"
tableRoute :: forall row. { listId :: Int, nodeId :: Int, tabType :: TabType | row} -> SessionRoute
tableRoute { listId, nodeId, tabType } = NodeAPI Node (Just nodeId) $ "table" <> "?tabType=" <> (showTabType' tabType) <> "&list=" <> (show listId)
tableHashRoute :: Int -> TabType -> SessionRoute
tableHashRoute nodeId tabType = NodeAPI Node (Just nodeId) $ "table/hash" <> "?tabType=" <> (showTabType' tabType)
tableRouteWithPage :: forall row.
{ listId :: Int
, nodeId :: Int
, params :: TT.Params
, query :: Query
, tabType :: TabType
, yearFilter :: Maybe Year
| row } -> SessionRoute
tableRouteWithPage { listId, nodeId, params: { limit, offset, orderBy, searchType }, query, tabType, yearFilter } =
NodeAPI Node (Just nodeId) $ "table" <> joinQueryStrings [tt, lst, lmt, odb, ofs, st, q, y]
where
lmt = queryParam "limit" limit
lst = queryParam "list" listId
ofs = queryParam "offset" offset
odb = mQueryParamS "orderBy" TT.orderByToForm orderBy
st = queryParam "searchType" searchType
tt = queryParamS "tabType" (showTabType' tabType)
q = queryParamS "query" query
y = mQueryParam "year" yearFilter
deleteAllDocuments :: Session -> Int -> Aff (Either RESTError (Array Int))
deleteAllDocuments session = delete session <<< documentsRoute
-- 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
DocsTable/ 0000775 0000000 0000000 00000000000 14111104351 0032322 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components Types.purs 0000664 0000000 0000000 00000013454 14111104351 0034350 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/DocsTable module Gargantext.Components.DocsTable.Types where
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))
import Simple.JSON as JSON
import Gargantext.Prelude
import Gargantext.Components.Category.Types (Category(..), decodeCategory, Star(..), decodeStar)
data Action
= MarkCategory Int Category
type DocumentsViewT =
( category :: Star
, date :: Int
, ngramCount :: Maybe Int
, score :: Maybe Int
, source :: String
, title :: String
, url :: String
)
newtype DocumentsView
= DocumentsView
{ _id :: Int
| DocumentsViewT
}
derive instance Generic DocumentsView _
instance Eq DocumentsView where
eq = genericEq
instance JSON.ReadForeign DocumentsView where
readImpl f = do
{ id, category, date, ngramCount, score, source, title, url } :: { id :: Int | DocumentsViewT } <- JSON.readImpl f
pure $ DocumentsView { _id: id
, category
, date
, ngramCount
, score
, source
, title
, url }
instance JSON.WriteForeign DocumentsView where
writeImpl (DocumentsView { _id, category, date, ngramCount, score, source, title, url }) =
JSON.writeImpl { id: _id
, category
, date
, ngramCount
, score
, source
, title
, url }
type ResponseT =
( hyperdata :: Hyperdata
, ngramCount :: Maybe Int
, score :: Maybe Int
, title :: String )
newtype Response = Response
{ cid :: Int
, category :: Star
| ResponseT
}
instance JSON.ReadForeign Response where
readImpl f = do
{ category, id, hyperdata, ngramCount, score, title } :: { category :: Int, id :: Int | ResponseT } <- JSON.readImpl f
--pure $ Response { category: decodeCategory category, cid, hyperdata, ngramCount, score, title }
pure $ Response { category: decodeStar category
, cid: id
, hyperdata
, ngramCount
, score
, title }
type HyperdataT =
( title :: String
, source :: String )
newtype Hyperdata = Hyperdata
{ pub_year :: Int
| HyperdataT
}
derive instance Generic Hyperdata _
instance JSON.ReadForeign Hyperdata where
readImpl f = do
{ publication_year, source, title} :: { publication_year :: Int | HyperdataT } <- JSON.readImpl f
pure $ Hyperdata { pub_year: publication_year
, title
, source }
type LocalCategories = Map Int Category
type LocalUserScore = Map Int Star
type Query = String
type Year = String
---------------------------------------------------------
sampleData' :: DocumentsView
sampleData' = DocumentsView { _id : 1
, url : ""
, date : 2010
, title : "title"
, source : "source"
, category : Star_1
, ngramCount : Just 1
, score: Just 1 }
sampleData :: Array DocumentsView
--sampleData = replicate 10 sampleData'
sampleData = map (\(Tuple t s) -> DocumentsView { _id : 1
, url : ""
, date : 2017
, title: t
, source: s
, category : Star_1
, ngramCount : Just 10
, score: Just 1 }) 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 "Letter to the Editor: 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"]
ErrorsView.purs 0000664 0000000 0000000 00000003076 14111104351 0033512 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components module Gargantext.Components.ErrorsView where
import Gargantext.Prelude
import Data.Array (deleteAt)
import Data.FunctorWithIndex (mapWithIndex)
import Data.Maybe (Maybe(..))
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Types (FrontendError(..))
import Gargantext.Utils.ReactBootstrap as RB
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.ErrorsView"
type ErrorsProps =
( errors :: T.Box (Array FrontendError) )
errorsView :: R2.Component ErrorsProps
errorsView = R.createElement errorsViewCpt
errorsViewCpt :: R.Component ErrorsProps
errorsViewCpt = here.component "errorsView" cpt
where
cpt { errors } _ = do
errors' <- T.useLive T.unequal errors
pure $ H.div {}
( mapWithIndex (showError errors) errors' )
showError errors i (FStringError { error }) =
RB.alert { dismissible: true
, onClose
, variant: "danger" } [ H.text error ]
where
onClose = do
here.log2 "click!" error
T.modify_ (\es -> case deleteAt i es of
Nothing -> es
Just es' -> es'
) errors
showError errors i (FRESTError { error }) =
RB.alert { dismissible: true
, onClose
, variant: "danger" } [ H.text $ show error ]
where
onClose = do
here.log2 "click!" error
T.modify_ (\es -> case deleteAt i es of
Nothing -> es
Just es' -> es'
) errors
FacetsTable.purs 0000664 0000000 0000000 00000037211 14111104351 0033556 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components -- TODO: this module should replace DocsTable
-- However the fix for favorites in commit 91cb6bd9906e128b3129b1db01ef6ef5ae13f7f8
-- has not been ported to this module yet.
module Gargantext.Components.FacetsTable where
import Gargantext.Prelude
import Data.Either (Either(..))
import Data.Eq.Generic (genericEq)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Newtype (class Newtype)
import Data.Sequence (Seq)
import Data.Sequence as Seq
import Data.Set (Set)
import Data.Set as Set
import Data.Show.Generic (genericShow)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
import Gargantext.Components.Category (CategoryQuery(..), putCategories)
import Gargantext.Components.Category.Types (Category(..), decodeCategory, favCategory)
import Gargantext.Components.Search (Contact(..), Document(..), HyperdataRowContact(..), HyperdataRowDocument(..), SearchQuery, SearchResult(..), SearchResultTypes(..))
import Gargantext.Components.Table as T
import Gargantext.Components.Table.Types as T
import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (url, Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(Search, NodeAPI))
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId, post, deleteWithBody)
import Gargantext.Types (NodeType(..), OrderBy(..), NodeID)
import Gargantext.Utils (toggleSet, zeroPad)
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.FacetsTable"
type Props =
( chart :: R.Element
, container :: Record T.TableContainerProps -> R.Element
, frontends :: Frontends
, listId :: Int
, nodeId :: Int
, query :: SearchQuery
, session :: Session
, totalRecords :: Int
)
-- | Tracks the ids of documents to delete and that have been deleted
type Deletions = { pending :: Set Int
, deleted :: Set Int
}
initialDeletions :: Deletions
initialDeletions = { pending: mempty, deleted: mempty }
----------------------------------------------------------------------
newtype Pair =
Pair { id :: Int
, label :: String
}
derive instance Generic Pair _
instance Eq Pair where
eq = genericEq
instance Show Pair where
show = genericShow
----------------------------------------------------------------------
newtype DocumentsView =
DocumentsView
{ id :: Int
, date :: String
, title :: String
, source :: String
, authors :: String
, score :: Int
, pairs :: Array Pair
, delete :: Boolean
, category :: Category
, publication_year :: Int
, publication_month :: Int
, publication_day :: Int
}
derive instance Generic DocumentsView _
instance Eq DocumentsView where
eq = genericEq
instance Show DocumentsView where
show = genericShow
----------------------------------------------------------------------
newtype ContactsView =
ContactsView
{ id :: Int
, hyperdata :: HyperdataRowContact
, score :: Int
, annuaireId :: Int
, delete :: Boolean
}
derive instance Generic ContactsView _
instance Eq ContactsView where
eq = genericEq
instance Show ContactsView where
show = genericShow
----------------------------------------------------------------------
data Rows = Docs { docs :: Seq DocumentsView }
| Contacts { contacts :: Seq ContactsView }
derive instance Generic Rows _
instance Eq Rows where
eq = genericEq
----------------------------------------------------------------------
-- | Main layout of the Documents Tab of a Corpus
docView :: Record Props -> R.Element
docView props = R.createElement docViewCpt props []
docViewCpt :: R.Component Props
docViewCpt = here.component "docView" cpt
where
cpt {frontends, session, nodeId, listId, query, totalRecords, chart, container} _ = do
deletions <- T.useBox initialDeletions
path <- T.useBox $ initialPagePath {nodeId, listId, query, session}
path' <- T.useLive T.unequal path
R.useEffect' $ do
let ipp = initialPagePath {nodeId, listId, query, session}
if path' == ipp then
pure unit
else
void $ T.write ipp path
pure $ H.div { className: "facets-doc-view container1" }
[ R2.row
[ chart
, H.div { className: "col-md-12" }
[ pageLayout { container, deletions, frontends, path, session, totalRecords } [] ]
{- , H.div { className: "col-md-12" }
[ H.button { style: buttonStyle, on: { click: trashClick deletions } }
[ H.i { className: "glyphitem fa fa-trash"
, style: { marginRight : "9px" }} []
, H.text "Delete document!" ]
]
-} ]
]
performDeletions :: Session -> Int -> T.Box Deletions -> Deletions -> Effect Unit
performDeletions session nodeId deletions deletions' = do
launchAff_ $ deleteDocuments session nodeId (DeleteDocumentQuery q)
T.modify_ del deletions
where
q = { documents: Set.toUnfoldable deletions'.pending }
del { deleted, pending } = { deleted: deleted <> pending, pending: mempty }
markCategory :: Session -> NodeID -> Category -> Array NodeID -> Effect Unit
markCategory session nodeId category nids =
void $ launchAff_ $ putCategories session nodeId (CategoryQuery q)
where -- TODO add array of delete rows here
q = {nodeIds: nids, category: favCategory category}
togglePendingDeletion :: R.State Deletions -> NodeID -> Effect Unit
togglePendingDeletion (_ /\ setDeletions) nid = setDeletions setter
where setter deletions@{pending} = deletions { pending = toggleSet nid pending }
docViewGraph :: Record Props -> R.Element
docViewGraph props = R.createElement docViewCpt props []
docViewGraphCpt :: R.Component Props
docViewGraphCpt = here.component "docViewGraph" cpt
where
cpt {frontends, session, nodeId, listId, query, totalRecords, chart, container} _ = do
deletions <- T.useBox initialDeletions
deletions' <- T.useLive T.unequal deletions
let buttonStyle = { backgroundColor: "peru", padding : "9px"
, color : "white", border : "white", float: "right"}
let performClick = \_ -> performDeletions session nodeId deletions deletions'
path <- T.useBox $ initialPagePath { nodeId, listId, query, session }
pure $ R.fragment
[ H.br {}
, H.p {} [ H.text "" ]
, H.br {}
, H.div { className: "container-fluid" }
[ R2.row
[ chart
, H.div { className: "col-md-12" }
[ pageLayout { container, deletions, frontends, path, session, totalRecords } []
, H.button { style: buttonStyle, on: { click: performClick } }
[ H.i { className: "glyphitem fa fa-trash"
, style: { marginRight : "9px" } } []
, H.text "Delete document!"
]
]
]
]
]
type PagePath = { nodeId :: Int
, listId :: Int
, query :: SearchQuery
, params :: T.Params
, session :: Session
}
initialPagePath :: {session :: Session, nodeId :: Int, listId :: Int, query :: SearchQuery} -> PagePath
initialPagePath {session, nodeId, listId, query} = {session, nodeId, listId, query, params: T.initialParams}
loadPage :: PagePath -> Aff (Either RESTError Rows)
loadPage { session, nodeId, listId, query, params: {limit, offset, orderBy }} = do
let
convOrderBy (T.ASC (T.ColumnName "Date")) = DateAsc
convOrderBy (T.DESC (T.ColumnName "Date")) = DateDesc
convOrderBy (T.ASC (T.ColumnName "Title")) = TitleAsc
convOrderBy (T.DESC (T.ColumnName "Title")) = TitleDesc
convOrderBy (T.ASC (T.ColumnName "Source")) = SourceAsc
convOrderBy (T.DESC (T.ColumnName "Source")) = SourceDesc
convOrderBy _ = DateAsc -- TODO
p = Search { listId, offset, limit, orderBy: convOrderBy <$> orderBy } (Just nodeId)
--SearchResult {result} <- post session p $ SearchQuery {query: concat query, expected:searchType}
eSearchResult <- post session p query
case eSearchResult of
Left err -> pure $ Left err
Right (SearchResult {result}) ->
-- $ SearchQuery {query: concat query, expected: SearchDoc}
pure $ Right $ case result of
SearchResultDoc {docs} -> Docs {docs: doc2view <$> Seq.fromFoldable docs}
SearchResultContact {contacts} -> Contacts {contacts: contact2view <$> Seq.fromFoldable contacts}
errMessage -> Docs {docs: Seq.fromFoldable [err2view errMessage]} -- TODO better error view
doc2view :: Document -> DocumentsView
doc2view ( Document { id
, 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
}
contact2view :: Contact -> ContactsView
contact2view (Contact { c_id
, c_hyperdata
, c_annuaireId
, c_score
}
) = ContactsView { id: c_id
, hyperdata: c_hyperdata
, score: c_score
, annuaireId : c_annuaireId
, delete: false
}
err2view :: forall a. a -> DocumentsView
err2view _message =
DocumentsView { id: 1
, date: ""
, title : "SearchNoResult"
, source: ""
, score: 1
, authors: ""
, category: decodeCategory 1
, pairs: []
, delete: false
, publication_year: 2020
, publication_month: 10
, publication_day: 1
}
type PageLayoutProps =
( frontends :: Frontends
, totalRecords :: Int
, deletions :: T.Box Deletions
, container :: Record T.TableContainerProps -> R.Element
, session :: Session
, path :: T.Box PagePath
)
type PageProps = ( rowsLoaded :: Rows | PageLayoutProps )
-- | Loads and renders a page
pageLayout :: R2.Component PageLayoutProps
pageLayout = R.createElement pageLayoutCpt
pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = here.component "pageLayout" cpt
where
cpt { container, deletions, frontends, path, session, totalRecords } _ = do
path' <- T.useLive T.unequal path
useLoader { errorHandler
, loader: loadPage
, path: path'
, render: \rowsLoaded -> page { container, deletions, frontends, path, rowsLoaded, session, totalRecords } [] }
errorHandler err = here.log2 "[pageLayout] RESTError" err
page :: R2.Component PageProps
page = R.createElement pageCpt
pageCpt :: R.Component PageProps
pageCpt = here.component "page" cpt
where
cpt { container
, deletions
, frontends
, path
, rowsLoaded
, session
, totalRecords } _ = do
path' <- T.useLive T.unequal path
params <- T.useFocused (_.params) (\a b -> b { params = a }) path
deletions' <- T.useLive T.unequal deletions
let isDeleted (DocumentsView {id}) = Set.member id deletions'.deleted
rows path' = case rowsLoaded of
Docs {docs} -> docRow path' <$> Seq.filter (not <<< isDeleted) docs
Contacts {contacts} -> contactRow path' <$> contacts
pure $ T.table { colNames
, container
, params
, rows: rows path'
, syncResetButton : [ H.div {} [] ]
, totalRecords
, wrapColElts
}
where
colNames = case rowsLoaded of
Docs _ -> T.ColumnName <$> [ "", "Date", "Title", "Journal", "", "" ]
Contacts _ -> T.ColumnName <$> [ "", "Contact", "Organization", "", "", "" ]
wrapColElts = const identity
-- TODO: how to interprete other scores?
gi Trash = "fa fa-star-empty"
gi _ = "fa fa-star"
documentUrl id { listId, nodeId } =
url frontends $ Routes.CorpusDocument (sessionId session) nodeId listId id
contactRow path' (ContactsView { id, hyperdata: HyperdataRowContact { firstname, lastname, labs }
, annuaireId, delete
}) =
{ row:
T.makeRow [ H.div {} [ H.a { className: gi Favorite, on: {click: markClick path'} } [] ]
, maybeStricken delete [ H.a { target: "_blank", href: contactUrl id }
[ H.text $ firstname <> " " <> lastname ]
]
, maybeStricken delete [ H.text labs ]
]
, delete: true
}
where
markClick { nodeId } _ = markCategory session nodeId Favorite [id]
contactUrl id' = url frontends $ Routes.ContactPage (sessionId session) annuaireId id'
docRow path' dv@(DocumentsView {id, title, source, delete, category}) =
{ row:
T.makeRow [ H.div {} [ H.a { className: gi category, on: {click: markClick path'} } [] ]
, maybeStricken delete [ H.text $ publicationDate dv ]
, maybeStricken delete [ H.a {target: "_blank", href: documentUrl id path'} [ H.text title ] ]
, maybeStricken delete [ H.text source ]
]
, delete: true }
where
markClick { nodeId } _ = markCategory session nodeId category [id]
-- comma = H.span {} [ H.text ", " ]
maybeStricken delete
| delete = H.div { style: { textDecoration: "line-through" } }
| otherwise = H.div {}
publicationDate :: DocumentsView -> String
publicationDate (DocumentsView { publication_year, publication_month }) =
(zeroPad 2 publication_year) <> "-" <> (zeroPad 2 publication_month)
-- <> "-" <> (zeroPad 2 publication_day)
---------------------------------------------------------
newtype DeleteDocumentQuery = DeleteDocumentQuery { documents :: Array Int }
derive instance Generic DeleteDocumentQuery _
derive instance Newtype DeleteDocumentQuery _
derive newtype instance JSON.WriteForeign DeleteDocumentQuery
deleteDocuments :: Session -> Int -> DeleteDocumentQuery -> Aff (Either RESTError (Array Int))
deleteDocuments session nodeId =
deleteWithBody session $ NodeAPI Node (Just nodeId) "documents"
Folder.purs 0000664 0000000 0000000 00000000640 14111104351 0032610 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components module Gargantext.Components.Folder where
import Reactix as R
import Reactix.DOM.HTML as H
-- TODO : get REST informations
folder :: {} -> R.Element
folder props = R.createElement folderCpt props []
folderCpt :: R.Component ()
folderCpt = R.staticComponent "G.C.Folder.folder" cpt
where
cpt _ _ =
R.fragment
[ H.h1 {} [ H.text "Folder" ]
, H.text "Some description of the folder here" ]
FolderView.js 0000664 0000000 0000000 00000000266 14111104351 0033072 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components 'use strict';
exports.back = function() {
return function() {
history.back();
}
}
exports.link = function (url) {
return function() {
window.location.href = url
}
} FolderView.purs 0000664 0000000 0000000 00000036542 14111104351 0033455 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components module Gargantext.Components.FolderView where
import Data.Array as A
import Data.Either (Either)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Nullable (null)
import Data.Traversable (traverse_)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode)
import Gargantext.Components.Forest.Tree.Node.Action.Contact as Contact
import Gargantext.Components.Forest.Tree.Node.Action.Delete (deleteNode, unpublishNode)
import Gargantext.Components.Forest.Tree.Node.Action.Link (linkNodeReq)
import Gargantext.Components.Forest.Tree.Node.Action.Merge (mergeNodeReq)
import Gargantext.Components.Forest.Tree.Node.Action.Move (moveNodeReq)
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.Update (updateRequest)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadArbitraryFile, uploadFile)
import Gargantext.Components.Forest.Tree.Node.Box (nodePopupView)
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..), fTreeID)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Config.Utils (handleRESTError)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Ordering, Unit, bind, compare, discard, pure, unit, void, ($), (<$>), (<>))
import Gargantext.Routes (AppRoute(Home), SessionRoute(..), appPath, nodeTypeAppRoute)
import Gargantext.Sessions (Session, get, sessionId)
import Gargantext.Types (NodeType(..))
import Gargantext.Types as GT
import Gargantext.Utils.Popover as Popover
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
foreign import back :: Effect Unit
foreign import link :: String -> Effect Unit
here :: R2.Here
here = R2.here "Gargantext.Components.FolderView"
type Props =
( backFolder :: Boolean
, boxes :: Boxes
, nodeId :: Int
, session :: Session
)
data FolderStyle = FolderUp | FolderChild
folderView :: R2.Leaf Props
folderView props = R.createElement folderViewCpt props []
folderViewCpt :: R.Component Props
folderViewCpt = here.component "folderViewCpt" cpt where
cpt { backFolder, boxes, nodeId, session } _ = do
setPopoverRef <- R.useRef Nothing
reload <- T.useBox T2.newReload
reload' <- T.useLive T.unequal reload
useLoader { errorHandler
, loader: loadFolders
, path: { nodeId, session, reload: reload'}
, render: \folders -> folderViewMain { backFolder
, boxes
, folders
, nodeId
, session
, reload
, setPopoverRef } }
where
errorHandler err = here.log2 "[folderView] RESTError" err
type FolderViewProps =
( backFolder :: Boolean
, boxes :: Boxes
, folders :: FTree
, nodeId :: Int
, reload :: T.Box T2.Reload
, session :: Session
, setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
)
folderViewMain :: Record FolderViewProps -> R.Element
folderViewMain props = R.createElement folderViewMainCpt props []
folderViewMainCpt :: R.Component FolderViewProps
folderViewMainCpt = here.component "folderViewMainCpt" cpt where
cpt { backFolder
, boxes
, folders: NTree (LNode {parent_id: parentId, nodeType}) (folders)
, nodeId
, reload
, session
, setPopoverRef } _ = do
let foldersS = A.sortBy sortFolders folders
let backHome = isBackHome nodeType
let parent = makeParentFolder parentId session backFolder backHome
let children = makeFolderElements foldersS { boxes, nodeId, reload, session, setPopoverRef }
pure $ H.div {className: "fv folders"} $ parent <> children
makeFolderElements foldersS props = makeFolderElementsMap <$> foldersS where
makeFolderElementsMap :: NTree LNode -> R.Element
makeFolderElementsMap (NTree (LNode node) _) = folder { boxes: props.boxes
, nodeId: node.id
, nodeType: node.nodeType
, parentId: props.nodeId
, reload: props.reload
, session: props.session
, setPopoverRef: props.setPopoverRef
, style: FolderChild
, text: node.name } []
makeParentFolder :: Maybe Int -> Session -> Boolean -> Boolean -> Array R.Element
makeParentFolder (Just parentId) session _ _ =
-- FIXME: The NodeType here should not be hardcoded to FolderPrivate but we currently can't get the actual NodeType
-- without performing another API call. Also parentId is never being returned by this API even when it clearly exists
[ folderSimple {style: FolderUp, text: "..", nodeId: parentId, nodeType: GT.FolderPrivate, session: session} [] ]
makeParentFolder Nothing _ _ true = [ H.a {className: "btn btn-primary", href: appPath Home} [ H.i { className: "fa fa-folder-open" } []
, H.br {}
, H.text ".."] ]
makeParentFolder Nothing _ true _ = [ H.button {className: "btn btn-primary", on: { click: back } } [ H.i { className: "fa fa-folder-open" } []
, H.br {}
, H.text ".."] ]
makeParentFolder Nothing _ _ _ = []
sortFolders :: FTree -> FTree -> Ordering
sortFolders a b = compare (fTreeID a) (fTreeID b)
isBackHome :: GT.NodeType -> Boolean
isBackHome GT.FolderPrivate = true
isBackHome GT.FolderPublic = true
isBackHome GT.FolderShared = true
isBackHome _ = false
type FolderSimpleProps =
(
style :: FolderStyle
, text :: String
, nodeType :: GT.NodeType
, nodeId :: Int
, session :: Session
)
folderSimple :: R2.Component FolderSimpleProps
folderSimple = R.createElement folderSimpleCpt
folderSimpleCpt :: R.Component FolderSimpleProps
folderSimpleCpt = here.component "folderSimpleCpt" cpt where
cpt {style, text, nodeId, session, nodeType} _ = do
let sid = sessionId session
pure $ H.a { className: "btn btn-primary"
, href: "/#/" <> getFolderPath nodeType sid nodeId }
[ H.i { className: icon style nodeType } []
, H.br {}
, H.text text ]
icon :: FolderStyle -> GT.NodeType -> String
icon FolderUp _ = "fa fa-folder-open"
icon _ nodeType = GT.fldr nodeType false
getFolderPath :: GT.NodeType -> GT.SessionId -> Int -> String
getFolderPath nodeType sid nodeId = appPath $ fromMaybe Home $ nodeTypeAppRoute nodeType sid nodeId
type FolderProps =
( boxes :: Boxes
, parentId :: Int
, reload :: T.Box T2.Reload
, setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
| FolderSimpleProps
)
folder :: R2.Component FolderProps
folder = R.createElement folderCpt
folderCpt :: R.Component FolderProps
folderCpt = here.component "folderCpt" cpt where
cpt props@{ boxes
, nodeId
, nodeType
, parentId
, reload
, session
, setPopoverRef
, style
, text } _ = do
let sid = sessionId session
let dispatch a = performAction a { boxes, nodeId, parentId, reload, session, setPopoverRef }
popoverRef <- R.useRef null
R.useEffect' $ do
R.setRef setPopoverRef $ Just $ Popover.setOpen popoverRef
pure $
H.div {} [
H.span{style: {position: "absolute"}} [ Popover.popover {
arrow: false
, open: false
, onClose: \_ -> pure unit
, onOpen: \_ -> pure unit
, ref: popoverRef
} [
popOverIcon
, mNodePopupView (Record.merge props { dispatch }) (onPopoverClose popoverRef)
]]
, H.button {on: {click: link ("/#/" <> getFolderPath nodeType sid nodeId) }, className: "btn btn-primary fv btn" } [
H.i {className: icon style nodeType} []
, H.br {}
, H.text text]]
icon :: FolderStyle -> GT.NodeType -> String
icon FolderUp _ = "fa fa-folder-open"
icon _ nodeType = GT.fldr nodeType false
getFolderPath :: GT.NodeType -> GT.SessionId -> Int -> String
getFolderPath nodeType sid nodeId = appPath $ fromMaybe Home $ nodeTypeAppRoute nodeType sid nodeId
onPopoverClose popoverRef _ = Popover.setOpen popoverRef false
popOverIcon = H.span { className: "fv action" } [
H.a { className: "settings fa fa-cog"
, title : "Each node of the Tree can perform some actions.\n"
<> "Click here to execute one of them." } []
]
mNodePopupView props opc = nodePopupView { boxes: props.boxes
, dispatch: props.dispatch
, id: props.nodeId
, onPopoverClose: opc
, nodeType: props.nodeType
, name: props.text
, session: props.session
}
backButton :: R.Element
backButton =
H.button {
className: "btn btn-primary"
, on: {click: back}
} [
H.i { className: "fa fa-arrow-left", title: "Previous view"} []
]
homeButton :: R.Element
homeButton =
H.a {
className: "btn btn-primary"
, href: appPath Home
} [
H.i { className: "fa fa-home", title: "Back to home"} []
]
type LoadProps =
(
session :: Session,
nodeId :: Int,
reload :: T2.Reload
)
loadFolders :: Record LoadProps -> Aff (Either RESTError FTree)
loadFolders {nodeId, session} = get session $ TreeFirstLevel (Just nodeId) ""
type PerformActionProps =
( boxes :: Boxes
, nodeId :: Int
, parentId :: Int
, reload :: T.Box T2.Reload
, setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
, session :: Session
)
performAction :: Action -> Record PerformActionProps -> Aff Unit
performAction = performAction' where
performAction' (DeleteNode nt) p = deleteNode' nt p
performAction' (DoSearch task) p = doSearch task p
performAction' (UpdateNode params) p = updateNode params p
performAction' (RenameNode name) p = renameNode name p
performAction' (ShareTeam username) p = shareTeam username p
performAction' (SharePublic { params }) p = sharePublic params p
performAction' (AddContact params) p = addContact params p
performAction' (AddNode name nodeType) p = addNode' name nodeType p
performAction' (UploadFile nodeType fileType mName contents) p = uploadFile' nodeType fileType mName contents p
performAction' (UploadArbitraryFile mName blob) p = uploadArbitraryFile' mName blob p
performAction' DownloadNode _ = liftEffect $ here.log "[performAction] DownloadNode"
performAction' (MoveNode {params}) p = moveNode params p
performAction' (MergeNode {params}) p = mergeNode params p
performAction' (LinkNode { nodeType, params }) p = linkNode nodeType params p
performAction' NoAction _ = liftEffect $ here.log "[performAction] NoAction"
performAction' ClosePopover p = closePopover p
performAction' _ _ = liftEffect $ here.log "[performAction] unsupported action"
closePopover { setPopoverRef } =
liftEffect $ traverse_ (\set -> set false) (R.readRef setPopoverRef)
refreshFolders p@{ boxes: { reloadForest }, reload } = do
liftEffect $ T2.reload reload
liftEffect $ T2.reload reloadForest
closePopover p
deleteNode' nt p@{ nodeId: id, parentId: parent_id, session } = do
case nt of
NodePublic FolderPublic -> void $ deleteNode session nt id
NodePublic _ -> void $ unpublishNode session (Just parent_id) id
_ -> void $ deleteNode session nt id
refreshFolders p
doSearch task { boxes: { tasks }, nodeId: id } = liftEffect $ do
GAT.insert id task tasks
here.log2 "[performAction] DoSearch task:" task
updateNode params { boxes: { errors, tasks }, nodeId: id, session } = do
eTask <- updateRequest params session id
handleRESTError errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks
here.log2 "[performAction] UpdateNode task:" task
shareTeam username { boxes: { errors }, nodeId: id, session } = do
eTask <- Share.shareReq session id $ Share.ShareTeamParams { username }
handleRESTError errors eTask $ \_task -> pure unit
sharePublic params p@{ boxes: { errors }, session } = traverse_ f params where
f (SubTreeOut { in: inId, out }) = do
eTask <- Share.shareReq session inId $ Share.SharePublicParams { node_id: out }
handleRESTError errors eTask $ \_task -> pure unit
refreshFolders p
addContact params { nodeId: id, session } =
void $ Contact.contactReq session id params
uploadFile' nodeType fileType mName contents { boxes: { errors, tasks }, nodeId: id, session } = do
eTask <- uploadFile { contents, fileType, id, nodeType, mName, session }
handleRESTError errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks
here.log2 "[performAction] UploadFile, uploaded, task:" task
uploadArbitraryFile' mName blob { boxes: { errors, tasks }, nodeId: id, session } = do
eTask <- uploadArbitraryFile session id { blob, mName }
handleRESTError errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks
here.log2 "[performAction] UploadArbitraryFile, uploaded, task:" task
moveNode params p@{ boxes: { errors }, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
eTask <- moveNodeReq session in' out
handleRESTError errors eTask $ \_task -> pure unit
refreshFolders p
mergeNode params p@{ boxes: { errors }, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
eTask <- mergeNodeReq session in' out
handleRESTError errors eTask $ \_task -> pure unit
refreshFolders p
linkNode nodeType params p@{ boxes: { errors }, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
eTask <- linkNodeReq session nodeType in' out
handleRESTError errors eTask $ \_task -> pure unit
refreshFolders p
renameNode name p@{ boxes: { errors }, nodeId: id, session } = do
eTask <- rename session id $ RenameValue { text: name }
handleRESTError errors eTask $ \_task -> pure unit
refreshFolders p
addNode' name nodeType p@{ boxes: { errors }, nodeId: id, session } = do
eTask <- addNode session id $ AddNodeValue {name, nodeType}
handleRESTError errors eTask $ \_task -> pure unit
refreshFolders p
FolderView/ 0000775 0000000 0000000 00000000000 14111104351 0032530 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components Box.purs 0000664 0000000 0000000 00000003773 14111104351 0034205 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/FolderView module Gargantext.Components.FolderView.Box where
import Gargantext.Prelude
import DOM.Simple as DOM
import Data.Maybe (Maybe(..))
import Effect (Effect)
import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox)
import Gargantext.Components.Forest.Tree.Node.Tools (prettyNodeType)
import Gargantext.Types (ID, Name)
import Gargantext.Types as GT
import Gargantext.Utils.Glyphicon (glyphicon)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.FolderView.Box"
type NodePopupProps =
( id :: ID
, name :: Name
, nodeType :: GT.NodeType
, onPopoverClose :: DOM.Element -> Effect Unit
)
nodePopupView :: Record NodePopupProps -> R.Element
nodePopupView props = R.createElement nodePopupCpt props []
nodePopupCpt :: R.Component NodePopupProps
nodePopupCpt = here.component "nodePopupView" cpt where
cpt props@{ id, name, nodeType } _ = do
pure $ H.div tooltipProps
[ H.div { className: "popup-container" }
[ H.div { className: "card" }
[ panelHeading props
]]]
closePopover props = props.onPopoverClose <<< R.unsafeEventTarget
tooltipProps = { id: "node-popup-tooltip", title: "Node settings"
, data: { toggle: "tooltip", placement: "right" } }
panelHeading props@{id, name, nodeType } =
H.div { className: "card-header" }
[ R2.row
[ H.div { className: "col-4" }
[ H.span { className: GT.fldr nodeType true} [] -- TODO fix names
, H.span { className: "h5" } [ H.text $ prettyNodeType nodeType ] ]
, H.div { className: "col-6" }
[ H.span { className: "text-primary center" } [ H.text props.name ] ]
, H.div { className: "col-1" }
[ H.a { type: "button", on: { click: closePopover props }, title: "Close"
, className: glyphicon "window-close" } [] ]]] where
SettingsBox { edit, doc, buttons } = settingsBox nodeType
Footer.purs 0000664 0000000 0000000 00000001064 14111104351 0032634 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components module Gargantext.Components.Footer where
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
here :: R2.Here
here = R2.here "Gargantext.Components.Footer"
---------------------------------------------------------------------------
type FooterProps = ( )
footer :: R2.Component FooterProps
footer = R.createElement footerCpt
footerCpt :: R.Component FooterProps
footerCpt = here.component "footer" cpt where
cpt { } _ = do
pure $ H.div { className: "container" } [ H.hr {}, H.footer {} [] ]
Forest.purs 0000664 0000000 0000000 00000006721 14111104351 0032645 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components module Gargantext.Components.Forest
( forest
, forestLayout
, Props
) where
import Gargantext.Prelude
import Data.Array as A
import Data.Maybe (Maybe(..))
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Forest.Tree (treeLoader)
import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session(..), unSessions)
import Gargantext.Types (switchHanded)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Forest"
-- Shared by components here with Tree
type Props =
( boxes :: Boxes
, frontends :: Frontends
)
forest :: R2.Component Props
forest = R.createElement forestCpt
forestCpt :: R.Component Props
forestCpt = here.component "forest" cpt where
cpt { boxes: boxes@{ handed
, reloadForest
, sessions }
, frontends } _ = do
-- TODO Fix this. I think tasks shouldn't be a Box but only a Reductor
-- tasks' <- GAT.useTasks reloadRoot reloadForest
-- R.useEffect' $ do
-- T.write_ (Just tasks') tasks
handed' <- T.useLive T.unequal handed
sessions' <- T.useLive T.unequal sessions
-- forestOpen' <- T.useLive T.unequal forestOpen
-- reloadRoot' <- T.useLive T.unequal reloadRoot
-- route' <- T.useLive T.unequal route
-- TODO If `reloadForest` is set, `reload` state should be updated
-- TODO fix tasks ref
pure $ H.div { className: "forest-layout-content" }
(A.cons (plus { boxes }) (trees handed' sessions'))
where
trees handed' sessions' = (tree handed') <$> unSessions sessions'
tree handed' s@(Session { treeId }) =
treeLoader { boxes
, frontends
, handed: handed'
, reload: reloadForest
, root: treeId
, session: s } []
type Plus = ( boxes :: Boxes )
plus :: R2.Leaf Plus
plus p = R.createElement plusCpt p []
plusCpt :: R.Component Plus
plusCpt = here.component "plus" cpt where
cpt { boxes: { backend, handed, showLogin } } _ = do
handed' <- T.useLive T.unequal handed
pure $ H.div {}
[ H.button { className: buttonClass handed'
, on: { click }
, title }
[ H.div { className: divClass } [ H.text " Log in/out " ] -- fa-lg
, H.div {} [ H.text " " ] ]
]
--, H.div { "type": "", className: "fa fa-plus-circle fa-lg"} []
--, H.div { "type": "", className: "fa fa-minus-circle fa-lg"} []
-- TODO same as the one in the Login Modal (same CSS)
-- [ H.i { className: "material-icons md-36"} [] ]
where
click _ = do
-- NOTE Reset backend in case G.C.N.Home.homeLayout set that to (Just b)
-- from current url
_ <- T.write Nothing backend
T.write_ true showLogin
title = "Add or remove connections to the server(s)."
divClass = "fa fa-universal-access"
buttonClass handed' =
"btn btn-primary d-block " <> switchHanded "mr-1 ml-auto" "ml-1 mr-auto" handed'
forestLayout :: R2.Component Props
forestLayout = R.createElement forestLayoutCpt
forestLayoutCpt :: R.Component Props
forestLayoutCpt = here.component "forestLayout" cpt where
cpt p _ = pure $
H.div { className: "forest-layout-wrapper col-md-2" }
[
H.div { className: "forest-layout" }
[
forest p []
,
H.div { className: "forest-layout-teaser" } []
]
]
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/0000775 0000000 0000000 00000000000 14111104351 0032003 5 ustar 00root root 0000000 0000000 Tree.purs 0000664 0000000 0000000 00000032514 14111104351 0033543 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest module Gargantext.Components.Forest.Tree where
import Gargantext.Prelude
import Data.Array as A
import Data.Either (Either)
import Data.Maybe (Maybe(..))
import Data.Traversable (traverse_, traverse)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Forest.Tree.Node (nodeSpan)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode)
import Gargantext.Components.Forest.Tree.Node.Action.Contact as Contact
import Gargantext.Components.Forest.Tree.Node.Action.Delete (deleteNode, unpublishNode)
import Gargantext.Components.Forest.Tree.Node.Action.Link (linkNodeReq)
import Gargantext.Components.Forest.Tree.Node.Action.Merge (mergeNodeReq)
import Gargantext.Components.Forest.Tree.Node.Action.Move (moveNodeReq)
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.Update (updateRequest)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile, uploadArbitraryFile)
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..), fTreeID)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Config.Utils (handleRESTError)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, get, mkNodeId)
import Gargantext.Sessions.Types (useOpenNodesMemberBox, openNodesInsert, openNodesDelete)
import Gargantext.Types (Handed, ID, isPublic, publicize, switchHanded)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RecordE
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree"
-- Shared by every component here
type Common =
( boxes :: Boxes
, frontends :: Frontends
, handed :: Handed
, reload :: T2.ReloadS
)
type LoaderProps =
( root :: ID
, session :: Session
| Common )
type NodeProps =
( reloadTree :: T2.ReloadS
, session :: Session
| Common )
type TreeProps =
( tree :: FTree
| NodeProps )
type ChildrenTreeProps =
( childProps :: { children' :: Array FTree
, folderOpen :: T.Box Boolean
, render :: R2.Leaf TreeProps }
| TreeProps )
--- The properties tree shares in common with performAction
type PACommon =
( boxes :: Boxes
, reloadTree :: T2.ReloadS
, session :: Session
, tree :: FTree
)
-- The properties tree shares in common with nodeSpan
type NSCommon =
( frontends :: Frontends
, handed :: Handed
, session :: Session )
-- The annoying 'render' here is busting a cycle in the low tech
-- way. This function is only called by functions in this module, so
-- we just have to careful in what we pass.
type ChildLoaderProps =
( id :: ID
, render :: R2.Leaf TreeProps
| NodeProps )
type PerformActionProps =
( setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
| PACommon )
-- | Loads and renders the tree starting at the given root node id.
treeLoader :: R2.Component LoaderProps
treeLoader = R.createElement treeLoaderCpt
treeLoaderCpt :: R.Component LoaderProps
treeLoaderCpt = here.component "treeLoader" cpt where
-- treeLoaderCpt :: R.Memo LoaderProps
-- treeLoaderCpt = R.memo (here.component "treeLoader" cpt) memoCmp where
-- memoCmp ({ root: t1 }) ({ root: t2 }) = t1 == t2
cpt p@{ root, session } _ = do
-- app <- T.useLive T.unequal p.reloadRoot
let fetch { root: r } = getNodeTree session r
useLoader { errorHandler
, loader: fetch
, path: { root }
, render: loaded }
where
loaded tree' = tree props where
props = Record.merge common extra where
common = RecordE.pick p :: Record Common
extra = { tree: tree', reloadTree: p.reload, session }
errorHandler err = here.log2 "[treeLoader] RESTError" err
getNodeTree :: Session -> ID -> Aff (Either RESTError FTree)
getNodeTree session nodeId = get session $ GR.NodeAPI GT.Tree (Just nodeId) ""
getNodeTreeFirstLevel :: Session -> ID -> Aff (Either RESTError FTree)
getNodeTreeFirstLevel session nodeId = get session $ GR.TreeFirstLevel (Just nodeId) ""
tree :: R2.Leaf TreeProps
tree props = R.createElement treeCpt props []
treeCpt :: R.Component TreeProps
treeCpt = here.component "tree" cpt where
cpt p@{ boxes: boxes@{ forestOpen }
, frontends
, handed
, reload
, session
, tree: NTree (LNode { id, name, nodeType }) children } _ = do
setPopoverRef <- R.useRef Nothing
folderOpen <- useOpenNodesMemberBox nodeId forestOpen
pure $ H.ul { className: ulClass }
[ H.li { className: childrenClass children' }
[ nodeSpan { boxes
, dispatch: dispatch setPopoverRef
, folderOpen
, frontends
, id
, isLeaf
, name
, nodeType
, reload
, session
, setPopoverRef }
[ renderChildren (Record.merge p { childProps: { children', folderOpen, render: tree } } ) [] ]
]
]
where
isLeaf = A.null children
nodeId = mkNodeId session id
ulClass = switchHanded "ml left" "mr right" handed <> "-auto tree handed"
children' = A.sortWith fTreeID pubChildren
pubChildren = if isPublic nodeType then map (map pub) children else children
dispatch setPopoverRef a = performAction a (Record.merge common' spr) where
common' = RecordE.pick p :: Record PACommon
spr = { setPopoverRef }
pub (LNode n@{ nodeType: t }) = LNode (n { nodeType = publicize t })
childrenClass [] = "no-children"
childrenClass _ = "with-children"
renderChildren :: R2.Component ChildrenTreeProps
renderChildren = R.createElement renderChildrenCpt
renderChildrenCpt :: R.Component ChildrenTreeProps
renderChildrenCpt = here.component "renderChildren" cpt where
cpt p@{ childProps: { folderOpen } } _ = do
folderOpen' <- T.useLive T.unequal folderOpen
if folderOpen' then
pure $ renderTreeChildren p []
else
pure $ H.div {} []
renderTreeChildren :: R2.Component ChildrenTreeProps
renderTreeChildren = R.createElement renderTreeChildrenCpt
renderTreeChildrenCpt :: R.Component ChildrenTreeProps
renderTreeChildrenCpt = here.component "renderTreeChildren" cpt where
cpt p@{ childProps: { children'
, render } } _ = do
pure $ R.fragment (map renderChild children')
where
nodeProps = RecordE.pick p :: Record NodeProps
renderChild (NTree (LNode {id: cId}) _) = childLoader props [] where
props = Record.merge nodeProps { id: cId, render }
childLoader :: R2.Component ChildLoaderProps
childLoader = R.createElement childLoaderCpt
childLoaderCpt :: R.Component ChildLoaderProps
childLoaderCpt = here.component "childLoader" cpt where
cpt p@{ boxes: { reloadRoot }
, reloadTree
, render } _ = do
reload <- T.useBox T2.newReload
let reloads = [ reload, reloadRoot, reloadTree ]
cache <- (A.cons p.id) <$> traverse (T.useLive T.unequal) reloads
useLoader { errorHandler
, loader: fetch
, path: cache
, render: paint reload }
where
errorHandler err = here.log2 "[childLoader] RESTError" err
fetch _ = getNodeTreeFirstLevel p.session p.id
paint reload tree' = render (Record.merge base extra) where
base = nodeProps { reload = reload }
extra = { tree: tree' }
nodeProps = RecordE.pick p :: Record NodeProps
closePopover { setPopoverRef } =
liftEffect $ traverse_ (\set -> set false) (R.readRef setPopoverRef)
refreshTree p@{ reloadTree } = liftEffect $ T2.reload reloadTree *> closePopover p
deleteNode' nt p@{ boxes: { forestOpen }, session, tree: (NTree (LNode {id, parent_id}) _) } = do
case nt of
GT.NodePublic GT.FolderPublic -> void $ deleteNode session nt id
GT.NodePublic _ -> void $ unpublishNode session parent_id id
_ -> void $ deleteNode session nt id
liftEffect $ T.modify_ (openNodesDelete (mkNodeId session id)) forestOpen
refreshTree p
doSearch task p@{ boxes: { tasks }, tree: NTree (LNode {id}) _ } = liftEffect $ do
GAT.insert id task tasks
here.log2 "[doSearch] DoSearch task:" task
updateNode params { boxes: { errors, tasks }, session, tree: (NTree (LNode {id}) _) } = do
eTask <- updateRequest params session id
handleRESTError errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks
here.log2 "[updateNode] UpdateNode task:" task
renameNode name p@{ boxes: { errors }, session, tree: (NTree (LNode {id}) _) } = do
eTask <- rename session id $ RenameValue { text: name }
handleRESTError errors eTask $ \_task -> pure unit
refreshTree p
shareTeam username p@{ boxes: { errors }, session, tree: (NTree (LNode {id}) _)} = do
eTask <- Share.shareReq session id $ Share.ShareTeamParams { username }
handleRESTError errors eTask $ \_task -> pure unit
sharePublic params p@{ boxes: { errors, forestOpen }, session } = traverse_ f params where
f (SubTreeOut { in: inId, out }) = do
eTask <- Share.shareReq session inId $ Share.SharePublicParams { node_id: out }
handleRESTError errors eTask $ \_task -> do
liftEffect $ T.modify_ (openNodesInsert (mkNodeId p.session out)) forestOpen
refreshTree p
addContact params p@{ boxes: { errors }, session, tree: (NTree (LNode {id}) _) } = do
eTask <- Contact.contactReq session id params
handleRESTError errors eTask $ \_task -> pure unit
addNode' name nodeType p@{ boxes: { errors, forestOpen }, session, tree: (NTree (LNode { id }) _) } = do
eId <- addNode session id $ AddNodeValue { name, nodeType }
handleRESTError errors eId $ \_id -> liftEffect $ do
liftEffect $ T.modify_ (openNodesInsert (mkNodeId session id)) forestOpen
refreshTree p
uploadFile' nodeType fileType mName contents p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } = do
eTask <- uploadFile { contents, fileType, id, mName, nodeType, session }
handleRESTError errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks
here.log2 "[uploadFile'] UploadFile, uploaded, task:" task
uploadArbitraryFile' mName blob p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } = do
eTask <- uploadArbitraryFile session id { blob, mName }
handleRESTError errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks
here.log2 "[uploadArbitraryFile'] UploadArbitraryFile, uploaded, task:" task
moveNode params p@{ boxes: { errors, forestOpen }, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
eTask <- moveNodeReq session in' out
handleRESTError errors eTask $ \_task -> pure unit
liftEffect $ T.modify_ (openNodesInsert (mkNodeId session out)) forestOpen
refreshTree p
mergeNode params p@{ boxes: { errors }, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
eTask <- mergeNodeReq session in' out
handleRESTError errors eTask $ \_task -> pure unit
refreshTree p
linkNode nodeType params p@{ boxes: { errors }, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
eTask <- linkNodeReq session nodeType in' out
handleRESTError errors eTask $ \_task -> pure unit
refreshTree p
-- | This thing is basically a hangover from when garg was a thermite
-- | application. we should slowly get rid of it.
performAction :: Action -> Record PerformActionProps -> Aff Unit
performAction (DeleteNode nt) p = deleteNode' nt p
performAction (DoSearch task) p = doSearch task p
performAction (UpdateNode params) p = updateNode params p
performAction (RenameNode name) p = renameNode name p
performAction (ShareTeam username) p = shareTeam username p
performAction (SharePublic { params }) p = sharePublic params p
performAction (AddContact params) p = addContact params p
performAction (AddNode name nodeType) p = addNode' name nodeType p
performAction (UploadFile nodeType fileType mName contents) p = uploadFile' nodeType fileType mName contents p
performAction (UploadArbitraryFile mName blob) p = uploadArbitraryFile' mName blob p
performAction DownloadNode _ = liftEffect $ here.log "[performAction] DownloadNode"
performAction (MoveNode {params}) p = moveNode params p
performAction (MergeNode {params}) p = mergeNode params p
performAction (LinkNode { nodeType, params }) p = linkNode nodeType params p
performAction RefreshTree p = refreshTree p
performAction NoAction _ = liftEffect $ here.log "[performAction] NoAction"
performAction ClosePopover p = closePopover p
Tree/ 0000775 0000000 0000000 00000000000 14111104351 0032623 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest Node.purs 0000664 0000000 0000000 00000031270 14111104351 0034426 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree module Gargantext.Components.Forest.Tree.Node where
import Gargantext.Prelude
import Data.Maybe (Maybe(..))
import Data.Nullable (null)
import Data.Symbol (SProxy(..))
import Effect (Effect)
import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect)
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Upload (DroppedFile(..), fileTypeView)
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileBlob(..))
import Gargantext.Components.Forest.Tree.Node.Box (nodePopupView)
import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox)
import Gargantext.Components.Forest.Tree.Node.Tools (nodeLink)
import Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar (asyncProgressBar, BarType(..))
import Gargantext.Components.Forest.Tree.Node.Tools.Sync (nodeActionsGraph, nodeActionsNodeList)
import Gargantext.Components.GraphExplorer.API as GraphAPI
import Gargantext.Components.Lang (Lang(EN))
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId)
import Gargantext.Types (ID, Name, reverseHanded)
import Gargantext.Types as GT
import Gargantext.Utils.Popover as Popover
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Gargantext.Version as GV
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node"
-- Main Node
type NodeMainSpanProps =
( boxes :: Boxes
, dispatch :: Action -> Aff Unit
, folderOpen :: T.Box Boolean
, frontends :: Frontends
, id :: ID
, isLeaf :: IsLeaf
, name :: Name
, nodeType :: GT.NodeType
, reload :: T2.ReloadS
, session :: Session
, setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
)
type IsLeaf = Boolean
nodeSpan :: R2.Component NodeMainSpanProps
nodeSpan = R.createElement nodeSpanCpt
nodeSpanCpt :: R.Component NodeMainSpanProps
nodeSpanCpt = here.component "nodeSpan" cpt
where
cpt props@{ boxes: { handed } } children = do
handed' <- T.useLive T.unequal handed
let className = case handed' of
GT.LeftHanded -> "lefthanded"
GT.RightHanded -> "righthanded"
pure $ H.div { className } ([ nodeMainSpan props [] ] <> children)
nodeMainSpan :: R2.Component NodeMainSpanProps
nodeMainSpan = R.createElement nodeMainSpanCpt
nodeMainSpanCpt :: R.Component NodeMainSpanProps
nodeMainSpanCpt = here.component "nodeMainSpan" cpt
where
cpt props@{ boxes: boxes@{ errors
, handed
, reloadMainPage
, reloadRoot
, route
, tasks }
, dispatch
, folderOpen
, frontends
, id
, isLeaf
, nodeType
, reload
, session
, setPopoverRef
} _ = do
handed' <- T.useLive T.unequal handed
route' <- T.useLive T.unequal route
-- only 1 popup at a time is allowed to be opened
droppedFile <- T.useBox (Nothing :: Maybe DroppedFile)
droppedFile' <- T.useLive T.unequal droppedFile
isDragOver <- T.useBox false
isDragOver' <- T.useLive T.unequal isDragOver
popoverRef <- R.useRef null
currentTasks <- GAT.focus id tasks
currentTasks' <- T.useLive T.unequal currentTasks
R.useEffect' $ do
R.setRef setPopoverRef $ Just $ Popover.setOpen popoverRef
let isSelected = Just route' == Routes.nodeTypeAppRoute nodeType (sessionId session) id
-- tasks' <- T.read tasks
pure $ H.span (dropProps droppedFile droppedFile' isDragOver isDragOver')
$ reverseHanded handed'
[ folderIcon { folderOpen, nodeType } []
, chevronIcon { folderOpen, handed, isLeaf, nodeType } []
, nodeLink { boxes
, folderOpen
, frontends
, id
, isSelected
, name: name' props
, nodeType
, session } []
, fileTypeView { dispatch, droppedFile, id, isDragOver, nodeType }
, H.div {} (map (\t -> asyncProgressBar { asyncTask: t
, barType: Pie
, errors
, nodeId: id
, onFinish: onTaskFinish id t
, session } []
) currentTasks'
)
, if nodeType == GT.NodeUser
then GV.versionView { session } []
else H.div {} []
, if showBox then
Popover.popover { arrow: false
, open: false
, onClose: \_ -> pure unit
, onOpen: \_ -> pure unit
, ref: popoverRef } [
popOverIcon
, mNodePopupView props (onPopoverClose popoverRef)
]
else H.div {} []
, nodeActions { id
, nodeType
, refresh: const $ dispatch RefreshTree
, session
} []
]
where
onTaskFinish id' t _ = do
GAT.finish id' t tasks
if GAT.asyncTaskTTriggersAppReload t then do
here.log2 "reloading root for task" t
T2.reload reloadRoot
else do
if GAT.asyncTaskTTriggersTreeReload t then do
here.log2 "reloading tree for task" t
T2.reload reload
else do
here.log2 "task doesn't trigger a tree reload" t
pure unit
if GAT.asyncTaskTTriggersMainPageReload t then do
here.log2 "reloading main page for task" t
T2.reload reloadMainPage
else do
here.log2 "task doesn't trigger a main page reload" t
pure unit
-- snd tasks $ GAT.Finish id' t
-- mT <- T.read tasks
-- case mT of
-- Just t' -> snd t' $ GAT.Finish id' t
-- Nothing -> pure unit
-- T2.reload reloadRoot
SettingsBox {show: showBox} = settingsBox nodeType
onPopoverClose popoverRef _ = Popover.setOpen popoverRef false
name' {name: n, nodeType: nt} = if nt == GT.NodeUser then show session else n
mNodePopupView props'@{ boxes: b, id: i, nodeType: nt } opc =
nodePopupView { boxes: b
, dispatch
, id: i
, name: name' props'
, nodeType: nt
, onPopoverClose: opc
, session }
popOverIcon =
H.a { className: "settings fa fa-cog"
, title : "Each node of the Tree can perform some actions.\n"
<> "Click here to execute one of them." } []
dropProps droppedFile droppedFile' isDragOver isDragOver' =
{ className: "leaf " <> (dropClass droppedFile' isDragOver')
, on: { dragLeave: onDragLeave isDragOver
, dragOver: onDragOverHandler isDragOver
, drop: dropHandler droppedFile }
}
where
dropClass (Just _) _ = "file-dropped"
dropClass _ true = "file-dropped"
dropClass Nothing _ = ""
dropHandler droppedFile e = do
-- prevent redirection when file is dropped
E.preventDefault e
E.stopPropagation e
blob <- R2.dataTransferFileBlob e
void $ launchAff do
--contents <- readAsText blob
liftEffect $ do
T.write_ (Just
$ DroppedFile { blob: (UploadFileBlob blob)
, fileType: Just CSV
, lang : EN
}) droppedFile
onDragOverHandler isDragOver e = do
-- prevent redirection when file is dropped
-- https://stackoverflow.com/a/6756680/941471
E.preventDefault e
E.stopPropagation e
T.write_ true isDragOver
onDragLeave isDragOver _ = T.write_ false isDragOver
type FolderIconProps = (
folderOpen :: T.Box Boolean
, nodeType :: GT.NodeType
)
folderIcon :: R2.Component FolderIconProps
folderIcon = R.createElement folderIconCpt
folderIconCpt :: R.Component FolderIconProps
folderIconCpt = here.component "folderIcon" cpt
where
cpt { folderOpen, nodeType } _ = do
open <- T.useLive T.unequal folderOpen
pure $ H.a { className: "folder-icon", on: { click: \_ -> T.modify_ not folderOpen } }
[ H.i { className: GT.fldr nodeType open } [] ]
type ChevronIconProps = (
folderOpen :: T.Box Boolean
, handed :: T.Box GT.Handed
, isLeaf :: Boolean
, nodeType :: GT.NodeType
)
chevronIcon :: R2.Component ChevronIconProps
chevronIcon = R.createElement chevronIconCpt
chevronIconCpt :: R.Component ChevronIconProps
chevronIconCpt = here.component "chevronIcon" cpt
where
cpt { folderOpen, handed, isLeaf: true, nodeType } _ = do
pure $ H.div {} []
cpt { folderOpen, handed, isLeaf: false, nodeType } _ = do
handed' <- T.useLive T.unequal handed
open <- T.useLive T.unequal folderOpen
pure $ H.a { className: "chevron-icon"
, on: { click: \_ -> T.modify_ not folderOpen }
}
[ H.i { className: if open
then "fa fa-chevron-down"
else if handed' == GT.RightHanded
then "fa fa-chevron-right"
else "fa fa-chevron-left"
} [] ]
{-
fldr nt open = if open
then "fa fa-globe" -- <> color nt
else "fa fa-folder-globe" -- <> color nt
--else "fa fa-folder-close" <> color nt
where
color GT.NodeUser = ""
color FolderPublic = ""
color FolderShared = " text-warning"
color _ = " text-danger"
-}
-- START nodeActions
type NodeActionsCommon =
( id :: ID
, refresh :: Unit -> Aff Unit
, session :: Session
)
type NodeActionsProps = ( nodeType :: GT.NodeType | NodeActionsCommon )
nodeActions :: R2.Component NodeActionsProps
nodeActions = R.createElement nodeActionsCpt
nodeActionsCpt :: R.Component NodeActionsProps
nodeActionsCpt = here.component "nodeActions" cpt where
cpt props _ = pure (child props.nodeType) where
nodeActionsP = SProxy :: SProxy "nodeType"
childProps = Record.delete nodeActionsP props
child GT.NodeList = listNodeActions childProps
child GT.Graph = graphNodeActions childProps
child _ = H.div {} []
graphNodeActions :: R2.Leaf NodeActionsCommon
graphNodeActions props = R.createElement graphNodeActionsCpt props []
graphNodeActionsCpt :: R.Component NodeActionsCommon
graphNodeActionsCpt = here.component "graphNodeActions" cpt where
cpt { id, session, refresh } _ =
useLoader { errorHandler
, loader: graphVersions session
, path: id
, render: \gv -> nodeActionsGraph { graphVersions: gv, session, id, refresh } [] }
graphVersions session graphId = GraphAPI.graphVersions { graphId, session }
errorHandler err = here.log2 "[graphNodeActions] RESTError" err
listNodeActions :: R2.Leaf NodeActionsCommon
listNodeActions props = R.createElement listNodeActionsCpt props []
listNodeActionsCpt :: R.Component NodeActionsCommon
listNodeActionsCpt = here.component "listNodeActions" cpt where
cpt { id, session, refresh } _ =
useLoader { errorHandler
, path: { nodeId: id, session }
, loader: loadCorpusWithChild
, render: \{ corpusId } -> nodeActionsNodeList
{ listId: id, nodeId: corpusId, session, refresh: refresh
, nodeType: GT.TabNgramType GT.CTabTerms } }
where
errorHandler err = here.log2 "[listNodeActions] RESTError" err
Node/ 0000775 0000000 0000000 00000000000 14111104351 0033510 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree Action.purs 0000664 0000000 0000000 00000014377 14111104351 0035654 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node module Gargantext.Components.Forest.Tree.Node.Action where
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut, SubTreeParams(..))
import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction(..), glyphiconNodeAction)
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType, UploadFileBlob)
import Gargantext.Components.Forest.Tree.Node.Action.Update.Types (UpdateNodeParams)
import Gargantext.Components.Forest.Tree.Node.Action.Contact.Types (AddContactParams)
import Gargantext.Sessions (Session)
import Gargantext.Types as GT
type Props =
( dispatch :: Action -> Aff Unit
, id :: Int
, nodeType :: GT.NodeType
, session :: Session
)
data Action = AddNode String GT.NodeType
| DeleteNode GT.NodeType
| RenameNode String
| UpdateNode UpdateNodeParams
| DoSearch GT.AsyncTaskWithType
| UploadFile GT.NodeType FileType (Maybe String) String
| UploadArbitraryFile (Maybe String) UploadFileBlob
| DownloadNode
| RefreshTree
| ClosePopover
| ShareTeam String
| AddContact AddContactParams
| SharePublic {params :: Maybe SubTreeOut}
| MoveNode {params :: Maybe SubTreeOut}
| MergeNode {params :: Maybe SubTreeOut}
| LinkNode {nodeType :: Maybe GT.NodeType, params :: Maybe SubTreeOut}
| NoAction
subTreeOut :: Action -> Maybe SubTreeOut
subTreeOut (MoveNode {params}) = params
subTreeOut (MergeNode {params}) = params
subTreeOut (LinkNode {params}) = params
subTreeOut (SharePublic {params}) = params
subTreeOut _ = Nothing
setTreeOut :: Action -> Maybe SubTreeOut -> Action
setTreeOut (MoveNode {params:_}) p = MoveNode {params: p}
setTreeOut (MergeNode {params:_}) p = MergeNode {params: p}
setTreeOut (LinkNode {nodeType, params:_}) p = LinkNode {nodeType, params: p}
setTreeOut (SharePublic {params:_}) p = SharePublic {params: p}
setTreeOut a _ = a
derive instance Generic Action _
instance Eq Action where
eq (AddNode s1 nt1) (AddNode s2 nt2) = (eq s1 s2) && (eq nt1 nt2)
eq (DeleteNode nt1) (DeleteNode nt2) = eq nt1 nt2
eq (RenameNode s1) (RenameNode s2) = eq s1 s2
eq (UpdateNode un1) (UpdateNode un2) = eq un1 un2
eq (DoSearch at1) (DoSearch at2) = eq at1 at2
eq (UploadFile nt1 ft1 s1 _) (UploadFile nt2 ft2 s2 _) = (eq nt1 nt2) && (eq ft1 ft2) && (eq s1 s2)
eq (UploadArbitraryFile s1 _) (UploadArbitraryFile s2 _) = eq s1 s2
eq DownloadNode DownloadNode = true
eq RefreshTree RefreshTree = true
eq ClosePopover ClosePopover = true
eq (ShareTeam s1) (ShareTeam s2) = eq s1 s2
eq (AddContact ac1) (AddContact ac2) = eq ac1 ac2
eq (SharePublic p1) (SharePublic p2) = eq p1 p2
eq (MoveNode p1) (MoveNode p2) = eq p1 p2
eq (MergeNode p1) (MergeNode p2) = eq p1 p2
eq (LinkNode l1) (LinkNode l2) = eq l1 l2
eq NoAction NoAction = true
eq _ _ = false
instance Show Action where
show (AddNode _ _ ) = "AddNode"
show (DeleteNode _ ) = "DeleteNode"
show (RenameNode _ ) = "RenameNode"
show (UpdateNode _ ) = "UpdateNode"
show (ShareTeam _ ) = "ShareTeam"
show (AddContact _ ) = "AddContact"
show (SharePublic _ ) = "SharePublic"
show (DoSearch _ ) = "SearchQuery"
show (UploadFile _ _ _ _) = "UploadFile"
show (UploadArbitraryFile _ _) = "UploadArbitraryFile"
show RefreshTree = "RefreshTree"
show ClosePopover = "ClosePopover"
show DownloadNode = "Download"
show (MoveNode _ ) = "MoveNode"
show (MergeNode _ ) = "MergeNode"
show (LinkNode _ ) = "LinkNode"
show NoAction = "NoAction"
-----------------------------------------------------------------------
icon :: Action -> String
icon (AddNode _ _) = glyphiconNodeAction (Add [])
icon (DeleteNode _) = glyphiconNodeAction Delete
icon (RenameNode _) = glyphiconNodeAction Config
icon (UpdateNode _) = glyphiconNodeAction Refresh
icon (ShareTeam _) = glyphiconNodeAction Share
icon (AddContact _) = glyphiconNodeAction Share
icon (SharePublic _ ) = glyphiconNodeAction (Publish { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (DoSearch _) = glyphiconNodeAction SearchBox
icon (UploadFile _ _ _ _) = glyphiconNodeAction Upload
icon (UploadArbitraryFile _ _ ) = glyphiconNodeAction Upload
icon RefreshTree = glyphiconNodeAction Refresh
icon ClosePopover = glyphiconNodeAction CloseNodePopover
icon DownloadNode = glyphiconNodeAction Download
icon (MoveNode _ ) = glyphiconNodeAction (Move { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (MergeNode _ ) = glyphiconNodeAction (Merge { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (LinkNode _ ) = glyphiconNodeAction (Link { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon NoAction = "hand-o-right"
-- icon _ = "hand-o-right"
text :: Action -> String
text (AddNode _ _ ) = "Add !"
text (DeleteNode _ ) = "Delete !"
text (RenameNode _ ) = "Rename !"
text (UpdateNode _ ) = "Update !"
text (ShareTeam _ ) = "Share with team !"
text (AddContact _ ) = "Add contact !"
text (SharePublic _ ) = "Publish !"
text (DoSearch _ ) = "Launch search !"
text (UploadFile _ _ _ _) = "Upload File !"
text (UploadArbitraryFile _ _) = "Upload arbitrary file !"
text RefreshTree = "Refresh Tree !"
text ClosePopover = "Close Popover !"
text DownloadNode = "Download !"
text (MoveNode _ ) = "Move !"
text (MergeNode _ ) = "Merge !"
text (LinkNode _ ) = "Link !"
text NoAction = "No Action"
-----------------------------------------------------------------------
Action/ 0000775 0000000 0000000 00000000000 14111104351 0034725 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node Add.purs 0000664 0000000 0000000 00000013520 14111104351 0036331 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Action module Gargantext.Components.Forest.Tree.Node.Action.Add where
import Gargantext.Prelude
import Data.Array (head, length)
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..), fromMaybe, isJust)
import Data.Newtype (class Newtype)
import Data.String (Pattern(..), indexOf)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox)
import Gargantext.Components.Forest.Tree.Node.Tools (formChoiceSafe, panel, submitButton)
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Lang (Lang(..), translate)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
import Gargantext.Types (NodeType(..), charCodeIcon)
import Gargantext.Types as GT
import Gargantext.Utils (nbsp)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
import Web.HTML (window)
import Web.HTML.Navigator (userAgent)
import Web.HTML.Window (navigator)
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Add"
addNode :: Session -> GT.ID -> AddNodeValue -> Aff (Either RESTError (Array GT.ID))
addNode session parentId = post session $ GR.NodeAPI GT.Node (Just parentId) ""
addNodeAsync :: Session
-> GT.ID
-> AddNodeValue
-> Aff (Either RESTError GT.AsyncTaskWithType)
addNodeAsync session parentId q = do
eTask :: Either RESTError GT.AsyncTask <- post session p q
case eTask of
Left err -> pure $ Left err
Right task -> pure $ Right $ GT.AsyncTaskWithType { task, typ: GT.AddNode }
where
p = GR.NodeAPI GT.Node (Just parentId) (GT.asyncTaskTypePath GT.AddNode)
----------------------------------------------------------------------
-- TODO AddNodeParams
newtype AddNodeValue = AddNodeValue
{ name :: GT.Name
, nodeType :: GT.NodeType
}
derive instance Generic AddNodeValue _
derive instance Newtype AddNodeValue _
instance JSON.WriteForeign AddNodeValue where
writeImpl (AddNodeValue {name, nodeType}) = JSON.writeImpl { pn_name: name
, pn_typename: nodeType }
----------------------------------------------------------------------
data NodePopup = CreatePopup | NodePopup
type CreateNodeProps =
( id :: GT.ID
, dispatch :: Action -> Aff Unit
, name :: GT.Name
, nodeType :: NodeType
, nodeTypes :: Array NodeType
)
addNodeView :: R2.Component CreateNodeProps
addNodeView = R.createElement addNodeViewCpt
addNodeViewCpt :: R.Component CreateNodeProps
addNodeViewCpt = here.component "addNodeView" cpt where
cpt { dispatch
, id
, name
, nodeTypes } _ = do
nodeName <- T.useBox "Name"
nodeName' <- T.useLive T.unequal nodeName
nodeType <- T.useBox $ fromMaybe Folder $ head nodeTypes
nodeType' <- T.useLive T.unequal nodeType
hasChromeAgent' <- R.unsafeHooksEffect hasChromeAgent
let
SettingsBox {edit} = settingsBox nodeType'
setNodeType' nt = do
T.write_ (GT.prettyNodeType nt) nodeName
T.write_ nt nodeType
(maybeChoose /\ nt') = if length nodeTypes > 1
then ([ formChoiceSafe nodeTypes Error setNodeType' (print hasChromeAgent') ] /\ nodeType')
else ([H.div {} [H.text $ "Creating a node of type "
<> show defaultNt
<> " with name:"
]
] /\ defaultNt
)
where
defaultNt = (fromMaybe Error $ head nodeTypes)
maybeEdit = [ if edit
then inputWithEnter {
onBlur: \val -> T.write_ val nodeName
, onEnter: \_ -> launchAff_ $ dispatch (AddNode nodeName' nt')
, onValueChanged: \val -> T.write_ val nodeName
, autoFocus: true
, className: "form-control"
, defaultValue: nodeName' -- (prettyNodeType nt')
, placeholder: nodeName' -- (prettyNodeType nt')
, type: "text"
}
else H.div {} []
]
pure $ panel (maybeChoose <> maybeEdit) (submitButton (AddNode nodeName' nt') dispatch)
-- END Create Node
showConfig :: NodeType -> R.Element
showConfig NodeUser = H.div {} []
showConfig FolderPrivate = H.div {} [H.text "This folder will be private only"]
showConfig FolderShared = H.div {} [H.text "This folder will be shared"]
showConfig FolderPublic = H.div {} [H.text "This folder will be public"]
showConfig nt = H.div {} [H.h4 {} [H.text $ "Config of " <> show nt ]]
-- (?) Regarding `print` and `hasChromeAgent`
--
-- As described in #309:
-- * while sticking to solution a) for icon display, it only works on
-- Chrome engine
-- * for now, we just patch surgery the like of display according to the
-- user browser (ie. has Chrome -> has icons)
print :: Boolean -> NodeType -> String
print withIconFlag nt =
let txt = translate EN -- @TODO "EN" assumption
in if withIconFlag
then
charCodeIcon nt true
--- as we are printing within an HTML text node,
-- margins will directly rely on content text spacing
<> nbsp 4
<> txt nt
else
txt nt
hasChromeAgent :: Effect Boolean
hasChromeAgent = window >>= navigator >>= userAgent >>= \ua -> pure $ check ua
where
check = indexOf (Pattern "Chrome") >>> isJust
Contact.purs 0000664 0000000 0000000 00000006402 14111104351 0037235 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Action module Gargantext.Components.Forest.Tree.Node.Action.Contact where
import Prelude
import Data.Either (Either)
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff, launchAff)
import Formula as F
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Contact.Types (AddContactParams(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
import Gargantext.Types (ID)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Contact"
contactReq :: Session -> ID -> AddContactParams -> Aff (Either RESTError ID)
contactReq session nodeId =
post session $ GR.NodeAPI GT.Annuaire (Just nodeId) "contact"
type ActionAddContact =
( dispatch :: Action -> Aff Unit
, id :: ID )
actionAddContact :: R2.Component ActionAddContact
actionAddContact = R.createElement actionAddContactCpt
actionAddContactCpt :: R.Component ActionAddContact
actionAddContactCpt = here.component "actionAddContact" cpt where
cpt { dispatch, id } _ = do
isOpen <- T.useBox true
pure $ textInputBox
{ boxAction: \p -> AddContact p
, boxName:"addContact"
, dispatch
, id
, isOpen
, params: {firstname:"First Name", lastname: "Last Name"} }
type TextInputBoxProps =
( boxAction :: AddContactParams -> Action
, boxName :: String
, dispatch :: Action -> Aff Unit
, id :: ID
, isOpen :: T.Box Boolean
, params :: Record AddContactProps )
type AddContactProps = ( firstname :: String, lastname :: String )
textInputBox :: R2.Leaf TextInputBoxProps
textInputBox props = R.createElement textInputBoxCpt props []
textInputBoxCpt :: R.Component TextInputBoxProps
textInputBoxCpt = here.component "textInputBox" cpt where
cpt { boxName, boxAction, dispatch, isOpen
, params: { firstname, lastname } } _ =
content <$> T.useLive T.unequal isOpen
<*> T.useBox firstname <*> T.useBox lastname
where
content false _ _ = H.div {} []
content true firstName lastName =
H.div { className: "from-group row" }
[ textInput firstName
, textInput lastName
, submitBtn firstName lastName
, cancelBtn
] where
textInput value =
H.div {className: "col-md-8"}
[ F.bindInput
{ value, className: "form-control", type: "text"
, placeholder: (boxName <> " Node") } ]
submitBtn first last =
H.a
{ className: "btn glyphitem fa fa-ok col-md-2 pull-left"
, type: "button", on: { click }, title:"Submit"
} [] where
click _ = do
f <- T.read first
l <- T.read last
T.write_ false isOpen
launchAff $
dispatch (boxAction $ AddContactParams { firstname: f, lastname: l })
cancelBtn =
H.a
{ className: "btn text-danger glyphitem fa fa-remove col-md-2 pull-left"
, on: { click }, title: "Cancel", type: "button"
} [] where
click _ = T.write_ false isOpen
Contact/ 0000775 0000000 0000000 00000000000 14111104351 0036320 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Action Types.purs 0000664 0000000 0000000 00000001215 14111104351 0040336 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Action/Contact module Gargantext.Components.Forest.Tree.Node.Action.Contact.Types where
import Data.Generic.Rep (class Generic)
import Data.Newtype (class Newtype)
import Data.Show.Generic (genericShow)
import Simple.JSON as JSON
import Gargantext.Prelude (class Eq, class Show)
newtype AddContactParams =
AddContactParams { firstname :: String, lastname :: String }
derive instance Eq AddContactParams
derive instance Generic AddContactParams _
derive instance Newtype AddContactParams _
instance Show AddContactParams where show = genericShow
derive newtype instance JSON.ReadForeign AddContactParams
derive newtype instance JSON.WriteForeign AddContactParams
Delete.purs 0000664 0000000 0000000 00000005400 14111104351 0037041 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Action module Gargantext.Components.Forest.Tree.Node.Action.Delete
where
import Gargantext.Prelude
import Data.Either (Either)
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, delete, put_)
import Gargantext.Types (NodeType(..))
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Delete"
-- TODO Delete with asyncTaskWithType
deleteNode :: Session -> NodeType -> GT.ID -> Aff (Either RESTError GT.ID)
deleteNode session nt nodeId = delete session $ NodeAPI GT.Node (Just nodeId) ""
{-
case nt of
NodePublic FolderPublic -> delete session $ NodeAPI GT.Node (Just nodeId) ""
NodePublic _ -> put_ session $ NodeAPI GT.Node (Just nodeId) "unpublish"
_ -> delete session $ NodeAPI GT.Node (Just nodeId) ""
-}
type ParentID = GT.ID
unpublishNode :: Session -> Maybe ParentID -> GT.ID -> Aff (Either RESTError GT.ID)
unpublishNode s p n = put_ s $ NodeAPI GT.Node p ("unpublish/" <> show n)
-- | Action : Delete
type Delete =
( dispatch :: Action -> Aff Unit
, nodeType :: NodeType )
actionDelete :: R2.Component Delete
actionDelete = R.createElement actionDeleteCpt
actionDeleteCpt :: R.Component Delete
actionDeleteCpt = here.component "actionDelete" cpt where
cpt props@{ nodeType: NodeUser } _ = pure $ actionDeleteUser props []
cpt props _ = pure $ actionDeleteOther props []
actionDeleteUser :: R2.Component Delete
actionDeleteUser = R.createElement actionDeleteUserCpt
actionDeleteUserCpt :: R.Component Delete
actionDeleteUserCpt = here.component "actionDeleteUser" cpt where
cpt _ _ = do
pure $ panel [ H.div { style: {margin: "10px"}}
[ H.text $ "Yes, we are RGPD compliant!"
<> " But you can not delete User Node yet."
<> " We are still on development."
<> " Thanks for your comprehensin."
]
] (H.div {} [])
actionDeleteOther :: R2.Component Delete
actionDeleteOther = R.createElement actionDeleteOtherCpt
actionDeleteOtherCpt :: R.Component Delete
actionDeleteOtherCpt = here.component "actionDeleteOther" cpt where
cpt { dispatch, nodeType } _ = do
pure $ panel (map (\t -> H.p {} [H.text t])
[ "Are your sure you want to delete it ?"
, "If yes, click again below."
]
) (submitButton (DeleteNode nodeType) dispatch)
Documentation.purs 0000664 0000000 0000000 00000003261 14111104351 0040453 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Action module Gargantext.Components.Forest.Tree.Node.Action.Documentation where
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude (map, pure, show, ($), (<>))
import Gargantext.Components.Forest.Tree.Node.Tools (panel)
import Gargantext.Types (NodeType)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Documentation"
-- | Action: Show Documentation
type ActionDoc =
( nodeType :: NodeType )
actionDoc :: R2.Component ActionDoc
actionDoc = R.createElement actionDocCpt
actionDocCpt :: R.Component ActionDoc
actionDocCpt = here.component "actionDoc" cpt where
cpt { nodeType } _ = do
pure $ panel ([ infoTitle nodeType ]
<> (map (\info -> H.p {} [H.text info]) $ docOf nodeType)
)
(H.div {} [])
where
infoTitle :: NodeType -> R.Element
infoTitle nt = H.div { style: {margin: "10px"}}
[ H.h3 {} [H.text "Documentation about " ]
, H.h3 {className: GT.fldr nt true} [ H.text $ show nt ]
]
-- | TODO add documentation of all NodeType
docOf :: NodeType -> Array String
docOf GT.NodeUser = [ "This account is personal"
, "See the instances terms of uses."
]
docOf GT.FolderPrivate = ["This folder and its children are private only."]
docOf GT.FolderPublic = ["Soon, you will be able to build public folders to share your work with the world!"]
docOf GT.FolderShared = ["Soon, you will be able to build teams folders to share your work"]
docOf nodeType = ["More information on " <> show nodeType]
Download.purs 0000664 0000000 0000000 00000006544 14111104351 0037420 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Action module Gargantext.Components.Forest.Tree.Node.Action.Download where
import Data.Maybe (Maybe(..))
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Forest.Tree.Node.Action (Action(DownloadNode))
import Gargantext.Components.Forest.Tree.Node.Tools (fragmentPT, panel, submitButtonHref)
import Gargantext.Ends (url)
import Gargantext.Prelude (pure, ($))
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session)
import Gargantext.Types (ID)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Documentation"
-- | Action : Download
type ActionDownload =
( id :: ID
, nodeType :: GT.NodeType
, session :: Session )
actionDownload :: R2.Component ActionDownload
actionDownload = R.createElement actionDownloadCpt
actionDownloadCpt :: R.Component ActionDownload
actionDownloadCpt = here.component "actionDownload" cpt where
cpt props@{ nodeType: GT.Corpus } _ = pure $ actionDownloadCorpus props []
cpt props@{ nodeType: GT.Graph } _ = pure $ actionDownloadGraph props []
cpt props@{ nodeType: GT.NodeList } _ = pure $ actionDownloadNodeList props []
cpt props@{ nodeType: _ } _ = pure $ actionDownloadOther props []
actionDownloadCorpus :: R2.Component ActionDownload
actionDownloadCorpus = R.createElement actionDownloadCorpusCpt
actionDownloadCorpusCpt :: R.Component ActionDownload
actionDownloadCorpusCpt = here.component "actionDownloadCorpus" cpt where
cpt { id, session } _ = do
pure $ panel [H.div {} [H.text info]]
(submitButtonHref DownloadNode href)
where
href = url session $ Routes.NodeAPI GT.Corpus (Just id) "export"
info = "Download as JSON"
actionDownloadGraph :: R2.Component ActionDownload
actionDownloadGraph = R.createElement actionDownloadGraphCpt
actionDownloadGraphCpt :: R.Component ActionDownload
actionDownloadGraphCpt = here.component "actionDownloadGraph" cpt where
cpt { id, session } _ = do
pure $ panel [H.div {} [H.text info]]
(submitButtonHref DownloadNode href)
where
href = url session $ Routes.NodeAPI GT.Graph (Just id) "gexf"
info = "Info about the Graph as GEXF format"
actionDownloadNodeList :: R2.Component ActionDownload
actionDownloadNodeList = R.createElement actionDownloadNodeListCpt
actionDownloadNodeListCpt :: R.Component ActionDownload
actionDownloadNodeListCpt = here.component "actionDownloadNodeList" cpt where
cpt { id, session } _ = do
pure $ panel [ H.div {} [H.text info] ]
(submitButtonHref DownloadNode href)
where
href = url session $ Routes.NodeAPI GT.NodeList (Just id) ""
info = "Info about the List as JSON format"
{-
-- TODO fix the route
actionDownload GT.Texts id session = pure $ panel [H.div {} [H.text info]]
(submitButtonHref DownloadNode href)
where
href = url session $ Routes.NodeAPI GT.Texts (Just id) ""
info = "TODO: fix the backend route. What is the expected result ?"
-}
actionDownloadOther :: R2.Component ActionDownload
actionDownloadOther = R.createElement actionDownloadOtherCpt
actionDownloadOtherCpt :: R.Component ActionDownload
actionDownloadOtherCpt = here.component "actionDownloadOther" cpt where
cpt { id, session } _ = do
pure $ fragmentPT $ "Soon, you will be able to download your file here "
Link.purs 0000664 0000000 0000000 00000005177 14111104351 0036547 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Action module Gargantext.Components.Forest.Tree.Node.Action.Link where
import Gargantext.Prelude
import Data.Either (Either)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Data.Show.Generic (genericShow)
import Effect.Aff (Aff)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, post)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Link"
newtype LinkNodeReq = LinkNodeReq { nodeType :: GT.NodeType, id :: GT.ID }
derive instance Eq LinkNodeReq
derive instance Generic LinkNodeReq _
instance Show LinkNodeReq where show = genericShow
derive newtype instance JSON.ReadForeign LinkNodeReq
derive newtype instance JSON.WriteForeign LinkNodeReq
linkNodeReq :: Session -> Maybe GT.NodeType -> GT.ID -> GT.ID -> Aff (Either RESTError GT.AsyncTaskWithType)
linkNodeReq session nt fromId toId = do
eTask :: Either RESTError GT.AsyncTask <- post session (NodeAPI GT.Node (Just fromId) "update")
(LinkNodeReq { nodeType: linkNodeType nt, id: toId })
pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.UpdateNode }) <$> eTask
linkNodeType :: Maybe GT.NodeType -> GT.NodeType
linkNodeType (Just GT.Corpus) = GT.Annuaire
linkNodeType (Just GT.Annuaire) = GT.Corpus
linkNodeType _ = GT.Error
linkNode :: R2.Component SubTreeParamsIn
linkNode = R.createElement linkNodeCpt
linkNodeCpt :: R.Component SubTreeParamsIn
linkNodeCpt = here.component "linkNode" cpt
where
cpt { boxes, dispatch, id, nodeType, session, subTreeParams } _ = do
action <- T.useBox (LinkNode { nodeType: Nothing, params: Nothing})
action' <- T.useLive T.unequal action
let button = case action' of
LinkNode { params } -> case params of
Just val -> submitButton (LinkNode {nodeType: Just nodeType, params: Just val}) dispatch
Nothing -> H.div {} []
_ -> H.div {} []
pure $ panel [
subTreeView { action
, boxes
, dispatch
, id
, nodeType
, session
, subTreeParams
} []
] button
Merge.purs 0000664 0000000 0000000 00000005662 14111104351 0036710 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Action module Gargantext.Components.Forest.Tree.Node.Action.Merge where
import Gargantext.Prelude
import Data.Either (Either)
import Data.Maybe (Maybe(..))
import Data.Set as Set
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel, checkbox, checkboxesListGroup)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, put_)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Merge"
mergeNodeReq :: Session -> GT.ID -> GT.ID -> Aff (Either RESTError (Array GT.ID))
mergeNodeReq session fromId toId =
put_ session $ NodeAPI GT.Node (Just fromId) ("merge/" <> show toId)
mergeNode :: R2.Component SubTreeParamsIn
mergeNode = R.createElement mergeNodeCpt
mergeNodeCpt :: R.Component SubTreeParamsIn
mergeNodeCpt = here.component "mergeNode" cpt
where
cpt { boxes, dispatch, id, nodeType, session, subTreeParams } _ = do
action <- T.useBox (MergeNode { params: Nothing })
action' <- T.useLive T.unequal action
merge <- T.useBox false
options <- T.useBox (Set.singleton GT.MapTerm)
let button = case action' of
MergeNode {params} -> case params of
Just val -> submitButton (MergeNode {params: Just val}) dispatch
Nothing -> H.div {} []
_ -> H.div {} []
pure $ panel
[ subTreeView { action
, boxes
, dispatch
, id
, nodeType
, session
, subTreeParams
} []
, H.ul { className:"merge mx-auto list-group"}
([ H.li { className: "list-group-item" }
[ H.h5 { className: "mb-1" } [ H.text "Merge which list?" ]
, checkboxesListGroup { groups: [ GT.MapTerm, GT.CandidateTerm, GT.StopTerm ]
, options } []
]
])
, H.ul { className:"merge mx-auto list-group"}
[ H.li { className: "list-group-item" }
[ H.h5 { className: "mb-1" } [ H.text "Title" ]
]
, H.li { className: "list-group-item" }
[ H.div { className: " form-check" }
[ checkbox { value: merge }
, H.label { className: "form-check-label" } [ H.text "Merge data?" ]
]
]
]
]
button
Move.purs 0000664 0000000 0000000 00000003552 14111104351 0036553 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Action module Gargantext.Components.Forest.Tree.Node.Action.Move where
import Gargantext.Prelude
import Data.Either (Either)
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Tools (submitButton, panel)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, put_)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Move"
moveNodeReq :: Session -> GT.ID -> GT.ID -> Aff (Either RESTError (Array GT.ID))
moveNodeReq session fromId toId =
put_ session $ NodeAPI GT.Node (Just fromId) ("move/" <> show toId)
moveNode :: R2.Component SubTreeParamsIn
moveNode = R.createElement moveNodeCpt
moveNodeCpt :: R.Component SubTreeParamsIn
moveNodeCpt = here.component "moveNode" cpt
where
cpt { boxes, dispatch, id, nodeType, session, subTreeParams } _ = do
action :: T.Box Action <- T.useBox (MoveNode {params: Nothing})
action' <- T.useLive T.unequal action
let button = case action' of
MoveNode { params } -> case params of
Just val -> submitButton (MoveNode {params: Just val}) dispatch
Nothing -> H.div {} []
_ -> H.div {} []
pure $
panel [ subTreeView { action
, boxes
, dispatch
, id
, nodeType
, session
, subTreeParams
} []
] button
Rename.purs 0000664 0000000 0000000 00000002316 14111104351 0037051 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Action module Gargantext.Components.Forest.Tree.Node.Action.Rename where
import Data.Either (Either)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Effect.Aff (Aff)
import Simple.JSON as JSON
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, put)
import Gargantext.Types (ID)
import Gargantext.Types as GT
------------------------------------------------------------------------
rename :: Session -> ID -> RenameValue -> Aff (Either RESTError (Array ID))
rename session renameNodeId =
put session $ GR.NodeAPI GT.Node (Just renameNodeId) "rename"
renameAction :: String -> Action
renameAction newName = RenameNode newName
------------------------------------------------------------------------
newtype RenameValue = RenameValue
{ text :: String }
derive instance Generic RenameValue _
derive instance Newtype RenameValue _
instance JSON.WriteForeign RenameValue where
writeImpl (RenameValue {text}) = JSON.writeImpl { name: text }
------------------------------------------------------------------------
Search.purs 0000664 0000000 0000000 00000004435 14111104351 0037053 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Action module Gargantext.Components.Forest.Tree.Node.Action.Search where
import Gargantext.Prelude
import Data.Maybe (Maybe)
import Effect (Effect)
import Effect.Aff (Aff, launchAff)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup)
import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchBar (searchBar)
import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField (defaultSearch)
import Gargantext.Components.Lang (allLangs)
import Gargantext.Sessions (Session)
import Gargantext.Types (ID)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Search"
type Props =
( boxes :: Boxes
, dispatch :: Action -> Aff Unit
, id :: Maybe ID
, nodePopup :: Maybe NodePopup
, session :: Session )
-- | Action : Search
actionSearch :: R2.Component Props
actionSearch = R.createElement actionSearchCpt
actionSearchCpt :: R.Component Props
actionSearchCpt = here.component "actionSearch" cpt
where
cpt { boxes: { errors }, dispatch, id, nodePopup, session } _ = do
search <- T.useBox $ defaultSearch { node_id = id }
pure $ R.fragment [ H.p { className: "action-search" }
[ H.text $ "Search and create a private "
<> "corpus with the search query as corpus name." ]
, searchBar { errors
, langs: allLangs
, onSearch: searchOn dispatch nodePopup
, search
, session
} []
]
where
searchOn :: (Action -> Aff Unit)
-> Maybe NodePopup
-> GT.AsyncTaskWithType
-> Effect Unit
searchOn dispatch' p task = do
_ <- launchAff $ dispatch' (DoSearch task)
-- close popup
_ <- launchAff $ dispatch' ClosePopover
-- TODO
--snd p $ const Nothing
pure unit
Search/ 0000775 0000000 0000000 00000000000 14111104351 0036132 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Action Frame.purs 0000664 0000000 0000000 00000010324 14111104351 0040077 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Action/Search module Gargantext.Components.Forest.Tree.Node.Action.Search.Frame where
import DOM.Simple as DOM
import DOM.Simple.Event (MessageEvent)
import DOM.Simple.EventListener (Callback, addEventListener, callback)
import DOM.Simple.Window (window)
import Data.Generic.Rep (class Generic)
import Data.Show.Generic (genericShow)
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import URI.Extra.QueryPairs as NQP
import URI.Query as Query
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action.Search.Types
( DataField(..), Search, isIsTex_Advanced )
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Search.Frame"
--------------------
data FrameSource = Istex | Searx
derive instance Generic FrameSource _
instance Show FrameSource where
show = genericShow
--------------------
-- | Iframes
type SearchIFramesProps = (
iframeRef :: R.Ref (Nullable DOM.Element)
, search :: T.Box Search
)
searchIframes :: R2.Component SearchIFramesProps
searchIframes = R.createElement searchIframesCpt
searchIframesCpt :: R.Component SearchIFramesProps
searchIframesCpt = here.component "searchIframes" cpt
where
cpt { iframeRef, search } _ = do
search' <- T.useLive T.unequal search
pure $ if isIsTex_Advanced search'.datafield
then divIframe { frameSource: Istex, iframeRef, search } []
else
if Just Web == search'.datafield
then divIframe { frameSource: Searx, iframeRef, search } []
else H.div {} []
type IFrameProps = (
frameSource :: FrameSource
, iframeRef :: R.Ref (Nullable DOM.Element)
, search :: T.Box Search
)
divIframe :: R2.Component IFrameProps
divIframe = R.createElement divIframeCpt
divIframeCpt :: R.Component IFrameProps
divIframeCpt = here.component "divIframe" cpt
where
cpt props _ = do
pure $ H.div { className: "frame-search card" }
[ iframeWith props [] ]
frameUrl :: FrameSource -> String
frameUrl Istex = "https://istex.frame.gargantext.org"
frameUrl Searx = "https://searx.frame.gargantext.org" -- 192.168.1.4:8080"
iframeWith :: R2.Component IFrameProps
iframeWith = R.createElement iframeWithCpt
iframeWithCpt :: R.Component IFrameProps
iframeWithCpt = here.component "iframeWith" cpt
where
cpt { frameSource, iframeRef, search } _ = do
search' <- T.useLive T.unequal search
pure $ H.iframe { src: src frameSource search'.term
, width: "100%"
, height: "100%"
, ref: iframeRef
, on: { load: \_ -> do
addEventListener window "message" (changeSearchOnMessage url)
R2.postMessage iframeRef search'.term
}
} []
where
url :: String
url = frameUrl frameSource
changeSearchOnMessage :: String -> Callback MessageEvent
changeSearchOnMessage url' =
callback $ \m -> if R2.getMessageOrigin m == url' then do
let {url'', term} = R2.getMessageData m
T.modify_ (_ {url = url'', term = term}) search
else
pure unit
isTexTermUrl :: String -> String
isTexTermUrl term = url <> query
where
query = Query.print $ NQP.print identity identity qp
qp = NQP.QueryPairs [ Tuple (NQP.keyFromString "query")
(Just (NQP.valueFromString term))
]
searxTermUrl :: String -> String
searxTermUrl term = url <> query
where
query = Query.print $ NQP.print identity identity qp
qp = NQP.QueryPairs [ Tuple (NQP.keyFromString "q")
(Just $ NQP.valueFromString term)
]
src :: FrameSource -> String -> String
src Istex term = isTexTermUrl term
src Searx term = searxTermUrl term
SearchBar.purs 0000664 0000000 0000000 00000003031 14111104351 0040674 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Action/Search module Gargantext.Components.Forest.Tree.Node.Action.Search.SearchBar
( Props
, searchBar
) where
import Gargantext.Components.Forest.Tree.Node.Action.Search.Types
import Effect (Effect)
import Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField (searchField)
import Gargantext.Components.Lang (Lang)
import Gargantext.Prelude (Unit, pure, ($))
import Gargantext.Sessions (Session)
import Gargantext.Types (FrontendError)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Search.SearchBar"
type Props = ( errors :: T.Box (Array FrontendError)
, langs :: Array Lang
, onSearch :: GT.AsyncTaskWithType -> Effect Unit
, search :: T.Box Search
, session :: Session
)
searchBar :: R2.Component Props
searchBar = R.createElement searchBarCpt
searchBarCpt :: R.Component Props
searchBarCpt = here.component "searchBar" cpt
where
cpt { errors, langs, onSearch, search, session } _ = do
--onSearchChange session s
pure $ H.div { className: "search-bar" }
[ searchField { databases:allDatabases
, errors
, langs
, onSearch
, search
, session
} []
]
SearchField.purs 0000664 0000000 0000000 00000040542 14111104351 0041223 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Action/Search module Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField where
import Gargantext.Prelude
import DOM.Simple.Console (log, log2)
import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Data.Newtype (over)
import Data.Nullable (null)
import Data.Set as Set
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Gargantext.Components.Forest.Tree.Node.Action.Search.Frame (searchIframes)
import Gargantext.Components.Forest.Tree.Node.Action.Search.Types (DataField(..), Database(..), IMT_org(..), Org(..), SearchQuery(..), allIMTorgs, allOrgs, dataFields, defaultSearchQuery, doc, performSearch, datafield2database, Search)
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Lang (Lang)
import Gargantext.Config.Utils (handleRESTError)
import Gargantext.Sessions (Session)
import Gargantext.Types (FrontendError)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Search.SearchField"
defaultSearch :: Search
defaultSearch = { databases: Empty
, datafield: Nothing
, node_id : Nothing
, lang : Nothing
, term : ""
, url: ""
}
type Props =
-- list of databases to search, or parsers to use on uploads
( databases :: Array Database
, errors :: T.Box (Array FrontendError)
, langs :: Array Lang
-- State hook for a search, how we get data in and out
, onSearch :: GT.AsyncTaskWithType -> Effect Unit
, search :: T.Box Search
, session :: Session
)
searchField :: R2.Component Props
searchField = R.createElement searchFieldCpt
searchFieldCpt :: R.Component Props
searchFieldCpt = here.component "searchField" cpt
where
cpt props@{ errors, onSearch, search, session } _ = do
search' <- T.useLive T.unequal search
iframeRef <- R.useRef null
let params =
[ searchInput { search } []
-- , if length s.term < 3 -- search with love : <3
-- then
-- H.div {}[]
-- else
, H.div {} [ dataFieldNav { datafields: dataFields, search } []
, if isExternal search'.datafield
then databaseInput { databases: props.databases, search } []
else H.div {} []
, if isHAL search'.datafield
then orgInput { orgs: allOrgs, search } []
else H.div {} []
, if isIMT search'.datafield
then componentIMT { search } []
else H.div {} []
, if isCNRS search'.datafield
then componentCNRS { search } []
else H.div {} []
, if needsLang search'.datafield
then langNav { langs: props.langs, search } []
else H.div {} []
, H.div {} [ searchIframes { iframeRef, search } [] ]
]
]
let button = submitButton { errors, onSearch, search, session } []
pure $
H.div { className: "search-field" }
[
R.fragment params
,
button
]
--pure $ panel params button
type ComponentProps =
( search :: T.Box Search )
componentIMT :: R2.Component ComponentProps
componentIMT = R.createElement componentIMTCpt
componentIMTCpt :: R.Component ComponentProps
componentIMTCpt = here.component "componentIMT" cpt
where
cpt { search } _ = do
search' <- T.useLive T.unequal search
let liCpt org = H.li {}
[ H.input { type: "checkbox"
, checked: isIn org search'.datafield
, on: { change: \_ -> ( T.modify_ (_ { datafield = updateFilter org search'.datafield }) search)
}
}
, if org == All_IMT
then H.i {} [H.text $ " " <> show org]
else H.text $ " " <> show org
]
pure $ R.fragment
[ H.ul {} $ map liCpt allIMTorgs
--, filterInput fi
]
componentCNRS :: R2.Component ComponentProps
componentCNRS = R.createElement componentCNRSCpt
componentCNRSCpt :: R.Component ComponentProps
componentCNRSCpt = here.component "componentCNRS" cpt
where
cpt { search } _ = do
pure $ R.fragment [
H.div {} []
--, filterInput fi
]
isExternal :: Maybe DataField -> Boolean
isExternal (Just (External _)) = true
isExternal _ = false
isHAL :: Maybe DataField -> Boolean
isHAL (Just
( External
( Just (HAL _ )
)
)
) = true
isHAL _ = false
isIsTex :: Maybe DataField -> Boolean
isIsTex ( Just
( External
( Just ( IsTex)
)
)
) = true
isIsTex _ = false
isIMT :: Maybe DataField -> Boolean
isIMT ( Just
( External
( Just
( HAL
( Just ( IMT _)
)
)
)
)
) = true
isIMT _ = false
isCNRS :: Maybe DataField -> Boolean
isCNRS ( Just
( External
( Just
( HAL
( Just ( CNRS _)
)
)
)
)
) = true
isCNRS _ = false
needsLang :: Maybe DataField -> Boolean
needsLang (Just Gargantext) = true
needsLang (Just Web) = true
needsLang ( Just
( External
( Just (HAL _)
)
)
) = true
needsLang _ = false
isIn :: IMT_org -> Maybe DataField -> Boolean
isIn org ( Just
( External
( Just
( HAL
( Just
( IMT imtOrgs )
)
)
)
)
) = Set.member org imtOrgs
isIn _ _ = false
updateFilter :: IMT_org -> Maybe DataField -> Maybe DataField
updateFilter org (Just (External (Just (HAL (Just (IMT imtOrgs)))))) =
(Just (External (Just (HAL (Just $ IMT imtOrgs')))))
where
imtOrgs' = if Set.member org imtOrgs
then
if org == All_IMT
then Set.empty
else Set.delete All_IMT $ Set.delete org imtOrgs
else
if org == All_IMT
then Set.fromFoldable allIMTorgs
else Set.insert org imtOrgs
updateFilter org _ = (Just (External (Just (HAL (Just (IMT imtOrgs'))))))
where
imtOrgs' = if org == All_IMT
then Set.fromFoldable allIMTorgs
else Set.fromFoldable [org]
------------------------------------------------------------------------
type LangNavProps =
( langs :: Array Lang
, search :: T.Box Search )
langNav :: R2.Component LangNavProps
langNav = R.createElement langNavCpt
langNavCpt :: R.Component LangNavProps
langNavCpt = here.component "langNav" cpt
where
cpt { langs, search } _ = do
search' <- T.useLive T.unequal search
pure $ R.fragment [ H.div {className: "text-primary center"} [H.text "with lang"]
, H.div {className: "nav nav-tabs"} ((liItem search') <$> langs)
]
where
liItem :: Search -> Lang -> R.Element
liItem { lang } lang' =
H.div { className : "nav-item nav-link" <> if (Just lang') == lang then " active" else ""
, on: { click: \_ -> T.modify_ (_ { lang = Just lang' }) search }
} [ H.text (show lang') ]
------------------------------------------------------------------------
type DataFieldNavProps =
( datafields :: Array DataField
, search :: T.Box Search )
dataFieldNav :: R2.Component DataFieldNavProps
dataFieldNav = R.createElement dataFieldNavCpt
dataFieldNavCpt :: R.Component DataFieldNavProps
dataFieldNavCpt = here.component "dataFieldNav" cpt
where
cpt { datafields, search } _ = do
search'@{ datafield } <- T.useLive T.unequal search
pure $ R.fragment [ H.div { className: "text-primary center"} [H.text "with DataField"]
, H.div {className: "nav nav-tabs"} ((liItem search') <$> dataFields)
, H.div {className: "center"} [ H.text
$ maybe "TODO: add Doc Instance" doc datafield
]
]
where
liItem :: Search -> DataField -> R.Element
liItem { datafield } df' =
H.div { className : "nav-item nav-link"
<> if isActive --(Just df') == datafield
then " active"
else ""
, on: { click: \_ -> T.modify_ (_ { datafield = Just df'
, databases = datafield2database df'
}) search
}
-- just one database query for now
-- a list a selected database needs more ergonomy
} [ H.text (show df') ]
where
isActive = show (Just df') == show datafield
------------------------------------------------------------------------
type DatabaseInputProps = (
databases :: Array Database
, search :: T.Box Search
)
databaseInput :: R2.Component DatabaseInputProps
databaseInput = R.createElement databaseInputCpt
databaseInputCpt :: R.Component DatabaseInputProps
databaseInputCpt = here.component "databaseInput" cpt
where
cpt { databases
, search } _ = do
search' <- T.useLive T.unequal search
let db = case search'.datafield of
(Just (External (Just x))) -> Just x
_ -> Nothing
liItem :: Database -> R.Element
liItem db' = H.option { className : "text-primary center"
, value: show db' } [ H.text (show db') ]
change e = do
let value = read $ R.unsafeEventValue e
T.modify_ (_ { datafield = Just $ External value
, databases = fromMaybe Empty value
}) search
pure $
H.div { className: "form-group" } [
H.div {className: "text-primary center"} [ H.text "in database" ]
, R2.select { className: "form-control"
, defaultValue: defaultValue search'.datafield
, on: { change }
} (liItem <$> databases)
, H.div {className:"center"} [ H.text $ maybe "" doc db ]
]
defaultValue datafield = show $ maybe Empty datafield2database datafield
type OrgInputProps =
( orgs :: Array Org
| ComponentProps)
orgInput :: R2.Component OrgInputProps
orgInput = R.createElement orgInputCpt
orgInputCpt :: R.Component OrgInputProps
orgInputCpt = here.component "orgInput" cpt
where
cpt { orgs, search } _ = do
let change e = do
let value = R.unsafeEventValue e
T.modify_ (_ { datafield = Just $ External $ Just $ HAL $ read value }) search
pure $ H.div { className: "form-group" }
[ H.div {className: "text-primary center"} [H.text "filter with organization: "]
, R2.select { className: "form-control"
, on: { change }
} (liItem <$> orgs)
]
liItem :: Org -> R.Element
liItem org = H.option {className : "text-primary center"} [ H.text (show org) ]
{-
filterInput :: R.State String -> R.Element
filterInput (term /\ setTerm) =
H.div { className: "form-group" }
[ H.input { defaultValue: term
, className: "form-control"
, type: "text"
, on: { change: setTerm <<< const <<< R.unsafeEventValue }
, "required pattern": "[[0-9]+[ ]+]*"
-- TODO ^FIXME not sure about the regex comprehension: that should match "123 2334 44545" only (Integers separated by one space)
-- form validation with CSS
-- DOC: https://developer.mozilla.org/en-US/docs/Learn/HTML/Forms/Form_validation
, placeholder : "Filter with struct_Ids as integer"
}
]
-}
type SearchInputProps =
(
search :: T.Box Search
)
searchInput :: R2.Component SearchInputProps
searchInput = R.createElement searchInputCpt
searchInputCpt :: R.Component SearchInputProps
searchInputCpt = here.component "searchInput" cpt
where
cpt { search } _ = do
{ term } <- T.useLive T.unequal search
valueRef <- R.useRef term
pure $ H.div { className: "" } [
inputWithEnter { onBlur: onBlur valueRef search
, onEnter: onEnter valueRef search
, onValueChanged: onValueChanged valueRef
, autoFocus: false
, className: "form-control"
, defaultValue: R.readRef valueRef
, placeholder: "Your query here"
, type: "text" }
]
-- pure $
-- H.div { className : "" }
-- [ H.input { className: "form-control"
-- , defaultValue: search.term
-- , on: { input : onInput valueRef setSearch }
-- , placeholder: "Your Query here"
-- , type: "text"
-- }
-- ]
onBlur valueRef search value = do
R.setRef valueRef value
T.modify_ (_ { term = value }) search
onEnter valueRef search _ = do
T.modify_ (_ { term = R.readRef valueRef }) search
onValueChanged valueRef value = do
R.setRef valueRef value
-- setSearch $ _ { term = value }
type SubmitButtonProps =
( errors :: T.Box (Array FrontendError)
, onSearch :: GT.AsyncTaskWithType -> Effect Unit
, search :: T.Box Search
, session :: Session
)
submitButton :: R2.Component SubmitButtonProps
submitButton = R.createElement submitButtonComponent
submitButtonComponent :: R.Component SubmitButtonProps
submitButtonComponent = here.component "submitButton" cpt
where
cpt { errors, onSearch, search, session } _ = do
search' <- T.useLive T.unequal search
pure $
H.button { className: "btn btn-primary"
, "type" : "button"
, on : { click: doSearch onSearch errors session search' }
, style : { width: "100%" }
} [ H.text "Launch Search" ]
doSearch os errors s q = \_ -> do
log2 "[submitButton] searching" q
triggerSearch os errors s q
--case search.term of
-- "" -> setSearch $ const defaultSearch
-- _ -> setSearch $ const q
triggerSearch :: (GT.AsyncTaskWithType -> Effect Unit)
-> T.Box (Array FrontendError)
-> Session
-> Search
-> Effect Unit
triggerSearch os errors s q =
launchAff_ $ do
liftEffect $ do
let here' = "[triggerSearch] Searching "
log2 (here' <> "databases: ") (show q.databases)
log2 (here' <> "datafield: ") (show q.datafield)
log2 (here' <> "term: ") q.term
log2 (here' <> "lang: ") (show q.lang)
case q.node_id of
Nothing -> liftEffect $ log "[triggerSearch] node_id is Nothing, don't know what to do"
Just id -> do
eTask <- performSearch s id $ searchQuery q
handleRESTError errors eTask $ \task -> liftEffect $ do
log2 "[triggerSearch] task" task
os task
--liftEffect $ do
-- log2 "Return:" r
-- modalShow "addCorpus"
searchQuery :: Search -> SearchQuery
searchQuery {datafield: Nothing, term} =
over SearchQuery (_ {query=term}) defaultSearchQuery
searchQuery {databases, datafield, lang, term, node_id} =
over SearchQuery (_ { databases= databases
, datafield= datafield
, lang = lang
, query = term
, node_id = node_id
}) defaultSearchQuery
Types.purs 0000664 0000000 0000000 00000030654 14111104351 0040161 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Action/Search module Gargantext.Components.Forest.Tree.Node.Action.Search.Types where
import Data.Array (concat)
import Data.Either (Either)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Newtype (class Newtype)
import Data.Set (Set)
import Data.Set as Set
import Data.String as String
import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Simple.JSON as JSON
import URI.Extra.QueryPairs as QP
import URI.Query as Q
import Gargantext.Prelude
import Gargantext.Components.Lang (Lang)
import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (class ToUrl, backendUrl)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session(..), post)
import Gargantext.Types as GT
type Search = { databases :: Database
, datafield :: Maybe DataField
, url :: String
, lang :: Maybe Lang
, node_id :: Maybe Int
, term :: String
}
isIsTex_Advanced :: Maybe DataField -> Boolean
isIsTex_Advanced ( Just
( External
( Just ( IsTex_Advanced)
)
)
) = true
isIsTex_Advanced _ = false
------------------------------------------------------------------------
class Doc a where
doc :: a -> String
------------------------------------------------------------------------
-- | DataField search specifications
dataFields :: Array DataField
dataFields = [ Gargantext
, External Nothing
, Web
-- , Files
]
data DataField = Gargantext
| External (Maybe Database)
| Web
| Files
derive instance Generic DataField _
instance Show DataField where
show Gargantext = "Gargantext"
show (External _) = "Databases (APIs)" -- <> show x
show Web = "Soon: web"
show Files = "Files"
instance Doc DataField where
doc Gargantext = "All Gargantext Database"
doc (External _) = "External (scientific) databases"
doc Web = "All the web crawled with meta-search-engine SearX"
doc Files = "Zip files with formats.."
derive instance Eq DataField
instance JSON.WriteForeign DataField where
writeImpl Gargantext = JSON.writeImpl "Internal PubMed"
writeImpl (External (Just db)) = JSON.writeImpl $ "External " <> show db
writeImpl f = JSON.writeImpl $ show f
----------------------------------------
data DataOriginApi = InternalOrigin { api :: Database }
| ExternalOrigin { api :: Database }
derive instance Generic DataOriginApi _
instance Show DataOriginApi where
show (InternalOrigin io) = "InternalOrigin " <> show io.api
show (ExternalOrigin io) = "ExternalOrigin " <> show io.api
derive instance Eq DataOriginApi
instance JSON.WriteForeign DataOriginApi where
writeImpl (InternalOrigin { api }) = JSON.writeImpl { api }
writeImpl (ExternalOrigin { api }) = JSON.writeImpl { api }
datafield2dataOriginApi :: DataField -> DataOriginApi
datafield2dataOriginApi (External (Just a)) = ExternalOrigin { api : a }
datafield2dataOriginApi _ = InternalOrigin { api : IsTex } -- TODO fixme
------------------------------------------------------------------------
-- | Database search specifications
datafield2database :: DataField -> Database
datafield2database (External (Just x)) = x
datafield2database _ = Empty
allDatabases :: Array Database
allDatabases = [ Empty
, PubMed
, HAL Nothing
, IsTex
, IsTex_Advanced
, Isidore
--, Web
--, News
--, SocialNetworks
]
data Database = All_Databases
| Empty
| PubMed
| HAL (Maybe Org)
| IsTex
| IsTex_Advanced
| Isidore
-- | News
-- | SocialNetworks
derive instance Generic Database _
instance Show Database where
show All_Databases= "All Databases"
show PubMed = "PubMed"
show (HAL _)= "HAL"
show IsTex = "IsTex"
show IsTex_Advanced = "IsTex_Advanced"
show Isidore= "Isidore"
show Empty = "Empty"
-- show News = "News"
-- show SocialNetworks = "Social Networks"
instance Doc Database where
doc All_Databases = "All databases"
doc PubMed = "All Medical publications"
doc (HAL _) = "All open science (archives ouvertes)"
doc IsTex = "All Elsevier enriched by CNRS/INIST"
doc IsTex_Advanced = "IsTex advanced search"
doc Isidore = "All (French) Social Sciences"
doc Empty = "Empty"
-- doc News = "Web filtered by News"
-- doc SocialNetworks = "Web filtered by MicroBlogs"
instance Read Database where
read :: String -> Maybe Database
read "All Databases" = Just All_Databases
read "PubMed" = Just PubMed
read "HAL" = Just $ HAL Nothing
read "Isidore"= Just Isidore
read "IsTex" = Just IsTex
read "IsTex_Advanced" = Just IsTex_Advanced
-- read "Web" = Just Web
-- read "News" = Just News
-- read "Social Networks" = Just SocialNetworks
read _ = Nothing
derive instance Eq Database
instance JSON.WriteForeign Database where writeImpl = JSON.writeImpl <<< show
------------------------------------------------------------------------
-- | Organization specifications
allOrgs :: Array Org
allOrgs = [ All_Orgs
, IMT $ Set.fromFoldable []
, CNRS $ Set.fromFoldable []
]
data Org = All_Orgs
| CNRS (Set StructId)
| Others (Set StructId)
| IMT (Set IMT_org)
type StructId = Int
derive instance Generic Org _
instance Show Org where
show All_Orgs = "All_Orgs"
show (CNRS _) = "CNRS"
show (IMT _) = "IMT"
show (Others _) = "Others"
instance Read Org where
read "All_Orgs" = Just $ All_Orgs
read "CNRS" = Just $ CNRS $ Set.fromFoldable []
read "IMT" = Just $ IMT $ Set.fromFoldable []
read "Others" = Just $ Others $ Set.fromFoldable []
read _ = Nothing
derive instance Eq Org
instance JSON.WriteForeign Org where writeImpl = JSON.writeImpl <<< show
------------------------------------------------------------------------
allIMTorgs :: Array IMT_org
allIMTorgs = [All_IMT] <> allIMTSubOrgs
allIMTSubOrgs :: Array IMT_org
allIMTSubOrgs = [ ARMINES
, Eurecom
, IMT_Atlantique
, IMT_Business_School
, IMT_Lille_Douai
, IMT_Mines_ALES
, IMT_Mines_Albi
, Institut_MinesTelecom_Paris
, MINES_ParisTech
, Mines_Douai
, Mines_Nantes
, Mines_SaintEtienne
, Telecom_Bretagne
, Telecom_Ecole_de_Management
, Telecom_Lille
, Telecom_ParisTech
, Telecom_SudParis
]
data IMT_org = All_IMT
| ARMINES
| Eurecom
| IMT_Atlantique
| IMT_Business_School
| IMT_Lille_Douai
| IMT_Mines_ALES
| IMT_Mines_Albi
| Institut_MinesTelecom_Paris
| MINES_ParisTech
| Mines_Douai
| Mines_Nantes
| Mines_SaintEtienne
| Telecom_Bretagne
| Telecom_Ecole_de_Management
| Telecom_Lille
| Telecom_ParisTech
| Telecom_SudParis
derive instance Ord IMT_org
derive instance Eq IMT_org
instance Show IMT_org where
show All_IMT = "All_IMT"
show ARMINES = "ARMINES"
show Eurecom = "Eurecom"
show IMT_Atlantique = "IMT_Atlantique"
show IMT_Business_School = "IMT_Business_School"
show IMT_Lille_Douai = "IMT_Lille_Douai"
show IMT_Mines_ALES = "IMT_Mines_ALES"
show IMT_Mines_Albi = "IMT_Mines_Albi"
show Institut_MinesTelecom_Paris = "Institut_MinesTelecom_Paris"
show MINES_ParisTech = "MINES_ParisTech"
show Mines_Douai = "Mines_Douai"
show Mines_Nantes = "Mines_Nantes"
show Mines_SaintEtienne = "Mines_SaintEtienne"
show Telecom_Bretagne = "Telecom_Bretagne"
show Telecom_Ecole_de_Management = "Telecom_Ecole_de_Management"
show Telecom_Lille = "Telecom_Lille"
show Telecom_ParisTech = "Telecom_ParisTech"
show Telecom_SudParis = "Telecom_SudParis"
instance Read IMT_org where
read "All_IMT" = Just All_IMT
read "ARMINES" = Just ARMINES
read "Eurecom" = Just Eurecom
read "IMT_Atlantique" = Just IMT_Atlantique
read "IMT_Business_School" = Just IMT_Business_School
read "IMT_Lille_Douai" = Just IMT_Lille_Douai
read "IMT_Mines_ALES" = Just IMT_Mines_ALES
read "IMT_Mines_Albi" = Just IMT_Mines_Albi
read "Institut_MinesTelecom_Paris" = Just Institut_MinesTelecom_Paris
read "MINES_ParisTech" = Just MINES_ParisTech
read "Mines_Douai" = Just Mines_Douai
read "Mines_Nantes" = Just Mines_Nantes
read "Mines_SaintEtienne" = Just Mines_SaintEtienne
read "Telecom_Bretagne" = Just Telecom_Bretagne
read "Telecom_Ecole_de_Management" = Just Telecom_Ecole_de_Management
read "Telecom_Lille" = Just Telecom_Lille
read "Telecom_ParisTech" = Just Telecom_ParisTech
read "Telecom_SudParis" = Just Telecom_SudParis
read _ = Nothing
imtStructId :: IMT_org -> Array StructId
imtStructId All_IMT = concat $ map imtStructId allIMTSubOrgs
imtStructId Mines_Douai = [224096]
imtStructId Telecom_Lille = [144103]
imtStructId Mines_Nantes = [84538]
imtStructId ARMINES = [300104]
imtStructId Telecom_ParisTech = [300362]
imtStructId Telecom_Bretagne = [301262]
imtStructId Telecom_Ecole_de_Management = [301442]
imtStructId MINES_ParisTech = [301492]
imtStructId Institut_MinesTelecom_Paris = [302102]
imtStructId Eurecom = [421532]
imtStructId IMT_Lille_Douai = [497330]
imtStructId Telecom_SudParis = [352124]
imtStructId IMT_Atlantique = [481355]
imtStructId IMT_Mines_Albi = [469216]
imtStructId IMT_Business_School = [542824]
imtStructId IMT_Mines_ALES = [6279]
imtStructId Mines_SaintEtienne = [29212]
------------------------------------------------------------------------
data SearchOrder
= DateAsc
| DateDesc
| TitleAsc
| TitleDesc
| ScoreAsc
| ScoreDesc
instance Show SearchOrder where
show DateAsc = "DateAsc"
show DateDesc = "DateDesc"
show TitleAsc = "TitleAsc"
show TitleDesc = "TitleDesc"
show ScoreAsc = "ScoreAsc"
show ScoreDesc = "ScoreDesc"
------------------------------------------------------------------------
newtype SearchQuery = SearchQuery
{ query :: String
, databases :: Database
, datafield :: Maybe DataField
, files_id :: Array String
, lang :: Maybe Lang
, limit :: Maybe Int
, node_id :: Maybe Int
, offset :: Maybe Int
, order :: Maybe SearchOrder
}
derive instance Generic SearchQuery _
derive instance Newtype SearchQuery _
defaultSearchQuery :: SearchQuery
defaultSearchQuery = SearchQuery
{ query: ""
, databases: Empty
, datafield: Nothing
, files_id : []
, lang : Nothing
, limit : Nothing
, node_id : Nothing
, offset : Nothing
, order : Nothing
}
instance ToUrl Session SearchQuery where
toUrl (Session {backend}) q = backendUrl backend q2
where q2 = "new" <> Q.print (GT.toQuery q)
instance GT.ToQuery SearchQuery where
toQuery (SearchQuery {offset, limit, order}) =
QP.print id id $ QP.QueryPairs
$ pair "offset" offset
<> pair "limit" limit
<> pair "order" order
where pair :: forall a. Show a => String -> Maybe a -> Array (Tuple QP.Key (Maybe QP.Value))
pair k = maybe [] $ \v ->
[ QP.keyFromString k /\ Just (QP.valueFromString $ show v) ]
instance JSON.WriteForeign SearchQuery where
writeImpl (SearchQuery { databases, lang, node_id, query }) =
JSON.writeImpl { query: String.replace (String.Pattern "\"") (String.Replacement "\\\"") query
, databases: databases
, lang: maybe "EN" show lang
, node_id: fromMaybe 0 node_id
}
performSearch :: Session -> Int -> SearchQuery -> Aff (Either RESTError GT.AsyncTaskWithType)
performSearch session nodeId q = do
eTask :: Either RESTError GT.AsyncTask <- post session p q
pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.Query }) <$> eTask
where
p = GR.NodeAPI GT.Corpus (Just nodeId) $ GT.asyncTaskTypePath GT.Query
Share.purs 0000664 0000000 0000000 00000006707 14111104351 0036714 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Action module Gargantext.Components.Forest.Tree.Node.Action.Share where
import Data.Either (Either)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Data.Show.Generic (genericShow)
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Simple.JSON.Generics as JSONG
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action (Action)
import Gargantext.Components.Forest.Tree.Node.Action as Action
import Gargantext.Components.Forest.Tree.Node.Tools as Tools
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Config.REST (RESTError)
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
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Share"
------------------------------------------------------------------------
shareReq :: Session -> ID -> ShareNodeParams -> Aff (Either RESTError ID)
shareReq session nodeId =
post session $ GR.NodeAPI GT.Node (Just nodeId) "share"
shareAction :: String -> Action
shareAction username = Action.ShareTeam username
------------------------------------------------------------------------
data ShareNodeParams = ShareTeamParams { username :: String }
| SharePublicParams { node_id :: Int }
derive instance Eq ShareNodeParams
derive instance Generic ShareNodeParams _
instance JSON.ReadForeign ShareNodeParams where readImpl = JSONG.untaggedSumRep
instance JSON.WriteForeign ShareNodeParams where writeImpl = JSON.writeImpl <<< show
instance Show ShareNodeParams where show = genericShow
------------------------------------------------------------------------
type ShareNode =
( id :: ID
, dispatch :: Action -> Aff Unit )
shareNode :: R2.Component ShareNode
shareNode = R.createElement shareNodeCpt
shareNodeCpt :: R.Component ShareNode
shareNodeCpt = here.component "shareNode" cpt
where
cpt { dispatch, id } _ = do
isOpen <- T.useBox true
pure $ Tools.panel
[ Tools.textInputBox { boxAction: shareAction
, boxName: "Share"
, dispatch
, id
, isOpen
, text: "username" } []
] (H.div {} [])
------------------------------------------------------------------------
publishNode :: R2.Component SubTreeParamsIn
publishNode = R.createElement publishNodeCpt
publishNodeCpt :: R.Component SubTreeParamsIn
publishNodeCpt = here.component "publishNode" cpt
where
cpt { boxes, dispatch, id, nodeType, session, subTreeParams } _ = do
action <- T.useBox (Action.SharePublic { params: Nothing })
action' <- T.useLive T.unequal action
let button = case action' of
Action.SharePublic { params } -> case params of
Just val -> Tools.submitButton (Action.SharePublic {params: Just val}) dispatch
Nothing -> H.div {} []
_ -> H.div {} []
pure $ Tools.panel
[ subTreeView { action
, boxes
, dispatch
, id
, nodeType
, session
, subTreeParams
} []
] button
Update.purs 0000664 0000000 0000000 00000010566 14111104351 0037072 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Action module Gargantext.Components.Forest.Tree.Node.Action.Update where
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Update.Types
import Gargantext.Components.Forest.Tree.Node.Tools (formChoiceSafe, submitButton, panel)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
import Gargantext.Types (NodeType(..), ID)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Update"
updateRequest :: UpdateNodeParams -> Session -> ID -> Aff (Either RESTError GT.AsyncTaskWithType)
updateRequest updateNodeParams session nodeId = do
eTask :: Either RESTError GT.AsyncTask <- post session p updateNodeParams
case eTask of
Left err -> pure $ Left err
Right task -> pure $ Right $ GT.AsyncTaskWithType { task, typ: GT.UpdateNode }
where
p = GR.NodeAPI GT.Node (Just nodeId) "update"
----------------------------------------------------------------------
type UpdateProps =
( dispatch :: Action -> Aff Unit
, nodeType :: NodeType )
update :: R2.Component UpdateProps
update = R.createElement updateCpt
updateCpt :: R.Component UpdateProps
updateCpt = here.component "update" cpt where
cpt props@{ nodeType: Dashboard } _ = pure $ updateDashboard props []
cpt props@{ nodeType: Graph } _ = pure $ updateGraph props []
cpt props@{ nodeType: NodeList } _ = pure $ updateNodeList props []
cpt props@{ nodeType: Texts } _ = pure $ updateTexts props []
cpt props@{ nodeType: _ } _ = pure $ updateOther props []
updateDashboard :: R2.Component UpdateProps
updateDashboard = R.createElement updateDashboardCpt
updateDashboardCpt :: R.Component UpdateProps
updateDashboardCpt = here.component "updateDashboard" cpt where
cpt { dispatch } _ = do
methodBoard <- T.useBox All
methodBoard' <- T.useLive T.unequal methodBoard
pure $ panel [ -- H.text "Update with"
formChoiceSafe [All, Sources, Authors, Institutes, Ngrams] All (\val -> T.write_ val methodBoard) show
]
(submitButton (UpdateNode $ UpdateNodeParamsBoard { methodBoard: methodBoard' }) dispatch)
updateGraph :: R2.Component UpdateProps
updateGraph = R.createElement updateGraphCpt
updateGraphCpt :: R.Component UpdateProps
updateGraphCpt = here.component "updateGraph" cpt where
cpt { dispatch } _ = do
methodGraph <- T.useBox Order1
methodGraph' <- T.useLive T.unequal methodGraph
pure $ panel [ -- H.text "Update with"
formChoiceSafe [Order1, Order2] Order1 (\val -> T.write_ val methodGraph) show
]
(submitButton (UpdateNode $ UpdateNodeParamsGraph { methodGraph: methodGraph' }) dispatch)
updateNodeList :: R2.Component UpdateProps
updateNodeList = R.createElement updateNodeListCpt
updateNodeListCpt :: R.Component UpdateProps
updateNodeListCpt = here.component "updateNodeList" cpt where
cpt { dispatch } _ = do
methodList <- T.useBox Basic
methodList' <- T.useLive T.unequal methodList
pure $ panel [ -- H.text "Update with"
formChoiceSafe [Basic, Advanced, WithModel] Basic (\val -> T.write_ val methodList) show
]
(submitButton (UpdateNode $ UpdateNodeParamsList { methodList: methodList' }) dispatch)
updateTexts :: R2.Component UpdateProps
updateTexts = R.createElement updateTextsCpt
updateTextsCpt :: R.Component UpdateProps
updateTextsCpt = here.component "updateTexts" cpt where
cpt { dispatch } _ = do
methodTexts <- T.useBox NewNgrams
methodTexts' <- T.useLive T.unequal methodTexts
pure $ panel [ -- H.text "Update with"
formChoiceSafe [NewNgrams, NewTexts, Both] NewNgrams (\val -> T.write_ val methodTexts) show
]
(submitButton (UpdateNode $ UpdateNodeParamsTexts { methodTexts: methodTexts' }) dispatch)
updateOther :: R2.Component UpdateProps
updateOther = R.createElement updateOtherCpt
updateOtherCpt :: R.Component UpdateProps
updateOtherCpt = here.component "updateOther" cpt where
cpt _ _ = do
pure $ H.div {} []
-- fragmentPT $ "Update " <> show nodeType
Update/ 0000775 0000000 0000000 00000000000 14111104351 0036147 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Action Types.purs 0000664 0000000 0000000 00000006617 14111104351 0040200 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Action/Update module Gargantext.Components.Forest.Tree.Node.Action.Update.Types where
import Data.Generic.Rep (class Generic)
import Data.Show.Generic (genericShow)
import Data.Maybe (Maybe(..))
import Simple.JSON as JSON
import Simple.JSON.Generics as JSONG
import Gargantext.Prelude
data UpdateNodeParams = UpdateNodeParamsList { methodList :: Method }
| UpdateNodeParamsGraph { methodGraph :: GraphMetric }
| UpdateNodeParamsTexts { methodTexts :: Granularity }
| UpdateNodeParamsBoard { methodBoard :: Charts }
derive instance Eq UpdateNodeParams
derive instance Generic UpdateNodeParams _
instance Show UpdateNodeParams where show = genericShow
instance JSON.ReadForeign UpdateNodeParams where readImpl = JSONG.untaggedSumRep
instance JSON.WriteForeign UpdateNodeParams where
writeImpl (UpdateNodeParamsList { methodList }) = JSON.writeImpl { methodList }
writeImpl (UpdateNodeParamsGraph { methodGraph }) = JSON.writeImpl { methodGraph }
writeImpl (UpdateNodeParamsTexts { methodTexts }) = JSON.writeImpl { methodTexts }
writeImpl (UpdateNodeParamsBoard { methodBoard }) = JSON.writeImpl { methodBoard }
----------------------------------------------------------------------
data Method = Basic | Advanced | WithModel
derive instance Generic Method _
derive instance Eq Method
instance Show Method where show = genericShow
instance JSON.ReadForeign Method where readImpl = JSONG.enumSumRep
instance JSON.WriteForeign Method where writeImpl = JSON.writeImpl <<< show
instance Read Method where
read "Basic" = Just Basic
read "Advanced" = Just Advanced
read "WithModel" = Just WithModel
read _ = Nothing
----------------------------------------------------------------------
data GraphMetric = Order1 | Order2
derive instance Generic GraphMetric _
derive instance Eq GraphMetric
instance Show GraphMetric where show = genericShow
instance Read GraphMetric where
read "Order1" = Just Order1
read "Order2" = Just Order2
read _ = Nothing
instance JSON.ReadForeign GraphMetric where readImpl = JSONG.enumSumRep
instance JSON.WriteForeign GraphMetric where writeImpl = JSON.writeImpl <<< show
----------------------------------------------------------------------
data Granularity = NewNgrams | NewTexts | Both
derive instance Generic Granularity _
derive instance Eq Granularity
instance Show Granularity where show = genericShow
instance Read Granularity where
read "NewNgrams" = Just NewNgrams
read "NewTexts" = Just NewTexts
read "Both" = Just Both
read _ = Nothing
instance JSON.ReadForeign Granularity where readImpl = JSONG.enumSumRep
instance JSON.WriteForeign Granularity where writeImpl = JSON.writeImpl <<< show
----------------------------------------------------------------------
data Charts = Sources | Authors | Institutes | Ngrams | All
derive instance Generic Charts _
derive instance Eq Charts
instance Show Charts where show = genericShow
instance Read Charts where
read "Sources " = Just Sources
read "Authors" = Just Authors
read "Institutes" = Just Institutes
read "Ngrams" = Just Ngrams
read "AllCharts" = Just All
read _ = Nothing
instance JSON.ReadForeign Charts where readImpl = JSONG.enumSumRep
instance JSON.WriteForeign Charts where
writeImpl All = JSON.writeImpl $ "AllCharts"
writeImpl f = JSON.writeImpl $ show f
Upload.purs 0000664 0000000 0000000 00000042127 14111104351 0037072 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Action module Gargantext.Components.Forest.Tree.Node.Action.Upload where
import Gargantext.Prelude
import Data.Either (Either(..), fromRight')
import Data.Eq.Generic (genericEq)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..), fromJust, fromMaybe)
import Data.Newtype (class Newtype)
import Data.String.Regex as DSR
import Data.String.Regex.Flags as DSRF
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..), Props)
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileBlob(..), readUFBAsText)
import Gargantext.Components.Forest.Tree.Node.Tools (fragmentPT, formChoiceSafe, panel)
import Gargantext.Components.Lang (Lang(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, postWwwUrlencoded)
import Gargantext.Types (NodeType(..), ID)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Partial.Unsafe (unsafePartial, unsafeCrashWith)
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import URI.Extra.QueryPairs as QP
import Web.File.FileReader.Aff (readAsDataURL)
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Upload"
-- UploadFile Action
-- | Action : Upload
type ActionUpload =
( dispatch :: Action -> Aff Unit
, id :: ID
, nodeType :: NodeType
, session :: Session )
actionUpload :: R2.Component ActionUpload
actionUpload = R.createElement actionUploadCpt
actionUploadCpt :: R.Component ActionUpload
actionUploadCpt = here.component "actionUpload" cpt where
cpt { nodeType: Corpus, dispatch, id, session } _ = pure $ uploadFileView {dispatch, id, nodeType: GT.Corpus, session}
cpt { nodeType: NodeList, dispatch, id, session } _ = pure $ uploadTermListView {dispatch, id, nodeType: GT.NodeList, session}
cpt props@{ nodeType: _ } _ = pure $ actionUploadOther props []
{-
actionUpload Annuaire id session dispatch =
pure $ uploadFileView {dispatch, id, nodeType: Annuaire, session}
-}
actionUploadOther :: R2.Component ActionUpload
actionUploadOther = R.createElement actionUploadOtherCpt
actionUploadOtherCpt :: R.Component ActionUpload
actionUploadOtherCpt = here.component "actionUploadOther" cpt where
cpt _ _ = do
pure $ fragmentPT $ "Soon, upload for this NodeType."
-- file upload types
data DroppedFile =
DroppedFile { blob :: UploadFileBlob
, fileType :: Maybe FileType
, lang :: Lang
}
derive instance Generic DroppedFile _
instance Eq DroppedFile where
eq = genericEq
type FileHash = String
type UploadFile =
{ blob :: UploadFileBlob
, name :: String
}
uploadFileView :: R2.Leaf Props
uploadFileView props = R.createElement uploadFileViewCpt props []
uploadFileViewCpt :: R.Component Props
uploadFileViewCpt = here.component "uploadFileView" cpt
where
cpt {dispatch, id, nodeType} _ = do
-- mFile :: R.State (Maybe UploadFile) <- R.useState' Nothing
mFile <- T.useBox (Nothing :: Maybe UploadFile)
fileType <- T.useBox CSV
lang <- T.useBox EN
let setFileType' val = T.write_ val fileType
let setLang' val = T.write_ val lang
let bodies =
[ R2.row
[ H.div { className:"col-12 flex-space-around"}
[ H.div { className: "form-group" }
[ H.input { type: "file"
, className: "form-control"
, placeholder: "Choose file"
, on: {change: onChangeContents mFile}
}
]
]
]
, R2.row
[ H.div {className:"col-6 flex-space-around"}
[ formChoiceSafe [ CSV
, CSV_HAL
, WOS
, PresseRIS
, Arbitrary
] CSV setFileType' show
]
]
, R2.row
[ H.div {className:"col-6 flex-space-around"}
[ formChoiceSafe [EN, FR, No_extraction, Universal] EN setLang'
show
]
]
]
let footer = H.div {} [ uploadButton { dispatch
, fileType
, lang
, id
, mFile
, nodeType
}
]
pure $ panel bodies footer
onChangeContents :: forall e. T.Box (Maybe UploadFile) -> E.SyntheticEvent_ e -> Effect Unit
onChangeContents mFile e = do
let mF = R2.inputFileNameWithBlob 0 e
E.preventDefault e
E.stopPropagation e
case mF of
Nothing -> pure unit
Just {blob, name} -> void $ launchAff do
--contents <- readAsText blob
--contents <- readAsDataURL blob
liftEffect $ do
T.write_ (Just $ {blob: UploadFileBlob blob, name}) mFile
type UploadButtonProps =
( dispatch :: Action -> Aff Unit
, fileType :: T.Box FileType
, id :: GT.ID
, lang :: T.Box Lang
, mFile :: T.Box (Maybe UploadFile)
, nodeType :: GT.NodeType
)
uploadButton :: Record UploadButtonProps -> R.Element
uploadButton props = R.createElement uploadButtonCpt props []
uploadButtonCpt :: R.Component UploadButtonProps
uploadButtonCpt = here.component "uploadButton" cpt
where
cpt { dispatch
, fileType
, id
, lang
, mFile
, nodeType
} _ = do
fileType' <- T.useLive T.unequal fileType
mFile' <- T.useLive T.unequal mFile
let disabled = case mFile' of
Nothing -> "1"
Just _ -> ""
pure $ H.button { className: "btn btn-primary"
, "type" : "button"
, disabled
, style : { width: "100%" }
, on: {click: onClick fileType' mFile'}
} [ H.text "Upload" ]
where
onClick fileType' mFile' e = do
let { blob, name } = unsafePartial $ fromJust mFile'
here.log2 "[uploadButton] fileType" fileType'
void $ launchAff do
case fileType' of
Arbitrary ->
dispatch $ UploadArbitraryFile (Just name) blob
_ -> do
contents <- readUFBAsText blob
dispatch $ UploadFile nodeType fileType' (Just name) contents
liftEffect $ do
T.write_ Nothing mFile
T.write_ CSV fileType
T.write_ EN lang
dispatch ClosePopover
-- START File Type View
type FileTypeProps =
( dispatch :: Action -> Aff Unit
, droppedFile :: T.Box (Maybe DroppedFile)
, id :: ID
, isDragOver :: T.Box Boolean
, nodeType :: GT.NodeType
)
fileTypeView :: Record FileTypeProps -> R.Element
fileTypeView p = R.createElement fileTypeViewCpt p []
fileTypeViewCpt :: R.Component FileTypeProps
fileTypeViewCpt = here.component "fileTypeView" cpt
where
cpt { dispatch
, droppedFile
, isDragOver
, nodeType
} _ = do
droppedFile' <- T.useLive T.unequal droppedFile
case droppedFile' of
Nothing -> pure $ H.div {} []
Just df@(DroppedFile { blob, fileType }) ->
pure $ H.div tooltipProps [ H.div { className: "card"}
[ panelHeading
, panelBody df
, panelFooter df
]
]
where
tooltipProps = { className: ""
, id : "file-type-tooltip"
, title : "Choose file type"
, data : { toggle: "tooltip"
, placement: "right"
}
}
panelHeading =
H.div {className: "card-header"}
[ H.div {className: "row"}
[ H.div {className: "col-md-10"}
[ H.h5 {} [H.text "Choose file type"] ]
, H.div {className: "col-md-2"}
[ H.a {className: "btn glyphitem fa fa-remove-circle"
, on: {click: \_ -> do
T.write_ Nothing droppedFile
T.write_ false isDragOver
}
, title: "Close"} []
]
]
]
panelBody (DroppedFile { blob }) =
H.div {className: "card-body"}
[ R2.select {className: "col-md-12 form-control"
, on: {change: onChange blob}
}
(map renderOption [CSV, CSV_HAL, WOS])
]
where
onChange blob e l =
T.write_ (Just $ DroppedFile $ { blob
, fileType: read $ R.unsafeEventValue e
, lang : fromMaybe EN $ read $ R.unsafeEventValue l
}) droppedFile
renderOption opt = H.option {} [ H.text $ show opt ]
panelFooter (DroppedFile { blob, fileType }) =
H.div {className: "card-footer"}
[
case fileType of
Just ft ->
H.button {className: "btn btn-success"
, type: "button"
, on: {click: \_ -> do
T.write_ Nothing droppedFile
launchAff $ do
contents <- readUFBAsText blob
dispatch $ UploadFile nodeType ft Nothing contents
}
} [H.text "Upload"]
Nothing ->
H.button {className: "btn btn-success disabled"
, type: "button"
} [H.text "Upload"]
]
newtype FileUploadQuery = FileUploadQuery {
fileType :: FileType
}
derive instance Newtype FileUploadQuery _
instance GT.ToQuery FileUploadQuery where
toQuery (FileUploadQuery {fileType}) =
QP.print id id $ QP.QueryPairs $
pair "fileType" fileType
where pair :: forall a. Show a => String -> a -> Array (Tuple QP.Key (Maybe QP.Value))
pair k v = [ QP.keyFromString k /\ (Just $ QP.valueFromString $ show v) ]
uploadFile :: { contents :: String
, fileType :: FileType
, id :: ID
, nodeType :: GT.NodeType
, mName :: Maybe String
, session :: Session }
-> Aff (Either RESTError GT.AsyncTaskWithType)
{-
uploadFile session NodeList id JSON { mName, contents } = do
let url = GR.NodeAPI NodeList (Just id) $ GT.asyncTaskTypePath GT.ListUpload
-- { input: { data: ..., filetype: "JSON", name: "..." } }
let body = { input: { data: contents
, filetype: "JSON"
, name: fromMaybe "" mName } }
task <- post session url body
pure $ GT.AsyncTaskWithType { task, typ: GT.Form }
-}
uploadFile { contents, fileType, id, nodeType, mName, session } = do
-- contents <- readAsText blob
eTask :: Either RESTError GT.AsyncTask <- postWwwUrlencoded session p bodyParams
case eTask of
Left err -> pure $ Left err
Right task -> pure $ Right $ GT.AsyncTaskWithType { task, typ: GT.Form }
--postMultipartFormData session p fileContents
where
p = case nodeType of
Corpus -> GR.NodeAPI nodeType (Just id) $ GT.asyncTaskTypePath GT.Form
Annuaire -> GR.NodeAPI nodeType (Just id) "annuaire"
NodeList -> case fileType of
JSON -> GR.NodeAPI nodeType (Just id) $ GT.asyncTaskTypePath GT.ListUpload
CSV -> GR.NodeAPI nodeType (Just id) $ GT.asyncTaskTypePath GT.ListCSVUpload
_ -> GR.NodeAPI nodeType (Just id) ""
_ -> GR.NodeAPI nodeType (Just id) ""
bodyParams = [ Tuple "_wf_data" (Just contents)
, Tuple "_wf_filetype" (Just $ show fileType)
, Tuple "_wf_name" mName
]
uploadArbitraryFile :: Session
-> ID
-> {blob :: UploadFileBlob, mName :: Maybe String}
-> Aff (Either RESTError GT.AsyncTaskWithType)
uploadArbitraryFile session id {mName, blob: UploadFileBlob blob} = do
contents <- readAsDataURL blob
uploadArbitraryDataURL session id mName contents
uploadArbitraryDataURL :: Session
-> ID
-> Maybe String
-> String
-> Aff (Either RESTError GT.AsyncTaskWithType)
uploadArbitraryDataURL session id mName contents' = do
let re = fromRight' (\_ -> unsafeCrashWith "Unexpected Left") $ DSR.regex "data:.*;base64," DSRF.noFlags
contents = DSR.replace re "" contents'
eTask :: Either RESTError GT.AsyncTask <- postWwwUrlencoded session p (bodyParams contents)
pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.Form }) <$> eTask
where
p = GR.NodeAPI GT.Node (Just id) $ GT.asyncTaskTypePath GT.UploadFile
bodyParams c = [ Tuple "_wfi_b64_data" (Just c)
, Tuple "_wfi_name" mName
]
------------------------------------------------------------------------
uploadTermListView :: Record Props -> R.Element
uploadTermListView props = R.createElement uploadTermListViewCpt props []
uploadTermListViewCpt :: R.Component Props
uploadTermListViewCpt = here.component "uploadTermListView" cpt
where
cpt {dispatch, id, nodeType} _ = do
let defaultUploadType = JSON
mFile <- T.useBox (Nothing :: Maybe UploadFile)
uploadType <- T.useBox defaultUploadType
let input = H.input { type: "file"
, placeholder: "Choose file"
, on: {change: onChangeContents mFile}
, className: "form-control"
}
let opt fileType = H.option { value: show fileType } [ H.text $ show fileType ]
let uploadTypeHtml = R2.select { className: "form-control"
, defaultValue: show defaultUploadType
, on: { change: onUploadTypeChange uploadType } } (opt <$> [ CSV, JSON ])
let footer = H.div {} [ uploadTermButton { dispatch
, id
, mFile
, nodeType
, uploadType
}
]
pure $ panel
[ H.form {}
[ R2.row [ R2.col 12 [ input ] ]
, R2.row [ R2.col 12 [ uploadTypeHtml ] ]
]
] footer
onChangeContents :: forall e. T.Box (Maybe UploadFile)
-> E.SyntheticEvent_ e
-> Effect Unit
onChangeContents mFile e = do
let mF = R2.inputFileNameWithBlob 0 e
E.preventDefault e
E.stopPropagation e
case mF of
Nothing -> pure unit
Just {blob, name} -> void $ launchAff do
--contents <- readAsText blob
liftEffect $ do
T.write_ (Just $ { blob: UploadFileBlob blob
, name }) mFile
onUploadTypeChange uploadType e = do
case read (R.unsafeEventValue e) of
Nothing -> pure unit
Just fileType -> T.write_ fileType uploadType
type UploadTermButtonProps =
( dispatch :: Action -> Aff Unit
, id :: Int
, mFile :: T.Box (Maybe UploadFile)
, nodeType :: GT.NodeType
, uploadType :: T.Box FileType
)
uploadTermButton :: R2.Leaf UploadTermButtonProps
uploadTermButton props = R.createElement uploadTermButtonCpt props []
uploadTermButtonCpt :: R.Component UploadTermButtonProps
uploadTermButtonCpt = here.component "uploadTermButton" cpt
where
cpt { dispatch
, mFile
, nodeType
, uploadType } _ = do
mFile' <- T.useLive T.unequal mFile
uploadType' <- T.useLive T.unequal uploadType
R.useEffect' $ do
here.log2 "[uploadTermButton] uploadType'" uploadType'
let disabled = case mFile' of
Nothing -> "1"
Just _ -> ""
pure $ H.button { className: "btn btn-primary"
, disabled
, on: { click: onClick mFile' uploadType' }
} [ H.text "Upload" ]
where
onClick mFile' uploadType' e = do
let {name, blob} = unsafePartial $ fromJust mFile'
void $ launchAff do
contents <- readUFBAsText blob
_ <- dispatch $ UploadFile nodeType uploadType' (Just name) contents
liftEffect $ do
T.write_ Nothing mFile
Upload/ 0000775 0000000 0000000 00000000000 14111104351 0036151 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Action Types.purs 0000664 0000000 0000000 00000002141 14111104351 0040166 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Action/Upload module Gargantext.Components.Forest.Tree.Node.Action.Upload.Types where
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Show.Generic (genericShow)
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Web.File.Blob (Blob, size)
import Web.File.FileReader.Aff (readAsText)
import Gargantext.Prelude
data FileType = CSV | CSV_HAL | WOS | PresseRIS | Arbitrary | JSON
derive instance Generic FileType _
instance Eq FileType where
eq = genericEq
instance Show FileType where
show = genericShow
instance Read FileType where
read :: String -> Maybe FileType
read "Arbitrary" = Just Arbitrary
read "CSV" = Just CSV
read "CSV_HAL" = Just CSV_HAL
read "PresseRIS" = Just PresseRIS
read "WOS" = Just WOS
read "JSON" = Just JSON
read _ = Nothing
newtype UploadFileBlob = UploadFileBlob Blob
derive instance Generic UploadFileBlob _
instance Eq UploadFileBlob where
eq (UploadFileBlob b1) (UploadFileBlob b2) = eq (size b1) (size b2)
readUFBAsText :: UploadFileBlob -> Aff String
readUFBAsText (UploadFileBlob b) = readAsText b
Box.purs 0000664 0000000 0000000 00000022476 14111104351 0035166 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node module Gargantext.Components.Forest.Tree.Node.Box where
import Gargantext.Prelude
import Data.Array as A
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Gargantext.Components.App.Data (Boxes)
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.Contact as Contact
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.Download (actionDownload)
import Gargantext.Components.Forest.Tree.Node.Action.Link (linkNode)
import Gargantext.Components.Forest.Tree.Node.Action.Merge (mergeNode)
import Gargantext.Components.Forest.Tree.Node.Action.Move (moveNode)
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.Share as Share
import Gargantext.Components.Forest.Tree.Node.Action.Update (update)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (actionUpload)
import Gargantext.Components.Forest.Tree.Node.Box.Types (NodePopupProps, NodePopupS)
import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction(..), SettingsBox(..), glyphiconNodeAction, settingsBox)
import Gargantext.Components.Forest.Tree.Node.Status (Status(..), hasStatus)
import Gargantext.Components.Forest.Tree.Node.Tools (textInputBox, fragmentPT)
import Gargantext.Sessions (Session)
import Gargantext.Types (FrontendError, ID, Name, prettyNodeType)
import Gargantext.Types as GT
import Gargantext.Utils.Glyphicon (glyphicon, glyphiconActive)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Box"
type CommonProps =
( dispatch :: Action -> Aff Unit
, session :: Session )
nodePopupView :: Record NodePopupProps -> R.Element
nodePopupView p = R.createElement nodePopupCpt p []
nodePopupCpt :: R.Component NodePopupProps
nodePopupCpt = here.component "nodePopupView" cpt where
cpt p@{ id, name, nodeType } _ = do
renameIsOpen <- T.useBox false
open <- T.useLive T.unequal renameIsOpen
nodePopup <- T.useBox { action: Nothing, id, name, nodeType }
action <- T.useFocused (_.action) (\a b -> b { action = a }) nodePopup
nodePopup' <- T.useLive T.unequal nodePopup
pure $ H.div tooltipProps
[ H.div { className: "popup-container" }
[ H.div { className: "card" }
[ panelHeading renameIsOpen open p
, H.div { className: "popup-container-body" }
[
panelBody action p
,
mPanelAction nodePopup' p
]
]
]
]
closePopover p = p.onPopoverClose <<< R.unsafeEventTarget
tooltipProps = { id: "node-popup-tooltip", title: "Node settings"
, data: { toggle: "tooltip", placement: "right" } }
panelHeading renameIsOpen open p@{ dispatch, id, name, nodeType } =
H.div { className: "card-header" }
[ R2.row
[ H.div { className: "col-4" }
[ H.span { className: GT.fldr nodeType true} [] -- TODO fix names
, H.span { className: "h5" } [ H.text $ prettyNodeType nodeType ] ]
, H.div { className: "col-6" }
[ if open then
textInputBox { boxAction: renameAction, boxName: "Rename"
, dispatch, id, text: name, isOpen: renameIsOpen } []
else H.span { className: "text-primary center" } [ H.text p.name ]
]
, H.div { className: "col-1" } [ editIcon renameIsOpen open ]
, H.div { className: "col-1" }
[ H.a { type: "button", on: { click: closePopover p }, title: "Close"
, className: glyphicon "window-close" } [] ]]] where
SettingsBox { edit, doc, buttons } = settingsBox nodeType
editIcon _ true = H.div {} []
editIcon isOpen false =
H.a { className: glyphicon "pencil", id: "rename1"
, title : "Rename", on: { click: \_ -> T.write_ true isOpen } } []
panelBody :: T.Box (Maybe NodeAction) -> Record NodePopupProps -> R.Element
panelBody nodePopupState {dispatch: d, nodeType} =
let (SettingsBox { edit, doc, buttons}) = settingsBox nodeType in
H.div {className: "card-body flex-space-between"}
$ [ H.p { className: "spacer" } []
, H.div { className: "flex-center" }
[ buttonClick { action: doc, state: nodePopupState, nodeType } ]
, H.div {className: "flex-center"}
$ map (\t -> buttonClick { action: t, state: nodePopupState, nodeType }) buttons ]
-- FIXME trick to increase the size of the box
<> if A.length buttons < 2
then [ H.div { className: "col-4" } [] ]
else []
mPanelAction :: Record NodePopupS -> Record NodePopupProps -> R.Element
mPanelAction { action: Just action }
{ boxes, dispatch, id, name, nodeType, session } =
panelAction { action
, boxes
, dispatch
, id
, name
, nodePopup: Just NodePopup
, nodeType
, session
}
mPanelAction { action: Nothing } _ =
H.div { className: "card-footer" }
[ H.div {className:"center fa-hand-pointer-o"}
[ H.h5 {} [ H.text " Select available actions of this node" ]
, H.ul { className: "panel-actions" }
[ H.div { className: "fa-thumbs-o-up ok-to-use" }
[ H.text " Black: usable" ]
, H.div { className: "fa-exclamation-triangle almost-useable" }
[ H.text " Orange: almost useable" ]
, H.div { className: "fa-rocket development-in-progress" }
[ H.text " Red: development in progress" ]]]]
type ActionState =
( action :: Maybe NodeAction
, id :: ID
, name :: Name
, nodeType :: GT.NodeType
)
type ButtonClickProps =
( action :: NodeAction
, state :: T.Box (Maybe NodeAction)
, nodeType :: GT.NodeType
)
buttonClick :: Record ButtonClickProps -> R.Element
buttonClick p = R.createElement buttonClickCpt p []
buttonClickCpt :: R.Component ButtonClickProps
buttonClickCpt = here.component "buttonClick" cpt where
cpt {action: todo, state, nodeType} _ = do
action <- T.useLive T.unequal state
let className = glyphiconActive (glyphiconNodeAction todo) (action == (Just todo))
let style = iconAStyle nodeType todo
let click _ = T.write_ (if action == Just todo then Nothing else Just todo) state
pure $ H.div { className: "col-1" }
[ H.a { style, className, id: show todo, title: show todo, on: { click } } [] ]
-- | Open the help indications if selected already
iconAStyle n a =
{ color: hasColor (hasStatus n a)
, paddingTop: "6px", paddingBottom: "6px" }
hasColor :: Status -> String
hasColor Stable = "black"
hasColor Test = "orange"
hasColor Dev = "red"
type NodeProps =
( id :: ID
, name :: Name
, nodeType :: GT.NodeType
)
type PanelActionProps =
( action :: NodeAction
, boxes :: Boxes
, id :: ID
, dispatch :: Action -> Aff Unit
, name :: Name
, nodePopup :: Maybe NodePopup
, nodeType :: GT.NodeType
, session :: Session
)
panelAction :: R2.Leaf PanelActionProps
panelAction p = R.createElement panelActionCpt p []
panelActionCpt :: R.Component PanelActionProps
panelActionCpt = here.component "panelAction" cpt
where
cpt {action: Documentation nodeType} _ = pure $ actionDoc { nodeType } []
cpt {action: Download, id, nodeType, session} _ = pure $ actionDownload { id, nodeType, session } []
cpt {action: Upload, dispatch, id, nodeType, session} _ = pure $ actionUpload { dispatch, id, nodeType, session } []
cpt {action: Delete, nodeType, dispatch} _ = pure $ actionDelete { dispatch, nodeType } []
cpt {action: Add xs, dispatch, id, name, nodeType} _ =
pure $ addNodeView {dispatch, id, name, nodeType, nodeTypes: xs} []
cpt {action: Refresh , dispatch, id, nodeType, session} _ = pure $ update { dispatch, nodeType } []
cpt {action: Config , dispatch, id, nodeType, session} _ =
pure $ fragmentPT $ "Config " <> show nodeType
-- Functions using SubTree
cpt { action: Merge {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
pure $ mergeNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
cpt {action: Move {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
pure $ moveNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
cpt {action: Link {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
pure $ linkNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
cpt {action : Share, dispatch, id, name } _ = pure $ Share.shareNode { dispatch, id } []
cpt {action : AddingContact, dispatch, id, name } _ = pure $ Contact.actionAddContact { dispatch, id } []
cpt {action : Publish {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
pure $ Share.publishNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
cpt props@{action: SearchBox, boxes, id, session, dispatch, nodePopup} _ =
pure $ actionSearch { boxes, dispatch, id: (Just id), nodePopup, session } []
cpt _ _ = pure $ H.div {} []
Box/ 0000775 0000000 0000000 00000000000 14111104351 0034240 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node Types.purs 0000664 0000000 0000000 00000001556 14111104351 0036266 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Box module Gargantext.Components.Forest.Tree.Node.Box.Types where
import DOM.Simple as DOM
import Data.Maybe (Maybe)
import Effect (Effect)
import Effect.Aff (Aff)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Forest.Tree.Node.Action (Action)
import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction)
import Gargantext.Prelude (Unit)
import Gargantext.Sessions (Session)
import Gargantext.Types (ID, Name)
import Gargantext.Types as GT
type CommonProps =
( dispatch :: Action -> Aff Unit
, session :: Session
)
type NodePopupProps =
( boxes :: Boxes
, id :: ID
, name :: Name
, nodeType :: GT.NodeType
, onPopoverClose :: DOM.Element -> Effect Unit
| CommonProps
)
type NodePopupS =
( action :: Maybe NodeAction
, id :: ID
, name :: Name
, nodeType :: GT.NodeType
)
Settings.purs 0000664 0000000 0000000 00000037270 14111104351 0036234 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node module Gargantext.Components.Forest.Tree.Node.Settings where
import Data.Generic.Rep (class Generic)
import Data.Show.Generic (genericShow)
import Data.Eq.Generic (genericEq)
import Gargantext.Prelude (class Eq, class Show, show, (&&), (<>), (==))
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeParams(..))
import Data.Array (foldl)
import Gargantext.Types
------------------------------------------------------------------------
------------------------------------------------------------------------
{-
-- | RIGHT Management
if user has access to node then he can do all his related actions
-}
------------------------------------------------------------------------
data NodeAction = Documentation NodeType
| SearchBox
| Download | Upload | Refresh | Config
| Delete
| Share
| Publish { subTreeParams :: SubTreeParams }
| Add (Array NodeType)
| Merge { subTreeParams :: SubTreeParams }
| Move { subTreeParams :: SubTreeParams }
| Link { subTreeParams :: SubTreeParams }
| Clone
| AddingContact
| CloseNodePopover
------------------------------------------------------------------------
instance Eq NodeAction where
eq (Documentation x) (Documentation y) = true && (x == y)
eq SearchBox SearchBox = true
eq Download Download = true
eq Upload Upload = true
eq Refresh Refresh = true
eq (Move x) (Move y) = x == y
eq Clone Clone = true
eq Delete Delete = true
eq Share Share = true
eq (Link x) (Link y) = x == y
eq (Add x) (Add y) = x == y
eq (Merge x) (Merge y) = x == y
eq Config Config = true
eq (Publish x) (Publish y) = x == y
eq AddingContact AddingContact = true
eq CloseNodePopover CloseNodePopover = true
eq _ _ = false
instance Show NodeAction where
show (Documentation x) = "Documentation of " <> show x
show SearchBox = "SearchBox"
show Download = "Download"
show Upload = "Upload"
show Refresh = "Refresh"
show (Move t) = "Move with subtree params" -- <> show t
show Clone = "Clone"
show Delete = "Delete"
show Share = "Share"
show Config = "Config"
show (Link x) = "Link to " -- <> show x
show (Add xs) = "Add Child" -- foldl (\a b -> a <> show b) "Add " xs
show (Merge t) = "Merge with subtree" -- <> show t
show (Publish x) = "Publish" -- <> show x
show AddingContact = "AddingContact"
show CloseNodePopover = "CloseNodePopover"
glyphiconNodeAction :: NodeAction -> String
glyphiconNodeAction (Documentation _) = "question-circle"
glyphiconNodeAction Delete = "trash"
glyphiconNodeAction (Add _) = "plus"
glyphiconNodeAction SearchBox = "search"
glyphiconNodeAction Upload = "upload"
glyphiconNodeAction (Link _) = "arrows-h"
glyphiconNodeAction Download = "download"
glyphiconNodeAction (Merge _) = "random"
glyphiconNodeAction Refresh = "refresh"
glyphiconNodeAction Config = "wrench"
glyphiconNodeAction Share = "user-plus"
glyphiconNodeAction AddingContact = "user-plus"
glyphiconNodeAction (Move _) = "share-square-o"
glyphiconNodeAction (Publish _) = fldr FolderPublic true
glyphiconNodeAction CloseNodePopover = "close"
glyphiconNodeAction _ = ""
------------------------------------------------------------------------
data SettingsBox =
SettingsBox { show :: Boolean
, edit :: Boolean
, doc :: NodeAction
, buttons :: Array NodeAction
}
------------------------------------------------------------------------
settingsBox :: NodeType -> SettingsBox
settingsBox NodeUser =
SettingsBox { show : true
, edit : false
, doc : Documentation NodeUser
, buttons : [ Add [ FolderPrivate
, FolderShared
, FolderPublic
]
, Delete
]
}
settingsBox FolderPrivate =
SettingsBox { show : true
, edit : false
, doc : Documentation FolderPrivate
, buttons : [ Add [ Corpus
, Folder
, Annuaire
, NodeFrameWrite
, NodeFrameCalc
]
, Delete
]
}
settingsBox Team =
SettingsBox { show : true
, edit : true
, doc : Documentation Team
, buttons : [ Add [ Corpus
, Folder
, Annuaire
, NodeFrameWrite
, NodeFrameCalc
-- , NodeFrameNotebook
, Team
, FolderShared
, NodeFrameVisio
]
, Share
, Delete
]
}
settingsBox FolderShared =
SettingsBox { show : true
, edit : true
, doc : Documentation FolderShared
, buttons : [ Add [Team, FolderShared]
, Delete
]
}
settingsBox FolderPublic =
SettingsBox { show : true
, edit : true
, doc : Documentation FolderPublic
, buttons : [ Add [ FolderPublic ]
, Delete
]
}
settingsBox Folder =
SettingsBox { show : true
, edit : true
, doc : Documentation Folder
, buttons : [ Add [ Corpus
, Folder
, Annuaire
, NodeFrameWrite
, NodeFrameCalc
]
, Move moveParameters
, Delete
]
}
settingsBox Corpus =
SettingsBox { show : true
, edit : true
, doc : Documentation Corpus
, buttons : [ Upload
, SearchBox
, Download
--, Clone
, Add [ NodeList
, Graph
, Dashboard
, NodeFrameWrite
, NodeFrameCalc
, Phylo
]
, Link (linkParams Annuaire)
, Move moveParameters
, Delete
]
}
settingsBox Texts =
SettingsBox { show : true
, edit : false
, doc : Documentation Texts
, buttons : [ Refresh
, Upload
, Download
, Delete
]
}
settingsBox Graph =
SettingsBox { show : true
, edit : true
, doc : Documentation Graph
, buttons : [ Refresh
, Config
, Download -- TODO as GEXF or JSON
-- , Publish publishParams
, Delete
]
}
settingsBox Phylo =
SettingsBox { show : true
, edit : true
, doc : Documentation Phylo
, buttons : [ Delete
]
}
settingsBox (NodePublic Graph) =
SettingsBox { show : true
, edit : true
, doc : Documentation Graph
, buttons : [ Download -- TODO as GEXF or JSON
, Delete
]
}
settingsBox (NodePublic Dashboard) =
SettingsBox { show : true
, edit : true
, doc : Documentation Dashboard
, buttons : [ Delete
]
}
settingsBox (NodePublic NodeFile) =
SettingsBox { show : true
, edit : true
, doc : Documentation NodeFile
, buttons : [ Delete
]
}
settingsBox (NodePublic FolderPublic) =
SettingsBox { show : true
, edit : true
, doc : Documentation FolderPublic
, buttons : [ Add [FolderPublic]
, Delete
]
}
settingsBox NodeList =
SettingsBox { show : true
, edit : false
, doc : Documentation NodeList
, buttons : [ Refresh
, Config
, Download
, Upload
, Merge {subTreeParams : SubTreeParams { showtypes: [ FolderPrivate
, FolderShared
, Team
, FolderPublic
, Folder
, Corpus
, NodeList
]
, valitypes: [ NodeList ]
}
}
, Delete
]
}
settingsBox Dashboard =
SettingsBox { show : true
, edit : false
, doc : Documentation Dashboard
, buttons : [ Refresh
, Publish publishParams
, Delete
]
}
settingsBox Annuaire =
SettingsBox { show : true
, edit : true
, doc : Documentation Annuaire
, buttons : [ Upload
, AddingContact
, Move moveParameters
, Link (linkParams Corpus)
, Delete
]
}
settingsBox NodeFrameWrite =
SettingsBox { show : true
, edit : true
, doc : Documentation NodeFrameWrite
, buttons : [ Add [ NodeFrameWrite
, NodeFrameCalc
]
, Move moveFrameParameters
, Delete
]
}
settingsBox NodeFrameCalc =
SettingsBox { show : true
, edit : true
, doc : Documentation NodeFrameCalc
, buttons : [ Add [ NodeFrameCalc
, NodeFrameWrite
]
, Move moveFrameParameters
, Delete
]
}
settingsBox NodeFrameNotebook =
SettingsBox { show : true
, edit : true
, doc : Documentation NodeFrameNotebook
, buttons : [ Add [ NodeFrameCalc
, NodeFrameWrite
, NodeFrameNotebook
]
, Move moveFrameParameters
, Delete
]
}
settingsBox NodeFrameVisio =
SettingsBox { show : true
, edit : true
, doc : Documentation NodeFrameVisio
, buttons : [ Add [ NodeFrameVisio
, NodeFrameWrite
, NodeFrameCalc
]
, Delete
]
}
settingsBox NodeFile =
SettingsBox { show: true
, edit: true
, doc: Documentation NodeFile
, buttons: [ Publish publishParams
, Delete ]
}
settingsBox _ =
SettingsBox { show : false
, edit : false
, doc : Documentation NodeUser
, buttons : []
}
-- | SubTree Parameters
moveParameters = { subTreeParams : SubTreeParams
{ showtypes: [ FolderPrivate
, FolderShared
, Team
, FolderPublic
, Folder
]
, valitypes: [ FolderPrivate
, Team
-- , FolderPublic
, Folder
]
}
}
moveFrameParameters = { subTreeParams : SubTreeParams
{ showtypes: [ FolderPrivate
, FolderShared
, Team
, FolderPublic
, Folder
, Corpus
, NodeFrameWrite
, NodeFrameCalc
]
, valitypes: [ FolderPrivate
, Team
-- , FolderPublic
, Folder
, Corpus
, NodeFrameWrite
, NodeFrameCalc
]
}
}
linkParams :: NodeType -> {subTreeParams :: SubTreeParams}
linkParams nodeType = { subTreeParams : SubTreeParams
{ showtypes: [ FolderPrivate
, FolderShared
, Team
, FolderPublic
, Folder
, nodeType
]
, valitypes: [ nodeType
]
}
}
publishParams = { subTreeParams : SubTreeParams
{ showtypes: [ FolderPublic
]
, valitypes: [ FolderPublic
]
}
}
Status.purs 0000664 0000000 0000000 00000001217 14111104351 0035707 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node module Gargantext.Components.Forest.Tree.Node.Status where
import Gargantext.Types
import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction(..))
------------------------------------------------------------------------
-- Beta Status
data Status = Stable | Test | Dev
hasStatus :: NodeType -> NodeAction -> Status
hasStatus _ SearchBox = Test
hasStatus _ Refresh = Dev
hasStatus _ Config = Dev
hasStatus _ (Merge _) = Dev
hasStatus _ (Documentation _) = Dev
hasStatus Annuaire Upload = Dev
hasStatus Texts Upload = Dev
hasStatus Corpus (Add _) = Dev
hasStatus _ _ = Stable
Tools.purs 0000664 0000000 0000000 00000024327 14111104351 0035533 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node module Gargantext.Components.Forest.Tree.Node.Tools where
import Data.Maybe (fromMaybe, Maybe(..))
import Data.Nullable (null)
import Data.Set (Set)
import Data.Set as Set
import Data.String as S
import Data.String.CodeUnits as DSCU
import Effect (Effect)
import Effect.Aff (Aff, launchAff, launchAff_)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Forest.Tree.Node.Action (Action, icon, text)
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Ends (Frontends, url)
import Gargantext.Prelude (class Ord, class Read, class Show, Unit, bind, const, discard, map, not, pure, read, show, when, mempty, ($), (<), (<<<), (<>), (<$>), (<*>))
import Gargantext.Sessions (Session, sessionId)
import Gargantext.Types as GT
import Gargantext.Utils (toggleSet)
import Gargantext.Utils.Glyphicon (glyphicon)
import Gargantext.Utils.ReactTooltip as ReactTooltip
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools"
fragmentPT :: String -> R.Element
fragmentPT text = H.div { style: { margin: "10px" }} [ H.text text ]
type Body = Array R.Element
type Footer = R.Element
panel :: Body -> Footer -> R.Element
panel bodies submit =
R.fragment
[ H.div { className: "card-body" }
[ H.div { className: "row" }
-- TODO add type for text or form here [ H.form {className: "form-horizontal"} bodies ]
[ H.div { className: "col-12" } bodies ]]
, H.div {className: "card-footer"}
[ H.div { className: "row" }
[ H.div { className: "mx-auto"} [ submit ] ]]]
type TextInputBoxProps =
( id :: GT.ID
, dispatch :: Action -> Aff Unit
, text :: String
, isOpen :: T.Box Boolean
, boxName :: String
, boxAction :: String -> Action
)
textInputBox :: R2.Component TextInputBoxProps
textInputBox = R.createElement textInputBoxCpt
textInputBoxCpt :: R.Component TextInputBoxProps
textInputBoxCpt = here.component "textInputBox" cpt where
cpt { boxAction, boxName, dispatch, id, isOpen, text } _ =
content <$> T.useLive T.unequal isOpen <*> R.useRef text
where
content false _ = (R.fragment [])
content true renameNodeNameRef =
H.div { className: "from-group row" }
[ textInput renameNodeNameRef
, submitBtn renameNodeNameRef
, cancelBtn
]
textInput renameNodeNameRef =
H.div { className: "col-8" }
[ inputWithEnter {
autoFocus: true
, className: "form-control"
, defaultValue: text
, onBlur: R.setRef renameNodeNameRef
, onEnter: submit renameNodeNameRef
, onValueChanged: R.setRef renameNodeNameRef
, placeholder: (boxName <> " Node")
, type: "text"
}
]
submitBtn renameNodeNameRef =
H.a { type: "button"
, title: "Submit"
, on: { click: submit renameNodeNameRef }
, className: "col-2 " <> glyphicon "floppy-o" } []
cancelBtn =
H.a { type: "button", title: "Cancel", on: { click }
, className: "text-danger col-2 " <> glyphicon "times" } []
submit ref _ = do
launchAff_ $ dispatch (boxAction $ R.readRef ref)
T.write_ false isOpen
click _ = T.write_ false isOpen
type DefaultText = String
formEdit :: forall prev next
. DefaultText -> ((prev -> String) -> Effect next) -> R.Element
formEdit defaultValue setter =
H.div { className: "form-group" }
[ H.input { defaultValue, type: "text", on: { input }
, placeholder: defaultValue, className: "form-control" }
] where input = setter <<< const <<< R.unsafeEventValue
-- | Form Choice input
-- if the list of options is not big enough, a button is used instead
formChoiceSafe :: forall item m
. Read item
=> Show item
=> Array item
-> item
-> (item -> Effect m)
-> (item -> String)
-> R.Element
formChoiceSafe [] _ _ _ = mempty
formChoiceSafe [n] _ cbk prnt = formButton n cbk prnt
formChoiceSafe arr def cbk prnt = formChoice arr def cbk prnt
-- | List Form
formChoice :: forall item m
. Read item
=> Show item
=> Array item
-> item
-> (item -> Effect m)
-> (item -> String)
-> R.Element
formChoice items def cbk prnt =
H.div { className: "form-group"}
[
R2.select
{ className: "form-control with-icon-font"
, on: { change }
} $
map option items
]
where
change e = cbk $ fromMaybe def $ read $ R.unsafeEventValue e
option opt =
H.option { value: show opt }
[ H.text $ prnt opt ]
-- | Button Form
-- FIXME: currently needs a click from the user (by default, we could avoid such click)
formButton :: forall item m
. item
-> (item -> Effect m)
-> (item -> String)
-> R.Element
formButton item cbk prnt =
H.div {}
[
H.text $ "Confirm the selection of: " <> prnt item
,
cta
]
where
cta =
H.button
{ className : "cold-md-5 btn btn-primary center"
, type : "button"
, title: "Form Button"
, style : { width: "100%" }
, on: { click: \_ -> cbk item }
}
[ H.text "Confirmation" ]
------------------------------------------------------------------------
------------------------------------------------------------------------
submitButton :: Action -> (Action -> Aff Unit) -> R.Element
submitButton action dispatch =
H.button { className : "btn btn-primary fa fa-" <> icon action
, type: "button"
, id: S.toLower $ show action
, title: show action
, on: {click: \_ -> launchAff $ dispatch action}
}
[ H.text $ " " <> text action]
type Href = String
submitButtonHref :: Action -> Href -> R.Element
submitButtonHref action href =
H.a { className, href, target: "_blank" } [ H.text $ " " <> text action ] where
className = "btn btn-primary fa fa-" <> icon action
------------------------------------------------------------------------
-- | CheckBox tools
-- checkboxes: Array of boolean values (basic: without pending option)
-- checkbox : One boolean value only
type CheckboxProps =
( value :: T.Box Boolean )
checkbox :: R2.Leaf CheckboxProps
checkbox props = R.createElement checkboxCpt props []
checkboxCpt :: R.Component CheckboxProps
checkboxCpt = here.component "checkbox" cpt
where
cpt { value } _ = do
value' <- T.useLive T.unequal value
pure $ H.input { className: "form-check-input"
, on: { click }
, type: "checkbox"
, value: value' }
where
click _ = T.modify_ not value
data CheckBoxes = Multiple | Uniq
type CheckboxesListGroup a =
( groups :: Array a
, options :: T.Box (Set a) )
checkboxesListGroup :: forall a. Ord a => Show a => R2.Component (CheckboxesListGroup a)
checkboxesListGroup = R.createElement checkboxesListGroupCpt
checkboxesListGroupCpt :: forall a. Ord a => Show a => R.Component (CheckboxesListGroup a)
checkboxesListGroupCpt = here.component "checkboxesListGroup" cpt
where
cpt { groups, options } _ = do
options' <- T.useLive T.unequal options
let one a =
H.li { className: "list-group-item" }
[ H.div { className: "form-check" }
[ H.input { defaultChecked: Set.member a options'
, on: { click: \_ -> T.write_ (toggleSet a options') options
, type: "checkbox" }
, className: "form-check-input" }
, H.label { className: "form-check-label" } [ H.text (show a) ] ]
]
pure $ R.fragment $ map one $ Set.toUnfoldable options'
prettyNodeType :: GT.NodeType -> String
prettyNodeType
= S.replace (S.Pattern "Node") (S.Replacement " ")
<<< S.replace (S.Pattern "Folder") (S.Replacement " ")
<<< show
tooltipId :: GT.NodeID -> String
tooltipId id = "node-link-" <> show id
-- START node link
type NodeLinkProps = (
boxes :: Boxes
, folderOpen :: T.Box Boolean
, frontends :: Frontends
, id :: Int
, isSelected :: Boolean
, name :: GT.Name
, nodeType :: GT.NodeType
, session :: Session
)
nodeLink :: R2.Component NodeLinkProps
nodeLink = R.createElement nodeLinkCpt
nodeLinkCpt :: R.Component NodeLinkProps
nodeLinkCpt = here.component "nodeLink" cpt
where
cpt { boxes: { handed }
, folderOpen
, frontends
, id
, isSelected
, name
, nodeType
, session
} _ = do
popoverRef <- R.useRef null
pure $
H.div { className: "node-link"
, on: { click } }
[ H.a { href, data: { for: tooltipId id, tip: true } }
[ nodeText { handed, isSelected, name } []
, ReactTooltip.reactTooltip { effect: "float", id: tooltipId id, type: "dark" }
[ R2.row
[ H.h4 {className: GT.fldr nodeType true}
[ H.text $ GT.prettyNodeType nodeType ]
]
, R2.row [ H.span {} [ H.text $ name ]]
]
]
]
where
-- NOTE Don't toggle tree if it is not selected
-- click on closed -> open
-- click on open -> ?
click _ = when (not isSelected) (T.write_ true folderOpen)
href = url frontends $ GT.NodePath (sessionId session) nodeType (Just id)
-- END node link
type NodeTextProps =
( isSelected :: Boolean
, handed :: T.Box GT.Handed
, name :: GT.Name
)
nodeText :: R2.Component NodeTextProps
nodeText = R.createElement nodeTextCpt
nodeTextCpt :: R.Component NodeTextProps
nodeTextCpt = here.component "nodeText" cpt where
cpt { isSelected, handed, name } _ = do
handed' <- T.useLive T.unequal handed
pure $ if isSelected then
H.u { className }
[ H.b {}
[ H.text ("| " <> name15 name <> " | ") ]
]
else
GT.flipHanded l r handed' where
l = H.text "..."
r = H.text (name15 name)
name_ len n =
if S.length n < len then n
else case (DSCU.slice 0 len n) of
Nothing -> "???"
Just s -> s <> "..."
name15 = name_ 15
className = "node-text"
Tools/ 0000775 0000000 0000000 00000000000 14111104351 0034610 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node FTree.purs 0000664 0000000 0000000 00000003620 14111104351 0036531 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Tools module Gargantext.Components.Forest.Tree.Node.Tools.FTree where
import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Foreign as F
import Simple.JSON as JSON
import Simple.JSON.Generics as JSONG
import Gargantext.Prelude
import Gargantext.Types as GT
-----------------------------------------------------------------------
type ID = Int
type Name = String
-----------------------------------------------------------------------
type FTree = NTree LNode
data NTree a = NTree a (Array (NTree a))
derive instance Generic (NTree a) _
instance JSON.ReadForeign (NTree LNode) where
readImpl f = do
inst :: { node :: LNode, children :: Array FTree } <- JSON.readImpl f
let (LNode { id }) = inst.node
pure $ NTree inst.node ((addParent id) <$> inst.children)
instance Eq a => Eq (NTree a) where
eq (NTree a1 as1) (NTree a2 as2) = (eq a1 a2) && (eq as1 as2)
type Tree = { tree :: FTree
, tasks :: Array GT.AsyncTaskWithType
}
fTreeID :: FTree -> ID
fTreeID (NTree (LNode { id }) _) = id
instance Functor NTree where
map f (NTree x ary) = NTree (f x) (map (map f) ary)
newtype LNode =
LNode
{ id :: ID
, name :: Name
, nodeType :: GT.NodeType
, parent_id :: Maybe ID
}
derive instance Newtype LNode _
derive instance Generic LNode _
instance Eq LNode where eq = genericEq
instance JSON.ReadForeign LNode where
readImpl f = do
inst :: { id :: ID, name :: Name, type :: GT.NodeType, parent_id :: Maybe ID } <- JSON.readImpl f
pure $ LNode { id: inst.id
, name: inst.name
, nodeType: inst.type
, parent_id: Nothing }
addParent :: ID -> NTree LNode -> NTree LNode
addParent id (NTree (LNode p@{id:id'}) ary)=
NTree (LNode (p {parent_id=Just id}))
(map (addParent id') ary)
ProgressBar.purs 0000664 0000000 0000000 00000010336 14111104351 0037757 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Tools module Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar where
import Gargantext.Prelude
import Data.Either (Either)
import Data.Int (fromNumber)
import Data.Maybe (Maybe(..))
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Effect.Timer (clearInterval, setInterval)
import Gargantext.Config.REST (RESTError)
import Gargantext.Config.Utils (handleRESTError)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
import Gargantext.Types (FrontendError)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools.ProgressBar"
data BarType = Bar | Pie
type Props = (
asyncTask :: GT.AsyncTaskWithType
, barType :: BarType
, errors :: T.Box (Array FrontendError)
, nodeId :: GT.ID
, onFinish :: Unit -> Effect Unit
, session :: Session
)
asyncProgressBar :: R2.Component Props
asyncProgressBar = R.createElement asyncProgressBarCpt
asyncProgressBarCpt :: R.Component Props
asyncProgressBarCpt = here.component "asyncProgressBar" cpt
where
cpt props@{ asyncTask: (GT.AsyncTaskWithType {task: GT.AsyncTask {id}})
, barType
, errors
, onFinish
} _ = do
progress <- T.useBox 0.0
intervalIdRef <- R.useRef Nothing
R.useEffectOnce' $ do
intervalId <- setInterval 1000 $ do
launchAff_ $ do
eAsyncProgress <- queryProgress props
handleRESTError errors eAsyncProgress $ \asyncProgress -> liftEffect $ do
let GT.AsyncProgress { status } = asyncProgress
T.write_ (min 100.0 $ GT.progressPercent asyncProgress) progress
if (status == GT.IsFinished) || (status == GT.IsKilled) || (status == GT.IsFailure) then do
_ <- case R.readRef intervalIdRef of
Nothing -> pure unit
Just iid -> clearInterval iid
onFinish unit
else
pure unit
R.setRef intervalIdRef $ Just intervalId
pure unit
pure $ progressIndicator { barType, label: id, progress }
type ProgressIndicatorProps =
( barType :: BarType
, label :: String
, progress :: T.Box Number
)
progressIndicator :: Record ProgressIndicatorProps -> R.Element
progressIndicator p = R.createElement progressIndicatorCpt p []
progressIndicatorCpt :: R.Component ProgressIndicatorProps
progressIndicatorCpt = here.component "progressIndicator" cpt
where
cpt { barType, label, progress } _ = do
progress' <- T.useLive T.unequal progress
let progressInt = toInt progress'
case barType of
Bar -> pure $
H.div { className: "progress" }
[ H.div { className: "progress-bar"
, role: "progressbar"
, style: { width: (show $ progressInt) <> "%" }
} [ H.text label ]
]
Pie -> pure $
H.div { className: "progress-pie" }
[ H.div { className: "progress-pie-segment"
, style: { "--over50": if progressInt < 50 then "0" else "1"
, "--value": show $ progressInt } } [
]
]
toInt :: Number -> Int
toInt n = case fromNumber n of
Nothing -> 0
Just x -> x
queryProgress :: Record Props -> Aff (Either RESTError GT.AsyncProgress)
queryProgress { asyncTask: GT.AsyncTaskWithType { task: GT.AsyncTask {id}
, typ
}
, nodeId
, session
} = get session (p typ)
where
-- TODO refactor path
p GT.UpdateNgramsCharts = NodeAPI GT.Node (Just nodeId) $ path <> id <> "/poll?limit=1"
p GT.UpdateNode = NodeAPI GT.Node (Just nodeId) $ path <> id <> "/poll?limit=1"
p _ = NodeAPI GT.Corpus (Just nodeId) $ path <> id <> "/poll?limit=1"
path = GT.asyncTaskTypePath typ
-- TODO wait route: take the result if failure then message
SubTree.purs 0000664 0000000 0000000 00000013317 14111104351 0037101 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Tools module Gargantext.Components.Forest.Tree.Node.Tools.SubTree where
import Gargantext.Prelude
import Data.Array as A
import Data.Either (Either)
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Forest.Tree.Node.Action (Props, Action, subTreeOut, setTreeOut)
import Gargantext.Components.Forest.Tree.Node.Tools (nodeText)
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..))
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeParams(..), SubTreeOut(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session(..), get)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools.SubTree"
type SubTreeParamsIn =
( boxes :: Boxes
, subTreeParams :: SubTreeParams
| Props
)
------------------------------------------------------------------------
type SubTreeParamsProps =
( action :: T.Box Action
| SubTreeParamsIn
)
subTreeView :: R2.Component SubTreeParamsProps
subTreeView = R.createElement subTreeViewCpt
subTreeViewCpt :: R.Component SubTreeParamsProps
subTreeViewCpt = here.component "subTreeView" cpt
where
cpt { action
, boxes
, dispatch
, id
, nodeType
, session
, subTreeParams
} _ = do
let
SubTreeParams {showtypes} = subTreeParams
-- (valAction /\ setAction) = action
-- _ <- pure $ setAction (const $ setTreeOut valAction Nothing)
useLoader { errorHandler
, loader: loadSubTree showtypes
, path: session
, render: \tree ->
subTreeViewLoaded { action
, boxes
, dispatch
, id
, nodeType
, session
, subTreeParams
, tree
} [] }
where
errorHandler err = here.log2 "RESTError" err
loadSubTree :: Array GT.NodeType -> Session -> Aff (Either RESTError FTree)
loadSubTree nodetypes session = getSubTree session treeId nodetypes
where
Session { treeId } = session
getSubTree :: Session -> Int -> Array GT.NodeType -> Aff (Either RESTError FTree)
getSubTree session treeId showtypes = get session $ GR.NodeAPI GT.Tree (Just treeId) nodeTypes
where
nodeTypes = A.foldl (\a b -> a <> "type=" <> show b <> "&") "?" showtypes
------------------------------------------------------------------------
type CorpusTreeProps =
( tree :: FTree
| SubTreeParamsProps
)
subTreeViewLoaded :: R2.Component CorpusTreeProps
subTreeViewLoaded = R.createElement subTreeViewLoadedCpt
subTreeViewLoadedCpt :: R.Component CorpusTreeProps
subTreeViewLoadedCpt = here.component "subTreeViewLoaded" cpt
where
cpt p@{ boxes: { handed } } _ = do
handed' <- T.useLive T.unequal handed
let pRender = Record.merge { render: subTreeTreeView } p
pure $ H.div {className:"tree"}
[ H.div { className: if handed' == GT.RightHanded
then "righthanded"
else "lefthanded"
}
[ subTreeTreeView (CorpusTreeRenderProps pRender) [] ]
]
newtype CorpusTreeRenderProps = CorpusTreeRenderProps
{ render :: CorpusTreeRenderProps -> Array R.Element -> R.Element
| CorpusTreeProps }
subTreeTreeView :: CorpusTreeRenderProps -> Array R.Element -> R.Element
subTreeTreeView = R2.ntCreateElement subTreeTreeViewCpt
subTreeTreeViewCpt :: R2.NTComponent CorpusTreeRenderProps
subTreeTreeViewCpt = here.ntComponent "subTreeTreeView" cpt where
cpt (CorpusTreeRenderProps p@{ action
, boxes: { handed }
, id
, render
, subTreeParams
, tree: NTree (LNode { id: targetId, name, nodeType }) ary }) _ = do
action' <- T.useLive T.unequal action
handed' <- T.useLive T.unequal handed
let click e = do
let action'' = if not validNodeType then Nothing else Just $ SubTreeOut { in: id, out: targetId }
E.preventDefault e
E.stopPropagation e
T.modify_ (\a -> setTreeOut a action'') action
children = (map (\ctree -> render (CorpusTreeRenderProps (p { tree = ctree })) []) sortedAry) :: Array R.Element
pure $ H.div {} $ GT.reverseHanded handed'
[ H.div { className: nodeClass validNodeType }
[ H.span { className: "text"
, on: { click } }
[ nodeText { handed
, isSelected: isSelected targetId action'
, name: " " <> name } []
, H.span { className: "children" } children
]
]
]
where
nodeClass vnt = "node " <> GT.fldr nodeType true <> " " <> validNodeTypeClass where
validNodeTypeClass = if vnt then "node-type-valid" else ""
SubTreeParams { valitypes } = subTreeParams
sortedAry = A.sortWith (\(NTree (LNode {id:id'}) _) -> id')
$ A.filter (\(NTree (LNode {id:id'}) _) -> id'/= id) ary
validNodeType = (A.elem nodeType valitypes) && (id /= targetId)
isSelected n action' = case (subTreeOut action') of
Nothing -> false
(Just (SubTreeOut {out})) -> n == out
SubTree/ 0000775 0000000 0000000 00000000000 14111104351 0036161 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Tools Types.purs 0000664 0000000 0000000 00000001727 14111104351 0040207 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Tools/SubTree module Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types where
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Show.Generic (genericShow)
import Gargantext.Prelude (class Eq, class Show)
import Gargantext.Types as GT
data SubTreeOut = SubTreeOut { in :: GT.ID
, out :: GT.ID
}
derive instance Generic SubTreeOut _
instance Eq SubTreeOut where eq = genericEq
instance Show SubTreeOut where show = genericShow
------------------------------------------------------------------------
data SubTreeParams = SubTreeParams { showtypes :: Array GT.NodeType
, valitypes :: Array GT.NodeType
}
derive instance Generic SubTreeParams _
instance Eq SubTreeParams where eq = genericEq
instance Show SubTreeParams where show = genericShow
------------------------------------------------------------------------
Sync.purs 0000664 0000000 0000000 00000010244 14111104351 0036440 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Forest/Tree/Node/Tools module Gargantext.Components.Forest.Tree.Node.Tools.Sync where
import Gargantext.Prelude
( Unit, bind, const, discard, pure, unit, ($), (<>), (==) )
import Effect.Aff (Aff, launchAff_)
import Data.Tuple.Nested ((/\))
import Data.Maybe (Maybe(..))
import Data.Tuple (fst)
import Effect.Class (liftEffect)
import Reactix.DOM.HTML as H
import Reactix as R
import Toestand as T
import Gargantext.Components.GraphExplorer.API as GraphAPI
import Gargantext.Types as GT
import Gargantext.Sessions (Session)
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools.Sync"
-- | Sync Node (Graph)
type NodeActionsGraphProps =
( id :: GT.ID
, graphVersions :: Record GraphAPI.GraphVersions
, session :: Session
, refresh :: Unit -> Aff Unit
)
nodeActionsGraph :: R2.Component NodeActionsGraphProps
nodeActionsGraph = R.createElement nodeActionsGraphCpt
nodeActionsGraphCpt :: R.Component NodeActionsGraphProps
nodeActionsGraphCpt = here.component "nodeActionsGraph" cpt
where
cpt { id, graphVersions, session, refresh } _ = do
pure $ H.div { className: "node-actions" } [
if graphVersions.gv_graph == Just graphVersions.gv_repo then
H.div {} []
else
graphUpdateButton { id, session, refresh }
]
type GraphUpdateButtonProps =
( id :: GT.ID
, session :: Session
, refresh :: Unit -> Aff Unit
)
graphUpdateButton :: Record GraphUpdateButtonProps -> R.Element
graphUpdateButton p = R.createElement graphUpdateButtonCpt p []
graphUpdateButtonCpt :: R.Component GraphUpdateButtonProps
graphUpdateButtonCpt = here.component "graphUpdateButton" cpt
where
cpt { id, session, refresh } _ = do
enabled <- T.useBox true
enabled' <- T.useLive T.unequal enabled
pure $ H.div { className: "update-button "
<> if enabled'
then "enabled"
else "disabled text-muted"
} [ H.span { className: "fa fa-refresh"
, on: { click: onClick enabled' enabled } } []
]
where
onClick false _ = pure unit
onClick true enabled = do
launchAff_ $ do
liftEffect $ T.write_ false enabled
g <- GraphAPI.updateGraphVersions { graphId: id, session }
liftEffect $ T.write_ true enabled
refresh unit
pure unit
-- | Sync Node (List)
type NodeActionsNodeListProps =
(
listId :: GT.ListId
, nodeId :: GT.ID
, nodeType :: GT.TabSubType GT.CTabNgramType
, session :: Session
, refresh :: Unit -> Aff Unit
)
nodeActionsNodeList :: Record NodeActionsNodeListProps -> R.Element
nodeActionsNodeList p = R.createElement nodeActionsNodeListCpt p []
nodeActionsNodeListCpt :: R.Component NodeActionsNodeListProps
nodeActionsNodeListCpt = here.component "nodeActionsNodeList" cpt
where
cpt props _ = do
pure $ H.div { className: "node-actions" } [
nodeListUpdateButton props
]
type NodeListUpdateButtonProps =
( listId :: GT.ListId
, nodeId :: GT.ID
, nodeType :: GT.TabSubType GT.CTabNgramType
, session :: Session
, refresh :: Unit -> Aff Unit
)
nodeListUpdateButton :: Record NodeListUpdateButtonProps -> R.Element
nodeListUpdateButton p = R.createElement nodeListUpdateButtonCpt p []
nodeListUpdateButtonCpt :: R.Component NodeListUpdateButtonProps
nodeListUpdateButtonCpt = here.component "nodeListUpdateButton" cpt
where
cpt { listId, nodeId, nodeType, session, refresh } _ = do
-- enabled <- T.useBox true
pure $ H.div {} [] {- { className: "update-button "
<> if (fst enabled) then "enabled" else "disabled text-muted"
} [ H.span { className: "fa fa-refresh"
, on: { click: onClick enabled } } []
]
where
onClick (false /\ _) _ = pure unit
onClick (true /\ setEnabled) _ = do
launchAff_ $ do
liftEffect $ setEnabled $ const false
_ <- NTAPI.updateNodeList { listId, nodeId, nodeType, session }
liftEffect $ setEnabled $ const true
refresh unit
pure unit
-}
Forms.purs 0000664 0000000 0000000 00000001201 14111104351 0032455 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components module Gargantext.Components.Forms where
import Record as Record
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Utils.Reactix as R2
clearfix :: R.Element
clearfix = H.div { className: "clearfix" } []
formGroup :: Array R.Element -> R.Element
formGroup = H.div { className: "form-group" }
center :: Array R.Element -> R.Element
center = H.div { className: "center" }
card :: Array R.Element -> R.Element
card = H.div { className: "card" }
cardBlock :: Array R.Element -> R.Element
cardBlock = H.div { className: "card-block" }
cardGroup :: Array R.Element -> R.Element
cardGroup = H.div { className: "card-group" }
Graph.purs 0000664 0000000 0000000 00000030175 14111104351 0032444 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components module Gargantext.Components.Graph
-- ( graph, graphCpt
-- , sigmaSettings, SigmaSettings, SigmaOptionalSettings
-- , forceAtlas2Settings, ForceAtlas2Settings, ForceAtlas2OptionalSettings
-- )
where
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable)
import DOM.Simple.Types (Element)
import Reactix as R
import Reactix.DOM.HTML as RH
import Record as Record
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Graph"
type OnProps = ()
data Stage = Init | Ready | Cleanup
derive instance Generic Stage _
derive instance Eq Stage
type Props sigma forceatlas2 =
( elRef :: R.Ref (Nullable Element)
, forceAtlas2Settings :: forceatlas2
, graph :: SigmaxTypes.SGraph
, mCamera :: Maybe GET.Camera
, multiSelectEnabledRef :: R.Ref Boolean
, selectedNodeIds :: T.Box SigmaxTypes.NodeIds
, showEdges :: T.Box SigmaxTypes.ShowEdgesState
, sigmaRef :: R.Ref Sigmax.Sigma
, sigmaSettings :: sigma
, stage :: T.Box Stage
, startForceAtlas :: Boolean
, transformedGraph :: SigmaxTypes.SGraph
)
graph :: forall s fa2. R2.Component (Props s fa2)
graph = R.createElement graphCpt
graphCpt :: forall s fa2. R.Component (Props s fa2)
graphCpt = here.component "graph" cpt where
cpt props@{ elRef
, showEdges
, sigmaRef
, stage } _ = do
showEdges' <- T.useLive T.unequal showEdges
stage' <- T.useLive T.unequal stage
stageHooks (Record.merge { showEdges', stage' } props)
R.useEffectOnce $ do
pure $ do
here.log "[graphCpt (Cleanup)]"
Sigmax.dependOnSigma (R.readRef sigmaRef) "[graphCpt (Cleanup)] no sigma" $ \sigma -> do
Sigma.stopForceAtlas2 sigma
here.log2 "[graphCpt (Cleanup)] forceAtlas stopped for" sigma
Sigma.kill sigma
here.log "[graphCpt (Cleanup)] sigma killed"
-- NOTE: This div is not empty after sigma initializes.
-- When we change state, we make it empty though.
--pure $ RH.div { ref: elRef, style: {height: "95%"} } []
pure $ case R.readNullableRef elRef of
Nothing -> RH.div {} []
Just el -> R.createPortal [] el
stageHooks { elRef
, mCamera
, multiSelectEnabledRef
, selectedNodeIds
, forceAtlas2Settings: fa2
, graph: graph'
, sigmaRef
, stage
, stage': Init
, startForceAtlas } = do
R.useEffectOnce' $ do
let rSigma = R.readRef sigmaRef
case Sigmax.readSigma rSigma of
Nothing -> do
eSigma <- Sigma.sigma {settings: sigmaSettings}
case eSigma of
Left err -> here.log2 "[graphCpt] error creating sigma" err
Right sig -> do
Sigmax.writeSigma rSigma $ Just sig
Sigmax.dependOnContainer elRef "[graphCpt (Ready)] container not found" $ \c -> do
_ <- Sigma.addRenderer sig {
"type": "canvas"
, container: c
, additionalContexts: ["mouseSelector"]
}
pure unit
Sigmax.refreshData sig $ Sigmax.sigmafy graph'
Sigmax.dependOnSigma (R.readRef sigmaRef) "[graphCpt (Ready)] no sigma" $ \sigma -> do
-- bind the click event only initially, when ref was empty
Sigmax.bindSelectedNodesClick sigma selectedNodeIds multiSelectEnabledRef
_ <- Sigma.bindMouseSelectorPlugin sigma
pure unit
Sigmax.setEdges sig false
-- here.log2 "[graph] startForceAtlas" startForceAtlas
if startForceAtlas then
Sigma.startForceAtlas2 sig fa2
else
Sigma.stopForceAtlas2 sig
case mCamera of
Nothing -> pure unit
Just (GET.Camera { ratio, x, y }) -> do
Sigma.updateCamera sig { ratio, x, y }
pure unit
Just _sig -> do
pure unit
T.write Ready stage
stageHooks { showEdges'
, sigmaRef
, stage': Ready
, transformedGraph } = do
let tEdgesMap = SigmaxTypes.edgesGraphMap transformedGraph
let tNodesMap = SigmaxTypes.nodesGraphMap transformedGraph
-- TODO Probably this can be optimized to re-mark selected nodes only when they changed
R.useEffect' $ do
Sigmax.dependOnSigma (R.readRef sigmaRef) "[graphCpt (Ready)] no sigma" $ \sigma -> do
Sigmax.performDiff sigma transformedGraph
Sigmax.updateEdges sigma tEdgesMap
Sigmax.updateNodes sigma tNodesMap
let edgesState = not $ SigmaxTypes.edgeStateHidden showEdges'
here.log2 "[graphCpt] edgesState" edgesState
Sigmax.setEdges sigma edgesState
stageHooks _ = pure unit
type SigmaSettings =
( animationsTime :: Number
, autoRescale :: Boolean
, autoResize :: Boolean
, batchEdgesDrawing :: Boolean
, borderSize :: Number
-- , canvasEdgesBatchSize :: Number
-- , clone :: Boolean
-- , defaultEdgeColor :: String
, defaultEdgeHoverColor :: String
, defaultEdgeType :: String
, defaultHoverLabelBGColor :: String
, defaultHoverLabelColor :: String
, defaultLabelColor :: String
-- , defaultLabelHoverColor :: String
, defaultLabelSize :: Number
, defaultNodeBorderColor :: String
, defaultNodeColor :: String
-- , defaultNodeHoverColor :: String
-- , defaultNodeType :: String
, doubleClickEnabled :: Boolean
-- , doubleClickTimeout :: Number
-- , doubleClickZoomDuration :: Number
-- , doubleClickZoomingRatio :: Number
-- , doubleTapTimeout :: Number
-- , dragTimeout :: Number
, drawEdgeLabels :: Boolean
, drawEdges :: Boolean
, drawLabels :: Boolean
, drawNodes :: Boolean
-- , edgeColor :: String
, edgeHoverColor :: String
, edgeHoverExtremities :: Boolean
, edgeHoverPrecision :: Number
, edgeHoverSizeRatio :: Number
-- , edgesPowRatio :: Number
-- , enableCamera :: Boolean
, enableEdgeHovering :: Boolean
, enableHovering :: Boolean
-- , eventsEnabled :: Boolean
, font :: String
, fontStyle :: String
, hideEdgesOnMove :: Boolean
-- , hoverFont :: String
-- , hoverFontStyle :: String
-- , immutable :: Boolean
-- , labelColor :: String
-- , labelHoverBGColor :: String
-- , labelHoverColor :: String
-- , labelHoverShadow :: String
-- , labelHoverShadowColor :: String
, labelSize :: String
, labelSizeRatio :: Number
, labelThreshold :: Number
, maxEdgeSize :: Number
, maxNodeSize :: Number
-- , minArrowSize :: Number
, minEdgeSize :: Number
, minNodeSize :: Number
, mouseEnabled :: Boolean
-- , mouseInertiaDuration :: Number
-- , mouseInertiaRatio :: Number
, mouseSelectorSize :: Number
-- , mouseWheelEnabled :: Boolean
, mouseZoomDuration :: Number
, nodeBorderColor :: String
-- , nodeHoverColor :: String
--, nodesPowRatio :: Number
, rescaleIgnoreSize :: Boolean
-- , scalingMode :: String
-- , sideMargin :: Number
, singleHover :: Boolean
-- , skipErrors :: Boolean
, touchEnabled :: Boolean
-- , touchInertiaDuration :: Number
-- , touchInertiaRatio :: Number
, twBorderGreyColor :: String
, twEdgeDefaultOpacity :: Number
, twEdgeGreyColor :: String
, twNodeRendBorderColor :: String
, twNodeRendBorderSize :: Number
, twNodesGreyOpacity :: Number
, twSelectedColor :: String
, verbose :: Boolean
-- , webglEdgesBatchSize :: Number
-- , webglOversamplingRatio :: Number
, zoomMax :: Number
, zoomMin :: Number
, zoomingRatio :: Number
)
-- not selected <=> (1-greyness)
-- selected nodes <=> special label
sigmaSettings :: {|SigmaSettings}
sigmaSettings =
{ animationsTime : 30000.0
, autoRescale : true
, autoResize : true
, batchEdgesDrawing : true
, borderSize : 1.0 -- for ex, bigger border when hover
, defaultEdgeHoverColor : "#f00"
, defaultEdgeType : "curve" -- 'curve' or 'line' (curve iff ourRendering)
, defaultHoverLabelBGColor : "#fff"
, defaultHoverLabelColor : "#000"
, defaultLabelColor : "#000" -- labels text color
, defaultLabelSize : 15.0 -- (old tina: showLabelsIfZoom)
, defaultNodeBorderColor : "#000" -- <- if nodeBorderColor = 'default'
, defaultNodeColor : "#FFF"
, doubleClickEnabled : false -- indicates whether or not the graph can be zoomed on double-click
, drawEdgeLabels : true
, drawEdges : true
, drawLabels : true
, drawNodes : true
, enableEdgeHovering : false
, edgeHoverExtremities : true
, edgeHoverColor : "edge"
, edgeHoverPrecision : 2.0
, edgeHoverSizeRatio : 2.0
, enableHovering : true
, font : "arial"
, fontStyle : ""
, hideEdgesOnMove : true
, labelSize : "proportional" -- alt : proportional, fixed
-- , labelSize : "fixed"
, labelSizeRatio : 2.0 -- label size in ratio of node size
, labelThreshold : 9.0 -- 5.0 for more labels -- min node cam size to start showing label
, maxEdgeSize : 1.0
, maxNodeSize : 10.0
, minEdgeSize : 0.5 -- in fact used in tina as edge size
, minNodeSize : 1.0
, mouseEnabled : true
, mouseSelectorSize : 15.0
, mouseZoomDuration : 150.0
, nodeBorderColor : "default" -- choices: "default" color vs. "node" color
--, nodesPowRatio : 10.8
, rescaleIgnoreSize : false
, singleHover : true
, touchEnabled : true
, twBorderGreyColor : "rgba(100, 100, 100, 0.9)"
, twEdgeDefaultOpacity : 0.4 -- initial opacity added to src/tgt colors
, twEdgeGreyColor : "rgba(100, 100, 100, 0.25)"
, twNodeRendBorderColor : "#FFF"
, twNodeRendBorderSize : 2.5 -- node borders (only iff ourRendering)
, twNodesGreyOpacity : 5.5 -- smaller value: more grey
, twSelectedColor : "node" -- "node" for a label bg like the node color, "default" for white background
, verbose : true
, zoomMax : 1.7
, zoomMin : 0.0
, zoomingRatio : 1.4
}
type ForceAtlas2Settings =
( adjustSizes :: Boolean
, barnesHutOptimize :: Boolean
-- , barnesHutTheta :: Number
, batchEdgesDrawing :: Boolean
, edgeWeightInfluence :: Number
-- , fixedY :: Boolean
, hideEdgesOnMove :: Boolean
, gravity :: Number
, includeHiddenEdges :: Boolean
, includeHiddenNodes :: Boolean
, iterationsPerRender :: Number
, linLogMode :: Boolean
, outboundAttractionDistribution :: Boolean
, scalingRatio :: Number
, skipHidden :: Boolean
, slowDown :: Number
, startingIterations :: Number
, strongGravityMode :: Boolean
-- , timeout :: Number
-- , worker :: Boolean
)
forceAtlas2Settings :: {|ForceAtlas2Settings}
forceAtlas2Settings =
{ adjustSizes : true
, barnesHutOptimize : true
, batchEdgesDrawing : true
, edgeWeightInfluence : 1.0
-- fixedY : false
, gravity : 0.01
, hideEdgesOnMove : true
, includeHiddenEdges : false
, includeHiddenNodes : true
, iterationsPerRender : 50.0 -- 10.0
, linLogMode : false -- false
, outboundAttractionDistribution : false
, scalingRatio : 1000.0
, skipHidden : false
, slowDown : 1.0
, startingIterations : 10.0
, strongGravityMode : false
}
GraphExplorer.purs 0000664 0000000 0000000 00000034075 14111104351 0034170 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components module Gargantext.Components.GraphExplorer where
import Gargantext.Prelude hiding (max, min)
import Data.Array as A
import Data.Either (Either)
import Data.FoldableWithIndex (foldMapWithIndex)
import Data.Int (toNumber)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromJust, maybe)
import Data.Nullable (null, Nullable)
import Data.Sequence as Seq
import Data.Set as Set
import Data.Tuple (Tuple(..))
import DOM.Simple.Types (Element)
import Effect.Aff (Aff)
import Math as Math
import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as RH
import Record as Record
import Record.Extra as RX
import Toestand as T
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Graph as Graph
import Gargantext.Components.GraphExplorer.Controls as Controls
import Gargantext.Components.GraphExplorer.Sidebar.Types as GEST
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Config.REST (RESTError)
import Gargantext.Data.Louvain as Louvain
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Hooks.Sigmax.Types as SigmaxT
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, get)
import Gargantext.Types as Types
import Gargantext.Utils.Range as Range
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer"
type BaseProps =
( boxes :: Boxes
, graphId :: GET.GraphId
)
type LayoutProps =
( session :: Session
| BaseProps )
type Props =
( graph :: SigmaxT.SGraph
, hyperdataGraph :: GET.HyperdataGraph
| LayoutProps
)
type GraphWriteProps =
( mMetaData' :: Maybe GET.MetaData
| Props
)
--------------------------------------------------------------
explorerLayout :: R2.Component LayoutProps
explorerLayout = R.createElement explorerLayoutCpt
explorerLayoutCpt :: R.Component LayoutProps
explorerLayoutCpt = here.component "explorerLayout" cpt where
cpt props@{ boxes: { graphVersion }, graphId, session } _ = do
graphVersion' <- T.useLive T.unequal graphVersion
useLoader { errorHandler
, loader: getNodes session graphVersion'
, path: graphId
, render: handler }
where
errorHandler err = here.log2 "[explorerLayout] RESTError" err
handler loaded@(GET.HyperdataGraph { graph: hyperdataGraph }) =
explorerWriteGraph (Record.merge props { graph, hyperdataGraph: loaded, mMetaData' }) []
where
Tuple mMetaData' graph = convert hyperdataGraph
explorerWriteGraph :: R2.Component GraphWriteProps
explorerWriteGraph = R.createElement explorerWriteGraphCpt
explorerWriteGraphCpt :: R.Component GraphWriteProps
explorerWriteGraphCpt = here.component "explorerWriteGraph" cpt where
cpt props@{ boxes: { sidePanelGraph }
, graph
, mMetaData' } _ = do
R.useEffectOnce' $ do
T.write_ (Just { mGraph: Just graph
, mMetaData: mMetaData'
, multiSelectEnabled: false
, removedNodeIds: Set.empty
, selectedNodeIds: Set.empty
, showControls: false
, sideTab: GET.SideTabLegend }) sidePanelGraph
pure $ explorer (RX.pick props :: Record Props) []
--------------------------------------------------------------
explorer :: R2.Component Props
explorer = R.createElement explorerCpt
explorerCpt :: R.Component Props
explorerCpt = here.component "explorer" cpt
where
cpt { boxes: { graphVersion, handed, reloadForest, showTree, sidePanelGraph, sidePanelState }
, graph
, graphId
, hyperdataGraph
, session
} _ = do
{ mMetaData } <- GEST.focusedSidePanel sidePanelGraph
_graphVersion' <- T.useLive T.unequal graphVersion
handed' <- T.useLive T.unequal handed
mMetaData' <- T.useLive T.unequal mMetaData
let startForceAtlas = maybe true (\(GET.MetaData { startForceAtlas: sfa }) -> sfa) mMetaData'
let forceAtlasS = if startForceAtlas
then SigmaxT.InitialRunning
else SigmaxT.InitialStopped
_dataRef <- R.useRef graph
graphRef <- R.useRef null
controls <- Controls.useGraphControls { forceAtlasS
, graph
, graphId
, hyperdataGraph
, reloadForest
, session
, showTree
, sidePanel: sidePanelGraph
, sidePanelState }
-- graphVersionRef <- R.useRef graphVersion'
-- R.useEffect' $ do
-- let readData = R.readRef dataRef
-- let gv = R.readRef graphVersionRef
-- if SigmaxT.eqGraph readData graph then
-- pure unit
-- else do
-- -- Graph data changed, reinitialize sigma.
-- let rSigma = R.readRef controls.sigmaRef
-- Sigmax.cleanupSigma rSigma "explorerCpt"
-- R.setRef dataRef graph
-- R.setRef graphVersionRef graphVersion'
-- -- Reinitialize bunch of state as well.
-- T.write_ SigmaxT.emptyNodeIds controls.removedNodeIds
-- T.write_ SigmaxT.emptyNodeIds controls.selectedNodeIds
-- T.write_ SigmaxT.EShow controls.showEdges
-- T.write_ forceAtlasS controls.forceAtlasState
-- T.write_ Graph.Init controls.graphStage
-- T.write_ Types.InitialClosed controls.sidePanelState
pure $
RH.div { className: "graph-meta-container" }
[ RH.div { className: "graph-container" }
[ RH.div { className: "container-fluid " <> hClass handed' }
[ RH.div { id: "controls-container" } [ Controls.controls controls [] ]
, RH.div { className: "row graph-row" }
[ RH.div { ref: graphRef, id: "graph-view", className: "col-md-12" } []
, graphView { controls
, elRef: graphRef
, graph
, hyperdataGraph
, mMetaData
} []
]
]
]
]
hClass h = case h of
Types.LeftHanded -> "lefthanded"
Types.RightHanded -> "righthanded"
type GraphProps = (
controls :: Record Controls.Controls
, elRef :: R.Ref (Nullable Element)
, graph :: SigmaxT.SGraph
, hyperdataGraph :: GET.HyperdataGraph
, mMetaData :: T.Box (Maybe GET.MetaData)
)
graphView :: R2.Component GraphProps
graphView = R.createElement graphViewCpt
graphViewCpt :: R.Component GraphProps
graphViewCpt = here.component "graphView" cpt
where
cpt { controls
, elRef
, graph
, hyperdataGraph: GET.HyperdataGraph { mCamera }
, mMetaData } _children = do
edgeConfluence' <- T.useLive T.unequal controls.edgeConfluence
edgeWeight' <- T.useLive T.unequal controls.edgeWeight
mMetaData' <- T.useLive T.unequal mMetaData
multiSelectEnabled' <- T.useLive T.unequal controls.multiSelectEnabled
nodeSize' <- T.useLive T.unequal controls.nodeSize
removedNodeIds' <- T.useLive T.unequal controls.removedNodeIds
selectedNodeIds' <- T.useLive T.unequal controls.selectedNodeIds
showEdges' <- T.useLive T.unequal controls.showEdges
showLouvain' <- T.useLive T.unequal controls.showLouvain
multiSelectEnabledRef <- R.useRef multiSelectEnabled'
-- TODO Cache this?
let louvainGraph =
if showLouvain' then
let louvain = Louvain.louvain unit in
let cluster = Louvain.init louvain (SigmaxT.louvainNodes graph) (SigmaxT.louvainEdges graph) in
SigmaxT.louvainGraph graph cluster
else
graph
let transformedGraph = transformGraph louvainGraph { edgeConfluence'
, edgeWeight'
, nodeSize'
, removedNodeIds'
, selectedNodeIds'
, showEdges' }
let startForceAtlas = maybe true (\(GET.MetaData { startForceAtlas: sfa }) -> sfa) mMetaData'
R.useEffect1' multiSelectEnabled' $ do
R.setRef multiSelectEnabledRef multiSelectEnabled'
pure $ Graph.graph { elRef
, forceAtlas2Settings: Graph.forceAtlas2Settings
, graph
, mCamera
, multiSelectEnabledRef
, selectedNodeIds: controls.selectedNodeIds
, showEdges: controls.showEdges
, sigmaRef: controls.sigmaRef
, sigmaSettings: Graph.sigmaSettings
, stage: controls.graphStage
, startForceAtlas
, transformedGraph
} []
convert :: GET.GraphData -> Tuple (Maybe GET.MetaData) SigmaxT.SGraph
convert (GET.GraphData r) = Tuple r.metaData $ SigmaxT.Graph {nodes, edges}
where
nodes = foldMapWithIndex nodeFn r.nodes
nodeFn _i nn@(GET.Node n) =
Seq.singleton {
borderColor: color
, color : color
, equilateral: { numPoints: 3 }
, gargType
, hidden : false
, id : n.id_
, label : n.label
, size : Math.log (toNumber n.size + 1.0)
, type : modeGraphType gargType
, x : n.x -- cos (toNumber i)
, y : n.y -- sin (toNumber i)
, _original: nn
}
where
cDef (GET.Cluster {clustDefault}) = clustDefault
color = GET.intColor (cDef n.attributes)
gargType = unsafePartial $ fromJust $ Types.modeFromString n.type_
nodesMap = SigmaxT.nodesMap nodes
edges = foldMapWithIndex edgeFn $ A.sortWith (\(GET.Edge {weight}) -> weight) r.edges
edgeFn i ee@(GET.Edge e) =
Seq.singleton
{ id : e.id_
, color
, confluence : e.confluence
, hidden : false
, size: 1.0
, source : e.source
, sourceNode
, target : e.target
, targetNode
, weight : e.weight
, weightIdx: i
, _original: ee
}
where
sourceNode = unsafePartial $ fromJust $ Map.lookup e.source nodesMap
targetNode = unsafePartial $ fromJust $ Map.lookup e.target nodesMap
color = sourceNode.color
-- | See sigmajs/plugins/sigma.renderers.customShapes/shape-library.js
modeGraphType :: Types.Mode -> String
modeGraphType Types.Authors = "square"
modeGraphType Types.Institutes = "equilateral"
modeGraphType Types.Sources = "star"
modeGraphType Types.Terms = "def"
getNodes :: Session -> T2.Reload -> GET.GraphId -> Aff (Either RESTError GET.HyperdataGraph)
getNodes session graphVersion graphId =
get session $ NodeAPI Types.Graph
(Just graphId)
("?version=" <> (show graphVersion))
type LiveProps = (
edgeConfluence' :: Range.NumberRange
, edgeWeight' :: Range.NumberRange
, nodeSize' :: Range.NumberRange
, removedNodeIds' :: SigmaxT.NodeIds
, selectedNodeIds' :: SigmaxT.NodeIds
, showEdges' :: SigmaxT.ShowEdgesState
)
transformGraph :: SigmaxT.SGraph -> Record LiveProps -> SigmaxT.SGraph
transformGraph graph { edgeConfluence'
, edgeWeight'
, nodeSize'
, removedNodeIds'
, selectedNodeIds' } = SigmaxT.Graph {nodes: newNodes, edges: newEdges}
where
edges = SigmaxT.graphEdges graph
nodes = SigmaxT.graphNodes graph
selectedEdgeIds =
Set.fromFoldable
$ Seq.map _.id
$ SigmaxT.neighbouringEdges graph selectedNodeIds'
hasSelection = not $ Set.isEmpty selectedNodeIds'
newEdges' = Seq.filter edgeFilter $ Seq.map (
-- NOTE We don't use edgeShowFilter anymore because of
-- https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/304
-- edgeHideWeight <<< edgeHideConfluence <<< edgeShowFilter <<< edgeMarked
edgeHideWeight <<< edgeHideConfluence <<< edgeMarked
) edges
newNodes = Seq.filter nodeFilter $ Seq.map (nodeMarked <<< nodeHideSize) nodes
newEdges = Seq.filter (edgeInGraph $ Set.fromFoldable $ Seq.map _.id newNodes) newEdges'
edgeFilter _e = true
nodeFilter n = nodeRemovedFilter n
nodeRemovedFilter { id } = not $ Set.member id removedNodeIds'
edgeHideConfluence :: Record SigmaxT.Edge -> Record SigmaxT.Edge
edgeHideConfluence edge@{ confluence } =
if Range.within edgeConfluence' confluence then
edge
else
edge { hidden = true }
edgeHideWeight :: Record SigmaxT.Edge -> Record SigmaxT.Edge
edgeHideWeight edge@{ weightIdx } =
if Range.within edgeWeight' $ toNumber weightIdx then
edge
else
edge { hidden = true }
edgeInGraph :: SigmaxT.NodeIds -> Record SigmaxT.Edge -> Boolean
edgeInGraph nodeIds e = (Set.member e.source nodeIds) && (Set.member e.target nodeIds)
edgeMarked :: Record SigmaxT.Edge -> Record SigmaxT.Edge
edgeMarked edge@{ id, sourceNode } = do
let isSelected = Set.member id selectedEdgeIds
case Tuple hasSelection isSelected of
Tuple false true -> edge { color = "#ff0000" }
Tuple true true -> edge { color = sourceNode.color }
Tuple true false -> edge { color = "rgba(221, 221, 221, 0.5)" }
_ -> edge
nodeMarked :: Record SigmaxT.Node -> Record SigmaxT.Node
nodeMarked node@{ id } =
if Set.member id selectedNodeIds' then
node { borderColor = "#000", type = "selected" }
else
node
nodeHideSize :: Record SigmaxT.Node -> Record SigmaxT.Node
nodeHideSize node@{ size } =
if Range.within nodeSize' size then
node
else
node { hidden = true }
GraphExplorer/ 0000775 0000000 0000000 00000000000 14111104351 0033244 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components API.purs 0000664 0000000 0000000 00000005223 14111104351 0034572 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/GraphExplorer module Gargantext.Components.GraphExplorer.API where
import Gargantext.Prelude
import Data.Either (Either(..))
import Data.Maybe (Maybe)
import Effect.Aff (Aff)
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Sigmax.Types as SigmaxT
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, get, post)
import Gargantext.Types as GT
type GraphAsyncUpdateParams =
( graphId :: Int
, listId :: Int
, nodes :: Array (Record SigmaxT.Node)
, session :: Session
, termList :: GT.TermList
, version :: NTC.Version
)
graphAsyncUpdate :: Record GraphAsyncUpdateParams -> Aff (Either RESTError GT.AsyncTaskWithType)
graphAsyncUpdate { graphId, listId, nodes, session, termList, version } = do
eTask <- post session p q
pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.GraphRecompute }) <$> eTask
where
p = GR.GraphAPI graphId $ GT.asyncTaskTypePath GT.GraphRecompute
q = { listId
, nodes
, termList
, version
}
type GraphAsyncRecomputeParams =
( graphId :: Int
, session :: Session
)
graphAsyncRecompute :: Record GraphAsyncRecomputeParams -> Aff (Either RESTError GT.AsyncTaskWithType)
graphAsyncRecompute { graphId, session } = do
eTask <- post session p q
pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.GraphRecompute }) <$> eTask
where
p = GR.GraphAPI graphId $ GT.asyncTaskTypePath GT.GraphRecompute
q = {}
type QueryProgressParams =
( graphId :: Int
, session :: Session
, taskId :: String
)
queryProgress :: Record QueryProgressParams -> Aff (Either RESTError GT.AsyncProgress)
queryProgress { graphId, session, taskId } = do
get session $ GR.GraphAPI graphId $ "async/" <> taskId <> "/poll"
type GraphVersions =
( gv_graph :: Maybe Int
, gv_repo :: Int
)
type GraphVersionsParams =
( graphId :: Int
, session :: Session
)
graphVersions :: Record GraphVersionsParams -> Aff (Either RESTError (Record GraphVersions))
graphVersions { graphId, session } = get session $ GR.GraphAPI graphId $ "versions"
type UpdateGraphVersionsParams =
( graphId :: Int
, session :: Session
)
updateGraphVersions :: Record UpdateGraphVersionsParams -> Aff (Either RESTError GET.GraphData)
updateGraphVersions { graphId, session } = post session (GR.GraphAPI graphId $ "versions") {}
type CloneGraphParams =
( hyperdataGraph :: GET.HyperdataGraph
, id :: Int
, session :: Session
)
cloneGraph :: Record CloneGraphParams -> Aff (Either RESTError Int)
cloneGraph { hyperdataGraph, id, session } = post session (GR.GraphAPI id $ "clone") hyperdataGraph
Button.purs 0000664 0000000 0000000 00000010232 14111104351 0035430 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/GraphExplorer module Gargantext.Components.GraphExplorer.Button
( Props, centerButton, simpleButton, cameraButton ) where
import Prelude
import Data.Either (Either(..))
import Data.Enum (fromEnum)
import Data.Maybe (Maybe(..))
import Data.DateTime as DDT
import Data.DateTime.Instant as DDI
import Data.String as DS
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Effect.Now as EN
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadArbitraryDataURL)
import Gargantext.Components.GraphExplorer.API (cloneGraph)
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.GraphExplorer.Utils as GEU
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Sessions (Session)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.Button"
type Props = (
onClick :: forall e. e -> Effect Unit
, text :: String
)
simpleButton :: Record Props -> R.Element
simpleButton props = R.createElement simpleButtonCpt props []
simpleButtonCpt :: R.Component Props
simpleButtonCpt = here.component "simpleButton" cpt
where
cpt {onClick, text} _ = do
pure $ H.button { className: "btn btn-outline-primary"
, on: {click: onClick}
} [ R2.small {} [ H.text text ] ]
centerButton :: R.Ref Sigmax.Sigma -> R.Element
centerButton sigmaRef = simpleButton {
onClick: \_ -> do
let sigma = R.readRef sigmaRef
Sigmax.dependOnSigma sigma "[centerButton] sigma: Nothing" $ \s ->
Sigma.goToAllCameras s {x: 0.0, y: 0.0, ratio: 1.0, angle: 0.0}
, text: "Center"
}
type CameraButtonProps =
( id :: Int
, hyperdataGraph :: GET.HyperdataGraph
, session :: Session
, sigmaRef :: R.Ref Sigmax.Sigma
, reloadForest :: T2.ReloadS
)
cameraButton :: Record CameraButtonProps -> R.Element
cameraButton { id
, hyperdataGraph: GET.HyperdataGraph { graph: GET.GraphData hyperdataGraph }
, session
, sigmaRef
, reloadForest } = simpleButton {
onClick: \_ -> do
let sigma = R.readRef sigmaRef
Sigmax.dependOnSigma sigma "[cameraButton] sigma: Nothing" $ \s -> do
screen <- Sigma.takeScreenshot s
now <- EN.now
let nowdt = DDI.toDateTime now
nowd = DDT.date nowdt
nowt = DDT.time nowdt
nowStr = DS.joinWith "-" [ show $ fromEnum $ DDT.year nowd
, show $ fromEnum $ DDT.month nowd
, show $ fromEnum $ DDT.day nowd
, show $ fromEnum $ DDT.hour nowt
, show $ fromEnum $ DDT.minute nowt
, show $ fromEnum $ DDT.second nowt ]
edges <- Sigmax.getEdges s
nodes <- Sigmax.getNodes s
let graphData = GET.GraphData $ hyperdataGraph { edges = map GEU.stEdgeToGET edges
, nodes = GEU.normalizeNodes $ map GEU.stNodeToGET nodes }
let cameras = map Sigma.toCamera $ Sigma.cameras s
let camera = case cameras of
[c] -> GET.Camera { ratio: c.ratio, x: c.x, y: c.y }
_ -> GET.Camera { ratio: 1.0, x: 0.0, y: 0.0 }
let hyperdataGraph' = GET.HyperdataGraph { graph: graphData, mCamera: Just camera }
launchAff_ $ do
eClonedGraphId <- cloneGraph { id, hyperdataGraph: hyperdataGraph', session }
case eClonedGraphId of
Left err -> liftEffect $ log2 "[cameraButton] RESTError" err
Right clonedGraphId -> do
eRet <- uploadArbitraryDataURL session clonedGraphId (Just $ nowStr <> "-" <> "screenshot.png") screen
case eRet of
Left err -> liftEffect $ log2 "[cameraButton] RESTError" err
Right _ret -> do
liftEffect $ T2.reload reloadForest
, text: "Screenshot"
}
Controls.purs 0000664 0000000 0000000 00000027445 14111104351 0035776 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/GraphExplorer module Gargantext.Components.GraphExplorer.Controls
( Controls
, useGraphControls
, controls
, controlsCpt
) where
import Data.Array as A
import Data.Int as I
import Data.Maybe (Maybe(..), maybe)
import Data.Sequence as Seq
import Data.Set as Set
import Effect.Timer (setTimeout)
import Prelude
import Reactix as R
import Reactix.DOM.HTML as RH
import Toestand as T
import Gargantext.Components.Graph as Graph
import Gargantext.Components.GraphExplorer.Button (centerButton, cameraButton)
import Gargantext.Components.GraphExplorer.RangeControl (edgeConfluenceControl, edgeWeightControl, nodeSizeControl)
import Gargantext.Components.GraphExplorer.SlideButton (labelSizeButton, mouseSelectorSizeButton)
import Gargantext.Components.GraphExplorer.ToggleButton (multiSelectEnabledButton, edgesToggleButton, louvainToggleButton, pauseForceAtlasButton, resetForceAtlasButton)
import Gargantext.Components.GraphExplorer.Sidebar.Types as GEST
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Types as SigmaxT
import Gargantext.Sessions (Session)
import Gargantext.Types as GT
import Gargantext.Utils.Range as Range
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.Controls"
type Controls =
( edgeConfluence :: T.Box Range.NumberRange
, edgeWeight :: T.Box Range.NumberRange
, forceAtlasState :: T.Box SigmaxT.ForceAtlasState
, graph :: SigmaxT.SGraph
, graphId :: GET.GraphId
, graphStage :: T.Box Graph.Stage
, hyperdataGraph :: GET.HyperdataGraph
, multiSelectEnabled :: T.Box Boolean
, nodeSize :: T.Box Range.NumberRange
, reloadForest :: T2.ReloadS
, removedNodeIds :: T.Box SigmaxT.NodeIds
, selectedNodeIds :: T.Box SigmaxT.NodeIds
, session :: Session
, showControls :: T.Box Boolean
, showEdges :: T.Box SigmaxT.ShowEdgesState
, showLouvain :: T.Box Boolean
, showTree :: T.Box Boolean
, sidePanelState :: T.Box GT.SidePanelState
, sideTab :: T.Box GET.SideTab
, sigmaRef :: R.Ref Sigmax.Sigma
)
type LocalControls = ( labelSize :: T.Box Number, mouseSelectorSize :: T.Box Number )
initialLocalControls :: R.Hooks (Record LocalControls)
initialLocalControls = do
labelSize <- T.useBox 14.0
mouseSelectorSize <- T.useBox 15.0
pure $ { labelSize, mouseSelectorSize }
controls :: R2.Component Controls
controls = R.createElement controlsCpt
controlsCpt :: R.Component Controls
controlsCpt = here.component "controls" cpt
where
cpt { edgeConfluence
, edgeWeight
, forceAtlasState
, graph
, graphId
, graphStage
, hyperdataGraph
, multiSelectEnabled
, nodeSize
, reloadForest
, selectedNodeIds
, session
, showControls
, showEdges
, showLouvain
, sidePanelState
, sideTab
, sigmaRef } _ = do
forceAtlasState' <- T.useLive T.unequal forceAtlasState
graphStage' <- T.useLive T.unequal graphStage
selectedNodeIds' <- T.useLive T.unequal selectedNodeIds
showControls' <- T.useLive T.unequal showControls
sidePanelState' <- T.useLive T.unequal sidePanelState
localControls <- initialLocalControls
-- ref to track automatic FA pausing
-- If user pauses FA before auto is triggered, clear the timeoutId
mFAPauseRef <- R.useRef Nothing
-- When graph is changed, cleanup the mFAPauseRef so that forceAtlas
-- timeout is retriggered.
R.useEffect' $ do
case graphStage' of
Graph.Init -> R.setRef mFAPauseRef Nothing
_ -> pure unit
-- Handle case when FA is paused from outside events, eg. the automatic timer.
R.useEffect' $ Sigmax.handleForceAtlas2Pause sigmaRef forceAtlasState mFAPauseRef Graph.forceAtlas2Settings
-- Handle automatic edge hiding when FA is running (to prevent flickering).
-- TODO Commented temporarily: this breaks forceatlas rendering after reset
-- NOTE This is a hack anyways. It's force atlas that should be fixed.
R.useEffect2' sigmaRef forceAtlasState' $ do
T.modify_ (SigmaxT.forceAtlasEdgeState forceAtlasState') showEdges
-- Automatic opening of sidebar when a node is selected (but only first time).
R.useEffect' $ do
if sidePanelState' == GT.InitialClosed && (not Set.isEmpty selectedNodeIds') then do
T.write_ GT.Opened sidePanelState
T.write_ GET.SideTabData sideTab
else
pure unit
-- Timer to turn off the initial FA. This is because FA eats up lot of
-- CPU, has memory leaks etc.
R.useEffect1' forceAtlasState' $ do
if forceAtlasState' == SigmaxT.InitialRunning then do
timeoutId <- setTimeout 9000 $ do
case forceAtlasState' of
SigmaxT.InitialRunning ->
T.write_ SigmaxT.Paused forceAtlasState
_ -> pure unit
R.setRef mFAPauseRef Nothing
R.setRef mFAPauseRef $ Just timeoutId
pure unit
else
pure unit
let edgesConfluenceSorted = A.sortWith (_.confluence) $ Seq.toUnfoldable $ SigmaxT.graphEdges graph
let edgeConfluenceMin = maybe 0.0 _.confluence $ A.head edgesConfluenceSorted
let edgeConfluenceMax = maybe 100.0 _.confluence $ A.last edgesConfluenceSorted
let edgeConfluenceRange = Range.Closed { min: edgeConfluenceMin, max: edgeConfluenceMax }
--let edgesWeightSorted = A.sortWith (_.weight) $ Seq.toUnfoldable $ SigmaxT.graphEdges graph
--let edgeWeightMin = maybe 0.0 _.weight $ A.head edgesWeightSorted
--let edgeWeightMax = maybe 100.0 _.weight $ A.last edgesWeightSorted
--let edgeWeightRange = Range.Closed { min: edgeWeightMin, max: edgeWeightMax }
let edgeWeightRange = Range.Closed {
min: 0.0
, max: I.toNumber $ Seq.length $ SigmaxT.graphEdges graph
}
let nodesSorted = A.sortWith (_.size) $ Seq.toUnfoldable $ SigmaxT.graphNodes graph
let nodeSizeMin = maybe 0.0 _.size $ A.head nodesSorted
let nodeSizeMax = maybe 100.0 _.size $ A.last nodesSorted
let nodeSizeRange = Range.Closed { min: nodeSizeMin, max: nodeSizeMax }
let className = "navbar navbar-expand-lg " <> if showControls' then "" else "d-none"
pure $ RH.nav { className }
[ RH.ul { className: "navbar-nav mx-auto" }
[ -- change type button (?)
navItem [ centerButton sigmaRef ]
, navItem [ resetForceAtlasButton { forceAtlasState, sigmaRef } [] ]
, navItem [ pauseForceAtlasButton { state: forceAtlasState } [] ]
, navItem [ edgesToggleButton { state: showEdges } [] ]
, navItem [ louvainToggleButton { state: showLouvain } [] ]
, navItem [ edgeConfluenceControl { range: edgeConfluenceRange
, state: edgeConfluence } [] ]
, navItem [ edgeWeightControl { range: edgeWeightRange
, state: edgeWeight } [] ]
-- change level
-- file upload
-- run demo
-- search button
-- search topics
, navItem [ labelSizeButton sigmaRef localControls.labelSize ] -- labels size: 1-4
, navItem [ nodeSizeControl { range: nodeSizeRange
, state: nodeSize } [] ]
-- zoom: 0 -100 - calculate ratio
, navItem [ multiSelectEnabledButton { state: multiSelectEnabled } [] ] -- toggle multi node selection
-- save button
, navItem [ mouseSelectorSizeButton sigmaRef localControls.mouseSelectorSize ]
, navItem [ cameraButton { id: graphId
, hyperdataGraph: hyperdataGraph
, session: session
, sigmaRef: sigmaRef
, reloadForest } ]
]
]
where
navItem = RH.li { className: "nav-item" }
-- RH.ul {} [ -- change type button (?)
-- RH.li {} [ centerButton sigmaRef ]
-- , RH.li {} [ pauseForceAtlasButton {state: forceAtlasState} ]
-- , RH.li {} [ edgesToggleButton {state: showEdges} ]
-- , RH.li {} [ louvainToggleButton showLouvain ]
-- , RH.li {} [ edgeConfluenceControl edgeConfluenceRange edgeConfluence ]
-- , RH.li {} [ edgeWeightControl edgeWeightRange edgeWeight ]
-- -- change level
-- -- file upload
-- -- run demo
-- -- search button
-- -- search topics
-- , RH.li {} [ labelSizeButton sigmaRef localControls.labelSize ] -- labels size: 1-4
-- , RH.li {} [ nodeSizeControl nodeSizeRange nodeSize ]
-- -- zoom: 0 -100 - calculate ratio
-- , RH.li {} [ multiSelectEnabledButton multiSelectEnabled ] -- toggle multi node selection
-- -- save button
-- , RH.li {} [ nodeSearchControl { graph: graph
-- , multiSelectEnabled: multiSelectEnabled
-- , selectedNodeIds: selectedNodeIds } ]
-- , RH.li {} [ mouseSelectorSizeButton sigmaRef localControls.mouseSelectorSize ]
-- , RH.li {} [ cameraButton { id: graphId
-- , hyperdataGraph: hyperdataGraph
-- , session: session
-- , sigmaRef: sigmaRef
-- , reloadForest: reloadForest } ]
-- ]
-- ]
useGraphControls :: { forceAtlasS :: SigmaxT.ForceAtlasState
, graph :: SigmaxT.SGraph
, graphId :: GET.GraphId
, hyperdataGraph :: GET.HyperdataGraph
, reloadForest :: T2.ReloadS
, session :: Session
, showTree :: T.Box Boolean
, sidePanel :: T.Box (Maybe (Record GEST.SidePanel))
, sidePanelState :: T.Box GT.SidePanelState }
-> R.Hooks (Record Controls)
useGraphControls { forceAtlasS
, graph
, graphId
, hyperdataGraph
, reloadForest
, session
, showTree
, sidePanel
, sidePanelState } = do
edgeConfluence <- T.useBox $ Range.Closed { min: 0.0, max: 1.0 }
edgeWeight <- T.useBox $ Range.Closed {
min: 0.0
, max: I.toNumber $ Seq.length $ SigmaxT.graphEdges graph
}
forceAtlasState <- T.useBox forceAtlasS
graphStage <- T.useBox Graph.Init
nodeSize <- T.useBox $ Range.Closed { min: 0.0, max: 100.0 }
showEdges <- T.useBox SigmaxT.EShow
showLouvain <- T.useBox false
sigma <- Sigmax.initSigma
sigmaRef <- R.useRef sigma
{ multiSelectEnabled, removedNodeIds, selectedNodeIds, showControls, sideTab } <- GEST.focusedSidePanel sidePanel
pure { edgeConfluence
, edgeWeight
, forceAtlasState
, graph
, graphId
, graphStage
, hyperdataGraph
, multiSelectEnabled
, nodeSize
, removedNodeIds
, selectedNodeIds
, session
, showControls
, showEdges
, showLouvain
, sidePanelState
, showTree
, sideTab
, sigmaRef
, reloadForest
}
ControlsToggleButton.purs 0000664 0000000 0000000 00000001626 14111104351 0040325 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/GraphExplorer module Gargantext.Components.GraphExplorer.ControlsToggleButton
( Props, controlsToggleButton, controlsToggleButtonCpt
) where
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.ControlsToggleButton"
type Props = ( state :: T.Box Boolean )
controlsToggleButton :: R2.Leaf Props
controlsToggleButton props = R.createElement controlsToggleButtonCpt props []
controlsToggleButtonCpt :: R.Component Props
controlsToggleButtonCpt = here.component "controlsToggleButton" cpt
where
cpt { state } _ = do
open' <- T.useLive T.unequal state
pure $
H.button
{ className: "btn btn-primary", on: {click: \_ -> T.modify_ not state } }
[ H.text (text open') ]
text true = "Hide Controls"
text false = "Show Controls"
Legend.purs 0000664 0000000 0000000 00000001720 14111104351 0035355 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/GraphExplorer module Gargantext.Components.GraphExplorer.Legend
( Props, legend, legendCpt
) where
import Prelude hiding (map)
import Data.Sequence (Seq)
import Data.Traversable (foldMap)
import Reactix as R
import Reactix.DOM.HTML as RH
import Gargantext.Components.GraphExplorer.Types (Legend(..), intColor)
import Gargantext.Utils.Reactix as R2
here = R2.here "Gargantext.Components.GraphExplorer.Legend"
type Props = ( items :: Seq Legend )
legend :: Record Props -> R.Element
legend props = R.createElement legendCpt props []
legendCpt :: R.Component Props
legendCpt = here.component "legend" cpt
where
cpt {items} _ = pure $ RH.div {} [foldMap entry items]
entry :: Legend -> R.Element
entry (Legend {id_, label}) =
RH.p {}
[ RH.span { style: { width : 10
, height: 10
, backgroundColor: intColor id_
, display: "inline-block"
}
} []
, RH.text $ " " <> label
]
RangeControl.purs 0000664 0000000 0000000 00000006371 14111104351 0036563 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/GraphExplorer module Gargantext.Components.GraphExplorer.RangeControl
( Props
, rangeControl
, edgeConfluenceControl
, edgeWeightControl
, nodeSizeControl
) where
import Prelude
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Components.RangeSlider as RS
import Gargantext.Utils.Range as Range
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.RangeControl"
type Props = (
caption :: String
, sliderProps :: Record RS.Props
)
rangeControl :: R2.Component Props
rangeControl = R.createElement rangeControlCpt
rangeControlCpt :: R.Component Props
rangeControlCpt = here.component "rangeButton" cpt
where
cpt {caption, sliderProps} _ = do
pure $
H.span {className: "range text-center"}
[ H.label {} [ R2.small {} [ H.text caption ] ]
, RS.rangeSlider sliderProps
]
type EdgeConfluenceControlProps = (
range :: Range.NumberRange
, state :: T.Box Range.NumberRange
)
edgeConfluenceControl :: R2.Component EdgeConfluenceControlProps
edgeConfluenceControl = R.createElement edgeConfluenceControlCpt
edgeConfluenceControlCpt :: R.Component EdgeConfluenceControlProps
edgeConfluenceControlCpt = here.component "edgeConfluenceControl" cpt
where
cpt { range: Range.Closed { min, max }
, state } _ = do
state' <- T.useLive T.unequal state
pure $ rangeControl {
caption: "Edge Confluence Weight"
, sliderProps: {
bounds: Range.Closed { min, max }
, initialValue: state'
, epsilon: 0.01
, step: 1.0
, width: 10.0
, height: 5.0
, onChange: \rng -> T.write_ rng state
}
} []
type EdgeWeightControlProps = (
range :: Range.NumberRange
, state :: T.Box Range.NumberRange
)
edgeWeightControl :: R2.Component EdgeWeightControlProps
edgeWeightControl = R.createElement edgeWeightControlCpt
edgeWeightControlCpt :: R.Component EdgeWeightControlProps
edgeWeightControlCpt = here.component "edgeWeightControl" cpt
where
cpt { range: Range.Closed { min, max }
, state } _ = do
state' <- T.useLive T.unequal state
pure $ rangeControl {
caption: "Edge Weight"
, sliderProps: {
bounds: Range.Closed { min, max }
, initialValue: state'
, epsilon: 1.0
, step: 1.0
, width: 10.0
, height: 5.0
, onChange: \rng -> T.write_ rng state
}
} []
type NodeSideControlProps = (
range :: Range.NumberRange
, state :: T.Box Range.NumberRange
)
nodeSizeControl :: R2.Component NodeSideControlProps
nodeSizeControl = R.createElement nodeSizeControlCpt
nodeSizeControlCpt :: R.Component NodeSideControlProps
nodeSizeControlCpt = here.component "nodeSizeControl" cpt
where
cpt { range: Range.Closed { min, max }
, state } _ = do
state' <- T.useLive T.unequal state
pure $ rangeControl {
caption: "Node Size"
, sliderProps: {
bounds: Range.Closed { min, max }
, initialValue: state'
, epsilon: 0.1
, step: 1.0
, width: 10.0
, height: 5.0
, onChange: \rng -> T.write_ rng state
}
} []
Search.purs 0000664 0000000 0000000 00000005434 14111104351 0035372 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/GraphExplorer module Gargantext.Components.GraphExplorer.Search
( Props, nodeSearchControl ) where
import Prelude
import Data.Sequence as Seq
import Data.Set as Set
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Components.InputWithAutocomplete (inputWithAutocomplete)
import Gargantext.Hooks.Sigmax.Types as SigmaxT
import Gargantext.Utils (queryMatchesLabel)
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.Search"
type Props = (
graph :: SigmaxT.SGraph
, multiSelectEnabled :: T.Box Boolean
, selectedNodeIds :: T.Box SigmaxT.NodeIds
)
-- | Whether a node matches a search string
nodeMatchesSearch :: String -> Record SigmaxT.Node -> Boolean
nodeMatchesSearch s n = queryMatchesLabel s n.label
searchNodes :: String -> Seq.Seq (Record SigmaxT.Node) -> Seq.Seq (Record SigmaxT.Node)
searchNodes "" _ = Seq.empty
searchNodes s nodes = Seq.filter (nodeMatchesSearch s) nodes
nodeSearchControl :: R2.Component Props
nodeSearchControl = R.createElement sizeButtonCpt
sizeButtonCpt :: R.Component Props
sizeButtonCpt = here.component "nodeSearchControl" cpt
where
cpt { graph, multiSelectEnabled, selectedNodeIds } _ = do
search <- T.useBox ""
search' <- T.useLive T.unequal search
multiSelectEnabled' <- T.useLive T.unequal multiSelectEnabled
pure $ R.fragment
[ inputWithAutocomplete { autocompleteSearch: autocompleteSearch graph
, classes: "mx-2"
, onAutocompleteClick: \s -> triggerSearch graph s multiSelectEnabled' selectedNodeIds
, onEnterPress: \s -> triggerSearch graph s multiSelectEnabled' selectedNodeIds
, state: search } []
, H.div { className: "btn input-group-addon"
, on: { click: \_ -> triggerSearch graph search' multiSelectEnabled' selectedNodeIds }
}
[ H.span { className: "fa fa-search" } [] ]
]
autocompleteSearch :: SigmaxT.SGraph -> String -> Array String
autocompleteSearch graph s = Seq.toUnfoldable $ (_.label) <$> searchNodes s nodes
where
nodes = SigmaxT.graphNodes graph
triggerSearch :: SigmaxT.SGraph
-> String
-> Boolean
-> T.Box SigmaxT.NodeIds
-> Effect Unit
triggerSearch graph search multiSelectEnabled selectedNodeIds = do
let graphNodes = SigmaxT.graphNodes graph
let matching = Set.fromFoldable $ (_.id) <$> searchNodes search graphNodes
log2 "[triggerSearch] search" search
T.modify_ (\nodes ->
Set.union matching $ if multiSelectEnabled then nodes else SigmaxT.emptyNodeIds) selectedNodeIds
Sidebar.purs 0000664 0000000 0000000 00000041050 14111104351 0035530 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/GraphExplorer module Gargantext.Components.GraphExplorer.Sidebar
-- (Props, sidebar)
where
import Gargantext.Prelude
import Control.Parallel (parTraverse)
import Data.Array (head, last, concat)
import Data.Array as A
import Data.Either (Either(..))
import Data.Int (fromString)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromJust)
import Data.Sequence as Seq
import Data.Set as Set
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.GraphExplorer.Legend as Legend
import Gargantext.Components.GraphExplorer.Sidebar.Types as GEST
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.Lang (Lang(..))
import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Components.Nodes.Corpus.Graph.Tabs (tabs) as CGT
import Gargantext.Components.RandomText (words)
import Gargantext.Components.Search (SearchType(..), SearchQuery(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Data.Array (mapMaybe)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Sigmax.Types as SigmaxT
import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType, FrontendError(..), NodeID, TabSubType(..), TabType(..), TermList(..), modeTabType)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as H
import Reactix.DOM.HTML as RH
import Record as Record
import Record.Extra as RX
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.Sidebar"
type Common = (
boxes :: Boxes
, graphId :: NodeID
, metaData :: GET.MetaData
, session :: Session
)
type Props = (
frontends :: Frontends
, graph :: SigmaxT.SGraph
| Common
)
sidebar :: R2.Component Props
sidebar = R.createElement sidebarCpt
sidebarCpt :: R.Component Props
sidebarCpt = here.component "sidebar" cpt
where
cpt props@{ boxes: { sidePanelGraph } } _ = do
{ sideTab } <- GEST.focusedSidePanel sidePanelGraph
sideTab' <- T.useLive T.unequal sideTab
pure $ RH.div { id: "sp-container" }
[ sideTabNav { sideTab
, sideTabs: [GET.SideTabLegend, GET.SideTabData, GET.SideTabCommunity] } []
, case sideTab' of
GET.SideTabLegend -> sideTabLegend sideTabProps []
GET.SideTabData -> sideTabData sideTabProps []
GET.SideTabCommunity -> sideTabCommunity sideTabProps []
]
where
sideTabProps = RX.pick props :: Record Props
type SideTabNavProps = (
sideTab :: T.Box GET.SideTab
, sideTabs :: Array GET.SideTab
)
sideTabNav :: R2.Component SideTabNavProps
sideTabNav = R.createElement sideTabNavCpt
sideTabNavCpt :: R.Component SideTabNavProps
sideTabNavCpt = here.component "sideTabNav" cpt
where
cpt { sideTab, sideTabs } _ = do
sideTab' <- T.useLive T.unequal sideTab
pure $ R.fragment [ H.div { className: "text-primary center"} [H.text ""]
, H.div { className: "nav nav-tabs"} (liItem sideTab' <$> sideTabs)
-- , H.div {className: "center"} [ H.text "Doc sideTabs"]
]
where
liItem :: GET.SideTab -> GET.SideTab -> R.Element
liItem sideTab' tab =
H.div { className : "nav-item nav-link"
<> if tab == sideTab'
then " active"
else ""
, on: { click: \_ -> T.write_ tab sideTab }
} [ H.text $ show tab ]
sideTabLegend :: R2.Component Props
sideTabLegend = R.createElement sideTabLegendCpt
sideTabLegendCpt :: R.Component Props
sideTabLegendCpt = here.component "sideTabLegend" cpt
where
cpt { metaData: GET.MetaData { legend } } _ = do
pure $ H.div {}
[ Legend.legend { items: Seq.fromFoldable legend }
, documentation EN
]
sideTabData :: R2.Component Props
sideTabData = R.createElement sideTabDataCpt
sideTabDataCpt :: R.Component Props
sideTabDataCpt = here.component "sideTabData" cpt
where
cpt props@{ boxes: { sidePanelGraph } } _ = do
{ selectedNodeIds } <- GEST.focusedSidePanel sidePanelGraph
selectedNodeIds' <- T.useLive T.unequal selectedNodeIds
pure $ RH.div {}
[ selectedNodes (Record.merge { nodesMap: SigmaxT.nodesGraphMap props.graph } props) []
, neighborhood props []
, RH.div { className: "col-md-12", id: "query" }
[ query { frontends: props.frontends
, metaData: props.metaData
, nodesMap: SigmaxT.nodesGraphMap props.graph
, searchType: SearchDoc
, selectedNodeIds: selectedNodeIds'
, session: props.session
} []
]
]
sideTabCommunity :: R2.Component Props
sideTabCommunity = R.createElement sideTabCommunityCpt
sideTabCommunityCpt :: R.Component Props
sideTabCommunityCpt = here.component "sideTabCommunity" cpt
where
cpt props@{ boxes: { sidePanelGraph }
, frontends } _ = do
{ selectedNodeIds } <- GEST.focusedSidePanel sidePanelGraph
selectedNodeIds' <- T.useLive T.unequal selectedNodeIds
pure $ RH.div { className: "col-md-12", id: "query" }
[ selectedNodes (Record.merge { nodesMap: SigmaxT.nodesGraphMap props.graph } props) []
, neighborhood props []
, query { frontends
, metaData: props.metaData
, nodesMap: SigmaxT.nodesGraphMap props.graph
, searchType: SearchContact
, selectedNodeIds: selectedNodeIds'
, session: props.session
} []
]
-------------------------------------------
-- TODO
-- selectedNodes :: Record Props -> Map.Map String Nodes -> R.Element
type SelectedNodesProps = (
nodesMap :: SigmaxT.NodesMap
| Props
)
selectedNodes :: R2.Component SelectedNodesProps
selectedNodes = R.createElement selectedNodesCpt
selectedNodesCpt :: R.Component SelectedNodesProps
selectedNodesCpt = here.component "selectedNodes" cpt
where
cpt props@{ boxes: { sidePanelGraph }
, graph
, nodesMap } _ = do
{ selectedNodeIds } <- GEST.focusedSidePanel sidePanelGraph
selectedNodeIds' <- T.useLive T.unequal selectedNodeIds
pure $ R2.row
[ R2.col 12
[ RH.ul { className: "nav nav-tabs d-flex justify-content-center"
, id: "myTab"
, role: "tablist" }
[ RH.div { className: "tab-content" }
[ RH.div { className: "d-flex flex-wrap justify-content-center"
, role: "tabpanel" }
( Seq.toUnfoldable
$ ( Seq.map (badge selectedNodeIds)
(badges graph selectedNodeIds')
)
)
, H.br {}
]
]
, RH.div { className: "tab-content flex-space-between" }
[ updateTermButton (Record.merge { buttonType: "primary"
, rType: CandidateTerm
, nodesMap
, text: "Move as candidate" } commonProps) []
, H.br {}
, updateTermButton (Record.merge { buttonType: "danger"
, nodesMap
, rType: StopTerm
, text: "Move as stop" } commonProps) []
]
]
]
where
commonProps = RX.pick props :: Record Common
neighborhood :: R2.Component Props
neighborhood = R.createElement neighborhoodCpt
neighborhoodCpt :: R.Component Props
neighborhoodCpt = here.component "neighborhood" cpt
where
cpt { boxes: { sidePanelGraph }
, graph
} _ = do
{ selectedNodeIds } <- GEST.focusedSidePanel sidePanelGraph
selectedNodeIds' <- T.useLive T.unequal selectedNodeIds
pure $ RH.div { className: "tab-content", id: "myTabContent" }
[ RH.div { -- className: "flex-space-around d-flex justify-content-center"
className: "d-flex flex-wrap flex-space-around"
, id: "home"
, role: "tabpanel"
}
(Seq.toUnfoldable $ Seq.map (badge selectedNodeIds)
$ neighbourBadges graph selectedNodeIds'
)
]
type UpdateTermButtonProps = (
buttonType :: String
, nodesMap :: SigmaxT.NodesMap
, rType :: TermList
, text :: String
| Common
)
updateTermButton :: R2.Component UpdateTermButtonProps
updateTermButton = R.createElement updateTermButtonCpt
updateTermButtonCpt :: R.Component UpdateTermButtonProps
updateTermButtonCpt = here.component "updateTermButton" cpt
where
cpt { boxes: { errors
, reloadForest
, sidePanelGraph }
, buttonType
, graphId
, metaData
, nodesMap
, rType
, session
, text } _ = do
{ removedNodeIds, sideTab, selectedNodeIds } <- GEST.focusedSidePanel sidePanelGraph
selectedNodeIds' <- T.useLive T.unequal selectedNodeIds
pure $ if Set.isEmpty selectedNodeIds' then
RH.div {} []
else
RH.button { className: "btn btn-sm btn-" <> buttonType
, on: { click: onClickRemove removedNodeIds selectedNodeIds selectedNodeIds' }
} [ RH.text text ]
where
onClickRemove removedNodeIds selectedNodeIds selectedNodeIds' _ = do
let nodes = mapMaybe (\id -> Map.lookup id nodesMap)
$ Set.toUnfoldable selectedNodeIds'
sendPatches { errors
, graphId: graphId
, metaData: metaData
, nodes
, session: session
, termList: rType
, reloadForest }
T.write_ selectedNodeIds' removedNodeIds
T.write_ SigmaxT.emptyNodeIds selectedNodeIds
badge :: T.Box SigmaxT.NodeIds -> Record SigmaxT.Node -> R.Element
badge selectedNodeIds {id, label} =
RH.a { className: "badge badge-pill badge-light"
, on: { click: onClick }
} [ RH.h6 {} [ RH.text label ] ]
where
onClick _ = do
T.write_ (Set.singleton id) selectedNodeIds
badges :: SigmaxT.SGraph -> SigmaxT.NodeIds -> Seq.Seq (Record SigmaxT.Node)
badges graph selectedNodeIds = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds
neighbourBadges :: SigmaxT.SGraph -> SigmaxT.NodeIds -> Seq.Seq (Record SigmaxT.Node)
neighbourBadges graph selectedNodeIds = SigmaxT.neighbours graph selectedNodes' where
selectedNodes' = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds
type SendPatches =
( errors :: T.Box (Array FrontendError)
, graphId :: NodeID
, metaData :: GET.MetaData
, nodes :: Array (Record SigmaxT.Node)
, reloadForest :: T2.ReloadS
, session :: Session
, termList :: TermList
)
sendPatches :: Record SendPatches -> Effect Unit
sendPatches { errors, metaData, nodes, reloadForest, session, termList } = do
launchAff_ do
patches <- (parTraverse (sendPatch termList session metaData) nodes) -- :: Aff (Array NTC.VersionedNgramsPatches)
let mPatch = last patches
case mPatch of
Nothing -> pure unit
Just (Left err) -> liftEffect $ do
T.modify_ (A.cons $ FRESTError { error: err }) errors
here.log2 "[sendPatches] RESTError" err
Just (Right (NTC.Versioned _patch)) -> do
liftEffect $ T2.reload reloadForest
-- Why is this called delete node?
sendPatch :: TermList
-> Session
-> GET.MetaData
-> Record SigmaxT.Node
-> Aff (Either RESTError NTC.VersionedNgramsPatches)
sendPatch termList session (GET.MetaData metaData) node = do
eRet <- NTC.putNgramsPatches coreParams versioned
case eRet of
Left err -> pure $ Left err
Right ret -> do
_task <- NTC.postNgramsChartsAsync coreParams -- TODO add task
pure $ Right ret
where
nodeId :: NodeID
nodeId = unsafePartial $ fromJust $ fromString node.id
versioned :: NTC.VersionedNgramsPatches
versioned = NTC.Versioned {version: metaData.list.version, data: np}
coreParams :: NTC.CoreParams ()
coreParams = {session, nodeId, listIds: [metaData.list.listId], tabType}
tabNgramType :: CTabNgramType
tabNgramType = modeTabType node.gargType
tabType :: TabType
tabType = TabCorpus (TabNgramType tabNgramType)
term :: NTC.NgramsTerm
term = NTC.normNgram tabNgramType node.label
np :: NTC.NgramsPatches
np = NTC.singletonPatchMap term $ NTC.NgramsPatch { patch_children: mempty, patch_list }
patch_list :: NTC.Replace TermList
patch_list = NTC.Replace { new: termList, old: MapTerm }
type Query =
( frontends :: Frontends
, metaData :: GET.MetaData
, nodesMap :: SigmaxT.NodesMap
, searchType :: SearchType
, selectedNodeIds :: SigmaxT.NodeIds
, session :: Session )
query :: R2.Component Query
query = R.createElement queryCpt
queryCpt :: R.Component Query
queryCpt = here.component "query" cpt where
cpt props@{ selectedNodeIds } _ = do
pure $ if Set.isEmpty selectedNodeIds
then RH.div {} []
else query' props []
query' :: R2.Component Query
query' = R.createElement queryCpt'
queryCpt' :: R.Component Query
queryCpt' = here.component "query'" cpt where
cpt { frontends
, metaData: GET.MetaData metaData
, nodesMap
, searchType
, selectedNodeIds
, session } _ = do
pure $ case (head metaData.corpusId) of
Nothing -> RH.div {} []
Just corpusId ->
CGT.tabs { frontends
, query: SearchQuery { expected: searchType
, query : concat $ toQuery <$> Set.toUnfoldable selectedNodeIds
}
, session
, sides: [side corpusId]
}
where
toQuery id = case Map.lookup id nodesMap of
Nothing -> []
Just n -> words n.label
side corpusId = GET.GraphSideCorpus { corpusId
, corpusLabel: metaData.title
, listId : metaData.list.listId
}
------------------------------------------------------------------------
{-, RH.div { className: "col-md-12", id: "horizontal-checkbox" }
[ RH.ul {}
[ checkbox "Pubs"
, checkbox "Projects"
, checkbox "Patents"
, checkbox "Others"
]
]
-}
--------------------------------------------------------------------------
documentation :: Lang -> R.Element
documentation _ =
H.div {} [ H.h2 {} [ H.text "What is Graph ?"]
, ul [ "Graph is a conveniant tool to explore your documents. "
, "Nodes are terms selected in your Map List. "
<> "Node size is proportional to the number of documents with the associated term. "
, "Edges between nodes represent proximities of terms according to a specific distance between your documents. "
<> "Link strength is proportional to the strenght of terms association."
]
, H.h3 {} [ H.text "Basic Interactions:"]
, ul [ "Click on a node to select/unselect and get its information. "
, "In case of multiple selection, the button unselect clears all selections. "
<> "Use your mouse scroll to zoom in and out in the graph. "
, "Use the node filter to create a subgraph with nodes of a given size "
<>"range (e.g. display only generic terms). "
, "Use the edge filter so create a subgraph with links in a given range (e.g. keep the strongest association)."
]
]
where
ul ts = H.ul {} $ map (\t -> H.li {} [ H.text t ]) ts
{-
TODO DOC
Conditional distance between the terms X and Y is the probability to have both terms X and Y in the same textual context.
Distributional distance between the terms X and Y is the probability to have same others terms in the same textual context as X or Y.
Global/local view:
The 'change level' button allows to change between global view and node centered view,
To explore the neighborhood of a selection click on the 'change level' button.
-}
Sidebar/ 0000775 0000000 0000000 00000000000 14111104351 0034615 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/GraphExplorer Types.purs 0000664 0000000 0000000 00000005105 14111104351 0036635 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/GraphExplorer/Sidebar module Gargantext.Components.GraphExplorer.Sidebar.Types where
import Data.Maybe (Maybe(..), maybe)
import Data.Set as Set
import Reactix as R
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Hooks.Sigmax.Types as SigmaxT
type SidePanel =
(
mGraph :: Maybe SigmaxT.SGraph
, mMetaData :: Maybe GET.MetaData
, multiSelectEnabled :: Boolean
, removedNodeIds :: SigmaxT.NodeIds
, selectedNodeIds :: SigmaxT.NodeIds
, showControls :: Boolean
, sideTab :: GET.SideTab
)
initialSidePanel :: Maybe (Record SidePanel)
initialSidePanel = Nothing
focusedSidePanel :: T.Box (Maybe (Record SidePanel))
-> R.Hooks { mGraph :: T.Box (Maybe SigmaxT.SGraph)
, mMetaData :: T.Box (Maybe GET.MetaData)
, multiSelectEnabled :: T.Box Boolean
, removedNodeIds :: T.Box SigmaxT.NodeIds
, selectedNodeIds :: T.Box SigmaxT.NodeIds
, showControls :: T.Box Boolean
, sideTab :: T.Box GET.SideTab }
focusedSidePanel sidePanel = do
mGraph <- T.useFocused
(maybe Nothing _.mGraph)
(\val -> maybe Nothing (\sp -> Just $ sp { mGraph = val })) sidePanel
mMetaData <- T.useFocused
(maybe Nothing _.mMetaData)
(\val -> maybe Nothing (\sp -> Just $ sp { mMetaData = val })) sidePanel
multiSelectEnabled <- T.useFocused
(maybe false _.multiSelectEnabled)
(\val -> maybe Nothing (\sp -> Just $ sp { multiSelectEnabled = val })) sidePanel
removedNodeIds <- T.useFocused
(maybe Set.empty _.removedNodeIds)
(\val -> maybe Nothing (\sp -> Just $ sp { removedNodeIds = val })) sidePanel
selectedNodeIds <- T.useFocused
(maybe Set.empty _.selectedNodeIds)
(\val -> maybe Nothing (\sp -> Just $ sp { selectedNodeIds = val })) sidePanel
showControls <- T.useFocused
(maybe false _.showControls)
(\val -> maybe Nothing (\sp -> Just $ sp { showControls = val })) sidePanel
sideTab <- T.useFocused
(maybe GET.SideTabLegend _.sideTab)
(\val -> maybe Nothing (\sp -> Just $ sp { sideTab = val })) sidePanel
pure $ {
mGraph
, mMetaData
, multiSelectEnabled
, removedNodeIds
, selectedNodeIds
, showControls
, sideTab
}
SlideButton.purs 0000664 0000000 0000000 00000004501 14111104351 0036413 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/GraphExplorer module Gargantext.Components.GraphExplorer.SlideButton
( Props
, sizeButton
, labelSizeButton
, mouseSelectorSizeButton
) where
import Global (readFloat)
import Prelude
import Effect (Effect)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.SlideButton"
type Props =
( caption :: String
, min :: Number
, max :: Number
, onChange :: forall e. e -> Effect Unit
, state :: T.Box Number
)
sizeButton :: Record Props -> R.Element
sizeButton props = R.createElement sizeButtonCpt props []
sizeButtonCpt :: R.Component Props
sizeButtonCpt = here.component "sizeButton" cpt where
cpt { state, caption, min, max, onChange } _ = do
defaultValue <- T.useLive T.unequal state
pure $ H.span { className: "range-simple" }
[ H.label {} [ R2.small {} [ H.text caption ] ]
, H.input { type: "range"
, className: "form-control"
, min: show min
, max: show max
, defaultValue
, on: { input: onChange } }]
labelSizeButton :: R.Ref Sigmax.Sigma -> T.Box Number -> R.Element
labelSizeButton sigmaRef state =
sizeButton {
state
, caption: "Label Size"
, min: 1.0
, max: 30.0
, onChange: \e -> do
let sigma = R.readRef sigmaRef
let newValue = readFloat $ R.unsafeEventValue e
Sigmax.dependOnSigma sigma "[labelSizeButton] sigma: Nothing" $ \s -> do
Sigma.setSettings s {
defaultLabelSize: newValue
, drawLabels: true
, maxNodeSize: newValue / 2.5
--, labelSizeRatio: newValue / 2.5
}
T.write_ newValue state
}
mouseSelectorSizeButton :: R.Ref Sigmax.Sigma -> T.Box Number -> R.Element
mouseSelectorSizeButton sigmaRef state =
sizeButton {
state
, caption: "Selector Size"
, min: 1.0
, max: 50.0
, onChange: \e -> do
let sigma = R.readRef sigmaRef
let newValue = readFloat $ R.unsafeEventValue e
Sigmax.dependOnSigma sigma "[mouseSelectorSizeButton] sigma: Nothing" $ \s -> do
Sigma.setSettings s {
mouseSelectorSize: newValue
}
T.write_ newValue state
}
ToggleButton.purs 0000664 0000000 0000000 00000017242 14111104351 0036602 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/GraphExplorer module Gargantext.Components.GraphExplorer.ToggleButton
( Props
, toggleButton
, toggleButtonCpt
, controlsToggleButton
, edgesToggleButton
, louvainToggleButton
, multiSelectEnabledButton
, sidebarToggleButton
, pauseForceAtlasButton
, resetForceAtlasButton
, treeToggleButton
) where
import Prelude
import Effect (Effect)
import Gargantext.Components.Graph as Graph
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.ToggleButton"
type Props = (
state :: T.Box Boolean
, onMessage :: String
, offMessage :: String
, style :: String
, onClick :: forall e. e -> Effect Unit
)
toggleButton :: R2.Component Props
toggleButton = R.createElement toggleButtonCpt
toggleButtonCpt :: R.Component Props
toggleButtonCpt = here.component "toggleButton" cpt
where
cpt { state
, onMessage
, offMessage
, onClick
, style } _ = do
state' <- T.useLive T.unequal state
pure $ H.div { className: "btn btn-outline-" <> style <> " " <> cls state' <> " mx-2"
, on: { click: onClick }
} [ R2.small {} [ H.text (text onMessage offMessage state') ] ]
cls true = "active"
cls false = ""
text on _off true = on
text _on off false = off
type ControlsToggleButtonProps = (
state :: T.Box Boolean
)
controlsToggleButton :: R2.Component ControlsToggleButtonProps
controlsToggleButton = R.createElement controlsToggleButtonCpt
controlsToggleButtonCpt :: R.Component ControlsToggleButtonProps
controlsToggleButtonCpt = here.component "controlsToggleButton" cpt
where
cpt { state } _ = do
pure $ toggleButton {
state: state
, onMessage: "Hide Controls"
, offMessage: "Show Controls"
, onClick: \_ -> T.modify_ not state
, style: "light"
} []
type EdgesButtonProps = (
state :: T.Box SigmaxTypes.ShowEdgesState
)
edgesToggleButton :: R2.Component EdgesButtonProps
edgesToggleButton = R.createElement edgesToggleButtonCpt
edgesToggleButtonCpt :: R.Component EdgesButtonProps
edgesToggleButtonCpt = here.component "edgesToggleButton" cpt
where
cpt { state } _ = do
state' <- T.useLive T.unequal state
pure $ H.button { className: "btn btn-outline-primary " <> cls state'
, on: { click: onClick state }
} [ R2.small {} [ H.text (text state') ] ]
text s = if SigmaxTypes.edgeStateHidden s then "Show edges" else "Hide edges"
cls SigmaxTypes.EShow = ""
cls _ = "active"
-- TODO: Move this to Graph.purs to the R.useEffect handler which renders nodes/edges
onClick state _ = T.modify_ SigmaxTypes.toggleShowEdgesState state
type LouvainToggleButtonProps = (
state :: T.Box Boolean
)
louvainToggleButton :: R2.Component LouvainToggleButtonProps
louvainToggleButton = R.createElement louvainToggleButtonCpt
louvainToggleButtonCpt :: R.Component LouvainToggleButtonProps
louvainToggleButtonCpt = here.component "louvainToggleButton" cpt
where
cpt { state } _ = do
pure $ toggleButton {
state: state
, onMessage: "Louvain off"
, offMessage: "Louvain on"
, onClick: \_ -> T.modify_ not state
, style: "primary"
} []
type MultiSelectEnabledButtonProps = (
state :: T.Box Boolean
)
multiSelectEnabledButton :: R2.Component MultiSelectEnabledButtonProps
multiSelectEnabledButton = R.createElement multiSelectEnabledButtonCpt
multiSelectEnabledButtonCpt :: R.Component MultiSelectEnabledButtonProps
multiSelectEnabledButtonCpt = here.component "lmultiSelectEnabledButton" cpt
where
cpt { state } _ = do
pure $ toggleButton {
state: state
, onMessage: "Single-node"
, offMessage: "Multi-node"
, onClick: \_ -> T.modify_ not state
, style : "primary"
} []
type ForceAtlasProps = (
state :: T.Box SigmaxTypes.ForceAtlasState
)
pauseForceAtlasButton :: R2.Component ForceAtlasProps
pauseForceAtlasButton = R.createElement pauseForceAtlasButtonCpt
pauseForceAtlasButtonCpt :: R.Component ForceAtlasProps
pauseForceAtlasButtonCpt = here.component "forceAtlasToggleButton" cpt
where
cpt { state } _ = do
state' <- T.useLive T.unequal state
pure $ H.button { className: "btn btn-outline-primary " <> cls state'
, on: { click: onClick state }
} [ R2.small {} [ H.text (text state') ] ]
cls SigmaxTypes.InitialRunning = "active"
cls SigmaxTypes.Running = "active"
cls _ = ""
text SigmaxTypes.InitialRunning = "Pause Force Atlas"
text SigmaxTypes.InitialStopped = "Start Force Atlas"
text SigmaxTypes.Running = "Pause Force Atlas"
text SigmaxTypes.Paused = "Start Force Atlas"
text SigmaxTypes.Killed = "Start Force Atlas"
onClick state _ = T.modify_ SigmaxTypes.toggleForceAtlasState state
type ResetForceAtlasProps = (
forceAtlasState :: T.Box SigmaxTypes.ForceAtlasState
, sigmaRef :: R.Ref Sigmax.Sigma
)
resetForceAtlasButton :: R2.Component ResetForceAtlasProps
resetForceAtlasButton = R.createElement resetForceAtlasButtonCpt
resetForceAtlasButtonCpt :: R.Component ResetForceAtlasProps
resetForceAtlasButtonCpt = here.component "resetForceAtlasToggleButton" cpt
where
cpt { forceAtlasState, sigmaRef } _ = do
pure $ H.button { className: "btn btn-outline-primary"
, on: { click: onClick forceAtlasState sigmaRef }
} [ R2.small {} [ H.text "Reset Force Atlas" ] ]
onClick forceAtlasState sigmaRef _ = do
-- TODO Sigma.killForceAtlas2 sigma
-- startForceAtlas2 sigma
Sigmax.dependOnSigma (R.readRef sigmaRef) "[resetForceAtlasButton] no sigma" $ \sigma -> do
Sigma.killForceAtlas2 sigma
Sigma.refreshForceAtlas sigma Graph.forceAtlas2Settings
T.write_ SigmaxTypes.Killed forceAtlasState
type TreeToggleButtonProps = (
state :: T.Box Boolean
)
treeToggleButton :: R2.Component TreeToggleButtonProps
treeToggleButton = R.createElement treeToggleButtonCpt
treeToggleButtonCpt :: R.Component TreeToggleButtonProps
treeToggleButtonCpt = here.component "treeToggleButton" cpt
where
cpt { state } _ = do
pure $ toggleButton {
state: state
, onMessage: "Hide Tree"
, offMessage: "Show Tree"
, onClick: \_ -> T.modify_ not state
, style: "light"
} []
type SidebarToggleButtonProps = (
state :: T.Box GT.SidePanelState
)
sidebarToggleButton :: R2.Component SidebarToggleButtonProps
sidebarToggleButton = R.createElement sidebarToggleButtonCpt
sidebarToggleButtonCpt :: R.Component SidebarToggleButtonProps
sidebarToggleButtonCpt = here.component "sidebarToggleButton" cpt
where
cpt { state } _ = do
state' <- T.useLive T.unequal state
pure $ H.div { className: "btn btn-outline-light " <> cls state'
, on: { click: onClick state }
} [ R2.small {} [ H.text (text onMessage offMessage state') ] ]
cls GT.Opened = "active"
cls _ = ""
onMessage = "Hide Sidebar"
offMessage = "Show Sidebar"
text on _off GT.Opened = on
text _on off GT.InitialClosed = off
text _on off GT.Closed = off
onClick state = \_ ->
T.modify_ GT.toggleSidePanelState state
-- case s of
-- GET.InitialClosed -> GET.Opened GET.SideTabLegend
-- GET.Closed -> GET.Opened GET.SideTabLegend
-- (GET.Opened _) -> GET.Closed) state
TopBar.purs 0000664 0000000 0000000 00000003115 14111104351 0035346 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/GraphExplorer module Gargantext.Components.GraphExplorer.TopBar where
import Data.Maybe (Maybe(..))
import Reactix as R
import Reactix.DOM.HTML as RH
import Toestand as T
import Gargantext.Prelude hiding (max,min)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.GraphExplorer.Search (nodeSearchControl)
import Gargantext.Components.GraphExplorer.Sidebar.Types as GEST
import Gargantext.Components.GraphExplorer.ToggleButton as Toggle
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.TopBar"
type TopBar =
(
boxes :: Boxes
)
topBar :: R2.Leaf TopBar
topBar p = R.createElement topBarCpt p []
topBarCpt :: R.Component TopBar
topBarCpt = here.component "topBar" cpt where
cpt { boxes: { showTree
, sidePanelGraph
, sidePanelState } } _ = do
{ mGraph, multiSelectEnabled, selectedNodeIds, showControls } <- GEST.focusedSidePanel sidePanelGraph
mGraph' <- T.useLive T.unequal mGraph
let search = case mGraph' of
Just graph -> nodeSearchControl { graph
, multiSelectEnabled
, selectedNodeIds } []
Nothing -> RH.div {} []
pure $ RH.form { className: "d-flex" }
[ Toggle.controlsToggleButton { state: showControls } []
, Toggle.sidebarToggleButton { state: sidePanelState } []
, search
]
where
rowToggle = RH.ul { className: "navbar-nav ml-auto mr-auto" }
col = RH.li { className: "nav-item" }
spaces = RH.a { className: "nav-link" }
Types.purs 0000664 0000000 0000000 00000020172 14111104351 0035265 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/GraphExplorer module Gargantext.Components.GraphExplorer.Types where
import Data.Array ((!!), length)
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Maybe (Maybe(..), fromJust)
import Data.Newtype (class Newtype)
import Data.Ord
import Data.Ord.Generic (genericCompare)
import Data.Symbol (SProxy(..))
import Partial.Unsafe (unsafePartial)
import Record as Record
import Simple.JSON as JSON
import Gargantext.Prelude
type GraphId = Int
newtype Node = Node {
attributes :: Cluster
, id_ :: String
, label :: String
, size :: Int
, type_ :: String
, x :: Number
, y :: Number
}
x_coordP = SProxy :: SProxy "x_coord"
xP = SProxy :: SProxy "x"
y_coordP = SProxy :: SProxy "y_coord"
yP = SProxy :: SProxy "y"
clustDefaultP = SProxy :: SProxy "clustDefault"
clust_defaultP = SProxy :: SProxy "clust_default"
cameraP = SProxy :: SProxy "camera"
mCameraP = SProxy :: SProxy "mCamera"
idP = SProxy :: SProxy "id"
id_P = SProxy :: SProxy "id_"
typeP = SProxy :: SProxy "type"
type_P = SProxy :: SProxy "type_"
derive instance Generic Node _
derive instance Newtype Node _
instance Eq Node where eq = genericEq
instance Ord Node where compare (Node n1) (Node n2) = compare n1.id_ n2.id_
instance JSON.ReadForeign Node where
readImpl f = do
inst <- JSON.readImpl f
pure $ Node $
Record.rename idP id_P $
Record.rename typeP type_P $
Record.rename x_coordP xP $
Record.rename y_coordP yP inst
instance JSON.WriteForeign Node where
writeImpl (Node nd) = JSON.writeImpl $
Record.rename id_P idP $
Record.rename type_P typeP $
Record.rename xP x_coordP $
Record.rename yP y_coordP nd
newtype Cluster = Cluster { clustDefault :: Int }
derive instance Generic Cluster _
derive instance Newtype Cluster _
instance Eq Cluster where eq = genericEq
instance JSON.ReadForeign Cluster where
readImpl f = do
inst <- JSON.readImpl f
pure $ Cluster $ Record.rename clust_defaultP clustDefaultP inst
instance JSON.WriteForeign Cluster where
writeImpl (Cluster cl) = JSON.writeImpl $ Record.rename clustDefaultP clust_defaultP cl
newtype Edge = Edge {
confluence :: Number
, id_ :: String
, source :: String
, target :: String
, weight :: Number
}
derive instance Generic Edge _
derive instance Newtype Edge _
instance Eq Edge where eq = genericEq
instance Ord Edge where compare (Edge e1) (Edge e2) = compare e1.id_ e2.id_
instance JSON.ReadForeign Edge where
readImpl f = do
inst <- JSON.readImpl f
pure $ Edge $ Record.rename idP id_P inst
instance JSON.WriteForeign Edge where
writeImpl (Edge ed) = JSON.writeImpl $ Record.rename id_P idP ed
-- | A 'fully closed interval' in CS parlance
type InclusiveRange t = { min :: t, max :: t }
type ListId = Int
type Version = Int
type CorpusId = Int
type CorpusLabel = String
newtype GraphSideCorpus = GraphSideCorpus
{ corpusId :: CorpusId
, corpusLabel :: CorpusLabel
, listId :: ListId
}
derive instance Generic GraphSideCorpus _
instance Eq GraphSideCorpus where eq = genericEq
newtype GraphData = GraphData
{ nodes :: Array Node
, edges :: Array Edge
, sides :: Array GraphSideCorpus
, metaData :: Maybe MetaData
}
derive instance Newtype GraphData _
derive instance Generic GraphData _
instance Eq GraphData where eq = genericEq
instance JSON.ReadForeign GraphData where
readImpl f = do
inst :: { nodes :: Array Node
, edges :: Array Edge
, metadata :: MetaData } <- JSON.readImpl f
let (MetaData metadata) = inst.metadata
let side x = GraphSideCorpus { corpusId: x
, corpusLabel: "Publications"
, listId : metadata.list.listId }
let sides = side <$> metadata.corpusId
pure $ GraphData { nodes: inst.nodes
, edges: inst.edges
, sides
, metaData: Just inst.metadata }
instance JSON.WriteForeign GraphData where
writeImpl (GraphData gd) = JSON.writeImpl { nodes: gd.nodes
, edges: gd.edges
, metadata: gd.metaData }
newtype MetaData = MetaData
{ corpusId :: Array Int
, legend :: Array Legend
, list :: { listId :: ListId
, version :: Version
}
, metric :: String -- dummy value
, startForceAtlas :: Boolean
, title :: String
}
derive instance Generic MetaData _
derive instance Newtype MetaData _
instance Eq MetaData where eq = genericEq
derive newtype instance JSON.ReadForeign MetaData
derive newtype instance JSON.WriteForeign MetaData
getLegend :: GraphData -> Maybe (Array Legend)
getLegend (GraphData {metaData}) = (\(MetaData m) -> m.legend) <$> metaData
newtype SelectedNode = SelectedNode {id :: String, label :: String}
derive instance Generic SelectedNode _
derive instance Newtype SelectedNode _
instance Eq SelectedNode where eq = genericEq
instance Ord SelectedNode where compare = genericCompare
instance Show SelectedNode where show (SelectedNode node) = node.label
type State = (
-- corpusId :: R.State Int
--, filePath :: R.State String
--, graphData :: R.State GraphData
--, legendData :: R.State (Array Legend)
--, multiNodeSelection :: R.State Boolean
--, selectedNodes :: R.State (Set SelectedNode)
--, showControls :: T.Box Boolean
--, showTree :: R.State Boolean
--, sidePanelState :: R.State Boolean
--, sigmaGraphData :: R.State (Maybe SigmaxTypes.SGraph)
--, sigmaSettings :: R.State ({|Graph.SigmaSettings})
--treeId :: R.State (Maybe TreeId)
)
initialGraphData :: GraphData
initialGraphData = GraphData {
nodes: []
, edges: []
, sides: []
, metaData : Just $ MetaData {
corpusId : []
, legend : []
, list: { listId : 0, version : 0 }
, metric: "Order1"
, startForceAtlas: true
, title : ""
}
}
newtype Legend = Legend {id_ ::Int , color :: String, label :: String}
derive instance Generic Legend _
derive instance Newtype Legend _
instance Eq Legend where eq (Legend l1) (Legend l2) = eq l1.id_ l2.id_
instance Ord Legend where compare (Legend l1) (Legend l2) = compare l1.id_ l2.id_
instance JSON.ReadForeign Legend where
readImpl f = do
inst <- JSON.readImpl f
pure $ Legend $ Record.rename idP id_P inst
instance JSON.WriteForeign Legend where
writeImpl (Legend l) = JSON.writeImpl $ Record.rename id_P idP l
getLegendData :: GraphData -> Array Legend
getLegendData (GraphData {metaData: Just (MetaData {legend})}) = legend
getLegendData _ = []
defaultPalette :: Array String
defaultPalette = ["#5fa571","#ab9ba2","#da876d","#bdd3ff","#b399df","#ffdfed","#33c8f3","#739e9a","#caeca3","#f6f7e5","#f9bcca","#ccb069","#c9ffde","#c58683","#6c9eb0","#ffd3cf","#ccffc7","#52a1b0","#d2ecff","#99fffe","#9295ae","#5ea38b","#fff0b3","#d99e68"]
-- clusterColor :: Cluster -> Color
-- clusterColor (Cluster {clustDefault}) = unsafePartial $ fromJust $ defaultPalette !! (clustDefault `mod` length defaultPalette)
intColor :: Int -> String
intColor i = unsafePartial $ fromJust $ defaultPalette !! (i `mod` length defaultPalette)
data SideTab = SideTabLegend | SideTabData | SideTabCommunity
derive instance Eq SideTab
instance Show SideTab where
show SideTabLegend = "Legend"
show SideTabData = "Data"
show SideTabCommunity = "Community"
newtype Camera =
Camera { ratio :: Number
, x :: Number
, y :: Number
}
derive instance Generic Camera _
derive instance Newtype Camera _
instance Eq Camera where eq = genericEq
derive newtype instance JSON.ReadForeign Camera
derive newtype instance JSON.WriteForeign Camera
newtype HyperdataGraph = HyperdataGraph {
graph :: GraphData
, mCamera :: Maybe Camera
}
derive instance Generic HyperdataGraph _
derive instance Newtype HyperdataGraph _
instance Eq HyperdataGraph where eq = genericEq
instance JSON.ReadForeign HyperdataGraph where
readImpl f = do
inst <- JSON.readImpl f
pure $ HyperdataGraph $ Record.rename cameraP mCameraP inst
instance JSON.WriteForeign HyperdataGraph where
writeImpl (HyperdataGraph c) = JSON.writeImpl $ Record.rename mCameraP cameraP c
Utils.purs 0000664 0000000 0000000 00000002416 14111104351 0035262 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/GraphExplorer module Gargantext.Components.GraphExplorer.Utils where
import Data.Maybe (Maybe(..))
import Gargantext.Prelude
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Hooks.Sigmax.Types as ST
import Gargantext.Utils.Array as GUA
stEdgeToGET :: Record ST.Edge -> GET.Edge
stEdgeToGET { _original } = _original
stNodeToGET :: Record ST.Node -> GET.Node
stNodeToGET { id, label, x, y, _original: GET.Node { attributes, size, type_ } } = GET.Node {
attributes
, id_: id
, label
, size
, type_
, x
, y
}
normalizeNodes :: Array GET.Node -> Array GET.Node
normalizeNodes ns = map normalizeNode ns
where
xs = map (\(GET.Node { x }) -> x) ns
ys = map (\(GET.Node { y }) -> y) ns
mMinx = GUA.min xs
mMaxx = GUA.max xs
mMiny = GUA.min ys
mMaxy = GUA.max ys
mXrange = do
minx <- mMinx
maxx <- mMaxx
pure $ maxx - minx
mYrange = do
miny <- mMiny
maxy <- mMaxy
pure $ maxy - miny
xdivisor = case mXrange of
Nothing -> 1.0
Just xdiv -> 1.0 / xdiv
ydivisor = case mYrange of
Nothing -> 1.0
Just ydiv -> 1.0 / ydiv
normalizeNode (GET.Node n@{ x, y }) = GET.Node $ n { x = x * xdivisor
, y = y * ydivisor }
InputWithAutocomplete.purs 0000664 0000000 0000000 00000007752 14111104351 0035725 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components module Gargantext.Components.InputWithAutocomplete where
import Prelude
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable, null, toMaybe)
import Data.Tuple.Nested ((/\))
import DOM.Simple as DOM
import DOM.Simple.Event as DE
import Effect (Effect)
import Effect.Timer (setTimeout)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.InputWithAutocomplete"
type Completions = Array String
type Props =
(
autocompleteSearch :: String -> Completions
, classes :: String
, onAutocompleteClick :: String -> Effect Unit
, onEnterPress :: String -> Effect Unit
, state :: T.Box String
)
inputWithAutocomplete :: R2.Component Props
inputWithAutocomplete = R.createElement inputWithAutocompleteCpt
inputWithAutocompleteCpt :: R.Component Props
inputWithAutocompleteCpt = here.component "inputWithAutocomplete" cpt
where
cpt props@{ autocompleteSearch
, classes
, onAutocompleteClick
, onEnterPress
, state } _ = do
state' <- T.useLive T.unequal state
inputRef <- R.useRef null
completions <- T.useBox $ autocompleteSearch state'
let onFocus completions e = T.write_ (autocompleteSearch state') completions
pure $
H.span { className: "input-with-autocomplete " <> classes }
[
completionsCpt { completions, onAutocompleteClick, state } []
, H.input { type: "text"
, ref: inputRef
, className: "form-control"
, value: state'
, on: { blur: onBlur completions
, focus: onFocus completions
, input: onInput completions
, change: onInput completions
, keyUp: onInputKeyUp inputRef } }
]
where
-- setTimeout is a bit of a hack here -- clicking on autocomplete
-- element will clear out the blur first, so the autocomplete click
-- won't fire without a timeout here. However, blur is very handy and
-- handles automatic autocomplete search, otherwise I'd have to hide it
-- in various different places (i.e. carefully handle all possible
-- events where blur happens and autocomplete should hide).
onBlur completions e = setTimeout 100 $ do
T.write_ [] completions
onInput completions e = do
let val = R.unsafeEventValue e
T.write_ val state
T.write_ (autocompleteSearch val) completions
onInputKeyUp :: R.Ref (Nullable DOM.Element) -> DE.KeyboardEvent -> Effect Unit
onInputKeyUp inputRef e = do
if DE.key e == "Enter" then do
let val = R.unsafeEventValue e
let mInput = toMaybe $ R.readRef inputRef
T.write_ val state
onEnterPress val
case mInput of
Nothing -> pure unit
Just input -> R2.blur input
else
pure $ unit
type CompletionsProps =
( completions :: T.Box Completions
, onAutocompleteClick :: String -> Effect Unit
, state :: T.Box String
)
completionsCpt :: R2.Component CompletionsProps
completionsCpt = R.createElement completionsCptCpt
completionsCptCpt :: R.Component CompletionsProps
completionsCptCpt = here.component "completionsCpt" cpt
where
cpt { completions, onAutocompleteClick, state } _ = do
completions' <- T.useLive T.unequal completions
let className = "completions " <> (if completions' == [] then "d-none" else "")
pure $ H.div { className }
[
H.div { className: "list-group" } (cCpt <$> completions')
]
where
cCpt c =
H.button { type: "button"
, className: "list-group-item"
, on: { click: onClick c } } [ H.text c ]
onClick c _ = do
T.write_ c state
onAutocompleteClick c
InputWithEnter.purs 0000664 0000000 0000000 00000002747 14111104351 0034340 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components module Gargantext.Components.InputWithEnter where
import Effect (Effect)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.InputWithEnter"
type Props a = (
onBlur :: String -> Effect Unit
, onEnter :: Unit -> Effect Unit
, onValueChanged :: String -> Effect Unit
, autoFocus :: Boolean
, className :: String
, defaultValue :: String
, placeholder :: String
, type :: String
)
inputWithEnter :: forall a. Record (Props a) -> R.Element
inputWithEnter props = R.createElement inputWithEnterCpt props []
inputWithEnterCpt :: forall a. R.Component (Props a)
inputWithEnterCpt = here.component "inputWithEnter" cpt
where
cpt props@{ onBlur, onEnter, onValueChanged
, autoFocus, className, defaultValue, placeholder } _ = do
pure $ H.input { on: { blur: onBlur'
, input: onInput
, keyPress: onKeyPress }
, autoFocus
, className
, defaultValue
, placeholder
, type: props.type }
where
onBlur' e = onBlur $ R.unsafeEventValue e
onInput e = onValueChanged $ R.unsafeEventValue e
onKeyPress e = do
char <- R2.keyCode e
if char == 13 then
onEnter unit
else
pure unit
Lang.purs 0000664 0000000 0000000 00000001776 14111104351 0032271 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components module Gargantext.Components.Lang where
import Data.Argonaut (class EncodeJson, encodeJson)
import Data.Maybe (Maybe(..))
import Gargantext.Prelude (class Eq, class Show, show, class Read)
-- Language used for search
allLangs :: Array Lang
allLangs = [ EN
, FR
, Universal
, No_extraction
]
data Lang = FR | EN | Universal | No_extraction
instance Show Lang where
show FR = "FR"
show EN = "EN"
show Universal = "All"
show No_extraction = "Nothing"
derive instance Eq Lang
instance Read Lang where
read "FR" = Just FR
read "EN" = Just EN
read "All" = Just Universal
read "Nothing" = Just No_extraction
read _ = Nothing
instance EncodeJson Lang where
encodeJson a = encodeJson (show a)
-- Language used for the landing page
data LandingLang = LL_EN | LL_FR
-- @TODO a possible method/class that a real i18n logic could later replace
class Show t <= Translate t where
translate :: Lang -> t -> String
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Lang/ 0000775 0000000 0000000 00000000000 14111104351 0031422 5 ustar 00root root 0000000 0000000 Landing.purs 0000664 0000000 0000000 00000001530 14111104351 0033631 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Lang module Gargantext.Components.Data.Landing where
data LandingData = LandingData { name :: String
, signature :: String
, logoTitle :: String
, imageTitle :: String
, blockTexts :: BlockTexts
}
data BlockTexts = BlockTexts { blocks :: Array BlockText }
data BlockText = BlockText { title :: String
, href :: String
, titleText :: String
, icon :: String
, text :: String
, docButton :: Button
}
data Button = Button { title :: String
, text :: String
, href :: String
}
Landing/ 0000775 0000000 0000000 00000000000 14111104351 0032717 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Lang EnUS.purs 0000664 0000000 0000000 00000007267 14111104351 0034460 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Lang/Landing module Gargantext.Components.Lang.Landing.EnUS where
import Gargantext.Components.Data.Landing
landingData :: LandingData
landingData = LandingData { name : "Gargantext"
, signature : "search map share"
, logoTitle : "Project hosted by CNRS (France, Europa)"
, imageTitle: "Click and test by yourself"
, blockTexts : BlockTexts { blocks : blockTexts}
}
blockTexts :: Array BlockText
blockTexts = [ BlockText { title : "Random sentences in Gargantua's Books chapters, historically true"
, href : "#"
, icon : "fa fa-random"
, titleText : "Historic"
, text : "Chapter 1.XV. How Gargantua was put under other schoolmasters. Chapter 2.XXII. How Panurge served a Parisian lady a trick that pleased her not very well. Chapter 3.XXXVII. How Pantagruel persuaded Panurge to take counsel of a fool. Chapter 4.LXI. How Gaster invented means to get and preserve corn. Chapter 5.XXXVIII. Of the temple's admirable pavement."
, docButton : Button { title : "Your first map in less than 5 minutes"
, text : " Documentation"
, href : "https://iscpif.fr/gargantext/your-first-map/"
}
}
, BlockText { title : "Randomized words, semantically and syntaxically falses."
, href : "#"
, icon : "fa fa-random"
, titleText : "Presentation"
, text : "Autem nascetur iaculis, sedfusce enimsed cursus posuere consectetuer eu justo aliquammauris. Phasellus vero nisi porttitor elit quod, leo feliscras ultricies non tempor sagittis. Liberoduis facilisinam erat dapibusnam, lacus dui duis tristique volutpatut quis vestibulum magna. Nobis faucibusvestibulum dolores minim. Bibendumin malesuada adipiscing ante, mattis fames nequeetiam lorem. No diam id. Litora quisaenean commodo lobortisetiam neque, libero mollis scelerisque inceptos ullamcorper sea congue delenit possim."
, docButton : Button { title : "Your first map in less than 5 minutes"
, text : " Documentation"
, href : "https://iscpif.fr/gargantext/your-first-map/"
}
}
, BlockText { title : "Randomized letters, true or false ?"
, href : "#"
, icon : "fa fa-random"
, titleText : "Tutoreil"
, text : "Il paraît que l'rdore des lettres dans un mot n'a pas d'imtraopnce. La première et la dernière lettre doeivnt être à la bonne place. Le reste peut être dans un désordre total et on peut touojurs lire sans prolèbme. On ne lit donc pas chaque lettre en ellêem-me, mais le mot comme un tout. Un chaegmnent de référentiel et nous tranpossons ce résultat au texte luimê-me: l'rdore des mots est failbement important copamré au contexte du texte qui, lui, est copmté: comptexter avec Gargantext."
, docButton : Button { title : "Your first map in less than 5 minutes"
, text : " Documentation"
, href : "https://iscpif.fr/gargantext/your-first-map/"
}
}
]
FrFR.purs 0000664 0000000 0000000 00000006574 14111104351 0034445 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Lang/Landing module Gargantext.Components.Lang.Landing.FrFR where
import Gargantext.Components.Data.Landing
landingData :: LandingData
landingData = LandingData { name : "Gargantext"
, signature : "chercher cartographier partgager"
, logoTitle : "Projet développé par le CNRS (France, Europe)"
, imageTitle: "Cliquez et testez vous-mêmes"
, blockTexts : BlockTexts { blocks : blockTexts}
}
blockTexts :: Array BlockText
blockTexts = [ BlockText { title : "Phrases aléatoires issues de l'oeuvre de François Rabelais. L'ordre historique des chapitres est préservé."
, href : "#"
, icon : "fa fa-random"
, titleText : "Historique"
, text : "Chapitre 1"
, docButton : Button { title : "Your first map in less than 5 minutes"
, text : " Documentation"
, href : "https://iscpif.fr/gargantext/your-first-map/"
}
}
, BlockText { title : "Mots aléatoires."
, href : "#"
, icon : "fa fa-random"
, titleText : "Presentation"
, text : "Autem nascetur iaculis, sedfusce enimsed cursus posuere consectetuer eu justo aliquammauris. Phasellus vero nisi porttitor elit quod, leo feliscras ultricies non tempor sagittis. Liberoduis facilisinam erat dapibusnam, lacus dui duis tristique volutpatut quis vestibulum magna. Nobis faucibusvestibulum dolores minim. Bibendumin malesuada adipiscing ante, mattis fames nequeetiam lorem. No diam id. Litora quisaenean commodo lobortisetiam neque, libero mollis scelerisque inceptos ullamcorper sea congue delenit possim."
, docButton : Button { title : "Your first map in less than 5 minutes"
, text : " Documentation"
, href : "https://iscpif.fr/gargantext/your-first-map/"
}
}
, BlockText { title : "Lettres alétaoires, expérience"
, href : "#"
, icon : "fa fa-random"
, titleText : "Tutoreil"
, text : "Il paraît que l'rdore des lettres dans un mot n'a pas d'imtraopnce. La première et la dernière lettre doeivnt être à la bonne place. Le reste peut être dans un désordre total et on peut touojurs lire sans prolèbme. On ne lit donc pas chaque lettre en ellêem-me, mais le mot comme un tout. Un chaegmnent de référentiel et nous tranpossons ce résultat au texte luimê-me: l'rdore des mots est failbement important copamré au contexte du texte qui, lui, est copmté: comptexter avec Gargantext."
, docButton : Button { title : "Your first map in less than 5 minutes"
, text : " Documentation"
, href : "https://iscpif.fr/gargantext/your-first-map/"
}
}
]
LoadingSpinner.purs 0000664 0000000 0000000 00000001471 14111104351 0034314 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components module Gargantext.Components.LoadingSpinner where
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.LoadingSpinner"
type Props = ()
loadingSpinner :: Record Props -> R.Element
loadingSpinner props = R.createElement loadingSpinnerCpt props []
loadingSpinnerCpt :: R.Component Props
loadingSpinnerCpt = here.component "LoadingSpinner" cpt
where
-- cpt _ _ = H.i {className: "spinner fa fa-smile-o fa-spin fa-3x fa-fw"} [H.text ""]
-- cpt _ _ = H.i {className: "fa fa-globe fa-spin fa-3x fa-fw"} [H.text ""]
-- cpt _ _ = H.i {className: "fa fa-circle-o-notch fa-spin fa-3x fa-fw"} [H.text ""]
cpt _ _ = do
pure $ H.i {className: "fa fa-spinner fa-pulse fa-3x fa-fw"} [H.text ""]
Login.purs 0000664 0000000 0000000 00000010234 14111104351 0032445 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components -- The Login component is a modal which allows the user to:
-- * See the currently logged in sessions
-- * Select a backend and log into it
module Gargantext.Components.Login where
import Data.Array (head)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.String as DST
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.Login.Modal (modal)
import Gargantext.Components.Login.Form (form)
import Gargantext.Components.NgramsTable.Loader as NTL
import Gargantext.Ends (Backend(..))
import Gargantext.Hooks.Loader as GHL
import Gargantext.Sessions (Session, Sessions, Action(Logout), unSessions)
import Gargantext.Sessions as Sessions
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Login"
-- TODO
-- enable anonymous login for first map
-- and ask for login (modal) or account creation after 15 mn when user
-- if not logged user can not save his work
type Props =
( backend :: T.Box (Maybe Backend)
, backends :: Array Backend
, sessions :: T.Box Sessions
, visible :: T.Box Boolean
)
login :: R2.Leaf Props
login props = R.createElement loginCpt props []
loginCpt :: R.Component Props
loginCpt = here.component "login" cpt where
cpt props@{ backend, sessions, visible } _ = do
b <- T.useLive T.unequal backend
pure $ modal { visible } (inner b) where
inner Nothing = chooser props
inner (Just b) = form { backend: b, sessions, visible }
chooser :: R2.Leaf Props
chooser props = R.createElement chooserCpt props []
chooserCpt :: R.Component Props
chooserCpt = here.component "chooser" cpt where
cpt { backend, backends, sessions } _ = do
sessions' <- T.useLive T.unequal sessions
pure $
R.fragment $
[ H.h2 { className: "center modal-title" }
[ H.text "Instances manager" ]]
<> activeConnections sessions sessions' <>
[ H.h3 {} [ H.text "Existing connections" ]
, H.table { className : "table" }
[ H.thead { className: "thead-light" }
[ H.tr {} (map header headers) ]
, H.tbody {} (map (renderBackend backend) backends) ]
, H.input { className: "form-control", type:"text", placeholder } ]
placeholder = "Search for your institute"
headers = [ "", "Label of instance", "Gargurl" ]
header label = H.th {} [ H.text label ]
-- Shown in the chooser
activeConnections :: forall s. T.ReadWrite s Sessions => s -> Sessions -> Array R.Element
activeConnections sessions sessions' | Sessions.null sessions' = []
activeConnections sessions sessions' =
[ H.h3 {} [ H.text "Active connection(s)" ]
, H.ul {} [ renderSessions sessions sessions' ] ]
renderSessions :: forall s. T.ReadWrite s Sessions => s -> Sessions -> R.Element
renderSessions sessions sessions' =
R.fragment (map renderSession $ unSessions sessions') where
renderSession session =
H.li {}
[ H.text $ show session
, signOutButton sessions session
, clearCacheButton ]
signOutButton :: forall c. T.ReadWrite c Sessions => c -> Session -> R.Element
signOutButton sessions session =
H.a { className, on: { click }, id: "log-out", title: "Log out" } [] where
className = "glyphitem fa fa-sign-out"
click _ = Sessions.change (Logout session) sessions
clearCacheButton :: R.Element
clearCacheButton =
H.a { className, on: { click }, id: "log-out", title: "Clear cache" } [] where
className = "glyphitem fa fa-eraser"
click _ =
launchAff_
$ GHL.clearCache unit
*> NTL.clearCache unit
*> liftEffect (here.log "cache cleared")
renderBackend :: forall b. T.Write b (Maybe Backend) => b -> Backend -> R.Element
renderBackend cursor backend@(Backend {name}) =
H.tr {}
[ H.td {} [ H.a { on: { click }, title: "Log In", className } [] ]
, H.td {} [ H.a { on: { click }} [ H.text (backendLabel name) ]]
, H.td {} [ H.text $ "garg://" <> name ]] where
className = "fa fa-hand-o-right" -- "glyphitem fa fa-log-in"
click _ = T.write_ (Just backend) cursor
backendLabel :: String -> String
backendLabel =
DST.toUpper <<< fromMaybe "" <<< head <<< DST.split (DST.Pattern ".")
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Login/ 0000775 0000000 0000000 00000000000 14111104351 0031611 5 ustar 00root root 0000000 0000000 Form.purs 0000664 0000000 0000000 00000012710 14111104351 0033351 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Login module Gargantext.Components.Login.Form where
import Prelude (Unit, bind, discard, notEq, pure, show, ($), (&&), (*>), (<>))
import Data.Either (Either(..))
import DOM.Simple.Event as DE
import Effect (Effect)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Formula as F
import Reactix as R
import Reactix.SyntheticEvent as E
import Reactix.DOM.HTML as H
import Toestand as T
import Toestand (useFocusedFields)
import Gargantext.Components.Login.Types (AuthRequest(..))
import Gargantext.Components.Forms (clearfix, formGroup)
import Gargantext.Ends (Backend)
import Gargantext.Sessions as Sessions
import Gargantext.Sessions (Sessions, postAuthRequest)
import Gargantext.Utils (csrfMiddlewareToken)
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Login.Form"
type Form =
{ error :: String
, username :: String
, password :: String
, agreed :: Boolean
}
emptyForm :: Form
emptyForm = { error: "", username: "", password: "", agreed: false }
type Boxes =
{ error :: T.Box String
, username :: T.Box String
, password :: T.Box String
, agreed :: T.Box Boolean }
formBoxes :: T.Box Form -> R.Hooks Boxes
formBoxes box = useFocusedFields box {}
type Props s v =
( backend :: Backend
, sessions :: s
, visible :: v
)
form :: forall s v. T.ReadWrite s Sessions => T.ReadWrite v Boolean
=> Record (Props s v) -> R.Element
form props = R.createElement formCpt props []
formCpt :: forall s v. T.ReadWrite s Sessions => T.ReadWrite v Boolean
=> R.Component (Props s v)
formCpt = here.component "form" cpt where
cpt props@{ backend, sessions, visible } _ = do
cell <- T.useBox emptyForm
cursors <- useFocusedFields cell {}
pure $ R2.row
[ H.form { className: "col-md-12" }
[ formLoginLink backend
, requestAccessLink
, csrfTokenInput
, formGroup
[ H.p {} [ F.viewText { text: cursors.error } ]
, usernameInput cursors.username ]
, formGroup
[ passwordInput cursors.password
, clearfix ]
, termsCheckbox cursors.agreed
, submitButton { backend, sessions, visible, cell }
]]
-- might be wrong, all we care about is preventDefault
type ChangeEvent = R.SyntheticEvent DE.MouseEvent
formLoginLink :: Backend -> R.Element
formLoginLink backend =
H.h4 { className: "text-center" } {-className: "text-muted"-}
[ H.text $ "Login to garg://" <> show backend ]
type SubmitButtonProps s v = ( cell :: T.Box Form | Props s v )
submitButton
:: forall s v. T.ReadWrite s Sessions => T.Write v Boolean
=> R2.Leaf (SubmitButtonProps s v)
submitButton props = R.createElement submitButtonCpt props []
submitButtonCpt
:: forall s v. T.ReadWrite s Sessions => T.Write v Boolean
=> R.Component (SubmitButtonProps s v)
submitButtonCpt = here.component "submitButton" cpt where
cpt { backend, sessions, visible, cell } _ = do
{ agreed, username, password } <- T.useLive T.unequal cell
pure $
if agreed && (username `notEq` "") && (password `notEq` "")
then H.div { className: "text-center" }
[ loginSubmit $ submitForm { backend, sessions, visible } cell ]
else H.div {} []
-- Attempts to submit the form
submitForm :: forall s v. T.ReadWrite s Sessions => T.Write v Boolean
=> Record (Props s v) -> T.Box Form -> ChangeEvent -> Effect Unit
submitForm { backend, sessions, visible } cell e = do
E.preventDefault e
state <- T.read cell
launchAff_ $ do
res <- postAuthRequest backend (req state)
case res of
Left message -> liftEffect $ T.write (state { error = message }) cell
Right sess ->
liftEffect $
Sessions.change (Sessions.Login sess) sessions
*> T.write false visible
*> T.write (state { error = "" }) cell
where
req { username, password } = AuthRequest { username, password }
csrfTokenInput :: R.Element -- TODO hard-coded CSRF token
csrfTokenInput = H.input { type: "hidden", name, value } where
name = "csrfmiddlewaretoken"
value = csrfMiddlewareToken
termsCheckbox :: forall cell. T.ReadWrite cell Boolean => cell -> R.Element
termsCheckbox checked =
H.div { className: "form-group form-check text-center" }
[ F.bindCheckbox { checked, className: "form-check-input" }
, H.label { className: "form-check-label" }
[ H.text "I hereby accept the "
, H.a { target: "_blank", href: termsUrl }
[ H.text "terms of use" ] ]]
where termsUrl = "http://gitlab.iscpif.fr/humanities/tofu/tree/master"
requestAccessLink :: R.Element
requestAccessLink =
H.div { className: "text-center" }
[ H.a { href, target: "_blank" } [ H.text "request access" ] ]
where href = "https://iscpif.fr/apply-for-a-services-account/"
usernameInput :: forall cell. T.ReadWrite cell String => cell -> R.Element
usernameInput value =
F.bindInput
{ value
, type: "text", className: "form-control"
, id: "id_username", placeholder: "username"
, name: "username", maxLength: "254"
}
passwordInput :: forall cell. T.ReadWrite cell String => cell -> R.Element
passwordInput value =
F.bindInput
{ value
, type: "password", className: "form-control"
, name: "password", placeholder: "password"
, id: "id_password"
}
loginSubmit :: (ChangeEvent -> Effect Unit) -> R.Element
loginSubmit click =
H.button { id, className, type: "submit", on: { click } }
[ H.text "Login" ] where
id = "login-button"
className = "btn btn-primary btn-rounded"
Modal.purs 0000664 0000000 0000000 00000003371 14111104351 0033505 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Login module Gargantext.Components.Login.Modal (Props, modal) where
import Prelude (bind, (<*), (<$>))
import Data.Semigroup ((<>))
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Utils.Reactix as R2
type Props v = ( visible :: v )
here :: R2.Here
here = R2.here "Gargantext.Components.Login.Modal"
modal :: forall v. T.ReadWrite v Boolean
=> Record (Props v) -> R.Element -> R.Element
modal props child = R.createElement modalCpt props [ child ]
modalCpt :: forall v. T.ReadWrite v Boolean => R.Component (Props v)
modalCpt = here.component "modal" cpt where
cpt { visible } children = do
v <- T.useLive T.unequal visible
R.createPortal
[ H.div
{ id: "loginModal", className: modalClass v, key: 0
, role: "dialog", data: { show: true }, style: { display: "block"} }
[ H.div { className: "modal-dialog modal-lg", role: "document"}
[ H.div { className: "modal-content" }
[ H.div { className: "modal-header" }
[ H.div { className: "col-md-10 col-md-push-1" }
[ H.h2 { className: "text-primary center m-a-2" }
-- H.i {className: "material-icons md-36"}
-- [ H.text "control_point" ]
[ H.span {className: "icon-text"} [ H.text "GarganText" ]]]
, H.button -- TODO , font-size : "50px"
{ type: "button", className: "close"
, data: { dismiss: "modal" }}
[ H.a { on: { click }, className: "btn fa fa-times" } [] ]]
, H.div { className: "modal-body" } children ]]]]
<$> R2.getPortalHost
where
click _ = here.log "click!" <* T.write false visible
modalClass s = "modal myModal" <> if s then "" else " fade"
Types.purs 0000664 0000000 0000000 00000003016 14111104351 0033551 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Login module Gargantext.Components.Login.Types where
import Prelude
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Lens (Iso', iso)
import Data.Maybe (Maybe)
import Data.Newtype (class Newtype)
import Simple.JSON as JSON
type Username = String
type Password = String
type Token = String
type TreeId = Int
newtype AuthRequest = AuthRequest
{ username :: Username
, password :: Password
}
derive instance Generic AuthRequest _
derive instance Newtype AuthRequest _
derive newtype instance JSON.ReadForeign AuthRequest
derive newtype instance JSON.WriteForeign AuthRequest
newtype AuthResponse = AuthResponse
{ valid :: Maybe AuthData
, inval :: Maybe AuthInvalid
}
derive instance Generic AuthResponse _
derive instance Newtype AuthResponse _
derive newtype instance JSON.ReadForeign AuthResponse
derive newtype instance JSON.WriteForeign AuthResponse
newtype AuthInvalid = AuthInvalid { message :: String }
derive instance Generic AuthInvalid _
derive instance Newtype AuthInvalid _
derive newtype instance JSON.ReadForeign AuthInvalid
derive newtype instance JSON.WriteForeign AuthInvalid
newtype AuthData = AuthData
{ token :: Token
, tree_id :: TreeId
}
derive instance Generic AuthData _
derive instance Newtype AuthData _
derive newtype instance JSON.ReadForeign AuthData
derive newtype instance JSON.WriteForeign AuthData
instance Eq AuthData where
eq = genericEq
_AuthData :: Iso' AuthData { token :: Token, tree_id :: TreeId }
_AuthData = iso (\(AuthData v) -> v) AuthData
MainPage.purs 0000664 0000000 0000000 00000001422 14111104351 0033055 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components module Gargantext.Components.MainPage where
import Gargantext.Prelude
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.MainPage"
type MainPage =
(
boxes :: Boxes
)
mainPage :: R2.Component MainPage
mainPage = R.createElement mainPageCpt
mainPageCpt :: R.Component MainPage
mainPageCpt = here.component "mainPage" cpt
where
cpt { boxes: { handed
, route } } children = do
handed' <- T.useLive T.unequal handed
route' <- T.useLive T.unequal route
pure $
H.div { id: "page-wrapper" }
[
H.div { className: "container-fluid" } children
]
Modal.purs 0000664 0000000 0000000 00000004643 14111104351 0032440 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components -- | The modal component sits atop everything else. It darkens the
-- | rest of the page and centers a box in which we can put
-- | content. Clicking outside of the box will close the modal
module Gargantext.Components.Modal where
import Prelude (Unit, bind, const, discard, pure, unit, ($))
import Data.Maybe ( maybe )
import Data.Nullable ( Nullable, null )
import DOM.Simple as DOM
import DOM.Simple.EventListener ( callback )
import DOM.Simple.Element as Element
import DOM.Simple.Event (MouseEvent, target)
import DOM.Simple.Document ( document )
import Effect (Effect)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Utils.Reactix as R2
here = R2.here "Gargantext.Components.Modal"
type Props = ( setVisible :: R.Setter Boolean )
modal :: R2.Component Props
modal = R.createElement modalCpt
modalCpt :: R.Component Props
modalCpt = here.component "modal" cpt
where
cpt {setVisible} children = do
host <- R2.getPortalHost
root <- R.useRef null -- used to close when user clicks outside
R2.useLayoutEffectOnce $ modalEffect root setVisible
pure $ R.createPortal
[ H.div { ref: root, className: "modal", data: {toggle: "popover", placement: "right"}}
[ H.div { className: "popover-content" }
[ H.div { className: "card" }
[ H.ul { className: "list-group" } children ]]]]
host
modalEffect
:: R.Ref (Nullable DOM.Element)
-> R.Setter Boolean
-> Effect (Effect Unit)
modalEffect rootRef setVisible = maybe (pure R.nothing) withRoot (R.readNullableRef rootRef)
where
onScroll = R2.named "hideModalOnScroll" $ callback handler
where -- removing this type declaration will unleash the hounds, so don't
handler :: MouseEvent -> Effect Unit
handler _ = setVisible (const false)
withRoot root = do
let onClick = clickHandler root
DOM.addEventListener document "click" onClick
DOM.addEventListener document "scroll" onScroll
pure $ do
DOM.removeEventListener document "click" onClick
DOM.removeEventListener document "scroll" onScroll
clickHandler root =
R2.named "hideModalOnClickOutside" $ callback handler
where -- removing this type declaration will unleash the hounds, so don't
handler :: MouseEvent -> Effect Unit
handler e =
if Element.contains root (target e)
then pure unit
else setVisible (const false)
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Modals/0000775 0000000 0000000 00000000000 14111104351 0031760 5 ustar 00root root 0000000 0000000 Modal.js 0000664 0000000 0000000 00000000652 14111104351 0033276 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Modals 'use strict';
exports.modalShow = function(name) {
return function(){
var myModal = document.getElementById(name);
var myModalInstance = new Modal(myModal);
myModalInstance.show();
};
};
exports.modalHide = function(name){
return function() {
var myModal = document.getElementById(name);
var myModalInstance = new Modal(myModal);
myModalInstance.hide();
};
};
Modal.purs 0000664 0000000 0000000 00000000305 14111104351 0033646 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Modals module Gargantext.Components.Modals.Modal where
import Prelude (Unit)
import Effect (Effect)
foreign import modalShow :: String -> Effect Unit
foreign import modalHide :: String -> Effect Unit
NgramsTable.purs 0000664 0000000 0000000 00000070567 14111104351 0033613 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components module Gargantext.Components.NgramsTable
( MainNgramsTableProps
, CommonProps
, mainNgramsTable
) where
import Gargantext.Prelude
import Data.Array as A
import Data.Either (Either)
import Data.FunctorWithIndex (mapWithIndex)
import Data.Lens (to, view, (%~), (.~), (^.), (^?))
import Data.Lens.At (at)
import Data.Lens.Common (_Just)
import Data.Lens.Fold (folded)
import Data.Lens.Index (ix)
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe, isNothing, maybe)
import Data.Monoid.Additive (Additive(..))
import Data.Ord.Down (Down(..))
import Data.Sequence (Seq, length) as Seq
import Data.Set (Set)
import Data.Set as Set
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.AutoUpdate (autoUpdateElt)
import Gargantext.Components.NgramsTable.Components as NTC
import Gargantext.Components.NgramsTable.Core (Action(..), CoreAction(..), CoreState, Dispatch, NgramsElement(..), NgramsPatch(..), NgramsTable, NgramsTerm, PageParams, PatchMap(..), Versioned(..), VersionedNgramsTable, VersionedWithCountNgramsTable, _NgramsElement, _NgramsRepoElement, _NgramsTable, _children, _list, _ngrams, _ngrams_repo_elements, _ngrams_scores, _occurrences, _root, addNewNgramA, applyNgramsPatches, applyPatchSet, chartsAfterSync, commitPatch, convOrderBy, coreDispatch, filterTermSize, fromNgramsPatches, ngramsRepoElementToNgramsElement, ngramsTermText, normNgram, patchSetFromMap, replace, singletonNgramsTablePatch, syncResetButtons, toVersioned)
import Gargantext.Components.NgramsTable.Loader (useLoaderWithCacheAPI)
import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Table as TT
import Gargantext.Components.Table.Types as TT
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..)) as R
import Gargantext.Sessions (Session, get)
import Gargantext.Types (CTabNgramType, OrderBy(..), SearchQuery, TabType, TermList(..), TermSize, termLists, termSizes)
import Gargantext.Utils (queryMatchesLabel, toggleSet, sortWith)
import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Seq as Seq
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Unsafe.Coerce (unsafeCoerce)
here :: R2.Here
here = R2.here "Gargantext.Components.NgramsTable"
type State =
CoreState (
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.
, ngramsParent :: Maybe NgramsTerm -- Nothing means we are not currently grouping terms
, ngramsSelection :: Set NgramsTerm
-- ^ The set of selected checkboxes of the first column.
)
initialState :: VersionedNgramsTable -> State
initialState (Versioned {version}) = {
ngramsChildren: Map.empty
, ngramsLocalPatch: mempty
, ngramsParent: Nothing
, ngramsSelection: mempty
, ngramsStagePatch: mempty
, ngramsValidPatch: mempty
, ngramsVersion: version
}
setTermListSetA :: NgramsTable -> Set NgramsTerm -> TermList -> Action
setTermListSetA ngramsTable ns new_list =
CoreAction $ CommitPatch $ fromNgramsPatches $ PatchMap $ mapWithIndex f $ toMap ns
where
f :: NgramsTerm -> Unit -> NgramsPatch
f n unit = NgramsPatch { patch_list, patch_children: mempty }
where
cur_list = ngramsTable ^? at n <<< _Just <<< _NgramsRepoElement <<< _list
patch_list = maybe mempty (\c -> replace c new_list) cur_list
toMap :: forall a. Set a -> Map a Unit
toMap = unsafeCoerce
-- TODO https://github.com/purescript/purescript-ordered-collections/pull/21
-- https://github.com/purescript/purescript-ordered-collections/pull/31
-- toMap = Map.fromFoldable
type PreConversionRows = Seq.Seq NgramsElement
type TableContainerProps =
( dispatch :: Dispatch
, ngramsChildren :: Map NgramsTerm Boolean
, ngramsParent :: Maybe NgramsTerm
, ngramsSelection :: Set NgramsTerm
, ngramsTable :: NgramsTable
, path :: T.Box PageParams
, tabNgramType :: CTabNgramType
, syncResetButton :: Array R.Element
)
tableContainer :: Record TableContainerProps -> Record TT.TableContainerProps -> R.Element
tableContainer p q = R.createElement (tableContainerCpt p) q []
tableContainerCpt :: Record TableContainerProps -> R.Component TT.TableContainerProps
tableContainerCpt { dispatch
, ngramsChildren
, ngramsParent
, ngramsSelection
, ngramsTable: ngramsTableCache
, path
, tabNgramType
, syncResetButton
} = here.component "tableContainer" cpt
where
cpt props _ = do
{ searchQuery, termListFilter, termSizeFilter } <- T.useLive T.unequal path
pure $ H.div {className: "container-fluid"} [
R2.row
[ H.div {className: "card col-12"}
[ H.div {className: "card-header"}
[
R2.row [ H.div {className: "col-md-2", style: {marginTop: "6px"}}
[ H.div {} syncResetButton
, if A.null props.tableBody && searchQuery /= "" then
H.li { className: "list-group-item" } [
H.button { className: "btn btn-primary"
, on: { click: const $ dispatch
$ CoreAction
$ addNewNgramA
(normNgram tabNgramType searchQuery)
MapTerm
}
}
[ H.text ("Add " <> searchQuery) ]
] else H.div {} []
]
, H.div {className: "col-md-2", style: {marginTop : "6px"}}
[ H.li {className: "list-group-item"}
[ R2.select { id: "picklistmenu"
, className: "form-control custom-select"
, defaultValue: (maybe "" show termListFilter)
, on: {change: setTermListFilter <<< read <<< R.unsafeEventValue}}
(map optps1 termLists)]
]
, H.div {className: "col-md-2", style: {marginTop : "6px"}}
[ H.li {className: "list-group-item"}
[ R2.select {id: "picktermtype"
, className: "form-control custom-select"
, defaultValue: (maybe "" show termSizeFilter)
, on: {change: setTermSizeFilter <<< read <<< R.unsafeEventValue}}
(map optps1 termSizes)]
]
, H.div { className: "col-md-2", style: { marginTop: "6px" } }
[ H.li {className: "list-group-item"}
[ H.div { className: "form-inline" }
[ H.div { className: "form-group" }
[ props.pageSizeControl
, H.label {} [ H.text " items" ]
-- H.div { className: "col-md-6" } [ props.pageSizeControl ]
-- , H.div { className: "col-md-6" } [
-- ]
]
]
]
]
, H.div {className: "col-md-4", style: {marginTop : "6px", marginBottom : "1px"}}
[ H.li {className: "list-group-item"}
[ props.pageSizeDescription
, props.paginationLinks
]
]
]
]
, editor
, if (selectionsExist ngramsSelection)
then H.li {className: "list-group-item"}
[selectButtons true]
else H.div {} []
, H.div {id: "terms_table", className: "card-body"}
[ H.table {className: "table able"}
[ H.thead {className: ""} [props.tableHead]
, H.tbody {} props.tableBody
]
, H.li {className: "list-group-item"}
[ H.div { className: "row" }
[ H.div { className: "col-md-4" }
[selectButtons (selectionsExist ngramsSelection)]
, H.div {className: "col-md-4 col-md-offset-4"}
[props.paginationLinks]
]
]
]
]
]
]
-- WHY setPath f = origSetPageParams (const $ f path)
setTermListFilter x = T.modify (_ { termListFilter = x }) path
setTermSizeFilter x = T.modify (_ { termSizeFilter = x }) path
setSelection = dispatch <<< setTermListSetA ngramsTableCache ngramsSelection
editor = H.div {} $ maybe [] f ngramsParent
where
f ngrams = [ H.p {} [H.text $ "Editing " <> ngramsTermText ngrams]
, NTC.renderNgramsTree { ngramsTable
, ngrams
, ngramsStyle: []
, ngramsClick
, ngramsEdit
}
, H.button { className: "btn btn-primary"
, on: {click: (const $ dispatch AddTermChildren)}
} [H.text "Save"]
, H.button { className: "btn btn-primary"
, on: {click: (const $ dispatch $ SetParentResetChildren Nothing)}
} [H.text "Cancel"]
]
where
ngramsTable = ngramsTableCache # at ngrams
<<< _Just
<<< _NgramsRepoElement
<<< _children
%~ applyPatchSet (patchSetFromMap ngramsChildren)
ngramsClick {depth: 1, ngrams: child} = Just $ dispatch $ ToggleChild false child
ngramsClick _ = Nothing
ngramsEdit _ = Nothing
selectionsExist :: Set NgramsTerm -> Boolean
selectionsExist = not <<< Set.isEmpty
selectButtons false = H.div {} []
selectButtons true =
H.div {} [
H.button { className: "btn btn-primary"
, on: { click: const $ setSelection MapTerm }
} [ H.text "Map" ]
, H.button { className: "btn btn-primary"
, on: { click: const $ setSelection StopTerm }
} [ H.text "Stop" ]
, H.button { className: "btn btn-primary"
, on: { click: const $ setSelection CandidateTerm }
} [ H.text "Candidate" ]
]
-- NEXT
type CommonProps =
( afterSync :: Unit -> Aff Unit
, boxes :: Boxes
, tabNgramType :: CTabNgramType
, withAutoUpdate :: Boolean
)
type PropsNoReload =
( cacheState :: NT.CacheState
, mTotalRows :: Maybe Int
, path :: T.Box PageParams
, state :: T.Box State
, versioned :: VersionedNgramsTable
| CommonProps
)
type Props =
( reloadForest :: T2.ReloadS
, reloadRoot :: T2.ReloadS
| PropsNoReload )
loadedNgramsTable :: R2.Component PropsNoReload
loadedNgramsTable = R.createElement loadedNgramsTableCpt
loadedNgramsTableCpt :: R.Component PropsNoReload
loadedNgramsTableCpt = here.component "loadedNgramsTable" cpt where
cpt { afterSync
, boxes: { errors
, tasks }
, cacheState
, mTotalRows
, path
, state
, tabNgramType
, versioned: Versioned { data: initTable }
, withAutoUpdate } _ = do
state'@{ ngramsChildren, ngramsLocalPatch, ngramsParent, ngramsSelection } <- T.useLive T.unequal state
path'@{ scoreType, termListFilter, termSizeFilter } <- T.useLive T.unequal path
params <- T.useFocused (_.params) (\a b -> b { params = a }) path
params'@{ orderBy } <- T.useLive T.unequal params
searchQuery <- T.useFocused (_.searchQuery) (\a b -> b { searchQuery = a }) path
searchQuery' <- T.useLive T.unequal searchQuery
let ngramsTable = applyNgramsPatches state' initTable
rowMap (Tuple ng nre) =
let ng_scores :: Map NgramsTerm (Additive Int)
ng_scores = ngramsTable ^. _NgramsTable <<< _ngrams_scores
Additive s = ng_scores ^. at ng <<< _Just
addOcc ne =
let Additive occurrences = sumOccurrences ngramsTable (ngramsElementToNgramsOcc ne) in
ne # _NgramsElement <<< _occurrences .~ occurrences
in
addOcc <$> rowsFilter (ngramsRepoElementToNgramsElement ng s nre)
rows :: PreConversionRows
rows = ngramsTableOrderWith orderBy (
Seq.mapMaybe rowMap $
Map.toUnfoldable (ngramsTable ^. _NgramsTable <<< _ngrams_repo_elements)
)
rowsFilter :: NgramsElement -> Maybe NgramsElement
rowsFilter ngramsElement =
if displayRow { ngramsElement
, ngramsParentRoot
, searchQuery: searchQuery'
, state: state'
, termListFilter
, termSizeFilter } then
Just ngramsElement
else
Nothing
performAction = mkDispatch { filteredRows
, path: path'
, state
, state' }
-- filteredRows :: PreConversionRows
-- no need to filter offset if cache is off
filteredRows = if cacheState == NT.CacheOn then TT.filterRows { params: params' } rows else rows
filteredConvertedRows :: TT.Rows
filteredConvertedRows = convertRow <$> filteredRows
convertRow ngramsElement =
{ row: NTC.renderNgramsItem { dispatch: performAction
, ngrams: ngramsElement ^. _NgramsElement <<< _ngrams
, ngramsElement
, ngramsLocalPatch
, ngramsParent
, ngramsSelection
, ngramsTable } []
, delete: false
}
allNgramsSelected = allNgramsSelectedOnFirstPage ngramsSelection filteredRows
totalRecords = fromMaybe (Seq.length rows) mTotalRows
afterSync' _ = do
chartsAfterSync path' errors tasks unit
afterSync unit
syncResetButton = syncResetButtons { afterSync: afterSync'
, ngramsLocalPatch
, performAction: performAction <<< CoreAction }
-- autoUpdate :: Array R.Element
autoUpdate path' = if withAutoUpdate then
[ R2.buff
$ autoUpdateElt
{ duration: 5000
, effect: performAction $ CoreAction $ Synchronize { afterSync: afterSync' }
}
]
else []
ngramsParentRoot :: Maybe NgramsTerm
ngramsParentRoot =
(\np -> ngramsTable ^? at np
<<< _Just
<<< _NgramsRepoElement
<<< _root
<<< _Just
) =<< ngramsParent
pure $ R.fragment $
autoUpdate path' <>
[ H.h4 {style: {textAlign : "center"}}
[ H.span {className: "fa fa-hand-o-down"} []
, H.text "Extracted Terms" ]
, NTC.searchInput { key: "search-input"
, searchQuery }
, TT.table
{ colNames
, container: tableContainer
{ dispatch: performAction
, ngramsChildren
, ngramsParent
, ngramsSelection
, ngramsTable
, path
, syncResetButton: [ syncResetButton ]
, tabNgramType }
, params
, rows: filteredConvertedRows
, syncResetButton: [ syncResetButton ]
, totalRecords
, wrapColElts:
wrapColElts { allNgramsSelected, dispatch: performAction, ngramsSelection } scoreType
}
, syncResetButton
]
where
colNames = TT.ColumnName <$> ["Show", "Select", "Map", "Stop", "Terms", "Score"] -- see convOrderBy
ngramsTableOrderWith orderBy =
case convOrderBy <$> orderBy of
Just ScoreAsc -> sortWith \x -> x ^. _NgramsElement <<< _occurrences
Just ScoreDesc -> sortWith \x -> Down $ x ^. _NgramsElement <<< _occurrences
Just TermAsc -> sortWith \x -> x ^. _NgramsElement <<< _ngrams
Just TermDesc -> sortWith \x -> Down $ x ^. _NgramsElement <<< _ngrams
_ -> identity -- the server ordering is enough here
-- This is used to *decorate* the Select header with the checkbox.
wrapColElts scProps _ (TT.ColumnName "Select") = const [NTC.selectionCheckbox scProps]
wrapColElts _ scoreType (TT.ColumnName "Score") = (_ <> [H.text ("(" <> show scoreType <> ")")])
wrapColElts _ _ _ = identity
type MkDispatchProps = (
filteredRows :: PreConversionRows
, path :: PageParams
, state :: T.Box State
, state' :: State
)
mkDispatch :: Record MkDispatchProps -> (Action -> Effect Unit)
mkDispatch { filteredRows
, path
, state
, state': { ngramsChildren
, ngramsParent
, ngramsSelection } } = performAction
where
allNgramsSelected = allNgramsSelectedOnFirstPage ngramsSelection filteredRows
setParentResetChildren :: Maybe NgramsTerm -> State -> State
setParentResetChildren p = _ { ngramsParent = p, ngramsChildren = Map.empty }
performAction :: Action -> Effect Unit
performAction (SetParentResetChildren p) =
T.modify_ (setParentResetChildren p) state
performAction (ToggleChild b c) =
T.modify_ (\s@{ ngramsChildren: nc } -> s { ngramsChildren = newNC nc }) state
where
newNC nc = Map.alter (maybe (Just b) (const Nothing)) c nc
performAction (ToggleSelect c) =
T.modify_ (\s@{ ngramsSelection: ns } -> s { ngramsSelection = toggleSet c ns }) state
performAction ToggleSelectAll =
T.modify_ toggler state
where
toggler s =
if allNgramsSelected then
s { ngramsSelection = Set.empty :: Set NgramsTerm }
else
s { ngramsSelection = selectNgramsOnFirstPage filteredRows }
performAction AddTermChildren =
case ngramsParent of
Nothing ->
-- impossible but harmless
pure unit
Just parent -> do
let pc = patchSetFromMap ngramsChildren
pe = NgramsPatch { patch_list: mempty, patch_children: pc }
pt = singletonNgramsTablePatch parent pe
T.modify_ (setParentResetChildren Nothing) state
commitPatch pt state
performAction (CoreAction a) = coreDispatch path state a
displayRow :: { ngramsElement :: NgramsElement
, ngramsParentRoot :: Maybe NgramsTerm
, searchQuery :: SearchQuery
, state :: State
, termListFilter :: Maybe TermList
, termSizeFilter :: Maybe TermSize } -> Boolean
displayRow { ngramsElement: NgramsElement {ngrams, root, list}
, ngramsParentRoot
, state: { ngramsChildren
, ngramsLocalPatch
, ngramsParent }
, searchQuery
, termListFilter
, termSizeFilter } =
(
isNothing root
-- ^ Display only nodes without parents
&& maybe true (_ == list) termListFilter
-- ^ and which matches the ListType filter.
&& ngramsChildren ^. at ngrams /= Just true
-- ^ and which are not scheduled to be added already
&& Just ngrams /= ngramsParent
-- ^ and which are not our new parent
&& Just ngrams /= ngramsParentRoot
-- ^ and which are not the root of our new parent
&& filterTermSize termSizeFilter ngrams
-- ^ and which satisfies the chosen term size
|| ngramsChildren ^. at ngrams == Just false
-- ^ unless they are scheduled to be removed.
|| NTC.tablePatchHasNgrams ngramsLocalPatch ngrams
-- ^ unless they are being processed at the moment.
)
&& queryMatchesLabel searchQuery (ngramsTermText ngrams)
-- ^ and which matches the search query.
allNgramsSelectedOnFirstPage :: Set NgramsTerm -> PreConversionRows -> Boolean
allNgramsSelectedOnFirstPage selected rows = selected == (selectNgramsOnFirstPage rows)
selectNgramsOnFirstPage :: PreConversionRows -> Set NgramsTerm
selectNgramsOnFirstPage rows = Set.fromFoldable $ (view $ _NgramsElement <<< _ngrams) <$> rows
type MainNgramsTableProps = (
cacheState :: T.Box NT.CacheState
, defaultListId :: Int
-- ^ This node can be a corpus or contact.
, path :: T.Box PageParams
, session :: Session
, tabType :: TabType
| CommonProps
)
mainNgramsTable :: R2.Component MainNgramsTableProps
mainNgramsTable = R.createElement mainNgramsTableCpt
mainNgramsTableCpt :: R.Component MainNgramsTableProps
mainNgramsTableCpt = here.component "mainNgramsTable" cpt
where
cpt { afterSync
, boxes
, cacheState
, defaultListId
, path
, tabNgramType
, withAutoUpdate } _ = do
cacheState' <- T.useLive T.unequal cacheState
path' <- T.useLive T.unequal path
-- let path = initialPageParams session nodeId [defaultListId] tabType
case cacheState' of
NT.CacheOn -> do
let render versioned = mainNgramsTablePaint { afterSync
, boxes
, cacheState: cacheState'
, path
, tabNgramType
, versioned
, withAutoUpdate } []
useLoaderWithCacheAPI {
cacheEndpoint: versionEndpoint { defaultListId, path: path' }
, errorHandler
, handleResponse
, mkRequest
, path: path'
, renderer: render
}
NT.CacheOff -> do
-- path <- R.useState' path
let render versionedWithCount = mainNgramsTablePaintNoCache { afterSync
, boxes
, cacheState: cacheState'
, path
, tabNgramType
, versionedWithCount
, withAutoUpdate } []
useLoader { errorHandler
, loader
, path: path'
, render }
errorHandler err = here.log2 "[mainNgramsTable] RESTError" err
-- NOTE With cache on
-- versionEndpoint :: Record MainNgramsTableProps -> PageParams -> Aff Version
versionEndpoint { defaultListId, path: { nodeId, tabType, session } } _ = get session $ R.GetNgramsTableVersion { listId: defaultListId, tabType } (Just nodeId)
-- NOTE With cache off
loader :: PageParams -> Aff (Either RESTError VersionedWithCountNgramsTable)
loader { listIds
, nodeId
, params: { limit, offset }
, searchQuery
, session
, tabType
, termListFilter
, termSizeFilter
} =
get session $ R.GetNgrams params (Just nodeId)
where
params = { limit
, listIds
, offset: Just offset
, orderBy: Nothing -- TODO
, searchQuery
, tabType
, termListFilter
, termSizeFilter
}
-- NOTE With cache on
mkRequest :: PageParams -> GUC.Request
mkRequest path@{ session } = GUC.makeGetRequest session $ url path
where
url { listIds
, nodeId
, tabType
} = R.GetNgramsTableAll { listIds
, tabType } (Just nodeId)
handleResponse :: VersionedNgramsTable -> VersionedNgramsTable
handleResponse v = v
type MainNgramsTablePaintProps = (
cacheState :: NT.CacheState
, path :: T.Box PageParams
, versioned :: VersionedNgramsTable
| CommonProps
)
mainNgramsTablePaint :: R2.Component MainNgramsTablePaintProps
mainNgramsTablePaint = R.createElement mainNgramsTablePaintCpt
mainNgramsTablePaintCpt :: R.Component MainNgramsTablePaintProps
mainNgramsTablePaintCpt = here.component "mainNgramsTablePaint" cpt
where
cpt { afterSync
, boxes
, cacheState
, path
, tabNgramType
, versioned
, withAutoUpdate } _ = do
state <- T.useBox $ initialState versioned
pure $ loadedNgramsTable { afterSync
, boxes
, cacheState
, mTotalRows: Nothing
, path
, state
, tabNgramType
, versioned
, withAutoUpdate
} []
type MainNgramsTablePaintNoCacheProps = (
cacheState :: NT.CacheState
, path :: T.Box PageParams
, versionedWithCount :: VersionedWithCountNgramsTable
| CommonProps
)
mainNgramsTablePaintNoCache :: R2.Component MainNgramsTablePaintNoCacheProps
mainNgramsTablePaintNoCache = R.createElement mainNgramsTablePaintNoCacheCpt
mainNgramsTablePaintNoCacheCpt :: R.Component MainNgramsTablePaintNoCacheProps
mainNgramsTablePaintNoCacheCpt = here.component "mainNgramsTablePaintNoCache" cpt
where
cpt { afterSync
, boxes
, cacheState
, path
, tabNgramType
, versionedWithCount
, withAutoUpdate } _ = do
-- TODO This is lame, make versionedWithCount a proper box?
let count /\ versioned = toVersioned versionedWithCount
state <- T.useBox $ initialState versioned
pure $ loadedNgramsTable { afterSync
, boxes
, cacheState
, mTotalRows: Just count
, path
, state
, tabNgramType
, versioned
, withAutoUpdate } []
type NgramsOcc = { occurrences :: Additive Int, children :: Set NgramsTerm }
ngramsElementToNgramsOcc :: NgramsElement -> NgramsOcc
ngramsElementToNgramsOcc (NgramsElement {occurrences, children}) = {occurrences: Additive occurrences, children}
sumOccurrences :: NgramsTable -> NgramsOcc -> Additive Int
sumOccurrences nt = sumOccChildren mempty
where
sumOccTerm :: Set NgramsTerm -> NgramsTerm -> Additive Int
sumOccTerm seen label
| Set.member label seen = Additive 0 -- TODO: Should not happen, emit a warning/error.
| otherwise =
sumOccChildren (Set.insert label seen)
{ occurrences: nt ^. _NgramsTable <<< _ngrams_scores <<< ix label
, children: nt ^. ix label <<< _NgramsRepoElement <<< _children
}
sumOccChildren :: Set NgramsTerm -> NgramsOcc -> Additive Int
sumOccChildren seen {occurrences, children} =
occurrences <> children ^. folded <<< to (sumOccTerm seen)
optps1 :: forall a. Show a => { desc :: String, mval :: Maybe a } -> R.Element
optps1 { desc, mval } = H.option { value: value } [H.text desc]
where value = maybe "" show mval
NgramsTable/ 0000775 0000000 0000000 00000000000 14111104351 0032661 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components API.purs 0000664 0000000 0000000 00000001114 14111104351 0034202 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/NgramsTable module Gargantext.Components.NgramsTable.API where
import Data.Either (Either)
import Effect.Aff (Aff)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
import Gargantext.Types as GT
type UpdateNodeListParams =
(
listId :: Int
, nodeId :: Int
, nodeType :: GT.TabSubType GT.CTabNgramType
, session :: Session
)
updateNodeList :: Record UpdateNodeListParams -> Aff (Either RESTError Int)
updateNodeList { listId, nodeId, nodeType, session } =
post session (GR.RecomputeNgrams nodeType nodeId listId) {}
Components.purs 0000664 0000000 0000000 00000025767 14111104351 0035742 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/NgramsTable module Gargantext.Components.NgramsTable.Components where
import Data.Lens ((^..), (^.), view)
import Data.Lens.At (at)
import Data.Lens.Fold (folded)
import Data.Lens.Index (ix)
import Data.List (null, toUnfoldable) as L
import Data.Maybe (Maybe(..), maybe, isJust)
import Data.Nullable (null, toMaybe)
import Data.Set (Set)
import Data.Set as Set
import React.DOM (a, span, text)
import React.DOM.Props as DOM
import Effect (Effect)
import FFI.Simple (delay)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Prelude
( Unit, bind, const, discard, map, not, otherwise
, pure, show, unit, ($), (+), (/=), (<<<), (<>), (==), (>), (||) )
import Gargantext.Components.NgramsTable.Core
( Action(..), Dispatch, NgramsElement, NgramsTable, NgramsTablePatch, NgramsTerm
, _NgramsElement, _NgramsRepoElement, _PatchMap, _children, _list
, _ngrams, _occurrences, ngramsTermText, replace, setTermListA )
import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Table as Tbl
import Gargantext.Types as T
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.NgramsTable.Components"
type SearchInputProps =
( key :: String -- to prevent refreshing & losing input
, searchQuery :: T.Box String
)
searchInput :: Record SearchInputProps -> R.Element
searchInput props = R.createElement searchInputCpt props []
searchInputCpt :: R.Component SearchInputProps
searchInputCpt = here.component "searchInput" cpt
where
cpt { searchQuery } _ = do
searchQuery' <- T.useLive T.unequal searchQuery
pure $ R2.row [
H.div { className: "col-12" } [
H.div { className: "input-group" }
[ searchButton searchQuery'
, fieldInput searchQuery'
]
]
]
where
searchButton searchQuery' =
H.div { className: "input-group-prepend" }
[ if searchQuery' /= ""
then removeButton
else H.span { className: "fa fa-search input-group-text" } []
]
removeButton =
H.button { className: "btn btn-danger"
, on: {click: \e -> T.write "" searchQuery}}
[ H.span {className: "fa fa-times"} []]
fieldInput searchQuery' =
H.input { className: "form-control"
, defaultValue: searchQuery'
, name: "search"
, on: { input: \e -> T.write (R.unsafeEventValue e) searchQuery }
, placeholder: "Search"
, type: "value"
}
type SelectionCheckboxProps =
( allNgramsSelected :: Boolean
, dispatch :: Dispatch
, ngramsSelection :: Set NgramsTerm
)
selectionCheckbox :: Record SelectionCheckboxProps -> R.Element
selectionCheckbox props = R.createElement selectionCheckboxCpt props []
selectionCheckboxCpt :: R.Component SelectionCheckboxProps
selectionCheckboxCpt = here.component "selectionCheckbox" cpt
where
cpt { allNgramsSelected, dispatch, ngramsSelection } _ = do
ref <- R.useRef null
R.useEffect' $ delay unit $ \_ -> do
let mCb = toMaybe $ R.readRef ref
case mCb of
Nothing -> pure unit
Just cb -> do
_ <- if allNgramsSelected || (Set.isEmpty ngramsSelection) then
R2.setIndeterminateCheckbox cb false
else
R2.setIndeterminateCheckbox cb true
pure unit
pure $ H.input { checked: allNgramsSelected
, className: "checkbox"
, on: { change: const $ dispatch $ ToggleSelectAll }
, ref
, type: "checkbox" }
type RenderNgramsTree =
( ngrams :: NgramsTerm
, ngramsClick :: NgramsClick
, ngramsEdit :: NgramsClick
, ngramsStyle :: Array DOM.Props
, ngramsTable :: NgramsTable
)
renderNgramsTree :: Record RenderNgramsTree -> R.Element
renderNgramsTree p = R.createElement renderNgramsTreeCpt p []
renderNgramsTreeCpt :: R.Component RenderNgramsTree
renderNgramsTreeCpt = here.component "renderNgramsTree" cpt
where
cpt { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit} _ =
pure $ H.ul {} [
H.span { className: "tree" } [
H.span { className: "righthanded" } [
tree { ngramsClick
, ngramsDepth: {ngrams, depth: 0}
, ngramsEdit
, ngramsStyle
, ngramsTable
}
]
]
]
type NgramsDepth = {ngrams :: NgramsTerm, depth :: Int}
type NgramsClick = NgramsDepth -> Maybe (Effect Unit)
type TagProps =
( ngramsClick :: NgramsClick
, ngramsDepth :: NgramsDepth
, ngramsStyle :: Array DOM.Props
)
{- TODO refactor here
-- tag :: TagProps -> Array R.Element -> R.Element
tag tagProps =
case tagProps.ngramsClick tagProps.ngramsDepth of
Just effect ->
a (tagProps.ngramsStyle <> [DOM.onClick $ const effect])
Nothing ->
span tagProps.ngramsStyle
-}
type TreeProps =
( ngramsEdit :: NgramsClick
, ngramsTable :: NgramsTable
| TagProps
)
tree :: Record TreeProps -> R.Element
tree p = R.createElement treeCpt p []
treeCpt :: R.Component TreeProps
treeCpt = here.component "tree" cpt
where
cpt params@{ ngramsClick, ngramsDepth, ngramsEdit, ngramsStyle, ngramsTable } _ =
pure $
H.li { style: {width : "100%"} }
([ H.i { className, style } [] ]
<> [ R2.buff $ tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ] ]
<> maybe [] edit (ngramsEdit ngramsDepth)
<> [ forest cs ]
)
where
tag =
case ngramsClick ngramsDepth of
Just effect ->
a (ngramsStyle <> [DOM.onClick $ const effect])
Nothing ->
span ngramsStyle
edit effect = [ H.text " "
, H.i { className: "fa fa-pencil"
, on: { click: const effect } } []
]
leaf = L.null cs
className = "fa fa-chevron-" <> if open then "down" else "right"
style = if leaf then {color: "#adb5bd"} else {color: ""}
open = not leaf || false {- TODO -}
cs = ngramsTable ^.. ix ngramsDepth.ngrams <<< _NgramsRepoElement <<< _children <<< folded
-- cs has a list is ok, the length is the number of direct children of an ngram which is generally < 10.
forest =
let depth = ngramsDepth.depth + 1 in
if depth > 10 then
const $ H.text "ERROR DEPTH > 10"
else
H.ul {} <<< map (\ngrams -> tree (params { ngramsDepth = {depth, ngrams} })) <<< L.toUnfoldable
type RenderNgramsItem = (
dispatch :: Action -> Effect Unit
, ngrams :: NgramsTerm
, ngramsElement :: NgramsElement
, ngramsLocalPatch :: NgramsTablePatch
, ngramsParent :: Maybe NgramsTerm
, ngramsSelection :: Set NgramsTerm
, ngramsTable :: NgramsTable
)
renderNgramsItem :: R2.Component RenderNgramsItem
renderNgramsItem = R.createElement renderNgramsItemCpt
renderNgramsItemCpt :: R.Component RenderNgramsItem
renderNgramsItemCpt = here.component "renderNgramsItem" cpt
where
cpt { dispatch
, ngrams
, ngramsElement
, ngramsLocalPatch
, ngramsParent
, ngramsSelection
, ngramsTable
} _ = do
pure $ Tbl.makeRow [
H.div { className: "ngrams-selector" } [
H.span { className: "ngrams-chooser fa fa-eye-slash"
, on: { click: onClick } } []
]
, selected
, checkbox T.MapTerm
, checkbox T.StopTerm
, H.div {} ( if ngramsParent == Nothing
then [renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit }]
else [H.a { on: { click: const $ dispatch $ ToggleChild true ngrams } }
[ H.i { className: "fa fa-plus" } []]
, R2.buff $ tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ]
]
)
, H.text $ show (ngramsElement ^. _NgramsElement <<< _occurrences)
]
where
ngramsDepth= {ngrams, depth: 0 }
tag =
case ngramsClick ngramsDepth of
Just effect ->
a (ngramsStyle <> [DOM.onClick $ const effect])
Nothing ->
span ngramsStyle
onClick _ = pure unit :: Effect Unit
-- onClick _ = do
-- R2.callTrigger toggleSidePanel unit
termList = ngramsElement ^. _NgramsElement <<< _list
ngramsStyle = [termStyle termList ngramsOpacity]
ngramsEdit = Just <<< dispatch <<< SetParentResetChildren <<< Just <<< view _ngrams
ngramsClick
= Just <<< dispatch <<< CoreAction <<< cycleTermListItem <<< view _ngrams
-- ^ This is the old behavior it is nicer to use since one can
-- rapidly change the ngram list without waiting for confirmation.
-- However this might expose bugs. One of them can be reproduced
-- by clicking a multiple times on the same ngram, sometimes it stays
-- transient.
-- | ngramsTransient = const Nothing
-- | otherwise = Just <<< dispatch <<< cycleTermListItem <<< view _ngrams
selected =
H.input { checked: Set.member ngrams ngramsSelection
, className: "checkbox"
, on: { change: const $ dispatch $ ToggleSelect ngrams }
, type: "checkbox"
}
checkbox termList' =
let chkd = termList == termList'
termList'' = if chkd then T.CandidateTerm else termList'
in
H.input { checked: chkd
, className: "checkbox"
, on: { change: const $ dispatch $ CoreAction $
setTermListA ngrams (replace termList termList'') }
, readOnly: ngramsTransient
, type: "checkbox" }
ngramsTransient = tablePatchHasNgrams ngramsLocalPatch ngrams
-- ^ TODO here we do not look at ngramsNewElems, shall we?
ngramsOpacity
| ngramsTransient = 0.5
| otherwise = 1.0
cycleTermListItem n = setTermListA n (replace termList (nextTermList termList))
termStyle :: T.TermList -> Number -> DOM.Props
termStyle T.MapTerm opacity = DOM.style { color: "green", opacity }
termStyle T.StopTerm opacity = DOM.style { color: "red", opacity
, textDecoration: "line-through" }
termStyle T.CandidateTerm opacity = DOM.style { color: "#767676", opacity }
tablePatchHasNgrams :: NgramsTablePatch -> NgramsTerm -> Boolean
tablePatchHasNgrams ngramsTablePatch ngrams =
isJust $ ngramsTablePatch.ngramsPatches ^. _PatchMap <<< at ngrams
nextTermList :: T.TermList -> T.TermList
nextTermList T.MapTerm = T.StopTerm
nextTermList T.StopTerm = T.CandidateTerm
nextTermList T.CandidateTerm = T.MapTerm
Core.purs 0000664 0000000 0000000 00000123414 14111104351 0034471 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/NgramsTable module Gargantext.Components.NgramsTable.Core
( PageParams
, CoreParams
, NgramsElement(..)
, _NgramsElement
, NgramsRepoElementT
, NgramsRepoElement(..)
, _NgramsRepoElement
, ngramsRepoElementToNgramsElement
, NgramsTable(..)
, NewElems
, NgramsPatch(..)
, NgramsPatches
, _NgramsTable
, NgramsTerm(..)
, normNgram
, ngramsTermText
, findNgramRoot
, findNgramTermList
, Version
, Versioned(..)
, Count
, VersionedWithCount(..)
, toVersioned
, VersionedNgramsPatches
, AsyncNgramsChartsUpdate(..)
, VersionedNgramsTable
, VersionedWithCountNgramsTable
, NgramsTablePatch
, CoreState
, HighlightElement
, highlightNgrams
, initialPageParams
, loadNgramsTable
, loadNgramsTableAll
, convOrderBy
, Replace(..) -- Ideally we should keep the constructors hidden
, replace
, PatchSet(..)
, PatchMap(..)
, _PatchMap
, patchSetFromMap
, applyPatchSet
--, applyNgramsTablePatch -- re-export only if we have a good reason not to use applyNgramsPatches
, applyNgramsPatches
, rootsOf
, singletonPatchMap
, fromNgramsPatches
, singletonNgramsTablePatch
, isEmptyNgramsTablePatch
, _list
, _occurrences
, _children
, _ngrams
, _parent
, _root
, _ngrams_repo_elements
, _ngrams_scores
, commitPatch
, putNgramsPatches
, postNgramsChartsAsync
, syncPatches
, addNewNgramP
, addNewNgramA
, setTermListP
, setTermListA
, CoreAction(..)
, CoreDispatch
, Action(..)
, Dispatch
, coreDispatch
, isSingleNgramsTerm
, filterTermSize
-- Reset Button TODO put elsewhere this file is too big
, SyncResetButtonsProps
, syncResetButtons
, chartsAfterSync
)
where
import Gargantext.Prelude
import Control.Monad.State (class MonadState, execState)
import DOM.Simple.Console (log2)
import Data.Array (head)
import Data.Array as A
import Data.Bifunctor (lmap)
import Data.Either (Either(..))
import Data.Eq.Generic (genericEq)
import Data.Foldable (class Foldable, foldMap, foldl, foldr)
import Data.FoldableWithIndex (class FoldableWithIndex, foldMapWithIndex, foldlWithIndex, foldrWithIndex)
import Data.Generic.Rep (class Generic)
import Data.Lens (Iso', Lens', use, view, (%=), (%~), (.~), (?=), (^?))
import Data.Lens.At (class At, at)
import Data.Lens.Common (_Just)
import Data.Lens.Fold (folded, traverseOf_)
import Data.Lens.Index (class Index, ix)
import Data.Lens.Iso.Newtype (_Newtype)
import Data.Lens.Record (prop)
import Data.List ((:), List(Nil))
import Data.List as L
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe, fromMaybe', isJust)
import Data.Monoid.Additive (Additive(..))
import Data.Newtype (class Newtype)
import Data.Ord.Generic (genericCompare)
import Data.Set (Set)
import Data.Set as Set
import Data.Show.Generic (genericShow)
import Data.String as S
import Data.String.Common as DSC
import Data.String.Regex (Regex, regex, replace) as R
import Data.String.Regex.Flags (global, multiline) as R
import Data.String.Utils as SU
import Data.Symbol (SProxy(..))
import Data.These (These(..))
import Data.Traversable (for, traverse_, traverse)
import Data.TraversableWithIndex (traverseWithIndex)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, error, launchAff_)
import Effect.Class (liftEffect)
import Effect.Exception.Unsafe (unsafeThrow)
import FFI.Simple.Functions (delay)
import Foreign as F
import Foreign.Object as FO
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Table as T
import Gargantext.Components.Table.Types as T
import Gargantext.Config.REST (RESTError)
import Gargantext.Config.Utils (handleRESTError)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get, post, put)
import Gargantext.Types (AsyncTask, AsyncTaskType(..), AsyncTaskWithType(..), CTabNgramType(..), FrontendError, ListId, OrderBy(..), ScoreType(..), TabSubType(..), TabType(..), TermList(..), TermSize(..))
import Gargantext.Utils.Either (eitherMap)
import Gargantext.Utils.KarpRabin (indicesOfAny)
import Gargantext.Utils.Reactix as R2
import Partial (crashWith)
import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.NgramsTable.Core"
type Endo a = a -> a
-- | Main Types
type Version = Int
newtype Versioned a = Versioned
{ version :: Version
, data :: a
}
derive instance Generic (Versioned a) _
derive instance Newtype (Versioned a) _
instance Eq a => Eq (Versioned a) where eq = genericEq
derive newtype instance JSON.ReadForeign a => JSON.ReadForeign (Versioned a)
derive newtype instance JSON.WriteForeign a => JSON.WriteForeign (Versioned a)
------------------------------------------------------------------------
type Count = Int
newtype VersionedWithCount a = VersionedWithCount
{ version :: Version
, count :: Count
, data :: a
}
derive instance Generic (VersionedWithCount a) _
derive instance Newtype (VersionedWithCount a) _
instance Eq a => Eq (VersionedWithCount a) where eq = genericEq
derive newtype instance JSON.ReadForeign a => JSON.ReadForeign (VersionedWithCount a)
derive newtype instance JSON.WriteForeign a => JSON.WriteForeign (VersionedWithCount a)
toVersioned :: forall a. VersionedWithCount a -> Tuple Count (Versioned a)
toVersioned (VersionedWithCount { count, data: d, version }) = Tuple count $ Versioned { data: d, version }
------------------------------------------------------------------------
-- TODO replace by NgramsPatches directly
type NgramsTablePatch = { ngramsPatches :: NgramsPatches }
newtype PatchMap k p = PatchMap (Map k p)
derive instance Generic (PatchMap k p) _
derive instance Newtype (PatchMap k p) _
derive instance (Eq k, Eq p) => Eq (PatchMap k p)
-- TODO generalize
instance JSON.WriteForeign p => JSON.WriteForeign (PatchMap NgramsTerm p) where
writeImpl (PatchMap m) =
JSON.writeImpl $ FO.fromFoldable $ map (lmap ngramsTermText) (Map.toUnfoldable m :: Array _)
instance (JSON.ReadForeign p, Monoid p) => JSON.ReadForeign (PatchMap NgramsTerm p) where
readImpl f = do
inst <- JSON.readImpl f
pure $ PatchMap $ foldlWithIndex (\k m v -> Map.insert (NormNgramsTerm k) v m) Map.empty (inst :: FO.Object p)
-- TODO we assume that the ngrams are already normalized ^^^^^^^^^^^^^
type NgramsPatches = PatchMap NgramsTerm NgramsPatch
data NgramsPatch
= NgramsReplace
{ patch_old :: Maybe NgramsRepoElement
, patch_new :: Maybe NgramsRepoElement
}
| NgramsPatch
{ patch_children :: PatchSet NgramsTerm
, patch_list :: Replace TermList
}
derive instance Generic NgramsPatch _
derive instance Eq NgramsPatch
instance Monoid NgramsPatch where
mempty = NgramsPatch { patch_children: mempty, patch_list: mempty }
instance Semigroup NgramsPatch where
append (NgramsReplace p) (NgramsReplace q)
| p.patch_old /= q.patch_new = unsafeThrow "append/NgramsPatch: old != new"
| otherwise = ngramsReplace q.patch_old p.patch_new
append (NgramsPatch p) (NgramsPatch q) = NgramsPatch
{ patch_children: p.patch_children <> q.patch_children
, patch_list: p.patch_list <> q.patch_list
}
append (NgramsPatch p) (NgramsReplace q) = ngramsReplace q.patch_old (q.patch_new # _Just <<< _Newtype %~ applyNgramsPatch' p)
append (NgramsReplace p) (NgramsPatch q) = ngramsReplace (p.patch_old # _Just <<< _Newtype %~ applyNgramsPatch' (invert q)) p.patch_new
instance JSON.WriteForeign NgramsPatch where
writeImpl (NgramsReplace { patch_old, patch_new }) = JSON.writeImpl { patch_old, patch_new }
writeImpl (NgramsPatch { patch_children, patch_list }) = JSON.writeImpl { patch_children, patch_list }
instance JSON.ReadForeign NgramsPatch where
readImpl f = do
inst :: { patch_old :: Maybe NgramsRepoElement
, patch_new :: Maybe NgramsRepoElement
, patch_children :: PatchSet NgramsTerm
, patch_list :: Replace TermList } <- JSON.readImpl f
-- TODO handle empty fields
-- TODO handle patch_new
if isJust inst.patch_new || isJust inst.patch_old then
pure $ NgramsReplace { patch_old: inst.patch_old, patch_new: inst.patch_new }
else do
pure $ NgramsPatch { patch_list: inst.patch_list, patch_children: inst.patch_children }
------------------------------------------------------------------------
newtype NgramsTerm = NormNgramsTerm String
derive instance Generic NgramsTerm _
derive instance Newtype NgramsTerm _
instance Eq NgramsTerm where eq = genericEq
instance Ord NgramsTerm where compare = genericCompare
instance Show NgramsTerm where show = genericShow
derive newtype instance JSON.ReadForeign NgramsTerm
derive newtype instance JSON.WriteForeign NgramsTerm
derive newtype instance Monoid NgramsTerm
------------------------------------------------------------------------
type CoreParams s =
{ nodeId :: Int
-- ^ This node can be a corpus or contact.
, listIds :: Array Int
, tabType :: TabType
, session :: Session
| s
}
type PageParams =
CoreParams
( params :: T.Params
, searchQuery :: String
, termListFilter :: Maybe TermList -- Nothing means all
, termSizeFilter :: Maybe TermSize -- Nothing means all
, scoreType :: ScoreType
)
initialPageParams :: Session -> Int -> Array Int -> TabType -> PageParams
initialPageParams session nodeId listIds tabType =
{ listIds
, nodeId
, params
, tabType
, termSizeFilter: Nothing
, termListFilter: Just MapTerm
, searchQuery: ""
, scoreType: Occurrences
, session
}
where
params = T.initialParams { orderBy = Just (T.DESC $ T.ColumnName "Score") }
ngramsTermText :: NgramsTerm -> String
ngramsTermText (NormNgramsTerm t) = t
-- TODO
normNgramInternal :: CTabNgramType -> String -> String
normNgramInternal CTabAuthors = identity
normNgramInternal CTabSources = identity
normNgramInternal CTabInstitutes = identity
normNgramInternal CTabTerms = S.toLower <<< R.replace wordBoundaryReg " "
normNgramWithTrim :: CTabNgramType -> String -> String
normNgramWithTrim nt = DSC.trim <<< normNgramInternal nt
normNgram :: CTabNgramType -> String -> NgramsTerm
normNgram tabType = NormNgramsTerm <<< normNgramWithTrim tabType
-----------------------------------------------------------------------------------
newtype NgramsElement = NgramsElement
{ ngrams :: NgramsTerm -- HERE
, size :: Int -- MISSING
, list :: TermList -- ok
, root :: Maybe NgramsTerm -- ok
, parent :: Maybe NgramsTerm -- ok
, children :: Set NgramsTerm -- ok
, occurrences :: Int -- HERE
}
derive instance Eq NgramsElement
_parent :: forall parent row. Lens' { parent :: parent | row } parent
_parent = prop (SProxy :: SProxy "parent")
_root :: forall root row. Lens' { root :: root | row } root
_root = prop (SProxy :: SProxy "root")
_ngrams :: forall row. Lens' { ngrams :: NgramsTerm | row } NgramsTerm
_ngrams = prop (SProxy :: SProxy "ngrams")
_children :: forall row. Lens' { children :: Set NgramsTerm | row } (Set NgramsTerm)
_children = prop (SProxy :: SProxy "children")
_occurrences :: forall row. Lens' { occurrences :: Int | row } Int
_occurrences = prop (SProxy :: SProxy "occurrences")
_list :: forall a row. Lens' { list :: a | row } a
_list = prop (SProxy :: SProxy "list")
_ngrams_repo_elements :: forall a row. Lens' { ngrams_repo_elements :: a | row } a
_ngrams_repo_elements = prop (SProxy :: SProxy "ngrams_repo_elements")
_ngrams_scores :: forall a row. Lens' { ngrams_scores :: a | row } a
_ngrams_scores = prop (SProxy :: SProxy "ngrams_scores")
derive instance Newtype NgramsElement _
derive instance Generic NgramsElement _
instance Show NgramsElement where show = genericShow
_NgramsElement :: Iso' NgramsElement {
children :: Set NgramsTerm
, size :: Int
, list :: TermList
, ngrams :: NgramsTerm
, occurrences :: Int
, parent :: Maybe NgramsTerm
, root :: Maybe NgramsTerm
}
_NgramsElement = _Newtype
instance JSON.ReadForeign NgramsElement where
readImpl f = do
inst :: { children :: Array NgramsTerm
, size :: Int
, list :: TermList
, ngrams :: NgramsTerm
, occurrences :: Int
, parent :: Maybe NgramsTerm
, root :: Maybe NgramsTerm }<- JSON.readImpl f
pure $ NgramsElement $ inst { children = Set.fromFoldable inst.children }
instance JSON.WriteForeign NgramsElement where
writeImpl (NgramsElement ne) =
JSON.writeImpl $ ne { children = Set.toUnfoldable ne.children :: Array _ }
type NgramsRepoElementT =
( size :: Int
, list :: TermList
, root :: Maybe NgramsTerm
, parent :: Maybe NgramsTerm
)
newtype NgramsRepoElement = NgramsRepoElement
{ children :: Set NgramsTerm
| NgramsRepoElementT }
derive instance Generic NgramsRepoElement _
derive instance Newtype NgramsRepoElement _
derive instance Eq NgramsRepoElement
instance JSON.ReadForeign NgramsRepoElement where
readImpl f = do
inst :: { children :: Array NgramsTerm | NgramsRepoElementT } <- JSON.readImpl f
pure $ NgramsRepoElement $ inst { children = Set.fromFoldable inst.children }
instance JSON.WriteForeign NgramsRepoElement where
writeImpl (NgramsRepoElement nre) =
JSON.writeImpl $ nre { children = Set.toUnfoldable nre.children :: Array _ }
instance Show NgramsRepoElement where show = genericShow
_NgramsRepoElement :: Iso' NgramsRepoElement {
children :: Set NgramsTerm
, size :: Int
, list :: TermList
, parent :: Maybe NgramsTerm
, root :: Maybe NgramsTerm
-- , occurrences :: Int
}
_NgramsRepoElement = _Newtype
ngramsRepoElementToNgramsElement :: NgramsTerm -> Int -> NgramsRepoElement -> NgramsElement
ngramsRepoElementToNgramsElement ngrams occurrences (NgramsRepoElement { children, list, parent, root, size }) =
NgramsElement
{ children
, list
, ngrams
, occurrences
, parent
, root
, size -- TODO should we assert that size(ngrams) == size?
}
-----------------------------------------------------------------------------------
{-
NgramsRepoElement does not have the occurrences field.
Instead NgramsTable has a ngrams_scores map.
Pro:
* Does not encumber NgramsRepoElement with the score which is not part of repo.
* Enables for multiple scores through multiple maps.
Cons:
* Having a map on the side is equivalent to a `occurrences :: Maybe Int`, which is
less precise.
* It is a tiny bit less performant to access the score.
-}
newtype NgramsTable = NgramsTable
{ ngrams_repo_elements :: Map NgramsTerm NgramsRepoElement
, ngrams_scores :: Map NgramsTerm (Additive Int)
}
derive instance Newtype NgramsTable _
derive instance Generic NgramsTable _
instance Eq NgramsTable where eq = genericEq
instance Show NgramsTable where show = genericShow
_NgramsTable :: Iso' NgramsTable
{ ngrams_repo_elements :: Map NgramsTerm NgramsRepoElement
, ngrams_scores :: Map NgramsTerm (Additive Int)
}
_NgramsTable = _Newtype
instance Index NgramsTable NgramsTerm NgramsRepoElement where
ix k = _NgramsTable <<< _ngrams_repo_elements <<< ix k
instance At NgramsTable NgramsTerm NgramsRepoElement where
at k = _NgramsTable <<< _ngrams_repo_elements <<< at k
instance JSON.ReadForeign NgramsTable where
readImpl ff = do
inst <- JSON.readImpl ff
pure $ NgramsTable
{ ngrams_repo_elements: Map.fromFoldable $ f <$> (inst :: Array NgramsElement)
, ngrams_scores: Map.fromFoldable $ g <$> inst
}
where
f (NgramsElement {ngrams, size, list, root, parent, children}) =
Tuple ngrams (NgramsRepoElement {size, list, root, parent, children})
g (NgramsElement e) = Tuple e.ngrams (Additive e.occurrences)
{- NOT USED
instance EncodeJson NgramsTable where
encodeJson (NgramsTable {ngrams_repo_elements, ngrams_scores}) = encodeJson $ Map.values ... TODO
-}
-----------------------------------------------------------------------------------
lookupRootList :: NgramsTerm -> NgramsTable -> Maybe TermList
lookupRootList ngram (NgramsTable {ngrams_repo_elements: elts}) =
case Map.lookup ngram elts of
Nothing -> Nothing
Just (NgramsRepoElement {list, root: Nothing}) -> Just list
Just (NgramsRepoElement {root: Just root}) ->
case Map.lookup root elts of
Nothing -> Nothing
Just (NgramsRepoElement {list}) -> Just list -- assert root == Nothing
wordBoundaryChars :: String
wordBoundaryChars = "[ .,;:!?'\\{}()]"
wordBoundaryReg :: R.Regex
wordBoundaryReg = case R.regex ("(" <> wordBoundaryChars <> ")") (R.global <> R.multiline) of
Left e -> unsafePartial $ crashWith e
Right r -> r
wordBoundaryReg2 :: R.Regex
wordBoundaryReg2 = case R.regex ("(" <> wordBoundaryChars <> ")\\1") (R.global <> R.multiline) of
Left e -> unsafePartial $ crashWith e
Right r -> r
type HighlightElement = Tuple String (List (Tuple NgramsTerm TermList))
type HighlightAccumulator = List HighlightElement
-- TODO: while this function works well with word boundaries,
-- it inserts too many spaces.
highlightNgrams :: CTabNgramType -> NgramsTable -> String -> Array HighlightElement
highlightNgrams ntype table@(NgramsTable {ngrams_repo_elements: elts}) input0 =
-- trace {pats, input0, input, ixs} \_ ->
A.fromFoldable ((\(s /\ ls)-> undb s /\ ls) <$> unsafePartial (foldl goFold ((input /\ Nil) : Nil) ixs))
where
spR x = " " <> R.replace wordBoundaryReg "$1$1" x <> " "
reR = R.replace wordBoundaryReg " "
db = S.replaceAll (S.Pattern " ") (S.Replacement " ")
sp x = " " <> db x <> " "
undb = R.replace wordBoundaryReg2 "$1"
input = spR input0
pats = A.fromFoldable (Map.keys elts)
ixs = indicesOfAny (sp <<< ngramsTermText <$> pats) (normNgramInternal ntype input)
splitAcc :: Partial => Int -> HighlightAccumulator
-> Tuple HighlightAccumulator HighlightAccumulator
splitAcc i = go 0 Nil
where
go j pref acc =
case compare i j of
LT -> crashWith "highlightNgrams: splitAcc': i < j"
EQ -> L.reverse pref /\ acc
GT ->
case acc of
Nil -> crashWith "highlightNgrams: splitAcc': acc=Nil" -- pref /\ Nil
elt@(s /\ ls) : elts ->
let slen = S.length s in
case compare i (j + slen) of
LT -> let {before: s0, after: s1} = S.splitAt (i - j) s in
L.reverse ((s0 /\ ls) : pref) /\ ((s1 /\ ls) : elts)
EQ -> L.reverse (elt : pref) /\ elts
GT -> go (j + slen) (elt : pref) elts
extractInputTextMatch :: Int -> Int -> String -> String
extractInputTextMatch i len input = undb $ S.take len $ S.drop (i + 1) input
addNgramElt ng ne_list (elt /\ elt_lists) = (elt /\ ((ng /\ ne_list) : elt_lists))
goAcc :: Partial => Int -> HighlightAccumulator -> Tuple NgramsTerm Int -> HighlightAccumulator
goAcc i acc (pat /\ lpat) =
case lookupRootList pat table of
Nothing ->
crashWith "highlightNgrams: pattern missing from table"
Just ne_list ->
let
(acc0 /\ acc1_2) = splitAcc i acc
(acc1 /\ acc2) = splitAcc (lpat + 1) acc1_2
text = extractInputTextMatch i lpat input
ng = normNgram ntype text
in
acc0 <> (addNgramElt ng ne_list <$> acc1) <> acc2
goFold :: Partial => HighlightAccumulator -> Tuple Int (Array Int) -> HighlightAccumulator
goFold acc (Tuple i pis) = foldl (goAcc i) acc $
-- A.sortWith snd $
map (\pat -> pat /\ S.length (db (ngramsTermText pat))) $
fromMaybe' (\_ -> crashWith "highlightNgrams: out of bounds pattern") $
traverse (A.index pats) pis
-----------------------------------------------------------------------------------
type VersionedNgramsTable = Versioned NgramsTable
type VersionedWithCountNgramsTable = VersionedWithCount NgramsTable
-----------------------------------------------------------------------------------
data Replace a
= Keep
| Replace { old :: a, new :: a }
derive instance Generic (Replace a) _
replace :: forall a. Eq a => a -> a -> Replace a
replace old new
| old == new = Keep
| otherwise = Replace { old, new }
derive instance Eq a => Eq (Replace a)
instance Eq a => Semigroup (Replace a) where
append Keep p = p
append p Keep = p
append (Replace { old }) (Replace { new }) | old /= new = unsafeThrow "old != new"
append (Replace { new }) (Replace { old }) = replace old new
instance Eq a => 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
instance JSON.WriteForeign a => JSON.WriteForeign (Replace a) where
writeImpl Keep = JSON.writeImpl { tag: "Keep" }
writeImpl (Replace {old, new}) = JSON.writeImpl { old, new, tag: "Replace" }
instance (JSON.ReadForeign a, Eq a) => JSON.ReadForeign (Replace a) where
readImpl f = do
impl :: { old :: Maybe a, new :: Maybe a } <- JSON.readImpl f
case Tuple impl.old impl.new of
Tuple (Just old) (Just new) -> pure $ replace old new
Tuple Nothing Nothing -> pure Keep
_ -> F.fail $ F.ForeignError "decodeJsonReplace"
-- 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
}
derive instance Generic (PatchSet a) _
derive instance Newtype (PatchSet a) _
instance 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 Ord a => Monoid (PatchSet a) where
mempty = PatchSet { rem: Set.empty, add: Set.empty }
instance JSON.WriteForeign a => JSON.WriteForeign (PatchSet a) where
writeImpl (PatchSet {rem, add}) = JSON.writeImpl { rem: (Set.toUnfoldable rem :: Array a)
, add: (Set.toUnfoldable add :: Array a) }
instance (Ord a, JSON.ReadForeign a) => JSON.ReadForeign (PatchSet a) where
readImpl f = do
-- TODO handle empty fields
inst :: { rem :: Array a, add :: Array a } <- JSON.readImpl f
let rem = mkSet inst.rem
add = mkSet inst.add
pure $ PatchSet { rem, add }
where
mkSet :: forall b. Ord b => Array b -> Set b
mkSet = Set.fromFoldable
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
-- TODO shall we normalise as in replace? shall we make a type class Replaceable?
ngramsReplace :: Maybe NgramsRepoElement -> Maybe NgramsRepoElement -> NgramsPatch
ngramsReplace patch_old patch_new = NgramsReplace {patch_old, patch_new}
derive instance Eq (PatchSet NgramsTerm)
-- TODO
invert :: forall a. a -> a
invert _ = unsafeThrow "invert: TODO"
applyNgramsPatch' :: forall row.
{ patch_children :: PatchSet NgramsTerm
, patch_list :: Replace TermList
} ->
Endo { list :: TermList
, children :: Set NgramsTerm
| row
}
applyNgramsPatch' p e =
e { list = applyReplace p.patch_list e.list
, children = applyPatchSet p.patch_children e.children
}
applyNgramsPatch :: NgramsPatch -> Maybe NgramsRepoElement -> Maybe NgramsRepoElement
applyNgramsPatch (NgramsReplace {patch_new}) _ = patch_new
applyNgramsPatch (NgramsPatch p) m = m # _Just <<< _Newtype %~ applyNgramsPatch' p
fromMap :: forall k p. Ord k => Eq p => Monoid p => Map k p -> PatchMap k p
fromMap = PatchMap <<< Map.filter (\v -> v /= mempty)
instance (Ord k, Eq p, Monoid p) => Semigroup (PatchMap k p) where
append (PatchMap p) (PatchMap q) = fromMap $ Map.unionWith append p q
instance (Ord k, Eq p, Monoid p) => Monoid (PatchMap k p) where
mempty = PatchMap Map.empty
_PatchMap :: forall k p. Iso' (PatchMap k p) (Map k p)
_PatchMap = _Newtype
{-
instance Functor (PatchMap k) where
map f (PatchMap m) = PatchMap (map f m) -- NO NORM: fromMap would not typecheck
instance FunctorWithIndex k (PatchMap k) where
mapWithIndex f (PatchMap m) = PatchMap (mapWithIndex f m) -- NO NORM: fromMap would not typecheck
-}
instance 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 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
{- fromMap is preventing these to type check:
instance Ord k => Traversable (PatchMap k) where
traverse f (PatchMap m) = fromMap <$> traverse f m
sequence (PatchMap m) = fromMap <$> sequence m
instance Ord k => TraversableWithIndex k (PatchMap k) where
traverseWithIndex f (PatchMap m) = fromMap <$> traverseWithIndex f m
-}
traversePatchMapWithIndex :: forall f a b k.
Applicative f => Ord k => Eq b => Monoid b =>
(k -> a -> f b) -> PatchMap k a -> f (PatchMap k b)
traversePatchMapWithIndex f (PatchMap m) = fromMap <$> traverseWithIndex f m
singletonPatchMap :: forall k p. k -> p -> PatchMap k p
singletonPatchMap k p = PatchMap (Map.singleton k p)
isEmptyPatchMap :: forall k p. PatchMap k p -> Boolean
isEmptyPatchMap (PatchMap p) = Map.isEmpty p
mergeMap :: forall k a b c. Ord k => (k -> These a b -> Maybe c) -> Map k a -> Map k b -> Map k c
mergeMap f m1 m2 = Map.mapMaybeWithKey f (Map.unionWith g (This <$> m1) (That <$> m2))
where
g (This p) (That v) = Both p v
g x _ = x -- impossible
applyPatchMap :: forall k p v. Ord k => (p -> Maybe v -> Maybe v) -> PatchMap k p -> Map k v -> Map k v
{-
applyPatchMap applyPatchValue (PatchMap pm) m = mergeMap f pm m
where
f _ (This pv) = applyPatchValue pv Nothing
f _ (That v) = Just v
f _ (Both pv v) = applyPatchValue pv (Just v)
-}
applyPatchMap applyPatchValue (PatchMap pm) m =
foldl go m (Map.toUnfoldable pm :: List (Tuple k p))
where
go m' (Tuple k pv) = Map.alter (applyPatchValue pv) k m'
type VersionedNgramsPatches = Versioned NgramsPatches
newtype AsyncNgramsChartsUpdate = AsyncNgramsChartsUpdate {
listId :: Maybe ListId
, tabType :: TabType
}
derive instance Generic AsyncNgramsChartsUpdate _
derive instance Newtype AsyncNgramsChartsUpdate _
instance JSON.WriteForeign AsyncNgramsChartsUpdate where
writeImpl (AsyncNgramsChartsUpdate { listId, tabType }) =
JSON.writeImpl { list_id: listId, tab_type: tabType }
type NewElems = Map NgramsTerm TermList
----------------------------------------------------------------------------------
isEmptyNgramsTablePatch :: NgramsTablePatch -> Boolean
isEmptyNgramsTablePatch {ngramsPatches} = isEmptyPatchMap ngramsPatches
fromNgramsPatches :: NgramsPatches -> NgramsTablePatch
fromNgramsPatches ngramsPatches = {ngramsPatches}
findNgramRoot :: NgramsTable -> NgramsTerm -> NgramsTerm
findNgramRoot (NgramsTable m) n =
fromMaybe n (m.ngrams_repo_elements ^? at n <<< _Just <<< _NgramsRepoElement <<< _root <<< _Just)
findNgramTermList :: NgramsTable -> NgramsTerm -> Maybe TermList
findNgramTermList (NgramsTable m) n = m.ngrams_repo_elements ^? at r <<< _Just <<< _NgramsRepoElement <<< _list
where
r = findNgramRoot (NgramsTable m) n
singletonNgramsTablePatch :: NgramsTerm -> NgramsPatch -> NgramsTablePatch
singletonNgramsTablePatch n p = fromNgramsPatches $ singletonPatchMap n p
rootsOf :: NgramsTable -> Set NgramsTerm
rootsOf (NgramsTable m) = Map.keys $ Map.mapMaybe isRoot m.ngrams_repo_elements
where
isRoot (NgramsRepoElement { parent }) = parent
type RootParent = { root :: NgramsTerm, parent :: NgramsTerm }
type ReParent a = forall m. MonadState NgramsTable m => a -> m Unit
reRootMaxDepth :: Int
reRootMaxDepth = 100 -- TODO: this is a hack
reRootChildren :: Int -> NgramsTerm -> ReParent NgramsTerm
reRootChildren 0 _ _ = pure unit -- TODO: this is a hack
reRootChildren max_depth root ngram = do
nre <- use (at ngram)
traverseOf_ (_Just <<< _NgramsRepoElement <<< _children <<< folded) (\child -> do
at child <<< _Just <<< _NgramsRepoElement <<< _root ?= root
reRootChildren (max_depth - 1) root child) nre
reParent :: Maybe RootParent -> ReParent NgramsTerm
reParent mrp child = do
at child <<< _Just <<< _NgramsRepoElement %= ((_parent .~ (view _parent <$> mrp)) <<<
(_root .~ (view _root <$> mrp)))
reRootChildren reRootMaxDepth (fromMaybe child (mrp ^? _Just <<< _root)) child
-- 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 _ (NgramsReplace _) = pure unit -- TODO
reParentNgramsPatch parent (NgramsPatch {patch_children: PatchSet {rem, add}}) = do
-- root_of_parent <- use (at parent <<< _Just <<< _NgramsElement <<< _root)
-- ^ TODO this does not type checks, we do the following two lines instead:
s <- use (at parent)
let root_of_parent = s ^? (_Just <<< _NgramsRepoElement <<< _root <<< _Just)
let rp = { root: fromMaybe parent root_of_parent, parent }
traverse_ (reParent Nothing) rem
traverse_ (reParent $ Just rp) add
reParentNgramsTablePatch :: ReParent NgramsPatches
reParentNgramsTablePatch = void <<< traversePatchMapWithIndex reParentNgramsPatch
{-
newElemsTable :: NewElems -> Map NgramsTerm NgramsElement
newElemsTable = mapWithIndex newElem
where
newElem ngrams list =
NgramsElement
{ ngrams
, list
, occurrences: 1
, parent: Nothing
, root: Nothing
, children: mempty
}
-}
applyNgramsTablePatch :: NgramsTablePatch -> NgramsTable -> NgramsTable
applyNgramsTablePatch { ngramsPatches } (NgramsTable m) =
execState (reParentNgramsTablePatch ngramsPatches) $
NgramsTable $ m { ngrams_repo_elements =
applyPatchMap applyNgramsPatch ngramsPatches m.ngrams_repo_elements }
applyNgramsPatches :: forall s. CoreState s -> NgramsTable -> NgramsTable
applyNgramsPatches {ngramsLocalPatch, ngramsStagePatch, ngramsValidPatch} =
applyNgramsTablePatch (ngramsLocalPatch <> ngramsStagePatch <> ngramsValidPatch)
-- First the valid patch, then the stage patch, and finally the local patch.
-----------------------------------------------------------------------------------
type CoreState s =
{ ngramsLocalPatch :: NgramsTablePatch
-- ^ These patches are local and not yet staged.
, ngramsStagePatch :: NgramsTablePatch
-- ^ These patches are staged (scheduled for synchronization).
-- Requests are being performed at the moment.
, ngramsValidPatch :: NgramsTablePatch
-- ^ These patches have been synchronized with the server.
, ngramsVersion :: Version
| s
}
{-
postNewNgrams :: forall s. Array NgramsTerm -> Maybe TermList -> CoreParams s -> Aff Unit
postNewNgrams newNgrams mayList {nodeId, listIds, tabType, session} =
when (not (A.null newNgrams)) $ do
(_ :: Array Unit) <- post session p newNgrams
pure unit
where p = PutNgrams tabType (head listIds) mayList (Just nodeId)
postNewElems :: forall s. NewElems -> CoreParams s -> Aff Unit
postNewElems newElems params = void $ traverseWithIndex postNewElem newElems
where
postNewElem ngrams list = postNewNgrams [ngrams] (Just list) params
-}
newNgramPatch :: TermList -> NgramsPatch
newNgramPatch list =
NgramsReplace
{ patch_old: Nothing
, patch_new:
Just $ NgramsRepoElement
{ size: 1 -- TODO
, list
, root: Nothing
, parent: Nothing
, children: mempty
-- , occurrences: 0 -- TODO
}
}
addNewNgramP :: NgramsTerm -> TermList -> NgramsTablePatch
addNewNgramP ngrams list =
{ ngramsPatches: singletonPatchMap ngrams (newNgramPatch list) }
addNewNgramA :: NgramsTerm -> TermList -> CoreAction
addNewNgramA ngrams list = CommitPatch $ addNewNgramP ngrams list
setTermListP :: NgramsTerm -> Replace TermList -> NgramsTablePatch
setTermListP ngram patch_list = singletonNgramsTablePatch ngram pe
where
pe = NgramsPatch { patch_list, patch_children: mempty }
setTermListA :: NgramsTerm -> Replace TermList -> CoreAction
setTermListA ngram termList = CommitPatch $ setTermListP ngram termList
putNgramsPatches :: forall s. CoreParams s -> VersionedNgramsPatches -> Aff (Either RESTError VersionedNgramsPatches)
putNgramsPatches { listIds, nodeId, session, tabType } = put session putNgrams
where putNgrams = PutNgrams tabType (head listIds) Nothing (Just nodeId)
syncPatches :: forall p s. CoreParams p -> T.Box (CoreState s) -> (Unit -> Aff Unit) -> Effect Unit
syncPatches props state callback = do
{ ngramsLocalPatch: ngramsLocalPatch@{ ngramsPatches }
, ngramsStagePatch
, ngramsValidPatch
, ngramsVersion } <- T.read state
when (isEmptyNgramsTablePatch ngramsStagePatch) $ do
let pt = Versioned { data: ngramsPatches, version: ngramsVersion }
launchAff_ $ do
ePatches <- putNgramsPatches props pt
case ePatches of
Left err -> liftEffect $ log2 "[syncPatches] RESTError" err
Right (Versioned { data: newPatch, version: newVersion }) -> do
callback unit
liftEffect $ do
log2 "[syncPatches] setting state, newVersion" newVersion
T.modify_ (\s ->
-- I think that sometimes this setState does not fully go through.
-- This is an issue because the version number does not get updated and the subsequent calls
-- can mess up the patches.
s {
ngramsLocalPatch = fromNgramsPatches mempty
, ngramsStagePatch = fromNgramsPatches mempty
, ngramsValidPatch = fromNgramsPatches newPatch <> ngramsLocalPatch <> s.ngramsValidPatch
-- First the already valid patch, then the local patch, then the newly received newPatch.
, ngramsVersion = newVersion
}) state
log2 "[syncPatches] ngramsVersion" newVersion
pure unit
{-
syncPatchesAsync :: forall p s. CoreParams p -> R.State (CoreState s) -> (Unit -> Aff Unit) -> Effect Unit
syncPatchesAsync props@{ listIds, tabType }
({ ngramsLocalPatch: ngramsLocalPatch@{ ngramsPatches }
, ngramsStagePatch
, ngramsValidPatch
, ngramsVersion
} /\ setState) callback = do
when (isEmptyNgramsTablePatch ngramsStagePatch) $ do
let patch = Versioned { data: ngramsPatches, version: ngramsVersion }
launchAff_ $ do
Versioned { data: newPatch, version: newVersion } <- postNgramsPatchesAsync props patch
callback unit
liftEffect $ do
log2 "[syncPatches] setting state, newVersion" newVersion
setState $ \s ->
s {
ngramsLocalPatch = fromNgramsPatches mempty
, ngramsStagePatch = fromNgramsPatches mempty
, ngramsValidPatch = fromNgramsPatches newPatch <> ngramsLocalPatch <> s.ngramsValidPatch
-- First the already valid patch, then the local patch, then the newly received newPatch.
, ngramsVersion = newVersion
}
log2 "[syncPatches] ngramsVersion" newVersion
-}
commitPatch :: forall s. NgramsTablePatch -> T.Box (CoreState s) -> Effect Unit
commitPatch tablePatch state = do
T.modify_ (\s -> s { ngramsLocalPatch = tablePatch <> s.ngramsLocalPatch }) state
-- First we apply the patches we have locally and then the new patch (tablePatch).
loadNgramsTable :: PageParams -> Aff (Either RESTError VersionedNgramsTable)
loadNgramsTable
{ nodeId, listIds, termListFilter, termSizeFilter, session, scoreType
, searchQuery, tabType, params: {offset, limit, orderBy}}
= get session query
where
query = GetNgramsTableAll { listIds
, tabType } (Just nodeId)
-- where query = GetNgrams { limit
-- , offset: Just offset
-- , listIds
-- , orderBy: convOrderBy <$> orderBy
-- , searchQuery
-- , tabType
-- , termListFilter
-- , termSizeFilter } (Just nodeId)
type NgramsListByTabType = Map TabType VersionedNgramsTable
loadNgramsTableAll :: PageParams -> Aff (Either RESTError NgramsListByTabType)
loadNgramsTableAll { nodeId, listIds, session, scoreType } = do
let
cTagNgramTypes =
[ CTabTerms
, CTabSources
, CTabAuthors
, CTabInstitutes
]
query tabType = GetNgramsTableAll { listIds, tabType } (Just nodeId)
ret <- Map.fromFoldable <$> for cTagNgramTypes \cTagNgramType -> do
let tabType = TabCorpus $ TabNgramType cTagNgramType
result :: Either RESTError VersionedNgramsTable <- get session $ query tabType
pure $ Tuple tabType result
pure $ eitherMap ret
convOrderBy :: T.OrderByDirection T.ColumnName -> OrderBy
convOrderBy (T.ASC (T.ColumnName "Score")) = ScoreAsc
convOrderBy (T.DESC (T.ColumnName "Score")) = ScoreDesc
convOrderBy (T.ASC _) = TermAsc
convOrderBy (T.DESC _) = TermDesc
data CoreAction
= CommitPatch NgramsTablePatch
| Synchronize { afterSync :: Unit -> Aff Unit }
| ResetPatches
data Action
= CoreAction CoreAction
| 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
| ToggleSelect NgramsTerm
-- ^ Toggles the NgramsTerm in the `Set` `ngramsSelection`.
| ToggleSelectAll
type CoreDispatch = CoreAction -> Effect Unit
type Dispatch = Action -> Effect Unit
coreDispatch :: forall p s. CoreParams p -> T.Box (CoreState s) -> CoreDispatch
coreDispatch path state (Synchronize { afterSync }) =
syncPatches path state afterSync
coreDispatch _ state (CommitPatch pt) =
commitPatch pt state
coreDispatch _ state ResetPatches =
T.modify_ (_ { ngramsLocalPatch = { ngramsPatches: mempty } }) state
isSingleNgramsTerm :: NgramsTerm -> Boolean
isSingleNgramsTerm nt = isSingleTerm $ ngramsTermText nt
where
isSingleTerm :: String -> Boolean
isSingleTerm s = A.length words == 1
where
words = A.filter (not S.null) $ DSC.trim <$> (SU.words s)
filterTermSize :: Maybe TermSize -> NgramsTerm -> Boolean
filterTermSize (Just MonoTerm) nt = isSingleNgramsTerm nt
filterTermSize (Just MultiTerm) nt = not $ isSingleNgramsTerm nt
filterTermSize _ _ = true
------------------------------------------------------------------------
-- | Reset Button
type SyncResetButtonsProps =
( afterSync :: Unit -> Aff Unit
, ngramsLocalPatch :: NgramsTablePatch
, performAction :: CoreDispatch
)
syncResetButtons :: Record SyncResetButtonsProps -> R.Element
syncResetButtons p = R.createElement syncResetButtonsCpt p []
syncResetButtonsCpt :: R.Component SyncResetButtonsProps
syncResetButtonsCpt = here.component "syncResetButtons" cpt
where
cpt { afterSync, ngramsLocalPatch, performAction } _ = do
synchronizing <- T.useBox false
synchronizing' <- T.useLive T.unequal synchronizing
let
hasChanges = ngramsLocalPatch /= mempty
hasChangesClass = if hasChanges then "" else " disabled"
synchronizingClass = if synchronizing' then " disabled" else ""
resetClick _ = do
performAction ResetPatches
synchronizeClick _ = delay unit $ \_ -> do
T.write_ true synchronizing
performAction $ Synchronize { afterSync: newAfterSync }
newAfterSync x = do
afterSync x
liftEffect $ T.write_ false synchronizing
pure $ H.div { className: "btn-toolbar" }
[ H.div { className: "btn-group mr-2" }
[ H.button { className: "btn btn-danger " <> hasChangesClass <> synchronizingClass
, on: { click: resetClick }
} [ H.text "Reset" ]
]
, H.div { className: "btn-group mr-2" }
[ H.button { className: "btn btn-primary " <> hasChangesClass <> synchronizingClass
, on: { click: synchronizeClick }
} [ H.text "Sync" ]
]
]
type ResetButton = (Unit -> Aff Unit)
-> { ngramsPatches :: PatchMap NgramsTerm NgramsPatch }
-> (Action -> Effect Unit)
-> Array R.Element
chartsAfterSync :: forall props discard.
{ listIds :: Array Int
, nodeId :: Int
, session :: Session
, tabType :: TabType
| props
}
-> T.Box (Array FrontendError)
-> T.Box GAT.Storage
-> discard
-> Aff Unit
chartsAfterSync path'@{ nodeId } errors tasks _ = do
eTask <- postNgramsChartsAsync path'
handleRESTError errors eTask $ \task -> liftEffect $ do
log2 "[chartsAfterSync] Synchronize task" task
GAT.insert nodeId task tasks
postNgramsChartsAsync :: forall s. CoreParams s -> Aff (Either RESTError AsyncTaskWithType)
postNgramsChartsAsync { listIds, nodeId, session, tabType } = do
eTask :: Either RESTError AsyncTask <- post session putNgramsAsync acu
pure $ (\task -> AsyncTaskWithType { task, typ: UpdateNgramsCharts }) <$> eTask
where
acu = AsyncNgramsChartsUpdate { listId: head listIds
, tabType }
putNgramsAsync = PostNgramsChartsAsync (Just nodeId)
Loader.purs 0000664 0000000 0000000 00000010020 14111104351 0034773 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/NgramsTable module Gargantext.Components.NgramsTable.Loader where
import Gargantext.Prelude
import Affjax (Error(..))
import Data.Either (Either(..))
import Data.Maybe (Maybe(..), maybe, isJust)
import Effect (Effect)
import Effect.Aff (Aff, launchAff_, throwError)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Gargantext.Components.LoadingSpinner (loadingSpinner)
import Gargantext.Components.NgramsTable.Core (Version, Versioned(..))
import Gargantext.Config.REST (RESTError(..))
import Gargantext.Utils.CacheAPI as GUC
import Reactix as R
import Simple.JSON as JSON
import Toestand as T
cacheName :: String
cacheName = "ngrams-cache-api-loader"
clearCache :: Unit -> Aff Unit
clearCache _ = GUC.delete $ GUC.CacheName cacheName
type LoaderWithCacheAPIProps path res ret = (
cacheEndpoint :: path -> Aff (Either RESTError Version)
, errorHandler :: RESTError -> Effect Unit
, handleResponse :: Versioned res -> ret
, mkRequest :: path -> GUC.Request
, path :: path
, renderer :: ret -> R.Element
)
useLoaderWithCacheAPI :: forall path res ret. Eq path => JSON.ReadForeign res => Eq ret =>
Record (LoaderWithCacheAPIProps path res ret)
-> R.Hooks R.Element
useLoaderWithCacheAPI { cacheEndpoint, errorHandler, handleResponse, mkRequest, path, renderer } = do
state <- T.useBox Nothing
state' <- T.useLive T.unequal state
useCachedAPILoaderEffect { cacheEndpoint
, errorHandler
, handleResponse
, mkRequest
, path
, state }
pure $ maybe (loadingSpinner {}) renderer state'
type LoaderWithCacheAPIEffectProps path res ret = (
cacheEndpoint :: path -> Aff (Either RESTError Version)
, errorHandler :: RESTError -> Effect Unit
, handleResponse :: Versioned res -> ret
, mkRequest :: path -> GUC.Request
, path :: path
, state :: T.Box (Maybe ret)
)
useCachedAPILoaderEffect :: forall path res ret. Eq path => JSON.ReadForeign res => Eq ret =>
Record (LoaderWithCacheAPIEffectProps path res ret)
-> R.Hooks Unit
useCachedAPILoaderEffect { cacheEndpoint
, errorHandler
, handleResponse
, mkRequest
, path
, state: state } = do
oPath <- R.useRef path
state' <- T.useLive T.unequal state
R.useEffect' $ do
if (R.readRef oPath == path) && (isJust state') then
pure unit
else do
R.setRef oPath path
let req = mkRequest path
-- log2 "[useCachedLoader] mState" mState
launchAff_ $ do
cache <- GUC.openCache $ GUC.CacheName cacheName
-- TODO Parallelize?
vr@(Versioned { version }) <- GUC.cachedJson cache req
eCacheReal <- cacheEndpoint path
case eCacheReal of
Left err -> liftEffect $ errorHandler err
Right cacheReal -> do
val <- if version == cacheReal then
pure vr
else do
-- liftEffect $ do
-- log "[useCachedAPILoaderEffect] versions dont match"
-- log2 "[useCachedAPILoaderEffect] cached version" version
-- log2 "[useCachedAPILoaderEffect] real version" cacheReal
_ <- GUC.deleteReq cache req
vr'@(Versioned { version: version', data: _ }) <- GUC.cachedJson cache req
if version' == cacheReal then
pure vr'
else do
liftEffect $ errorHandler $ SendResponseError $ RequestContentError $ "[useCachedAPILoaderEffect] Fetched clean cache but hashes don't match: " <> show version <> " != " <> show cacheReal
throwError $ error $"[useCachedAPILoaderEffect] Fetched clean cache but hashes don't match: " <> show version <> " != " <> show cacheReal
liftEffect $ do
T.write_ (Just $ handleResponse val) state
Node.purs 0000664 0000000 0000000 00000002403 14111104351 0032261 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components module Gargantext.Components.Node
where
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Maybe (Maybe)
import Data.Newtype (class Newtype)
import Simple.JSON as JSON
import Gargantext.Prelude
type NodePolyCommon a =
( id :: Int
, typename :: Int
, name :: String
, date :: String
, hyperdata :: a )
newtype NodePoly a =
NodePoly { userId :: Int
, parentId :: Int
| NodePolyCommon a
}
derive instance Generic (NodePoly a) _
derive instance Newtype (NodePoly a) _
instance Eq a => Eq (NodePoly a) where eq = genericEq
instance JSON.ReadForeign a => JSON.ReadForeign (NodePoly a) where
readImpl f = do
inst :: { user_id :: Int, parent_id :: Int | NodePolyCommon a } <- JSON.readImpl f
pure $ NodePoly { id: inst.id
, typename: inst.typename
, userId: inst.user_id
, parentId: inst.parent_id
, name: inst.name
, date: inst.date
, hyperdata: inst.hyperdata }
newtype HyperdataList = HyperdataList { preferences :: Maybe String }
derive instance Generic HyperdataList _
derive instance Newtype HyperdataList _
derive newtype instance JSON.ReadForeign HyperdataList
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/ 0000775 0000000 0000000 00000000000 14111104351 0031611 5 ustar 00root root 0000000 0000000 Annuaire.purs 0000664 0000000 0000000 00000024340 14111104351 0034212 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes module Gargantext.Components.Nodes.Annuaire
-- ( annuaire )
where
import Data.Array as A
import Data.Either (Either)
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Data.Newtype (class Newtype)
import Data.Sequence as Seq
import Data.Symbol (SProxy(..))
import Effect.Aff (Aff, launchAff_)
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Simple.JSON as JSON
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.NgramsTable.Loader (clearCache)
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types as CT
import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Table (defaultContainer, initialParams, makeRow, table, tableHeaderLayout) as TT
import Gargantext.Components.Table.Types (ColumnName(..), Params) as TT
import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (url, Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId, get)
import Gargantext.Types (NodeType(..), AffETableResult, TableResult)
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Annuaire"
newtype IndividuView =
CorpusView
{ id :: Int
, name :: String
, role :: String
, company :: String
}
--toRows :: AnnuaireTable -> Array (Maybe Contact)
--toRows (AnnuaireTable a) = a.annuaireTable
-- | Top level layout component. Loads an annuaire by id and renders
-- | the annuaire using the result
type LayoutProps =
( frontends :: Frontends
, nodeId :: Int
, session :: Session
)
annuaireLayout :: R2.Leaf LayoutProps
annuaireLayout props = R.createElement annuaireLayoutCpt props []
annuaireLayoutCpt :: R.Component LayoutProps
annuaireLayoutCpt = here.component "annuaireLayout" cpt where
cpt { frontends, nodeId, session } _ = do
pure $ annuaireLayoutWithKey { frontends, key, nodeId, session }
where
key = show (sessionId session) <> "-" <> show nodeId
type KeyLayoutProps =
( key :: String
| LayoutProps
)
annuaireLayoutWithKey :: R2.Leaf KeyLayoutProps
annuaireLayoutWithKey props = R.createElement annuaireLayoutWithKeyCpt props []
annuaireLayoutWithKeyCpt :: R.Component KeyLayoutProps
annuaireLayoutWithKeyCpt = here.component "annuaireLayoutWithKey" cpt where
cpt { frontends, nodeId, session } _ = do
path <- T.useBox nodeId
path' <- T.useLive T.unequal path
useLoader { errorHandler
, loader: getAnnuaireInfo session
, path: path'
, render: \info -> annuaire { frontends, info, path, session } }
where
errorHandler err = here.log2 "[annuaireLayoutWithKey] RESTError" err
type AnnuaireProps =
( session :: Session
, path :: T.Box Int
, info :: AnnuaireInfo
, frontends :: Frontends
)
-- | Renders a basic table and the page loader
annuaire :: R2.Leaf AnnuaireProps
annuaire props = R.createElement annuaireCpt props []
-- Abuses closure to work around the Loader
annuaireCpt :: R.Component AnnuaireProps
annuaireCpt = here.component "annuaire" cpt
where
cpt {session, path, info: info@(AnnuaireInfo {name, date: date'}), frontends} _ = do
path' <- T.useLive T.unequal path
pagePath <- T.useBox $ initialPagePath path'
cacheState <- T.useBox NT.CacheOff
cacheState' <- T.useLive T.unequal cacheState
R.useEffectOnce' $ do
T.listen (\_ -> launchAff_ $ clearCache unit) cacheState
pure $ R.fragment
[ TT.tableHeaderLayout
{ cacheState
, date
, desc: name
, key: "annuaire-" <> (show cacheState')
, query: ""
, title: name
, user: "" } []
, H.p {} []
-- , H.div {className: "col-md-3"} [ H.text " Filter ", H.input { className: "form-control", style } ]
, H.br {}
, pageLayout { info, session, pagePath, frontends} ]
where
date = "Last update: " <> date'
initialPagePath nodeId = {nodeId, params: TT.initialParams}
type PagePath = { nodeId :: Int, params :: TT.Params }
type PageLayoutProps =
( session :: Session
, frontends :: Frontends
, info :: AnnuaireInfo
, pagePath :: T.Box PagePath
)
pageLayout :: Record PageLayoutProps -> R.Element
pageLayout props = R.createElement pageLayoutCpt props []
pageLayoutCpt :: R.Component PageLayoutProps
pageLayoutCpt = here.component "pageLayout" cpt
where
cpt { frontends, pagePath, session } _ = do
pagePath' <- T.useLive T.unequal pagePath
useLoader { errorHandler
, loader: loadPage session
, path: pagePath'
, render: \table -> page { session, table, frontends, pagePath } }
where
errorHandler err = here.log2 "[pageLayout] RESTError" err
type PageProps =
( session :: Session
, frontends :: Frontends
, pagePath :: T.Box PagePath
-- , info :: AnnuaireInfo
, table :: TableResult CT.NodeContact
)
page :: Record PageProps -> R.Element
page props = R.createElement pageCpt props []
pageCpt :: R.Component PageProps
pageCpt = here.component "page" cpt
where
cpt { frontends
, pagePath
, session
, table: ({count: totalRecords, docs}) } _ = do
pagePath' <- T.useLive T.unequal pagePath
params <- T.useFocused (_.params) (\a b -> b { params = a }) pagePath
pure $ TT.table { colNames
, container
, params
, rows: rows pagePath'
, syncResetButton : [ H.div {} [] ]
, totalRecords
, wrapColElts
}
where
rows pagePath' = (row pagePath') <$> Seq.fromFoldable docs
row { nodeId } contact = { row: contactCells { annuaireId: nodeId, frontends, contact, session }
, delete: false }
container = TT.defaultContainer -- TODO
colNames = TT.ColumnName <$> [ "", "First Name", "Last Name", "Company", "Role"]
wrapColElts = const identity
type AnnuaireId = Int
type ContactCellsProps =
( annuaireId :: AnnuaireId
, contact :: CT.NodeContact
, frontends :: Frontends
, session :: Session
)
contactCells :: Record ContactCellsProps -> R.Element
contactCells p = R.createElement contactCellsCpt p []
contactCellsCpt :: R.Component ContactCellsProps
contactCellsCpt = here.component "contactCells" cpt where
cpt { contact: CT.NodeContact
{ hyperdata: CT.HyperdataContact { who : Nothing } } } _ =
pure $ TT.makeRow
[ H.text ""
, H.span {} [ H.text "Name" ]
--, H.a { href, target: "blank" } [ H.text $ fromMaybe "name" contact.title ]
, H.text "No ContactWhere"
, H.text "No ContactWhereDept"
, H.div { className: "nooverflow" }
[ H.text "No ContactWhereRole" ]
]
cpt { annuaireId, frontends, session
, contact: CT.NodeContact
{ id, hyperdata: CT.HyperdataContact
{ who: Just (CT.ContactWho { firstName, lastName })
, ou: ou }}} _ = do
pure $ TT.makeRow [
H.text ""
, H.a { target: "_blank", href: contactUrl annuaireId id }
[ H.text $ fromMaybe "First Name" firstName ]
, H.text $ fromMaybe "First Name" lastName
-- , H.a { href } [ 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 ContactWhereDept" contactWhereDept (A.head $ ou)
-- , H.div {className: "nooverflow"} [
-- H.text $ maybe "No ContactWhereRole" contactWhereRole (A.head $ ou)
]
where
contactUrl aId id' = url frontends $ Routes.ContactPage (sessionId session) aId id'
contactWhereOrg (CT.ContactWhere { organization: [] }) = "No Organization"
contactWhereOrg (CT.ContactWhere { organization: orga }) =
fromMaybe "No orga (list)" (A.head orga)
contactWhereDept (CT.ContactWhere { labTeamDepts : [] }) = "Empty Dept"
contactWhereDept (CT.ContactWhere { labTeamDepts : dept }) =
fromMaybe "No Dept (list)" (A.head dept)
newtype HyperdataAnnuaire = HyperdataAnnuaire
{ title :: Maybe String
, desc :: Maybe String }
derive instance Generic HyperdataAnnuaire _
derive instance Newtype HyperdataAnnuaire _
instance Eq HyperdataAnnuaire where eq = genericEq
derive newtype instance JSON.ReadForeign HyperdataAnnuaire
------------------------------------------------------------------------------
newtype AnnuaireInfo =
AnnuaireInfo
{ id :: Int
, typename :: Int
, userId :: Int
, parentId :: Int
, name :: String
, date :: String
, hyperdata :: HyperdataAnnuaire
}
derive instance Generic AnnuaireInfo _
derive instance Newtype AnnuaireInfo _
instance Eq AnnuaireInfo where eq = genericEq
instance JSON.ReadForeign AnnuaireInfo where
readImpl f = do
inst <- JSON.readImpl f
pure $ AnnuaireInfo $ Record.rename user_idP userIdP $ Record.rename parent_idP parentIdP inst
where
user_idP = SProxy :: SProxy "user_id"
userIdP = SProxy :: SProxy "userId"
parent_idP = SProxy :: SProxy "parent_id"
parentIdP = SProxy :: SProxy "parentId"
--newtype AnnuaireTable = AnnuaireTable { annuaireTable :: Array (Maybe Contact)}
--instance DecodeJson AnnuaireTable where
-- decodeJson json = do
-- rows <- decodeJson json
-- pure $ AnnuaireTable { annuaireTable : rows}
------------------------------------------------------------------------
loadPage :: Session -> PagePath -> AffETableResult CT.NodeContact
loadPage session {nodeId, params: { offset, limit }} =
get session children
-- TODO orderBy
-- where
-- convOrderBy (T.ASC (T.ColumnName "Name")) = NameAsc
-- convOrderBy (T.DESC (T.ColumnName "Name")) = NameDesc
-- ...
-- convOrderBy _ = NameAsc -- TODO
where
children = Children NodeContact offset limit Nothing {-(convOrderBy <$> orderBy)-} (Just nodeId)
getAnnuaireInfo :: Session -> Int -> Aff (Either RESTError AnnuaireInfo)
getAnnuaireInfo session id = get session (NodeAPI Node (Just id) "")
Annuaire/ 0000775 0000000 0000000 00000000000 14111104351 0033274 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes Tabs.purs 0000664 0000000 0000000 00000010515 14111104351 0035102 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Annuaire -- TODO copy of Gargantext.Components.Nodes.Corpus.Tabs.Specs
module Gargantext.Components.Nodes.Annuaire.Tabs where
import Prelude hiding (div)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Data.Show.Generic (genericShow)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.DocsTable as DT
import Gargantext.Components.DocsTable.Types (Year)
import Gargantext.Components.NgramsTable as NT
import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (ContactData)
import Gargantext.Components.Nodes.Lists.Types as LTypes
import Gargantext.Components.Nodes.Texts.Types as TextsT
import Gargantext.Components.Tab as Tab
import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType(..), PTabNgramType(..), TabSubType(..), TabType(..))
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Record as Record
import Record.Extra as RX
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs"
data Mode = Patents | Books | Communication
derive instance Generic Mode _
instance Show Mode where
show = genericShow
derive instance Eq Mode
modeTabType :: Mode -> PTabNgramType
modeTabType Patents = PTabPatents
modeTabType Books = PTabBooks
modeTabType Communication = PTabCommunication
-- TODO fix this type
modeTabType' :: Mode -> CTabNgramType
modeTabType' Patents = CTabAuthors
modeTabType' Books = CTabAuthors
modeTabType' Communication = CTabAuthors
type TabsProps =
( boxes :: Boxes
, cacheState :: T.Box LTypes.CacheState
, contactData :: ContactData
, frontends :: Frontends
, nodeId :: Int
, session :: Session
, sidePanel :: T.Box (Maybe (Record TextsT.SidePanel))
)
tabs :: R2.Leaf TabsProps
tabs props = R.createElement tabsCpt props []
tabsCpt :: R.Component TabsProps
tabsCpt = here.component "tabs" cpt where
cpt props _ = do
activeTab <- T.useBox 0
yearFilter <- T.useBox (Nothing :: Maybe Year)
pure $ Tab.tabs { activeTab, tabs: tabs' yearFilter props }
tabs' yearFilter props@{ boxes, sidePanel } =
[ "Documents" /\ docs
, "Patents" /\ ngramsView (viewProps Patents)
, "Books" /\ ngramsView (viewProps Books)
, "Communication" /\ ngramsView (viewProps Communication)
, "Trash" /\ docs -- TODO pass-in trash mode
] where
viewProps mode = Record.merge props { defaultListId: props.contactData.defaultListId
, mode }
totalRecords = 4736 -- TODO lol
docs = DT.docViewLayout (Record.merge { boxes, sidePanel } $ Record.merge dtCommon dtExtra)
dtCommon = RX.pick props :: Record DTCommon
dtExtra =
{ chart: mempty
, listId: props.contactData.defaultListId
, mCorpusId: Nothing
, showSearch: true
, tabType: TabPairing TabDocs
, totalRecords
, yearFilter
}
type DTCommon =
( cacheState :: T.Box LTypes.CacheState
-- , contactData :: ContactData
, frontends :: Frontends
, nodeId :: Int
, session :: Session
-- , sidePanel :: T.Box (Record SidePanel)
)
type NgramsViewTabsProps =
( defaultListId :: Int
, mode :: Mode
| TabsProps )
ngramsView :: R2.Leaf NgramsViewTabsProps
ngramsView props = R.createElement ngramsViewCpt props []
ngramsViewCpt :: R.Component NgramsViewTabsProps
ngramsViewCpt = here.component "ngramsView" cpt where
cpt props@{ defaultListId, mode, nodeId, session } _ = do
path <- T.useBox $
NTC.initialPageParams session nodeId
[ defaultListId ] (TabDocument TabDocs)
pure $ NT.mainNgramsTable (props' path) [] where
most = RX.pick props :: Record NTCommon
props' path =
(Record.merge most
{ afterSync
, path
, tabType: TabPairing (TabNgramType $ modeTabType mode)
, tabNgramType: modeTabType' mode
, withAutoUpdate: false }) :: Record NT.MainNgramsTableProps
where
afterSync :: Unit -> Aff Unit
afterSync _ = pure unit
type NTCommon =
( boxes :: Boxes
, cacheState :: T.Box LTypes.CacheState
, defaultListId :: Int
, session :: Session
)
User.purs 0000664 0000000 0000000 00000023371 14111104351 0035133 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Annuaire module Gargantext.Components.Nodes.Annuaire.User
( module Gargantext.Components.Nodes.Annuaire.User.Contacts.Types
, userLayout
)
where
import Gargantext.Prelude
import Data.Either (Either)
import Data.Lens as L
import Data.Maybe (Maybe(..), fromMaybe)
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Nodes.Annuaire.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.Components.Nodes.Lists.Types as LT
import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as Routes
import Gargantext.Sessions (WithSession, WithSessionContext, Session, get, put, sessionId)
import Gargantext.Types (NodeType(..))
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Annuaire.User"
type DisplayProps = ( title :: String )
display :: R2.Component DisplayProps
display = R.createElement displayCpt
displayCpt :: R.Component DisplayProps
displayCpt = here.component "display" cpt
where
cpt { title } children = do
pure $ H.div { className: "container-fluid" }
[ H.div { className: "row", id: "contact-page-header" }
[ H.div { className: "col-md-6"} [ H.h3 {} [ H.text title ] ]
, H.div { className: "col-md-8"} []
, H.div { className: "col-md-2"} [ H.span {} [ H.text "" ] ]
]
, H.div { className: "row", id: "contact-page-info" }
[ H.div { className: "col-md-12" }
[ H.div { className: "row" }
[ H.div { className: "col-md-2" } [ H.img { src: "/images/Gargantextuel-212x300.jpg"} ]
, H.div { className: "col-md-1"} []
, H.div { className: "col-md-8"} children
]]]]
-- | TODO format data in better design (UI) shape
contactInfos :: HyperdataUser -> (HyperdataUser -> Effect Unit) -> Array R.Element
contactInfos h onUpdateHyperdata = item <$> contactInfoItems
where
item {label, defaultVal, lens} =
contactInfoItem { hyperdata: h
, label
, lens
, onUpdateHyperdata
, placeholder: defaultVal }
contactInfoItems :: Array {label:: String, defaultVal:: String, lens:: HyperdataUserLens}
contactInfoItems =
[ {label: "Last Name" , defaultVal: "Empty Last Name" , lens: _shared <<< _who <<< _lastName }
, {label: "First Name" , defaultVal: "Empty First Name" , lens: _shared <<< _who <<< _firstName }
, {label: "Organisation" , defaultVal: "Empty Organisation" , lens: _shared <<< _ouFirst <<< _organizationJoinComma}
, {label: "Lab/Team/Dept", defaultVal: "Empty Lab/Team/Dept", lens: _shared <<< _ouFirst <<< _labTeamDeptsJoinComma}
, {label: "Office" , defaultVal: "Empty Office" , lens: _shared <<< _ouFirst <<< _office }
, {label: "City" , defaultVal: "Empty City" , lens: _shared <<< _ouFirst <<< _city }
, {label: "Country" , defaultVal: "Empty Country" , lens: _shared <<< _ouFirst <<< _country }
, {label: "Role" , defaultVal: "Empty Role" , lens: _shared <<< _ouFirst <<< _role }
, {label: "Phone" , defaultVal: "Empty Phone" , lens: _shared <<< _ouFirst <<< _touch <<< _phone }
, {label: "Mail" , defaultVal: "Empty Mail" , lens: _shared <<< _ouFirst <<< _touch <<< _mail }
]
type HyperdataUserLens = L.ALens' HyperdataUser String
type ContactInfoItemProps =
( hyperdata :: HyperdataUser
, label :: String
, lens :: HyperdataUserLens
, onUpdateHyperdata :: HyperdataUser -> Effect Unit
, placeholder :: String
)
contactInfoItem :: Record ContactInfoItemProps -> R.Element
contactInfoItem props = R.createElement contactInfoItemCpt props []
contactInfoItemCpt :: R.Component ContactInfoItemProps
contactInfoItemCpt = here.component "contactInfoItem" cpt
where
cpt {hyperdata, label, lens, onUpdateHyperdata, placeholder} _ = do
isEditing <- T.useBox false
isEditing' <- T.useLive T.unequal isEditing
let value = (L.view cLens hyperdata) :: String
valueRef <- R.useRef value
pure $ H.div { className: "form-group row" } [
H.span { className: "col-sm-2 col-form-label" } [ H.text label ]
, item isEditing' isEditing valueRef
]
where
cLens = L.cloneLens lens
item false isEditing valueRef =
H.div { className: "input-group col-sm-6" } [
H.input { className: "form-control"
, defaultValue: placeholder'
, disabled: 1
, type: "text" }
, H.div { className: "btn input-group-append"
, on: { click: onClick } } [
H.div { className: "input-group-text fa fa-pencil" } []
]
]
where
placeholder' = R.readRef valueRef
onClick _ = T.write_ true isEditing
item true isEditing valueRef =
H.div { className: "input-group col-sm-6" } [
inputWithEnter {
autoFocus: true
, className: "form-control"
, defaultValue: R.readRef valueRef
, onBlur: R.setRef valueRef
, onEnter: onClick
, onValueChanged: R.setRef valueRef
, placeholder
, type: "text"
}
, H.div { className: "btn input-group-append"
, on: { click: onClick } } [
H.div { className: "input-group-text fa fa-floppy-o" } []
]
]
where
onClick _ = do
T.write_ true isEditing
let newHyperdata = (L.over cLens (\_ -> R.readRef valueRef) hyperdata) :: HyperdataUser
onUpdateHyperdata newHyperdata
{-
listElement :: Array R.Element -> R.Element
listElement = H.li { className: "list-group-item justify-content-between" }
-}
type LayoutNoSessionProps =
( boxes :: Boxes
, frontends :: Frontends
, nodeId :: Int
)
type LayoutProps = WithSession LayoutNoSessionProps
type LayoutSessionContextProps = WithSessionContext LayoutNoSessionProps
type KeyLayoutProps = (
key :: String
| LayoutProps
)
userLayout :: R2.Component LayoutProps
userLayout = R.createElement userLayoutCpt
userLayoutCpt :: R.Component LayoutProps
userLayoutCpt = here.component "userLayout" cpt
where
cpt props@{ nodeId
, session } _ = do
let sid = sessionId session
pure $ userLayoutWithKey $ Record.merge props { key: show sid <> "-" <> show nodeId }
userLayoutWithKey :: R2.Leaf KeyLayoutProps
userLayoutWithKey props = R.createElement userLayoutWithKeyCpt props []
userLayoutWithKeyCpt :: R.Component KeyLayoutProps
userLayoutWithKeyCpt = here.component "userLayoutWithKey" cpt where
cpt { boxes: boxes@{ sidePanelTexts }
, frontends
, nodeId
, session } _ = do
reload <- T.useBox T2.newReload
reload' <- T.useLive T.unequal reload
cacheState <- T.useBox LT.CacheOn
useLoader { errorHandler
, loader: getUserWithReload
, path: { nodeId, reload: reload', session }
, render: \contactData@{contactNode: Contact {name, hyperdata}} ->
H.ul { className: "col-md-12 list-group" } [
display { title: fromMaybe "no name" name }
(contactInfos hyperdata (onUpdateHyperdata reload))
, Tabs.tabs {
boxes
, cacheState
, contactData
, frontends
, nodeId
, session
, sidePanel: sidePanelTexts
}
]
}
where
errorHandler err = here.log2 "[userLayoutWithKey] RESTError" err
onUpdateHyperdata :: T2.ReloadS -> HyperdataUser -> Effect Unit
onUpdateHyperdata reload hd = do
launchAff_ $ do
_ <- saveContactHyperdata session nodeId hd
liftEffect $ T2.reload reload
-- | toUrl to get data XXX
getContact :: Session -> Int -> Aff (Either RESTError ContactData)
getContact session id = do
eContactNode <- get session $ Routes.NodeAPI Node (Just id) ""
-- TODO: we need a default list for the pairings
--defaultListIds <- get $ toUrl endConfigStateful Back (Children NodeList 0 1 Nothing) $ Just id
--case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of
-- Just (NodePoly { id: defaultListId }) ->
-- pure {contactNode, defaultListId}
-- Nothing ->
-- throwError $ error "Missing default list"
pure $ (\contactNode -> { contactNode, defaultListId: 424242 }) <$> eContactNode
getUserWithReload :: { nodeId :: Int
, reload :: T2.Reload
, session :: Session} -> Aff (Either RESTError ContactData)
getUserWithReload {nodeId, session} = getContact session nodeId
saveContactHyperdata :: Session -> Int -> HyperdataUser -> Aff (Either RESTError Int)
saveContactHyperdata session id h = do
put session (Routes.NodeAPI Node (Just id) "") h
User/ 0000775 0000000 0000000 00000000000 14111104351 0034212 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Annuaire Contact.purs 0000664 0000000 0000000 00000022471 14111104351 0036526 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Annuaire/User module Gargantext.Components.Nodes.Annuaire.User.Contact
( module Gargantext.Components.Nodes.Annuaire.User.Contacts.Types
, contactLayout
) where
import Gargantext.Prelude
import Data.Either (Either)
import Data.Lens as L
import Data.Maybe (Maybe(..), fromMaybe)
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.InputWithEnter (inputWithEnter)
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.Components.Nodes.Lists.Types as LT
import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, get, put, sessionId)
import Gargantext.Types (NodeType(..))
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Annuaire.User.Contact"
type DisplayProps = ( title :: String )
display :: R2.Component DisplayProps
display = R.createElement displayCpt
displayCpt :: R.Component DisplayProps
displayCpt = here.component "display" cpt
where
cpt { title } children = do
pure $ H.div { className: "container-fluid" }
[ H.div { className: "row", id: "contact-page-header" }
[ H.div { className: "col-md-6"} [ H.h3 {} [ H.text title ] ]
, H.div { className: "col-md-8"} []
, H.div { className: "col-md-2"} [ H.span {} [ H.text "" ] ]
]
, H.div { className: "row", id: "contact-page-info" }
[ H.div { className: "col-md-12" }
[ H.div { className: "row" }
[ H.div { className: "col-md-2" } [ H.img { src: "/images/Gargantextuel-212x300.jpg"} ]
, H.div { className: "col-md-1"} []
, H.div { className: "col-md-8"} children
]]]]
-- | TODO format data in better design (UI) shape
contactInfos :: HyperdataContact -> (HyperdataContact -> Effect Unit) -> Array R.Element
contactInfos h onUpdateHyperdata = item <$> contactInfoItems where
item { label, lens, defaultVal: placeholder } =
contactInfoItem { label, lens, onUpdateHyperdata, placeholder, hyperdata: h }
contactInfoItems :: Array {label:: String, defaultVal:: String, lens:: HyperdataContactLens}
contactInfoItems =
[ {label: "Last Name" , defaultVal: "Empty Last Name" , lens: _who <<< _lastName }
, {label: "First Name" , defaultVal: "Empty First Name" , lens: _who <<< _firstName }
, {label: "Organisation" , defaultVal: "Empty Organisation" , lens: _ouFirst <<< _organizationJoinComma}
, {label: "Lab/Team/Dept", defaultVal: "Empty Lab/Team/Dept", lens: _ouFirst <<< _labTeamDeptsJoinComma}
, {label: "Office" , defaultVal: "Empty Office" , lens: _ouFirst <<< _office }
, {label: "City" , defaultVal: "Empty City" , lens: _ouFirst <<< _city }
, {label: "Country" , defaultVal: "Empty Country" , lens: _ouFirst <<< _country }
, {label: "Role" , defaultVal: "Empty Role" , lens: _ouFirst <<< _role }
, {label: "Phone" , defaultVal: "Empty Phone" , lens: _ouFirst <<< _touch <<< _phone }
, {label: "Mail" , defaultVal: "Empty Mail" , lens: _ouFirst <<< _touch <<< _mail }
]
type HyperdataContactLens = L.ALens' HyperdataContact String
type ContactInfoItemProps =
( hyperdata :: HyperdataContact
, label :: String
, lens :: HyperdataContactLens
, onUpdateHyperdata :: HyperdataContact -> Effect Unit
, placeholder :: String
)
contactInfoItem :: R2.Leaf ContactInfoItemProps
contactInfoItem props = R.createElement contactInfoItemCpt props []
contactInfoItemCpt :: R.Component ContactInfoItemProps
contactInfoItemCpt = here.component "contactInfoItem" cpt
where
cpt { hyperdata, label, lens, onUpdateHyperdata, placeholder } _ = do
isEditing <- T.useBox false
isEditing' <- T.useLive T.unequal isEditing
let value = (L.view cLens hyperdata) :: String
valueRef <- R.useRef value
pure $
H.div { className: "form-group row" }
[ H.span { className: "col-sm-2 col-form-label" } [ H.text label ]
, item isEditing' isEditing valueRef ]
where
cLens = L.cloneLens lens
item false isEditing valueRef =
H.div { className: "input-group col-sm-6" }
[ H.input
{ className: "form-control", type: "text"
, defaultValue: placeholder', disabled: true }
, H.div { className: "btn input-group-append", on: { click } }
[ H.div { className: "input-group-text fa fa-pencil" } [] ]]
where
placeholder' = R.readRef valueRef
click _ = T.write_ true isEditing
item true isEditing valueRef =
H.div { className: "input-group col-sm-6" }
[ inputWithEnter
{ autoFocus: true
, className: "form-control"
, defaultValue: R.readRef valueRef
, onBlur: R.setRef valueRef
, onEnter: click
, onValueChanged: R.setRef valueRef
, placeholder
, type: "text" }
, H.div { className: "btn input-group-append", on: { click } }
[ H.div { className: "input-group-text fa fa-floppy-o" } [] ]]
where
click _ = do
T.write_ false isEditing
let newHyperdata = (L.over cLens (\_ -> R.readRef valueRef) hyperdata) :: HyperdataContact
onUpdateHyperdata newHyperdata
type ReloadProps =
( boxes :: Boxes
, frontends :: Frontends
, nodeId :: Int
)
type LayoutProps =
( session :: Session
| ReloadProps )
type KeyLayoutProps =
( key :: String
, session :: Session
| ReloadProps )
saveContactHyperdata :: Session -> Int -> HyperdataContact -> Aff (Either RESTError Int)
saveContactHyperdata session id = put session (Routes.NodeAPI Node (Just id) "")
type AnnuaireLayoutProps = ( annuaireId :: Int, session :: Session | ReloadProps )
type AnnuaireKeyLayoutProps = ( annuaireId :: Int | KeyLayoutProps )
contactLayout :: R2.Component AnnuaireLayoutProps
contactLayout = R.createElement contactLayoutCpt
contactLayoutCpt :: R.Component AnnuaireLayoutProps
contactLayoutCpt = here.component "contactLayout" cpt where
cpt props@{ nodeId
, session } _ = do
let key = show (sessionId session) <> "-" <> show nodeId
pure $
contactLayoutWithKey $ Record.merge props { key }
contactLayoutWithKey :: R2.Leaf AnnuaireKeyLayoutProps
contactLayoutWithKey props = R.createElement contactLayoutWithKeyCpt props []
contactLayoutWithKeyCpt :: R.Component AnnuaireKeyLayoutProps
contactLayoutWithKeyCpt = here.component "contactLayoutWithKey" cpt where
cpt { annuaireId
, boxes: boxes@{ sidePanelTexts }
, frontends
, nodeId
, session } _ = do
reload <- T.useBox T2.newReload
_ <- T.useLive T.unequal reload
cacheState <- T.useBox LT.CacheOn
useLoader { errorHandler
, loader: getAnnuaireContact session annuaireId
, path: nodeId
, render: \contactData@{contactNode: Contact' {name, hyperdata}} ->
H.ul { className: "col-md-12 list-group" }
[ display { title: fromMaybe "no name" name }
(contactInfos hyperdata (onUpdateHyperdata reload))
, Tabs.tabs
{ boxes
, cacheState
, contactData
, frontends
, nodeId
, session
, sidePanel: sidePanelTexts
} ] }
where
errorHandler err = here.log2 "[contactLayoutWithKey] RESTError" err
onUpdateHyperdata :: T2.ReloadS -> HyperdataContact -> Effect Unit
onUpdateHyperdata reload hd =
launchAff_ $
saveContactHyperdata session nodeId hd *> liftEffect (T2.reload reload)
getAnnuaireContact :: Session -> Int -> Int -> Aff (Either RESTError ContactData')
getAnnuaireContact session annuaireId id = do
eContactNode <- get session $ Routes.NodeAPI Annuaire (Just annuaireId) $ show id
-- TODO: we need a default list for the pairings
--defaultListIds <- get $ toUrl endConfigStateful Back (Children NodeList 0 1 Nothing) $ Just id
--case (head defaultListIds :: Maybe (NodePoly HyperdataList)) of
-- Just (NodePoly { id: defaultListId }) ->
-- pure {contactNode, defaultListId}
-- Nothing ->
-- throwError $ error "Missing default list"
pure $ (\contactNode -> { contactNode, defaultListId: 424242 }) <$> eContactNode
Contacts/ 0000775 0000000 0000000 00000000000 14111104351 0035770 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Annuaire/User Tabs.purs 0000664 0000000 0000000 00000011634 14111104351 0037601 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Annuaire/User/Contacts -- TODO copy of Gargantext.Components.Nodes.Corpus.Tabs.Specs
module Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs where
import Gargantext.Prelude
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Data.Show.Generic (genericShow)
import Data.Tuple.Nested ((/\))
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.DocsTable as DT
import Gargantext.Components.DocsTable.Types (Year)
import Gargantext.Components.NgramsTable as NT
import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Components.Nodes.Annuaire.User.Contacts.Types (ContactData')
import Gargantext.Components.Nodes.Lists.Types as LTypes
import Gargantext.Components.Nodes.Texts.Types as TTypes
import Gargantext.Components.Tab as Tab
import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType(..), FrontendError, PTabNgramType(..), SidePanelState, TabSubType(..), TabType(..))
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Annuaire.User.Contacts.Tabs"
data Mode = Patents | Books | Communication
derive instance Generic Mode _
instance Show Mode where
show = genericShow
derive instance Eq Mode
modeTabType :: Mode -> PTabNgramType
modeTabType Patents = PTabPatents
modeTabType Books = PTabBooks
modeTabType Communication = PTabCommunication
-- TODO fix this type
modeTabType' :: Mode -> CTabNgramType
modeTabType' Patents = CTabAuthors
modeTabType' Books = CTabAuthors
modeTabType' Communication = CTabAuthors
type TabsProps = (
boxes :: Boxes
, cacheState :: T.Box LTypes.CacheState
, contactData :: ContactData'
, frontends :: Frontends
, nodeId :: Int
, session :: Session
, sidePanel :: T.Box (Maybe (Record TTypes.SidePanel))
)
tabs :: R2.Leaf TabsProps
tabs props = R.createElement tabsCpt props []
tabsCpt :: R.Component TabsProps
tabsCpt = here.component "tabs" cpt
where
cpt { boxes
, cacheState
, contactData: {defaultListId}
, frontends
, nodeId
, session
, sidePanel
} _ = do
activeTab <- T.useBox 0
yearFilter <- T.useBox (Nothing :: Maybe Year)
pure $ Tab.tabs { activeTab, tabs: tabs' yearFilter }
where
tabs' yearFilter =
[ "Documents" /\ docs
, "Patents" /\ ngramsView patentsView []
, "Books" /\ ngramsView booksView []
, "Communication" /\ ngramsView commView []
, "Trash" /\ docs -- TODO pass-in trash mode
]
where
patentsView = { boxes
, cacheState
, defaultListId
, mode: Patents
, nodeId
, session
}
booksView = { boxes
, cacheState
, defaultListId
, mode: Books
, nodeId
, session
}
commView = { boxes
, cacheState
, defaultListId
, mode: Communication
, nodeId
, session
}
chart = mempty
totalRecords = 4736 -- TODO
docs = DT.docViewLayout
{ boxes
, cacheState
, chart
, frontends
, listId: defaultListId
, mCorpusId: Nothing
, nodeId
, session
, showSearch: true
, sidePanel
, tabType: TabPairing TabDocs
, totalRecords
, yearFilter
}
type NgramsViewTabsProps = (
boxes :: Boxes
, cacheState :: T.Box LTypes.CacheState
, defaultListId :: Int
, mode :: Mode
, nodeId :: Int
, session :: Session
)
ngramsView :: R2.Component NgramsViewTabsProps
ngramsView = R.createElement ngramsViewCpt
ngramsViewCpt :: R.Component NgramsViewTabsProps
ngramsViewCpt = here.component "ngramsView" cpt
where
cpt { boxes
, cacheState
, defaultListId
, mode
, nodeId
, session } _ = do
path <- T.useBox $ NTC.initialPageParams session nodeId [defaultListId] (TabDocument TabDocs)
pure $ NT.mainNgramsTable {
afterSync: \_ -> pure unit
, boxes
, cacheState
, defaultListId
, path
, session
, tabNgramType
, tabType
, withAutoUpdate: false
} []
where
tabNgramType = modeTabType' mode
tabType = TabPairing $ TabNgramType $ modeTabType mode
Types.purs 0000664 0000000 0000000 00000026403 14111104351 0040014 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Annuaire/User/Contacts module Gargantext.Components.Nodes.Annuaire.User.Contacts.Types where
import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Lens (Lens', lens)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Newtype (class Newtype)
import Data.String as S
import Data.Symbol (SProxy(..))
import Record as Record
import Simple.JSON as JSON
import Gargantext.Prelude (class Eq, bind, pure, ($))
-- 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
}
derive instance Generic NodeContact _
derive instance Newtype NodeContact _
instance Eq NodeContact where eq = genericEq
instance JSON.ReadForeign NodeContact where
readImpl f = do
inst <- JSON.readImpl f
pure $ NodeContact $ Record.rename parent_idP parentIdP $ Record.rename user_idP userIdP inst
----------------------------------------------------------------------------
newtype Contact' =
Contact'
{ id :: Int
, date :: Maybe String
, hyperdata :: HyperdataContact
, name :: Maybe String
, parentId :: Maybe Int
, typename :: Maybe Int
, userId :: Maybe Int
}
derive instance Generic Contact' _
derive instance Newtype Contact' _
instance Eq Contact' where eq = genericEq
instance JSON.ReadForeign Contact' where
readImpl f = do
inst <- JSON.readImpl f
pure $ Contact' $ Record.rename parent_idP parentIdP $ Record.rename user_idP userIdP inst
-- | TODO rename Contact with User
-- and fix shared decodeJson
newtype Contact =
Contact
{ id :: Int
, date :: Maybe String
, hyperdata :: HyperdataUser
, name :: Maybe String
, parentId :: Maybe Int
, typename :: Maybe Int
, userId :: Maybe Int
}
derive instance Generic Contact _
derive instance Newtype Contact _
instance Eq Contact where eq = genericEq
instance JSON.ReadForeign Contact where
readImpl f = do
inst <- JSON.readImpl f
pure $ Contact $ Record.rename parent_idP parentIdP $ Record.rename user_idP userIdP inst
----------------------------------------------------------------------------
newtype User =
User
{ id :: Int
, date :: Maybe String
, hyperdata :: HyperdataUser
, name :: Maybe String
, parentId :: Maybe Int
, typename :: Maybe Int
, userId :: Maybe Int
}
derive instance Generic User _
derive instance Newtype User _
instance JSON.ReadForeign User where
readImpl f = do
inst <- JSON.readImpl f
pure $ User $ Record.rename parent_idP parentIdP $ Record.rename user_idP userIdP inst
newtype ContactWho =
ContactWho
{ idWho :: Maybe String
, firstName :: Maybe String
, lastName :: Maybe String
, keywords :: (Array String)
, freetags :: (Array String)
}
derive instance Newtype ContactWho _
derive instance Generic ContactWho _
instance Eq ContactWho where eq = genericEq
instance JSON.ReadForeign ContactWho where
readImpl f = do
inst <- JSON.readImpl f
pure $ ContactWho $ inst { keywords = fromMaybe [] inst.keywords
, freetags = fromMaybe [] inst.freetags }
derive newtype instance JSON.WriteForeign ContactWho
defaultContactWho :: ContactWho
defaultContactWho =
ContactWho {
idWho: Nothing
, firstName: Nothing
, lastName: Nothing
, keywords: []
, freetags: []
}
newtype 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 Newtype ContactWhere _
derive instance Generic ContactWhere _
instance Eq ContactWhere where eq = genericEq
instance JSON.ReadForeign ContactWhere where
readImpl f = do
inst <- JSON.readImpl f
pure $ ContactWhere $ inst { organization = fromMaybe [] inst.organization
, labTeamDepts = fromMaybe [] inst.labTeamDepts }
derive newtype instance JSON.WriteForeign ContactWhere
defaultContactWhere :: ContactWhere
defaultContactWhere =
ContactWhere {
organization: []
, labTeamDepts: []
, role: Nothing
, office: Nothing
, country: Nothing
, city: Nothing
, touch: Nothing
, entry: Nothing
, exit: Nothing
}
newtype ContactTouch =
ContactTouch
{ mail :: Maybe String
, phone :: Maybe String
, url :: Maybe String }
derive instance Newtype ContactTouch _
derive instance Generic ContactTouch _
instance Eq ContactTouch where eq = genericEq
derive newtype instance JSON.ReadForeign ContactTouch
derive newtype instance JSON.WriteForeign ContactTouch
defaultContactTouch :: ContactTouch
defaultContactTouch =
ContactTouch {
mail: Nothing
, phone: Nothing
, url: Nothing
}
type HyperdataContactT =
( bdd :: Maybe String
, lastValidation :: Maybe String
, source :: Maybe String
, title :: Maybe String
, uniqId :: Maybe String
, uniqIdBdd :: Maybe String
, who :: Maybe ContactWho
)
newtype HyperdataContact =
HyperdataContact { ou :: Array ContactWhere
| HyperdataContactT
}
derive instance Newtype HyperdataContact _
derive instance Generic HyperdataContact _
instance Eq HyperdataContact where eq = genericEq
instance JSON.ReadForeign HyperdataContact where
readImpl f = do
inst :: { where :: Maybe (Array ContactWhere) | HyperdataContactT } <- JSON.readImpl f
pure $ HyperdataContact { bdd: inst.bdd
, lastValidation: inst.lastValidation
, ou: fromMaybe [] inst.where
, source: inst.source
, title: inst.title
, uniqId: inst.uniqId
, uniqIdBdd: inst.uniqIdBdd
, who: inst.who }
instance JSON.WriteForeign HyperdataContact
where
writeImpl (HyperdataContact hc) = JSON.writeImpl { bdd: hc.bdd
, lastValidation: hc.lastValidation
, where: hc.ou
, source: hc.source
, title: hc.title
, uniqId: hc.uniqId
, uniqIdBdd: hc.uniqIdBdd
, who: hc.who }
defaultHyperdataContact :: HyperdataContact
defaultHyperdataContact =
HyperdataContact { bdd: Nothing
, who: Nothing
, ou: []
, title: Nothing
, source: Nothing
, lastValidation: Nothing
, uniqId: Nothing
, uniqIdBdd: Nothing
}
newtype HyperdataUser =
HyperdataUser {
shared :: Maybe HyperdataContact
}
derive instance Newtype HyperdataUser _
derive instance Generic HyperdataUser _
instance Eq HyperdataUser where eq = genericEq
derive newtype instance JSON.ReadForeign HyperdataUser
derive newtype instance JSON.WriteForeign HyperdataUser
defaultHyperdataUser :: HyperdataUser
defaultHyperdataUser =
HyperdataUser {
shared: Just defaultHyperdataContact
}
-- newtype HyperData c s =
-- HyperData
-- { common :: c
-- , shared :: s
-- , specific :: Map String String
-- }
-- instance (DecodeJson c, DecodeJson s) =>
-- DecodeJson (HyperData c s) where
-- decodeJson json = do
-- common <- decodeJson json
-- shared <- decodeJson json
-- specific <- decodeJson json
-- pure $ HyperData {common, shared, specific}
type ContactData = {contactNode :: Contact, defaultListId :: Int}
type ContactData' = {contactNode :: Contact', defaultListId :: Int}
_shared :: Lens' HyperdataUser HyperdataContact
_shared = lens getter setter
where
getter (HyperdataUser {shared}) = fromMaybe defaultHyperdataContact shared
setter (HyperdataUser h) val = HyperdataUser $ h { shared = Just val }
_who :: Lens' HyperdataContact ContactWho
_who = lens getter setter
where
getter (HyperdataContact {who}) = fromMaybe defaultContactWho who
setter (HyperdataContact hc) val = HyperdataContact $ hc { who = Just val }
_ouFirst :: Lens' HyperdataContact ContactWhere
_ouFirst = lens getter setter
where
getter (HyperdataContact {ou}) = fromMaybe defaultContactWhere $ A.head ou
setter (HyperdataContact hc@{ou}) val = HyperdataContact $ hc { ou = fromMaybe [val] $ A.updateAt 0 val ou }
_lastName :: Lens' ContactWho String
_lastName = lens getter setter
where
getter (ContactWho {lastName}) = fromMaybe "" lastName
setter (ContactWho cw) val = ContactWho $ cw { lastName = Just val }
_firstName :: Lens' ContactWho String
_firstName = lens getter setter
where
getter (ContactWho {firstName}) = fromMaybe "" firstName
setter (ContactWho cw) val = ContactWho $ cw { firstName = Just val }
_organizationJoinComma :: Lens' ContactWhere String
_organizationJoinComma = lens getter setter
where
getter (ContactWhere {organization}) = S.joinWith pattern organization
setter (ContactWhere cw) val = ContactWhere $ cw { organization = S.split (S.Pattern pattern) val }
pattern = ", "
_labTeamDeptsJoinComma :: Lens' ContactWhere String
_labTeamDeptsJoinComma = lens getter setter
where
getter (ContactWhere {labTeamDepts}) = S.joinWith pattern labTeamDepts
setter (ContactWhere cw) val = ContactWhere $ cw { labTeamDepts = S.split (S.Pattern pattern) val }
pattern = ", "
_office :: Lens' ContactWhere String
_office = lens getter setter
where
getter (ContactWhere {office}) = fromMaybe "" office
setter (ContactWhere cw) val = ContactWhere $ cw { office = Just val }
_city :: Lens' ContactWhere String
_city = lens getter setter
where
getter (ContactWhere {city}) = fromMaybe "" city
setter (ContactWhere cw) val = ContactWhere $ cw { city = Just val }
_country :: Lens' ContactWhere String
_country = lens getter setter
where
getter (ContactWhere {country}) = fromMaybe "" country
setter (ContactWhere cw) val = ContactWhere $ cw { country = Just val }
_role :: Lens' ContactWhere String
_role = lens getter setter
where
getter (ContactWhere {role}) = fromMaybe "" role
setter (ContactWhere cw) val = ContactWhere $ cw { role = Just val }
_touch :: Lens' ContactWhere ContactTouch
_touch = lens getter setter
where
getter (ContactWhere {touch}) = fromMaybe defaultContactTouch touch
setter (ContactWhere cw) val = ContactWhere $ cw { touch = Just val }
_mail :: Lens' ContactTouch String
_mail = lens getter setter
where
getter (ContactTouch {mail}) = fromMaybe "" mail
setter (ContactTouch ct) val = ContactTouch $ ct { mail = Just val }
_phone :: Lens' ContactTouch String
_phone = lens getter setter
where
getter (ContactTouch {phone}) = fromMaybe "" phone
setter (ContactTouch ct) val = ContactTouch $ ct { phone = Just val }
user_idP = SProxy :: SProxy "user_id"
userIdP = SProxy :: SProxy "userId"
parent_idP = SProxy :: SProxy "parent_id"
parentIdP = SProxy :: SProxy "parentId"
Corpus.purs 0000664 0000000 0000000 00000056352 14111104351 0033733 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes module Gargantext.Components.Nodes.Corpus where
import Data.Array as A
import Data.Either (Either(..))
import Data.Eq.Generic (genericEq)
import Data.Generic.Rep (class Generic)
import Data.List as List
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Show.Generic (genericShow)
import Effect (Effect)
import Effect.Aff (Aff, launchAff_, throwError)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.CodeEditor as CE
import Gargantext.Components.FolderView as FV
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Node (NodePoly(..), HyperdataList)
import Gargantext.Components.Nodes.Corpus.Types (CorpusData, Hyperdata(..))
import Gargantext.Components.Nodes.Types (FTField, FTFieldList(..), FTFieldWithIndex, FTFieldsWithIndex(..), Field(..), FieldType(..), Hash, Index, defaultField, defaultHaskell', defaultJSON', defaultMarkdown', defaultPython')
import Gargantext.Config.REST (RESTError(..))
import Gargantext.Data.Array as GDA
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (class Eq, class Show, Unit, bind, discard, pure, show, unit, ($), (+), (-), (<), (<$>), (<<<), (<>), (==), (>))
import Gargantext.Routes (SessionRoute(Children, NodeAPI))
import Gargantext.Sessions (Session, get, put, sessionId)
import Gargantext.Types (AffETableResult, NodeType(..))
import Gargantext.Utils.Crypto as Crypto
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus"
type Props =
( boxes :: Boxes
, nodeId :: Int
, session :: Session )
corpusLayout :: R2.Leaf Props
corpusLayout props = R.createElement corpusLayoutCpt props []
corpusLayoutCpt :: R.Component Props
corpusLayoutCpt = here.component "corpusLayout" cpt where
cpt { boxes, nodeId, session } _ = do
pure $ corpusLayoutMain { boxes, key, nodeId, session }
where
key = show (sessionId session) <> "-" <> show nodeId
type KeyProps =
( boxes :: Boxes
, key :: String
, nodeId :: Int
, session :: Session
)
corpusLayoutMain :: R2.Leaf KeyProps
corpusLayoutMain props = R.createElement corpusLayoutMainCpt props []
corpusLayoutMainCpt :: R.Component KeyProps
corpusLayoutMainCpt = here.component "corpusLayoutMain" cpt
where
cpt { boxes, key, nodeId, session } _ = do
viewType <- T.useBox Folders
pure $ H.div {} [
H.div {} [
H.div { className: "row" } [
H.div { className: "col-1" } [ viewTypeSelector {state: viewType} ]
, H.div { className: "col-1" } [ FV.homeButton ]
]
]
, H.div {} [corpusLayoutSelection { boxes, key, session, state: viewType, nodeId }]
]
type SelectionProps =
( boxes :: Boxes
, nodeId :: Int
, key :: String
, session :: Session
, state :: T.Box ViewType
)
corpusLayoutSelection :: R2.Leaf SelectionProps
corpusLayoutSelection props = R.createElement corpusLayoutSelectionCpt props []
corpusLayoutSelectionCpt :: R.Component SelectionProps
corpusLayoutSelectionCpt = here.component "corpusLayoutSelection" cpt where
cpt { boxes, key, nodeId, session, state } _ = do
state' <- T.useLive T.unequal state
viewType <- T.read state
pure $ renderContent viewType nodeId session key boxes
renderContent Folders nodeId session _ boxes =
FV.folderView { backFolder: true
, boxes
, nodeId
, session
}
renderContent Code nodeId session key _ = corpusLayoutWithKey { key, nodeId, session }
type CorpusKeyProps =
( nodeId :: Int
, key :: String
, session :: Session
)
corpusLayoutWithKey :: R2.Leaf CorpusKeyProps
corpusLayoutWithKey props = R.createElement corpusLayoutWithKeyCpt props []
corpusLayoutWithKeyCpt :: R.Component CorpusKeyProps
corpusLayoutWithKeyCpt = here.component "corpusLayoutWithKey" cpt where
cpt { nodeId, session } _ = do
reload <- T.useBox T2.newReload
reload' <- T.useLive T.unequal reload
useLoader { errorHandler
, loader: loadCorpusWithReload
, path: { nodeId, reload: reload', session }
, render: \corpus -> corpusLayoutView { corpus, nodeId, reload, session } }
where
errorHandler err = here.log2 "[corpusLayoutWithKey] RESTError" err
type ViewProps =
( corpus :: NodePoly Hyperdata
, nodeId :: Int
, reload :: T2.ReloadS
, session :: Session
)
corpusLayoutView :: Record ViewProps -> R.Element
corpusLayoutView props = R.createElement corpusLayoutViewCpt props []
corpusLayoutViewCpt :: R.Component ViewProps
corpusLayoutViewCpt = here.component "corpusLayoutView" cpt
where
cpt {corpus: (NodePoly {hyperdata: Hyperdata {fields: FTFieldList fields}}), nodeId, reload, session} _ = do
let fieldsWithIndex = FTFieldsWithIndex $ List.mapWithIndex (\idx -> \ftField -> { idx, ftField }) fields
fieldsS <- T.useBox fieldsWithIndex
fields' <- T.useLive T.unequal fieldsS
fieldsRef <- R.useRef fields
-- handle props change of fields
R.useEffect1' fields $ do
if R.readRef fieldsRef == fields then
pure unit
else do
R.setRef fieldsRef fields
T.write_ fieldsWithIndex fieldsS
pure $ H.div {}
[ H.div { className: "row" }
[ H.div { className: "btn btn-primary " <> (saveEnabled fieldsWithIndex fields')
, on: { click: onClickSave {fields: fields', nodeId, reload, session} }
}
[ H.span { className: "fa fa-floppy-o" } [ ] ]
]
, H.div {}
[ fieldsCodeEditor { fields: fieldsS
, nodeId
, session } [] ]
, H.div { className: "row" }
[ H.div { className: "btn btn-primary"
, on: { click: onClickAdd fieldsS }
}
[ H.span { className: "fa fa-plus" } [ ]
]
]
]
saveEnabled :: FTFieldsWithIndex -> FTFieldsWithIndex -> String
saveEnabled fs fsS = if fs == fsS then "disabled" else "enabled"
onClickSave :: forall e. { fields :: FTFieldsWithIndex
, nodeId :: Int
, reload :: T2.ReloadS
, session :: Session } -> e -> Effect Unit
onClickSave {fields: FTFieldsWithIndex fields, nodeId, reload, session} _ = do
launchAff_ do
res <- saveCorpus $ { hyperdata: Hyperdata {fields: FTFieldList $ (_.ftField) <$> fields}
, nodeId
, session }
liftEffect $ do
_ <- case res of
Left err -> here.log2 "[corpusLayoutView] onClickSave RESTError" err
_ -> pure unit
T2.reload reload
onClickAdd :: forall e. T.Box FTFieldsWithIndex -> e -> Effect Unit
onClickAdd fieldsS _ = do
T.modify_ (\(FTFieldsWithIndex fs) -> FTFieldsWithIndex $
List.snoc fs $ { idx: List.length fs, ftField: defaultField }) fieldsS
type FieldsCodeEditorProps =
(
fields :: T.Box FTFieldsWithIndex
| LoadProps
)
fieldsCodeEditor :: R2.Component FieldsCodeEditorProps
fieldsCodeEditor = R.createElement fieldsCodeEditorCpt
fieldsCodeEditorCpt :: R.Component FieldsCodeEditorProps
fieldsCodeEditorCpt = here.component "fieldsCodeEditorCpt" cpt
where
cpt { fields, nodeId, session } _ = do
(FTFieldsWithIndex fields') <- T.useLive T.unequal fields
masterKey <- T.useBox T2.newReload
masterKey' <- T.useLive T.unequal masterKey
let editorsMap { idx, ftField } =
fieldCodeEditorWrapper { canMoveDown: idx < (List.length fields' - 1)
, canMoveUp: idx > 0
, field: ftField
, key: (show masterKey') <> "-" <> (show idx)
, onChange: onChange idx
, onMoveDown: onMoveDown masterKey idx
, onMoveUp: onMoveUp masterKey idx
, onRemove: onRemove idx
, onRename: onRename idx
}
pure $ H.div {} $ List.toUnfoldable (editorsMap <$> fields')
where
onChange :: Index -> FieldType -> Effect Unit
onChange idx typ = do
T.modify_ (\(FTFieldsWithIndex fs) ->
FTFieldsWithIndex $ fromMaybe fs $
List.modifyAt idx (\{ ftField: Field f} -> { idx, ftField: Field $ f { typ = typ } }) fs) fields
onMoveDown :: T2.ReloadS -> Index -> Unit -> Effect Unit
onMoveDown masterKey idx _ = do
T2.reload masterKey
T.modify_ (\(FTFieldsWithIndex fs) -> recomputeIndices $ FTFieldsWithIndex $ GDA.swapList idx (idx + 1) fs) fields
onMoveUp :: T2.ReloadS -> Index -> Unit -> Effect Unit
onMoveUp masterKey idx _ = do
T2.reload masterKey
T.modify_ (\(FTFieldsWithIndex fs) -> recomputeIndices $ FTFieldsWithIndex $ GDA.swapList idx (idx - 1) fs) fields
onRemove :: Index -> Unit -> Effect Unit
onRemove idx _ = do
T.modify_ (\(FTFieldsWithIndex fs) -> FTFieldsWithIndex $ fromMaybe fs $ List.deleteAt idx fs) fields
onRename :: Index -> String -> Effect Unit
onRename idx newName = do
T.modify_ (\(FTFieldsWithIndex fs) ->
FTFieldsWithIndex $ fromMaybe fs $
List.modifyAt idx (\{ ftField: Field f } -> { idx, ftField: Field $ f { name = newName } }) fs) fields
recomputeIndices :: FTFieldsWithIndex -> FTFieldsWithIndex
recomputeIndices (FTFieldsWithIndex lst) = FTFieldsWithIndex $ List.mapWithIndex (\idx -> \{ ftField } -> { idx, ftField }) lst
hash :: FTFieldWithIndex -> Hash
hash { idx, ftField } = Crypto.hash $ "--idx--" <> (show idx) <> "--field--" <> (show ftField)
type FieldCodeEditorProps =
(
canMoveDown :: Boolean
, canMoveUp :: Boolean
, field :: FTField
, key :: String
, onChange :: FieldType -> Effect Unit
, onMoveDown :: Unit -> Effect Unit
, onMoveUp :: Unit -> Effect Unit
, onRemove :: Unit -> Effect Unit
, onRename :: String -> Effect Unit
)
fieldCodeEditorWrapper :: Record FieldCodeEditorProps -> R.Element
fieldCodeEditorWrapper props = R.createElement fieldCodeEditorWrapperCpt props []
fieldCodeEditorWrapperCpt :: R.Component FieldCodeEditorProps
fieldCodeEditorWrapperCpt = here.component "fieldCodeEditorWrapperCpt" cpt
where
cpt props@{canMoveDown, canMoveUp, field: Field {name, typ}, onMoveDown, onMoveUp, onRemove, onRename} _ = do
pure $ H.div { className: "row card" } [
H.div { className: "card-header" } [
H.div { className: "code-editor-heading row" } [
H.div { className: "col-4" } [
inputWithEnter { onBlur: onRename
, onEnter: \_ -> pure unit
, onValueChanged: onRename
, autoFocus: false
, className: "form-control"
, defaultValue: name
, placeholder: "Enter file name"
, type: "text" }
]
, H.div { className: "col-7" } []
, H.div { className: "buttons-right col-1" } ([
H.div { className: "btn btn-danger"
, on: { click: \_ -> onRemove unit }
} [
H.span { className: "fa fa-trash" } [ ]
]
] <> moveButtons)
]
]
, H.div { className: "card-body" } [
fieldCodeEditor props
]
]
where
moveButtons = [] <> (if canMoveDown then [moveDownButton] else [])
<> (if canMoveUp then [moveUpButton] else [])
moveDownButton =
H.div { className: "btn btn-primary"
, on: { click: \_ -> onMoveDown unit }
} [
H.span { className: "fa fa-arrow-down" } [ ]
]
moveUpButton =
H.div { className: "btn btn-primary"
, on: { click: \_ -> onMoveUp unit }
} [
H.span { className: "fa fa-arrow-up" } [ ]
]
type RenameableProps =
(
onRename :: String -> Effect Unit
, text :: String
)
renameable :: Record RenameableProps -> R.Element
renameable props = R.createElement renameableCpt props []
renameableCpt :: R.Component RenameableProps
renameableCpt = here.component "renameableCpt" cpt
where
cpt {onRename, text} _ = do
isEditing <- T.useBox false
state <- T.useBox text
textRef <- R.useRef text
-- handle props change of text
R.useEffect1' text $ do
if R.readRef textRef == text then
pure unit
else do
R.setRef textRef text
T.write_ text state
pure $ H.div { className: "renameable" } [
renameableText { isEditing, onRename, state }
]
type RenameableTextProps =
(
isEditing :: T.Box Boolean
, onRename :: String -> Effect Unit
, state :: T.Box String
)
renameableText :: Record RenameableTextProps -> R.Element
renameableText props = R.createElement renameableTextCpt props []
renameableTextCpt :: R.Component RenameableTextProps
renameableTextCpt = here.component "renameableTextCpt" cpt
where
cpt { isEditing, onRename, state } _ = do
isEditing' <- T.useLive T.unequal isEditing
state' <- T.useLive T.unequal state
pure $ if isEditing' then
H.div { className: "input-group" }
[ inputWithEnter {
autoFocus: false
, className: "form-control text"
, defaultValue: state'
, onBlur: \st -> T.write_ st state
, onEnter: submit state'
, onValueChanged: \st -> T.write_ st state
, placeholder: ""
, type: "text"
}
, H.div { className: "btn input-group-append"
, on: { click: submit state' } }
[ H.span { className: "fa fa-floppy-o" } []
]
]
else
H.div { className: "input-group" }
[ H.input { className: "form-control"
, defaultValue: state'
, disabled: 1
, type: "text" }
, H.div { className: "btn input-group-append"
, on: { click: \_ -> T.write_ true isEditing } }
[ H.span { className: "fa fa-pencil" } []
]
]
where
submit text _ = do
T.write_ false isEditing
onRename text
fieldCodeEditor :: Record FieldCodeEditorProps -> R.Element
fieldCodeEditor props = R.createElement fieldCodeEditorCpt props []
fieldCodeEditorCpt :: R.Component FieldCodeEditorProps
fieldCodeEditorCpt = here.component "fieldCodeEditorCpt" cpt
where
cpt {field: Field {typ: typ@(Haskell {haskell})}, onChange} _ = do
pure $ CE.codeEditor {code: haskell, defaultCodeType: CE.Haskell, onChange: changeCode onChange typ}
cpt {field: Field {typ: typ@(Python {python})}, onChange} _ = do
pure $ CE.codeEditor {code: python, defaultCodeType: CE.Python, onChange: changeCode onChange typ}
cpt {field: Field {typ: typ@(JSON j)}, onChange} _ = do
pure $ CE.codeEditor {code, defaultCodeType: CE.JSON, onChange: changeCode onChange typ}
where
code = R2.stringify (JSON.writeImpl j) 2
cpt {field: Field {typ: typ@(Markdown {text})}, onChange} _ = do
pure $ CE.codeEditor {code: text, defaultCodeType: CE.Markdown, onChange: changeCode onChange typ}
-- Performs the matrix of code type changes
-- (FieldType -> Effect Unit) is the callback function for fields array
-- FieldType is the current element that we will modify
-- CE.CodeType is the editor code type (might have been the cause of the trigger)
-- CE.Code is the editor code (might have been the cause of the trigger)
changeCode :: (FieldType -> Effect Unit) -> FieldType -> CE.CodeType -> CE.Code -> Effect Unit
changeCode onc (Haskell hs) CE.Haskell c = onc $ Haskell $ hs { haskell = c }
changeCode onc (Haskell hs) CE.Python c = onc $ Python $ defaultPython' { python = c }
changeCode onc (Haskell {haskell}) CE.JSON c = onc $ JSON $ defaultJSON' { desc = haskell }
changeCode onc (Haskell {haskell}) CE.Markdown c = onc $ Markdown $ defaultMarkdown' { text = haskell }
changeCode onc (Python hs) CE.Python c = onc $ Python $ hs { python = c }
changeCode onc (Python hs) CE.Haskell c = onc $ Haskell $ defaultHaskell' { haskell = c }
changeCode onc (Python {python}) CE.JSON c = onc $ JSON $ defaultJSON' { desc = python }
changeCode onc (Python {python}) CE.Markdown c = onc $ Markdown $ defaultMarkdown' { text = python }
changeCode onc (Markdown md) CE.Haskell c = onc $ Haskell $ defaultHaskell' { haskell = c }
changeCode onc (Markdown md) CE.Python c = onc $ Python $ defaultPython' { python = c }
changeCode onc (Markdown md) CE.JSON c = onc $ Markdown $ defaultMarkdown' { text = c }
changeCode onc (Markdown md) CE.Markdown c = onc $ Markdown $ md { text = c }
changeCode onc (JSON j@{desc}) CE.Haskell c = onc $ Haskell $ defaultHaskell' { haskell = haskell }
where
haskell = R2.stringify (JSON.writeImpl j) 2
changeCode onc (JSON j@{desc}) CE.Python c = onc $ Python $ defaultPython' { python = toCode }
where
toCode = R2.stringify (JSON.writeImpl j) 2
changeCode onc _ CE.JSON c = do
case JSON.readJSON c of
Left err -> here.log2 "[fieldCodeEditor'] cannot parse json" c
Right j' -> onc $ JSON j'
-- case jsonParser c of
-- Left err -> here.log2 "[fieldCodeEditor'] cannot parse json" c
-- Right j' -> case decodeJson j' of
-- Left err -> here.log2 "[fieldCodeEditor'] cannot decode json" j'
-- Right j'' -> onc $ JSON j''
changeCode onc (JSON j) CE.Markdown _ = onc $ Markdown $ defaultMarkdown' { text = text }
where
text = R2.stringify (JSON.writeImpl j) 2
type LoadProps =
( nodeId :: Int
, session :: Session
)
loadCorpus' :: Record LoadProps -> Aff (Either RESTError (NodePoly Hyperdata))
loadCorpus' {nodeId, session} = get session $ NodeAPI Corpus (Just nodeId) ""
-- Just to make reloading effective
loadCorpusWithReload :: { reload :: T2.Reload | LoadProps } -> Aff (Either RESTError (NodePoly Hyperdata))
loadCorpusWithReload {nodeId, session} = loadCorpus' {nodeId, session}
type SaveProps = (
hyperdata :: Hyperdata
| LoadProps
)
saveCorpus :: Record SaveProps -> Aff (Either RESTError Int)
saveCorpus {hyperdata, nodeId, session} = do
put session (NodeAPI Corpus (Just nodeId) "") hyperdata
loadCorpus :: Record LoadProps -> Aff (Either RESTError CorpusData)
loadCorpus {nodeId, session} = do
-- fetch corpus via lists parentId
res <- get session nodePolyRoute
case res of
Left err -> pure $ Left err
Right (NodePoly {parentId: corpusId} :: NodePoly {}) -> do
eCorpusNode <- get session $ corpusNodeRoute corpusId ""
eDefaultListIds <- (get session $ defaultListIdsRoute corpusId)
:: forall a. JSON.ReadForeign a => AffETableResult (NodePoly a)
case eCorpusNode of
Left err -> pure $ Left err
Right corpusNode -> do
case eDefaultListIds of
Left err -> pure $ Left err
Right defaultListIds -> do
case (A.head defaultListIds.docs :: Maybe (NodePoly HyperdataList)) of
Just (NodePoly { id: defaultListId }) ->
pure $ Right { corpusId, corpusNode, defaultListId }
Nothing ->
pure $ Left $ CustomError "Missing default list"
-- (NodePoly {parentId: corpusId} :: NodePoly {}) <- get session nodePolyRoute
-- corpusNode <- get session $ corpusNodeRoute corpusId ""
-- defaultListIds <- (get session $ defaultListIdsRoute corpusId)
-- :: forall a. JSON.ReadForeign a => AffTableResult (NodePoly a)
-- case (A.head defaultListIds.docs :: Maybe (NodePoly HyperdataList)) of
-- Just (NodePoly { id: defaultListId }) ->
-- pure {corpusId, corpusNode, defaultListId}
-- Nothing ->
-- throwError $ error "Missing default list"
where
nodePolyRoute = NodeAPI Corpus (Just nodeId) ""
corpusNodeRoute = NodeAPI Corpus <<< Just
defaultListIdsRoute = Children NodeList 0 1 Nothing <<< Just
loadCorpusWithChild :: Record LoadProps -> Aff (Either RESTError CorpusData)
loadCorpusWithChild { nodeId: childId, session } = do
-- fetch corpus via lists parentId
eListNode <- get session $ listNodeRoute childId ""
case eListNode of
Left err -> pure $ Left err
Right listNode -> do
let (NodePoly {parentId: corpusId} :: NodePoly {}) = listNode
eCorpusNode <- get session $ corpusNodeRoute corpusId ""
case eCorpusNode of
Left err -> pure $ Left err
Right corpusNode -> do
eDefaultListIds <- (get session $ defaultListIdsRoute corpusId)
:: forall a. JSON.ReadForeign a => AffETableResult (NodePoly a)
case eDefaultListIds of
Left err -> pure $ Left err
Right defaultListIds -> do
case (A.head defaultListIds.docs :: Maybe (NodePoly HyperdataList)) of
Just (NodePoly { id: defaultListId }) ->
pure $ Right { corpusId, corpusNode, defaultListId }
Nothing ->
throwError $ error "Missing default list"
where
corpusNodeRoute = NodeAPI Corpus <<< Just
listNodeRoute = NodeAPI Node <<< Just
defaultListIdsRoute = Children NodeList 0 1 Nothing <<< Just
type LoadWithReloadProps =
(
reload :: T2.Reload
| LoadProps
)
-- Just to make reloading effective
loadCorpusWithChildAndReload :: Record LoadWithReloadProps -> Aff (Either RESTError CorpusData)
loadCorpusWithChildAndReload {nodeId, reload, session} = loadCorpusWithChild {nodeId, session}
data ViewType = Code | Folders
derive instance Generic ViewType _
instance Eq ViewType where
eq = genericEq
instance Show ViewType where
show = genericShow
type ViewTypeSelectorProps =
(
state :: T.Box ViewType
)
viewTypeSelector :: Record ViewTypeSelectorProps -> R.Element
viewTypeSelector p = R.createElement viewTypeSelectorCpt p []
viewTypeSelectorCpt :: R.Component ViewTypeSelectorProps
viewTypeSelectorCpt = here.component "viewTypeSelector" cpt
where
cpt {state} _ = do
state' <- T.useLive T.unequal state
pure $ H.div { className: "btn-group"
, role: "group" } [
viewTypeButton Folders state' state
, viewTypeButton Code state' state
]
viewTypeButton viewType state' state =
H.button { className: "btn btn-primary" <> active
, on: { click: \_ -> T.write viewType state }
, type: "button"
} [
H.i { className: "fa " <> (icon viewType) } []
]
where
active = if viewType == state' then " active" else ""
icon Folders = "fa-folder"
icon Code = "fa-code"
Corpus/ 0000775 0000000 0000000 00000000000 14111104351 0033005 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes Chart.purs 0000664 0000000 0000000 00000001220 14111104351 0034754 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Corpus module Gargantext.Components.Nodes.Corpus.Chart where
import Reactix as R
import Gargantext.Components.Nodes.Corpus.Chart.Histo (histo)
import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie, bar)
import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree)
import Gargantext.Components.Nodes.Corpus.Chart.Types (Props)
import Gargantext.Types (ChartType(..))
getChartFunction :: ChartType -> (Record Props -> R.Element)
getChartFunction Histo = histo
getChartFunction ChartBar = bar
getChartFunction ChartPie = pie
getChartFunction Scatter = metrics
getChartFunction ChartTree = tree
Chart/ 0000775 0000000 0000000 00000000000 14111104351 0034046 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Corpus API.purs 0000664 0000000 0000000 00000001007 14111104351 0035370 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Corpus/Chart module Gargantext.Components.Nodes.Corpus.Chart.API where
import Data.Either (Either)
import Effect.Aff (Aff)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, post)
import Gargantext.Types as T
recomputeChart :: Session -> T.ChartType -> T.CTabNgramType -> Int -> Int -> Aff (Either RESTError (Array Int))
recomputeChart session chartType ngramType corpusId listId =
post session (RecomputeListChart chartType ngramType corpusId listId) {}
Common.purs 0000664 0000000 0000000 00000006262 14111104351 0036217 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Corpus/Chart module Gargantext.Components.Nodes.Corpus.Chart.Common where
import Gargantext.Prelude
import Data.Array as A
import Data.Either (Either)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Gargantext.Components.Nodes.Corpus.Chart.Types (MetricsProps, ReloadPath)
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (HashedResponse, useLoader, useLoaderWithCacheAPI)
import Gargantext.Sessions (Session)
import Gargantext.Types (FrontendError(..))
import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.Crypto (Hash)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Simple.JSON as JSON
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus.Chart.Common"
type MetricsLoadViewProps a = (
getMetrics :: Session -> ReloadPath -> Aff (Either RESTError a)
, loaded :: Record MetricsProps -> a -> R.Element
| MetricsProps
)
cacheName :: String
cacheName = "metrics"
metricsLoadView :: forall a. Eq a => Record (MetricsLoadViewProps a) -> R.Element
metricsLoadView p = R.createElement metricsLoadViewCpt p []
metricsLoadViewCpt :: forall a. Eq a => R.Component (MetricsLoadViewProps a)
metricsLoadViewCpt = here.component "metricsLoadView" cpt
where
cpt { boxes: boxes@{ errors }
, getMetrics
, loaded
, onClick
, onInit
, path
, reload
, session } _ = do
reload' <- T.useLive T.unequal reload
useLoader { errorHandler
, loader: getMetrics session
, path: reload' /\ path
, render: \l -> loaded { boxes, path, reload, session, onClick, onInit } l }
where
errorHandler error = do
T.modify_ (A.cons $ FRESTError { error }) errors
here.log2 "RESTError" error
type MetricsWithCacheLoadViewProps res ret =
( getMetricsHash :: Session -> ReloadPath -> Aff (Either RESTError Hash)
, handleResponse :: HashedResponse res -> ret
, loaded :: Record MetricsProps -> ret -> R.Element
, mkRequest :: ReloadPath -> GUC.Request
| MetricsProps
)
metricsWithCacheLoadView :: forall res ret.
Eq ret => JSON.ReadForeign res =>
Record (MetricsWithCacheLoadViewProps res ret) -> R.Element
metricsWithCacheLoadView p = R.createElement metricsWithCacheLoadViewCpt p []
metricsWithCacheLoadViewCpt :: forall res ret.
Eq ret => JSON.ReadForeign res =>
R.Component (MetricsWithCacheLoadViewProps res ret)
metricsWithCacheLoadViewCpt = here.component "metricsWithCacheLoadView" cpt
where
cpt { boxes
, getMetricsHash
, handleResponse
, loaded
, mkRequest
, path
, reload
, session
, onClick
, onInit } _ = do
reload' <- T.useLive T.unequal reload
useLoaderWithCacheAPI { boxes
, cacheEndpoint: (getMetricsHash session)
, handleResponse
, mkRequest
, path: (reload' /\ path)
, renderer: loaded { boxes, path, reload, session, onClick, onInit } }
Histo.purs 0000664 0000000 0000000 00000010576 14111104351 0036060 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Corpus/Chart module Gargantext.Components.Nodes.Corpus.Chart.Histo where
import Data.Either (Either)
import Data.Eq.Generic (genericEq)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
import Gargantext.Components.Charts.Options.Color (grey, blue)
import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis')
import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter)
import Gargantext.Components.Charts.Options.Series (seriesBarD1)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types (MetricsProps, Path, Props, ReloadPath)
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (HashedResponse(..))
import Gargantext.Prelude (class Eq, bind, map, pure, ($), (==))
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..))
import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus.Chart.Histo"
newtype ChartMetrics = ChartMetrics {
"data" :: HistoMetrics
}
derive instance Generic ChartMetrics _
derive instance Newtype ChartMetrics _
instance Eq ChartMetrics where eq = genericEq
derive newtype instance JSON.ReadForeign ChartMetrics
newtype HistoMetrics = HistoMetrics { dates :: Array String, count :: Array Number }
derive instance Generic HistoMetrics _
derive instance Newtype HistoMetrics _
instance Eq HistoMetrics where eq = genericEq
derive newtype instance JSON.ReadForeign HistoMetrics
derive newtype instance JSON.WriteForeign HistoMetrics
type Loaded = HistoMetrics
chartOptions :: Record MetricsProps -> HistoMetrics -> Options
chartOptions { onClick, onInit } (HistoMetrics { dates: dates', count: count'}) = Options
{ mainTitle : "Histogram"
, subTitle : "Distribution of publications over time"
, xAxis : xAxis' dates'
, yAxis : yAxis' { position: "left", show: true, min:0}
, addZoom : true
, tooltip : mkTooltip { formatter: templateFormatter "{b0}" }
, series
, onClick
, onInit
}
where
mapSeriesBar n = dataSerie
{ value: n
, itemStyle: itemStyle { color: grey }
, emphasis: { itemStyle: itemStyle { color: blue } }
-- @XXX "select" action not working
-- , selectedMode: selectedMode Single
-- , select: { itemStyle: itemStyle { color: green }}
}
series =
[ seriesBarD1 {name: "Number of publication / year"} $
map mapSeriesBar count'
]
getMetricsHash :: Session -> ReloadPath -> Aff (Either RESTError String)
getMetricsHash session (_ /\ { corpusId, listId, tabType }) = do
get session $ ChartHash { chartType: Histo, listId: mListId, tabType } (Just corpusId)
where
mListId = if listId == 0 then Nothing else (Just listId)
chartUrl :: Record Path -> SessionRoute
chartUrl { corpusId, limit, listId, tabType } = Chart {chartType: Histo, limit, listId: mListId, tabType} (Just corpusId)
where
mListId = if listId == 0 then Nothing else (Just listId)
handleResponse :: HashedResponse ChartMetrics -> HistoMetrics
handleResponse (HashedResponse { value: ChartMetrics ms }) = ms."data"
mkRequest :: Session -> ReloadPath -> GUC.Request
mkRequest session (_ /\ path) = GUC.makeGetRequest session $ chartUrl path
histo :: Record Props -> R.Element
histo props = R.createElement histoCpt props []
histoCpt :: R.Component Props
histoCpt = here.component "histo" cpt
where
cpt { boxes, path, session, onClick, onInit } _ = do
reload <- T.useBox T2.newReload
pure $ metricsWithCacheLoadView
{ boxes
, getMetricsHash
, handleResponse
, loaded
, mkRequest: mkRequest session
, path
, reload
, session
, onClick
, onInit
}
loaded :: Record MetricsProps -> HistoMetrics -> R.Element
loaded p l =
H.div {} [
{- U.reloadButton reload
, U.chartUpdateButton { chartType: Histo, path, reload, session }
, -} chart $ chartOptions p l
]
-- TODO: parametrize ngramsType above
Metrics.purs 0000664 0000000 0000000 00000011305 14111104351 0036367 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Corpus/Chart module Gargantext.Components.Nodes.Corpus.Chart.Metrics where
import Data.Generic.Rep (class Generic)
import Data.Either (Either)
import Data.Eq.Generic (genericEq)
import Data.Map as Map
import Data.Map (Map)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
import Gargantext.Prelude (class Eq, bind, negate, pure, ($), (<$>), (<>))
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, yAxis')
import Gargantext.Components.Charts.Options.Type (xAxis)
import Gargantext.Components.Charts.Options.Series (Series, seriesScatterD2)
import Gargantext.Components.Charts.Options.Color (green, grey, red)
import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter)
import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types
(MetricsProps, Path, Props, ReloadPath)
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (HashedResponse(..))
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
import Gargantext.Types (TermList(..))
import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus.Chart.Metrics"
newtype Metric = Metric
{ label :: String
, x :: Number
, y :: Number
, cat :: TermList
}
derive instance Generic Metric _
derive instance Newtype Metric _
instance Eq Metric where eq = genericEq
derive newtype instance JSON.ReadForeign Metric
derive newtype instance JSON.WriteForeign Metric
newtype Metrics = Metrics {
"data" :: Array Metric
}
derive instance Generic Metrics _
derive instance Newtype Metrics _
derive newtype instance JSON.ReadForeign Metrics
type Loaded = Array Metric
scatterOptions :: Record MetricsProps -> Array Metric -> Options
scatterOptions { onClick, onInit } metrics' = Options
{ mainTitle : "Ngrams Selection Metrics"
, subTitle : "Local metrics (Inc/Exc, Spe/Gen), Global metrics (TFICF maillage)"
, xAxis : xAxis { min: -1 }
, yAxis : yAxis' { position : "", show: true, min : -2}
, series : map2series $ metric2map metrics'
, addZoom : false
, tooltip : mkTooltip { formatter: templateFormatter "{b0}" }
, onClick
, onInit
}
where
metric2map :: Array Metric -> Map TermList (Array Metric)
metric2map ds = Map.fromFoldableWith (<>) $ (\(Metric m) -> Tuple m.cat [Metric m]) <$> ds
--{-
map2series :: Map TermList (Array Metric) -> Array Series
map2series ms = toSeries <$> Map.toUnfoldable ms
where
-- TODO colors are not respected yet
toSeries (Tuple k ms') =
seriesScatterD2 {symbolSize: 5.0} (toSerie color <$> ms')
where
color =
case k of
StopTerm -> red
MapTerm -> green
CandidateTerm -> grey
toSerie color' (Metric {label,x,y}) =
dataSerie { name: label, itemStyle: itemStyle {color: color'}
-- , label: {show: true}
, value: [x,y]
}
--}
getMetricsHash :: Session -> ReloadPath -> Aff (Either RESTError String)
getMetricsHash session (_ /\ { corpusId, listId, tabType }) =
get session $ CorpusMetricsHash { listId, tabType } (Just corpusId)
chartUrl :: Record Path -> SessionRoute
chartUrl { corpusId, limit, listId, tabType } = CorpusMetrics { limit, listId, tabType } (Just corpusId)
handleResponse :: HashedResponse Metrics -> Loaded
handleResponse (HashedResponse { value: Metrics ms }) = ms."data"
mkRequest :: Session -> ReloadPath -> GUC.Request
mkRequest session (_ /\ path) = GUC.makeGetRequest session $ chartUrl path
metrics :: Record Props -> R.Element
metrics props = R.createElement metricsCpt props []
metricsCpt :: R.Component Props
metricsCpt = here.component "etrics" cpt
where
cpt { boxes, onClick, onInit, path, session } _ = do
reload <- T.useBox T2.newReload
pure $ metricsWithCacheLoadView {
boxes
, getMetricsHash
, handleResponse
, loaded
, mkRequest: mkRequest session
, path
, reload
, session
, onClick
, onInit
}
loaded :: Record MetricsProps -> Loaded -> R.Element
loaded p loaded' =
H.div {} [
{- U.reloadButton reload
, U.chartUpdateButton { chartType: Scatter, path, reload, session }
, -} chart $ scatterOptions p loaded'
]
Pie.purs 0000664 0000000 0000000 00000013215 14111104351 0035500 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Corpus/Chart module Gargantext.Components.Nodes.Corpus.Chart.Pie where
import Data.Array (zip, filter)
import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Either (Either)
import Data.Eq.Generic (genericEq)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Data.String (take, joinWith, Pattern(..), split, length)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
import Gargantext.Prelude (class Eq, bind, map, pure, ($), (==), (>))
import Gargantext.Components.Charts.Options.Color (blue)
import Gargantext.Components.Charts.Options.Data (dataSerie)
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis')
import Gargantext.Components.Charts.Options.Font (itemStyle, mkTooltip, templateFormatter)
import Gargantext.Components.Charts.Options.Series (seriesBarD1, seriesPieD1)
import Gargantext.Config.REST (RESTError)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types
(MetricsProps, Path, Props, ReloadPath)
import Gargantext.Hooks.Loader (HashedResponse(..))
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..))
import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus.Chart.Pie"
newtype ChartMetrics = ChartMetrics {
"data" :: HistoMetrics
}
derive instance Generic ChartMetrics _
derive instance Newtype ChartMetrics _
derive newtype instance JSON.ReadForeign ChartMetrics
newtype HistoMetrics = HistoMetrics
{ dates :: Array String
, count :: Array Number
}
derive instance Generic HistoMetrics _
derive instance Newtype HistoMetrics _
instance Eq HistoMetrics where eq = genericEq
derive newtype instance JSON.ReadForeign HistoMetrics
derive newtype instance JSON.WriteForeign HistoMetrics
type Loaded = HistoMetrics
chartOptionsBar :: Record MetricsProps -> HistoMetrics -> Options
chartOptionsBar { onClick, onInit } (HistoMetrics { dates: dates', count: count'}) = Options
{ mainTitle : "Bar"
, subTitle : "Count of MapTerm"
, xAxis : xAxis' $ map (\t -> joinWith " " $ map (take 3) $ A.take 3 $ filter (\s -> length s > 3) $ split (Pattern " ") t) dates'
, yAxis : yAxis' { position: "left", show: true, min:0}
, series : [seriesBarD1 {name: "Number of publication / year"} $ map (\n -> dataSerie {name: "", itemStyle: itemStyle {color:blue}, value: n }) count']
, addZoom : false
, tooltip : mkTooltip { formatter: templateFormatter "{b0}" }
, onClick
, onInit
}
chartOptionsPie :: Record MetricsProps -> HistoMetrics -> Options
chartOptionsPie { onClick, onInit } (HistoMetrics { dates: dates', count: count'}) = Options
{ mainTitle : "Pie"
, subTitle : "Distribution by MapTerm"
, xAxis : xAxis' []
, yAxis : yAxis' { position: "", show: false, min:0}
, series : [seriesPieD1 {name: "Data"} $ map (\(Tuple n v) -> dataSerie {name: n, value:v}) $ zip dates' count']
-- , series : [seriesBarD1 {name: "Number of publication / year"} $ map (\n -> dataSerie {name: "", value: n }) count']
, addZoom : false
, tooltip : mkTooltip { formatter: templateFormatter "{b0}" }
, onClick
, onInit
}
getMetricsHash :: Session -> ReloadPath -> Aff (Either RESTError String)
getMetricsHash session (_ /\ { corpusId, listId, tabType }) = do
get session $ ChartHash { chartType: ChartPie, listId: mListId, tabType } (Just corpusId)
where
mListId = if listId == 0 then Nothing else (Just listId)
chartUrl :: Record Path -> SessionRoute
chartUrl { corpusId, limit, listId, tabType } = Chart {chartType: ChartPie, limit, listId: mListId, tabType} (Just corpusId)
where
mListId = if listId == 0 then Nothing else (Just listId)
handleResponse :: HashedResponse ChartMetrics -> HistoMetrics
handleResponse (HashedResponse { value: ChartMetrics ms }) = ms."data"
mkRequest :: Session -> ReloadPath -> GUC.Request
mkRequest session (_ /\ path) = GUC.makeGetRequest session $ chartUrl path
pie :: R2.Leaf Props
pie props = R.createElement pieCpt props []
pieCpt :: R.Component Props
pieCpt = here.component "pie" cpt
where
cpt { boxes, path, session, onClick, onInit } _ = do
reload <- T.useBox T2.newReload
pure $ metricsWithCacheLoadView
{ boxes
, getMetricsHash
, handleResponse
, loaded: loadedPie
, mkRequest: mkRequest session
, path
, reload
, session
, onClick
, onInit
}
loadedPie :: Record MetricsProps -> HistoMetrics -> R.Element
loadedPie p loaded =
H.div {} [
{- U.reloadButton reload
, U.chartUpdateButton { chartType: ChartPie, path, reload, session }
, -} chart $ chartOptionsPie p loaded
]
bar :: Record Props -> R.Element
bar props = R.createElement barCpt props []
barCpt :: R.Component Props
barCpt = here.component "bar" cpt
where
cpt { boxes, path, session, onClick, onInit} _ = do
reload <- T.useBox T2.newReload
pure $ metricsWithCacheLoadView {
boxes
, getMetricsHash
, handleResponse
, loaded: loadedBar
, mkRequest: mkRequest session
, path
, reload
, session
, onClick
, onInit
}
loadedBar :: Record MetricsProps -> Loaded -> R.Element
loadedBar p loaded =
H.div {} [
{- U.reloadButton reload
, U.chartUpdateButton { chartType: ChartBar, path, reload, session }
, -} chart $ chartOptionsBar p loaded
]
Predefined.purs 0000664 0000000 0000000 00000007036 14111104351 0037034 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Corpus/Chart module Gargantext.Components.Nodes.Corpus.Chart.Predefined where
import Gargantext.Prelude
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Ord.Generic (genericCompare)
import Data.Show.Generic (genericShow)
import Effect (Effect)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Charts.Options.Type (EChartsInstance, MouseEvent)
import Gargantext.Components.Nodes.Corpus.Chart.Histo (histo)
import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie)
import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree)
import Gargantext.Sessions (Session)
import Gargantext.Types (Mode(..), NodeID, TabSubType(..), TabType(..), modeTabType)
import Reactix as R
import Simple.JSON as JSON
import Simple.JSON.Generics as JSONG
data PredefinedChart =
CDocsHistogram
| CAuthorsPie
| CSourcesBar
| CInstitutesTree
| CTermsMetrics
derive instance Generic PredefinedChart _
instance JSON.ReadForeign PredefinedChart where readImpl = JSONG.enumSumRep
instance JSON.WriteForeign PredefinedChart where writeImpl = JSON.writeImpl <<< show
instance Show PredefinedChart where
show = genericShow
derive instance Eq PredefinedChart
instance Ord PredefinedChart where
compare = genericCompare
instance Read PredefinedChart where
read "CDocsHistogram" = Just CDocsHistogram
read "CAuthorsPie" = Just CAuthorsPie
read "CSourcesBar" = Just CSourcesBar
read "CInstitutesTree" = Just CInstitutesTree
read "CTermsMetrics" = Just CTermsMetrics
read _ = Nothing
allPredefinedCharts :: Array PredefinedChart
allPredefinedCharts =
[ CDocsHistogram
, CAuthorsPie
-- , CTermsMetrics
, CInstitutesTree
, CSourcesBar
]
type Params =
( boxes :: Boxes
, corpusId :: NodeID
-- optinal params
, limit :: Maybe Int
, listId :: Maybe Int
, onClick :: Maybe (MouseEvent -> Effect Unit)
, onInit :: Maybe (EChartsInstance -> Effect Unit)
, session :: Session
)
render :: PredefinedChart -> Record Params -> R.Element
render CDocsHistogram { boxes, corpusId, listId, session, onClick, onInit } =
histo { boxes, path, session, onClick, onInit }
where
path = { corpusId
, listId: fromMaybe 0 listId
, limit: Nothing
, tabType: TabCorpus TabDocs
}
render CAuthorsPie { boxes, corpusId, listId, session, onClick, onInit } =
pie { boxes, path, session, onClick, onInit }
where
path = { corpusId
, listId: fromMaybe 0 listId
, limit: Nothing
, tabType: TabCorpus (TabNgramType $ modeTabType Authors)
}
render CInstitutesTree { boxes, corpusId, limit, listId, session, onClick, onInit } =
tree { boxes, path, session, onClick, onInit }
where
path = { corpusId
, limit
, listId: fromMaybe 0 listId
, tabType: TabCorpus (TabNgramType $ modeTabType Institutes)
}
render CTermsMetrics { boxes, corpusId, limit, listId, session, onClick, onInit } =
metrics { boxes, path, session, onClick, onInit }
where
path = { corpusId
, limit
, listId: fromMaybe 0 listId
, tabType: TabCorpus (TabNgramType $ modeTabType Terms)
}
render CSourcesBar { boxes, corpusId, limit, listId, session, onClick, onInit } =
metrics { boxes, path, session, onClick, onInit }
where
path = { corpusId
, limit
, listId: fromMaybe 0 listId
, tabType: TabCorpus (TabNgramType $ modeTabType Sources)
}
Tree.purs 0000664 0000000 0000000 00000006706 14111104351 0035671 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Corpus/Chart module Gargantext.Components.Nodes.Corpus.Chart.Tree where
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.Charts.Options.ECharts (Options(..), chart, xAxis', yAxis')
import Gargantext.Components.Charts.Options.Series (TreeNode, Trees(..), mkTree)
import Gargantext.Components.Charts.Options.Font (mkTooltip, templateFormatter)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types (MetricsProps, Path, Props, ReloadPath)
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (HashedResponse(..))
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..))
import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus.Chart.Tree"
newtype Metrics = Metrics {
"data" :: Array TreeNode
}
derive instance Generic Metrics _
derive instance Newtype Metrics _
derive newtype instance JSON.ReadForeign Metrics
derive newtype instance JSON.WriteForeign Metrics
type Loaded = Array TreeNode
scatterOptions :: Record MetricsProps -> Array TreeNode -> Options
scatterOptions { onClick, onInit } nodes = Options
{ mainTitle : "Tree"
, subTitle : "Tree Sub Title"
, xAxis : xAxis' []
, yAxis : yAxis' { position : "", show: false, min:0}
, series : [ mkTree TreeMap nodes]
, addZoom : false
, tooltip : mkTooltip { formatter: templateFormatter "{b0}" }
, onClick
, onInit
-- TODO improve the formatter:
-- https://ecomfe.github.io/echarts-examples/public/editor.html?c=treemap-obama
}
getMetricsHash :: Session -> ReloadPath -> Aff (Either RESTError String)
getMetricsHash session (_ /\ { corpusId, listId, tabType }) = do
get session $ ChartHash { chartType: ChartTree, listId: mListId, tabType } (Just corpusId)
where
mListId = if listId == 0 then Nothing else (Just listId)
chartUrl :: Record Path -> SessionRoute
chartUrl { corpusId, limit, listId, tabType } = Chart {chartType: ChartTree, limit, listId: mListId, tabType} (Just corpusId)
where
mListId = if listId == 0 then Nothing else (Just listId)
handleResponse :: HashedResponse Metrics -> Loaded
handleResponse (HashedResponse { value: Metrics ms }) = ms."data"
mkRequest :: Session -> ReloadPath -> GUC.Request
mkRequest session (_ /\ path) = GUC.makeGetRequest session $ chartUrl path
tree :: Record Props -> R.Element
tree props = R.createElement treeCpt props []
treeCpt :: R.Component Props
treeCpt = here.component "tree" cpt
where
cpt { boxes, path, session, onClick, onInit } _ = do
reload <- T.useBox T2.newReload
pure $ metricsWithCacheLoadView
{ boxes
, getMetricsHash
, handleResponse
, loaded
, mkRequest: mkRequest session
, path
, reload
, session
, onClick
, onInit
}
loaded :: Record MetricsProps -> Loaded -> R.Element
loaded p loaded' =
H.div {} [
{- U.reloadButton reload
, U.chartUpdateButton { chartType: ChartTree, path, reload, session }
, -} chart (scatterOptions p loaded')
]
Types.purs 0000664 0000000 0000000 00000001525 14111104351 0036070 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Corpus/Chart module Gargantext.Components.Nodes.Corpus.Chart.Types where
import Data.Maybe (Maybe)
import Data.Tuple (Tuple)
import Effect (Effect)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Charts.Options.Type (EChartsInstance, MouseEvent)
import Gargantext.Prelude (Unit)
import Gargantext.Sessions (Session)
import Gargantext.Types (FrontendError, TabType)
import Gargantext.Utils.Toestand as T2
import Toestand as T
type Path = (
corpusId :: Int
, limit :: Maybe Int
, listId :: Int
, tabType :: TabType
)
type Props = (
boxes :: Boxes
, path :: Record Path
, session :: Session
, onClick :: Maybe (MouseEvent -> Effect Unit)
, onInit :: Maybe (EChartsInstance -> Effect Unit)
)
type MetricsProps = (
reload :: T2.ReloadS
| Props
)
type ReloadPath = Tuple T2.Reload (Record Path)
Utils.purs 0000664 0000000 0000000 00000004233 14111104351 0036063 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Corpus/Chart module Gargantext.Components.Nodes.Corpus.Chart.Utils where
import Data.Maybe (Maybe(..))
import Effect (Effect)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.Nodes.Corpus.Chart.API (recomputeChart)
import Gargantext.Components.Nodes.Corpus.Chart.Types (Path)
import Gargantext.Sessions (Session)
import Gargantext.Types as T
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus.Chart.Utils"
reloadButtonWrap :: T2.ReloadS -> R.Element -> R.Element
reloadButtonWrap setReload el = H.div {} [
reloadButton setReload
, el
]
reloadButton :: T2.ReloadS -> R.Element
reloadButton reloadS = H.a { className, on: { click }, title: "Reload" } [] where
className = "reload-btn fa fa-refresh"
click _ = T2.reload reloadS
mNgramsTypeFromTabType :: T.TabType -> Maybe T.CTabNgramType
mNgramsTypeFromTabType (T.TabCorpus (T.TabNgramType ngramType)) = Just ngramType
mNgramsTypeFromTabType (T.TabDocument (T.TabNgramType ngramType)) = Just ngramType
mNgramsTypeFromTabType _ = Nothing
type ChartUpdateButtonProps =
( chartType :: T.ChartType
, path :: Record Path
, reload :: T2.ReloadS
, session :: Session
)
chartUpdateButton :: Record ChartUpdateButtonProps -> R.Element
chartUpdateButton p = R.createElement chartUpdateButtonCpt p []
chartUpdateButtonCpt :: R.Component ChartUpdateButtonProps
chartUpdateButtonCpt = here.component "chartUpdateButton" cpt where
cpt { path: { corpusId, listId, tabType }
, reload, chartType, session } _ = do
pure $ H.a { className, on: { click }, title: "Update chart data" } []
where
className = "chart-update-button fa fa-database"
click :: forall a. a -> Effect Unit
click _ = do
launchAff_ $ do
case mNgramsTypeFromTabType tabType of
Just ngramsType -> do
_ <- recomputeChart session chartType ngramsType corpusId listId
liftEffect $ T2.reload reload
Nothing -> pure unit
Dashboard.purs 0000664 0000000 0000000 00000041355 14111104351 0035617 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Corpus module Gargantext.Components.Nodes.Corpus.Dashboard where
import Data.Array as A
import Data.Either (Either(..))
import Data.List as List
import Data.Maybe (Maybe(..), fromMaybe)
import Effect (Effect)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Nodes.Corpus (fieldsCodeEditor)
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.Components.Nodes.Dashboard.Types as DT
import Gargantext.Components.Nodes.Types (FTFieldList(..), FTFieldsWithIndex(..), defaultField)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Unit, bind, discard, pure, read, show, unit, ($), (<$>), (<>), (==))
import Gargantext.Sessions (Session, sessionId)
import Gargantext.Types (FrontendError, NodeID)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus.Dashboard"
type Props =
( boxes :: Boxes
, nodeId :: NodeID
, session :: Session )
dashboardLayout :: R2.Component Props
dashboardLayout = R.createElement dashboardLayoutCpt
dashboardLayoutCpt :: R.Component Props
dashboardLayoutCpt = here.component "dashboardLayout" cpt where
cpt props@{ nodeId, session } content = do
pure $ dashboardLayoutWithKey (Record.merge props { key }) content
where
key = show (sessionId session) <> "-" <> show nodeId
type KeyProps =
( key :: String
| Props
)
dashboardLayoutWithKey :: R2.Component KeyProps
dashboardLayoutWithKey = R.createElement dashboardLayoutWithKeyCpt
dashboardLayoutWithKeyCpt :: R.Component KeyProps
dashboardLayoutWithKeyCpt = here.component "dashboardLayoutWithKey" cpt
where
cpt { boxes, nodeId, session } _ = do
reload <- T.useBox T2.newReload
reload' <- T.useLive T.unequal reload
useLoader { errorHandler
, loader: DT.loadDashboardWithReload
, path: { nodeId, reload: reload', session }
, render: \(DT.DashboardData { hyperdata: DT.Hyperdata h, parentId }) -> do
let { charts, fields } = h
dashboardLayoutLoaded { boxes
, charts
, corpusId: parentId
, defaultListId: 0
, fields
, nodeId
, onChange: onChange nodeId reload (DT.Hyperdata h)
, session } [] }
where
errorHandler err = here.log2 "[dashboardLayoutWithKey] RESTError" err
onChange :: NodeID -> T2.ReloadS -> DT.Hyperdata -> { charts :: Array P.PredefinedChart
, fields :: FTFieldList } -> Effect Unit
onChange nodeId' reload (DT.Hyperdata h) { charts, fields } = do
launchAff_ do
res <- DT.saveDashboard { hyperdata: DT.Hyperdata $ h { charts = charts, fields = fields }
, nodeId:nodeId'
, session }
liftEffect $ do
_ <- case res of
Left err -> here.log2 "[dashboardLayoutWithKey] onChange RESTError" err
_ -> pure unit
T2.reload reload
type LoadedProps =
( boxes :: Boxes
, charts :: Array P.PredefinedChart
, corpusId :: NodeID
, defaultListId :: Int
, fields :: FTFieldList
, onChange :: { charts :: Array P.PredefinedChart
, fields :: FTFieldList } -> Effect Unit
, nodeId :: NodeID
, session :: Session
)
dashboardLayoutLoaded :: R2.Component LoadedProps
dashboardLayoutLoaded = R.createElement dashboardLayoutLoadedCpt
dashboardLayoutLoadedCpt :: R.Component LoadedProps
dashboardLayoutLoadedCpt = here.component "dashboardLayoutLoaded" cpt
where
cpt { boxes
, charts
, corpusId
, defaultListId
, fields
, nodeId
, onChange
, session } _ = do
pure $ H.div {}
[ dashboardCodeEditor { fields
, nodeId
, onChange: \fs -> onChange { charts, fields: fs }
, session } []
, H.div { className: "row" }
[ H.div { className: "col-12" }
([ H.h1 {} [ H.text "Board" ]
, H.p {} [ H.text "Summary of all your charts here" ]
] <> chartsEls <> [addNew])
]
]
where
addNew = H.div { className: "row" } [
H.span { className: "btn btn-primary"
, on: { click: onClickAddChart }} [ H.span { className: "fa fa-plus" } [] ]
]
where
onClickAddChart _ = onChange { charts: A.cons P.CDocsHistogram charts
, fields }
chartsEls = A.mapWithIndex chartIdx charts
chartIdx idx chart =
renderChart { boxes
, chart
, corpusId
, defaultListId
, onChange: onChangeChart
, onRemove
, session } []
where
onChangeChart c = do
onChange { charts: fromMaybe charts (A.modifyAt idx (\_ -> c) charts)
, fields }
onRemove _ = onChange { charts: fromMaybe charts $ A.deleteAt idx charts
, fields }
type CodeEditorProps =
( fields :: FTFieldList
, onChange :: FTFieldList -> Effect Unit
, nodeId :: NodeID
, session :: Session
)
dashboardCodeEditor :: R2.Component CodeEditorProps
dashboardCodeEditor = R.createElement dashboardCodeEditorCpt
dashboardCodeEditorCpt :: R.Component CodeEditorProps
dashboardCodeEditorCpt = here.component "dashboardCodeEditor" cpt
where
cpt { fields: FTFieldList fields, nodeId, onChange, session } _ = do
let fieldsWithIndex = FTFieldsWithIndex $ List.mapWithIndex (\idx -> \ftField -> { idx, ftField }) fields
fieldsS <- T.useBox fieldsWithIndex
fields' <- T.useLive T.unequal fieldsS
fieldsRef <- R.useRef fields'
-- handle props change of fields
R.useEffect1' fields $ do
if R.readRef fieldsRef == fields' then
pure unit
else do
R.setRef fieldsRef fields'
T.write_ fieldsWithIndex fieldsS
pure $ R.fragment
[ H.div { className: "row" }
[ H.div { className: "btn btn-primary " <> (saveEnabled fieldsWithIndex fields')
, on: { click: onClickSave fields' }
}
[ H.span { className: "fa fa-floppy-o" } [ ]
]
]
, H.div { className: "row" }
[ H.div { className: "col-12" }
[ fieldsCodeEditor { fields: fieldsS
, nodeId
, session } []
]
]
, H.div { className: "row" }
[ H.div { className: "btn btn-primary"
, on: { click: onClickAddField fieldsS }
}
[ H.span { className: "fa fa-plus" } [ ]
]
]
]
where
saveEnabled :: FTFieldsWithIndex -> FTFieldsWithIndex -> String
saveEnabled fs fsS = if fs == fsS then "disabled" else "enabled"
onClickSave :: forall e. FTFieldsWithIndex -> e -> Effect Unit
onClickSave (FTFieldsWithIndex fields') _ = do
onChange $ FTFieldList $ (_.ftField) <$> fields'
onClickAddField :: forall e. T.Box FTFieldsWithIndex -> e -> Effect Unit
onClickAddField fieldsS _ = do
T.modify_ (\(FTFieldsWithIndex fs) -> FTFieldsWithIndex $
List.snoc fs $ { idx: List.length fs, ftField: defaultField }) fieldsS
type PredefinedChartProps =
( boxes :: Boxes
, chart :: P.PredefinedChart
, corpusId :: NodeID
, defaultListId :: Int
, onChange :: P.PredefinedChart -> Effect Unit
, onRemove :: Unit -> Effect Unit
, session :: Session
)
renderChart :: R2.Component PredefinedChartProps
renderChart = R.createElement renderChartCpt
renderChartCpt :: R.Component PredefinedChartProps
renderChartCpt = here.component "renderChart" cpt
where
cpt { boxes
, chart
, corpusId
, defaultListId
, onChange
, onRemove
, session } _ = do
pure $ H.div { className: "row chart card" }
[ H.div { className: "card-header" }
[ H.div { className: "row" }
[ H.div { className: "col-2" }
[ R2.select { defaultValue: show chart
, on: { change: onSelectChange }
} (option <$> P.allPredefinedCharts)
]
, H.div { className: "col-9" } []
, H.div { className: "col-1" }
[ H.span { className: "btn btn-danger"
, on: { click: onRemoveClick }} [ H.span { className: "fa fa-trash" } [] ]
]
]
]
, H.div { className: "card-body" }
[ H.div { className: "row" }
[ H.div { className: "col-12 chart" }
[ P.render chart params ]
]
]
]
where
option pc =
H.option { value: show pc } [ H.text $ show pc ]
onSelectChange e = onChange $ fromMaybe P.CDocsHistogram $ read value
where
value = R.unsafeEventValue e
onRemoveClick _ = onRemove unit
params = { boxes
, corpusId
, limit: Just 1000
, listId: Just defaultListId
, onClick: Nothing
, onInit: Nothing
, session
}
-- aSchool school = H.div {className: "col-md-4 content"} [ chart $ focus school ]
-- schools = [ "Télécom Bretagne", "Mines Nantes", "Eurecom" ]
-- myData =
-- [seriesBarD1 {name: "Bar Data"}
-- [ dataSerie {name: "val1", value: 50.0}
-- , dataSerie {name: "val2", value: 70.0}
-- , dataSerie {name: "val3", value: 80.0} ] ]
-- focus :: String -> Options
-- focus school =
-- Options
-- { mainTitle : "Focus " <> school
-- , subTitle : "Total scientific publications"
-- , xAxis : xAxis' ["2015", "2016", "2017"]
-- , yAxis : yAxis' { position: "left", show: false, min : 0 }
-- , series : myData
-- , addZoom : false
-- , tooltip : tooltipTriggerAxis } -- Necessary?
-----------------------------------------------------------------------------------------------------------
-- naturePublis_x :: Array String
-- naturePublis_x = ["Com","Articles","Thèses","Reports"]
-- naturePublis_y' :: Array Int
-- naturePublis_y' = [23901,17417,1188,1176]
-- naturePublis_y :: Array DataD1
-- naturePublis_y = zipWith (\n v -> dataSerie {name: n, value: toNumber v }) naturePublis_x naturePublis_y'
-- naturePublis :: Options
-- naturePublis = Options
-- { mainTitle : "Nature of publications"
-- , subTitle : "Distribution by type"
-- , xAxis : xAxis' []
-- , yAxis : yAxis' { position: "left", show: false, min:0}
-- , series : [seriesFunnelD1 { name: "Funnel Data" } naturePublis_y]
-- , addZoom : false
-- , tooltip : tooltipTriggerAxis -- Necessary?
-- }
-----------------------------------------------------------------------------------------------------------
-- globalPublis_x :: Array Int
-- globalPublis_x = [1982,1986,1987,1988,1990,1993,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011,2012,2013,2014,2015,2016,2017]
-- globalPublis_y :: Array Int
-- globalPublis_y = [1,4,2,1,1,2,1,1,8,38,234,76,40,82,75,202,1475,1092,1827,2630,4978,3668,4764,5915,4602,5269,6814,4018]
-- globalPublis :: Options
-- globalPublis = Options
-- { mainTitle : "Histogram"
-- , subTitle : "Distribution of publications over time"
-- , xAxis : xAxis' (map show globalPublis_x)
-- , yAxis : yAxis' { position: "left", show: true, min:0}
-- , series : [seriesBarD1 {name: "Number of publication / year"} $ map (\n -> dataSerie {name: "", value: toNumber n }) globalPublis_y]
-- , addZoom : true
-- , tooltip : tooltipTriggerAxis -- Necessary?
-- }
-- distriBySchool_y :: Array (Tuple String Int)
-- distriBySchool_y = [Tuple "Télécom Bretagne" 1150,Tuple "Télécom SudParis" 946,Tuple "Mines Nantes" 547,Tuple "Télécom ParisTech" 429,Tuple "IMT Atlantique" 205,Tuple "Mines Alès" 56
-- ,Tuple "Télécom Ecole de Management" 52,Tuple "Mines Albi-Carmaux" 6]
-- distriBySchool :: Options
-- distriBySchool = Options
-- { mainTitle : "School production in 2017"
-- , subTitle : "Distribution by school"
-- , xAxis : xAxis' []
-- , yAxis : yAxis' { position : "", show: false, min:0}
-- , series : [ seriesPieD1 {name: "Pie data"} (map (\(Tuple n v) -> dataSerie {name: n, value: toNumber v}) distriBySchool_y)]
-- , addZoom : false
-- , tooltip : tooltipTriggerAxis -- Necessary?
-- }
-- scatterEx :: Options
-- scatterEx = Options
-- { mainTitle : "Scatter test"
-- , subTitle : "Scatter subtitle"
-- , xAxis : xAxis' []
-- , yAxis : yAxis' { position: "", show: true, min:0}
-- , series : [ seriesScatterD2 {name: "name1", symbolSize: 10.0} (dataSerieV <$> [[2.0,3.0],[3.0,4.0]])
-- , seriesScatterD2 {name: "name2", symbolSize: 5.0 } (dataSerieV <$> [[1.0,3.0],[5.0,4.0]])
-- , seriesScatterD2 {name: "name3", symbolSize: 10.0} (dataSerieV <$> [[10.0,3.0],[8.0,4.0]])
-- ]
-- , addZoom : false
-- , tooltip : tooltipTriggerAxis -- Necessary?
-- }
-- sankeyEx :: Options
-- sankeyEx = Options
-- { mainTitle : ""
-- , subTitle : ""
-- , xAxis : xAxis' []
-- , yAxis : yAxis' { position: "", show: false, min:0}
-- , series :
-- [ seriesSankey
-- { "data":
-- [ {name : "a"}, {name : "b"}
-- , {name:"c"}, {name:"d"} ]
-- , links:
-- [ {source : "a", target : "b", value :2.0}
-- , {source : "a", target : "c", value :1.0}
-- , {source : "b", target : "c", value :1.0}
-- , {source : "b", target : "d", value :3.0}
-- ]
-- , layout: "none"
-- }
-- ]
-- , tooltip : tooltipTriggerAxis -- Necessary?
-- , addZoom : false
-- }
-- treeData :: Array TreeNode
-- treeData =
-- [ treeNode "nodeA" 10
-- [ treeNode "nodeAa" 4 []
-- , treeNode "nodeAb" 5 []
-- , treeNode "nodeAc" 1
-- [ treeNode "nodeAca" 5 []
-- , treeNode "nodeAcb" 5 [] ] ]
-- , treeNode "nodeB" 20
-- [ treeNode "nodeBa" 20
-- [ treeNode "nodeBa1" 20 [] ]]
-- , treeNode "nodeC" 20
-- [ treeNode "nodeCa" 20
-- [ treeNode "nodeCa1" 10 []
-- , treeNode "nodeCa2" 10 [] ]
-- , treeNode "nodeD" 20
-- [ treeNode "nodeDa" 20
-- [ treeNode "nodeDa1" 2 []
-- , treeNode "nodeDa2" 2 []
-- , treeNode "nodeDa3" 2 []
-- , treeNode "nodeDa4" 2 []
-- , treeNode "nodeDa5" 2 []
-- , treeNode "nodeDa6" 2 []
-- , treeNode "nodeDa7" 2 []
-- , treeNode "nodeDa8" 2 []
-- , treeNode "nodeDa9" 2 []
-- , treeNode "nodeDa10" 2 [] ]]]]
-- treeData' :: Array TreeNode
-- treeData' =
-- [ treeNode "nodeA" 10
-- [ treeLeaf "nodeAa" 4
-- , treeLeaf "nodeAb" 5
-- , treeNode "nodeAc" 1 [ treeLeaf "nodeAca" 5, treeLeaf "nodeAcb" 5 ]]
-- , treeNode "nodeB" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
-- , treeNode "nodeC" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
-- , treeNode "nodeD" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
-- , treeNode "nodeE" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
-- , treeNode "nodeF" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
-- , treeNode "nodeG" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]
-- , treeNode "nodeH" 20 [ treeNode "nodeBa" 20 [ treeLeaf "nodeBa1" 20]]]
-- treeMapEx :: Options
-- treeMapEx = Options
-- { mainTitle : ""
-- , subTitle : ""
-- , xAxis : xAxis' []
-- , yAxis : yAxis' { position: "", show: false, min:0}
-- , series : [mkTree TreeMap treeData]
-- , addZoom : false
-- , tooltip : tooltipTriggerAxis -- Necessary?
-- }
-- treeEx :: Options
-- treeEx = Options
-- { mainTitle : "Tree"
-- , subTitle : "Radial"
-- , xAxis : xAxis' []
-- , yAxis : yAxis' { position: "", show: false, min:0}
-- , series : [mkTree TreeRadial treeData']
-- , addZoom : false
-- , tooltip : tooltipTriggerAxis -- Necessary?
-- }
Document.purs 0000664 0000000 0000000 00000017070 14111104351 0035503 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Corpus module Gargantext.Components.Nodes.Corpus.Document where
--import Data.Argonaut (encodeJson) -- DEBUG
--import Data.Argonaut.Core (stringifyWithIndent) -- DEBUG
import Data.Either (Either(..))
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
import Gargantext.Prelude (bind, pure, show, unit, ($), (<>), (<$>), (<<<))
import Gargantext.Components.AutoUpdate (autoUpdate)
import Gargantext.Components.Search (SearchType(..))
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Nodes.Corpus.Document.Types (DocPath, Document(..), LoadedData, NodeDocument, Props, State, initialState)
import Gargantext.Components.NgramsTable.Core
( CoreAction(..), Versioned(..), addNewNgramA, applyNgramsPatches, coreDispatch, loadNgramsTable
, replace, setTermListA, syncResetButtons, findNgramRoot )
import Gargantext.Components.Annotation.AnnotatedField as AnnotatedField
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get, sessionId)
import Gargantext.Types (CTabNgramType(..), ListId, NodeID, NodeType(..), TabSubType(..), TabType(..), ScoreType(..))
import Gargantext.Utils as U
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus.Document"
publicationDate :: Document -> String
publicationDate (Document doc@{publication_year: Nothing}) = ""
publicationDate (Document doc@{publication_year: Just py, publication_month: Nothing}) = U.zeroPad 2 py
publicationDate (Document doc@{publication_year: Just py, publication_month: Just pm, publication_day: Nothing}) = (U.zeroPad 2 py) <> "-" <> (U.zeroPad 2 pm)
publicationDate (Document doc@{publication_year: Just py, publication_month: Just pm, publication_day: Just pd}) = (U.zeroPad 2 py) <> "-" <> (U.zeroPad 2 pm) <> "-" <> (U.zeroPad 2 pd)
docViewWrapper :: R2.Component Props
docViewWrapper = R.createElement docViewWrapperCpt
docViewWrapperCpt :: R.Component Props
docViewWrapperCpt = here.component "docViewWrapper" cpt
where
cpt props@{ loaded } _ = do
state <- T.useBox $ initialState { loaded }
pure $ docView (Record.merge props { state }) []
type DocViewProps = (
state :: T.Box State
| Props
)
docView :: R2.Component DocViewProps
docView = R.createElement docViewCpt
docViewCpt :: R.Component DocViewProps
docViewCpt = here.component "docView" cpt
where
cpt { path
, loaded: loaded@{ ngramsTable: Versioned { data: initTable }, document }
, state
} _children = do
state'@{ ngramsLocalPatch, ngramsVersion: version } <- T.useLive T.unequal state
let
afterSync = \_ -> pure unit
syncResetBtns =
[ syncResetButtons { afterSync, ngramsLocalPatch, performAction: dispatch } ]
withAutoUpdate = false
autoUpd :: Array R.Element
autoUpd =
if withAutoUpdate
then [ autoUpdate { duration: 5000, effect: dispatch $ Synchronize { afterSync } } ]
else []
ngrams = applyNgramsPatches state' initTable
annotate text = AnnotatedField.annotatedField { ngrams, setTermList, text }
setTermListOrAddA ngram Nothing = addNewNgramA ngram
setTermListOrAddA ngram (Just oldList) = setTermListA ngram <<< replace oldList
setTermList ngram mOldList = dispatch <<< setTermListOrAddA (findNgramRoot ngrams ngram) mOldList
pure $ H.div {} $
autoUpd <> syncResetBtns <>
--DEBUG
--[ H.pre { rows: 30 } [
-- H.text (stringifyWithIndent 2 (encodeJson (fst state)))
-- ] ] <>
[ H.div { className: "corpus-doc-view container1" }
[ R2.row
[ R2.col 12
[ H.h4 {} [ H.span {} [ badge "title", annotate doc.title [] ] ]
, H.ul { className: "list-group" }
[ li' [ badgeLi "source", text' doc.source ]
-- TODO add href to /author/ if author present in
, li' [ badgeLi "authors", text' doc.authors ]
, li' [ badgeLi "date", H.text $ publicationDate $ Document doc ]
]
, H.span {} [ badge "abstract", annotate doc.abstract [] ]
, H.div { className: "jumbotron" } [ H.p {} [ H.text "Empty Full Text" ] ]
]]]]
where
dispatch = coreDispatch path state
badge s = H.span { className: "badge badge-default badge-pill" } [ H.text s ]
badgeLi s =
H.span { className: "list-group-item-heading" }
[ H.span { className: "badge-container" }
[ H.span { className: "badge badge-default badge-pill" } [ H.text s ] ]]
li' = H.li { className: "list-group-item justify-content-between" }
-- Here the use of findNgramRoot makes that we always target the root of an ngram group.
text' x = H.span { className: "list-group-item-text" } [ H.text $ fromMaybe "Nothing" x ]
NodePoly {hyperdata: Document doc} = document
type LayoutProps =
( listId :: ListId
, mCorpusId :: Maybe NodeID
, nodeId :: NodeID
, session :: Session
)
documentMainLayout :: R2.Component LayoutProps
documentMainLayout = R.createElement documentMainLayoutCpt
documentMainLayoutCpt :: R.Component LayoutProps
documentMainLayoutCpt = here.component "documentMainLayout" cpt where
cpt props _ = pure $ R2.row [ R2.col 10 [ documentLayout props [] ] ]
documentLayout :: R2.Component LayoutProps
documentLayout = R.createElement documentLayoutCpt
documentLayoutCpt :: R.Component LayoutProps
documentLayoutCpt = here.component "documentLayout" cpt where
cpt { listId, mCorpusId, nodeId, session } children = do
pure $ documentLayoutWithKey { key, listId, mCorpusId, nodeId, session } children
where
key = show (sessionId session) <> "-" <> show nodeId
type KeyLayoutProps =
( key :: String
, listId :: ListId
, mCorpusId :: Maybe NodeID
, nodeId :: NodeID
, session :: Session
)
documentLayoutWithKey :: R2.Component KeyLayoutProps
documentLayoutWithKey = R.createElement documentLayoutWithKeyCpt
documentLayoutWithKeyCpt :: R.Component KeyLayoutProps
documentLayoutWithKeyCpt = here.component "documentLayoutWithKey" cpt
where
cpt { listId, mCorpusId, nodeId, session } _ = do
useLoader { errorHandler
, loader: loadData
, path
, render: \loaded -> docViewWrapper { loaded, path } [] }
where
tabType = TabDocument (TabNgramType CTabTerms)
path = { listIds: [listId], mCorpusId, nodeId, session, tabType }
errorHandler err = here.log2 "[documentLayoutWithKey] RESTError" err
------------------------------------------------------------------------
loadDocument :: Session -> Int -> Aff (Either RESTError NodeDocument)
loadDocument session nodeId = get session $ NodeAPI Node (Just nodeId) ""
loadData :: DocPath -> Aff (Either RESTError LoadedData)
loadData { listIds, nodeId, session, tabType } = do
eDocument <- loadDocument session nodeId
case eDocument of
Left err -> pure $ Left err
Right document -> do
eNgramsTable <- loadNgramsTable
{ listIds
, nodeId
, params: { offset : 0, limit : 100, orderBy: Nothing, searchType: SearchDoc}
, scoreType: Occurrences
, searchQuery: ""
, session
, tabType
, termListFilter: Nothing
, termSizeFilter: Nothing
}
pure $ (\ngramsTable -> { document, ngramsTable }) <$> eNgramsTable
Document/ 0000775 0000000 0000000 00000000000 14111104351 0034563 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Corpus Types.purs 0000664 0000000 0000000 00000014021 14111104351 0036600 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Corpus/Document module Gargantext.Components.Nodes.Corpus.Document.Types where
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Newtype (class Newtype)
import Data.Show.Generic (genericShow)
import Data.Maybe (Maybe(..))
import Simple.JSON as JSON
import Gargantext.Prelude
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.NgramsTable.Core (CoreState, Versioned(..) , VersionedNgramsTable)
import Gargantext.Sessions (Session)
import Gargantext.Types (ListId, NodeID, TabType)
type DocPath = {
listIds :: Array ListId
, mCorpusId :: Maybe NodeID
, nodeId :: NodeID
, session :: Session
, tabType :: TabType
}
type NodeDocument = NodePoly Document
type LoadedData =
{ document :: NodeDocument
, ngramsTable :: VersionedNgramsTable
}
type Props = (
loaded :: LoadedData
, path :: DocPath
)
-- This is a subpart of NgramsTable.State.
type State = CoreState ()
initialState
:: forall props others
. { loaded :: { ngramsTable :: VersionedNgramsTable | others }
| props }
-> State
initialState {loaded: {ngramsTable: Versioned {version}}} =
{ ngramsLocalPatch: mempty
, ngramsStagePatch: mempty
, ngramsValidPatch: mempty
, ngramsVersion: version
}
newtype Status = Status { failed :: Int
, succeeded :: Int
, remaining :: Int
}
derive instance Generic Status _
derive instance Newtype Status _
derive newtype instance JSON.ReadForeign Status
derive newtype instance JSON.WriteForeign Status
instance Show Status where show = genericShow
newtype DocumentV3 =
DocumentV3 { abstract :: Maybe String
, authors :: Maybe String
--, error :: Maybe String
, language_iso2 :: Maybe String
, language_iso3 :: Maybe String
, language_name :: Maybe String
, publication_date :: Maybe String
, publication_day :: Maybe Int
, publication_hour :: Maybe Int
, publication_minute :: Maybe Int
, publication_month :: Maybe Int
, publication_second :: Maybe Int
, publication_year :: Maybe Int
, realdate_full_ :: Maybe String
, source :: Maybe String
, statuses :: Maybe (Array Status)
, title :: Maybe String
}
derive instance Generic DocumentV3 _
derive instance Newtype DocumentV3 _
derive newtype instance JSON.ReadForeign DocumentV3
derive newtype instance JSON.WriteForeign DocumentV3
instance Show DocumentV3 where show = genericShow
defaultNodeDocumentV3 :: NodePoly DocumentV3
defaultNodeDocumentV3 =
NodePoly { id : 0
, typename : 0
, userId : 0
, parentId : 0
, name : "Default name"
, date : "Default date"
, hyperdata : defaultDocumentV3
}
defaultDocumentV3 :: DocumentV3
defaultDocumentV3 =
DocumentV3 { abstract : Nothing
, authors : Nothing
--, error : Nothing
, language_iso2 : Nothing
, language_iso3 : Nothing
, language_name : Nothing
, publication_date : Nothing
, publication_day : Nothing
, publication_hour : Nothing
, publication_minute : Nothing
, publication_month : Nothing
, publication_second : Nothing
, publication_year : Nothing
, realdate_full_ : Nothing
, source : Nothing
, statuses : Nothing
, title : Nothing
}
newtype Document =
Document
{ abstract :: Maybe String
, authors :: Maybe String
, bdd :: Maybe String
, doi :: Maybe String
, language_iso2 :: Maybe String
-- , page :: Maybe Int
, publication_date :: Maybe String
--, publication_second :: Maybe Int
--, publication_minute :: Maybe Int
--, publication_hour :: Maybe Int
, publication_day :: Maybe Int
, publication_month :: Maybe Int
, publication_year :: Maybe Int
, source :: Maybe String
, institutes :: Maybe String
, title :: Maybe String
, uniqId :: Maybe String
--, url :: Maybe String
--, text :: Maybe String
}
derive instance Generic Document _
derive instance Newtype Document _
derive newtype instance JSON.ReadForeign Document
derive newtype instance JSON.WriteForeign Document
instance Eq Document where eq = genericEq
instance Show Document where show = genericShow
defaultNodeDocument :: NodeDocument
defaultNodeDocument =
NodePoly { id : 0
, typename : 0
, userId : 0
, parentId : 0
, name : "Default name"
, date : "Default date"
, hyperdata : defaultDocument
}
-- TODO: BUG if DOI does not exist, page is not shown
defaultDocument :: Document
defaultDocument =
Document { abstract : Nothing
, authors : Nothing
, bdd : Nothing
, doi : Nothing
, language_iso2 : Nothing
--, page : Nothing
, publication_date : Nothing
--, publication_second : Nothing
--, publication_minute : Nothing
--, publication_hour : Nothing
, publication_day : Nothing
, publication_month : Nothing
, publication_year : Nothing
, source : Nothing
, institutes : Nothing
, title : Nothing
, uniqId : Nothing
--, url : Nothing
--, text : Nothing
}
Graph/ 0000775 0000000 0000000 00000000000 14111104351 0034046 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Corpus Tabs.purs 0000664 0000000 0000000 00000003023 14111104351 0035650 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Corpus/Graph module Gargantext.Components.Nodes.Corpus.Graph.Tabs where
import Prelude hiding (div)
import Data.Array (fromFoldable)
import Data.Tuple (Tuple(..))
import Reactix as R
import Toestand as T
import Gargantext.Components.GraphExplorer.Types (GraphSideCorpus(..))
import Gargantext.Components.FacetsTable (docView)
import Gargantext.Components.Search (SearchQuery)
import Gargantext.Components.Table as Table
import Gargantext.Components.Tab as Tab
import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session)
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus.Graph.Tabs"
type Props =
( frontends :: Frontends
, query :: SearchQuery
, session :: Session
, sides :: Array GraphSideCorpus
)
tabs :: Record Props -> R.Element
tabs props = R.createElement tabsCpt props []
-- TODO no need for Children here
tabsCpt :: R.Component Props
tabsCpt = here.component "tabs" cpt
where
cpt {frontends, query, session, sides} _ = do
activeTab <- T.useBox 0
pure $ Tab.tabs { activeTab, tabs: tabs' }
where
tabs' = fromFoldable $ tab frontends session query <$> sides
tab :: Frontends -> Session -> SearchQuery -> GraphSideCorpus -> Tuple String R.Element
tab frontends session query (GraphSideCorpus {corpusId: nodeId, corpusLabel, listId}) =
Tuple corpusLabel (docView dvProps)
where
dvProps = {frontends, session, nodeId, listId, query, chart, totalRecords: 0, container}
chart = mempty
container = Table.graphContainer
Phylo.purs 0000664 0000000 0000000 00000001373 14111104351 0035017 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Corpus module Gargantext.Components.Nodes.Corpus.Phylo where
import Gargantext.Prelude
( pure, ($) )
-- import Gargantext.Utils.Toestand as T2
-- import Toestand as T
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Gargantext.Sessions (Session)
import Gargantext.Types (NodeID)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus.Phylo"
type Props = ( nodeId :: NodeID, session :: Session )
phyloLayout :: R2.Component Props
phyloLayout = R.createElement phyloLayoutCpt
phyloLayoutCpt :: R.Component Props
phyloLayoutCpt = here.component "phyloLayout" cpt where
cpt { nodeId, session } content = do
pure $ H.h1 {} [ H.text "Hello Phylo" ]
Types.purs 0000664 0000000 0000000 00000004762 14111104351 0035035 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Corpus module Gargantext.Components.Nodes.Corpus.Types where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, (.:), (:=), (~>), jsonEmptyObject)
import Data.Eq.Generic (genericEq)
import Data.Generic.Rep (class Generic)
import Data.List as List
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Gargantext.Components.Node (NodePoly)
import Gargantext.Components.Nodes.Types (FTField, Field(..), FieldType(..), FTField, FTFieldList(..), isJSON)
import Gargantext.Prelude
import Reactix as R
import Record as Record
import Simple.JSON as JSON
import Toestand as T
newtype Hyperdata =
Hyperdata { fields :: FTFieldList }
derive instance Generic Hyperdata _
derive instance Newtype Hyperdata _
instance Eq Hyperdata where eq = genericEq
derive newtype instance JSON.ReadForeign Hyperdata
derive newtype instance JSON.WriteForeign Hyperdata
type NoTotalRecords =
( title :: String
, authors :: String
, desc :: String
, query :: String
)
newtype CorpusInfo =
CorpusInfo { totalRecords :: Int
| NoTotalRecords
}
derive instance Generic CorpusInfo _
derive instance Newtype CorpusInfo _
instance JSON.ReadForeign CorpusInfo where
readImpl f = do
inst :: Record NoTotalRecords <- JSON.readImpl f
pure $ CorpusInfo $ Record.merge inst { totalRecords: 47361 } -- TODO
derive newtype instance JSON.WriteForeign CorpusInfo
type CorpusData = { corpusId :: Int
, corpusNode :: NodePoly Hyperdata -- CorpusInfo
, defaultListId :: Int }
getCorpusInfo :: FTFieldList -> CorpusInfo
getCorpusInfo (FTFieldList as) = case List.head (List.filter isJSON as) of
Just (Field {typ: JSON {authors, desc, query, title}}) -> CorpusInfo { title
, desc
, query
, authors
, totalRecords: 0
}
_ -> CorpusInfo { title:"Empty"
, desc:""
, query:""
, authors:""
, totalRecords: 0
}
Dashboard/ 0000775 0000000 0000000 00000000000 14111104351 0033421 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes Types.purs 0000664 0000000 0000000 00000005052 14111104351 0035442 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Dashboard module Gargantext.Components.Nodes.Dashboard.Types where
import Gargantext.Prelude
import Data.Either (Either)
import Data.Eq.Generic (genericEq)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Effect.Aff (Aff)
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.Components.Nodes.Types (FTFieldList)
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, get, put)
import Gargantext.Types (NodeType(..))
import Simple.JSON as JSON
type Preferences = Maybe String
newtype Hyperdata =
Hyperdata
{ charts :: Array P.PredefinedChart
, fields :: FTFieldList
, preferences :: Preferences
}
derive instance Generic Hyperdata _
derive instance Newtype Hyperdata _
derive newtype instance JSON.ReadForeign Hyperdata
derive newtype instance JSON.WriteForeign Hyperdata
-- instance JSON.WriteForeign Hyperdata where
-- writeImpl (Hyperdata h) = JSON.writeImpl h'
-- where
-- h' = { charts: h.charts
-- , fields: List.toUnfoldable h.fields :: Array FTField
-- , preferences: h.preferences }
instance Eq Hyperdata where
eq = genericEq
type LoadProps = ( nodeId :: Int, session :: Session )
loadDashboard' :: Record LoadProps -> Aff (Either RESTError DashboardData)
loadDashboard' {nodeId, session} = get session $ NodeAPI Node (Just nodeId) ""
-- Just to make reloading effective
loadDashboardWithReload :: {reload :: Int | LoadProps} -> Aff (Either RESTError DashboardData)
loadDashboardWithReload {nodeId, session} = loadDashboard' {nodeId, session}
type SaveProps = ( hyperdata :: Hyperdata | LoadProps )
saveDashboard :: Record SaveProps -> Aff (Either RESTError Int)
saveDashboard {hyperdata, nodeId, session} = do
put session (NodeAPI Node (Just nodeId) "") hyperdata
newtype DashboardData =
DashboardData
{ id :: Int
, hyperdata :: Hyperdata
, parentId :: Int
}
derive instance Generic DashboardData _
derive instance Newtype DashboardData _
instance JSON.ReadForeign DashboardData where
readImpl f = do
inst :: { id :: Int, hyperdata :: Hyperdata, parent_id :: Int } <- JSON.readImpl f
pure $ DashboardData { id: inst.id
, hyperdata: inst.hyperdata
, parentId: inst.parent_id }
instance JSON.WriteForeign DashboardData where
writeImpl (DashboardData { id, hyperdata, parentId }) =
JSON.writeImpl { id, hyperdata, parent_id: parentId }
instance Eq DashboardData where
eq = genericEq
File.purs 0000664 0000000 0000000 00000005312 14111104351 0033325 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes module Gargantext.Components.Nodes.File where
import Data.Generic.Rep (class Generic)
import Data.Either (Either(..))
import Data.Eq.Generic (genericEq)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Gargantext.Prelude
import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (toUrl)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
import Gargantext.Types (NodeType(..), NodeID)
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.File"
newtype HyperdataFile =
HyperdataFile
{ mime :: String
, name :: String
, path :: String
}
derive instance Generic HyperdataFile _
derive instance Newtype HyperdataFile _
derive newtype instance JSON.ReadForeign HyperdataFile
instance Eq HyperdataFile where
eq = genericEq
newtype File =
File
{ id :: Int
, date :: String
, hyperdata :: HyperdataFile
, name :: String
}
derive instance Generic File _
derive instance Newtype File _
derive newtype instance JSON.ReadForeign File
instance Eq File where
eq = genericEq
type FileLayoutProps = ( nodeId :: NodeID, session :: Session )
fileLayout :: R2.Leaf FileLayoutProps
fileLayout props = R.createElement fileLayoutCpt props []
fileLayoutCpt :: R.Component FileLayoutProps
fileLayoutCpt = here.component "fileLayout" cpt where
cpt { nodeId, session } _ = do
useLoader { errorHandler
, loader: loadFile session
, path: nodeId
, render: onLoad }
where
errorHandler err = here.log2 "RESTError" err
onLoad loaded = fileLayoutLoaded { loaded, nodeId, session }
loadFile :: Session -> NodeID -> Aff (Either RESTError File)
loadFile session nodeId = get session $ NodeAPI Node (Just nodeId) ""
type FileLayoutLoadedProps =
( loaded :: File
| FileLayoutProps
)
fileLayoutLoaded :: Record FileLayoutLoadedProps -> R.Element
fileLayoutLoaded props = R.createElement fileLayoutLoadedCpt props []
fileLayoutLoadedCpt :: R.Component FileLayoutLoadedProps
fileLayoutLoadedCpt = here.component "fileLayoutLoaded" cpt where
cpt { loaded: File { hyperdata: HyperdataFile hyperdata }, nodeId, session } _ = do
R.useEffect' $ here.log hyperdata
pure $
H.div { className: "col-md-12" }
[ H.div { className: "row" } [ H.h2 {} [ H.text hyperdata.name ] ]
, H.div { className: "row" }
[ H.div { className: "btn btn-primary" }
[ H.a { href, target: "_blank" } [ H.text "Download" ]]]] where
href = toUrl session ("node/" <> show nodeId <> "/file/download")
Frame.purs 0000664 0000000 0000000 00000012643 14111104351 0033505 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes module Gargantext.Components.Nodes.Frame where
import Gargantext.Prelude
import DOM.Simple as DOM
import Data.Either (Either)
import Data.Eq.Generic (genericEq)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Data.Nullable (Nullable, null, toMaybe)
import Data.Show.Generic (genericShow)
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
import Web.URL as WURL
import Gargantext.Components.FolderView as FV
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, get, sessionId)
import Gargantext.Types (NodeType(..))
import Gargantext.Utils.JitsiMeet as JM
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Frame"
newtype Hyperdata = Hyperdata { base :: String, frame_id :: String }
derive instance Generic Hyperdata _
derive instance Newtype Hyperdata _
instance Eq Hyperdata where eq = genericEq
instance Show Hyperdata where show = genericShow
derive newtype instance JSON.ReadForeign Hyperdata
derive newtype instance JSON.WriteForeign Hyperdata
type Props =
( nodeId :: Int
, nodeType :: NodeType
, session :: Session
)
type KeyProps =
( key :: String
| Props
)
frameLayout :: R2.Leaf Props
frameLayout props = R.createElement frameLayoutCpt props []
frameLayoutCpt :: R.Component Props
frameLayoutCpt = here.component "frameLayout" cpt where
cpt { nodeId, nodeType, session } _ = do
pure $ frameLayoutWithKey { key, nodeId, nodeType, session }
where
key = show (sessionId session) <> "-" <> show nodeId
frameLayoutWithKey :: R2.Leaf KeyProps
frameLayoutWithKey props = R.createElement frameLayoutWithKeyCpt props []
frameLayoutWithKeyCpt :: R.Component KeyProps
frameLayoutWithKeyCpt = here.component "frameLayoutWithKey" cpt where
cpt { nodeId, session, nodeType} _ = do
reload <- T.useBox T2.newReload
reload' <- T.useLive T.unequal reload
useLoader { errorHandler
, loader: loadframeWithReload
, path: {nodeId, reload: reload', session}
, render: \frame -> frameLayoutView {frame, nodeId, reload, session, nodeType} }
where
errorHandler err = here.log2 "[frameLayoutWithKey] RESTError" err
type ViewProps =
( frame :: NodePoly Hyperdata
, reload :: T2.ReloadS
, nodeId :: Int
, session :: Session
, nodeType :: NodeType
)
type Base = String
type FrameId = String
hframeUrl :: NodeType -> Base -> FrameId -> String
hframeUrl NodeFrameNotebook _ frame_id = frame_id -- Temp fix : frame_id is currently the whole url created
hframeUrl NodeFrameCalc base frame_id = base <> "/" <> frame_id
hframeUrl NodeFrameVisio base frame_id = base <> "/" <> frame_id
hframeUrl _ base frame_id = base <> "/" <> frame_id <> "?view" -- "?both"
frameLayoutView :: R2.Leaf ViewProps
frameLayoutView props = R.createElement frameLayoutViewCpt props []
frameLayoutViewCpt :: R.Component ViewProps
frameLayoutViewCpt = here.component "frameLayoutView" cpt
where
cpt { frame: NodePoly { hyperdata: Hyperdata { base, frame_id }}
, nodeType
, reload } _ = do
case nodeType of
NodeFrameVisio ->
case WURL.fromAbsolute base of
Nothing -> pure $ H.div {} [ H.text $ "Wrong base url: " <> base ]
Just url -> pure $ nodeFrameVisio { frame_id, reload, url }
_ ->
pure $ H.div{} [
FV.backButton
, FV.homeButton
, H.div { className : "frame"
, rows: "100%,*" }
[ -- H.script { src: "https://visio.gargantext.org/external_api.js"} [],
H.iframe { src: hframeUrl nodeType base frame_id
, width: "100%"
, height: "100%"
} []
]
]
type NodeFrameVisioProps =
( frame_id :: String
, reload :: T2.ReloadS
, url :: WURL.URL
)
nodeFrameVisio :: R2.Leaf NodeFrameVisioProps
nodeFrameVisio props = R.createElement nodeFrameVisioCpt props []
nodeFrameVisioCpt :: R.Component NodeFrameVisioProps
nodeFrameVisioCpt = here.component "nodeFrameVisio" cpt
where
cpt { frame_id
, url } _ = do
ref <- R.useRef (null :: Nullable DOM.Element)
R.useEffect' $ do
here.log2 "[nodeFrameVisio] ref" $ R.readRef ref
here.log2 "[nodeFrameVisio] JM.api" JM._api
case toMaybe (R.readRef ref) of
Nothing -> pure unit
Just r -> do
api <- JM.jitsiMeetAPI (WURL.host url) { parentNode: r, roomName: frame_id }
here.log2 "[nodeFrameVisio] api" api
pure $ H.div { ref } [ H.text $ WURL.host url ]
type LoadProps = ( nodeId :: Int
, session :: Session )
type ReloadProps = ( nodeId :: Int
, reload :: T2.Reload
, session :: Session )
loadframe' :: Record LoadProps -> Aff (Either RESTError (NodePoly Hyperdata))
loadframe' { nodeId, session } = get session $ NodeAPI Node (Just nodeId) ""
-- Just to make reloading effective
loadframeWithReload :: Record ReloadProps -> Aff (Either RESTError (NodePoly Hyperdata))
loadframeWithReload { nodeId, session } = loadframe' { nodeId, session }
Home.purs 0000664 0000000 0000000 00000036101 14111104351 0033336 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes module Gargantext.Components.Nodes.Home where
import Gargantext.Prelude
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype)
import Effect (Effect)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Data.Landing (BlockText(..), BlockTexts(..), Button(..), LandingData(..))
import Gargantext.Components.FolderView as FV
import Gargantext.Components.Lang (LandingLang(..))
import Gargantext.Components.Lang.Landing.EnUS as En
import Gargantext.Components.Lang.Landing.FrFR as Fr
import Gargantext.Components.Nodes.Home.Public (renderPublic)
import Gargantext.Config as Config
import Gargantext.Ends (Backend(..))
import Gargantext.License (license)
import Gargantext.Sessions (Sessions)
import Gargantext.Sessions as Sessions
import Gargantext.Sessions.Types (Session(..))
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Routing.Hash (setHash)
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Home"
newtype State = State { userName :: String, password :: String }
derive instance Newtype State _
initialState :: State
initialState = State { userName: "", password: "" }
data Action
= Documentation
| Enter
| Login
| SignUp
performAction :: Action -> Effect Unit
performAction Documentation = pure unit
performAction Enter = void $ setHash "/search"
performAction Login = void $ setHash "/login"
performAction SignUp = pure unit
langLandingData :: LandingLang -> LandingData
langLandingData LL_FR = Fr.landingData
langLandingData LL_EN = En.landingData
------------------------------------------------------------------------
type HomeProps =
( boxes :: Boxes
, lang :: LandingLang
)
homeLayout :: R2.Leaf HomeProps
homeLayout props = R.createElement homeLayoutCpt props []
homeLayoutCpt :: R.Component HomeProps
homeLayoutCpt = here.component "homeLayout" cpt
where
cpt { boxes: boxes@{ backend
, sessions
, showLogin }
, lang } _ = do
backend' <- T.useLive T.unequal backend
sessions' <- T.useLive T.unequal sessions
let landingData = langLandingData lang
pure $
H.span {}
[ H.div { className: "home-title container1" }
[ jumboTitle landingData ]
, H.div { className: "home-research-form container1" } [] -- TODO
, joinButtonOrTutorial boxes sessions' (click backend')
, H.div { className: "home-public container1" }
[ renderPublic { }
, H.div { className:"col-12 d-flex justify-content-center" }
[ H.h1 {} [ H.text "" ]] -- H.span {className: "fa fa-star-o"} []
, H.div { className: "home-landing-data container1" }
[ blocksRandomText' landingData ]
, license
]
] where
click mBackend _ =
case mBackend of
Nothing -> do
mLoc <- Config.matchCurrentLocation
case mLoc of
Nothing -> pure unit
Just b -> do
T.write_ (Just b) backend
T.write_ true showLogin
Just _ -> T.write_ true showLogin
joinButtonOrTutorial :: forall e. Boxes
-> Sessions
-> (e -> Effect Unit)
-> R.Element
joinButtonOrTutorial boxes sessions click =
if Sessions.null sessions
then joinButton click
else tutorial { boxes, sessions: Sessions.unSessions sessions }
joinButton :: forall e. (e -> Effect Unit) -> R.Element
joinButton click =
-- TODO Add G.C.L.F.form -- which backend to use?
-- form { backend, sessions, visible }
H.div { className: divClass
, style: { paddingTop: "100px", paddingBottom: "100px" } }
[ H.button { className: buttonClass, title, on: { click } } [ H.text "Log in" ] ] where
title = "Connect to the server"
divClass = "flex-space-around d-flex justify-content-center"
buttonClass = "btn btn-primary btn-lg btn-block"
incompatible :: String
incompatible =
"Sorry your browser is not compatible: use Firefox or Chromium instead."
video :: String -> R.Element
video fileDuration =
H.div { className:"col-12 d-flex justify-content-center" }
[ H.video
{ src, title, id, width: "900", type: "video/ogg", controls: true, muted: true }
[ H.text incompatible ] ] where
src = "http://dl.gargantext.org/" <> fileDuration
title = "tutorial video here"
id = "source_" <> fileDuration
data Tuto = Tuto { title :: String, id :: String, text :: String }
summary :: R.Element
summary =
H.div {}
[ H.h3 {} [ H.text "Summary"]
, H.ol {}
[ sum "Getting Started for beginners" startTutos "alert-info"
-- , sum "How to play (advanced users)?" playTutos "alert-warning"
-- , sum "How to master (expert users)?" expertTutos "alert-danger"
]]
where
sum name tutos class' =
H.div { className: "alert " <> class' }
[ H.li {}
[ H.h4 {} [ H.text name ]
, H.ol {} (map toSummary tutos) ] ]
toSummary (Tuto x) = H.li {} [ H.a {href: "#" <> x.id} [ H.text x.title ]]
type TutorialProps =
( boxes :: Boxes
, sessions :: Array Session )
tutorial :: R2.Leaf TutorialProps
tutorial props = R.createElement tutorialCpt props []
tutorialCpt :: R.Component TutorialProps
tutorialCpt = here.component "tutorial" cpt where
cpt { boxes
, sessions } _ = do
let folders = makeFolders sessions
pure $ H.div { className: "mx-auto container" }
[ H.div {className: "d-flex justify-content-center"} [ H.div { className: "folders" } folders ]
-- , H.h1 {} [H.text "Tutorials"]
-- , summary
-- , H.h3 {} [H.text "Resources"]
-- , section "How to start?" "alert-info" startTutos
-- , section "How to play?" "alert-warning" playTutos
-- , section "How to master?" "alert-danger" expertTutos
]
where
{-
section name class' tutos =
H.div {} $ Array.cons (H.h4 {} [ H.text name ]) (map (makeTuto class') tutos)
makeTuto class' (Tuto x) =
H.div { className : "alert " <> class', id: x.id}
[ video x.id, H.h4 {} [ H.text x.title ], H.p {} [ H.text x.text ] ]
-}
makeFolders :: Array Session -> Array R.Element
makeFolders s = sessionToFolder <$> s where
sessionToFolder session@(Session {treeId, username, backend: (Backend {name})}) =
H.span { className: "folder" } [
H.div { className: "d-flex justify-content-center" } [ H.text (username <> "@" <> name) ]
, H.div {} [ FV.folderView { backFolder: false, boxes, nodeId: treeId, session } ] ]
startTutos :: Array Tuto
startTutos =
[ Tuto { title: "The tree to manage your data"
, id: "0_tree.ogv"
, text : "The tree enables you to control all your actions. The Tree has typed nodes. Each node has some attributes and some methods which depend on its type. This specific ergonomy helps the memorization of all the complexity of the GarganTexts' features: hence you do not need to remember all the documentation! Just remember these simple axioms, the Tree is built with parent-children relations of nodes which have specific attributes and methods. To get its methods and attributes, just click on the wheel near its name (for this feature, see advanced tutorial: how to play with GarganText)." }
-- , Tuto { title : "Edit your profile"
-- , id : "0_edit.ogv"
-- , text : "At the root of the tree, there is your user node, parent of all others nodes. Your profile is what others users will see or search for to reach you or to watch/follow your work. If you delete it you remove all your data from the specified instance, clear and simple." }
, Tuto { title : "Discover the nodes of the tree"
, id : "0_nodes.ogv"
, text : "Under your user node you have 3 main nodes: private, shared and public nodes. Each node has its specific attributes and methods! Under private node, all your work is private only. Under shared folder you can create teams to invite your partners, students or colleagues. Under public node, you can publish your work with the world: hello word!" }
-- , Tuto { title : "Read a corpus"
-- , id : "video_tutorial.mp4#t=43,79"
-- , text : "Each fresh corpus node has 4 children only: docs, list, board, graph. The docs node enable you to manage your documents and rate it. The list node let the user to manage its ngrams. The board node sum up your analysis with the main charts you made with your ngrams. The graph node let you explore your data in a new way. Others new type of nodes are coming such as Phylo node..." }
-- , Tuto { title : "Manage your ngrams"
-- , id : "video_tutorial.mp4#t=80,214"
-- , text : "By default, 4 types of ngrams are created: Terms extracted from text fields such as title or abstract, Institutes are extracted from the Institute field of the metadata, Sources, Authors. In that tutorial, you will learn how to change the status of ngrams, group it or create new categories. Remember you need to save your work with the sycn button. Then the charts are updated after each sync. Your work is either synchronous or asynchronous: you can save locally your data, disconnect your device and sync when your Internet connection is back." }
-- , Tuto { title : "Watch with the board"
-- , id : "video_tutorial.mp4#t=215,237"
-- , text : "Build your own watchboard! Easy. All your list enable you to have charts to follow the evolution of your corpus." }
-- , Tuto { title : "Explore with the graph"
-- , id : "video_tutorial.mp4#t=238,293"
-- , text : "With the map terms you have selected already, the graph is built. 3 main panels can be hidden or shown to give you more visual space: tree, controls, side panel. The side panel shows the legend, the selected data and the community you are watching. You can link your corpus with a community (check nodes methods to do this)." }
-- , Tuto { title : "Edit ngrams in your documents"
-- , id : "video_tutorial.mp4#t=294,312"
-- , text : "All selected ngrams can be updated in the document and they are autmatically updated in the lists." }
]
playTutos :: Array Tuto
playTutos = []
-- [ Tuto { title : "Again the tree is your friend"
-- , id : "video_tutorial_1.mp4#t=,46"
-- , text : "At the right of each node, its wheel shows its attributes or enables the execution of its methods. Each type of node has different attributes and methods to help user in an ergonomic way." }
-- , Tuto { title : "Build your analysis"
-- , id : "video_tutorial_1.mp4#t=47,146"
-- , text : "To build your analysis you need to create a corpus. Suppose you want to create it in your private folder in this tutorial. Use the wheel to execute any function on the corpus node in the tree. You can search the local database instance, the web or through apis connected to public databases. It becomes easy to add many documents to your dynamic corpus." }
-- , Tuto { title : "Add documents with files and download your data"
-- , id : "video_tutorial_1.mp4#t=157,166"
-- , text : "You can add CSV files from Gargantext V3 legacy version: in your previous account, export your corpus and download it on your device. Then, upload it to v4 as CSV file." }
-- , Tuto { title : "Move your corpus elsewhere in the tree"
-- , id : "video_tutorial_1.mp4#t=167,175"
-- , text : "Each node can be moved with this function. Move it in your team to share it. Remove it to unshare it. Some nodes can not be moved, it depends on the types methods." }
-- , Tuto { title : "Rename your corpus"
-- , id : "video_tutorial_1.mp4#t=145,160"
-- , text : "Some nodes can be renamed, most of them. But you can not rename your User Node which is the root of the tree." }
-- , Tuto { title : "Delete your corpus"
-- , id : "video_tutorial_1.mp4#t=179,182"
-- , text : "Each node can be deleted with its children." }
-- ]
expertTutos :: Array Tuto
expertTutos = []
-- [ Tuto { title : "Share with a team and send invitations"
-- , id : "video_tutorial_2.mp4#t=,46"
-- , text : "[Link to update]" }
-- , Tuto { title : "Multi instance connections"
-- , id : "video_tutorial_2.mp4#t=,46"
-- , text : "[Link to update]" }
-- , Tuto { title : "Freeze a graph"
-- , id : "video_tutorial_2.mp4#t=,46"
-- , text : "[Link to update]" }
-- , Tuto { title : "Publish"
-- , id : "video_tutorial_2.mp4#t=,46"
-- , text : "[Link to update]" }
-- , Tuto { title : "Link a set of document (corpus) with a set of persons (community)"
-- , id : "video_tutorial_2.mp4#t=,46"
-- , text : "[Link to update]" }
-- , Tuto { title : "Social lists: cumulative work made easy"
-- , id : "video_tutorial_2.mp4#t=,46"
-- , text : "[Link to update]" }
-- , Tuto { title : "Data mining with calc"
-- , id : "video_tutorial_2.mp4#t=,46"
-- , text : "[Link to update]" }
-- , Tuto { title : "Collaborative sync edition notes"
-- , id : "video_tutorial_2.mp4#t=,46"
-- , text : "[Link to update]" }
-- , Tuto { title : "Coding with our notebooks"
-- , id : "video_tutorial_2.mp4#t=,46"
-- , text : "[Link to update]" }
-- , Tuto { title : "Our api"
-- , id : "video_tutorial_2.mp4#t=,46"
-- , text : "[Link to update]" }
-- , Tuto { title : "A tour in the code"
-- , id : "video_tutorial_2.mp4#t=,46"
-- , text : "[Link to update]" }
-- ]
blocksRandomText' :: LandingData -> R.Element
blocksRandomText' (LandingData hd) = blocksRandomText hd.blockTexts
blocksRandomText :: BlockTexts -> R.Element
blocksRandomText (BlockTexts bt) =
H.div { className: "row" } ( map showBlock bt.blocks )
where
showBlock :: BlockText -> R.Element
showBlock (BlockText b) =
H.div { className: "col-md-4 content" }
[ H.h3 {}
[ H.a { href: b.href, title: b.title}
[ H.i { className: b.icon } []
, H.text (" " <> b.titleText) ]]
, H.p {} [ H.text b.text ]
, H.p {} [ docButton b.docButton ]]
docButton :: Button -> R.Element
docButton (Button b) =
H.a { className, href: b.href, target: "blank", title: b.title }
[ H.span { aria: { hidden: true }, className: "fa fa-hand-right" } []
, H.text b.text ] where
className = "btn btn-outline-primary btn-sm spacing-class"
-- | TODO
--
jumboTitle :: LandingData -> R.Element
jumboTitle (LandingData hd) =
H.div {}
[ H.div { className: "row" }
[ H.div { className: "mx-auto" }
[ H.div { id: "logo-designed" }
[ H.img { src: "images/logo.png", title: hd.logoTitle } ]]]]
imageEnter :: forall t. LandingData -> t -> R.Element
imageEnter (LandingData hd) action =
H.div {className: "row"}
[ H.div {className: "col-md-offset-5 col-md-6 content"}
[ H.img { src, action, id: "funnyimg", title: hd.imageTitle } ] ] where
src = "images/Gargantextuel-212x300.jpg"
Home/ 0000775 0000000 0000000 00000000000 14111104351 0032422 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes Public.purs 0000664 0000000 0000000 00000011050 14111104351 0034550 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Home module Gargantext.Components.Nodes.Home.Public where
import Data.Either (Either)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Data.Show.Generic (genericShow)
import Data.String (take)
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Simple.JSON.Generics as JSONG
import Gargantext.Config (publicBackend)
import Gargantext.Config.REST (get, RESTError)
import Gargantext.Ends (backendUrl)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Home.Public"
type PublicDataProps = ( publicData :: Array PublicData )
data PublicData = PublicData
{ title :: String
, abstract :: String
, img :: String
, url :: String
, date :: String
, database :: String
, author :: String
} | NoData { nodata :: String }
derive instance Eq PublicData
derive instance Generic PublicData _
instance JSON.ReadForeign PublicData where readImpl = JSONG.untaggedSumRep
instance Show PublicData where
show = genericShow
------------------------------------------------------------------------
type LoadData :: forall k. Row k
type LoadData = ()
type LoadProps = (reload :: Int)
-- | WIP still finding the right way to chose the default public backend
loadPublicData :: Record LoadProps -> Aff (Either RESTError (Array PublicData))
loadPublicData _l = do
-- This solution is error prone (url needs to be cleaned)
--backend <- liftEffect public
-- This solution for development only, with local backend
-- let backend = head defaultBackends
let backend = publicBackend
get Nothing (backendUrl backend "public")
{- | Another solution: get all data
let
ok = ["local.cnrs", "devel.inshs.cnrs"]
backends = Array.filter
(\(Backend {name}) -> Array.elem name ok)
(toArray defaultBackends)
Array.concat <$> traverse
(\backend -> get Nothing (backendUrl backend "public"))
backends
-}
renderPublic :: R2.Leaf ()
renderPublic props = R.createElement renderPublicCpt props []
renderPublicCpt :: R.Component ()
renderPublicCpt = here.component "renderPublic" cpt where
cpt _ _ = do
useLoader { errorHandler
, loader: loadPublicData
, path: { reload: 0 }
, render: loaded }
where
loaded publicData = publicLayout { publicData }
errorHandler err = here.log2 "RESTError" err
publicLayout :: Record PublicDataProps -> R.Element
publicLayout props = R.createElement publicLayoutCpt props []
publicLayoutCpt :: R.Component PublicDataProps
publicLayoutCpt = here.component "publicLayout" cpt
where
cpt { publicData } _ = do
pure $
H.span {}
[ H.div { className: "text-center" }
[ H.div { className:"container1", style: { marginBottom: "15px" }}
[ H.h2 {}
[ H.text "Discover knowledge"
, H.p { className: "lead text-muted center"}
[ H.text "maps made with "
, H.span { className: "fa fa-heart" } [] ]]]]
-- | TODO: browse maps, random maps
, album publicData ]
album :: Array PublicData -> R.Element
album pd =
H.div { className: "album py-5 bg-light" }
[ H.div { className: "container" }
[ H.div { className: "row" } (map content pd) ]]
where content tab = H.div { className: "col-md-6 content"} [ tableau tab ]
tableau :: PublicData -> R.Element
tableau (NoData _) =
H.div { className : "center" }
[ H.h2 {} [ H.text "Create a corpus and publicize it" ]]
tableau (PublicData { title, abstract, img, url, date, database, author }) =
H.div { className: "card mb-6 box-shadow" }
[ H.a { target: "_blank", href: url }
[ H.div { className:"center"} [ H.img { src: img, width: "50%" } ]]
, H.div { className : "card-body"}
[ H.h3 {} [H.text title]
, H.p { className: "card-text"} [ H.text $ (take 252 abstract) <> "..." ]
, H.div { className: "center justify-content-between align-items-center" }
[ H.div { className: "btn-group" }
[ H.div { className : "small text-muted flex-end" }
[ H.text
$ "Made by " <> author
<> " on " <> date
<> " with " <> database ]]]]]
-- , H.button { className: "btn btn-primary flex-between"
-- , href: url, role: "button" }
-- [ H.text "View the map" ]
-- , H.button { className: "btn btn-primary flex-start"
-- , href: url, role: "button" }
-- [ H.text "More like this" ]]]]
RandomText.purs 0000664 0000000 0000000 00000007747 14111104351 0035441 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Home {-|
Module : RandomText
Description : Contextual randomized text
Copyright : (c) CNRS / Alexandre Delanoe, 2017-present
License : AGPL + CECILL v3
Maintainer : alexandre.delanoe@iscpif.fr
Stability : experimental
Portability : POSIX
How semantic emerges from contextualized randomness can be experimented
with these simple functions;
randomSentences: randomizes sentences in a paragraph.
randomWords : randomizes words in a sentence.
randomChars : randomizes chars in a word.
TODO: add some tests as examples.
-}
module Gargantext.Components.RandomText where
import Prelude
import Data.Array (drop, dropEnd, filter, foldl, head, length, tail, take, takeEnd, (!!))
import Data.Maybe (Maybe(Nothing, Just), fromJust)
import Data.String (Pattern(..), split)
import Data.String.CodeUnits (fromCharArray, toCharArray)
import Effect (Effect)
import Effect.Random (randomInt)
import Partial (crash)
import Partial.Unsafe (unsafePartial)
-------------------------------------------------------------------
randomSentences :: String -> Effect String
randomSentences ss = case (length (sentences ss)) >= 5 of
true -> foldl (\a b -> a <> "." <> b) "" <$> randomPart (sentences ss)
_ -> pure ss
randomWords :: String -> Effect String
randomWords ws = case (length (words ws)) >= 5 of
true -> foldl (\a b -> a <> " " <> b) "" <$> randomPart (words ws)
_ -> pure ws
randomChars :: String -> Effect String
randomChars word = case (length (toCharArray word)) >= 5 of
true -> fromCharArray <$> randomPart (toCharArray word)
_ -> pure word
-------------------------------------------------------------------
words :: String -> Array String
words sentence = filter ((/=) "")
$ split (Pattern " ") sentence
sentences :: String -> Array String
sentences paragraph = filter ((/=) "")
$ split (Pattern ".") paragraph
-------------------------------------------------------------------
data RandomWheel a = RandomWheel { before :: Array a
, during :: a
, after :: Array a
}
randomPart :: forall b. Array b -> Effect (Array b)
randomPart array = randomArrayPoly middle
>>= \(middle') -> pure ( start <> middle' <> end)
where
start = take 2 array
middle = dropEnd 2 $ drop 2 array
end = takeEnd 2 array
randomArrayPoly :: forall a. Array a -> Effect (Array a)
randomArrayPoly wheel = case head wheel of
Nothing -> pure []
Just wheel' -> randomWheel (RandomWheel { before:wheel, during:wheel', after:[]})
>>= \(RandomWheel rand) -> (pure rand.after)
randomWheel :: forall b. RandomWheel b -> Effect (RandomWheel b)
randomWheel (RandomWheel {before:[], during:d, after:a}) =
pure (RandomWheel {before:[], during:d, after:a})
randomWheel (RandomWheel {before:b, during:d, after:a}) = do
RandomWheel {before:b', during:d', after:a'} <- randomArray b
randomWheel $ RandomWheel {before:b', during:d', after:(a <> [d'])}
randomArray :: forall b. Array b -> Effect (RandomWheel b)
randomArray array = unsafePartial $ do
n <- randomInt 0 (length array - 1)
let maybeDuring = (array !! n)
case maybeDuring of
Nothing ->
crash "[G.C.N.H.R.RandomText ERROR] It should never happen."
Just during ->
pure $ RandomWheel { before : remove n array
, during : during
, after : []
}
remove :: forall a. Int -> Array a -> Array a
remove n [] = []
remove n xs = unsafePartial $ case n of
0 -> fromJust $ tail xs
_ -> (take n xs) <> (drop (n+1) xs)
-------------------------------------------------------------------
Lists.purs 0000664 0000000 0000000 00000012035 14111104351 0033544 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes module Gargantext.Components.Nodes.Lists where
import Gargantext.Prelude
import Effect (Effect)
import Effect.Aff (launchAff_)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.NgramsTable.Loader (clearCache)
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild)
import Gargantext.Components.Nodes.Corpus.Types (getCorpusInfo, CorpusInfo(..), Hyperdata(..))
import Gargantext.Components.Nodes.Lists.Tabs as Tabs
import Gargantext.Components.Nodes.Lists.Types (CacheState(..))
import Gargantext.Components.Table as Table
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Sessions (WithSession, WithSessionContext, Session, sessionId, getCacheState, setCacheState)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Lists"
--------------------------------------------------------
type CommonPropsNoSession =
( boxes :: Boxes
, nodeId :: Int
, sessionUpdate :: Session -> Effect Unit
)
type Props = WithSession CommonPropsNoSession
type CommonPropsSessionContext = WithSessionContext CommonPropsNoSession
type WithTreeProps = ( handed :: GT.Handed | Props )
listsLayout :: R2.Component Props
listsLayout = R.createElement listsLayoutCpt
listsLayoutCpt :: R.Component Props
listsLayoutCpt = here.component "listsLayout" cpt where
cpt props@{ nodeId, session } _ = do
let sid = sessionId session
pure $ listsLayoutWithKey (Record.merge props { key: show sid <> "-" <> show nodeId }) []
type KeyProps =
( key :: String
| Props )
listsLayoutWithKey :: R2.Component KeyProps
listsLayoutWithKey = R.createElement listsLayoutWithKeyCpt
listsLayoutWithKeyCpt :: R.Component KeyProps
listsLayoutWithKeyCpt = here.component "listsLayoutWithKey" cpt where
cpt { boxes: boxes@{ reloadMainPage }
, nodeId
, session
, sessionUpdate } _ = do
activeTab <- T.useBox 0
_reloadMainPage' <- T.useLive T.unequal reloadMainPage
let path = { nodeId, session }
cacheState <- T.useBox $ getCacheState CacheOn session nodeId
cacheState' <- T.useLive T.unequal cacheState
R.useEffectOnce' $ do
T.listen (\{ new } -> afterCacheStateChange new) cacheState
useLoader { errorHandler
, path
, loader: loadCorpusWithChild
, render: \corpusData@{ corpusId, corpusNode: NodePoly poly } ->
let { date, hyperdata : Hyperdata h, name } = poly
CorpusInfo { authors, desc, query } = getCorpusInfo h.fields
in
R.fragment [
Table.tableHeaderLayout {
cacheState
, date
, desc
, key: "listsLayoutWithKey-header-" <> (show cacheState')
, query
, title: "Corpus " <> name
, user: authors } []
, Tabs.tabs {
activeTab
, boxes
, cacheState
, corpusData
, corpusId
, key: "listsLayoutWithKey-tabs-" <> (show cacheState')
, session
}
] }
where
errorHandler err = here.log2 "[listsLayoutWithKey] RESTError" err
afterCacheStateChange cacheState = do
launchAff_ $ clearCache unit
sessionUpdate $ setCacheState session nodeId cacheState
type SidePanelProps =
( session :: Session
, sidePanelState :: T.Box GT.SidePanelState
)
sidePanel :: R2.Component SidePanelProps
sidePanel = R.createElement sidePanelCpt
sidePanelCpt :: R.Component SidePanelProps
sidePanelCpt = here.component "sidePanel" cpt
where
cpt { session
, sidePanelState } _ = do
sidePanelState' <- T.useLive T.unequal sidePanelState
let mainStyle = case sidePanelState' of
GT.Opened -> { display: "block" }
_ -> { display: "none" }
let closeSidePanel _ = T.write_ GT.Closed sidePanelState
pure $ H.div { style: mainStyle } [
H.div { className: "header" } [
H.span { className: "btn btn-danger"
, on: { click: closeSidePanel } } [
H.span { className: "fa fa-times" } []
]
]
, sidePanelDocView { session } []
]
type SidePanelDocView = ( session :: Session )
sidePanelDocView :: R2.Component SidePanelDocView
sidePanelDocView = R.createElement sidePanelDocViewCpt
sidePanelDocViewCpt :: R.Component SidePanelDocView
sidePanelDocViewCpt = here.component "sidePanelDocView" cpt where
cpt { } _ = do
-- pure $ H.h4 {} [ H.text txt ]
pure $ H.div {} [ H.text "Hello ngrams" ]
Lists/ 0000775 0000000 0000000 00000000000 14111104351 0032630 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes Tabs.purs 0000664 0000000 0000000 00000014077 14111104351 0034445 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Lists module Gargantext.Components.Nodes.Lists.Tabs where
import Gargantext.Components.Nodes.Lists.Types
import Data.Array as A
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple.Nested ((/\))
import Effect.Class (liftEffect)
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.NgramsTable as NT
import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Components.Nodes.Corpus.Chart.Metrics (metrics)
import Gargantext.Components.Nodes.Corpus.Chart.Pie (pie, bar)
import Gargantext.Components.Nodes.Corpus.Chart.Tree (tree)
import Gargantext.Components.Nodes.Corpus.Chart.Utils (mNgramsTypeFromTabType)
import Gargantext.Components.Nodes.Corpus.Types (CorpusData)
import Gargantext.Components.Tab as Tab
import Gargantext.Prelude (bind, pure, unit, ($), (<>))
import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType(..), FrontendError, Mode(..), TabSubType(..), TabType(..), modeTabType)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RX
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Lists.Tabs"
type Props = (
activeTab :: T.Box Int
, boxes :: Boxes
, cacheState :: T.Box CacheState
, corpusData :: CorpusData
, corpusId :: Int
, session :: Session
)
type PropsWithKey = ( key :: String | Props )
tabs :: Record PropsWithKey -> R.Element
tabs props = R.createElement tabsCpt props []
tabsCpt :: R.Component PropsWithKey
tabsCpt = here.component "tabs" cpt where
cpt props@{ activeTab } _ = do
pure $ Tab.tabs { activeTab
, tabs: tabs' } where
tabs' = [ "Terms" /\ view Terms []
, "Authors" /\ view Authors []
, "Institutes" /\ view Institutes []
, "Sources" /\ view Sources []
]
common = RX.pick props :: Record Props
view mode = ngramsView $ Record.merge common { mode }
type NgramsViewProps = ( mode :: Mode | Props )
ngramsView :: R2.Component NgramsViewProps
ngramsView = R.createElement ngramsViewCpt
ngramsViewCpt :: R.Component NgramsViewProps
ngramsViewCpt = here.component "ngramsView" cpt where
cpt props@{ boxes
, cacheState
, corpusData: { defaultListId }
, corpusId
, mode
, session } _ = do
chartsReload <- T.useBox T2.newReload
path <- T.useBox $ NTC.initialPageParams props.session initialPath.corpusId [initialPath.listId] initialPath.tabType
{ listIds, nodeId, params, tabType } <- T.useLive T.unequal path
let path' = {
corpusId: nodeId
, limit: params.limit
, listId: fromMaybe defaultListId $ A.head listIds
, tabType: tabType
}
let chartParams = {
corpusId: path'.corpusId
, limit: Just path'.limit
, listId: path'.listId
, tabType: path'.tabType
}
pure $ R.fragment
( charts chartParams tabNgramType
<> [ NT.mainNgramsTable { afterSync: afterSync chartsReload
, boxes
, cacheState
, defaultListId
, path
, session
, tabNgramType
, tabType
, withAutoUpdate: false
} []
]
)
where
afterSync chartsReload _ = do
case mNgramsType of
Just ngramsType -> do
-- NOTE: No need to recompute chart, after ngrams are sync this
-- should be recomputed already
-- We just refresh it
-- _ <- recomputeChart session chartType ngramsType corpusId listId
liftEffect $ T2.reload chartsReload
Nothing -> pure unit
tabNgramType = modeTabType mode
tabType = TabCorpus (TabNgramType tabNgramType)
mNgramsType = mNgramsTypeFromTabType tabType
listId = defaultListId
initialPath = { corpusId
-- , limit: Just 1000
, listId
, tabType
}
charts params CTabTerms = [
H.div {className: "row"}
[ H.div {className: "col-12 d-flex justify-content-center"}
[ H.img { src: "images/Gargantextuel-212x300.jpg"
, id: "funnyimg"
}
]
]
{-
R2.select { className: "form-control"
, defaultValue: show chartType
, on: { change: \e -> setChartType
$ const
$ fromMaybe Histo
$ chartTypeFromString
$ R.unsafeEventValue e
}
} [
H.option { value: show Histo } [ H.text $ show Histo ]
, H.option { value: show Scatter } [ H.text $ show Scatter ]
, H.option { value: show ChartBar } [ H.text $ show ChartBar ]
, H.option { value: show ChartPie } [ H.text $ show ChartPie ]
, H.option { value: show ChartTree } [ H.text $ show ChartTree ]
]
]
]
, getChartFunction chartType $ { path: params, session }
-}
]
charts params _ = [ chart params mode ]
chart path Authors = pie { boxes, path, session, onClick: Nothing, onInit: Nothing }
chart path Institutes = tree { boxes, path, session, onClick: Nothing, onInit: Nothing }
chart path Sources = bar { boxes, path, session, onClick: Nothing, onInit: Nothing }
chart path Terms = metrics { boxes, path, session, onClick: Nothing, onInit: Nothing }
Types.purs 0000664 0000000 0000000 00000001532 14111104351 0034650 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Lists module Gargantext.Components.Nodes.Lists.Types where
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Maybe (Maybe(..))
import Data.Show.Generic (genericShow)
import Simple.JSON as JSON
import Simple.JSON.Generics as JSONG
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Lists.Types"
data CacheState = CacheOn | CacheOff
derive instance Generic CacheState _
instance JSON.ReadForeign CacheState where
readImpl = JSONG.enumSumRep
instance JSON.WriteForeign CacheState where
writeImpl = JSON.writeImpl <<< show
instance Eq CacheState where
eq = genericEq
instance Show CacheState where
show = genericShow
type SidePanel :: forall k. Row k
type SidePanel = ()
initialSidePanel :: Maybe (Record SidePanel)
initialSidePanel = Nothing
Texts.purs 0000664 0000000 0000000 00000037477 14111104351 0033576 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes module Gargantext.Components.Nodes.Texts where
import Gargantext.Prelude
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Data.Show.Generic (genericShow)
import Data.Tuple.Nested ((/\))
import Effect.Aff (launchAff_)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.Charts.Options.ECharts (dispatchAction)
import Gargantext.Components.Charts.Options.Type (EChartsInstance, EChartActionData)
import Gargantext.Components.DocsTable as DT
import Gargantext.Components.DocsTable.Types (Year)
import Gargantext.Components.NgramsTable.Loader (clearCache)
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Nodes.Corpus (loadCorpusWithChild)
import Gargantext.Components.Nodes.Corpus.Chart.Histo (histo)
import Gargantext.Components.Nodes.Corpus.Document as D
import Gargantext.Components.Nodes.Corpus.Types (CorpusData, CorpusInfo(..), Hyperdata(..), getCorpusInfo)
import Gargantext.Components.Nodes.Lists.Types as LT
import Gargantext.Components.Nodes.Texts.Types as TT
import Gargantext.Components.Tab as Tab
import Gargantext.Components.Table as Table
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Sessions (WithSession, Session, getCacheState)
import Gargantext.Types (CTabNgramType(..), ListId, NodeID, SidePanelState(..), TabSubType(..), TabType(..))
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Texts"
--------------------------------------------------------
type CommonPropsNoSession =
( boxes :: Boxes
, frontends :: Frontends
, nodeId :: NodeID
)
type Props = WithSession CommonPropsNoSession
textsLayout :: R2.Component Props
textsLayout = R.createElement textsLayoutCpt
textsLayoutCpt :: R.Component Props
textsLayoutCpt = here.component "textsLayout" cpt where
cpt { boxes, frontends, nodeId, session } children = do
pure $ textsLayoutWithKey { key
, boxes
, frontends
, nodeId
, session } children
where
key = show nodeId
-- key = show sid <> "-" <> show nodeId
-- where
-- sid = sessionId session
type KeyProps = (
key :: String
, boxes :: Boxes
, frontends :: Frontends
, nodeId :: NodeID
, session :: Session
)
textsLayoutWithKey :: R2.Component KeyProps
textsLayoutWithKey = R.createElement textsLayoutWithKeyCpt
textsLayoutWithKeyCpt :: R.Component KeyProps
textsLayoutWithKeyCpt = here.component "textsLayoutWithKey" cpt
where
cpt { boxes: boxes@{ sidePanelTexts }
, frontends
, nodeId
, session } _children = do
cacheState <- T.useBox $ getCacheState LT.CacheOff session nodeId
cacheState' <- T.useLive T.unequal cacheState
yearFilter <- T.useBox (Nothing :: Maybe Year)
eChartsInstance <- T.useBox (Nothing :: Maybe EChartsInstance)
R.useEffectOnce' $ do
T.listen (\{ new } -> afterCacheStateChange new) cacheState
useLoader { errorHandler
, loader: loadCorpusWithChild
, path: { nodeId, session }
, render: \corpusData@{ corpusId, corpusNode } -> do
let NodePoly { date, hyperdata: Hyperdata h, name } = corpusNode
CorpusInfo { authors, desc, query } = getCorpusInfo h.fields
title = "Corpus " <> name
R.fragment
[ Table.tableHeaderLayout { cacheState
, date
, desc
, query
, title
, user: authors
, key: "textsLayoutWithKey-" <> (show cacheState') } []
, tabs { boxes
, cacheState
, corpusData
, corpusId
, eChartsInstance
, frontends
, session
, sidePanel: sidePanelTexts
, yearFilter
}
] }
where
errorHandler err = here.log2 "[textsLayoutWithKey] RESTError" err
afterCacheStateChange cacheState = do
launchAff_ $ clearCache unit
-- TODO
--sessionUpdate $ setCacheState session nodeId cacheState
--_ <- setCacheState session nodeId cacheState
data Mode = MoreLikeFav | MoreLikeTrash
derive instance Generic Mode _
instance Show Mode where
show = genericShow
derive instance Eq Mode
modeTabType :: Mode -> CTabNgramType
modeTabType MoreLikeFav = CTabAuthors -- TODO
modeTabType MoreLikeTrash = CTabSources -- TODO
type TabsProps =
( boxes :: Boxes
, cacheState :: T.Box LT.CacheState
, corpusData :: CorpusData
, corpusId :: NodeID
, eChartsInstance :: T.Box (Maybe EChartsInstance)
, frontends :: Frontends
, session :: Session
, sidePanel :: T.Box (Maybe (Record TT.SidePanel))
, yearFilter :: T.Box (Maybe Year)
)
tabs :: Record TabsProps -> R.Element
tabs props = R.createElement tabsCpt props []
tabsCpt :: R.Component TabsProps
tabsCpt = here.component "tabs" cpt
where
cpt { boxes
, cacheState
, corpusId
, corpusData
, eChartsInstance
, frontends
, session
, sidePanel
, yearFilter } _ = do
let
path = initialPath
onInit = Just \i -> T.write_ (Just i) eChartsInstance
onClick = Just \opts@{ name } -> do
T.write_ (Just name) yearFilter
T.read eChartsInstance >>= case _ of
Nothing -> pure unit
Just i -> do
-- @XXX due to lack of support for "echart.select" action,
-- have to manually rely on a set/unset selection
-- targeting the "echart.emphasis" action
let
opts' :: Record EChartActionData
opts' =
{ dataIndex : opts.dataIndex
, name : opts.name
, seriesId : opts.seriesId
, seriesIndex : opts.seriesIndex
, seriesName : opts.seriesName
, type : "highlight"
}
dispatchAction i { type: "downplay" }
dispatchAction i opts'
activeTab <- T.useBox 0
pure $ Tab.tabs {
activeTab
, tabs: [
"Documents" /\ R.fragment [
histo { boxes, path, session, onClick, onInit }
, docView' path TabDocs
]
, "Trash" /\ docView' path TabTrash
-- , "More like fav" /\ docView' path TabMoreLikeFav
-- , "More like trash" /\ docView' path TabMoreLikeTrash
]
}
where
initialPath = { corpusId
, listId: corpusData.defaultListId
, limit: Nothing
, tabType: TabCorpus TabDocs }
docView' path tabType = docView { boxes
, cacheState
, corpusData
, corpusId
, frontends
, listId: path.listId
-- , path
, session
, tabType
, sidePanel
, yearFilter
} []
type DocViewProps a =
( boxes :: Boxes
, cacheState :: T.Box LT.CacheState
, corpusData :: CorpusData
, corpusId :: NodeID
, frontends :: Frontends
, listId :: ListId
-- , path :: Record DT.Path
, session :: Session
, tabType :: TabSubType a
, sidePanel :: T.Box (Maybe (Record TT.SidePanel))
, yearFilter :: T.Box (Maybe Year)
)
docView :: forall a. R2.Component (DocViewProps a)
docView = R.createElement docViewCpt
docViewCpt :: forall a. R.Component (DocViewProps a)
docViewCpt = here.component "docView" cpt
where
cpt props _children = do
pure $ DT.docViewLayout $ docViewLayoutRec props
-- docViewLayoutRec :: forall a. DocViewProps a -> Record DT.LayoutProps
docViewLayoutRec { boxes
, cacheState
, corpusId
, frontends
, listId
, session
, tabType: TabDocs
, sidePanel
, yearFilter
} =
{ boxes
, cacheState
, chart : H.div {} []
, frontends
, listId
, mCorpusId: Just corpusId
, nodeId: corpusId
-- ^ TODO merge nodeId and corpusId in DT
, session
, showSearch: true
, sidePanel
, tabType: TabCorpus TabDocs
, totalRecords: 4737
, yearFilter
}
docViewLayoutRec { boxes
, cacheState
, corpusId
, frontends
, listId
, session
, tabType: TabMoreLikeFav
, sidePanel
, yearFilter
} =
{ boxes
, cacheState
, chart : H.div {} []
, frontends
, listId
, mCorpusId: Just corpusId
, nodeId: corpusId
-- ^ TODO merge nodeId and corpusId in DT
, session
, showSearch: false
, sidePanel
, tabType: TabCorpus TabMoreLikeFav
, totalRecords: 4737
, yearFilter
}
docViewLayoutRec { boxes
, cacheState
, corpusId
, frontends
, listId
, session
, tabType: TabMoreLikeTrash
, sidePanel
, yearFilter
} =
{ boxes
, cacheState
, chart : H.div {} []
, frontends
, listId
, mCorpusId: Just corpusId
, nodeId: corpusId
-- ^ TODO merge nodeId and corpusId in DT
, session
, showSearch: false
, sidePanel
, tabType: TabCorpus TabMoreLikeTrash
, totalRecords: 4737
, yearFilter
}
docViewLayoutRec { boxes
, cacheState
, corpusId
, frontends
, listId
, session
, tabType: TabTrash
, sidePanel
, yearFilter
} =
{ boxes
, cacheState
, chart : H.div {} []
, frontends
, listId
, mCorpusId: Just corpusId
, nodeId: corpusId
-- ^ TODO merge nodeId and corpusId in DT
, session
, showSearch: true
, sidePanel
, tabType: TabCorpus TabTrash
, totalRecords: 4737
, yearFilter
}
-- DUMMY
docViewLayoutRec { boxes
, cacheState
, corpusId
, frontends
, listId
, session
, sidePanel
, tabType
, yearFilter
} =
{ boxes
, cacheState
, chart : H.div {} []
, frontends
, listId
, mCorpusId: Just corpusId
, nodeId: corpusId
-- ^ TODO merge nodeId and corpusId in DT
, session
, showSearch: true
, sidePanel
, tabType: TabCorpus TabTrash
, totalRecords: 4737
, yearFilter
}
--------------------------------------------------------
type SidePanelProps = (
boxes :: Boxes
, session :: Session
, sidePanel :: T.Box (Maybe (Record TT.SidePanel))
)
sidePanel :: R2.Component SidePanelProps
sidePanel = R.createElement sidePanelCpt
sidePanelCpt :: R.Component SidePanelProps
sidePanelCpt = here.component "sidePanel" cpt
where
cpt { boxes: { sidePanelState }
, session
, sidePanel } _ = do
sidePanelState' <- T.useLive T.unequal sidePanelState
sidePanel' <- T.useLive T.unequal sidePanel
-- R.useEffect' $ do
-- let toggleSidePanel' _ = snd sidePanelState toggleSidePanelState
-- triggerSidePanel' _ = snd sidePanelState $ const Opened
-- R2.setTrigger toggleSidePanel toggleSidePanel'
-- R2.setTrigger triggerSidePanel triggerSidePanel'
-- (mCorpusId /\ setMCorpusId) <- R.useState' Nothing
-- (mListId /\ setMListId) <- R.useState' Nothing
-- (mNodeId /\ setMNodeId) <- R.useState' Nothing
-- R.useEffect3 mCorpusId mListId mNodeId $ do
-- if mCorpusId == Just corpusId && mListId == Just listId && mNodeId == Just nodeId && mCurrentDocId == Just nodeId then do
-- T.modify_ (\sp -> sp { mCurrentDocId = Nothing }) sidePanel
-- else do
-- T.modify_ (\sp -> sp { mCorpusId = Just corpusId
-- , mCurrentDocId = Just nodeId
-- , mListId = Just listId
-- , mNodeId = Just nodeId }) sidePanel
-- let trigger :: Record TriggerAnnotatedDocIdChangeParams -> Effect Unit
-- trigger { corpusId, listId, nodeId } = do
-- log2 "[sidePanel trigger] trigger corpusId change" corpusId
-- log2 "[sidePanel trigger] trigger listId change" listId
-- log2 "[sidePanel trigger] trigger nodeId change" nodeId
-- if mCorpusId == Just corpusId && mListId == Just listId && mNodeId == Just nodeId && mCurrentDocId == Just nodeId then do
-- R.setRef currentDocIdRef Nothing
-- T.modify_ (\sp -> sp { mCurrentDocId = Nothing }) sidePanel
-- R2.callTrigger toggleSidePanel unit
-- else do
-- setMCorpusId $ const $ Just corpusId
-- setMListId $ const $ Just listId
-- setMNodeId $ const $ Just nodeId
-- R.setRef currentDocIdRef $ Just nodeId
-- R2.callTrigger triggerSidePanel unit
-- T.modify_ (\sp -> sp { mCorpusId = Just corpusId
-- , mCurrentDocId = Just nodeId
-- , mListId = Just listId
-- , mNodeId = Just nodeId }) sidePanel
-- log2 "[sidePanel] trigger" trigger
-- R2.setTrigger triggerAnnotatedDocIdChange trigger
-- pure unit
-- pure $ do
-- -- log "[sidePanel] clearing triggerAnnotatedDocIdChange"
-- R2.clearTrigger triggerAnnotatedDocIdChange
let mainStyle = case sidePanelState' of
Opened -> { display: "block" }
_ -> { display: "none" }
let closeSidePanel _ = do
-- T.modify_ (\sp -> sp { mCurrentDocId = Nothing
-- , state = Closed }) sidePanel
T.write_ Closed sidePanelState
T.write_ Nothing sidePanel
pure $ H.div { style: mainStyle } [
H.div { className: "header" } [
H.span { className: "btn btn-danger"
, on: { click: closeSidePanel } } [
H.span { className: "fa fa-times" } []
]
]
, sidePanelDocView { mSidePanel: sidePanel', session } []
]
type SidePanelDocView = (
mSidePanel :: Maybe (Record TT.SidePanel)
, session :: Session
)
sidePanelDocView :: R2.Component SidePanelDocView
sidePanelDocView = R.createElement sidePanelDocViewCpt
sidePanelDocViewCpt :: R.Component SidePanelDocView
sidePanelDocViewCpt = here.component "sidePanelDocView" cpt
where
cpt { mSidePanel: Nothing } _ = do
pure $ H.div {} []
cpt { mSidePanel: Just { corpusId, listId, nodeId }
, session } _ = do
pure $ D.documentLayout { listId
, mCorpusId: Just corpusId
, nodeId
, session } []
Texts/ 0000775 0000000 0000000 00000000000 14111104351 0032641 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes SidePanelToggleButton.purs 0000664 0000000 0000000 00000002023 14111104351 0037753 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Texts module Gargantext.Components.Nodes.Texts.SidePanelToggleButton
( Props, sidePanelToggleButton
) where
import Data.Tuple.Nested ((/\))
import Prelude
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Components.Nodes.Texts.Types
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Texts.SidePanelToggleButton"
type Props = ( state :: T.Box SidePanelState )
sidePanelToggleButton :: R2.Component Props
sidePanelToggleButton = R.createElement sidePanelToggleButtonCpt
sidePanelToggleButtonCpt :: R.Component Props
sidePanelToggleButtonCpt = here.component "sidePanelToggleButton" cpt
where
cpt { state } _ = do
open' <- T.useLive T.unequal state
pure $
H.button { className: "btn btn-primary"
, on: { click: \_ -> T.modify_ toggleSidePanelState state } } [ H.text (text open') ]
text InitialClosed = "Show Side Panel"
text Opened = "Hide Side Panel"
text Closed = "Show Side Panel"
Types.purs 0000664 0000000 0000000 00000003360 14111104351 0034662 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes/Texts module Gargantext.Components.Nodes.Texts.Types where
import Data.Maybe (Maybe(..))
import Reactix as R
import Gargantext.Prelude
import Gargantext.Types (ListId, NodeID)
import Gargantext.Utils.Reactix as R2
data SidePanelState = InitialClosed | Opened | Closed
derive instance Eq SidePanelState
toggleSidePanelState :: SidePanelState -> SidePanelState
toggleSidePanelState InitialClosed = Opened
toggleSidePanelState Closed = Opened
toggleSidePanelState Opened = Closed
type TriggerAnnotatedDocIdChangeParams = (
corpusId :: NodeID
, listId :: ListId
, nodeId :: NodeID
)
type SidePanelTriggers = (
currentDocIdRef :: R.Ref (Maybe Int)
, toggleSidePanel :: R2.Trigger Unit -- toggles side panel
, triggerAnnotatedDocIdChange :: R2.Trigger (Record TriggerAnnotatedDocIdChangeParams)
, triggerSidePanel :: R2.Trigger Unit -- opens side panel
)
emptySidePanelTriggers :: R.Hooks (Record SidePanelTriggers)
emptySidePanelTriggers = do
currentDocIdRef <- R.useRef Nothing
toggleSidePanel <- R.useRef Nothing
triggerAnnotatedDocIdChange <- R.useRef Nothing
triggerSidePanel <- R.useRef Nothing
pure $ {
currentDocIdRef
, toggleSidePanel
, triggerAnnotatedDocIdChange
, triggerSidePanel
}
type TextsLayoutControls = (
triggers :: Record SidePanelTriggers
)
initialControls :: R.Hooks (Record TextsLayoutControls)
initialControls = do
triggers <- emptySidePanelTriggers
pure $ {
triggers
}
type SidePanel =
(
corpusId :: NodeID
, listId :: ListId
, mCurrentDocId :: Maybe Int
, nodeId :: NodeID
)
initialSidePanel :: Maybe (Record SidePanel)
initialSidePanel = Nothing
Types.purs 0000664 0000000 0000000 00000017527 14111104351 0033565 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Nodes module Gargantext.Components.Nodes.Types where
import Gargantext.Prelude
import Data.Eq.Generic (genericEq)
import Data.Generic.Rep (class Generic)
import Data.List as List
import Data.Maybe (Maybe, fromMaybe)
import Data.Newtype (class Newtype)
import Data.Show.Generic (genericShow)
import Foreign as F
import Simple.JSON as JSON
import Gargantext.Utils.JSON as GUJ
type Author = String
type Description = String
type HaskellCode = String
type Hash = String
type MarkdownText = String
type PythonCode = String
type Query = String
type Tag = String
type Title = String
-- We need FTFields with indices because it's the only way to identify the
-- FTField element inside a component (there are no UUIDs and such)
type Index = Int
type FTFieldWithIndex = { idx :: Index, ftField :: FTField }
newtype FTFieldsWithIndex = FTFieldsWithIndex (List.List FTFieldWithIndex)
derive instance Generic FTFieldsWithIndex _
derive instance Newtype FTFieldsWithIndex _
instance Eq FTFieldsWithIndex where eq = genericEq
instance JSON.ReadForeign FTFieldsWithIndex where readImpl f = FTFieldsWithIndex <$> GUJ.readList f
instance JSON.WriteForeign FTFieldsWithIndex where writeImpl (FTFieldsWithIndex lst) = GUJ.writeList lst
newtype Field a =
Field { name :: String
, typ :: a
}
type FTField = Field FieldType
type HaskellFT =
( haskell :: HaskellCode )
type JSONFT =
( authors :: Author
, desc :: Description
, query :: Query
, title :: Title )
type MarkdownFT =
( text :: MarkdownText )
type PythonFT =
( python :: PythonCode )
type FieldFieldTypeJSONRead =
{ name :: String
, type :: String
, data :: { tag :: Tag
-- HaskellFT
, haskell :: Maybe HaskellCode
-- JSONFT
, authors :: Maybe Author
, desc :: Maybe Description
, query :: Maybe Query
, title :: Maybe Title
-- MarkdownFT
, text :: Maybe MarkdownText
-- PythonFT
, python :: Maybe PythonCode
}
}
derive instance Generic (Field FieldType) _
derive instance Newtype (Field FieldType) _
instance JSON.ReadForeign (Field FieldType) where
readImpl f = do
r :: FieldFieldTypeJSONRead <- JSON.readImpl f
typ <- case r.type of
"Haskell" -> pure $ Haskell { haskell: fromMaybe "" r.data.haskell, tag: r.data.tag }
"JSON" -> pure $ JSON { authors: fromMaybe "" r.data.authors
, desc: fromMaybe "" r.data.desc
, query: fromMaybe "" r.data.query
, tag: r.data.tag
, title: fromMaybe "" r.data.title }
"Markdown" -> pure $ Markdown { tag: r.data.tag, text: fromMaybe "" r.data.text }
"Python" -> pure $ Python { python: fromMaybe "" r.data.python, tag: r.data.tag }
_ -> F.fail $ F.ErrorAtProperty "type" $ F.ForeignError "Unknown type"
pure $ Field { name: r.name, typ }
instance JSON.WriteForeign (Field FieldType) where
writeImpl (Field { name, typ }) = JSON.writeImpl $ { data: typ
, name
, type: typ' typ }
where
typ' (Haskell _) = "Haskell"
typ' (JSON _) = "JSON"
typ' (Markdown _) = "Markdown"
typ' (Python _) = "Python"
instance Eq (Field FieldType) where eq = genericEq
instance Show (Field FieldType) where show = genericShow
data FieldType =
Haskell { tag :: Tag | HaskellFT }
| JSON { tag :: Tag | JSONFT }
| Markdown { tag :: Tag | MarkdownFT }
| Python { tag :: Tag | PythonFT }
derive instance Generic FieldType _
instance JSON.WriteForeign FieldType where
writeImpl (Haskell { haskell }) = JSON.writeImpl { haskell, tag: "HaskellField" }
writeImpl (JSON { authors, desc, query, tag, title }) = JSON.writeImpl { authors, desc, query, tag: "JsonField", title }
writeImpl (Markdown { text }) = JSON.writeImpl { tag: "MarkdownField", text }
writeImpl (Python { python }) = JSON.writeImpl { python, tag: "PythonField" }
instance Eq FieldType where eq = genericEq
instance Show FieldType where show = genericShow
newtype FTFieldList = FTFieldList (List.List FTField)
derive instance Generic FTFieldList _
derive instance Newtype FTFieldList _
instance Eq FTFieldList where eq = genericEq
instance JSON.ReadForeign FTFieldList where readImpl f = FTFieldList <$> GUJ.readList f
instance JSON.WriteForeign FTFieldList where writeImpl (FTFieldList lst) = GUJ.writeList lst
isJSON :: FTField -> Boolean
isJSON (Field {typ}) = isJSON' typ
where
isJSON' (JSON _) = true
isJSON' _ = false
-- instance DecodeJson (Field FieldType) where
-- decodeJson json = do
-- obj <- decodeJson json
-- name <- obj .: "name"
-- type_ <- obj .: "type"
-- data_ <- obj .: "data"
-- typ <- case type_ of
-- "Haskell" -> do
-- haskell <- data_ .: "haskell"
-- tag <- data_ .: "tag"
-- pure $ Haskell {haskell, tag}
-- "Python" -> do
-- python <- data_ .: "python"
-- tag <- data_ .: "tag"
-- pure $ Python {python, tag}
-- "JSON" -> do
-- authors <- data_ .: "authors"
-- desc <- data_ .: "desc"
-- query <- data_ .: "query"
-- tag <- data_ .: "tag"
-- title <- data_ .: "title"
-- pure $ JSON {authors, desc, query, tag, title}
-- "Markdown" -> do
-- tag <- data_ .: "tag"
-- text <- data_ .: "text"
-- pure $ Markdown {tag, text}
-- _ -> Left $ TypeMismatch $ "Unsupported 'type' " <> type_
-- pure $ Field {name, typ}
-- instance EncodeJson (Field FieldType) where
-- encodeJson (Field {name, typ}) =
-- "data" := typ
-- ~> "name" := name
-- ~> "type" := typ' typ
-- ~> jsonEmptyObject
-- where
-- typ' (Haskell _) = "Haskell"
-- typ' (Python _) = "Python"
-- typ' (JSON _) = "JSON"
-- typ' (Markdown _) = "Markdown"
-- instance EncodeJson FieldType where
-- encodeJson (Haskell {haskell}) =
-- "haskell" := haskell
-- ~> "tag" := "HaskellField"
-- ~> jsonEmptyObject
-- encodeJson (Python {python}) =
-- "python" := python
-- ~> "tag" := "PythonField"
-- ~> jsonEmptyObject
-- encodeJson (JSON {authors, desc, query, tag, title}) =
-- "authors" := authors
-- ~> "desc" := desc
-- ~> "query" := query
-- ~> "tag" := "JsonField"
-- ~> "title" := title
-- ~> jsonEmptyObject
-- encodeJson (Markdown {text}) =
-- "tag" := "MarkdownField"
-- ~> "text" := text
-- ~> jsonEmptyObject
defaultPython :: FieldType
defaultPython = Python defaultPython'
defaultPython' :: { python :: String, tag :: String }
defaultPython' = { python: "import Foo"
, tag : "PythonField"
}
defaultHaskell :: FieldType
defaultHaskell = Haskell defaultHaskell'
defaultHaskell' :: { haskell :: String, tag :: String }
defaultHaskell' = { haskell: ""
, tag : "HaskellField"
}
defaultJSON :: FieldType
defaultJSON = JSON defaultJSON'
defaultJSON' :: { authors :: String
, desc :: String
, query :: String
, tag :: String
, title :: String
}
defaultJSON' = { authors: ""
, desc: ""
, query: ""
, tag: "JSONField"
, title: ""
}
defaultMarkdown :: FieldType
defaultMarkdown = Markdown defaultMarkdown'
defaultMarkdown' :: { tag :: String
, text :: String
}
defaultMarkdown' = { tag: "MarkdownField"
, text: "# New file"
}
defaultField :: FTField
defaultField = Field { name: "New file"
, typ: defaultMarkdown
}
RangeSlider.purs 0000664 0000000 0000000 00000022002 14111104351 0033570 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components -- | The RangeSlider is a slider component with two knobs, allowing
-- | the user to specify both a minimum and maximum value to filter
-- | data by. It may be dragged with the mouse or moved with the
-- | keyboard like a regular slider component. The RangeSlider is
-- | designed to let the user adjust in multiples of a provided
-- | epsilon (smallest difference)
module Gargantext.Components.RangeSlider where
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Int (fromNumber)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Nullable (Nullable, null)
import Data.Traversable (traverse_)
import DOM.Simple as DOM
import DOM.Simple.Document (document)
import DOM.Simple.Event as Event
import DOM.Simple.EventListener as EL
import DOM.Simple (DOMRect)
import Global (toFixed)
import Effect (Effect)
import Math as M
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Prelude
import Gargantext.Utils.Math (roundToMultiple)
import Gargantext.Utils.Range as Range
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.RangeSlider"
-- data Axis = X | Y
type Bounds = Range.NumberRange
type Epsilon = Number
-- To avoid overloading the terms 'min' and 'max' here, we treat 'min'
-- and 'max' as being the bounds of the scale and 'low' and 'high' as
-- being the selected values
type Props =
( bounds :: Bounds -- The minimum and maximum values it is possible to select
, initialValue :: Range.NumberRange -- The user's selection of minimum and maximum values
, epsilon :: Number -- The smallest possible change (for mouse)
, step :: Number -- The 'standard' change (for keyboard)
-- , axis :: Axis -- Which direction to move in
, width :: Number
, height :: Number
, onChange :: Range.NumberRange -> Effect Unit )
rangeSlider :: Record Props -> R.Element
rangeSlider props = R.createElement rangeSliderCpt props []
data Knob = MinKnob | MaxKnob
derive instance Generic Knob _
instance Eq Knob where
eq = genericEq
data RangeUpdate = SetMin Number | SetMax Number
rangeSliderCpt :: R.Component Props
rangeSliderCpt = here.component "rangeSlider" cpt
where
cpt props _ = do
-- rounding precision (i.e. how many decimal digits are in epsilon)
let precision = fromMaybe 0 $ fromNumber $ max 0.0 $ - M.floor $ (M.log props.epsilon) / M.ln10
-- scale bar
scaleElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- dom ref
-- scale sel bar
scaleSelElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- dom ref
-- low knob
lowElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- a dom ref to the low knob
-- high knob
highElem <- (R.useRef null) :: R.Hooks (R.Ref (Nullable DOM.Element)) -- a dom ref to the high knob
-- The value of the user's selection
value <- T.useBox $ initialValue props
value' <- T.useLive T.unequal value
-- the knob we are currently in a drag for. set by mousedown on a knob
dragKnob <- T.useBox (Nothing :: Maybe Knob)
dragKnob' <- T.useLive T.unequal dragKnob
-- the handler functions for trapping mouse events, so they can be removed
mouseMoveHandler <- (R.useRef $ Nothing) :: R.Hooks (R.Ref (Maybe (EL.Callback Event.MouseEvent)))
mouseUpHandler <- (R.useRef $ Nothing) :: R.Hooks (R.Ref (Maybe (EL.Callback Event.MouseEvent)))
let destroy = \_ -> do
destroyEventHandler "mousemove" mouseMoveHandler
destroyEventHandler "mouseup" mouseUpHandler
R.setRef mouseMoveHandler $ Nothing
R.setRef mouseUpHandler $ Nothing
R2.useLayoutEffect1' dragKnob' $ \_ -> do
let scalePos = R2.readPositionRef scaleElem
let lowPos = R2.readPositionRef lowElem
let highPos = R2.readPositionRef highElem
case dragKnob' of
Just knob -> do
let drag = (getDragScale knob scalePos lowPos highPos) :: Maybe Range.NumberRange
let onMouseMove = EL.callback $ \(event :: Event.MouseEvent) -> do
case reproject drag scalePos props.bounds props.epsilon (R2.domMousePosition event) of
Just val -> do
setKnob knob value value' val
props.onChange $ knobSetter knob value' val
Nothing -> destroy unit
let onMouseUp = EL.callback $ \(_event :: Event.MouseEvent) -> do
--props.onChange $ knobSetter knob value val
T.write_ Nothing dragKnob
destroy unit
EL.addEventListener document "mousemove" onMouseMove
EL.addEventListener document "mouseup" onMouseUp
R.setRef mouseMoveHandler $ Just onMouseMove
R.setRef mouseUpHandler $ Just onMouseUp
Nothing -> destroy unit
pure $ H.div { className, aria }
[ renderScale scaleElem props value'
, renderScaleSel scaleSelElem props value'
, renderKnob MinKnob lowElem value' props.bounds dragKnob precision
, renderKnob MaxKnob highElem value' props.bounds dragKnob precision
]
className = "range-slider"
aria = { label: "Range Slider Control. Expresses filtering data by a minimum and maximum value range through two slider knobs. Knobs can be adjusted with the arrow keys." }
destroyEventHandler
:: forall e
. Event.IsEvent e
=> String -> R.Ref (Maybe (EL.Callback e)) -> Effect Unit
destroyEventHandler name ref = traverse_ destroy $ R.readRef ref
where
destroy handler = do
EL.removeEventListener document name handler
R.setRef ref Nothing
setKnob :: Knob -> T.Box Range.NumberRange -> Range.NumberRange -> Number -> Effect Unit
setKnob knob value r val = T.write_ (knobSetter knob r val) value
knobSetter :: Knob -> Range.NumberRange -> Number -> Range.NumberRange
knobSetter MinKnob = Range.withMin
knobSetter MaxKnob = Range.withMax
getDragScale :: Knob -> Maybe DOMRect -> Maybe DOMRect -> Maybe DOMRect -> Maybe Range.NumberRange
getDragScale knob scalePos lowPos highPos = do
scale <- scalePos
low <- lowPos
high <- highPos
pure $ Range.Closed { min: min knob scale low, max: max knob scale high }
where
min MinKnob scale _ = scale.left
min MaxKnob _ low = low.left
max MinKnob _ high = high.left
max MaxKnob scale _ = scale.right
renderScale :: R.Ref (Nullable DOM.Element) -> Record Props -> Range.NumberRange -> R.Element
renderScale ref {width,height} (Range.Closed {min, max}) =
H.div { ref, className, width, height, aria } []
where
className = "scale"
aria = { label: "Scale running from " <> show min <> " to " <> show max }
renderScaleSel :: R.Ref (Nullable DOM.Element) -> Record Props -> Range.NumberRange -> R.Element
renderScaleSel ref props (Range.Closed {min, max}) =
H.div { ref, className, style} []
where
className = "scale-sel"
style = {left: computeLeft, width: computeWidth}
percOffsetMin = Range.normalise props.bounds min
percOffsetMax = Range.normalise props.bounds max
computeLeft = (show $ 100.0 * percOffsetMin) <> "%"
computeWidth = (show $ 100.0 * (percOffsetMax - percOffsetMin)) <> "%"
renderKnob :: Knob -> R.Ref (Nullable DOM.Element) -> Range.NumberRange -> Bounds -> T.Box (Maybe Knob) -> Int -> R.Element
renderKnob knob ref (Range.Closed value) bounds set precision =
H.div { ref, tabIndex, className, aria, on: { mouseDown: onMouseDown }, style } [
H.div { className: "button" }
[
H.text $ text $ toFixed precision val
]
]
where
text (Just num) = num
text Nothing = "error"
tabIndex = 0
className = "knob"
aria = { label: labelPrefix knob <> "value: " <> show val }
labelPrefix MinKnob = "Minimum "
labelPrefix MaxKnob = "Maximum "
onMouseDown _ = T.write_ (Just knob) set
percOffset = Range.normalise bounds val
style = { left: (show $ 100.0 * percOffset) <> "%" }
val = case knob of
MinKnob -> value.min
MaxKnob -> value.max
-- TODO round to nearest epsilon
reproject :: Maybe Range.NumberRange -> Maybe DOMRect -> Bounds -> Epsilon -> R2.Point -> Maybe Number
reproject drag scalePos bounds epsilon (R2.Point mousePos) = do
drag_ <- drag
scale_ <- rectRange <$> scalePos
let normal = Range.normalise scale_ (Range.clamp drag_ mousePos.x)
let val = Range.projectNormal bounds normal
pure $ round epsilon bounds val
rectRange :: DOMRect -> Range.NumberRange
rectRange rect = Range.Closed { min, max }
where min = rect.left
max = rect.right
initialValue :: Record Props -> Range.NumberRange
initialValue props = roundRange props.epsilon props.bounds props.initialValue
round :: Epsilon -> Bounds -> Number -> Number
round epsilon bounds = roundToMultiple epsilon <<< Range.clamp bounds
roundRange :: Epsilon -> Bounds -> Range.NumberRange -> Range.NumberRange
roundRange epsilon bounds (Range.Closed initial) = Range.Closed { min, max }
where min = round epsilon bounds initial.min
max = round epsilon bounds initial.max
Renameable.purs 0000664 0000000 0000000 00000006353 14111104351 0033437 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components module Gargantext.Components.Renameable where
import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Renameable"
type RenameableProps =
(
onRename :: String -> Effect Unit
, text :: String
)
renameable :: R2.Component RenameableProps
renameable = R.createElement renameableCpt
renameableCpt :: R.Component RenameableProps
renameableCpt = here.component "renameableCpt" cpt
where
cpt { onRename, text } _ = do
isEditing <- T.useBox false
state <- T.useBox text
textRef <- R.useRef text
-- handle props change of text
R.useEffect1' text $ do
if R.readRef textRef == text then
pure unit
else do
R.setRef textRef text
T.write_ text state
pure $ H.div { className: "renameable" } [
renameableText { isEditing, onRename, state } []
]
type RenameableTextProps =
(
isEditing :: T.Box Boolean
, onRename :: String -> Effect Unit
, state :: T.Box String
)
renameableText :: R2.Component RenameableTextProps
renameableText = R.createElement renameableTextCpt
renameableTextCpt :: R.Component RenameableTextProps
renameableTextCpt = here.component "renameableText" cpt
where
cpt props@{ isEditing, state } _ = do
isEditing' <- T.useLive T.unequal isEditing
pure $ if isEditing' then
notEditing props []
else
editing props []
notEditing :: R2.Component RenameableTextProps
notEditing = R.createElement notEditingCpt
notEditingCpt :: R.Component RenameableTextProps
notEditingCpt = here.component "notEditing" cpt
where
cpt props@{ isEditing, state } _ = do
state' <- T.useLive T.unequal state
pure $ H.div { className: "input-group" }
[ H.input { className: "form-control"
, defaultValue: state'
, disabled: 1
, type: "text" }
, H.div { className: "btn input-group-append"
, on: { click: \_ -> T.write_ true isEditing } }
[ H.span { className: "fa fa-pencil" } []
]
]
editing :: R2.Component RenameableTextProps
editing = R.createElement editingCpt
editingCpt :: R.Component RenameableTextProps
editingCpt = here.component "editing" cpt
where
cpt props@{ isEditing, onRename, state } _ = do
state' <- T.useLive T.unequal state
pure $ H.div { className: "input-group" }
[ inputWithEnter {
autoFocus: false
, className: "form-control text"
, defaultValue: state'
, onBlur: \s -> T.write_ s state
, onEnter: submit state'
, onValueChanged: \s -> T.write_ s state
, placeholder: ""
, type: "text"
}
, H.div { className: "btn input-group-append"
, on: { click: submit } }
[ H.span { className: "fa fa-floppy-o" } []
]
]
where
submit text _ = do
T.write_ false isEditing
onRename text
Router.purs 0000664 0000000 0000000 00000043056 14111104351 0032665 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components module Gargantext.Components.Router (router) where
import Gargantext.Prelude
import Data.Array as A
import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.ErrorsView (errorsView)
import Gargantext.Components.Footer (footer)
import Gargantext.Components.Forest as Forest
import Gargantext.Components.GraphExplorer as GraphExplorer
import Gargantext.Components.GraphExplorer.Sidebar as GES
import Gargantext.Components.GraphExplorer.Sidebar.Types as GEST
import Gargantext.Components.GraphExplorer.TopBar as GETB
import Gargantext.Components.Lang (LandingLang(LL_EN))
import Gargantext.Components.Login (login)
import Gargantext.Components.MainPage as MainPage
import Gargantext.Components.Nodes.Annuaire (annuaireLayout)
import Gargantext.Components.Nodes.Annuaire.User (userLayout)
import Gargantext.Components.Nodes.Annuaire.User.Contact (contactLayout)
import Gargantext.Components.Nodes.Corpus (corpusLayout)
import Gargantext.Components.Nodes.Corpus.Dashboard (dashboardLayout)
import Gargantext.Components.Nodes.Corpus.Document (documentMainLayout)
import Gargantext.Components.Nodes.Corpus.Phylo (phyloLayout)
import Gargantext.Components.Nodes.File (fileLayout)
import Gargantext.Components.Nodes.Frame (frameLayout)
import Gargantext.Components.Nodes.Home (homeLayout)
import Gargantext.Components.Nodes.Lists as Lists
import Gargantext.Components.Nodes.Texts as Texts
import Gargantext.Components.TopBar as TopBar
import Gargantext.Config (defaultFrontends, defaultBackends)
import Gargantext.Ends (Backend)
import Gargantext.Routes (AppRoute)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, WithSession)
import Gargantext.Sessions as Sessions
import Gargantext.Types (CorpusId, Handed(..), ListId, NodeID, NodeType(..), SessionId, SidePanelState(..), reverseHanded)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RE
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.Router"
type Props = ( boxes :: Boxes )
type SessionProps = ( sessionId :: SessionId | Props )
type SessionNodeProps = ( nodeId :: NodeID | SessionProps )
type Props' = ( backend :: Backend, route' :: AppRoute | Props )
router :: R2.Leaf Props
router props = R.createElement routerCpt props []
routerCpt :: R.Component Props
routerCpt = here.component "router" cpt where
cpt { boxes: boxes@{ handed } } _ = do
handed' <- T.useLive T.unequal handed
let handedClassName = case handed' of
LeftHanded -> "left-handed"
RightHanded -> "right-handed"
pure $ R.fragment
([ loginModal { boxes }
, topBar { boxes }
, errorsView { errors: boxes.errors } []
, H.div { className: handedClassName <> " router-inner" } $ reverseHanded handed' $
[ forest { boxes }
, mainPage { boxes }
, sidePanel { boxes }
]
])
loginModal :: R2.Leaf Props
loginModal p = R.createElement loginModalCpt p []
loginModalCpt :: R.Component Props
loginModalCpt = here.component "loginModal" cpt
where
cpt { boxes: boxes@{ showLogin } } _ = do
showLogin' <- T.useLive T.unequal showLogin
pure $ if showLogin' then login' boxes else H.div {} []
topBar :: R2.Leaf Props
topBar p = R.createElement topBarCpt p []
topBarCpt :: R.Component Props
topBarCpt = here.component "topBar" cpt where
cpt { boxes: boxes@{ route } } _ = do
route' <- T.useLive T.unequal route
let children = case route' of
GR.PGraphExplorer _s _g -> [ GETB.topBar { boxes } ]
_ -> []
pure $ TopBar.topBar { boxes } children
mainPage :: R2.Leaf Props
mainPage p = R.createElement mainPageCpt p []
mainPageCpt :: R.Component Props
mainPageCpt = here.component "mainPage" cpt where
cpt { boxes } _ = do
pure $ MainPage.mainPage { boxes } [ renderRoute { boxes } ]
forest :: R2.Leaf Props
forest p = R.createElement forestCpt p []
forestCpt :: R.Component Props
forestCpt = here.component "forest" cpt where
cpt { boxes: boxes@{ showTree } } _ = do
showTree' <- T.useLive T.unequal showTree
pure $
if not showTree'
then mempty
else Forest.forestLayout
{ boxes
, frontends: defaultFrontends } []
sidePanel :: R2.Leaf Props
sidePanel p = R.createElement sidePanelCpt p []
sidePanelCpt :: R.Component Props
sidePanelCpt = here.component "sidePanel" cpt where
cpt props@{ boxes: { session
, sidePanelState } } _ = do
session' <- T.useLive T.unequal session
sidePanelState' <- T.useLive T.unequal sidePanelState
case session' of
Nothing -> pure $ H.div {} []
Just s ->
case sidePanelState' of
Opened -> pure $ openedSidePanel (Record.merge { session: s } props) []
_ -> pure $ H.div {} []
renderRoute :: R2.Leaf Props
renderRoute p = R.createElement renderRouteCpt p []
renderRouteCpt :: R.Component Props
renderRouteCpt = here.component "renderRoute" cpt where
cpt props@{ boxes } _ = do
let sessionNodeProps sId nId = Record.merge { nodeId: nId, sessionId: sId } props
route' <- T.useLive T.unequal boxes.route
pure $ R.fragment
[ case route' of
GR.Annuaire s n -> annuaire (sessionNodeProps s n) []
GR.ContactPage s a n -> contact (Record.merge { annuaireId: a } $ sessionNodeProps s n) []
GR.Corpus s n -> corpus (sessionNodeProps s n) []
GR.CorpusDocument s c l n -> corpusDocument (Record.merge { corpusId: c, listId: l } $ sessionNodeProps s n) []
GR.Dashboard s n -> dashboard (sessionNodeProps s n) []
GR.Document s l n -> document (Record.merge { listId: l } $ sessionNodeProps s n) []
GR.Folder s n -> corpus (sessionNodeProps s n) []
GR.FolderPrivate s n -> corpus (sessionNodeProps s n) []
GR.FolderPublic s n -> corpus (sessionNodeProps s n) []
GR.FolderShared s n -> corpus (sessionNodeProps s n) []
GR.Home -> home { boxes } []
GR.Lists s n -> lists (sessionNodeProps s n) []
GR.Login -> login' boxes
GR.PGraphExplorer s g -> graphExplorer (sessionNodeProps s g) []
GR.PhyloExplorer s g -> phyloExplorer (sessionNodeProps s g) []
GR.RouteFile s n -> routeFile (sessionNodeProps s n) []
GR.RouteFrameWrite s n -> routeFrame (Record.merge { nodeType: NodeFrameWrite } $ sessionNodeProps s n) []
GR.RouteFrameCalc s n -> routeFrame (Record.merge { nodeType: NodeFrameCalc } $ sessionNodeProps s n) []
GR.RouteFrameCode s n -> routeFrame (Record.merge { nodeType: NodeFrameNotebook } $ sessionNodeProps s n) []
GR.RouteFrameVisio s n -> routeFrame (Record.merge { nodeType: NodeFrameVisio } $ sessionNodeProps s n) []
GR.Team s n -> team (sessionNodeProps s n) []
GR.Texts s n -> texts (sessionNodeProps s n) []
GR.UserPage s n -> user (sessionNodeProps s n) []
]
type AuthedProps =
( content :: Session -> R.Element
| SessionProps )
authed :: R2.Component AuthedProps
authed = R.createElement authedCpt
authedCpt :: R.Component AuthedProps
authedCpt = here.component "authed" cpt where
cpt props@{ boxes: { session, sessions }
, content
, sessionId } _ = do
sessions' <- T.useLive T.unequal sessions
let session' = Sessions.lookup sessionId sessions'
R.useEffect' $ do
T.write_ session' session
case session' of
Nothing -> pure $ home homeProps []
Just s -> pure $ R.fragment [ content s, footer {} [] ]
where
homeProps = RE.pick props :: Record Props
openedSidePanel :: R2.Component (WithSession Props)
openedSidePanel = R.createElement openedSidePanelCpt
openedSidePanelCpt :: R.Component (WithSession Props)
openedSidePanelCpt = here.component "openedSidePanel" cpt where
cpt { boxes: boxes@{ route
, sidePanelGraph
, sidePanelState
, sidePanelTexts }
, session } _ = do
{ mGraph, mMetaData } <- GEST.focusedSidePanel sidePanelGraph
mGraph' <- T.useLive T.unequal mGraph
mGraphMetaData' <- T.useLive T.unequal mMetaData
route' <- T.useLive T.unequal route
let wrapper = H.div { className: "side-panel" }
case route' of
GR.Lists _s _n -> do
pure $ wrapper
[ Lists.sidePanel { session
, sidePanelState } [] ]
GR.PGraphExplorer _s g -> do
case (mGraph' /\ mGraphMetaData') of
(Nothing /\ _) -> pure $ wrapper []
(_ /\ Nothing) -> pure $ wrapper []
(Just graph /\ Just metaData) -> do
pure $ wrapper
[ GES.sidebar { boxes
, frontends: defaultFrontends
, graph
, graphId: g
, metaData
, session
} [] ]
GR.Texts _s _n -> do
pure $ wrapper
[ Texts.sidePanel { boxes
, session
, sidePanel: sidePanelTexts } [] ]
_ -> pure $ wrapper []
annuaire :: R2.Component SessionNodeProps
annuaire = R.createElement annuaireCpt
annuaireCpt :: R.Component SessionNodeProps
annuaireCpt = here.component "annuaire" cpt where
cpt props@{ nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
annuaireLayout { frontends: defaultFrontends
, nodeId
, session } } sessionProps) []
corpus :: R2.Component SessionNodeProps
corpus = R.createElement corpusCpt
corpusCpt :: R.Component SessionNodeProps
corpusCpt = here.component "corpus" cpt where
cpt props@{ boxes, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
corpusLayout { boxes
, nodeId
, session } } sessionProps) []
type CorpusDocumentProps =
( corpusId :: CorpusId
, listId :: ListId
| SessionNodeProps
)
corpusDocument :: R2.Component CorpusDocumentProps
corpusDocument = R.createElement corpusDocumentCpt
corpusDocumentCpt :: R.Component CorpusDocumentProps
corpusDocumentCpt = here.component "corpusDocument" cpt
where
cpt props@{ corpusId: corpusId', listId, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
documentMainLayout { mCorpusId: Just corpusId'
, listId: listId
, nodeId
, session } [] } sessionProps )[]
dashboard :: R2.Component SessionNodeProps
dashboard = R.createElement dashboardCpt
dashboardCpt :: R.Component SessionNodeProps
dashboardCpt = here.component "dashboard" cpt
where
cpt props@{ boxes, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
dashboardLayout { boxes, nodeId, session } [] } sessionProps) []
type DocumentProps = ( listId :: ListId | SessionNodeProps )
document :: R2.Component DocumentProps
document = R.createElement documentCpt
documentCpt :: R.Component DocumentProps
documentCpt = here.component "document" cpt where
cpt props@{ listId, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
documentMainLayout { listId
, nodeId
, mCorpusId: Nothing
, session } [] } sessionProps) []
graphExplorer :: R2.Component SessionNodeProps
graphExplorer = R.createElement graphExplorerCpt
graphExplorerCpt :: R.Component SessionNodeProps
graphExplorerCpt = here.component "graphExplorer" cpt where
cpt props@{ boxes
, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
GraphExplorer.explorerLayout { boxes
, graphId: nodeId
, session } [] } sessionProps) []
phyloExplorer :: R2.Component SessionNodeProps
phyloExplorer = R.createElement phyloExplorerCpt
phyloExplorerCpt :: R.Component SessionNodeProps
phyloExplorerCpt = here.component "phylo" cpt
where
cpt props@{ nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
phyloLayout { nodeId, session } [] } sessionProps) []
home :: R2.Component Props
home = R.createElement homeCpt
homeCpt :: R.Component Props
homeCpt = here.component "home" cpt where
cpt { boxes } _ = do
pure $ homeLayout { boxes, lang: LL_EN }
lists :: R2.Component SessionNodeProps
lists = R.createElement listsCpt
listsCpt :: R.Component SessionNodeProps
listsCpt = here.component "lists" cpt where
cpt props@{ boxes
, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
Lists.listsLayout { boxes
, nodeId
, session
, sessionUpdate: \_ -> pure unit } [] } sessionProps) []
login' :: Boxes -> R.Element
login' { backend, sessions, showLogin: visible } =
login { backend
, backends: A.fromFoldable defaultBackends
, sessions
, visible }
routeFile :: R2.Component SessionNodeProps
routeFile = R.createElement routeFileCpt
routeFileCpt :: R.Component SessionNodeProps
routeFileCpt = here.component "routeFile" cpt where
cpt props@{ nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
fileLayout { nodeId, session } } sessionProps) []
type RouteFrameProps = (
nodeType :: NodeType
| SessionNodeProps
)
routeFrame :: R2.Component RouteFrameProps
routeFrame = R.createElement routeFrameCpt
routeFrameCpt :: R.Component RouteFrameProps
routeFrameCpt = here.component "routeFrame" cpt where
cpt props@{ nodeId, nodeType } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
frameLayout { nodeId, nodeType, session } } sessionProps) []
team :: R2.Component SessionNodeProps
team = R.createElement teamCpt
teamCpt :: R.Component SessionNodeProps
teamCpt = here.component "team" cpt where
cpt props@{ boxes, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
corpusLayout { boxes
, nodeId
, session } } sessionProps) []
texts :: R2.Component SessionNodeProps
texts = R.createElement textsCpt
textsCpt :: R.Component SessionNodeProps
textsCpt = here.component "texts" cpt
where
cpt props@{ boxes
, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
Texts.textsLayout { boxes
, frontends: defaultFrontends
, nodeId
, session } [] } sessionProps) []
user :: R2.Component SessionNodeProps
user = R.createElement userCpt
userCpt :: R.Component SessionNodeProps
userCpt = here.component "user" cpt where
cpt props@{ boxes
, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
pure $ authed (Record.merge { content: \session ->
userLayout { boxes
, frontends: defaultFrontends
, nodeId
, session } [] } sessionProps) []
type ContactProps = ( annuaireId :: NodeID | SessionNodeProps )
contact :: R2.Component ContactProps
contact = R.createElement contactCpt
contactCpt :: R.Component ContactProps
contactCpt = here.component "contact" cpt where
cpt props@{ annuaireId
, boxes
, nodeId } _ = do
let sessionProps = RE.pick props :: Record SessionProps
-- let forestedProps = RE.pick props :: Record Props
pure $ authed (Record.merge { content: \session ->
contactLayout { annuaireId
, boxes
, frontends: defaultFrontends
, nodeId
, session } [] } sessionProps) []
Search.purs 0000664 0000000 0000000 00000017777 14111104351 0032625 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components module Gargantext.Components.Search where
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Show.Generic (genericShow)
import Data.Maybe (Maybe)
import Data.Newtype (class Newtype)
import Simple.JSON as JSON
import Simple.JSON.Generics as JSONG
import Gargantext.Prelude
-- 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 Generic SearchType _
instance Eq SearchType where eq = genericEq
instance Show SearchType where show = genericShow
instance JSON.ReadForeign SearchType where readImpl = JSONG.enumSumRep
instance JSON.WriteForeign SearchType where writeImpl = JSON.writeImpl <<< show
------------------------------------------------------------------------
newtype SearchQuery = SearchQuery { query :: Array String, expected :: SearchType }
derive instance Generic SearchQuery _
derive instance Newtype SearchQuery _
instance Eq SearchQuery where eq = genericEq
instance Show SearchQuery where show = genericShow
derive newtype instance JSON.ReadForeign SearchQuery
derive newtype instance JSON.WriteForeign SearchQuery
------------------------------------------------------------------------
------------------------------------------------------------------------
newtype SearchResult = SearchResult { result :: SearchResultTypes }
derive instance Generic SearchResult _
derive instance Newtype SearchResult _
instance Eq SearchResult where eq = genericEq
instance Show SearchResult where show = genericShow
derive newtype instance JSON.ReadForeign SearchResult
derive newtype instance JSON.WriteForeign SearchResult
------------------------------------------------------------------------
data SearchResultTypes = SearchResultDoc { docs :: Array Document}
| SearchNoResult { message :: String }
| SearchResultContact { contacts :: Array Contact }
derive instance Generic SearchResultTypes _
instance Eq SearchResultTypes where eq = genericEq
instance Show SearchResultTypes where show = genericShow
instance JSON.ReadForeign SearchResultTypes where readImpl = JSONG.untaggedSumRep
instance JSON.WriteForeign SearchResultTypes where
writeImpl (SearchResultDoc s) = JSON.writeImpl s
writeImpl (SearchNoResult s) = JSON.writeImpl s
writeImpl (SearchResultContact s) = JSON.writeImpl s
------------------------------------------------------------------------
newtype Document =
Document { id :: Int
, created :: String
, title :: String
, hyperdata :: HyperdataRowDocument
, category :: Int
, score :: Int
}
derive instance Generic Document _
derive instance Newtype Document _
instance Eq Document where eq = genericEq
instance Show Document where show = genericShow
derive newtype instance JSON.ReadForeign Document
derive newtype instance JSON.WriteForeign Document
------------------------------------------------------------------------
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 Generic HyperdataRowDocument _
instance Eq HyperdataRowDocument where eq = genericEq
instance Show HyperdataRowDocument where show = genericShow
derive newtype instance JSON.ReadForeign HyperdataRowDocument
derive newtype instance JSON.WriteForeign HyperdataRowDocument
------------------------------------------------------------------------
------------------------------------------------------------------------
------------------------------------------------------------------------
newtype Contact =
Contact { c_id :: Int
, c_created :: String
, c_hyperdata :: HyperdataRowContact
, c_score :: Int
, c_annuaireId :: Int
}
derive instance Generic Contact _
instance Eq Contact where eq = genericEq
instance Show Contact where show = genericShow
derive newtype instance JSON.ReadForeign Contact
derive newtype instance JSON.WriteForeign Contact
newtype HyperdataRowContact =
HyperdataRowContact { firstname :: String
, lastname :: String
, labs :: String
}
derive instance Generic HyperdataRowContact _
instance Eq HyperdataRowContact where eq = genericEq
instance Show HyperdataRowContact where show = genericShow
derive newtype instance JSON.ReadForeign HyperdataRowContact
derive newtype instance JSON.WriteForeign HyperdataRowContact
newtype 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 Generic HyperdataContact _
instance Eq HyperdataContact where eq = genericEq
instance Show HyperdataContact where show = genericShow
derive newtype instance JSON.ReadForeign HyperdataContact
derive newtype instance JSON.WriteForeign HyperdataContact
-------
newtype ContactWho =
ContactWho { id :: Maybe String
, firstName :: Maybe String
, lastName :: Maybe String
, keywords :: Array String
, freetags :: Array String
}
derive instance Generic ContactWho _
instance Eq ContactWho where eq = genericEq
instance Show ContactWho where show = genericShow
derive newtype instance JSON.ReadForeign ContactWho
derive newtype instance JSON.WriteForeign ContactWho
newtype 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 Generic ContactWhere _
instance Eq ContactWhere where eq = genericEq
instance Show ContactWhere where show = genericShow
derive newtype instance JSON.ReadForeign ContactWhere
derive newtype instance JSON.WriteForeign ContactWhere
newtype ContactTouch =
ContactTouch { mail :: Maybe String
, phone :: Maybe String
, url :: Maybe String
}
derive instance Generic ContactTouch _
instance Eq ContactTouch where eq = genericEq
instance Show ContactTouch where show = genericShow
derive newtype instance JSON.ReadForeign ContactTouch
derive newtype instance JSON.WriteForeign ContactTouch
SessionLoader.purs 0000664 0000000 0000000 00000002235 14111104351 0034151 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components -- | A component that loads the session specified in the route and provides it to its child.
-- |
-- | If the session cannot be loaded, displays the homepage.
module Gargantext.Components.SessionLoader
where
import Data.Maybe (Maybe(..))
import Reactix as R
import Toestand as T
import Gargantext.Prelude
import Gargantext.Sessions as Sessions
import Gargantext.Sessions (Session, Sessions)
import Gargantext.Types (SessionId)
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.SessionWrapper"
type Props =
(
context :: R.Context Session
, fallback :: R.Element
, sessionId :: SessionId
, sessions :: T.Box Sessions
)
sessionWrapper :: R2.Component Props
sessionWrapper = R.createElement sessionWrapperCpt
sessionWrapperCpt :: R.Component Props
sessionWrapperCpt = here.component "sessionWrapper" cpt where
cpt { fallback, context, sessionId, sessions } content = do
sessions' <- T.useLive T.unequal sessions
pure $ cp sessions'
where
cp sessions' = c $ Sessions.lookup sessionId sessions' where
c (Just session) = (R.provideContext context session content)
c Nothing = fallback
Tab.purs 0000664 0000000 0000000 00000003577 14111104351 0032117 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components module Gargantext.Components.Tab where
import Data.FunctorWithIndex (mapWithIndex)
import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\))
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Tab"
type TabsProps = (
activeTab :: T.Box Int
, tabs :: Array (Tuple String R.Element)
)
tabs :: R2.Leaf TabsProps
tabs props = R.createElement tabsCpt props []
-- this is actually just the list of tabs, not the tab contents itself
tabsCpt :: R.Component TabsProps
tabsCpt = here.component "tabs" cpt where
cpt { activeTab
, tabs: tabs' } _ = do
activeTab' <- T.useLive T.unequal activeTab
pure $ H.div {}
[ H.nav {}
[ H.br {}
, H.div { className: "nav nav-tabs", title: "Search result" }
(mapWithIndex (button activeTab activeTab') tabs')
]
, H.div { className: "tab-content" }
(mapWithIndex (item activeTab') tabs')
]
button activeTab selected index (name /\ _) =
H.a { className, on: { click } } [ H.text name ] where
eq = index == selected
className = "nav-item nav-link" <> (if eq then " active" else "")
click _ = T.write_ index activeTab
item selected index (_ /\ cpt') = tab { selected, index } [ cpt' ]
-- TODO: document what these are (selection, item indices)
type TabProps = ( selected :: Int, index :: Int )
tab :: R2.Component TabProps
tab = R.createElement tabCpt
-- | A tab only shows its contents if it is currently selected
tabCpt :: R.Component TabProps
tabCpt = here.component "tab" cpt
where
cpt { selected, index } children = pure $ H.div { className } children'
where
same = selected == index
className = "tab-pane" <> (if same then "show active" else "fade")
children' = if same then children else []
Table.purs 0000664 0000000 0000000 00000024455 14111104351 0032436 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components module Gargantext.Components.Table where
import Data.Array as A
import Data.Maybe (Maybe(..))
import Data.Sequence as Seq
import Effect (Effect)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.FolderView as FV
import Gargantext.Components.Table.Types (ColumnName, OrderBy, OrderByDirection(..), Params, Props, TableContainerProps, columnName)
import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Search (SearchType(..))
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reactix (effectLink)
here :: R2.Here
here = R2.here "Gargantext.Components.Table"
type Page = Int
type State =
{ page :: Page
, pageSize :: PageSizes
, orderBy :: OrderBy
, searchType :: SearchType
}
paramsState :: Params -> State
paramsState {offset, limit, orderBy, searchType} = {pageSize, page, orderBy, searchType}
where
pageSize = int2PageSizes limit
page = offset / limit + 1
stateParams :: State -> Params
stateParams {pageSize, page, orderBy, searchType} = {offset, limit, orderBy, searchType}
where
limit = pageSizes2Int pageSize
offset = limit * (page - 1)
type TableHeaderLayoutProps = (
cacheState :: T.Box NT.CacheState
, date :: String
, desc :: String
, key :: String
, query :: String
, title :: String
, user :: String
)
initialParams :: Params
initialParams = stateParams {page: 1, pageSize: PS10, orderBy: Nothing, searchType: SearchDoc}
-- TODO: Not sure this is the right place for this
tableHeaderLayout :: R2.Component TableHeaderLayoutProps
tableHeaderLayout = R.createElement tableHeaderLayoutCpt
tableHeaderLayoutCpt :: R.Component TableHeaderLayoutProps
tableHeaderLayoutCpt = here.component "tableHeaderLayout" cpt
where
cpt { cacheState, date, desc, query, title, user } _ = do
cacheState' <- T.useLive T.unequal cacheState
pure $ R.fragment
[ R2.row [FV.backButton, FV.homeButton]
,
R2.row
[ H.div {className: "col-md-3"} [ H.h3 {} [H.text title] ]
, H.div {className: "col-md-9"}
[ H.hr {style: {height: "2px", backgroundColor: "black"}} ]
]
, R2.row
[ H.div {className: "col-md-8 content"}
[ H.p {}
[ H.span {className: "fa fa-globe"} []
, H.text $ " " <> desc
]
, H.p {}
[ H.span {className: "fa fa-search-plus"} []
, H.text $ " " <> query
]
, H.p { className: "cache-toggle"
, on: { click: cacheClick cacheState } }
[ H.span { className: "fa " <> (cacheToggle cacheState') } []
, H.text $ cacheText cacheState'
]
]
, H.div {className: "col-md-4 content"}
[ H.p {}
[ H.span {className: "fa fa-calendar"} []
, H.text $ " " <> date
]
, H.p {}
[ H.span {className: "fa fa-user"} []
, H.text $ " " <> user
]
]
]
]
cacheToggle NT.CacheOn = "fa-toggle-on"
cacheToggle NT.CacheOff = "fa-toggle-off"
cacheText NT.CacheOn = "Cache On"
cacheText NT.CacheOff = "Cache Off"
cacheClick cacheState _ = do
T.modify cacheStateToggle cacheState
cacheStateToggle NT.CacheOn = NT.CacheOff
cacheStateToggle NT.CacheOff = NT.CacheOn
table :: R2.Leaf Props
table props = R.createElement tableCpt props []
tableCpt :: R.Component Props
tableCpt = here.component "table" cpt
where
cpt { colNames
, container
, params
, rows
, syncResetButton
, totalRecords
, wrapColElts } _ = do
params' <- T.useLive T.unequal params
let
state = paramsState params'
ps = pageSizes2Int state.pageSize
totalPages = (totalRecords / ps) + min 1 (totalRecords `mod` ps)
colHeader :: ColumnName -> R.Element
colHeader c = H.th {scope: "col"} [ H.b {} cs ]
where
lnk mc = effectLink $ void $ T.modify (_ { orderBy = mc }) params
cs :: Array R.Element
cs =
wrapColElts c $
case state.orderBy of
Just (ASC d) | c == d -> [lnk (Just (DESC c)) "ASC " , lnk Nothing (columnName c)]
Just (DESC d) | c == d -> [lnk (Just (ASC c)) "DESC ", lnk Nothing (columnName c)]
_ -> [lnk (Just (ASC c)) (columnName c)]
pure $ container
{ pageSizeControl: sizeDD { params }
, pageSizeDescription: textDescription state.page state.pageSize totalRecords
, paginationLinks: pagination { params, totalPages }
, syncResetButton
, tableBody: map _.row $ A.fromFoldable rows
, tableHead: H.tr {} (colHeader <$> colNames)
}
makeRow :: Array R.Element -> R.Element
makeRow els = H.tr {} $ (\c -> H.td {} [c]) <$> els
type FilterRowsParams =
(
params :: Params
)
filterRows :: forall a. Record FilterRowsParams -> Seq.Seq a -> Seq.Seq a
filterRows { params: { limit, offset, orderBy } } rs = newRs
where
newRs = Seq.take limit $ Seq.drop offset $ rs
defaultContainer :: Record TableContainerProps -> R.Element
defaultContainer props = R.fragment $ props.syncResetButton <> controls
where
controls = [ R2.row
[ H.div {className: "col-md-4"} [ props.pageSizeDescription ]
, H.div {className: "col-md-4"} [ props.paginationLinks ]
, H.div {className: "col-md-4"} [ props.pageSizeControl ]
]
, R2.row [
H.table {className: "col-md-12 table"}
[ H.thead {className: ""} [ props.tableHead ]
, H.tbody {} props.tableBody
]
]
]
-- TODO: this needs to be in Gargantext.Pages.Corpus.Graph.Tabs
graphContainer :: Record TableContainerProps -> R.Element
graphContainer props =
-- TODO title in tabs name (above)
H.table {className: "table"}
[ H.thead {className: ""} [ props.tableHead ]
, H.tbody {} props.tableBody
]
-- TODO better rendering of the paginationLinks
-- , props.pageSizeControl
-- , props.pageSizeDescription
-- , props.paginationLinks
type SizeDDProps =
(
params :: T.Box Params
)
sizeDD :: Record SizeDDProps -> R.Element
sizeDD p = R.createElement sizeDDCpt p []
sizeDDCpt :: R.Component SizeDDProps
sizeDDCpt = here.component "sizeDD" cpt
where
cpt { params } _ = do
params' <- T.useLive T.unequal params
let { pageSize } = paramsState params'
pure $ H.span {} [
R2.select { className, defaultValue: show pageSize, on: {change} } sizes
]
where
className = "form-control"
change e = do
let ps = string2PageSize $ R.unsafeEventValue e
T.modify (\p -> stateParams $ (paramsState p) { pageSize = ps }) params
sizes = map option pageSizes
option size = H.option {value} [H.text value]
where value = show size
textDescription :: Int -> PageSizes -> Int -> R.Element
textDescription currPage pageSize totalRecords =
H.div {className: "row1"} [ H.div {className: ""} [ H.text msg ] ] -- TODO or col-md-6 ?
where
start = (currPage - 1) * pageSizes2Int pageSize + 1
end' = currPage * pageSizes2Int pageSize
end = if end' > totalRecords then totalRecords else end'
msg = "Showing " <> show start <> " to " <> show end <> " of " <> show totalRecords
changePage :: Page -> T.Box Params -> Effect Unit
changePage page params =
void $ T.modify (\p -> stateParams $ (paramsState p) { page = page }) params
type PaginationProps =
( params :: T.Box Params
, totalPages :: Int )
pagination :: R2.Leaf PaginationProps
pagination props = R.createElement paginationCpt props []
paginationCpt :: R.Component PaginationProps
paginationCpt = here.component "pagination" cpt
where
cpt { params, totalPages } _ = do
params' <- T.useLive T.unequal params
let { page } = paramsState params'
prev = if page == 1 then
H.text " Prev. "
else
changePageLink (page - 1) "Prev."
next = if page == totalPages then
H.text " Next "
else
changePageLink (page + 1) "Next"
first = if page == 1 then
H.text ""
else
changePageLink' 1
last = if page == totalPages then
H.text ""
else
changePageLink' totalPages
ldots = if page >= 5 then
H.text " ... "
else
H.text ""
rdots = if page + 3 < totalPages then
H.text " ... "
else
H.text ""
lnums = map changePageLink' $ A.filter (1 < _) [page - 2, page - 1]
rnums = map changePageLink' $ A.filter (totalPages > _) [page + 1, page + 2]
pure $ H.span {} $
[ H.text " ", prev, first, ldots]
<>
lnums
<>
[H.b {} [H.text $ " " <> show page <> " "]]
<>
rnums
<>
[ rdots, last, next ]
where
changePageLink :: Int -> String -> R.Element
changePageLink i s =
H.span {}
[ H.text " "
, effectLink (changePage i params) s
, H.text " "
]
changePageLink' :: Int -> R.Element
changePageLink' i = changePageLink i (show i)
data PageSizes = PS10 | PS20 | PS50 | PS100 | PS200
derive instance Eq PageSizes
instance Show PageSizes where
show PS10 = "10"
show PS20 = "20"
show PS50 = "50"
show PS100 = "100"
show PS200 = "200"
int2PageSizes :: Int -> PageSizes
int2PageSizes i = string2PageSize $ show i
pageSizes2Int :: PageSizes -> Int
pageSizes2Int PS10 = 10
pageSizes2Int PS20 = 20
pageSizes2Int PS50 = 50
pageSizes2Int PS100 = 100
pageSizes2Int PS200 = 200
pageSizes :: Array PageSizes
pageSizes = [PS10, PS20, PS50, PS100, PS200]
string2PageSize :: String -> PageSizes
string2PageSize "10" = PS10
string2PageSize "20" = PS20
string2PageSize "50" = PS50
string2PageSize "100" = PS100
string2PageSize "200" = PS200
string2PageSize _ = PS10
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Table/ 0000775 0000000 0000000 00000000000 14111104351 0031570 5 ustar 00root root 0000000 0000000 Types.purs 0000664 0000000 0000000 00000003456 14111104351 0033540 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components/Table module Gargantext.Components.Table.Types where
import Data.Generic.Rep (class Generic)
import Data.Show.Generic (genericShow)
import Data.Maybe (Maybe)
import Data.Sequence as Seq
import Reactix as R
import Toestand as T
import Prelude (class Eq, class Show, (<>))
import Gargantext.Components.Search (SearchType)
type Params = { limit :: Int
, offset :: Int
, orderBy :: OrderBy
, searchType :: SearchType
}
type OrderBy = Maybe (OrderByDirection ColumnName)
data OrderByDirection a = ASC a | DESC a
derive instance Generic (OrderByDirection a) _
instance Show a => Show (OrderByDirection a) where
show = genericShow
derive instance Eq a => Eq (OrderByDirection a)
orderByToForm :: OrderByDirection ColumnName -> String
orderByToForm (ASC (ColumnName x)) = x <> "Asc"
orderByToForm (DESC (ColumnName x)) = x <> "Desc"
newtype ColumnName = ColumnName String
derive instance Generic ColumnName _
instance Show ColumnName where
show = genericShow
derive instance Eq ColumnName
columnName :: ColumnName -> String
columnName (ColumnName c) = c
type Props =
( syncResetButton :: Array R.Element
, colNames :: Array ColumnName
, container :: Record TableContainerProps -> R.Element
, params :: T.Box Params
, rows :: Rows
, totalRecords :: Int
, wrapColElts :: ColumnName -> Array R.Element -> Array R.Element
-- ^ Use `const identity` as a default behavior.
)
type TableContainerProps =
( syncResetButton :: Array R.Element
, pageSizeControl :: R.Element
, pageSizeDescription :: R.Element
, paginationLinks :: R.Element
, tableHead :: R.Element
, tableBody :: Array R.Element
)
type Row = { row :: R.Element, delete :: Boolean }
type Rows = Seq.Seq Row
Themes.purs 0000664 0000000 0000000 00000005272 14111104351 0032630 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components module Gargantext.Components.Themes where
import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Maybe (Maybe(..))
import Effect (Effect)
import FFI.Simple ((.=))
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Themes"
stylesheetElId :: String
stylesheetElId = "bootstrap-css"
newtype Theme = Theme { location :: String
, name :: String }
derive instance Generic Theme _
instance Eq Theme where
eq = genericEq
themeName :: Theme -> String
themeName (Theme { name }) = name
defaultTheme :: Theme
defaultTheme = Theme { name: "default"
, location: "styles/bootstrap-default.css" }
greysonTheme :: Theme
greysonTheme = Theme { name: "greyson"
, location: "styles/bootstrap-greyson.css" }
monotonyTheme :: Theme
monotonyTheme = Theme { name: "monotony"
, location: "styles/bootstrap-monotony.css" }
herbieTheme :: Theme
herbieTheme = Theme { name: "herbie"
, location: "styles/bootstrap-herbie.css" }
darksterTheme :: Theme
darksterTheme = Theme { name: "darkster (bêta)"
, location: "styles/bootstrap-darkster.css" }
allThemes :: Array Theme
allThemes = [ defaultTheme, greysonTheme, monotonyTheme, herbieTheme, darksterTheme]
switchTheme :: Theme -> Effect Unit
switchTheme (Theme { location }) = do
mEl <- R2.getElementById stylesheetElId
case mEl of
Nothing -> pure unit
Just el -> do
_ <- pure $ (el .= "href") location
pure unit
type ThemeSwitcherProps = (
theme :: Theme
, themes :: Array Theme
)
themeSwitcher :: R2.Component ThemeSwitcherProps
themeSwitcher = R.createElement themeSwitcherCpt
themeSwitcherCpt :: R.Component ThemeSwitcherProps
themeSwitcherCpt = here.component "themeSwitcher" cpt
where
cpt { theme, themes } _ = do
currentTheme <- T.useBox theme
currentTheme' <- T.useLive T.unequal currentTheme
let option (Theme { name }) = H.option { value: name } [ H.text name ]
let options = map option themes
pure $ R2.select { className: "form-control"
, defaultValue: themeName currentTheme'
, on: { change: onChange currentTheme } } options
where
onChange currentTheme e = do
let value = R.unsafeEventValue e
let mTheme = A.head $ A.filter (\(Theme { name }) -> value == name) themes
case mTheme of
Nothing -> pure unit
Just t -> do
switchTheme t
T.write_ t currentTheme
TopBar.purs 0000664 0000000 0000000 00000021612 14111104351 0032566 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Components module Gargantext.Components.TopBar where
import Gargantext.Prelude
import Data.Foldable (intercalate)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.GraphExplorer.ToggleButton as Toggle
import Gargantext.Components.Themes (themeSwitcher, defaultTheme, allThemes)
import Gargantext.Types (Handed(..), reverseHanded)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Components.TopBar"
type TopBarProps =
( boxes :: Boxes )
topBar :: R2.Component TopBarProps
topBar = R.createElement topBarCpt
topBarCpt :: R.Component TopBarProps
topBarCpt = here.component "topBar" cpt
where
cpt { boxes: { handed, showTree } } children = do
handed' <- T.useLive T.unequal handed
pure $ H.div { className: "navbar navbar-expand-lg navbar-dark bg-dark"
, id: "dafixedtop"
, role: "navigation"
}
[ H.div { className: "container-fluid" } $ reverseHanded handed'
[
-- NOTE: first (and only) entry in the sorted array should have the "ml-auto class"
-- https://stackoverflow.com/questions/19733447/bootstrap-navbar-with-left-center-or-right-aligned-items
-- In practice: only apply "ml-auto" to the last element of this list, if handed == LeftHanded
logo
, H.div { className: "collapse navbar-collapse" }
[ H.ul { className: "navbar-nav " <> if handed' == LeftHanded then "ml-auto" else "" } $ reverseHanded handed'
([ divDropdownLeft {} []
, handButton
, smiley
, H.li { className: "nav-item" } [ themeSwitcher { theme: defaultTheme
, themes: allThemes } [] ]
, Toggle.treeToggleButton { state: showTree } []
] <> children)
]
]
]
where
handButton = H.li { title: "If you are Left Handed you can change\n"
<> "the interface by clicking on me. Click\n"
<> "again to come back to previous state."
, className: "nav-item"
} [handedChooser { handed } []]
smiley = H.li { title: "Hello! Looking for the tree ?\n"
<> "Just watch on the other side!\n"
<> "Click on the hand again to see it back."
, className : "nav-item"
}
[ H.a { className: "nav-link" } [H.span {className: "fa fa-question-circle-o"} [] ]]
{-, H.ul { title: "Dark Mode soon here"
, className : "nav navbar-nav"
} [ H.li {} [ H.a {} [ H.span {className : "fa fa-moon"}[]
]
]
]
-}
-- SB.searchBar {session, databases: allDatabases}
logo :: R.Element
logo =
H.a { className, href: "#/" } [
H.img { src, title, width: "30", height: "28" }
]
where
className = "navbar-brand logoSmall"
src = "images/logoSmall.png"
title = "Back home."
divDropdownLeft :: R2.Component ()
divDropdownLeft = R.createElement divDropdownLeftCpt
divDropdownLeftCpt :: R.Component ()
divDropdownLeftCpt = here.component "divDropdownLeft" cpt
where
cpt {} _ = do
show <- T.useBox false
pure $ H.li { className: "nav-item dropdown" } [
menuButton { element: menuElement, show } []
, menuElements { elements, show } []
]
menuElement = LiNav { title : "About Gargantext"
, href : "#"
, icon : "fa fa-info-circle"
, text : "Info" }
elements = [
[
LiNav { title : "Quick start, tutorials and methodology"
, href : "https://iscpif.fr/gargantext/your-first-map/"
, icon : "fa fa-lightbulb-o"
, text : "Tutorials"
}
, LiNav { title : "Report bug here"
, href : "https://www.iscpif.fr/gargantext/feedback-and-bug-reports/"
, icon : "fa fa-bullhorn"
, text : "Feedback"
}
]
, -----------------------------------------------------------
[ LiNav { title : "Chat"
, href : "https://chat.iscpif.fr/channel/gargantext"
, icon : "fa fa-rocket"
, text : "Chat"
}
, LiNav { title : "Forums"
, href : "https://discourse.iscpif.fr/c/gargantext"
, icon : "fa fa-weixin"
, text : "Forum"
}
]
,------------------------------------------------------------
[ LiNav { title : "Code documentation"
, href : "https://doc.gargantext.org"
, icon : "fa fa-book"
, text : "Source Code Documentation"
}
, LiNav { title : "API documentation"
, href : "https://v4.gargantext.org/swagger-ui"
, icon : "fa fa-code-fork"
, text : "API documentation"
}
, LiNav { title : "Source code"
, href : "https://gitlab.iscpif.fr/gargantext/haskell-gargantext"
, icon : "fa fa-code"
, text : "Source Code"
}
]
,------------------------------------------------------------
[ LiNav { title : "More about us (you)"
, href : "https://iscpif.fr"
, icon : "fa fa-question"
, text : "About"
}
]
] -- ===========================================================
type MenuButtonProps = (
element :: LiNav
, show :: T.Box Boolean
)
menuButton :: R2.Component MenuButtonProps
menuButton = R.createElement menuButtonCpt
menuButtonCpt :: R.Component MenuButtonProps
menuButtonCpt = here.component "menuButton" cpt
where
cpt { element: LiNav { title, href, icon, text }, show } _ = do
pure $ H.a { className: "dropdown-toggle navbar-text"
-- , data: {toggle: "dropdown"}
, title
, on: { click: \_ -> T.modify_ not show }
, role: "button" } [
H.span { aria: {hidden : true}, className: icon } []
, H.text (" " <> text)
]
-- | Menu in the sidebar, syntactic sugar
type MenuElementsProps = (
elements :: Array (Array LiNav)
, show :: T.Box Boolean
)
menuElements :: R2.Component MenuElementsProps
menuElements = R.createElement menuElementsCpt
menuElementsCpt :: R.Component MenuElementsProps
menuElementsCpt = here.component "menuElements" cpt
where
cpt { elements, show } _ = do
show' <- T.useLive T.unequal show
pure $ if show' then
H.ul { className: "dropdown-menu"
, on: { click: \_ -> T.write_ false show }
, style: { display: "block" } } $ intercalate divider $ map (map liNav) elements
else
H.div {} []
divider :: Array R.Element
divider = [H.li {className: "dropdown-divider"} []]
-- | surgar for target : "blank"
--data LiNav_ = LiNav_ { title :: String
-- , href :: String
-- , icon :: String
-- , text :: String
-- , target :: String
-- }
data LiNav = LiNav { title :: String
, href :: String
, icon :: String
, text :: String
}
liNav :: LiNav -> R.Element
liNav (LiNav { title : title'
, href : href'
, icon : icon'
, text : text'
}
) = H.li { className: "dropdown-item" } [
H.a { tabIndex: (-1)
, target: "blank"
, title: title'
, href: href'
} [ H.span { className: icon' } []
, H.text $ " " <> text'
]
]
type HandedChooserProps = (
handed :: T.Box Handed
)
handedChooser :: R2.Component HandedChooserProps
handedChooser = R.createElement handedChooserCpt
handedChooserCpt :: R.Component HandedChooserProps
handedChooserCpt = here.component "handedChooser" cpt
where
cpt { handed } _ = do
handed' <- T.useLive T.unequal handed
pure $ H.a { className: "nav-link" } [
H.span { className: handedClass handed'
, on: { click: onClick handed } } []
]
handedClass LeftHanded = "fa fa-hand-o-left"
handedClass RightHanded = "fa fa-hand-o-right"
onClick handed = T.modify_ (\h -> case h of
LeftHanded -> RightHanded
RightHanded -> LeftHanded) handed
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Config.purs 0000664 0000000 0000000 00000005776 14111104351 0030553 0 ustar 00root root 0000000 0000000 module Gargantext.Config where
import Data.Array as A
import Data.Array.NonEmpty as AN
import Data.Maybe (Maybe)
import Data.NonEmpty (NonEmpty, (:|), head)
import Data.String (Pattern(..), Replacement(..), replace) as S
import Data.String.Utils (startsWith) as S
import Effect (Effect)
import Gargantext.Ends
import Gargantext.Prelude (bind, pure, ($))
import Gargantext.Types (ApiVersion(..))
import Gargantext.Utils (href)
defaultBackends :: NonEmpty Array Backend
defaultBackends =
backend_local :| [ backend_prod, backend_partner, backend_demo, backend_dev ]
prodUrl :: String
prodUrl = "https://v4.gargantext.org"
backend_prod :: Backend
backend_prod = backend V10 "/api/" prodUrl "iscpif.cnrs"
partnerUrl :: String
partnerUrl = "https://imtv4.gargantext.org"
backend_partner :: Backend
backend_partner = backend V10 "/api/" partnerUrl "institut-mines-telecom.imt"
demoUrl :: String
demoUrl = "https://demo.gargantext.org"
backend_demo :: Backend
backend_demo = backend V10 "/api/" demoUrl "demo.inshs.cnrs"
devUrl :: String
devUrl = "https://dev.gargantext.org"
backend_dev :: Backend
backend_dev = backend V10 "/api/" devUrl "devel.inshs.cnrs"
localUrl :: String
localUrl = "http://localhost:8008"
backend_local :: Backend
backend_local = backend V10 "/api/" localUrl "local.cnrs"
matchCurrentLocation :: Effect (Maybe Backend)
matchCurrentLocation = do
href <- href
let starts = AN.filter (\(Backend { baseUrl }) -> S.startsWith baseUrl href) $ AN.fromNonEmpty defaultBackends
pure $ A.head starts
-- | public Backend
-- When user is not logged, use the location of the window
publicBackend :: Backend
publicBackend = backend_local
publicBackend' :: Effect Backend
publicBackend' = do
href <- href
pure $ Backend { name : "Public Backend"
, baseUrl : href
, prePath : "api/"
, version : V10
}
defaultApps :: NonEmpty Array Frontend
defaultApps = relative :| [prod, dev, demo, haskell, python, caddy]
where
relative = frontend "/#/" "" "Relative"
prod = frontend "/#/" "https://v4.gargantext.org" "v4.gargantext.org"
dev = frontend "/#/" "https://dev.gargantext.org" "gargantext.org (dev)"
demo = frontend "/#/" "https://demo.gargantext.org" "gargantext.org (demo)"
haskell = frontend "/#/" "http://localhost:8008" "localhost.gargantext"
python = frontend "/#/" "http://localhost:8000" "localhost.python"
caddy = frontend "/#/" "http://localhost:2015" "localhost.caddy"
defaultStatics :: NonEmpty Array Frontend
defaultStatics = relative :| []
where
relative = frontend "" "/" "relative"
defaultApp :: Frontend
defaultApp = head defaultApps
defaultStatic :: Frontend
defaultStatic = head defaultStatics
defaultFrontends :: Frontends
defaultFrontends = Frontends { app: defaultApp, static: defaultStatic }
changePort :: String -> String
changePort = S.replace (S.Pattern "http://localhost:8000/") (S.Replacement "http://localhost:8008/")
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Config/ 0000775 0000000 0000000 00000000000 14111104351 0027621 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Config/REST.purs 0000664 0000000 0000000 00000014406 14111104351 0031316 0 ustar 00root root 0000000 0000000 module Gargantext.Config.REST where
import Gargantext.Prelude
import Affjax (Error(..), defaultRequest, request)
import Affjax as Affjax
import Affjax.RequestBody (formData, formURLEncoded, string)
import Affjax.RequestHeader as ARH
import Affjax.ResponseFormat as ResponseFormat
import Data.Argonaut.Core as AC
import Data.Either (Either(..))
import Data.Foldable (foldMap)
import Data.FormURLEncoded as FormURLEncoded
import Data.Generic.Rep (class Generic)
import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(..))
import Data.MediaType.Common (applicationFormURLEncoded, applicationJSON, multipartFormData)
import Data.Tuple (Tuple)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Foreign as Foreign
import Gargantext.Utils.Reactix as R2
import Simple.JSON as JSON
import Web.XHR.FormData as XHRFormData
type Token = String
data RESTError =
SendResponseError Affjax.Error
| ReadJSONError Foreign.MultipleErrors
| CustomError String
derive instance Generic RESTError _
instance Show RESTError where
show (SendResponseError e) = "SendResponseError " <> showError e
where
showError (RequestContentError e') = "(RequestContentError " <> show e' <> ")"
showError (ResponseBodyError fe rf) = "(ResponseBodyError " <> show fe <> " (rf)" -- <> show rf <> ")"
showError (TimeoutError) = "(TimeoutError)"
showError (RequestFailedError) = "(RequestFailedError)"
showError (XHROtherError e') = "(XHROtherError " <> show e' <> ")"
show (ReadJSONError e) = "ReadJSONError " <> show e
show (CustomError s) = "CustomError " <> s
instance Eq RESTError where
-- this is crude but we need it only because of useLoader
eq _ _ = false
readJSON :: forall a b. JSON.ReadForeign a =>
Either Affjax.Error
{ body :: AC.Json
| b
} -> Either RESTError a
readJSON affResp =
case affResp of
Left err -> do
-- _ <- liftEffect $ log $ printError err
--throwError $ error $ printError err
Left $ SendResponseError err
Right resp -> do
--_ <- liftEffect $ log json.status
--_ <- liftEffect $ log json.headers
--_ <- liftEffect $ log json.body
case (JSON.readJSON $ AC.stringify resp.body) of
Left err -> Left $ ReadJSONError err
Right r -> Right r
-- readJSONOrFail affResp = do
-- case readJSON affResp of
-- Left err -> throwError $ error $ "decodeJson affResp.body: " <> show err
-- Right b -> pure b
-- TODO too much duplicate code in `postWwwUrlencoded`
send :: forall body res. JSON.WriteForeign body => JSON.ReadForeign res =>
Method -> Maybe Token -> String -> Maybe body -> Aff (Either RESTError res)
send m mtoken url reqbody = do
let req = defaultRequest
{ url = url
, responseFormat = ResponseFormat.json
, method = Left m
, headers = [ ARH.ContentType applicationJSON
, ARH.Accept applicationJSON
] <>
foldMap (\token ->
[ARH.RequestHeader "Authorization" $ "Bearer " <> token]
) mtoken
, content = Just $ string $ JSON.writeJSON reqbody
}
case mtoken of
Nothing -> pure unit
Just token -> liftEffect $ do
let cookie = "JWT-Cookie=" <> token <> "; Path=/;" --" HttpOnly; Secure; SameSite=Lax"
R2.setCookie cookie
affResp <- request req
pure $ readJSON affResp
noReqBody :: Maybe String
noReqBody = Just ""
--noReqBody = Nothing
get :: forall a. JSON.ReadForeign a => Maybe Token -> String -> Aff (Either RESTError a)
get mtoken url = send GET mtoken url noReqBody
put :: forall a b. JSON.WriteForeign a => JSON.ReadForeign b => Maybe Token -> String -> a -> Aff (Either RESTError b)
put mtoken url = send PUT mtoken url <<< Just
put_ :: forall a. JSON.ReadForeign a => Maybe Token -> String -> Aff (Either RESTError a)
put_ mtoken url = send PUT mtoken url noReqBody
delete :: forall a. JSON.ReadForeign a => Maybe Token -> String -> Aff (Either RESTError a)
delete mtoken url = send DELETE mtoken url noReqBody
-- This might not be a good idea:
-- https://stackoverflow.com/questions/14323716/restful-alternatives-to-delete-request-body
deleteWithBody :: forall a b. JSON.WriteForeign a => JSON.ReadForeign b => Maybe Token -> String -> a -> Aff (Either RESTError b)
deleteWithBody mtoken url = send DELETE mtoken url <<< Just
post :: forall a b. JSON.WriteForeign a => JSON.ReadForeign b => Maybe Token -> String -> a -> Aff (Either RESTError b)
post mtoken url = send POST mtoken url <<< Just
type FormDataParams = Array (Tuple String (Maybe String))
-- TODO too much duplicate code with `send`
postWwwUrlencoded :: forall b. JSON.ReadForeign b => Maybe Token -> String -> FormDataParams -> Aff (Either RESTError b)
postWwwUrlencoded mtoken url bodyParams = do
affResp <- request $ defaultRequest
{ url = url
, responseFormat = ResponseFormat.json
, method = Left POST
, headers = [ ARH.ContentType applicationFormURLEncoded
, ARH.Accept applicationJSON
] <>
foldMap (\token ->
[ARH.RequestHeader "Authorization" $ "Bearer " <> token]
) mtoken
, content = Just $ formURLEncoded urlEncodedBody
}
pure $ readJSON affResp
where
urlEncodedBody = FormURLEncoded.fromArray bodyParams
postMultipartFormData :: forall b. JSON.ReadForeign b => Maybe Token -> String -> String -> Aff (Either RESTError b)
postMultipartFormData mtoken url body = do
fd <- liftEffect $ XHRFormData.new
_ <- liftEffect $ XHRFormData.append (XHRFormData.EntryName "body") body fd
affResp <- request $ defaultRequest
{ url = url
, responseFormat = ResponseFormat.json
, method = Left POST
, headers = [ ARH.ContentType multipartFormData
, ARH.Accept applicationJSON
] <>
foldMap (\token ->
[ ARH.RequestHeader "Authorization" $ "Bearer " <> token ]
) mtoken
, content = Just $ formData fd
}
pure $ readJSON affResp
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Config/Utils.purs 0000664 0000000 0000000 00000001355 14111104351 0031640 0 ustar 00root root 0000000 0000000 module Gargantext.Config.Utils where
import Gargantext.Prelude
import Data.Array as A
import Data.Either (Either(..))
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Gargantext.Config.REST (RESTError)
import Gargantext.Types (FrontendError(..))
import Gargantext.Utils.Reactix as R2
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Config.Utils"
handleRESTError :: forall a. T.Box (Array FrontendError)
-> Either RESTError a
-> (a -> Aff Unit)
-> Aff Unit
handleRESTError errors (Left error) _ = liftEffect $ do
T.modify_ (A.cons $ FRESTError { error }) errors
here.log2 "[handleTaskError] RESTError" error
handleRESTError _ (Right task) handler = handler task
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Data/ 0000775 0000000 0000000 00000000000 14111104351 0027265 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Data/Array.purs 0000664 0000000 0000000 00000004331 14111104351 0031257 0 ustar 00root root 0000000 0000000 module Gargantext.Data.Array
where
import Data.Array as DA
import Data.List as List
import Data.Maybe
import Data.Sequence as Seq
import Data.Tuple (Tuple(..))
import Prelude (bind, flip, identity, (<<<), ($))
----------------------------------------------------------------------
-- | Split arrays tools
splitEvery :: forall a. Int -> Array a -> Array (Array a)
splitEvery _ [] = []
splitEvery n xs =
let (Tuple h t) = splitAt n xs
in DA.cons h (splitEvery n t)
splitAt :: forall a. Int -> Array a -> Tuple (Array a) (Array a)
splitAt n ls = Tuple (Seq.toUnfoldable x) (Seq.toUnfoldable xs)
where
Tuple x xs = Seq.splitAt n (Seq.fromFoldable ls)
----------------------------------------------------------------------
-- | Array with Maybe tools
mapMaybe :: forall a b. (a -> Maybe b) -> Array a -> Array b
mapMaybe f = concatMap (maybe [] singleton <<< f)
catMaybes :: forall a. Array (Maybe a) -> Array a
catMaybes = mapMaybe identity
----------------------------------------------------------------------
-- | Array misc tools
concatMap :: forall a b. (a -> Array b) -> Array a -> Array b
concatMap = flip bind
singleton :: forall a. a -> Array a
singleton a = [a]
----------------------------------------------------------------------
-- | Seq with Maybe tools
seqMapMaybe :: forall a b. (a -> Maybe b) -> Seq.Seq a -> Seq.Seq b
seqMapMaybe f = seqConcatMap (maybe Seq.empty Seq.singleton <<< f)
seqCatMaybes :: forall a. Seq.Seq (Maybe a) -> Seq.Seq a
seqCatMaybes = seqMapMaybe identity
----------------------------------------------------------------------
-- | Seq misc tools
seqConcatMap :: forall a b. (a -> Seq.Seq b) -> Seq.Seq a -> Seq.Seq b
seqConcatMap = flip bind
-- swap 2 array indices
swap :: forall a. Int -> Int -> Array a -> Array a
swap i j arr = DA.updateAtIndices updates arr
where
updates = case DA.index arr i of
Nothing -> []
Just iEl -> case DA.index arr j of
Nothing -> []
Just jEl -> [ Tuple i jEl, Tuple j iEl ]
swapList :: forall a. Int -> Int -> List.List a -> List.List a
swapList i j seq = List.fromFoldable $ swap i j $ List.toUnfoldable seq
swapSeq :: forall a. Int -> Int -> Seq.Seq a -> Seq.Seq a
swapSeq i j seq = Seq.fromFoldable $ swap i j $ Seq.toUnfoldable seq
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Data/Louvain.js 0000775 0000000 0000000 00000024462 14111104351 0031253 0 ustar 00root root 0000000 0000000 /*
Author: Corneliu S. (github.com/upphiminn)
This is a javascript implementation of the Louvain
community detection algorithm (http://arxiv.org/abs/0803.0476)
Based on https://bitbucket.org/taynaud/python-louvain/overview
*/
exports._jLouvain = (function(){
return function(){
//Constants
var __PASS_MAX = -1
var __MIN = 0.0000001
//Local vars
var original_graph_nodes;
var original_graph_edges;
var original_graph = {};
var partition_init;
//Helpers
function make_set(array){
var set = {};
array.forEach(function(d,i){
set[d] = true;
});
return Object.keys(set);
};
function obj_values(obj){
return Object.values(obj);
/*
var vals = [];
for( var key in obj ) {
if ( obj.hasOwnProperty(key) ) {
vals.push(obj[key]);
}
}
return vals;
*/
};
function get_degree_for_node(graph, node){
var neighbours = get_neighbours_of_node(graph, node);
var weight = 0;
neighbours.forEach(function(neighbour,i){
var value = graph._assoc_mat[node][neighbour] || 1;
if(node == neighbour)
value *= 2;
weight += value;
});
return weight;
};
function get_neighbours_of_node(graph, node){
if(typeof graph._assoc_mat[node] == 'undefined')
return [];
return Object.keys(graph._assoc_mat[node]);
}
function get_edge_weight(graph, node1, node2){
return graph._assoc_mat[node1] ? graph._assoc_mat[node1][node2] : undefined;
}
function get_graph_size(graph){
var size = 0;
graph.edges.forEach(function(edge){
size += edge.weight;
});
return size;
}
function add_edge_to_graph(graph, edge){
update_assoc_mat(graph, edge);
var edge_index = graph.edges.map(function(d){
return d.source+'_'+d.target;
}).indexOf(edge.source+'_'+edge.target);
if(edge_index != -1)
graph.edges[edge_index].weight = edge.weight;
else
graph.edges.push(edge);
}
function make_assoc_mat(edge_list){
var mat = {};
edge_list.forEach(function(edge, i){
mat[edge.source] = mat[edge.source] || {};
mat[edge.source][edge.target] = edge.weight;
mat[edge.target] = mat[edge.target] || {};
mat[edge.target][edge.source] = edge.weight;
});
return mat;
}
function update_assoc_mat(graph, edge){
graph._assoc_mat[edge.source] = graph._assoc_mat[edge.source] || {};
graph._assoc_mat[edge.source][edge.target] = edge.weight;
graph._assoc_mat[edge.target] = graph._assoc_mat[edge.target] || {};
graph._assoc_mat[edge.target][edge.source] = edge.weight;
}
function clone(obj){
if(obj == null || typeof(obj) != 'object')
return obj;
var temp = obj.constructor();
for(var key in obj)
temp[key] = clone(obj[key]);
return temp;
}
//Core-Algorithm Related
function init_status(graph, status, part){
status['nodes_to_com'] = {};
status['total_weight'] = 0;
status['internals'] = {};
status['degrees'] = {};
status['gdegrees'] = {};
status['loops'] = {};
status['total_weight'] = get_graph_size(graph);
if(typeof part == 'undefined'){
graph.nodes.forEach(function(node,i){
status.nodes_to_com[node] = i;
var deg = get_degree_for_node(graph, node);
if (deg < 0)
throw 'Bad graph type, use positive weights!';
status.degrees[i] = deg;
status.gdegrees[node] = deg;
status.loops[node] = get_edge_weight(graph, node, node) || 0;
status.internals[i] = status.loops[node];
});
}else{
graph.nodes.forEach(function(node,i){
var com = part[node];
status.nodes_to_com[node] = com;
var deg = get_degree_for_node(graph, node);
status.degrees[com] = (status.degrees[com] || 0) + deg;
status.gdegrees[node] = deg;
var inc = 0.0;
var neighbours = get_neighbours_of_node(graph, node);
neighbours.forEach(function(neighbour, i){
var weight = graph._assoc_mat[node][neighbour];
if (weight <= 0){
throw "Bad graph type, use positive weights";
}
if(part[neighbour] == com){
if (neighbour == node){
inc += weight;
}else{
inc += weight/2.0;
}
}
});
status.internals[com] = (status.internals[com] || 0) + inc;
});
}
}
function __modularity(status){
var links = status.total_weight;
var result = 0.0;
var communities = make_set(obj_values(status.nodes_to_com));
communities.forEach(function(com,i){
var in_degree = status.internals[com] || 0 ;
var degree = status.degrees[com] || 0 ;
if(links > 0){
result = result + in_degree / links - Math.pow((degree / (2.0*links)), 2);
}
});
return result;
}
function __neighcom(node, graph, status){
// compute the communities in the neighb. of the node, with the graph given by
// node_to_com
var weights = {};
var neighboorhood = get_neighbours_of_node(graph, node);//make iterable;
neighboorhood.forEach(function(neighbour, i){
if(neighbour != node){
var weight = graph._assoc_mat[node][neighbour] || 1;
var neighbourcom = status.nodes_to_com[neighbour];
weights[neighbourcom] = (weights[neighbourcom] || 0) + weight;
}
});
return weights;
}
function __insert(node, com, weight, status){
//insert node into com and modify status
status.nodes_to_com[node] = +com;
status.degrees[com] = (status.degrees[com] || 0) + (status.gdegrees[node]||0);
status.internals[com] = (status.internals[com] || 0) + weight + (status.loops[node]||0);
}
function __remove(node, com, weight, status){
//remove node from com and modify status
status.degrees[com] = ((status.degrees[com] || 0) - (status.gdegrees[node] || 0));
status.internals[com] = ((status.internals[com] || 0) - weight -(status.loops[node] ||0));
status.nodes_to_com[node] = -1;
}
function __renumber(dict){
var count = 0;
var ret = clone(dict); //deep copy :)
var new_values = {};
var dict_keys = Object.keys(dict);
dict_keys.forEach(function(key){
var value = dict[key];
var new_value = typeof new_values[value] =='undefined' ? -1 : new_values[value];
if(new_value == -1){
new_values[value] = count;
new_value = count;
count = count + 1;
}
ret[key] = new_value;
});
return ret;
}
function __one_level(graph, status){
//Compute one level of the Communities Dendogram.
var modif = true,
nb_pass_done = 0,
cur_mod = __modularity(status),
new_mod = cur_mod;
while (modif && nb_pass_done != __PASS_MAX){
cur_mod = new_mod;
modif = false;
nb_pass_done += 1
graph.nodes.forEach(function(node,i){
var com_node = status.nodes_to_com[node];
var degc_totw = (status.gdegrees[node] || 0) / (status.total_weight * 2.0);
var neigh_communities = __neighcom(node, graph, status);
__remove(node, com_node, (neigh_communities[com_node] || 0.0), status);
var best_com = com_node;
var best_increase = 0;
var neigh_communities_entries = Object.keys(neigh_communities);//make iterable;
neigh_communities_entries.forEach(function(com,i){
var incr = neigh_communities[com] - (status.degrees[com] || 0.0) * degc_totw;
if (incr > best_increase){
best_increase = incr;
best_com = com;
}
});
__insert(node, best_com, neigh_communities[best_com] || 0, status);
if(best_com != com_node)
modif = true;
});
new_mod = __modularity(status);
if(new_mod - cur_mod < __MIN)
break;
}
}
function induced_graph(partition, graph){
var ret = {nodes:[], edges:[], _assoc_mat: {}};
var w_prec, weight;
//add nodes from partition values
var partition_values = obj_values(partition);
ret.nodes = ret.nodes.concat(make_set(partition_values)); //make set
graph.edges.forEach(function(edge,i){
weight = edge.weight || 1;
var com1 = partition[edge.source];
var com2 = partition[edge.target];
w_prec = (get_edge_weight(ret, com1, com2) || 0);
var new_weight = (w_prec + weight);
add_edge_to_graph(ret, {'source': com1, 'target': com2, 'weight': new_weight});
});
return ret;
}
function partition_at_level(dendogram, level){
var partition = clone(dendogram[0]);
for(var i = 1; i < level + 1; i++ )
Object.keys(partition).forEach(function(key,j){
var node = key;
var com = partition[key];
partition[node] = dendogram[i][com];
});
return partition;
}
function generate_dendogram(graph, part_init){
if(graph.edges.length == 0){
var part = {};
graph.nodes.forEach(function(node,i){
part[node] = node;
});
return part;
}
var status = {};
init_status(original_graph, status, part_init);
var mod = __modularity(status);
var status_list = [];
__one_level(original_graph, status);
var new_mod = __modularity(status);
var partition = __renumber(status.nodes_to_com);
status_list.push(partition);
mod = new_mod;
var current_graph = induced_graph(partition, original_graph);
init_status(current_graph, status);
while (true){
__one_level(current_graph, status);
new_mod = __modularity(status);
if(new_mod - mod < __MIN)
break;
partition = __renumber(status.nodes_to_com);
status_list.push(partition);
mod = new_mod;
current_graph = induced_graph(partition, current_graph);
init_status(current_graph, status);
}
return status_list;
}
var core = function(){
var status = {};
var dendogram = generate_dendogram(original_graph, partition_init);
return partition_at_level(dendogram, dendogram.length - 1);
};
core.nodes = function(nds){
if(arguments.length > 0){
original_graph_nodes = nds;
return core;
} else {
return original_graph_nodes;
}
};
core.edges = function(edgs){
if(typeof original_graph_nodes == 'undefined')
throw 'Please provide the graph nodes first!';
if(arguments.length > 0){
original_graph_edges = edgs;
var assoc_mat = make_assoc_mat(edgs);
original_graph = { 'nodes': original_graph_nodes,
'edges': original_graph_edges,
'_assoc_mat': assoc_mat };
return core;
} else {
return original_graph_edges;
}
};
core.partition_init = function(prttn){
if(arguments.length > 0){
partition_init = prttn;
}
return core;
};
return core;
}
})();
exports._init = function(louvain, nodes, edges) {
return Object.entries(louvain.nodes(nodes).edges(edges)());
}
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Data/Louvain.purs 0000664 0000000 0000000 00000001652 14111104351 0031621 0 ustar 00root root 0000000 0000000 module Gargantext.Data.Louvain where
import Prelude (Unit, (<$>))
import Data.Function.Uncurried (Fn1, runFn1, Fn3, runFn3)
import Data.Map as Map
import Data.Tuple (Tuple(..))
import Data.Tuple.Native (T2, prj)
import Data.Typelevel.Num (d0, d1)
foreign import data Louvain :: Type
type Node = String
type Edge =
(
source :: Node
, target :: Node
, weight :: Number
)
type Cluster = Int
type LouvainCluster_ = T2 Node Cluster
type LouvainCluster = Map.Map Node Cluster
foreign import _jLouvain :: Fn1 Unit Louvain
louvain :: Unit -> Louvain
louvain unit = runFn1 _jLouvain unit
foreign import _init :: Fn3 Louvain (Array Node) (Array (Record Edge)) (Array LouvainCluster_)
init :: Louvain -> Array Node -> Array (Record Edge) -> LouvainCluster
init l nds edgs = Map.fromFoldable clusterTuples
where
clusterArr = runFn3 _init l nds edgs
clusterTuples = (\t2 -> Tuple (prj d0 t2) (prj d1 t2)) <$> clusterArr
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Data/Louvain/ 0000775 0000000 0000000 00000000000 14111104351 0030702 5 ustar 00root root 0000000 0000000 Algorithm.purs 0000664 0000000 0000000 00000004436 14111104351 0033473 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Data/Louvain module Gargantext.Data.Louvain.Algorithm where
import Data.Foldable (sum)
import Data.Map as Map
import Data.Maybe (Maybe(..))
import Data.Sequence as Seq
import Data.Set as Set
import Data.Tuple (Tuple(..))
import Prelude ((&&), (==), ($), (<$>), class Eq, class Ord)
newtype Cluster = Cluster String
newtype Node = Node String
derive instance Eq Node
derive instance Ord Node
newtype Edge = Edge {
source :: Node
, target :: Node
, weight :: Number
}
newtype Graph = Graph {
edges :: Seq.Seq Edge
, nodes :: Seq.Seq Node
}
newtype Status = Status {
--degrees
--gdegrees
--internals
--loops
--nodesToCom ::
totalWeight :: Number
}
newtype Dendrogram = Dendrogram (Map.Map Node Cluster)
-- edge helpers
eSource :: Edge -> Node
eSource (Edge {source}) = source
eTarget :: Edge -> Node
eTarget (Edge {target}) = target
eWeight :: Edge -> Number
eWeight (Edge {weight}) = weight
-- graph helpers
gEdges :: Graph -> Seq.Seq Edge
gEdges (Graph {edges}) = edges
gNodes :: Graph -> Seq.Seq Node
gNodes (Graph {nodes}) = nodes
getGraphSize :: Graph -> Number
getGraphSize g = sum $ Seq.map eWeight $ gEdges g
getEdgeWeight :: Graph -> Node -> Node -> Maybe Number
getEdgeWeight g n1 n2 = eWeight <$> Seq.head edges
where
edges = Seq.filter (\e -> eSource e == n1 && eTarget e == n2) (gEdges g)
getNeighboursOfNode :: Graph -> Node -> Seq.Seq Node
getNeighboursOfNode g n = Seq.fromFoldable $ Set.union sources targets
where
edges = gEdges g
sourceEdges = Seq.filter (\e -> eSource e == n) edges
targetEdges = Seq.filter (\e -> eTarget e == n) edges
-- edge target, when edge source matches n
sources = Set.fromFoldable $ Seq.map eTarget sourceEdges
-- edge source, when edge target matches n
targets = Set.fromFoldable $ Seq.map eSource targetEdges
-- TODO algorithm
initStatus :: Graph -> Status -> Maybe Dendrogram -> Status
initStatus g s Nothing = Status {totalWeight}
where
totalWeight = getGraphSize g
initStatus g s (Just d) = Status {totalWeight}
where
totalWeight = getGraphSize g
generateDendrogram :: Graph -> Dendrogram -> Dendrogram
generateDendrogram g partInit =
if Seq.null (gEdges g) then
Dendrogram $ Map.fromFoldable $ Seq.map (\n@(Node ns) -> Tuple n (Cluster ns)) (gNodes g)
else
Dendrogram $ Map.empty
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Ends.purs 0000664 0000000 0000000 00000022670 14111104351 0030227 0 ustar 00root root 0000000 0000000 -- | Those things at the end of urls
module Gargantext.Ends
-- ( )
where
import Prelude (class Eq, class Show, show, ($), (/=), (<<<), (<>), (==))
import Data.Foldable (foldMap)
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Data.Newtype (class Newtype)
import Simple.JSON as JSON
import Gargantext.Routes as R
import Gargantext.Types (ApiVersion, ChartType(..), Limit, NodePath, NodeType(..), Offset, TabType(..), TermSize(..), nodePath, nodeTypePath, showTabType', TermList(MapTerm))
-- | A means of generating a url to visit, a destination
class ToUrl conf p where
toUrl :: conf -> p -> String
url :: forall conf p. ToUrl conf p => conf -> p -> String
url = toUrl
-- | Encapsulates the data we need to talk to a backend server
newtype Backend = Backend
{ name :: String
, baseUrl :: String
, prePath :: String
, version :: ApiVersion
}
derive instance Generic Backend _
derive instance Newtype Backend _
derive newtype instance JSON.ReadForeign Backend
derive newtype instance JSON.WriteForeign Backend
instance Eq Backend where eq = genericEq
instance Show Backend where show (Backend {name}) = name
instance ToUrl Backend String where toUrl = backendUrl
backend :: ApiVersion -> String -> String -> String -> Backend
backend version prePath baseUrl name = Backend { name, version, prePath, baseUrl }
-- | Creates a backend url from a backend and the path as a string
backendUrl :: Backend -> String -> String
backendUrl (Backend b) path = b.baseUrl <> b.prePath <> show b.version <> "/" <> path
-- | Encapsulates the data needed to construct a url to a frontend
-- | server (either for the app or static content)
newtype Frontend = Frontend
{ name :: String
, baseUrl :: String
, prePath :: String }
derive instance Generic Frontend _
instance Eq Frontend where eq = genericEq
instance ToUrl Frontend NodePath where toUrl front np = frontendUrl front (nodePath np)
instance Show Frontend where show (Frontend {name}) = name
instance ToUrl Frontend String where toUrl = frontendUrl
instance ToUrl Frontend R.AppRoute where toUrl f r = frontendUrl f (R.appPath r)
-- | Creates a frontend
frontend :: String -> String -> String -> Frontend
frontend baseUrl prePath name = Frontend { name, baseUrl, prePath }
-- | Creates a url from a frontend and the path as a string
frontendUrl :: Frontend -> String -> String
frontendUrl (Frontend f) path = f.baseUrl <> f.prePath <> path
-- | The currently selected App and Static configurations
newtype Frontends = Frontends { app :: Frontend, static :: Frontend }
derive instance Eq Frontends
instance ToUrl Frontends R.AppRoute where toUrl f r = appUrl f (R.appPath r)
instance ToUrl Frontends NodePath where toUrl (Frontends {app}) np = frontendUrl app (nodePath np)
-- | Creates an app url from a Frontends and the path as a string
appUrl :: Frontends -> String -> String
appUrl (Frontends {app}) = frontendUrl app
-- | Creates a static url from a Frontends and the path as a string
staticUrl :: Frontends -> String -> String
staticUrl (Frontends {static}) = frontendUrl static
sessionPath :: R.SessionRoute -> String
sessionPath (R.Tab t i) = sessionPath (R.NodeAPI Node i (showTabType' t))
sessionPath (R.Children n o l s i) = sessionPath (R.NodeAPI Node i ("children?type=" <> show n <> offsetUrl o <> limitUrl l <> orderUrl s))
sessionPath (R.NodeAPI Phylo pId p) = "phyloscape?nodeId=" <> (show $ fromMaybe 0 pId) <> p
sessionPath (R.RecomputeNgrams nt nId lId) = "node/" <> (show nId) <> "/ngrams/recompute?" <> (defaultList lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.RecomputeListChart ChartBar nt nId lId) = "node/" <> (show nId) <> "/pie?" <> (defaultList lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.RecomputeListChart ChartPie nt nId lId) = "node/" <> (show nId) <> "/pie?" <> (defaultList lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.RecomputeListChart ChartTree nt nId lId) = "node/" <> (show nId) <> "/tree?" <> (defaultList lId) <> "&ngramsType=" <> (show nt) <> "&listType=" <> show MapTerm
sessionPath (R.RecomputeListChart Histo nt nId lId) = "node/" <> (show nId) <> "/chart?" <> (defaultList lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.RecomputeListChart Scatter nt nId lId) = "node/" <> (show nId) <> "/metrics?" <> (defaultList lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.RecomputeListChart _ nt nId lId) = "node/" <> (show nId) <> "/recompute-chart?" <> (defaultList lId) <> "&ngramsType=" <> (show nt)
sessionPath (R.GraphAPI gId p) = "graph/" <> (show gId) <> "/" <> p
sessionPath (R.GetNgrams opts i) =
base opts.tabType
$ "ngrams?ngramsType=" <> showTabType' opts.tabType
<> limitUrl opts.limit
<> offset opts.offset
<> orderByUrl opts.orderBy
<> foldMap (\x -> if x /= 0 then "&list=" <> show x else "") opts.listIds
<> foldMap (\x -> "&listType=" <> show x) opts.termListFilter
<> foldMap termSizeFilter opts.termSizeFilter
<> search opts.searchQuery
where
base (TabCorpus _) = sessionPath <<< R.NodeAPI Node i
base _ = sessionPath <<< R.NodeAPI Url_Document i
offset Nothing = ""
offset (Just o) = offsetUrl o
termSizeFilter MonoTerm = "&minTermSize=0&maxTermSize=1"
termSizeFilter MultiTerm = "&minTermSize=2"
search "" = ""
search s = "&search=" <> s
sessionPath (R.GetNgramsTableAll opts i) =
sessionPath $ R.NodeAPI Node i
$ "ngrams?ngramsType="
<> showTabType' opts.tabType
<> foldMap (\x -> "&list=" <> show x) opts.listIds
<> limitUrl 100000
sessionPath (R.GetNgramsTableVersion opts i) =
sessionPath $ R.NodeAPI Node i
$ "ngrams/version?ngramsType="
<> showTabType' opts.tabType
<> "&list=" <> show opts.listId
-- $ "ngrams/version?"
-- <> "list=" <> show opts.listId
sessionPath (R.ListDocument lId dId) =
sessionPath $ R.NodeAPI NodeList lId ("document/" <> (show $ fromMaybe 0 dId))
sessionPath (R.ListsRoute lId) = "lists/" <> show lId
sessionPath (R.PutNgrams t listId termList i) =
sessionPath $ R.NodeAPI Node i
$ "ngrams?ngramsType="
<> showTabType' t
<> maybe "" (\x -> "&list=" <> show x) listId
<> foldMap (\x -> "&listType=" <> show x) termList
sessionPath (R.PostNgramsChartsAsync i) =
sessionPath $ R.NodeAPI Node i $ "ngrams/async/charts/update"
sessionPath (R.NodeAPI nt i p) = nodeTypePath nt
<> (maybe "" (\i' -> "/" <> show i') i)
<> (if p == "" then "" else "/" <> p)
sessionPath (R.TreeFirstLevel nId p) = nodeTypePath Tree
<> (maybe "" (\nId' -> "/" <> show nId') nId) <> "/first-level" <> p
sessionPath (R.Search {listId, limit, offset, orderBy} Nothing) =
sessionPath $ R.NodeAPI Corpus Nothing
$ "search?list_id=" <> show listId
<> offsetUrl offset
<> limitUrl limit
<> orderUrl orderBy
sessionPath (R.Search {listId, limit, offset, orderBy} (Just corpusId)) =
sessionPath $ R.NodeAPI Corpus (Just corpusId)
$ "search?list_id=" <> show listId
<> offsetUrl offset
<> limitUrl limit
<> orderUrl orderBy
-- sessionPath (R.Search {listId, limit, offset, orderBy} (Just corpusId)) =
-- "search/" <> (show corpusId) <> "/list/" <> (show listId) <> "?"
-- <> offsetUrl offset
-- <> limitUrl limit
-- <> orderUrl orderBy
sessionPath (R.CorpusMetrics { listId, limit, tabType} i) =
sessionPath $ R.NodeAPI Corpus i
$ "metrics"
<> "?ngrams=" <> show listId
<> "&ngramsType=" <> showTabType' tabType
<> maybe "" limitUrl limit
sessionPath (R.CorpusMetricsHash { listId, tabType} i) =
sessionPath $ R.NodeAPI Corpus i
$ "metrics/hash"
<> "?ngrams=" <> show listId
<> "&ngramsType=" <> showTabType' tabType
-- TODO fix this url path
sessionPath (R.Chart {chartType, limit, listId, tabType} i) =
sessionPath $ R.NodeAPI Corpus i
$ show chartType
<> "?ngramsType=" <> showTabType' tabType
<> "&listType=" <> show MapTerm -- listId
<> defaultListAddMaybe listId
where
limitPath = case limit of
Just li -> "&limit=" <> show li
Nothing -> ""
-- <> maybe "" limitUrl limit
sessionPath (R.ChartHash { chartType, listId, tabType } i) =
sessionPath $ R.NodeAPI Corpus i
$ show chartType
<> "/hash?ngramsType=" <> showTabType' tabType
<> "&listType=" <> show MapTerm -- listId
<> defaultListAddMaybe listId
-- sessionPath (R.NodeAPI (NodeContact s a i) i) = sessionPath $ "annuaire/" <> show a <> "/contact/" <> show i
------- misc routing stuff
defaultList :: Int -> String
defaultList n = if n == 0 then "" else ("list=" <> show n)
defaultListAdd :: Int -> String
defaultListAdd n = "&" <> defaultList n
defaultListAddMaybe :: Maybe Int -> String
defaultListAddMaybe Nothing = ""
defaultListAddMaybe (Just l) = "&list=" <> show l
limitUrl :: Limit -> String
limitUrl l = "&limit=" <> show l
offsetUrl :: Offset -> String
offsetUrl o = "&offset=" <> show o
orderUrl :: forall a. Show a => Maybe a -> String
orderUrl = maybe "" (\x -> "&order=" <> show x)
orderByUrl :: forall a. Show a => Maybe a -> String
orderByUrl = maybe "" (\x -> "&orderBy=" <> show x)
-- nodeTypePath :: NodeType -> Path
-- nodeTypePath = NodeAPI
-- instance ToUrl NodeType where
-- toUrl ec e nt i = toUrl ec e (NodeAPI nt) i
-- instance ToUrl Path where
-- toUrl ec e p i = doUrl base path params
-- where
-- base = endBaseUrl e ec
-- path = endPathUrl e ec p i
-- params = ""
------------------------------------------------------------
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Hooks.purs 0000664 0000000 0000000 00000001026 14111104351 0030411 0 ustar 00root root 0000000 0000000 module Gargantext.Hooks ( useHashRouter ) where
import Prelude (Unit, ($))
import Reactix as R
import Routing.Match (Match)
import Routing.Hash (matches)
import Toestand as T
-- | Sets up the hash router so it writes the route to the given cell.
-- | Note: if it gets sent to an unrecognised url, it will quietly
-- | drop the change.
useHashRouter :: forall r c. T.Write c r => Match r -> c -> R.Hooks Unit
useHashRouter routes cell = R.useEffectOnce $ matches routes h where
h _old new = T.write_ new cell
-- useSession cell =
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Hooks/ 0000775 0000000 0000000 00000000000 14111104351 0027477 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Hooks/Loader.purs 0000664 0000000 0000000 00000014101 14111104351 0031615 0 ustar 00root root 0000000 0000000 module Gargantext.Hooks.Loader where
import Gargantext.Prelude
import Data.Array as A
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..), isJust, maybe)
import Data.Newtype (class Newtype)
import Effect (Effect)
import Effect.Aff (Aff, launchAff_, throwError)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Gargantext.Components.App.Data (Boxes)
import Gargantext.Components.LoadingSpinner (loadingSpinner)
import Gargantext.Config.REST (RESTError)
import Gargantext.Config.Utils (handleRESTError)
import Gargantext.Types (FrontendError(..))
import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.Crypto (Hash)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Simple.JSON as JSON
import Toestand (Box)
import Toestand as T
here :: R2.Here
here = R2.here "Gargantext.Hooks.Loader"
cacheName :: String
cacheName = "cache-api-loader"
clearCache :: Unit -> Aff Unit
clearCache _ = GUC.delete $ GUC.CacheName cacheName
type UseLoader path state =
( errorHandler :: RESTError -> Effect Unit
, loader :: path -> Aff (Either RESTError state)
, path :: path
, render :: state -> R.Element
)
useLoader :: forall path st. Eq path => Eq st
=> Record (UseLoader path st)
-> R.Hooks R.Element
useLoader { errorHandler, loader: loader', path, render } = do
state <- T.useBox Nothing
useLoaderEffect { errorHandler, loader: loader', path, state: state }
pure $ loader { path, render, state } []
type LoaderProps path st =
( path :: path
, render :: st -> R.Element
, state :: T.Box (Maybe st) )
loader :: forall path st. Eq path => Eq st => R2.Component (LoaderProps path st)
loader = R.createElement loaderCpt
loaderCpt :: forall path st. Eq path => Eq st => R.Component (LoaderProps path st)
loaderCpt = here.component "loader" cpt
where
cpt { render, state } _ = do
state' <- T.useLive T.unequal state
pure $ maybe (loadingSpinner {}) render state'
type UseLoaderEffect path state =
( errorHandler :: RESTError -> Effect Unit
, loader :: path -> Aff (Either RESTError state)
, path :: path
, state :: T.Box (Maybe state)
)
useLoaderEffect :: forall st path. Eq path => Eq st
=> Record (UseLoaderEffect path st)
-> R.Hooks Unit
useLoaderEffect { errorHandler, loader: loader', path, state } = do
state' <- T.useLive T.unequal state
oPath <- R.useRef path
R.useEffect' $ do
path' <- R.readRefM oPath
if (path' == path) && (isJust state')
then pure $ R.nothing
else do
R.setRef oPath path
R2.affEffect "G.H.Loader.useLoaderEffect" $ do
l <- loader' path
case l of
Left err -> liftEffect $ errorHandler err
Right l' -> liftEffect $ T.write_ (Just l') state
newtype HashedResponse a = HashedResponse { hash :: Hash, value :: a }
derive instance Generic (HashedResponse a) _
derive instance Newtype (HashedResponse a) _
derive newtype instance JSON.ReadForeign a => JSON.ReadForeign (HashedResponse a)
derive newtype instance JSON.WriteForeign a => JSON.WriteForeign (HashedResponse a)
type LoaderWithCacheAPIProps path res ret =
( boxes :: Boxes
, cacheEndpoint :: path -> Aff (Either RESTError Hash)
, handleResponse :: HashedResponse res -> ret
, mkRequest :: path -> GUC.Request
, path :: path
, renderer :: ret -> R.Element
)
useLoaderWithCacheAPI :: forall path res ret.
Eq ret => Eq path => JSON.ReadForeign res =>
Record (LoaderWithCacheAPIProps path res ret)
-> R.Hooks R.Element
useLoaderWithCacheAPI { boxes
, cacheEndpoint
, handleResponse
, mkRequest
, path
, renderer } = do
state <- T.useBox Nothing
state' <- T.useLive T.unequal state
useCachedAPILoaderEffect { boxes
, cacheEndpoint
, handleResponse
, mkRequest
, path
, state }
pure $ maybe (loadingSpinner {}) renderer state'
type LoaderWithCacheAPIEffectProps path res ret = (
boxes :: Boxes
, cacheEndpoint :: path -> Aff (Either RESTError Hash)
, handleResponse :: HashedResponse res -> ret
, mkRequest :: path -> GUC.Request
, path :: path
, state :: T.Box (Maybe ret)
)
useCachedAPILoaderEffect :: forall path res ret.
Eq ret => Eq path => JSON.ReadForeign res =>
Record (LoaderWithCacheAPIEffectProps path res ret)
-> R.Hooks Unit
useCachedAPILoaderEffect { boxes: { errors }
, cacheEndpoint
, handleResponse
, mkRequest
, path
, state } = do
state' <- T.useLive T.unequal state
oPath <- R.useRef path
R.useEffect' $ do
if (R.readRef oPath == path) && (isJust state') then
pure unit
else do
R.setRef oPath path
let req = mkRequest path
-- log2 "[useCachedLoader] mState" mState
launchAff_ $ do
cache <- GUC.openCache $ GUC.CacheName cacheName
-- TODO Parallelize?
hr@(HashedResponse { hash }) <- GUC.cachedJson cache req
eCacheReal <- cacheEndpoint path
handleRESTError errors eCacheReal $ \cacheReal -> do
val <- if hash == cacheReal then
pure hr
else do
_ <- GUC.deleteReq cache req
hr'@(HashedResponse { hash: h }) <- GUC.cachedJson cache req
if h == cacheReal then
pure hr'
else do
let err = "[Hooks.Loader] Fetched clean cache but hashes don't match: " <> h <> " != " <> cacheReal
liftEffect $ T.modify_ (A.cons $ FStringError { error: err }) errors
throwError $ error err
liftEffect $ do
T.write_ (Just $ handleResponse val) state
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Hooks/Sigmax.purs 0000664 0000000 0000000 00000022233 14111104351 0031644 0 ustar 00root root 0000000 0000000 module Gargantext.Hooks.Sigmax
where
import Prelude
( Unit, bind, discard, flip, map, not, pure, unit
, ($), (&&), (*>), (<<<), (<>), (>>=))
import Data.Array as A
import Data.Either (either)
import Data.Foldable (sequence_, foldl)
import Data.Map as Map
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable)
import Data.Sequence (Seq)
import Data.Sequence as Seq
import Data.Set as Set
import Data.Traversable (traverse_)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested((/\))
import DOM.Simple.Console (log, log2)
import DOM.Simple.Types (Element)
import Effect (Effect)
import Effect.Class.Console (error)
import Effect.Timer (TimeoutId, clearTimeout)
import FFI.Simple ((.=))
import Reactix as R
import Toestand as T
import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Hooks.Sigmax.Types as ST
import Gargantext.Utils.Reactix as R2
type Sigma =
{ sigma :: R.Ref (Maybe Sigma.Sigma)
-- TODO is Seq in cleanup really necessary?
, cleanup :: R.Ref (Seq (Effect Unit))
}
type Data n e = { graph :: R.Ref (ST.Graph n e) }
initSigma :: R.Hooks Sigma
initSigma = do
s <- R2.nothingRef
c <- R.useRef Seq.empty
pure { sigma: s, cleanup: c }
readSigma :: Sigma -> Maybe Sigma.Sigma
readSigma sigma = R.readRef sigma.sigma
writeSigma :: Sigma -> Maybe Sigma.Sigma -> Effect Unit
writeSigma sigma = R.setRef sigma.sigma
-- | Pushes to the back of the cleanup sequence. Cleanup happens
-- | *before* sigma is destroyed
cleanupLast :: Sigma -> Effect Unit -> Effect Unit
cleanupLast sigma = R.setRef sigma.cleanup <<< Seq.snoc existing
where existing = R.readRef sigma.cleanup
-- | Pushes to the front of the cleanup sequence. Cleanup happens
-- | *before* sigma is destroyed
cleanupFirst :: Sigma -> Effect Unit -> Effect Unit
cleanupFirst sigma =
R.setRef sigma.cleanup <<< (flip Seq.cons) (R.readRef sigma.cleanup)
cleanupSigma :: Sigma -> String -> Effect Unit
cleanupSigma sigma context = traverse_ kill (readSigma sigma)
where
kill sig = runCleanups *> killSigma *> emptyOut
where -- close over sig
killSigma = Sigma.killSigma sig >>= report
runCleanups = sequence_ (R.readRef sigma.cleanup)
emptyOut = writeSigma sigma Nothing *> R.setRef sigma.cleanup Seq.empty
report = either (log2 errorMsg) (\_ -> log successMsg)
prefix = "[" <> context <> "] "
errorMsg = prefix <> "Error killing sigma:"
successMsg = prefix <> "Killed sigma"
refreshData :: forall n e. Sigma.Sigma -> Sigma.Graph n e -> Effect Unit
refreshData sigma graph
= log clearingMsg
*> Sigma.clear sigmaGraph
*> log readingMsg
*> Sigma.graphRead sigmaGraph graph
>>= either (log2 errorMsg) refresh
where
sigmaGraph = Sigma.graph sigma
refresh _ = log refreshingMsg *> Sigma.refresh sigma
clearingMsg = "[refreshData] Clearing existing graph data"
readingMsg = "[refreshData] Reading graph data"
refreshingMsg = "[refreshData] Refreshing graph"
errorMsg = "[refreshData] Error reading graph data:"
sigmafy :: forall n e. ST.Graph n e -> Sigma.Graph n e
sigmafy (ST.Graph g) = {nodes,edges}
where
nodes = A.fromFoldable g.nodes
edges = A.fromFoldable g.edges
dependOnSigma :: Sigma -> String -> (Sigma.Sigma -> Effect Unit) -> Effect Unit
dependOnSigma sigma notFoundMsg f = do
case readSigma sigma of
Nothing -> log notFoundMsg
Just sig -> f sig
dependOnContainer :: R.Ref (Nullable Element) -> String -> (Element -> Effect Unit) -> Effect Unit
dependOnContainer container notFoundMsg f = do
case R.readNullableRef container of
Nothing -> log notFoundMsg
Just c -> f c
-- Effectful versions of the above code
-- | Effect for handling pausing FA via state changes. We need this because
-- | pausing can be done not only via buttons but also from the initial
-- | setTimer.
handleForceAtlas2Pause :: forall settings. R.Ref Sigma -> T.Box ST.ForceAtlasState -> R.Ref (Maybe TimeoutId) -> settings -> Effect Unit
handleForceAtlas2Pause sigmaRef forceAtlasState mFAPauseRef settings = do
let sigma = R.readRef sigmaRef
toggled <- T.read forceAtlasState
dependOnSigma sigma "[handleForceAtlas2Pause] sigma: Nothing" $ \s -> do
let isFARunning = Sigma.isForceAtlas2Running s
case Tuple toggled isFARunning of
Tuple ST.InitialRunning false -> do
Sigma.restartForceAtlas2 s settings
Tuple ST.Running false -> do
Sigma.restartForceAtlas2 s settings
case R.readRef mFAPauseRef of
Nothing -> pure unit
Just timeoutId -> clearTimeout timeoutId
Tuple ST.Paused true -> do
Sigma.stopForceAtlas2 s
_ -> pure unit
setEdges :: Sigma.Sigma -> Boolean -> Effect Unit
setEdges sigma val = do
let settings = {
drawEdges: val
, drawEdgeLabels: val
, hideEdgesOnMove: not val
}
Sigma.setSettings sigma settings
updateEdges :: Sigma.Sigma -> ST.EdgesMap -> Effect Unit
updateEdges sigma edgesMap = do
Sigma.forEachEdge (Sigma.graph sigma) \e -> do
let mTEdge = Map.lookup e.id edgesMap
case mTEdge of
Nothing -> error $ "Edge id " <> e.id <> " not found in edgesMap"
(Just {color: tColor, hidden: tHidden}) -> do
_ <- pure $ (e .= "color") tColor
_ <- pure $ (e .= "hidden") tHidden
pure unit
--Sigma.refresh sigma
updateNodes :: Sigma.Sigma -> ST.NodesMap -> Effect Unit
updateNodes sigma nodesMap = do
Sigma.forEachNode (Sigma.graph sigma) \n -> do
let mTNode = Map.lookup n.id nodesMap
case mTNode of
Nothing -> error $ "Node id " <> n.id <> " not found in nodesMap"
(Just { borderColor: tBorderColor
, color: tColor
, equilateral: tEquilateral
, hidden: tHidden
, type: tType }) -> do
_ <- pure $ (n .= "borderColor") tBorderColor
_ <- pure $ (n .= "color") tColor
_ <- pure $ (n .= "equilateral") tEquilateral
_ <- pure $ (n .= "hidden") tHidden
_ <- pure $ (n .= "type") tType
pure unit
--Sigma.refresh sigma
-- | Toggles item visibility in the selected set
multiSelectUpdate :: ST.NodeIds -> ST.NodeIds -> ST.NodeIds
multiSelectUpdate new selected = foldl fld selected new
where
fld selectedAcc item =
if Set.member item selectedAcc then
Set.delete item selectedAcc
else
Set.insert item selectedAcc
bindSelectedNodesClick :: Sigma.Sigma -> T.Box ST.NodeIds -> R.Ref Boolean -> Effect Unit
bindSelectedNodesClick sigma selectedNodeIds multiSelectEnabledRef =
Sigma.bindClickNodes sigma $ \nodes -> do
let multiSelectEnabled = R.readRef multiSelectEnabledRef
let nodeIds = Set.fromFoldable $ map _.id nodes
if multiSelectEnabled then
T.modify_ (multiSelectUpdate nodeIds) selectedNodeIds
else
T.write_ nodeIds selectedNodeIds
bindSelectedEdgesClick :: R.Ref Sigma -> R.State ST.EdgeIds -> Effect Unit
bindSelectedEdgesClick sigmaRef (_ /\ setEdgeIds) =
dependOnSigma (R.readRef sigmaRef) "[graphCpt] no sigma" $ \sigma -> do
Sigma.bindClickEdge sigma $ \edge -> do
setEdgeIds \eids ->
if Set.member edge.id eids then
Set.delete edge.id eids
else
Set.insert edge.id eids
selectorWithSize :: Sigma.Sigma -> Int -> Effect Unit
selectorWithSize sigma size = do
pure unit
performDiff :: Sigma.Sigma -> ST.SGraph -> Effect Unit
performDiff sigma g = do
if (Seq.null addEdges) && (Seq.null addNodes) && (Set.isEmpty removeEdges) && (Set.isEmpty removeNodes) then
pure unit
else do
traverse_ (Sigma.addNode sigmaGraph) addNodes
traverse_ (Sigma.addEdge sigmaGraph) addEdges
traverse_ (Sigma.removeEdge sigmaGraph) removeEdges
traverse_ (Sigma.removeNode sigmaGraph) removeNodes
Sigma.refresh sigma
Sigma.killForceAtlas2 sigma
where
sigmaGraph = Sigma.graph sigma
sigmaEdgeIds = Sigma.sigmaEdgeIds sigmaGraph
sigmaNodeIds = Sigma.sigmaNodeIds sigmaGraph
{add: Tuple addEdges addNodes, remove: Tuple removeEdges removeNodes} = ST.sigmaDiff sigmaEdgeIds sigmaNodeIds g
-- DEPRECATED
markSelectedEdges :: Sigma.Sigma -> ST.EdgeIds -> ST.EdgesMap -> Effect Unit
markSelectedEdges sigma selectedEdgeIds graphEdges = do
Sigma.forEachEdge (Sigma.graph sigma) \e -> do
case Map.lookup e.id graphEdges of
Nothing -> error $ "Edge id " <> e.id <> " not found in graphEdges map"
Just {color} -> do
let newColor =
if Set.member e.id selectedEdgeIds then
"#ff0000"
else
color
_ <- pure $ (e .= "color") newColor
pure unit
Sigma.refresh sigma
markSelectedNodes :: Sigma.Sigma -> ST.NodeIds -> ST.NodesMap -> Effect Unit
markSelectedNodes sigma selectedNodeIds graphNodes = do
Sigma.forEachNode (Sigma.graph sigma) \n -> do
case Map.lookup n.id graphNodes of
Nothing -> error $ "Node id " <> n.id <> " not found in graphNodes map"
Just {color} -> do
let newColor =
if Set.member n.id selectedNodeIds then
"#ff0000"
else
color
_ <- pure $ (n .= "color") newColor
pure unit
Sigma.refresh sigma
getEdges :: Sigma.Sigma -> Effect (Array (Record ST.Edge))
getEdges sigma = Sigma.getEdges sigma
getNodes :: Sigma.Sigma -> Effect (Array (Record ST.Node))
getNodes sigma = Sigma.getNodes sigma
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Hooks/Sigmax/ 0000775 0000000 0000000 00000000000 14111104351 0030727 5 ustar 00root root 0000000 0000000 Sigma.js 0000664 0000000 0000000 00000015022 14111104351 0032246 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Hooks/Sigmax 'use strict';
const sigma = require('sigma/src/garg.js').sigma;
if (typeof window !== 'undefined') {
window.sigma = sigma;
}
const CustomShapes = require('sigma/plugins/garg.js').init(sigma, window).customShapes;
require('sigma/src/utils/sigma.utils.js').init(sigma);
// Black circle around a node
(function() {
var originalDef = sigma.canvas.nodes.def;
sigma.canvas.nodes.def = (node, context, settings) => {
var prefix = settings('prefix') || '';
originalDef(node, context, settings);
context.strokeStyle = '#000';
context.lineWidth = 1;
context.beginPath();
context.arc(
node[prefix + 'x'],
node[prefix + 'y'],
node[prefix + 'size'],
0,
Math.PI * 2,
true
);
context.stroke();
}
})()
sigma.canvas.nodes.selected = (node, context, settings) => {
// hack
// We need to temporarily set node.type to 'def'. This is for 2 reasons
// 1. Make it render as a normal node
// 2. Avoid infinite recursion (hovers.def calls node renderer and we would end up here back
// again with node.type = 'hovered')
node.type = 'def';
sigma.canvas.hovers.def(node, context, settings);
node.type = 'selected';
//console.log('hovers, settings:', settings);
};
CustomShapes.init();
let sigmaMouseSelector = (sigma, options) => {
sigma.plugins = sigma.plugins || {};
sigma.plugins.mouseSelector = (s, renderer) => {
var _self = this;
var _offset = null;
const _s = s;
const _renderer = renderer;
const _container = _renderer.container;
//renderer.initDOM('canvas', 'mouseSelector');
// A hack to force resize to be called (there is a width/height equality
// check which can't be escaped in any other way).
//renderer.resize(renderer.width - 1, renderer.height - 1);
//renderer.resize(renderer.width + 1, renderer.height + 1);
const _context = _renderer.contexts.mouseSelector;
// These are used to prevent using the 'click' event when in fact this was a drag
let _clickPositionX = null;
let _clickPositionY = null;
let _isValidClick = false;
_container.onmousemove = function(e) { return mouseMove(e); };
_context.canvas.onclick = function(e) { return onClick(e); };
_container.onmousedown = function(e) { return onMouseDown(e); }
_container.onmouseup = function(e) { return onMouseUp(e); }
s.bind('click', function(e) { return onClick(e); })
// The mouseSelector canvas will pass its events down to the "mouse" canvas.
_context.canvas.style.pointerEvents = 'none';
s.bind('kill', () => _self.unbindAll());
this.unbindAll = () => {
console.log('[sigmaMouseSelector] unbinding');
_container.onclick = null;
_context.canvas.onmousemove = null;
_container.onmousedown = null;
_container.onmouseup = null;
}
const onMouseDown = (e) => {
_clickPositionX = e.clientX;
_clickPositionY = e.clientY;
}
const onMouseUp = (e) => {
// Prevent triggering click when in fact this was a drag
if ((_clickPositionX != e.clientX) || (_clickPositionY != e.clientY)) {
_clickPositionX = null;
_clickPositionY = null;
_isValidClick = false;
} else {
_isValidClick = true;
}
}
const mouseMove = (e) => {
const size = _s.settings('mouseSelectorSize') || 3;
const x = e.clientX + document.body.scrollLeft - _offset.left - size/2;
const y = e.clientY + document.body.scrollTop - _offset.top - size/2;
_context.clearRect(0, 0, _context.canvas.width, _context.canvas.height);
_context.fillStyle = 'rgba(91, 192, 222, 0.7)';
_context.beginPath();
_context.arc(
x,
y,
size,
0,
Math.PI * 2,
true
);
_context.closePath();
_context.fill();
}
const onClick = (e) => {
if(!_isValidClick) {
return;
}
const size = _s.settings('mouseSelectorSize') || 3;
const x = e.data.clientX + document.body.scrollLeft - _offset.left - size/2;
const y = e.data.clientY + document.body.scrollTop - _offset.top - size/2;
const prefix = _renderer.options.prefix;
//console.log('[sigmaMouseSelector] clicked', e, x, y, size);
let nodes = [];
_s.graph.nodes().forEach((node) => {
const nodeX = node[prefix + 'x'];
const nodeY = node[prefix + 'y'];
if(sigma.utils.getDistance(x, y, nodeX, nodeY) <= size) {
nodes.push(node);
}
});
//console.log('[sigmaMouseSelector] nodes', nodes);
_renderer.dispatchEvent('clickNodes', {
node: nodes,
captor: e.data
})
_clickPositionX = null;
_clickPositionY = null;
}
const calculateOffset = (element) => {
var style = window.getComputedStyle(element);
var getCssProperty = function(prop) {
return parseInt(style.getPropertyValue(prop).replace('px', '')) || 0;
};
return {
left: element.getBoundingClientRect().left + getCssProperty('padding-left'),
top: element.getBoundingClientRect().top + getCssProperty('padding-top')
};
};
_offset = calculateOffset(renderer.container);
}
}
sigmaMouseSelector(sigma);
function _sigma(left, right, opts) {
try {
return right(new sigma(opts));
} catch(e) {
return left(e);
}
}
function addRenderer(left, right, sigma, renderer) {
try {
return right(sigma.addRenderer(renderer));
} catch(e) {
return left(e);
}
}
function bindMouseSelectorPlugin(left, right, sig) {
try {
return right(sigma.plugins.mouseSelector(sig, sig.renderers[0]));
} catch(e) {
console.log('[bindMouseSelectorPlugin] error', e);
return left(e);
}
}
function bind(sigma, event, handler) { sigma.bind(event, handler); }
function takeScreenshot(sigma) {
let c = sigma.renderers[0].container;
let edges = c.getElementsByClassName('sigma-edges')[0];
let scene = c.getElementsByClassName('sigma-scene')[0];
// let sceneCtx = scene.getContext('2d');
// sceneCtx.globalAlpha = 1;
// sceneCtx.drawImage(edges, 0, 0);
// return scene.toDataURL('image/png');
let edgesCtx = edges.getContext('2d');
edgesCtx.globalAlpha = 1;
edgesCtx.drawImage(scene, 0, 0);
return edges.toDataURL('image/png');
}
function getEdges(sigma) {
return sigma.graph.edges();
}
function getNodes(sigma) {
return sigma.graph.nodes();
}
exports._sigma = _sigma;
exports._addRenderer = addRenderer;
exports._bindMouseSelectorPlugin = bindMouseSelectorPlugin;
exports._bind = bind;
exports._takeScreenshot = takeScreenshot;
exports._getEdges = getEdges;
exports._getNodes = getNodes;
Sigma.purs 0000664 0000000 0000000 00000027623 14111104351 0032635 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Hooks/Sigmax module Gargantext.Hooks.Sigmax.Sigma where
import Prelude
import DOM.Simple.Types (Element)
import Data.Array as A
import Data.Either (Either(..))
import Data.Maybe (Maybe)
import Data.Sequence as Seq
import Data.Set as Set
import Data.Traversable (traverse_)
import Effect (Effect)
import Effect.Exception as EEx
import Effect.Timer (setTimeout)
import Effect.Uncurried (EffectFn1, EffectFn3, EffectFn4, mkEffectFn1, runEffectFn1, runEffectFn3, runEffectFn4)
import FFI.Simple ((..), (...), (.=))
import Foreign.Object as Object
import Type.Row (class Union)
import Gargantext.Hooks.Sigmax.Types as Types
-- | Type representing a sigmajs instance
foreign import data Sigma :: Type
-- | Type representing `sigma.graph`
foreign import data SigmaGraph :: Type
type NodeRequiredProps = ( id :: Types.NodeId )
type EdgeRequiredProps = ( id :: Types.EdgeId, source :: Types.NodeId, target :: Types.NodeId )
class NodeProps (all :: Row Type) (extra :: Row Type) | all -> extra
class EdgeProps (all :: Row Type) (extra :: Row Type) | all -> extra
instance nodeProps
:: Union NodeRequiredProps extra all
=> NodeProps all extra
instance edgeProps
:: Union EdgeRequiredProps extra all
=> EdgeProps all extra
type Graph n e = { nodes :: Array {|n}, edges :: Array {|e} }
type SigmaOpts s = { settings :: s }
-- | Initialize sigmajs.
sigma :: forall opts err. SigmaOpts opts -> Effect (Either err Sigma)
sigma = runEffectFn3 _sigma Left Right
-- | Kill a sigmajs instance.
kill :: Sigma -> Effect Unit
kill s = pure $ s ... "kill" $ []
-- | Call the `refresh()` method on a sigmajs instance.
refresh :: Sigma -> Effect Unit
refresh s = pure $ s ... "refresh" $ []
-- | Type representing a sigmajs renderer.
foreign import data Renderer :: Type
type RendererType = String
--makeRenderer :: forall props. RendererType -> Element -> props -> Renderer
--makeRenderer type_ container props =
-- {
-- "type": type_
-- , container
-- | props
-- }
-- | Call the `addRenderer` method on a sigmajs instance.
--addRenderer :: forall err. Sigma -> Renderer -> Effect (Either err Unit)
addRenderer :: forall r err. Sigma -> r -> Effect (Either err Unit)
addRenderer = runEffectFn4 _addRenderer Left Right
-- | Initialize the mouse selector plugin. This allows for custom bindings to mouse events.
bindMouseSelectorPlugin :: forall err. Sigma -> Effect (Either err Unit)
bindMouseSelectorPlugin = runEffectFn3 _bindMouseSelectorPlugin Left Right
-- | Call `killRenderer` on a sigmajs instance.
killRenderer :: forall r. Sigma -> r -> Effect (Either EEx.Error Unit)
killRenderer s r = EEx.try $ pure $ s ... "killRenderer" $ [ r ]
-- | Get `renderers` of a sigmajs instance.
renderers :: Sigma -> Array Renderer
renderers s = s .. "renderers" :: Array Renderer
-- | Get the `container` of a sigmajs renderer.
rendererContainer :: Renderer -> Element
rendererContainer r = r .. "container"
-- | Return the container of first renderer in sigmajs instance's `renderers` list.
getRendererContainer :: Sigma -> Maybe Element
getRendererContainer s = rendererContainer <$> mContainer
where
mContainer = A.head $ renderers s
-- | Set the container of first renderer in sigmajs instance's `renderers` list.
setRendererContainer :: Renderer -> Element -> Effect Unit
setRendererContainer r el = do
_ <- pure $ (r .= "container") el
pure unit
-- | Call the `kill()` method on a sigmajs instance.
killSigma :: Sigma -> Effect (Either EEx.Error Unit)
killSigma s = EEx.try $ pure $ s ... "kill" $ []
-- | Get the `.graph` object from a sigmajs instance.
graph :: Sigma -> SigmaGraph
graph s = s .. "graph" :: SigmaGraph
-- | Read graph into a sigmajs instance.
graphRead :: forall nodeExtra node edgeExtra edge. NodeProps nodeExtra node => EdgeProps edgeExtra edge => SigmaGraph -> Graph node edge -> Effect (Either EEx.Error Unit)
graphRead sg g = EEx.try $ pure $ sg ... "read" $ [ g ]
-- | Clear a sigmajs graph.
clear :: SigmaGraph -> Effect Unit
clear sg = pure $ sg ... "clear" $ []
-- | Call `sigma.bind(event, handler)` on a sigmajs instance.
bind_ :: forall e. Sigma -> String -> (e -> Effect Unit) -> Effect Unit
bind_ s e h = runEffectFn3 _bind s e (mkEffectFn1 h)
-- | Generic function to bind a sigmajs event for edges.
bindEdgeEvent :: Sigma -> String -> (Record Types.Edge -> Effect Unit) -> Effect Unit
bindEdgeEvent s ev f = bind_ s ev $ \e -> do
let edge = e .. "data" .. "edge" :: Record Types.Edge
f edge
-- | Generic function to bind a sigmajs event for nodes.
bindNodeEvent :: Sigma -> String -> (Record Types.Node -> Effect Unit) -> Effect Unit
bindNodeEvent s ev f = bind_ s ev $ \e -> do
let node = e .. "data" .. "node" :: Record Types.Node
f node
-- | Call `sigma.unbind(event)` on a sigmajs instance.
unbind_ :: Sigma -> String -> Effect Unit
unbind_ s e = pure $ s ... "unbind" $ [e]
edges_ :: SigmaGraph -> Array (Record Types.Edge)
edges_ sg = sg ... "edges" $ [] :: Array (Record Types.Edge)
nodes_ :: SigmaGraph -> Array (Record Types.Node)
nodes_ sg = sg ... "nodes" $ [] :: Array (Record Types.Node)
-- | Call `sigmaGraph.edges()` on a sigmajs graph instance.
edges :: SigmaGraph -> Seq.Seq (Record Types.Edge)
edges = Seq.fromFoldable <<< edges_
-- | Call `sigmaGraph.nodes()` on a sigmajs graph instance.
nodes :: SigmaGraph -> Seq.Seq (Record Types.Node)
nodes = Seq.fromFoldable <<< nodes_
-- | Fetch ids of graph edges in a sigmajs instance.
sigmaEdgeIds :: SigmaGraph -> Types.EdgeIds
sigmaEdgeIds sg = Set.fromFoldable edgeIds
where
edgeIds = _.id <$> edges sg
-- | Fetch ids of graph nodes in a sigmajs instance.
sigmaNodeIds :: SigmaGraph -> Types.NodeIds
sigmaNodeIds sg = Set.fromFoldable nodeIds
where
nodeIds = _.id <$> nodes sg
-- | Call `addEdge` on a sigmajs graph.
addEdge :: SigmaGraph -> Record Types.Edge -> Effect Unit
addEdge sg e = pure $ sg ... "addEdge" $ [e]
-- | Call `removeEdge` on a sigmajs graph.
removeEdge :: SigmaGraph -> String -> Effect Unit
removeEdge sg eId = pure $ sg ... "dropEdge" $ [eId]
--removeEdge = runEffectFn2 _removeEdge
-- | Call `addNode` on a sigmajs graph.
addNode :: SigmaGraph -> Record Types.Node -> Effect Unit
addNode sg n = pure $ sg ... "addNode" $ [n]
-- | Call `removeNode` on a sigmajs graph.
removeNode :: SigmaGraph -> String -> Effect Unit
removeNode sg nId = pure $ sg ... "dropNode" $ [nId]
-- | Iterate over all edges in a sigmajs graph.
forEachEdge :: SigmaGraph -> (Record Types.Edge -> Effect Unit) -> Effect Unit
forEachEdge sg f = traverse_ f (edges sg)
-- | Iterate over all nodes in a sigmajs graph.
forEachNode :: SigmaGraph -> (Record Types.Node -> Effect Unit) -> Effect Unit
forEachNode sg f = traverse_ f (nodes sg)
-- | Bind a `clickNode` event.
bindClickNode :: Sigma -> (Record Types.Node -> Effect Unit) -> Effect Unit
bindClickNode s f = bindNodeEvent s "clickNode" f
-- | Unbind a `clickNode` event.
unbindClickNode :: Sigma -> Effect Unit
unbindClickNode s = unbind_ s "clickNode"
-- | Bind a `clickNodes` event.
bindClickNodes :: Sigma -> (Array (Record Types.Node) -> Effect Unit) -> Effect Unit
bindClickNodes s f = bind_ s "clickNodes" $ \e -> do
let ns = e .. "data" .. "node" :: Array (Record Types.Node)
f ns
-- | Unbind a `clickNodes` event.
unbindClickNodes :: Sigma -> Effect Unit
unbindClickNodes s = unbind_ s "clickNodes"
-- | Bind a `overNode` event.
bindOverNode :: Sigma -> (Record Types.Node -> Effect Unit) -> Effect Unit
bindOverNode s f = bindNodeEvent s "overNode" f
-- | Bind a `clickEdge` event.
bindClickEdge :: Sigma -> (Record Types.Edge -> Effect Unit) -> Effect Unit
bindClickEdge s f = bindEdgeEvent s "clickEdge" f
-- | Unbind a `clickEdge` event.
unbindClickEdge :: Sigma -> Effect Unit
unbindClickEdge s = unbind_ s "clickEdge"
-- | Bind a `overEdge` event.
bindOverEdge :: Sigma -> (Record Types.Edge -> Effect Unit) -> Effect Unit
bindOverEdge s f = bindEdgeEvent s "overEdge" f
-- | Call `settings(s)` on a sigmajs instance.
setSettings :: forall settings. Sigma -> settings -> Effect Unit
setSettings s settings = do
_ <- pure $ s ... "settings" $ [ settings ]
refresh s
-- | Start forceAtlas2 on a sigmajs instance.
startForceAtlas2 :: forall settings. Sigma -> settings -> Effect Unit
startForceAtlas2 s settings = pure $ s ... "startForceAtlas2" $ [ settings ]
-- | Restart forceAtlas2 on a sigmajs instance.
restartForceAtlas2 :: forall settings. Sigma -> settings -> Effect Unit
restartForceAtlas2 s settings = startForceAtlas2 s settings
-- | Stop forceAtlas2 on a sigmajs instance.
stopForceAtlas2 :: Sigma -> Effect Unit
stopForceAtlas2 s = pure $ s ... "stopForceAtlas2" $ []
-- | Kill forceAtlas2 on a sigmajs instance.
killForceAtlas2 :: Sigma -> Effect Unit
killForceAtlas2 s = pure $ s ... "killForceAtlas2" $ []
-- | Return whether forceAtlas2 is running on a sigmajs instance.
isForceAtlas2Running :: Sigma -> Boolean
isForceAtlas2Running s = s ... "isForceAtlas2Running" $ [] :: Boolean
-- | Refresh forceAtlas2 (with a `setTimeout` hack as it seems it doesn't work
-- | otherwise).
refreshForceAtlas :: forall settings. Sigma -> settings -> Effect Unit
refreshForceAtlas s settings = do
let isRunning = isForceAtlas2Running s
if isRunning then
pure unit
else do
_ <- setTimeout 100 $ do
restartForceAtlas2 s settings
_ <- setTimeout 100 $
stopForceAtlas2 s
pure unit
pure unit
newtype SigmaEasing = SigmaEasing String
sigmaEasing ::
{ linear :: SigmaEasing
, quadraticIn :: SigmaEasing
, quadraticOut :: SigmaEasing
, quadraticInOut :: SigmaEasing
, cubicIn :: SigmaEasing
, cubicOut :: SigmaEasing
, cubicInOut :: SigmaEasing
}
sigmaEasing =
{ linear : SigmaEasing "linear"
, quadraticIn : SigmaEasing "quadraticIn"
, quadraticOut : SigmaEasing "quadraticOut"
, quadraticInOut : SigmaEasing "quadraticInOut"
, cubicIn : SigmaEasing "cubicIn"
, cubicOut : SigmaEasing "cubicOut"
, cubicInOut : SigmaEasing "cubicInOut"
}
type CameraProps =
( x :: Number
, y :: Number
, ratio :: Number
, angle :: Number
)
foreign import data CameraInstance' :: Row Type
type CameraInstance = { | CameraInstance' }
-- | Get an array of a sigma instance's `cameras`.
cameras :: Sigma -> Array CameraInstance
cameras s = Object.values cs
where
-- For some reason, `sigma.cameras` is an object with integer keys.
cs = s .. "cameras" :: Object.Object CameraInstance
toCamera :: CameraInstance -> Record CameraProps
toCamera c = { angle, ratio, x, y }
where
angle = c .. "angle" :: Number
ratio = c .. "ratio" :: Number
x = c .. "x" :: Number
y = c .. "y" :: Number
updateCamera :: Sigma -> { ratio :: Number, x :: Number, y :: Number } -> Effect Unit
updateCamera sig { ratio, x, y } = do
let camera = sig .. "camera"
_ <- pure $ (camera .= "ratio") ratio
_ <- pure $ (camera .= "x") x
_ <- pure $ (camera .= "y") y
pure unit
goTo :: Record CameraProps -> CameraInstance -> Effect Unit
goTo props cam = pure $ cam ... "goTo" $ [props]
goToAllCameras :: Sigma -> Record CameraProps -> Effect Unit
goToAllCameras s props = traverse_ (goTo props) $ cameras s
takeScreenshot :: Sigma -> Effect String
takeScreenshot = runEffectFn1 _takeScreenshot
getEdges :: Sigma -> Effect (Array (Record Types.Edge))
getEdges = runEffectFn1 _getEdges
getNodes :: Sigma -> Effect (Array (Record Types.Node))
getNodes = runEffectFn1 _getNodes
-- | FFI
foreign import _sigma ::
forall a b opts err.
EffectFn3 (a -> Either a b)
(b -> Either a b)
(SigmaOpts opts)
(Either err Sigma)
foreign import _addRenderer
:: forall a b r err.
EffectFn4 (a -> Either a b)
(b -> Either a b)
Sigma
r
(Either err Unit)
foreign import _bindMouseSelectorPlugin
:: forall a b err.
EffectFn3 (a -> Either a b)
(b -> Either a b)
Sigma
(Either err Unit)
foreign import _bind :: forall e. EffectFn3 Sigma String (EffectFn1 e Unit) Unit
foreign import _takeScreenshot :: EffectFn1 Sigma String
foreign import _getEdges :: EffectFn1 Sigma (Array (Record Types.Edge))
foreign import _getNodes :: EffectFn1 Sigma (Array (Record Types.Node))
Sigmajs.js 0000664 0000000 0000000 00000000160 14111104351 0032600 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Hooks/Sigmax 'use strict';
exports.goToImpl = function(cam) {
return function(props) {
return cam.goTo(props);
};
};
Sigmajs.purs 0000664 0000000 0000000 00000007421 14111104351 0033164 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Hooks/Sigmax module Gargantext.Hooks.Sigmax.Sigmajs where
import Prelude
import Effect (Effect)
import Effect.Uncurried (EffectFn1, runEffectFn1)
import React.Ref as RR
import Record.Unsafe (unsafeGet)
import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Types (class Optional)
foreign import data SigmaNode :: Type
foreign import data SigmaEdge :: Type
foreign import data SigmaSettings :: Type
type SigmaNodeEvent =
{ "data" ::
{ node :: {id :: Int, label :: String}
, captor ::
{ clientX :: Number
, clientY :: Number
}
}
}
type SigmaEdgeEvent =
{ "data"::
{ node :: SigmaEdge
, captor ::
{ clientX :: Number
, clientY :: Number
}
}
}
newtype SigmaGraphData = SigmaGraphData
{ nodes :: Array SigmaNode
, edges :: Array SigmaEdge
}
type SigmaNodeOptProps =
( x :: Number
, y :: Number
, size :: Number
, color :: String
, label :: String
)
type SigmaNodeReqProps o =
{ id :: String
| o
}
type SigmaEdgeOptProps =
( color :: String
, label :: String
, "type" :: String
)
type SigmaEdgeReqProps o =
{ id :: String
, source :: String
, target :: String
| o
}
sigmaNode :: forall o. Optional o SigmaNodeOptProps => SigmaNodeReqProps o -> SigmaNode
sigmaNode = unsafeCoerce
sigmaEdge :: forall o. Optional o SigmaEdgeOptProps => SigmaEdgeReqProps o -> SigmaEdge
sigmaEdge = unsafeCoerce
-- se_ex01 :: SigmaEdge
-- se_ex01 = sigmaEdge { id : "", source : "", target : "", label : ""}
-- sn_ex01 :: SigmaNode
-- sn_ex01 = sigmaNode { id : "", label : ""}
foreign import data SigmaStyle :: Type
type CameraProps =
( x :: Number
, y :: Number
, ratio :: Number
, angle :: Number
)
foreign import data SigmaInstance' :: Row Type
foreign import data CameraInstance' :: Row Type
type SigmaInstance = { | SigmaInstance' }
type CameraInstance = { | CameraInstance' }
cameras :: SigmaInstance -> Array CameraInstance
cameras = unsafeGet "cameras"
getCameraProps :: CameraInstance -> { | CameraProps }
getCameraProps = unsafeCoerce
foreign import goToImpl :: forall o. CameraInstance -> EffectFn1 { | o } CameraInstance
goTo :: forall o. Optional o CameraProps => CameraInstance -> { | o } -> Effect CameraInstance
goTo cam = runEffectFn1 (goToImpl cam)
type SigmaProps =
( renderer :: String
, settings :: SigmaSettings
, style :: SigmaStyle
, graph :: SigmaGraphData
, ref :: RR.RefHandler RR.ReactInstance
, onClickNode :: SigmaNodeEvent -> Unit
, onOverNode :: SigmaNodeEvent -> Unit
, onOutNode :: SigmaNodeEvent -> Effect Unit
, onClickEdge :: SigmaEdgeEvent -> Effect Unit
, onOverEdge :: SigmaEdgeEvent -> Effect Unit
, onOutEdge :: SigmaEdgeEvent -> Effect Unit
)
sStyle :: forall style. { | style } -> SigmaStyle
sStyle = unsafeCoerce
newtype EdgeShape = EdgeShape String
edgeShape :: { line :: EdgeShape
, arrow :: EdgeShape
, curve :: EdgeShape
, curvedArrow :: EdgeShape
, dashed :: EdgeShape
, dotted :: EdgeShape
, parallel :: EdgeShape
, tapered :: EdgeShape
}
edgeShape =
{ line : EdgeShape "line"
, arrow : EdgeShape "arrow"
, curve : EdgeShape "curve"
, curvedArrow : EdgeShape "curvedArrow"
, dashed : EdgeShape "dashed"
, dotted : EdgeShape "dotted"
, parallel : EdgeShape "parallel"
, tapered : EdgeShape "tapered"
}
newtype NodeShape = NodeShape String
nodeShape :: { def :: NodeShape
, pacman :: NodeShape
, star :: NodeShape
, equilateral :: NodeShape
, cross :: NodeShape
, diamond :: NodeShape
, circle :: NodeShape
, square :: NodeShape
}
nodeShape =
{ def : NodeShape "def"
, pacman : NodeShape "pacman"
, star : NodeShape "star"
, equilateral : NodeShape "equilateral"
, cross : NodeShape "cross"
, diamond : NodeShape "diamond"
, circle : NodeShape "circle"
, square : NodeShape "square"
}
Types.purs 0000664 0000000 0000000 00000022664 14111104351 0032701 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Hooks/Sigmax module Gargantext.Hooks.Sigmax.Types where
import DOM.Simple.Types (Element)
import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Show.Generic (genericShow)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromJust)
import Data.Sequence as Seq
import Data.Set as Set
import Data.Tuple (Tuple(..))
import Partial.Unsafe (unsafePartial)
import Prelude (class Eq, class Show, map, ($), (&&), (==), (||), (<$>), mod, not)
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Data.Louvain as Louvain
import Gargantext.Types as GT
newtype Graph n e = Graph { edges :: Seq.Seq {|e}, nodes :: Seq.Seq {|n} }
derive instance Generic (Graph n e) _
instance (Eq (Record n), Eq (Record e)) => Eq (Graph n e) where
eq = genericEq
--instance Eq Graph where
-- eq (Graph {nodes: n1, edges: e1}) (Graph {nodes: n2, edges: e2}) = n1 == n2 && e1 == e2
type Renderer = { "type" :: String, container :: Element }
type NodeId = String
type EdgeId = String
type Node = (
borderColor :: String
, color :: String
, equilateral :: { numPoints :: Int }
, gargType :: GT.Mode
, hidden :: Boolean
, id :: NodeId
, label :: String
, size :: Number
, type :: String -- available types: circle, cross, def, diamond, equilateral, pacman, square, star
, x :: Number
, y :: Number
, _original :: GET.Node
)
type Edge = (
color :: String
, confluence :: Number
, id :: EdgeId
, hidden :: Boolean
, size :: Number
, source :: NodeId
, sourceNode :: Record Node
, target :: NodeId
, targetNode :: Record Node
, weight :: Number
, weightIdx :: Int
, _original :: GET.Edge
)
type NodeIds = Set.Set NodeId
type EdgeIds = Set.Set EdgeId
type EdgesMap = Map.Map String (Record Edge)
type NodesMap = Map.Map String (Record Node)
emptyEdgeIds :: EdgeIds
emptyEdgeIds = Set.empty
emptyNodeIds :: NodeIds
emptyNodeIds = Set.empty
type SGraph = Graph Node Edge
-- Diff graph structure
-- NOTE: "add" is NOT a graph. There can be edges which join nodes that are not
-- in the SigmaDiff nodes array.
type SigmaDiff =
(
add :: Tuple (Seq.Seq (Record Edge)) (Seq.Seq (Record Node))
, remove :: Tuple EdgeIds NodeIds
)
graphEdges :: SGraph -> Seq.Seq (Record Edge)
graphEdges (Graph {edges}) = edges
graphNodes :: SGraph -> Seq.Seq (Record Node)
graphNodes (Graph {nodes}) = nodes
edgesGraphMap :: SGraph -> EdgesMap
edgesGraphMap graph =
Map.fromFoldable $ map (\e -> Tuple e.id e) $ graphEdges graph
edgesFilter :: (Record Edge -> Boolean) -> SGraph -> SGraph
edgesFilter f (Graph {edges, nodes}) = Graph { edges: Seq.filter f edges, nodes }
nodesMap :: Seq.Seq (Record Node) -> NodesMap
nodesMap nodes = Map.fromFoldable $ map (\n -> Tuple n.id n) nodes
nodesGraphMap :: SGraph -> NodesMap
nodesGraphMap graph =
nodesMap $ graphNodes graph
nodesFilter :: (Record Node -> Boolean) -> SGraph -> SGraph
nodesFilter f (Graph {edges, nodes}) = Graph { edges, nodes: Seq.filter f nodes }
nodesById :: SGraph -> NodeIds -> SGraph
nodesById g nodeIds = nodesFilter (\n -> Set.member n.id nodeIds) g
-- | "Subtract" second graph from first one (only node/edge id's are compared, not other props)
sub :: SGraph -> SGraph -> SGraph
sub graph (Graph {nodes, edges}) = newGraph
where
edgeIds = Set.fromFoldable $ Seq.map _.id edges
nodeIds = Set.fromFoldable $ Seq.map _.id nodes
edgeFilterFunc e = (not $ Set.member e.id edgeIds)
&& (not $ Set.member e.source nodeIds)
&& (not $ Set.member e.target nodeIds)
filteredEdges = edgesFilter edgeFilterFunc graph
newGraph = nodesFilter (\n -> not (Set.member n.id nodeIds)) filteredEdges
-- | Compute a diff between current sigma graph and whatever is set via customer controls
sigmaDiff :: EdgeIds -> NodeIds -> SGraph -> Record SigmaDiff
sigmaDiff sigmaEdges sigmaNodes g@(Graph {nodes, edges}) = {add, remove}
where
add = Tuple addEdges addNodes
remove = Tuple removeEdges removeNodes
addG = edgesFilter (\e -> not (Set.member e.id sigmaEdges)) $ nodesFilter (\n -> not (Set.member n.id sigmaNodes)) g
addEdges = graphEdges addG
addNodes = graphNodes addG
removeEdges = Set.difference sigmaEdges (Set.fromFoldable $ Seq.map _.id edges)
removeNodes = Set.difference sigmaNodes (Set.fromFoldable $ Seq.map _.id nodes)
neighbours :: SGraph -> Seq.Seq (Record Node) -> Seq.Seq (Record Node)
neighbours g nodes = Seq.fromFoldable $ Set.unions [Set.fromFoldable nodes, sources, targets]
where
nodeIds = Set.fromFoldable $ Seq.map _.id nodes
selectedEdges = neighbouringEdges g nodeIds
sources = Set.fromFoldable $ graphNodes $ nodesById g $ Set.fromFoldable $ Seq.map _.source selectedEdges
targets = Set.fromFoldable $ graphNodes $ nodesById g $ Set.fromFoldable $ Seq.map _.target selectedEdges
neighbouringEdges :: SGraph -> NodeIds -> Seq.Seq (Record Edge)
neighbouringEdges g nodeIds = Seq.filter condition $ graphEdges g
where
condition {source, target} = (Set.member source nodeIds) || (Set.member target nodeIds)
eqGraph :: SGraph -> SGraph -> Boolean
eqGraph (Graph {nodes: n1, edges: e1}) (Graph {nodes: n2, edges: e2}) = (n1 == n2) && (e1 == e2)
-- | Custom state for force atlas. Basically, it can be "Running" or "Paused"
-- however when graph is loaded initially, forceAtlas is running for a couple of
-- seconds and then stops (unless the user alters this by clicking the toggle
-- button).
data ForceAtlasState = InitialRunning | InitialStopped | Running | Paused | Killed
derive instance Generic ForceAtlasState _
instance Eq ForceAtlasState where
eq = genericEq
toggleForceAtlasState :: ForceAtlasState -> ForceAtlasState
toggleForceAtlasState InitialRunning = Paused
toggleForceAtlasState InitialStopped = InitialRunning
toggleForceAtlasState Running = Paused
toggleForceAtlasState Paused = Running
toggleForceAtlasState Killed = InitialRunning
-- | Custom state for show edges. Normally it is EShow or EHide (show/hide
-- | edges). However, edges are temporarily turned off when forceAtlas is
-- | running.
-- | NOTE ETempHiddenThenShow state is a hack for force atlas
-- | flickering. Ideally it should be removed from here.
data ShowEdgesState = EShow | EHide | ETempHiddenThenShow
derive instance Generic ShowEdgesState _
instance Eq ShowEdgesState where
eq = genericEq
instance Show ShowEdgesState where
show = genericShow
-- | Whether the edges are hidden now (temp or "stable").
edgeStateHidden :: ShowEdgesState -> Boolean
edgeStateHidden EHide = true
edgeStateHidden ETempHiddenThenShow = true
edgeStateHidden _ = false
-- | Switch from hidden to shown, handling the temp state as well.
toggleShowEdgesState :: ShowEdgesState -> ShowEdgesState
toggleShowEdgesState s =
if edgeStateHidden s then
EShow
else
EHide
-- | Return the temporary hidden state, if applicable.
edgeStateTempHide :: ShowEdgesState -> ShowEdgesState
edgeStateTempHide EHide = EHide
edgeStateTempHide _ = ETempHiddenThenShow
-- | Whether, after disabling the temp state, edges will be shown or hidden.
edgeStateWillBeHidden :: ShowEdgesState -> Boolean
edgeStateWillBeHidden EHide = true
edgeStateWillBeHidden _ = false
-- | Get rid of the temporary transition
edgeStateStabilize :: ShowEdgesState -> ShowEdgesState
edgeStateStabilize ETempHiddenThenShow = EShow
edgeStateStabilize s = s
-- | Return state in which showEdges should be depending on forceAtlasState
forceAtlasEdgeState :: ForceAtlasState -> ShowEdgesState -> ShowEdgesState
forceAtlasEdgeState InitialRunning EShow = ETempHiddenThenShow
forceAtlasEdgeState InitialRunning es = es
forceAtlasEdgeState InitialStopped es = es
forceAtlasEdgeState Running EShow = ETempHiddenThenShow
forceAtlasEdgeState Running es = es
forceAtlasEdgeState Paused ETempHiddenThenShow = EShow
forceAtlasEdgeState Paused es = es
forceAtlasEdgeState Killed ETempHiddenThenShow = EShow
forceAtlasEdgeState Killed es = es
louvainEdges :: SGraph -> Array (Record Louvain.Edge)
louvainEdges g = Seq.toUnfoldable $ Seq.map (\{source, target, weight} -> {source, target, weight}) (graphEdges g)
louvainNodes :: SGraph -> Array Louvain.Node
louvainNodes g = Seq.toUnfoldable $ Seq.map _.id (graphNodes g)
louvainGraph :: SGraph -> Louvain.LouvainCluster -> SGraph
louvainGraph g cluster = Graph {nodes: newNodes, edges: newEdges}
where
nodes = graphNodes g
edges = graphEdges g
newNodes = (nodeClusterColor cluster) <$> nodes
nm = nodesMap newNodes
newEdges = (edgeClusterColor cluster nm) <$> edges
edgeClusterColor cluster nm e = e { color = sourceNode.color, sourceNode = sourceNode, targetNode = targetNode }
where
sourceNode = case Map.lookup e.source nm of
Just sn -> sn
Nothing -> e.sourceNode
targetNode = case Map.lookup e.target nm of
Just tn -> tn
Nothing -> e.targetNode
nodeClusterColor cluster n = n { color = newColor }
where
newColor = case Map.lookup n.id cluster of
Nothing -> n.color
Just c -> do
let idx = c `mod` (A.length defaultPalette)
unsafePartial $ fromJust $ defaultPalette A.!! idx
defaultPalette :: Array String
defaultPalette = ["#5fa571","#ab9ba2","#da876d","#bdd3ff"
,"#b399df","#ffdfed","#33c8f3","#739e9a"
,"#caeca3","#f6f7e5","#f9bcca","#ccb069"
,"#c9ffde","#c58683","#6c9eb0","#ffd3cf"
,"#ccffc7","#52a1b0","#d2ecff","#99fffe"
,"#9295ae","#5ea38b","#fff0b3","#d99e68"
]
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/License.purs 0000664 0000000 0000000 00000001573 14111104351 0030717 0 ustar 00root root 0000000 0000000 module Gargantext.License where
import Reactix as R
import Reactix.DOM.HTML as H
license :: R.Element
license = H.p { className: "license" }
[ H.text "GarganText "
, H.span { className: "fa fa-registered"} []
, H.text " is made by "
, H.a { href: "https://iscpif.fr"
, target: "blank"
} [ H.text "CNRS/ISCPIF" ]
, H.a { href: "http://gitlab.iscpif.fr/humanities/gargantext/blob/stable/LICENSE"
, target: "blank"
, title: "Legal instructions of the project."
}
[ H.text ", with licences aGPLV3 and CECILL variant Affero compliant, " ]
, H.span { className: "fa fa-copyright" } []
, H.a { href: "https://cnrs.fr", target:"blank"} [H.text " CNRS 2017-Present "]
, H.text "."
]
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Prelude.purs 0000664 0000000 0000000 00000004140 14111104351 0030726 0 ustar 00root root 0000000 0000000 module Gargantext.Prelude (module Prelude, logs, logExceptions, id, class Read, read, xor)
where
import Data.Maybe (Maybe)
import Prelude (class Applicative, class Apply, class Bind, class BooleanAlgebra, class Bounded, class Category, class CommutativeRing, class Discard, class DivisionRing, class Eq, class EuclideanRing, class Field, class Functor, class HeytingAlgebra, class Monad, class Monoid, class Ord, class Ring, class Semigroup, class Semigroupoid, class Semiring, class Show, type (~>), Ordering(..), Unit, Void, absurd, add, ap, append, apply, between, bind, bottom, clamp, compare, comparing, compose, conj, const, degree, discard, disj, eq, flap, flip, gcd, identity, ifM, join, lcm, liftA1, liftM1, map, max, mempty, min, mod, mul, negate, not, notEq, one, otherwise, pure, recip, show, sub, top, unit, unless, unlessM, void, when, whenM, zero, (#), ($), ($>), (&&), (*), (*>), (+), (-), (/), (/=), (<), (<#>), (<$), (<$>), (<*), (<*>), (<<<), (<=), (<=<), (<>), (<@>), (=<<), (==), (>), (>=), (>=>), (>>=), (>>>), (||))
import Effect.Console (log)
import Effect.Class (class MonadEffect, liftEffect)
import Effect.Exception (catchException, throwException)
import Effect.Unsafe (unsafePerformEffect)
-- | JL: Astonishingly, not in the prelude
-- AD: recent Preludes in Haskell much prefer identity
-- then id can be used as a variable name (in records for instance)
-- since records in Purescript are not the same as in Haskell
-- this behavior is questionable indeed.
id :: forall a. a -> a
id a = a
class Read a where
read :: String -> Maybe a
logs:: forall message effect.
(MonadEffect effect)
=> Show message
=> message
-> effect Unit
logs = liftEffect <<< log <<< show
logExceptions :: forall message a b. Show message =>
message -> (a -> b) -> a -> b
logExceptions message f x =
unsafePerformEffect $ do
catchException (\e -> do logs message
logs e
throwException e) do
pure $ f x
xor :: Boolean -> Boolean -> Boolean
xor true false = true
xor false true = true
xor _ _ = false
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Router.purs 0000664 0000000 0000000 00000003725 14111104351 0030616 0 ustar 00root root 0000000 0000000 module Gargantext.Router where
import Prelude
import Data.Foldable (oneOf)
import Data.Int (floor)
import Routing.Match (Match, lit, num, str)
import Gargantext.Routes (AppRoute(..))
import Gargantext.Types (SessionId(..))
router :: Match AppRoute
router = oneOf
[ Login <$ route "login"
, Folder <$> (route "folder" *> sid) <*> int
, FolderPrivate <$> (route "folderPrivate" *> sid) <*> int
, FolderPublic <$> (route "folderPublic" *> sid) <*> int
, FolderShared <$> (route "folderShared" *> sid) <*> int
, Team <$> (route "team" *> sid) <*> int
, CorpusDocument <$> (route "corpus" *> sid) <*> int
<*> (lit "list" *> int)
<*> (lit "document" *> int)
, Corpus <$> (route "corpus" *> sid) <*> int
, Document <$> (route "list" *> sid) <*> int
<*> (lit "document" *> int)
, Dashboard <$> (route "dashboard" *> sid) <*> int
, PGraphExplorer <$> (route "graph" *> sid) <*> int
, PhyloExplorer <$> (route "phylo" *> sid) <*> int
, Texts <$> (route "texts" *> sid) <*> int
, Lists <$> (route "lists" *> sid) <*> int
, ContactPage <$> (route "annuaire" *> sid) <*> int
<*> (lit "contact" *> int)
, Annuaire <$> (route "annuaire" *> sid) <*> int
, UserPage <$> (route "user" *> sid) <*> int
, RouteFrameWrite <$> (route "write" *> sid) <*> int
, RouteFrameCalc <$> (route "calc" *> sid) <*> int
, RouteFrameCode <$> (route "code" *> sid) <*> int
, RouteFrameVisio <$> (route "visio" *> sid) <*> int
, RouteFile <$> (route "file" *> sid) <*> int
, Home <$ lit ""
]
where
route str = lit "" *> lit str
int :: Match Int
int = floor <$> num
sid :: Match SessionId
sid = SessionId <$> str
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Routes.purs 0000664 0000000 0000000 00000016153 14111104351 0030616 0 ustar 00root root 0000000 0000000 module Gargantext.Routes where
import Prelude
import Data.Maybe (Maybe(..))
import Gargantext.Types (ChartOpts, ChartType, CorpusMetricOpts, CTabNgramType, Id, Limit,
ListId, DocId, ContactId, NgramsGetOpts, NgramsGetTableAllOpts, NodeType,
Offset, OrderBy, SearchOpts, SessionId, TabSubType, TabType, TermList)
import Gargantext.Types as GT
data AppRoute
= Annuaire SessionId Int
| ContactPage SessionId Int Int
| Corpus SessionId Int
| CorpusDocument SessionId Int Int Int
| Dashboard SessionId Int
| Document SessionId Int Int
| Folder SessionId Int
| FolderPrivate SessionId Int
| FolderPublic SessionId Int
| FolderShared SessionId Int
| Home
| Lists SessionId Int
| Login
| PGraphExplorer SessionId Int
| PhyloExplorer SessionId Int
| RouteFile SessionId Int
| RouteFrameCalc SessionId Int
| RouteFrameCode SessionId Int
| RouteFrameWrite SessionId Int
| RouteFrameVisio SessionId Int
| Team SessionId Int
| Texts SessionId Int
| UserPage SessionId Int
derive instance Eq AppRoute
data SessionRoute
= Tab TabType (Maybe Id)
| Children NodeType Offset Limit (Maybe OrderBy) (Maybe Id)
| GetNgrams NgramsGetOpts (Maybe Id)
| GetNgramsTableAll NgramsGetTableAllOpts (Maybe Id)
| GetNgramsTableVersion { listId :: ListId, tabType :: TabType } (Maybe Id)
| PutNgrams TabType (Maybe ListId) (Maybe TermList) (Maybe Id)
| PostNgramsChartsAsync (Maybe Id)
-- ^ This name is not good. In particular this URL is used both in PUT and POST.
| RecomputeNgrams (TabSubType CTabNgramType) Id ListId
| RecomputeListChart ChartType CTabNgramType Id ListId
| NodeAPI NodeType (Maybe Id) String
| TreeFirstLevel (Maybe Id) String
| GraphAPI Id String
| ListsRoute ListId
| ListDocument (Maybe ListId) (Maybe DocId)
| Search SearchOpts (Maybe Id)
| CorpusMetrics CorpusMetricOpts (Maybe Id)
| CorpusMetricsHash { listId :: ListId, tabType :: TabType } (Maybe Id)
| Chart ChartOpts (Maybe Id)
| ChartHash { chartType :: ChartType, listId :: Maybe ListId, tabType :: TabType } (Maybe Id)
-- | AnnuaireContact AnnuaireId DocId
instance Show AppRoute where
show Home = "Home"
show Login = "Login"
show (Folder s i) = "Folder" <> show i <> " (" <> show s <> ")"
show (FolderPrivate s i) = "FolderPrivate" <> show i <> " (" <> show s <> ")"
show (FolderPublic s i) = "FolderPublic" <> show i <> " (" <> show s <> ")"
show (FolderShared s i) = "FolderShared" <> show i <> " (" <> show s <> ")"
show (Team s i) = "Team" <> show i <> " (" <> show s <> ")"
show (Corpus s i) = "Corpus" <> show i <> " (" <> show s <> ")"
show (Document _ s i) = "Document" <> show i <> " (" <> show s <> ")"
show (CorpusDocument s _ _ i) = "CorpusDocument" <> show i <> " (" <> show s <> ")"
show (PGraphExplorer s i) = "graphExplorer" <> show i <> " (" <> show s <> ")"
show (PhyloExplorer s i) = "phyloExplorer" <> show i <> " (" <> show s <> ")"
show (Dashboard s i) = "Dashboard" <> show i <> " (" <> show s <> ")"
show (Texts s i) = "texts" <> show i <> " (" <> show s <> ")"
show (Lists s i) = "lists" <> show i <> " (" <> show s <> ")"
show (Annuaire s i) = "Annuaire" <> show i <> " (" <> show s <> ")"
show (UserPage s i) = "User" <> show i <> " (" <> show s <> ")"
show (ContactPage s a i) = "Contact" <> show a <> "::" <> show i <> " (" <> show s <> ")"
show (RouteFrameWrite s i) = "write" <> show i <> " (" <> show s <> ")"
show (RouteFrameCalc s i) = "calc" <> show i <> " (" <> show s <> ")"
show (RouteFrameCode s i) = "code" <> show i <> " (" <> show s <> ")"
show (RouteFrameVisio s i) = "visio" <> show i <> " (" <> show s <> ")"
show (RouteFile s i) = "file" <> show i <> " (" <> show s <> ")"
appPath :: AppRoute -> String
appPath Home = ""
appPath Login = "login"
appPath (Folder s i) = "folder/" <> show s <> "/" <> show i
appPath (FolderPrivate s i) = "folderPrivate/" <> show s <> "/" <> show i
appPath (FolderPublic s i) = "folderPublic/" <> show s <> "/" <> show i
appPath (FolderShared s i) = "folderShared/" <> show s <> "/" <> show i
appPath (Team s i) = "team/" <> show s <> "/" <> show i
appPath (CorpusDocument s c l i) = "corpus/" <> show s <> "/" <> show c <> "/list/" <> show l <> "/document/" <> show i
appPath (Corpus s i) = "corpus/" <> show s <> "/" <> show i
appPath (Document s l i) = "list/" <> show s <> "/" <> show l <> "/document/" <> show i
appPath (Dashboard s i) = "dashboard/" <> show s <> "/" <> show i
appPath (PGraphExplorer s i) = "graph/" <> show s <> "/" <> show i
appPath (PhyloExplorer s i) = "phylo/" <> show s <> "/" <> show i
appPath (Texts s i) = "texts/" <> show s <> "/" <> show i
appPath (Lists s i) = "lists/" <> show s <> "/" <> show i
appPath (Annuaire s i) = "annuaire/" <> show s <> "/" <> show i
appPath (UserPage s i) = "user/" <> show s <> "/" <> show i
appPath (ContactPage s a i) = "annuaire/" <> show s <> "/" <> show a <> "/contact/" <> show i
appPath (RouteFrameWrite s i) = "write/" <> show s <> "/" <> show i
appPath (RouteFrameCalc s i) = "calc/" <> show s <> "/" <> show i
appPath (RouteFrameCode s i) = "code/" <> show s <> "/" <> show i
appPath (RouteFrameVisio s i) = "visio/" <> show s <> "/" <> show i
appPath (RouteFile s i) = "file/" <> show s <> "/" <> show i
nodeTypeAppRoute :: NodeType -> SessionId -> Int -> Maybe AppRoute
nodeTypeAppRoute GT.Annuaire s i = Just $ Annuaire s i
nodeTypeAppRoute GT.Corpus s i = Just $ Corpus s i
nodeTypeAppRoute GT.Dashboard s i = Just $ Dashboard s i
nodeTypeAppRoute GT.Folder s i = Just $ Folder s i
nodeTypeAppRoute GT.FolderPrivate s i = Just $ FolderPrivate s i
nodeTypeAppRoute GT.FolderPublic s i = Just $ FolderPublic s i
nodeTypeAppRoute GT.FolderShared s i = Just $ FolderShared s i
nodeTypeAppRoute GT.Graph s i = Just $ PGraphExplorer s i
nodeTypeAppRoute GT.Phylo s i = Just $ PhyloExplorer s i
nodeTypeAppRoute GT.NodeContact s i = Just $ Annuaire s i
nodeTypeAppRoute GT.NodeFile s i = Just $ RouteFile s i
nodeTypeAppRoute GT.NodeList s i = Just $ Lists s i
nodeTypeAppRoute GT.NodeUser s i = Just $ UserPage s i
nodeTypeAppRoute GT.Team s i = Just $ Team s i
nodeTypeAppRoute GT.Texts s i = Just $ Texts s i
nodeTypeAppRoute GT.NodeFrameWrite s i = Just $ RouteFrameWrite s i
nodeTypeAppRoute GT.NodeFrameCalc s i = Just $ RouteFrameCalc s i
nodeTypeAppRoute GT.NodeFrameVisio s i = Just $ RouteFrameVisio s i
nodeTypeAppRoute _ _ _ = Nothing
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Sessions.purs 0000664 0000000 0000000 00000013373 14111104351 0031144 0 ustar 00root root 0000000 0000000 -- | A module for authenticating to create sessions and handling them
module Gargantext.Sessions
( module Gargantext.Sessions.Types
, WithSession, WithSessionContext
, load, change
, Action(..), act, delete, get, post, put, put_
, postAuthRequest, deleteWithBody, postWwwUrlencoded
, getCacheState, setCacheState
) where
import DOM.Simple.Console (log2)
import Data.Either (Either(..), hush)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe)
import Effect (Effect)
import Effect.Aff (Aff)
import Reactix as R
import Simple.JSON as JSON
import Toestand as T
import Web.Storage.Storage (getItem, removeItem, setItem)
import Gargantext.Prelude
import Gargantext.Components.Login.Types (AuthData(..), AuthInvalid(..), AuthRequest(..), AuthResponse(..))
import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Config.REST as REST
import Gargantext.Ends (class ToUrl, Backend, toUrl)
import Gargantext.Sessions.Types (Session(..), Sessions(..), OpenNodes, NodeId, mkNodeId, sessionUrl, sessionId, empty, null, unSessions, lookup, cons, tryCons, update, remove, tryRemove)
import Gargantext.Utils.Reactix as R2
type WithSession c =
( session :: Session
| c )
type WithSessionContext c =
( session :: R.Context Session
| c )
load :: forall c. T.Write c Sessions => c -> Effect Sessions
load cell = do
sessions <- loadSessions
T.write sessions cell
change
:: forall c
. T.Read c Sessions
=> T.Write c Sessions
=> Action -> c -> Effect Sessions
change action cell = do
cur <- T.read cell
new <- act cur action
saveSessions new *> T.write new cell
data Action
= Login Session
| Logout Session
| Update Session
act :: Sessions -> Action -> Effect Sessions
act ss (Login s) =
case tryCons s ss of
Right new -> pure new
_ -> pure ss <* log2 "Cannot overwrite existing session: " (sessionId s)
act old@(Sessions ss) (Logout s) =
case tryRemove (sessionId s) old of
Right new -> pure $ new
_ -> pure old <* log2 "Logged out of stale session:" (sessionId s)
act ss (Update s) = saveSessions $ update s ss
-- Key we will store the data under
localStorageKey :: String
localStorageKey = "garg-sessions"
getCacheState :: NT.CacheState -> Session -> Int -> NT.CacheState
getCacheState defaultCacheState (Session { caches }) nodeId =
fromMaybe defaultCacheState $ Map.lookup nodeId caches
setCacheState :: Session -> Int -> NT.CacheState -> Session
setCacheState (Session session@{ caches }) nodeId cacheState =
Session $ session { caches = Map.insert nodeId cacheState caches }
-- | Will attempt to load saved sessions from localstorage. should log
-- | if decoding fails
loadSessions :: Effect Sessions
loadSessions = do
storage <- R2.getls
mItem :: Maybe String <- getItem localStorageKey storage
case mItem of
Nothing -> pure empty
Just val -> do
let r = JSON.readJSON val
case hush r of
Nothing -> pure empty
Just p -> pure p
-- loadSessions = R2.getls >>= getItem localStorageKey >>= handleMaybe
-- where
-- -- a localstorage lookup can find nothing
-- handleMaybe (Just val) = handleEither (JSON.readJSON val)
-- handleMaybe Nothing = pure empty
-- -- either parsing or decoding could fail, hence two errors
-- handleEither (Left err) = err *> pure empty
-- handleEither (Right ss) = pure ss
saveSessions :: Sessions -> Effect Sessions
saveSessions sessions = effect *> pure sessions where
rem = R2.getls >>= removeItem localStorageKey
set v = R2.getls >>= setItem localStorageKey v
effect
| null sessions = rem
| otherwise = set (JSON.writeJSON sessions)
postAuthRequest :: Backend -> AuthRequest -> Aff (Either String Session)
postAuthRequest backend ar@(AuthRequest {username}) =
decode <$> REST.post Nothing (toUrl backend "auth") ar
where
decode (Left _err) = Left "Error when sending REST.post"
decode (Right (AuthResponse ar2))
| {inval: Just (AuthInvalid {message})} <- ar2 = Left message
| {valid: Just (AuthData {token, tree_id})} <- ar2 =
Right $ Session { backend, caches: Map.empty, token, treeId: tree_id, username }
| otherwise = Left "Invalid response from server"
get :: forall a p. JSON.ReadForeign a => ToUrl Session p =>
Session -> p -> Aff (Either REST.RESTError a)
get session@(Session {token}) p = REST.get (Just token) (toUrl session p)
put :: forall a b p. JSON.WriteForeign a => JSON.ReadForeign b => ToUrl Session p =>
Session -> p -> a -> Aff (Either REST.RESTError b)
put session@(Session {token}) p = REST.put (Just token) (toUrl session p)
put_ :: forall b p. JSON.ReadForeign b => ToUrl Session p => Session -> p -> Aff (Either REST.RESTError b)
put_ session@(Session {token}) p = REST.put_ (Just token) (toUrl session p)
delete :: forall a p. JSON.ReadForeign a => ToUrl Session p =>
Session -> p -> Aff (Either REST.RESTError a)
delete session@(Session {token}) p = REST.delete (Just token) (toUrl session p)
-- This might not be a good idea:
-- https://stackoverflow.com/questions/14323716/restful-alternatives-to-delete-request-body
deleteWithBody :: forall a b p. JSON.WriteForeign a => JSON.ReadForeign b => ToUrl Session p =>
Session -> p -> a -> Aff (Either REST.RESTError b)
deleteWithBody session@(Session {token}) p = REST.deleteWithBody (Just token) (toUrl session p)
post :: forall a b p. JSON.WriteForeign a => JSON.ReadForeign b => ToUrl Session p =>
Session -> p -> a -> Aff (Either REST.RESTError b)
post session@(Session {token}) p = REST.post (Just token) (toUrl session p)
postWwwUrlencoded :: forall b p. JSON.ReadForeign b => ToUrl Session p =>
Session -> p -> REST.FormDataParams -> Aff (Either REST.RESTError b)
postWwwUrlencoded session@(Session {token}) p = REST.postWwwUrlencoded (Just token) (toUrl session p)
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Sessions/ 0000775 0000000 0000000 00000000000 14111104351 0030222 5 ustar 00root root 0000000 0000000 Types.purs 0000664 0000000 0000000 00000013777 14111104351 0032201 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Sessions module Gargantext.Sessions.Types
( Session(..), Sessions(..), OpenNodes(..), NodeId, mkNodeId
, sessionUrl, sessionId
, empty, null, unSessions, lookup, cons, tryCons, update, remove, tryRemove
, useOpenNodesMemberBox, openNodesInsert, openNodesDelete
) where
import Data.Array as A
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Int as Int
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Newtype (class Newtype)
import Data.Sequence (Seq)
import Data.Sequence as Seq
import Data.Set (Set)
import Data.Set as Set
import Data.Show.Generic (genericShow)
import Data.Tuple (Tuple)
import Foreign.Object as Object
import Reactix as R
import Simple.JSON as JSON
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.Login.Types (TreeId)
import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Ends (class ToUrl, Backend(..), backendUrl, sessionPath)
import Gargantext.Routes (SessionRoute)
import Gargantext.Types (NodePath, SessionId(..), nodePath)
import Gargantext.Utils.JSON as GJSON
import Gargantext.Utils.Tuple as GUT
-- | A Session represents an authenticated session for a user at a
-- | backend. It contains a token and root tree id.
newtype Session = Session
{ backend :: Backend
, caches :: Map Int NT.CacheState -- whether cache is turned on for node id
, token :: String
, treeId :: TreeId
, username :: String
}
------------------------------------------------------------------------
-- | Main instances
derive instance Generic Session _
derive instance Newtype Session _
instance JSON.ReadForeign Session where
readImpl f = do
r <- JSON.readImpl f
let objTuple = Object.toUnfoldable r.caches :: Array (Tuple String NT.CacheState)
let rUp = r { caches = Map.fromFoldable (GUT.mapFst (fromMaybe 0 <<< Int.fromString) <$> objTuple) }
pure $ Session rUp
instance JSON.WriteForeign Session where
writeImpl (Session { backend, caches, token, treeId, username }) =
JSON.writeImpl { backend, caches: caches', token, treeId, username }
where
caches' = JSON.writeImpl $ Object.fromFoldable (GUT.mapFst show <$> Map.toUnfoldable caches :: Array (Tuple String NT.CacheState))
instance Eq Session where eq = genericEq
instance Show Session where show (Session {backend, username}) = username <> "@" <> show backend
instance ToUrl Session SessionRoute where toUrl (Session {backend}) r = backendUrl backend (sessionPath r)
instance ToUrl Session NodePath where toUrl (Session {backend}) np = backendUrl backend (nodePath np)
instance ToUrl Session String where toUrl = sessionUrl
sessionUrl :: Session -> String -> String
sessionUrl (Session {backend}) = backendUrl backend
sessionId :: Session -> SessionId
sessionId = SessionId <<< show
------------------------------------------------------------------------
newtype Sessions = Sessions { sessions :: Seq Session }
derive instance Generic Sessions _
derive instance Newtype Sessions _
instance JSON.ReadForeign Sessions where
readImpl f = do
sessions <- GJSON.readSequence f
pure $ Sessions { sessions }
instance JSON.WriteForeign Sessions where
writeImpl (Sessions { sessions }) = GJSON.writeSequence sessions
instance Eq Sessions where eq = genericEq
instance Show Sessions where show = genericShow
empty :: Sessions
empty = Sessions { sessions: Seq.empty }
-- True if there are no sessions stored
null :: Sessions -> Boolean
null (Sessions { sessions: seq }) = Seq.null seq
unSessions :: Sessions -> Array Session
unSessions (Sessions {sessions:s}) = A.fromFoldable s
lookup :: SessionId -> Sessions -> Maybe Session
lookup sid (Sessions {sessions:ss}) = Seq.head (Seq.filter f ss) where
f s = sid == sessionId s
cons :: Session -> Sessions -> Sessions
cons s (Sessions {sessions:ss}) = Sessions {sessions:(Seq.cons s ss)}
tryCons :: Session -> Sessions -> Either Unit Sessions
tryCons s ss = try $ lookup sid ss
where
sid = sessionId s
try Nothing = Right (cons s ss)
try _ = Left unit
update :: Session -> Sessions -> Sessions
update s ss = up $ lookup sid ss
where
sid = sessionId s
up Nothing = cons s ss
up _ = cons s $ remove sid ss
remove :: SessionId -> Sessions -> Sessions
remove sid (Sessions {sessions:ss}) = Sessions {sessions: Seq.filter f ss} where
f s = sid /= sessionId s
tryRemove :: SessionId -> Sessions -> Either Unit Sessions
tryRemove sid old@(Sessions ss) = ret where
new = remove sid old
ret
| new == old = Left unit
| otherwise = Right new
-- open tree nodes data
newtype OpenNodes = OpenNodes (Set NodeId)
derive instance Generic OpenNodes _
derive instance Newtype OpenNodes _
instance JSON.ReadForeign OpenNodes where
readImpl f = do
inst :: Array NodeId <- JSON.readImpl f
pure $ OpenNodes $ Set.fromFoldable inst
instance JSON.WriteForeign OpenNodes where
writeImpl (OpenNodes ns) = JSON.writeImpl $ (Set.toUnfoldable ns :: Array NodeId)
openNodesInsert :: NodeId -> OpenNodes -> OpenNodes
openNodesInsert nodeId (OpenNodes set) = OpenNodes $ Set.insert nodeId set
openNodesDelete :: NodeId -> OpenNodes -> OpenNodes
openNodesDelete nodeId (OpenNodes set) = OpenNodes $ Set.delete nodeId set
-- | Creates a cursor which presents a Boolean over whether the member
-- | is in the set. Adjusting the value will toggle whether the value
-- | is in the underlying set.
useOpenNodesMemberBox
:: forall box. T.ReadWrite box OpenNodes
=> NodeId -> box -> R.Hooks (T.Box Boolean)
useOpenNodesMemberBox val box = T.useFocused (\(OpenNodes ns) -> Set.member val ns) (toggleSet val) box
-- utility for useOpenNodesMemberBox
toggleSet :: NodeId -> Boolean -> OpenNodes -> OpenNodes
toggleSet val true (OpenNodes ns) = OpenNodes $ Set.insert val ns
toggleSet val false (OpenNodes ns) = OpenNodes $ Set.delete val ns
type NodeId =
{ treeId :: TreeId -- Id of the node
, baseUrl :: String -- the baseUrl of the backend
}
mkNodeId :: Session -> TreeId -> NodeId
mkNodeId (Session {backend: Backend {baseUrl}}) treeId = { treeId, baseUrl }
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Text/ 0000775 0000000 0000000 00000000000 14111104351 0027340 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Text/BreakWords.js0000664 0000000 0000000 00000000057 14111104351 0031743 0 ustar 00root root 0000000 0000000 'use strict';
exports._wordRegex = /[a-z]+/gi;
BreakWords.purs 0000664 0000000 0000000 00000005077 14111104351 0032250 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Text -- | Break a string into words and spaces
-- | It uses a simple algorithm of searching for word characters incrementally
-- | Punctuation is considered whitespace, so it's best used in a sentence or
-- | for highlighting purposes
module Gargantext.Text.BreakWords (BrokenWord(..), breakWords) where
import Prelude (Unit, discard, negate, otherwise, pure, ($), (-), (<<<), (==), (>>=))
import Data.Traversable (traverse_)
import Effect (Effect)
import Data.Maybe (Maybe(..))
import Data.String.CodeUnits (length, slice) -- TODO: double check i'm the right choice
import Data.String.Regex (Regex)
import Gargantext.Utils.Regex (cloneRegex, execRegex, getRegexLastIndex)
import Gargantext.Utils.Array (push)
data BrokenWord = Word String | Space String
breakWords :: String -> Effect (Array BrokenWord)
breakWords s = loop $ break s
where loop b = breakNext b >>= (h b)
h :: Breaking -> Boolean -> Effect (Array BrokenWord)
h b cont
| cont = loop b
| otherwise = pure b.results
-- Implementation
-- Returns whether to continue
breakNext :: Breaking -> Effect Boolean
breakNext b = checkStatic (lastIndex b)
where checkStatic origin
| origin == length b.source = pure false
| otherwise = search b >>= next' origin
next' origin Nothing = finish b origin
next' origin (Just w) = next b origin w
next :: Breaking -> Int -> String -> Effect Boolean
next b origin word =
do traverse_ (pushSpace b) $ preceding b origin word
pushWord b word
pure true
preceding :: Breaking -> Int -> String -> Maybe String
preceding b origin word = p $ (lastIndex b) - (length word)
where p o
| o == origin = Nothing
| otherwise = slice origin o b.source
finish :: Breaking -> Int -> Effect Boolean
finish b origin =
do let last = slice origin (-1) b.source
traverse_ (pushSpace b) last
pure false
type Breaking = { source :: String, wordRegex :: Regex, results :: Array BrokenWord }
-- almost `pure`
break :: String -> Breaking
break s = { source, wordRegex, results }
where source = s
wordRegex = cloneRegex _wordRegex
results = []
search :: Breaking -> Effect (Maybe String)
search b = execRegex b.wordRegex b.source
lastIndex :: Breaking -> Int
lastIndex b = getRegexLastIndex b.wordRegex
pushResult :: Breaking -> BrokenWord -> Effect Unit
pushResult b = push b.results
pushSpace :: Breaking -> String -> Effect Unit
pushSpace b = pushResult b <<< Space
pushWord :: Breaking -> String -> Effect Unit
pushWord b = pushResult b <<< Word
foreign import _wordRegex :: Regex
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Types.purs 0000664 0000000 0000000 00000063503 14111104351 0030442 0 ustar 00root root 0000000 0000000 module Gargantext.Types where
import Gargantext.Prelude
import Data.Array as A
import Data.Either (Either)
import Data.Eq.Generic (genericEq)
import Data.Generic.Rep (class Generic)
import Data.Int (toNumber)
import Data.Maybe (Maybe(..), maybe)
import Data.Newtype (class Newtype)
import Data.Ord.Generic (genericCompare)
import Data.Show.Generic (genericShow)
import Data.String as S
import Effect.Aff (Aff)
import Foreign as F
import Prim.Row (class Union)
import Reactix as R
import Simple.JSON as JSON
import Simple.JSON.Generics as JSONG
import URI.Query (Query)
import Gargantext.Components.Lang (class Translate, Lang(..))
import Gargantext.Config.REST (RESTError)
import Gargantext.Utils.Glyphicon (classNamePrefix, glyphiconToCharCode)
data Handed = LeftHanded | RightHanded
switchHanded :: forall a. a -> a -> Handed -> a
switchHanded l _ LeftHanded = l
switchHanded _ r RightHanded = r
reverseHanded :: forall a. Handed -> Array a -> Array a
reverseHanded LeftHanded a = A.reverse a
reverseHanded RightHanded a = a
flipHanded :: R.Element -> R.Element -> Handed -> R.Element
flipHanded l r LeftHanded = R.fragment [r, l]
flipHanded l r RightHanded = R.fragment [l, r]
derive instance Generic Handed _
instance Eq Handed where
eq = genericEq
type ID = Int
type Name = String
newtype SessionId = SessionId String
type NodeID = Int
derive instance Generic SessionId _
instance Eq SessionId where
eq = genericEq
instance Show SessionId where
show (SessionId s) = s
data TermSize = MonoTerm | MultiTerm
data Term = Term String TermList
derive instance Generic TermSize _
instance Eq TermSize where eq = genericEq
-- | Converts a data structure to a query string
class ToQuery a where
toQuery :: a -> Query
instance Show TermSize where
show MonoTerm = "MonoTerm"
show MultiTerm = "MultiTerm"
instance Read TermSize where
read :: String -> Maybe TermSize
read "MonoTerm" = Just MonoTerm
read "MultiTerm" = Just MultiTerm
read _ = Nothing
termSizes :: Array { desc :: String, mval :: Maybe TermSize }
termSizes = [ { desc: "All types", mval: Nothing }
, { desc: "One-word terms", mval: Just MonoTerm }
, { desc: "Multi-word terms", mval: Just MultiTerm }
]
data TermList = MapTerm | StopTerm | CandidateTerm
-- TODO use generic JSON instance
derive instance Generic TermList _
instance Eq TermList where eq = genericEq
instance Ord TermList where compare = genericCompare
instance JSON.WriteForeign TermList where writeImpl = JSON.writeImpl <<< show
instance JSON.ReadForeign TermList where readImpl = JSONG.enumSumRep
instance Show TermList where show = genericShow
-- TODO: Can we replace the show instance above with this?
termListName :: TermList -> String
termListName MapTerm = "Map List"
termListName StopTerm = "Stop List"
termListName CandidateTerm = "Candidate List"
instance Read TermList where
read :: String -> Maybe TermList
read "MapTerm" = Just MapTerm
read "StopTerm" = Just StopTerm
read "CandidateTerm" = Just CandidateTerm
read _ = Nothing
termLists :: Array { desc :: String, mval :: Maybe TermList }
termLists = [ { desc: "All terms", mval: Nothing }
, { desc: "Map terms", mval: Just MapTerm }
, { desc: "Stop terms", mval: Just StopTerm }
, { desc: "Candidate terms", mval: Just CandidateTerm }
]
-- | Proof that row `r` is a subset of row `s`
class Optional (r :: Row Type) (s :: Row Type)
instance Union r t s => Optional r s
showTabType' :: TabType -> String
showTabType' (TabCorpus t) = show t
showTabType' (TabDocument t) = show t
showTabType' (TabPairing t) = show t
newtype TabPostQuery = TabPostQuery {
offset :: Int
, limit :: Int
, orderBy :: OrderBy
, tabType :: TabType
, query :: String
}
derive instance Generic TabPostQuery _
derive instance Newtype TabPostQuery _
derive newtype instance JSON.WriteForeign TabPostQuery
data NodeType = Annuaire
| Corpus
| Dashboard
| Error
| Folder
| FolderPrivate
| FolderPublic
| FolderShared
| Graph
| Individu
| Node
| NodeContact
| NodeList
| NodeUser
| Nodes
| Phylo
| Team
| Texts
| Tree
| Url_Document
-- TODO Optional Nodes
| NodeFile
| NodeFrameCalc
| NodeFrameNotebook
| NodeFrameWrite
| NodeFrameVisio
| NodePublic NodeType
derive instance Generic NodeType _
derive instance Eq NodeType
instance JSON.ReadForeign NodeType where
readImpl f = do
s <- F.readString f
case read s of
Nothing -> F.fail $ F.ErrorAtProperty s $ F.ForeignError "unknown property"
Just nt -> pure nt
instance JSON.WriteForeign NodeType where writeImpl = JSON.writeImpl <<< show
instance Show NodeType where
show NodeUser = "NodeUser"
show Folder = "NodeFolder"
show FolderPrivate = "NodeFolderPrivate" -- Node Private Worktop
show FolderShared = "NodeFolderShared" -- Node Share Worktop
show FolderPublic = "NodeFolderPublic" -- Node Public Worktop
show Annuaire = "NodeAnnuaire"
show NodeContact = "NodeContact"
show Corpus = "NodeCorpus"
show Dashboard = "NodeDashboard"
show Url_Document = "NodeDocument"
show Error = "NodeError"
show Graph = "NodeGraph"
show Phylo = "NodePhylo"
show Individu = "NodeIndividu"
show Node = "Node"
show Nodes = "Nodes"
show Tree = "NodeTree"
show Team = "NodeTeam"
show NodeList = "NodeList"
show Texts = "NodeDocs"
show NodeFrameWrite = "NodeFrameWrite"
show NodeFrameCalc = "NodeFrameCalc"
show NodeFrameNotebook = "NodeFrameNotebook"
show NodeFrameVisio = "NodeFrameVisio"
show (NodePublic nt) = "NodePublic" <> show nt
show NodeFile = "NodeFile"
instance Read NodeType where
read "NodeUser" = Just NodeUser
read "NodeFolder" = Just Folder
read "NodeFolderPrivate" = Just FolderPrivate
read "NodeFolderShared" = Just FolderShared
read "NodeFolderPublic" = Just FolderPublic
read "NodeAnnuaire" = Just Annuaire
read "NodeDashboard" = Just Dashboard
read "Document" = Just Url_Document
read "NodeGraph" = Just Graph
read "NodePhylo" = Just Phylo
read "Individu" = Just Individu
read "Node" = Just Node
read "Nodes" = Just Nodes
read "NodeCorpus" = Just Corpus
read "NodeContact" = Just NodeContact
read "Tree" = Just Tree
read "NodeTeam" = Just Team
read "NodeList" = Just NodeList
read "NodeTexts" = Just Texts
read "Annuaire" = Just Annuaire
read "NodeFrameWrite" = Just NodeFrameWrite
read "NodeFrameCalc" = Just NodeFrameCalc
read "NodeFrameNotebook" = Just NodeFrameNotebook
read "NodeFrameVisio" = Just NodeFrameVisio
read "NodeFile" = Just NodeFile
-- TODO NodePublic read ?
read _ = Nothing
------------------------------------------------------
instance translateNodeType :: Translate NodeType where
translate l n = case l of
FR -> translateFR n
_ -> translateEN n
translateFR :: NodeType -> String
translateFR = case _ of
Annuaire -> "Annuaire"
Corpus -> "Corpus"
Dashboard -> "Dashboard"
Error -> "Erreur"
Folder -> "Dossier"
FolderPrivate -> "Dossier privé"
FolderPublic -> "Dossier public"
FolderShared -> "Dossier partagé"
Graph -> "Graphe"
Individu -> "Individu"
Node -> "NÅ“ud"
NodeContact -> "Contact"
NodeList -> "Liste"
NodeUser -> "Utilisateur"
Nodes -> "NÅ“uds"
Phylo -> "Phylo"
Team -> "Équipe"
Texts -> "Textes"
Tree -> "Arbre"
Url_Document -> "Document URL"
--
NodeFile -> "Fichier"
NodeFrameCalc -> "Feuilles de calcul"
NodeFrameNotebook -> "Carnet de notes"
NodeFrameWrite -> "Éditeur de texte"
NodeFrameVisio -> "Visio"
NodePublic n -> translateFR n
translateEN :: NodeType -> String
translateEN = case _ of
Annuaire -> "Annuaire"
Corpus -> "Corpus"
Dashboard -> "Dashboard"
Error -> "Error"
Folder -> "Folder"
FolderPrivate -> "Private folder"
FolderPublic -> "Public folder"
FolderShared -> "Shared folder"
Graph -> "Graph"
Individu -> "Person"
Node -> "Node"
NodeContact -> "Contact"
NodeList -> "List"
NodeUser -> "User"
Nodes -> "Nodes"
Phylo -> "Phylo"
Team -> "Team"
Texts -> "Texts"
Tree -> "Tree"
Url_Document -> "URL document"
--
NodeFile -> "File"
NodeFrameCalc -> "Calc"
NodeFrameNotebook -> "Notebook"
NodeFrameWrite -> "Write"
NodeFrameVisio -> "Visio"
NodePublic n -> translateEN n
------------------------------------------------------
getIcon :: NodeType -> Boolean -> String
getIcon NodeUser false = "user-circle"
getIcon NodeUser true = "user"
------------------------------------------------------
getIcon Folder false = "folder"
getIcon Folder true = "folder-open-o"
------------------------------------------------------
getIcon FolderPrivate true = "lock"
getIcon FolderPrivate false = "lock-circle"
getIcon FolderShared true = "share-alt"
getIcon FolderShared false = "share-circle"
getIcon Team true = "users"
getIcon Team false = "users-closed"
getIcon FolderPublic true = "globe-circle"
getIcon FolderPublic false = "globe"
------------------------------------------------------
getIcon Corpus true = "book"
getIcon Corpus false = "book-circle"
getIcon Phylo _ = "code-fork"
getIcon Graph _ = "hubzilla"
getIcon Texts _ = "newspaper-o"
getIcon Dashboard _ = "signal"
getIcon NodeList _ = "list"
getIcon NodeFile _ = "file" -- TODO depending on mime type we can use fa-file-image etc
getIcon Annuaire true = "address-card-o"
getIcon Annuaire false = "address-card"
getIcon NodeContact true = "address-card-o"
getIcon NodeContact false = "address-card"
getIcon NodeFrameWrite true = "file-text-o"
getIcon NodeFrameWrite false = "file-text"
getIcon NodeFrameCalc true = "calculator"
getIcon NodeFrameCalc false = "calculator"
getIcon NodeFrameNotebook true = "file-code-o"
getIcon NodeFrameNotebook false = "code"
getIcon NodeFrameVisio true = "video-camera"
getIcon NodeFrameVisio false = "video-camera"
getIcon (NodePublic nt) b = getIcon nt b
getIcon _ true = "folder-open"
getIcon _ false = "folder-o"
------------------------------------------------------
fldr :: NodeType -> Boolean -> String
fldr nt flag = classNamePrefix <> getIcon nt flag
charCodeIcon :: NodeType -> Boolean -> String
charCodeIcon nt flag = glyphiconToCharCode $ getIcon nt flag
publicize :: NodeType -> NodeType
publicize (NodePublic nt) = NodePublic nt
publicize nt = NodePublic nt
isPublic :: NodeType -> Boolean
isPublic (NodePublic _) = true
isPublic FolderPublic = true
isPublic _ = false
{-
------------------------------------------------------------
instance Ord NodeType where
compare n1 n2 = compare (show n1) (show n2)
instance Eq NodeType where
eq n1 n2 = eq (show n1) (show n2)
-}
------------------------------------------------------------
nodeTypePath :: NodeType -> String
nodeTypePath Folder = "folder"
nodeTypePath FolderPrivate = "folderPrivate"
nodeTypePath FolderShared = "folderShared"
nodeTypePath FolderPublic = "folderPublic"
nodeTypePath Annuaire = "annuaire"
nodeTypePath Corpus = "corpus"
nodeTypePath Dashboard = "dashboard"
nodeTypePath Url_Document = "document"
nodeTypePath Error = "ErrorNodeType"
nodeTypePath Graph = "graph"
nodeTypePath Phylo = "phylo"
nodeTypePath Individu = "individu"
nodeTypePath Node = "node"
nodeTypePath Nodes = "nodes"
nodeTypePath NodeUser = "user"
nodeTypePath NodeContact = "contact"
nodeTypePath Tree = "tree"
nodeTypePath NodeList = "lists"
nodeTypePath Texts = "texts"
nodeTypePath Team = "team"
nodeTypePath NodeFrameWrite = "write"
nodeTypePath NodeFrameCalc = "calc"
nodeTypePath NodeFrameNotebook = "code"
nodeTypePath NodeFrameVisio = "visio"
nodeTypePath (NodePublic nt) = nodeTypePath nt
nodeTypePath NodeFile = "file"
------------------------------------------------------------
type CorpusId = Int
type DocId = Int
type ListId = Int
type AnnuaireId = Int
type ContactId = Int
data ScoreType = Occurrences
derive instance Generic ScoreType _
instance Eq ScoreType where eq = genericEq
instance Show ScoreType where show = genericShow
type SearchQuery = String
type NgramsGetOpts =
{ limit :: Limit
, listIds :: Array ListId
, offset :: Maybe Offset
, orderBy :: Maybe OrderBy
, searchQuery :: SearchQuery
, tabType :: TabType
, termListFilter :: Maybe TermList
, termSizeFilter :: Maybe TermSize
}
type NgramsGetTableAllOpts =
{ listIds :: Array ListId
, tabType :: TabType
}
type SearchOpts =
{ {-id :: Int
, query :: Array String
,-}
listId :: Int
, limit :: Limit
, offset :: Offset
, orderBy :: Maybe OrderBy
}
type CorpusMetricOpts =
{ tabType :: TabType
, listId :: ListId
, limit :: Maybe Limit
}
type ChartOpts =
{ chartType :: ChartType
, limit :: Maybe Limit
, listId :: Maybe ListId
, tabType :: TabType
}
data NodePath = NodePath SessionId NodeType (Maybe Id)
nodePath :: NodePath -> String
nodePath (NodePath s t i) = nodeTypePath t <> "/" <> show s <> id
where id = maybe "" (\j -> "/" <> show j) i
data ChartType = Histo | Scatter | ChartPie | ChartBar | ChartTree
instance Show ChartType
where
show Histo = "chart"
show Scatter = "scatter"
show ChartBar = "bar"
show ChartPie = "pie"
show ChartTree = "tree"
chartTypeFromString :: String -> Maybe ChartType
chartTypeFromString "bar" = Just ChartBar
chartTypeFromString "chart" = Just Histo
chartTypeFromString "pie" = Just ChartPie
chartTypeFromString "scatter" = Just Scatter
chartTypeFromString "tree" = Just ChartTree
chartTypeFromString _ = Nothing
type Id = Int
type Limit = Int
type Offset = Int
data OrderBy = DateAsc | DateDesc
| TitleAsc | TitleDesc
| ScoreAsc | ScoreDesc
| TermAsc | TermDesc
| SourceAsc | SourceDesc
derive instance Generic OrderBy _
instance Show OrderBy where show = genericShow
instance JSON.ReadForeign OrderBy where readImpl = JSONG.enumSumRep
instance JSON.WriteForeign OrderBy where writeImpl = JSON.writeImpl <<< show
------------------------------------------------------------
-- V0 is the dummy case (impossible)
data ApiVersion = V0 | V10 | V11
derive instance Generic ApiVersion _
instance JSON.ReadForeign ApiVersion where
readImpl f = do
s <- JSON.readImpl f
case s of
"v0" -> pure V0
"v1.0" -> pure V10
"v1.1" -> pure V11
x -> F.fail $ F.ErrorAtProperty x $ F.ForeignError "unknown API value"
instance JSON.WriteForeign ApiVersion where
writeImpl v = F.unsafeToForeign $ JSON.writeImpl $ show v
instance Show ApiVersion where
show V0 = "v0"
show V10 = "v1.0"
show V11 = "v1.1"
instance Eq ApiVersion where
eq V10 V10 = true
eq V11 V11 = true
eq _ _ = false
------------------------------------------------------------
-- Types of ngrams. Used to display user-selectable tabs and is sent via API,
-- wrapped in `TabNgramType a :: TabSubType`
data CTabNgramType = CTabTerms | CTabSources | CTabAuthors | CTabInstitutes
derive instance Generic CTabNgramType _
derive instance Eq CTabNgramType
derive instance Ord CTabNgramType
instance Show CTabNgramType where
show CTabTerms = "Terms"
show CTabSources = "Sources"
show CTabAuthors = "Authors"
show CTabInstitutes = "Institutes"
instance JSON.WriteForeign CTabNgramType where writeImpl = JSON.writeImpl <<< show
data PTabNgramType = PTabPatents | PTabBooks | PTabCommunication
derive instance Generic PTabNgramType _
instance Eq PTabNgramType where eq = genericEq
instance Ord PTabNgramType where compare = genericCompare
instance Show PTabNgramType where
show PTabPatents = "Patents"
show PTabBooks = "Books"
show PTabCommunication = "Communication"
instance JSON.WriteForeign PTabNgramType where writeImpl = JSON.writeImpl <<< show
data TabSubType a = TabDocs | TabNgramType a | TabTrash | TabMoreLikeFav | TabMoreLikeTrash
derive instance Generic (TabSubType a) _
instance Eq a => Eq (TabSubType a) where eq = genericEq
instance Ord a => Ord (TabSubType a) where compare = genericCompare
instance JSON.WriteForeign a => JSON.WriteForeign (TabSubType a) where
writeImpl TabDocs = JSON.writeImpl { type: "TabDocs"
, data: (Nothing :: Maybe String) }
writeImpl (TabNgramType a) = JSON.writeImpl { type: "TabNgramType"
, data: a }
writeImpl TabTrash = JSON.writeImpl { type: "TabTrash"
, data: (Nothing :: Maybe String) }
writeImpl TabMoreLikeFav = JSON.writeImpl { type: "TabMoreLikeFav"
, data: (Nothing :: Maybe String) }
writeImpl TabMoreLikeTrash = JSON.writeImpl { type: "TabMoreLikeTrash"
, data: (Nothing :: Maybe String) }
{-
instance DecodeJson a => DecodeJson (TabSubType a) where
decodeJson j = do
obj <- decodeJson j
typ <- obj .: "type"
dat <- obj .: "data"
case typ of
"TabDocs" -> TabDocs
"TabNgramType" -> TabNgramType dat
"TabTrash" -> TabTrash
"TabMoreLikeFav" -> TabMoreLikeFav
"TabMoreLikeTrash" -> TabMoreLikeTrash
_ -> Left ("Unknown type '" <> typ <> "'") -}
instance Show a => Show (TabSubType a) where
show TabDocs = "Docs"
show (TabNgramType a) = show a
show TabTrash = "Trash"
show TabMoreLikeFav = "MoreFav"
show TabMoreLikeTrash = "MoreTrash"
data TabType
= TabCorpus (TabSubType CTabNgramType)
| TabPairing (TabSubType PTabNgramType)
| TabDocument (TabSubType CTabNgramType)
derive instance Generic TabType _
derive instance Eq TabType
derive instance Ord TabType
instance Show TabType where show = genericShow
instance JSON.WriteForeign TabType where
writeImpl (TabCorpus TabDocs) = JSON.writeImpl "Docs"
writeImpl (TabCorpus (TabNgramType CTabAuthors)) = JSON.writeImpl "Authors"
writeImpl (TabCorpus (TabNgramType CTabInstitutes)) = JSON.writeImpl "Institutes"
writeImpl (TabCorpus (TabNgramType CTabSources)) = JSON.writeImpl "Sources"
writeImpl (TabCorpus (TabNgramType CTabTerms)) = JSON.writeImpl "Terms"
writeImpl (TabCorpus TabMoreLikeFav) = JSON.writeImpl "MoreFav"
writeImpl (TabCorpus TabMoreLikeTrash) = JSON.writeImpl "MoreTrash"
writeImpl (TabCorpus TabTrash) = JSON.writeImpl "Trash"
writeImpl (TabDocument TabDocs) = JSON.writeImpl "Docs"
writeImpl (TabDocument (TabNgramType CTabAuthors)) = JSON.writeImpl "Authors"
writeImpl (TabDocument (TabNgramType CTabInstitutes)) = JSON.writeImpl "Institutes"
writeImpl (TabDocument (TabNgramType CTabSources)) = JSON.writeImpl "Sources"
writeImpl (TabDocument (TabNgramType CTabTerms)) = JSON.writeImpl "Terms"
writeImpl (TabDocument TabMoreLikeFav) = JSON.writeImpl "MoreFav"
writeImpl (TabDocument TabMoreLikeTrash) = JSON.writeImpl "MoreTrash"
writeImpl (TabDocument TabTrash) = JSON.writeImpl "Trash"
writeImpl (TabPairing _d) = JSON.writeImpl "TabPairing" -- TODO
-- ["Docs","Trash","MoreFav","MoreTrash","Terms","Sources","Authors","Institutes","Contacts"]
{-
instance DecodeJson TabType where
decodeJson j = do
obj <- decodeJson j
typ <- obj .: "type"
dat <- obj .: "data"
case typ of
"TabCorpus" -> TabCorpus dat
"TabDocument" -> TabDocument dat
"TabPairing" -> TabPairing dat
_ -> Left ("Unknown type '" <> typ <> "'") -}
type TableResult a = {count :: Int, docs :: Array a}
type AffTableResult a = Aff (TableResult a)
type AffETableResult a = Aff (Either RESTError (TableResult a))
data Mode = Authors
| Sources
| Institutes
| Terms
derive instance Generic Mode _
instance Show Mode where show = genericShow
instance Eq Mode where eq = genericEq
instance Ord Mode where compare = genericCompare
instance JSON.WriteForeign Mode where writeImpl = JSON.writeImpl <<< show
modeTabType :: Mode -> CTabNgramType
modeTabType Authors = CTabAuthors
modeTabType Institutes = CTabInstitutes
modeTabType Sources = CTabSources
modeTabType Terms = CTabTerms
modeFromString :: String -> Maybe Mode
modeFromString "Authors" = Just Authors
modeFromString "Institutes" = Just Institutes
modeFromString "Sources" = Just Sources
modeFromString "Terms" = Just Terms
modeFromString _ = Nothing
-- Async tasks
-- corresponds to /add/form/async or /add/query/async
data AsyncTaskType = AddNode
| Form -- this is file upload too
| GraphRecompute
| ListUpload
| ListCSVUpload -- legacy v3 CSV upload for lists
| Query
| UpdateNgramsCharts
| UpdateNode
| UploadFile
derive instance Generic AsyncTaskType _
instance JSON.ReadForeign AsyncTaskType where
readImpl = JSONG.enumSumRep
instance Eq AsyncTaskType where
eq = genericEq
instance Show AsyncTaskType where
show = genericShow
asyncTaskTypePath :: AsyncTaskType -> String
asyncTaskTypePath AddNode = "async/nobody/"
asyncTaskTypePath Form = "add/form/async/"
asyncTaskTypePath GraphRecompute = "async/recompute/"
asyncTaskTypePath ListUpload = "add/form/async/"
asyncTaskTypePath ListCSVUpload = "csv/add/form/async/"
asyncTaskTypePath Query = "query/"
asyncTaskTypePath UpdateNgramsCharts = "ngrams/async/charts/update/"
asyncTaskTypePath UpdateNode = "update/"
asyncTaskTypePath UploadFile = "async/file/add/"
type AsyncTaskID = String
data AsyncTaskStatus = IsRunning
| IsPending
| IsReceived
| IsStarted
| IsFailure
| IsFinished
| IsKilled
derive instance Generic AsyncTaskStatus _
instance JSON.ReadForeign AsyncTaskStatus where
readImpl = JSONG.enumSumRep
instance Show AsyncTaskStatus where
show = genericShow
derive instance Eq AsyncTaskStatus
-- instance Read AsyncTaskStatus where
-- read "IsFailure" = Just Failed
-- read "IsFinished" = Just Finished
-- read "IsKilled" = Just Killed
-- read "IsPending" = Just Pending
-- read "IsReceived" = Just Received
-- read "IsRunning" = Just Running
-- read "IsStarted" = Just Started
-- read _ = Nothing
newtype AsyncTask =
AsyncTask { id :: AsyncTaskID
, status :: AsyncTaskStatus
}
derive instance Generic AsyncTask _
derive instance Newtype AsyncTask _
derive newtype instance JSON.ReadForeign AsyncTask
instance Eq AsyncTask where eq = genericEq
newtype AsyncTaskWithType = AsyncTaskWithType {
task :: AsyncTask
, typ :: AsyncTaskType
}
derive instance Generic AsyncTaskWithType _
derive instance Newtype AsyncTaskWithType _
derive newtype instance JSON.ReadForeign AsyncTaskWithType
instance Eq AsyncTaskWithType where
eq = genericEq
newtype AsyncProgress = AsyncProgress {
id :: AsyncTaskID
, log :: Array AsyncTaskLog
, status :: AsyncTaskStatus
}
derive instance Generic AsyncProgress _
derive instance Newtype AsyncProgress _
derive newtype instance JSON.ReadForeign AsyncProgress
newtype AsyncTaskLog = AsyncTaskLog {
events :: Array String
, failed :: Int
, remaining :: Int
, succeeded :: Int
}
derive instance Generic AsyncTaskLog _
derive instance Newtype AsyncTaskLog _
derive newtype instance JSON.ReadForeign AsyncTaskLog
progressPercent :: AsyncProgress -> Number
progressPercent (AsyncProgress {log}) = perc
where
perc = case A.head log of
Nothing -> 0.0
Just (AsyncTaskLog {failed, remaining, succeeded}) -> 100.0*nom/denom
where
nom = toNumber $ failed + succeeded
denom = toNumber $ failed + succeeded + remaining
---------------------------------------------------------------------------
-- | GarganText Internal Sugar
prettyNodeType :: NodeType -> String
prettyNodeType nt = S.replace (S.Pattern "Node") (S.Replacement " ")
$ S.replace (S.Pattern "Folder") (S.Replacement " ")
$ show nt
---------------------------------------------------------------------------
data SidePanelState = InitialClosed | Opened | Closed
derive instance Generic SidePanelState _
instance Eq SidePanelState where eq = genericEq
toggleSidePanelState :: SidePanelState -> SidePanelState
toggleSidePanelState InitialClosed = Opened
toggleSidePanelState Closed = Opened
toggleSidePanelState Opened = Closed
---------------------------------------------------------------------------
data FrontendError = FStringError
{ error :: String
} | FRESTError
{ error :: RESTError }
derive instance Generic FrontendError _
instance Eq FrontendError where eq = genericEq
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils.purs 0000664 0000000 0000000 00000006205 14111104351 0030432 0 ustar 00root root 0000000 0000000 module Gargantext.Utils where
import Data.Char (fromCharCode)
import Data.Either (Either(..))
import Data.Foldable (class Foldable, foldr)
import Data.Lens (Lens', lens)
import Data.Maybe (fromJust)
import Data.Newtype (class Newtype, unwrap, wrap)
import Data.Sequence.Ordered as OSeq
import Data.Set (Set)
import Data.Set as Set
import Data.String as S
import Data.String.CodeUnits (singleton)
import Data.Unfoldable (class Unfoldable)
import Effect (Effect)
import Prelude
import Partial.Unsafe (unsafePartial)
import Web.HTML as WHTML
import Web.HTML.Location as WHL
import Web.HTML.Window (location)
-- | TODO (hard coded)
csrfMiddlewareToken :: String
csrfMiddlewareToken = "Wy52D2nor8kC1r1Y4GrsrSIxQ2eqW8UwkdiQQshMoRwobzU4uldknRUhP0j4WcEM"
setterv :: forall nt record field.
Newtype nt record
=> (record -> field -> record)
-> field
-> nt
-> nt
setterv fn v t = (setter (flip fn v) t)
setter :: forall nt record.
Newtype nt record
=> (record -> record)
-> nt
-> nt
setter fn = wrap <<< fn <<< unwrap
getter :: forall record field nt.
Newtype nt record
=> (record -> field)
-> nt
-> field
getter fn = fn <<< unwrap
-- 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
-- Default sort order is ascending, we may want descending
invertOrdering :: Ordering -> Ordering
invertOrdering LT = GT
invertOrdering GT = LT
invertOrdering EQ = EQ
-- A lens that always returns unit
_unit :: forall s. Lens' s Unit
_unit = lens (\_ -> unit) (\s _ -> s)
-- | Format a number with specified amount of zero-padding
zeroPad :: Int -> Int -> String
zeroPad pad num = zeros <> (show num)
where
numDigits = S.length $ show num
zeros = if numDigits < pad then zeros' (pad - numDigits) else ""
zeros' 0 = ""
zeros' n = "0" <> (zeros' (n - 1))
queryMatchesLabel :: String -> String -> Boolean
queryMatchesLabel q l = S.contains (S.Pattern $ normalize q) (normalize l)
where
normalize = S.toLower
mapLeft :: forall l m r. (l -> m) -> Either l r -> Either m r
mapLeft f (Left l) = Left (f l)
mapLeft _ (Right r) = Right r
data On a b = On a b
instance Eq a => Eq (On a b) where
eq (On x _) (On y _) = eq x y
instance Ord a => Ord (On a b) where
compare (On x _) (On y _) = compare x y
-- same as
-- https://github.com/purescript/purescript-arrays/blob/v5.3.1/src/Data/Array.purs#L715-L715
sortWith :: forall a b f. Functor f =>
Foldable f =>
Unfoldable f =>
Ord b =>
(a -> b) -> f a -> f a
sortWith f = map (\(On _ y) -> y) <<< OSeq.toUnfoldable <<< foldr (\x -> OSeq.insert (On (f x) x)) OSeq.empty
href :: Effect String
href = do
w <- WHTML.window
loc <- location w
WHL.href loc
nbsp :: Int -> String
nbsp = nbsp' ""
where
char = singleton $ unsafePartial $ fromJust $ fromCharCode 160
nbsp' acc n
| n <= 0 = acc
| otherwise = nbsp' (acc <> char) (n - 1)
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils/ 0000775 0000000 0000000 00000000000 14111104351 0027514 5 ustar 00root root 0000000 0000000 Argonaut.purs 0000664 0000000 0000000 00000011101 14111104351 0032122 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils module Gargantext.Utils.Argonaut where
import Prelude
import Control.Alt ((<|>))
import Data.Argonaut (Json)
import Data.Argonaut as Argonaut
import Data.Argonaut.Decode.Error (JsonDecodeError(..))
import Data.Either (Either(..))
import Data.Generic.Rep as GR
import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol)
-- | Provide a generic sum JSON decoding for sum types deriving Generic
genericSumDecodeJson
:: forall a rep
. GR.Generic a rep
=> GenericSumDecodeJsonRep rep
=> Json
-> Either JsonDecodeError a
genericSumDecodeJson f =
GR.to <$> genericSumDecodeJsonRep f
-- | Provide a generic sum JSON encoding for sum types deriving Generic
genericSumEncodeJson
:: forall a rep
. GR.Generic a rep
=> GenericSumEncodeJsonRep rep
=> a
-> Json
genericSumEncodeJson f =
genericSumEncodeJsonRep $ GR.from f
class GenericSumDecodeJsonRep rep where
genericSumDecodeJsonRep :: Json -> Either JsonDecodeError rep
class GenericSumEncodeJsonRep rep where
genericSumEncodeJsonRep :: rep -> Json
instance
( GenericSumDecodeJsonRep a
, GenericSumDecodeJsonRep b
) => GenericSumDecodeJsonRep (GR.Sum a b) where
genericSumDecodeJsonRep f
= GR.Inl <$> genericSumDecodeJsonRep f
<|> GR.Inr <$> genericSumDecodeJsonRep f
instance
( GenericSumDecodeJsonRep a
, IsSymbol name
) => GenericSumDecodeJsonRep (GR.Constructor name a) where
genericSumDecodeJsonRep f = do
-- here we attempt to read the following json:
-- { "ConstructorName": argument }
let name = reflectSymbol (SProxy :: _ name)
obj <- Argonaut.decodeJson f
inner <- Argonaut.getField obj name
argument <- genericSumDecodeJsonRep inner
pure $ GR.Constructor argument
instance
GenericSumDecodeJsonRep (GR.NoArguments) where
genericSumDecodeJsonRep _ = do
pure GR.NoArguments
instance
( Argonaut.DecodeJson a
) => GenericSumDecodeJsonRep (GR.Argument a) where
genericSumDecodeJsonRep f = GR.Argument <$> Argonaut.decodeJson f
instance
( GenericSumEncodeJsonRep a
, GenericSumEncodeJsonRep b
) => GenericSumEncodeJsonRep (GR.Sum a b) where
genericSumEncodeJsonRep (GR.Inl f) = genericSumEncodeJsonRep f
genericSumEncodeJsonRep (GR.Inr f) = genericSumEncodeJsonRep f
instance
( GenericSumEncodeJsonRep a
, IsSymbol name
) => GenericSumEncodeJsonRep (GR.Constructor name a) where
genericSumEncodeJsonRep (GR.Constructor inner) = do
-- here we attempt to write the following json:
-- { "ConstructorName": argument }
let name = reflectSymbol (SProxy :: _ name)
let argument = genericSumEncodeJsonRep inner
Argonaut.jsonSingletonObject name argument
instance
GenericSumEncodeJsonRep GR.NoArguments where
genericSumEncodeJsonRep GR.NoArguments = Argonaut.jsonNull
instance
( Argonaut.EncodeJson a
) => GenericSumEncodeJsonRep (GR.Argument a) where
genericSumEncodeJsonRep (GR.Argument f) = Argonaut.encodeJson f
genericEnumDecodeJson :: forall a rep
. GR.Generic a rep
=> GenericEnumDecodeJson rep
=> Json
-> Either JsonDecodeError a
genericEnumDecodeJson f =
GR.to <$> genericEnumDecodeJsonRep f
-- | Generic Enum Sum Representations, with constructor names as strings
class GenericEnumDecodeJson rep where
genericEnumDecodeJsonRep :: Json -> Either JsonDecodeError rep
instance
( GenericEnumDecodeJson a
, GenericEnumDecodeJson b
) => GenericEnumDecodeJson (GR.Sum a b) where
genericEnumDecodeJsonRep f
= GR.Inl <$> genericEnumDecodeJsonRep f
<|> GR.Inr <$> genericEnumDecodeJsonRep f
instance
( IsSymbol name
) => GenericEnumDecodeJson (GR.Constructor name GR.NoArguments) where
genericEnumDecodeJsonRep f = do
s <- Argonaut.decodeJson f
if s == name
then pure $ GR.Constructor GR.NoArguments
else Left $ Named s $ TypeMismatch $ "Enum did not match expected string " <> name
where
name = reflectSymbol (SProxy :: SProxy name)
genericEnumEncodeJson :: forall a rep
. GR.Generic a rep
=> GenericEnumEncodeJson rep
=> a
-> Json
genericEnumEncodeJson f =
genericEnumEncodeJsonRep $ GR.from f
-- | Generic Enum Sum Representations, with constructor names as strings
class GenericEnumEncodeJson rep where
genericEnumEncodeJsonRep :: rep -> Json
instance
( GenericEnumEncodeJson a
, GenericEnumEncodeJson b
) => GenericEnumEncodeJson (GR.Sum a b) where
genericEnumEncodeJsonRep (GR.Inl x) = genericEnumEncodeJsonRep x
genericEnumEncodeJsonRep (GR.Inr x) = genericEnumEncodeJsonRep x
instance
( IsSymbol name
) => GenericEnumEncodeJson (GR.Constructor name GR.NoArguments) where
genericEnumEncodeJsonRep _ = Argonaut.encodeJson $ reflectSymbol (SProxy :: SProxy name)
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils/Array.js 0000664 0000000 0000000 00000000075 14111104351 0031132 0 ustar 00root root 0000000 0000000 function _push(a, i) {
a.push(i);
}
exports._push = _push;
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils/Array.purs 0000664 0000000 0000000 00000001343 14111104351 0031506 0 ustar 00root root 0000000 0000000 module Gargantext.Utils.Array (max, min, push) where
import Data.Array as A
import Data.Foldable (foldr)
import Data.Maybe (Maybe(..))
import Data.Ord as Ord
import Effect (Effect)
import Effect.Uncurried (EffectFn2, runEffectFn2)
import Gargantext.Prelude
foreign import _push :: forall a. EffectFn2 (Array a) a Unit
push :: forall a. Array a -> a -> Effect Unit
push = runEffectFn2 _push
max :: forall a. Ord a => Array a -> Maybe a
max xs = foldr reducer (A.head xs) xs
where
reducer _ Nothing = Nothing
reducer v (Just acc) = Just $ Ord.max acc v
min :: forall a. Ord a => Array a -> Maybe a
min xs = foldr reducer (A.head xs) xs
where
reducer _ Nothing = Nothing
reducer v (Just acc) = Just $ Ord.min acc v
BootstrapNative.js 0000664 0000000 0000000 00000000253 14111104351 0033117 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils "use strict";
exports.createDropdown = function(iid) {
var el = document.getElementById(iid);
if (!window.Dropdown) return;
new window.Dropdown(el, {});
};
BootstrapNative.purs 0000664 0000000 0000000 00000000231 14111104351 0033470 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils module Gargantext.Utils.BootstrapNative where
import Effect (Effect)
import Gargantext.Prelude
foreign import createDropdown :: String -> Effect Unit
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils/CacheAPI.js 0000664 0000000 0000000 00000001570 14111104351 0031412 0 ustar 00root root 0000000 0000000 exports._makeRequest = function(url) {
return function(options) {
return new Request(url, options);
}
}
exports._openCache = function(cacheName) {
return function() {
return window.caches.open(cacheName);
}
}
exports._delete = function(cacheName) {
return function() {
return caches.delete(cacheName);
}
}
exports._deleteReq = function(cache) {
return function(req) {
return function() {
return cache.delete(req);
}
}
}
exports._add = function(cache) {
return function(req) {
return function() {
return cache.add(req);
}
}
}
exports._match = function(cache) {
return function(req) {
return function() {
return cache.match(req);
}
}
}
exports._fetch = function(req) {
return function() {
return fetch(req);
}
}
CacheAPI.purs 0000664 0000000 0000000 00000010667 14111104351 0031717 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils module Gargantext.Utils.CacheAPI where
import Control.Monad.Except (runExcept)
import Control.Promise (Promise, toAffE)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))
import Effect (Effect)
import Effect.Aff (Aff, throwError)
import Effect.Exception (error)
import Foreign as F
import Foreign.Object as O
import Milkis as M
import Simple.JSON as JSON
import Type.Row (class Union)
import Gargantext.Prelude hiding (add)
import Gargantext.Ends (class ToUrl, toUrl)
import Gargantext.Sessions (Session(..))
get :: forall a p. JSON.ReadForeign a => ToUrl Session p => Cache -> Session -> p -> Aff a
get cache session p = do
let req = makeGetRequest session p
res <- cached cache req
j <- M.text res
case JSON.readJSON j of
Left err -> throwError $ error $ "decodeJson affResp.body: " <> show err
Right b -> pure b
foreign import data Cache :: Type
foreign import data Request :: Type
newtype CacheName = CacheName String
type Token = String
makeRequest :: forall options trash. Union options trash M.Options =>
M.URL -> { method :: M.Method, headers :: M.Headers | options } -> Request
makeRequest url options = _makeRequest url options
makeTokenRequest :: forall options trash. Union options trash M.Options =>
M.URL -> Maybe Token -> { method :: M.Method, headers :: M.Headers | options } -> Request
makeTokenRequest url mToken options = case mToken of
Nothing -> makeRequest url $ options { headers = mkHeaders O.empty }
Just t -> makeRequest url $ options { headers = mkHeaders $ O.singleton "Authorization" $ "Bearer " <> t }
where
defaultOptions = O.fromFoldable [ Tuple "Accept" "application/json"
, Tuple "Content-Type" "application/json" ]
mkHeaders t = O.unions [ options.headers, defaultOptions, t ]
makeGetRequest :: forall p. ToUrl Session p => Session -> p -> Request
makeGetRequest session@(Session { token }) p = makeTokenRequest url (Just token) { method, headers: O.empty }
where
method = M.getMethod
url = M.URL $ toUrl session p
openCache :: CacheName -> Aff Cache
openCache (CacheName cacheName) = toAffE $ _openCache cacheName
delete :: CacheName -> Aff Unit
delete (CacheName cacheName) = toAffE $ _delete cacheName
add :: Cache -> Request -> Aff Unit
add cache req = toAffE $ _add cache req
match :: Cache -> Request -> Aff (Maybe M.Response)
match cache req = do
res <- toAffE $ _match cache req
-- _match returns a null/undefined value when cache entity not found
case runExcept $ F.readNullOrUndefined res of
Left err -> throwError $ error $ show err
Right v -> pure $ F.unsafeFromForeign <$> v
cached :: Cache -> Request -> Aff M.Response
cached cache req = do
mRes <- match cache req
case mRes of
Just res -> do
-- liftEffect $ log2 "[cached] cache hit" req
pure res
Nothing -> do
-- liftEffect $ log2 "[cached] cache miss" req
_ <- add cache req
mResFresh <- match cache req
case mResFresh of
Just res -> pure res
Nothing -> throwError $ error $ "[cached] Cannot add to cache"
cachedJson :: forall a. JSON.ReadForeign a => Cache -> Request -> Aff a
cachedJson cache req = do
res <- cached cache req
-- liftEffect $ do
-- log2 "[cachedJson] res" res
j <- M.text res
case JSON.readJSON j of
Left err -> throwError $ error $ "[cachedJson] decodeJson affResp.body: " <> show err
Right b -> pure b
deleteReq :: Cache -> Request -> Aff Unit
deleteReq cache req = toAffE $ _deleteReq cache req
-- No cache: raw API calls
fetch :: Request -> Aff M.Response
fetch req = do
res <- toAffE $ _fetch req
pure $ F.unsafeFromForeign res
pureJson :: forall a. JSON.ReadForeign a => Request -> Aff a
pureJson req = do
res <- fetch req
j <- M.text res
case JSON.readJSON j of
Left err -> throwError $ error $ "[pureJson] decodeJson affResp.body: " <> show err
Right b -> pure b
foreign import _makeRequest :: forall options trash.
M.URL -> { method :: M.Method, headers :: M.Headers | options } -> Request
foreign import _openCache :: String -> Effect (Promise Cache)
foreign import _delete :: String -> Effect (Promise Unit)
foreign import _deleteReq :: Cache -> Request -> Effect (Promise Unit)
foreign import _add :: Cache -> Request -> Effect (Promise Unit)
foreign import _match :: Cache -> Request -> Effect (Promise F.Foreign)
foreign import _fetch :: Request -> Effect (Promise F.Foreign)
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils/Crypto.purs 0000664 0000000 0000000 00000001617 14111104351 0031714 0 ustar 00root root 0000000 0000000 module Gargantext.Utils.Crypto where
import Crypto.Simple as Crypto
import Data.Set (Set)
import Data.Set as Set
import Data.Array as Array
import Gargantext.Prelude
-- | TODO use newtype to disambiguate Set String and Set Hash
-- Set String needs Set.map hash
-- Set Hash does not need Set.map hash (just concat)
type Hash = String
hash' :: forall a. Crypto.Hashable a => a -> String
hash' = Crypto.toString <<< Crypto.hash Crypto.SHA256
class IsHashable a where
hash :: a -> Hash
instance IsHashable String
where
hash = hash'
instance (Crypto.Hashable a, IsHashable a) => IsHashable (Array a)
where
hash = hash <<< Set.fromFoldable <<< map hash
instance IsHashable (Set String) where
hash = hash <<< concat <<< toArray
where
toArray :: forall a. Set a -> Array a
toArray = Set.toUnfoldable
concat :: Array Hash -> String
concat = Array.foldl (<>) ""
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils/Debug.js 0000664 0000000 0000000 00000000105 14111104351 0031074 0 ustar 00root root 0000000 0000000 function _debugger(a) {
debugger;
}
exports._debugger = _debugger;
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils/Debug.purs 0000664 0000000 0000000 00000000546 14111104351 0031462 0 ustar 00root root 0000000 0000000 module Gargantext.Utils.Debug where
import Data.Array as A
import Data.Foldable (foldr)
import Data.Maybe (Maybe(..))
import Data.Ord as Ord
import Effect (Effect)
import Effect.Uncurried (EffectFn1, runEffectFn1)
import Gargantext.Prelude
foreign import _debugger :: EffectFn1 Unit Unit
debugger :: Unit -> Effect Unit
debugger = runEffectFn1 _debugger
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils/Either.purs 0000664 0000000 0000000 00000001462 14111104351 0031652 0 ustar 00root root 0000000 0000000 module Gargantext.Utils.Either where
import Gargantext.Prelude
import Data.Array (cons, uncons)
import Data.Either (Either(..))
import Data.Map as Map
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))
eitherList :: forall l r. Array (Either l r) -> Either l (Array r)
eitherList xs = case uncons xs of
Nothing -> Right []
Just { head: Left x } -> Left x
Just { head: Right x, tail } ->
case eitherList tail of
Left err -> Left err
Right ds -> Right (cons x ds)
eitherMap :: forall k l r. Ord k => Map.Map k (Either l r) -> Either l (Map.Map k r)
eitherMap m = case eitherList (helper <$> Map.toUnfoldable m) of
Left err -> Left err
Right lst -> Right $ Map.fromFoldable lst
where
helper (Tuple _ (Left err)) = Left err
helper (Tuple k (Right v)) = Right (Tuple k v)
Glyphicon.purs 0000664 0000000 0000000 00000046750 14111104351 0032320 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils module Gargantext.Utils.Glyphicon where
import Data.Char (fromCharCode)
import Data.Maybe (fromJust)
import Data.String.CodeUnits (singleton)
import Gargantext.Prelude ((<>), ($), (<<<))
import Partial.Unsafe (unsafePartial)
classNamePrefix :: String
classNamePrefix = "fa fa-"
glyphicon :: String -> String
glyphicon t = "btn glyphitem " <> classNamePrefix <> t
glyphiconActive :: String -> Boolean -> String
glyphiconActive icon b = glyphicon icon <> if b then " active" else ""
-- (?) UI print Glyphicon directly on text node
--
-- * convert "Glyphicon ForkAwesome" classNames to CharCode [1]
-- * bypass React "dangerousInnerHTML" via vanilla JavaScript coerce [2]
-- (see "forkawesome.css" dist file for conversion matching)
--
-- (?) No `crash` or `Nothing` value returned if unknown icon is provided
-- Identic design as the glyphicon className, eg: by providing an unknown
-- icon, a blank space will be output → same here, a blank char code will
-- be returned
--
-- [1] https://stackoverflow.com/a/54002856/6003907
-- [2] https://github.com/facebook/react/issues/3769#issuecomment-97163582
glyphiconToCharCode :: String -> String
glyphiconToCharCode = _toString <<< case _ of
"500px" -> 0xf26e
"activitypub" -> 0xf2f2
"address-book" -> 0xf2b9
"address-book-o" -> 0xf2ba
"address-card" -> 0xf2bb
"address-card-o" -> 0xf2bc
"adjust" -> 0xf042
"adn" -> 0xf170
"align-center" -> 0xf037
"align-justify" -> 0xf039
"align-left" -> 0xf036
"align-right" -> 0xf038
"amazon" -> 0xf270
"ambulance" -> 0xf0f9
"american-sign-language-interpreting" -> 0xf2a3
"anchor" -> 0xf13d
"android" -> 0xf17b
"angellist" -> 0xf209
"angle-double-down" -> 0xf103
"angle-double-left" -> 0xf100
"angle-double-right" -> 0xf101
"angle-double-up" -> 0xf102
"angle-down" -> 0xf107
"angle-left" -> 0xf104
"angle-right" -> 0xf105
"angle-up" -> 0xf106
"apple" -> 0xf179
"archive" -> 0xf187
"archive-org" -> 0xf2fc
"archlinux" -> 0xf323
"area-chart" -> 0xf1fe
"arrow-circle-down" -> 0xf0ab
"arrow-circle-left" -> 0xf0a8
"arrow-circle-o-down" -> 0xf01a
"arrow-circle-o-left" -> 0xf190
"arrow-circle-o-right" -> 0xf18e
"arrow-circle-o-up" -> 0xf01b
"arrow-circle-right" -> 0xf0a9
"arrow-circle-up" -> 0xf0aa
"arrow-down" -> 0xf063
"arrow-left" -> 0xf060
"arrow-right" -> 0xf061
"arrow-up" -> 0xf062
"arrows" -> 0xf047
"arrows-alt" -> 0xf0b2
"arrows-h" -> 0xf07e
"arrows-v" -> 0xf07d
"artstation" -> 0xf2ed
"assistive-listening-systems" -> 0xf2a2
"asterisk" -> 0xf069
"at" -> 0xf1fa
"att" -> 0xf31e
"audio-description" -> 0xf29e
"backward" -> 0xf04a
"balance-scale" -> 0xf24e
"ballot" -> 0xf342
"ballot-circle" -> 0xf343
"ban" -> 0xf05e
"bandcamp" -> 0xf2d5
"bar-chart" -> 0xf080
"barcode" -> 0xf02a
"bars" -> 0xf0c9
"bath" -> 0xf2cd
"battery-empty" -> 0xf244
"battery-full" -> 0xf240
"battery-half" -> 0xf242
"battery-quarter" -> 0xf243
"battery-three-quarters" -> 0xf241
"bed" -> 0xf236
"beer" -> 0xf0fc
"behance" -> 0xf1b4
"behance-square" -> 0xf1b5
"bell" -> 0xf0f3
"bell-o" -> 0xf0a2
"bell-rigning-o" -> 0xf330
"bell-ringing" -> 0xf32d
"bell-slash" -> 0xf1f6
"bell-slash-o" -> 0xf1f7
"bicycle" -> 0xf206
"binoculars" -> 0xf1e5
"biometric" -> 0xf32b
"birthday-cake" -> 0xf1fd
"bitbucket" -> 0xf171
"bitbucket-square" -> 0xf172
"black-tie" -> 0xf27e
"blind" -> 0xf29d
"bluetooth" -> 0xf293
"bluetooth-b" -> 0xf294
"bold" -> 0xf032
"bolt" -> 0xf0e7
"bomb" -> 0xf1e2
"book" -> 0xf02d
"book-circle" -> 0xf33e
"bookmark" -> 0xf02e
"bookmark-o" -> 0xf097
"bootstrap" -> 0xf315
"braille" -> 0xf2a1
"briefcase" -> 0xf0b1
"btc" -> 0xf15a
"bug" -> 0xf188
"building" -> 0xf1ad
"building-o" -> 0xf0f7
"bullhorn" -> 0xf0a1
"bullseye" -> 0xf140
"bus" -> 0xf207
"buysellads" -> 0xf20d
"c" -> 0xf31c
"calculator" -> 0xf1ec
"calendar" -> 0xf073
"calendar-check-o" -> 0xf274
"calendar-minus-o" -> 0xf272
"calendar-o" -> 0xf133
"calendar-plus-o" -> 0xf271
"calendar-times-o" -> 0xf273
"camera" -> 0xf030
"camera-retro" -> 0xf083
"car" -> 0xf1b9
"caret-down" -> 0xf0d7
"caret-left" -> 0xf0d9
"caret-right" -> 0xf0da
"caret-square-o-down" -> 0xf150
"caret-square-o-left" -> 0xf191
"caret-square-o-right" -> 0xf152
"caret-square-o-up" -> 0xf151
"caret-up" -> 0xf0d8
"cart-arrow-down" -> 0xf218
"cart-plus" -> 0xf217
"cc" -> 0xf20a
"cc-amex" -> 0xf1f3
"cc-diners-club" -> 0xf24c
"cc-discover" -> 0xf1f2
"cc-jcb" -> 0xf24b
"cc-mastercard" -> 0xf1f1
"cc-paypal" -> 0xf1f4
"cc-stripe" -> 0xf1f5
"cc-visa" -> 0xf1f0
"certificate" -> 0xf0a3
"chain-broken" -> 0xf127
"check" -> 0xf00c
"check-circle" -> 0xf058
"check-circle-o" -> 0xf05d
"check-square" -> 0xf14a
"check-square-o" -> 0xf046
"chevron-circle-down" -> 0xf13a
"chevron-circle-left" -> 0xf137
"chevron-circle-right" -> 0xf138
"chevron-circle-up" -> 0xf139
"chevron-down" -> 0xf078
"chevron-left" -> 0xf053
"chevron-right" -> 0xf054
"chevron-up" -> 0xf077
"child" -> 0xf1ae
"chrome" -> 0xf268
"circle" -> 0xf111
"circle-o" -> 0xf10c
"circle-o-notch" -> 0xf1ce
"circle-thin" -> 0xf1db
"classicpress" -> 0xf331
"classicpress-circle" -> 0xf332
"clipboard" -> 0xf0ea
"clock-o" -> 0xf017
"clone" -> 0xf24d
"cloud" -> 0xf0c2
"cloud-download" -> 0xf0ed
"cloud-upload" -> 0xf0ee
"code" -> 0xf121
"code-fork" -> 0xf126
"codepen" -> 0xf1cb
"codiepie" -> 0xf284
"coffee" -> 0xf0f4
"cog" -> 0xf013
"cogs" -> 0xf085
"columns" -> 0xf0db
"comment" -> 0xf075
"comment-o" -> 0xf0e5
"commenting" -> 0xf27a
"commenting-o" -> 0xf27b
"comments" -> 0xf086
"comments-o" -> 0xf0e6
"compass" -> 0xf14e
"compress" -> 0xf066
"connectdevelop" -> 0xf20e
"contao" -> 0xf26d
"copyright" -> 0xf1f9
"creative-commons" -> 0xf25e
"credit-card" -> 0xf09d
"credit-card-alt" -> 0xf283
"crop" -> 0xf125
"crosshairs" -> 0xf05b
"css3" -> 0xf13c
"cube" -> 0xf1b2
"cubes" -> 0xf1b3
"cutlery" -> 0xf0f5
"dashcube" -> 0xf210
"database" -> 0xf1c0
"deaf" -> 0xf2a4
"debian" -> 0xf2ff
"delicious" -> 0xf1a5
"desktop" -> 0xf108
"dev-to" -> 0xf316
"deviantart" -> 0xf1bd
"diamond" -> 0xf219
"diaspora" -> 0xf2e5
"digg" -> 0xf1a6
"digitalocean" -> 0xf31d
"discord" -> 0xf2ee
"discord-alt" -> 0xf2ef
"dogmazic" -> 0xf303
"dot-circle-o" -> 0xf192
"download" -> 0xf019
"dribbble" -> 0xf17d
"dropbox" -> 0xf16b
"drupal" -> 0xf1a9
"edge" -> 0xf282
"eercast" -> 0xf2da
"eject" -> 0xf052
"ellipsis-h" -> 0xf141
"ellipsis-v" -> 0xf142
"emby" -> 0xf319
"empire" -> 0xf1d1
"envelope" -> 0xf0e0
"envelope-o" -> 0xf003
"envelope-open" -> 0xf2b6
"envelope-open-o" -> 0xf2b7
"envelope-square" -> 0xf199
"envira" -> 0xf299
"eraser" -> 0xf12d
"ethereum" -> 0xf2f3
"etsy" -> 0xf2d7
"eur" -> 0xf153
"exchange" -> 0xf0ec
"exclamation" -> 0xf12a
"exclamation-circle" -> 0xf06a
"exclamation-triangle" -> 0xf071
"expand" -> 0xf065
"expeditedssl" -> 0xf23e
"external-link" -> 0xf08e
"external-link-square" -> 0xf14c
"eye" -> 0xf06e
"eye-slash" -> 0xf070
"eyedropper" -> 0xf1fb
"f-droid" -> 0xf32a
"facebook" -> 0xf09a
"facebook-messenger" -> 0xf2fe
"facebook-official" -> 0xf230
"facebook-square" -> 0xf082
"fast-backward" -> 0xf049
"fast-forward" -> 0xf050
"fax" -> 0xf1ac
"female" -> 0xf182
"ffmpeg" -> 0xf30f
"fighter-jet" -> 0xf0fb
"file" -> 0xf15b
"file-archive-o" -> 0xf1c6
"file-audio-o" -> 0xf1c7
"file-code-o" -> 0xf1c9
"file-epub" -> 0xf321
"file-excel-o" -> 0xf1c3
"file-image-o" -> 0xf1c5
"file-o" -> 0xf016
"file-pdf-o" -> 0xf1c1
"file-powerpoint-o" -> 0xf1c4
"file-text" -> 0xf15c
"file-text-o" -> 0xf0f6
"file-video-o" -> 0xf1c8
"file-word-o" -> 0xf1c2
"files-o" -> 0xf0c5
"film" -> 0xf008
"filter" -> 0xf0b0
"fire" -> 0xf06d
"fire-extinguisher" -> 0xf134
"firefox" -> 0xf269
"first-order" -> 0xf2b0
"flag" -> 0xf024
"flag-checkered" -> 0xf11e
"flag-o" -> 0xf11d
"flask" -> 0xf0c3
"flickr" -> 0xf16e
"floppy-o" -> 0xf0c7
"folder" -> 0xf07b
"folder-o" -> 0xf114
"folder-open" -> 0xf07c
"folder-open-o" -> 0xf115
"font" -> 0xf031
"font-awesome" -> 0xf2b4
"fonticons" -> 0xf280
"fork-awesome" -> 0xf2e3
"fort-awesome" -> 0xf286
"forumbee" -> 0xf211
"forward" -> 0xf04e
"foursquare" -> 0xf180
"free-code-camp" -> 0xf2c5
"freedombox" -> 0xf2fd
"friendica" -> 0xf2e6
"frown-o" -> 0xf119
"funkwhale" -> 0xf339
"futbol-o" -> 0xf1e3
"gamepad" -> 0xf11b
"gavel" -> 0xf0e3
"gbp" -> 0xf154
"genderless" -> 0xf22d
"get-pocket" -> 0xf265
"gg" -> 0xf260
"gg-circle" -> 0xf261
"gift" -> 0xf06b
"gimp" -> 0xf31b
"git" -> 0xf1d3
"git-square" -> 0xf1d2
"gitea" -> 0xf31f
"github" -> 0xf09b
"github-alt" -> 0xf113
"github-square" -> 0xf092
"gitlab" -> 0xf296
"glass" -> 0xf000
"glide" -> 0xf2a5
"glide-g" -> 0xf2a6
"globe" -> 0xf0ac
"globe-circle" -> 0xf33f
"globe-closed" -> 0xf33a
"globe-e" -> 0xf304
"globe-w" -> 0xf305
"gnu-social" -> 0xf2e7
"gnupg" -> 0xf30d
"google" -> 0xf1a0
"google-plus" -> 0xf0d5
"google-plus-official" -> 0xf2b3
"google-plus-square" -> 0xf0d4
"google-wallet" -> 0xf1ee
"graduation-cap" -> 0xf19d
"gratipay" -> 0xf184
"grav" -> 0xf2d6
"h-square" -> 0xf0fd
"hackaday" -> 0xf30a
"hacker-news" -> 0xf1d4
"hackster" -> 0xf326
"hal" -> 0xf333
"hand-lizard-o" -> 0xf258
"hand-o-down" -> 0xf0a7
"hand-o-left" -> 0xf0a5
"hand-o-right" -> 0xf0a4
"hand-o-up" -> 0xf0a6
"hand-paper-o" -> 0xf256
"hand-peace-o" -> 0xf25b
"hand-pointer-o" -> 0xf25a
"hand-rock-o" -> 0xf255
"hand-scissors-o" -> 0xf257
"hand-spock-o" -> 0xf259
"handshake-o" -> 0xf2b5
"hashnode" -> 0xf317
"hashtag" -> 0xf292
"hdd-o" -> 0xf0a0
"header" -> 0xf1dc
"headphones" -> 0xf025
"heart" -> 0xf004
"heart-o" -> 0xf08a
"heartbeat" -> 0xf21e
"history" -> 0xf1da
"home" -> 0xf015
"hospital-o" -> 0xf0f8
"hourglass" -> 0xf254
"hourglass-end" -> 0xf253
"hourglass-half" -> 0xf252
"hourglass-o" -> 0xf250
"hourglass-start" -> 0xf251
"houzz" -> 0xf27c
"html5" -> 0xf13b
"hubzilla" -> 0xf2eb
"i-cursor" -> 0xf246
"id-badge" -> 0xf2c1
"id-card" -> 0xf2c2
"id-card-o" -> 0xf2c3
"ils" -> 0xf20b
"imdb" -> 0xf2d8
"inbox" -> 0xf01c
"indent" -> 0xf03c
"industry" -> 0xf275
"info" -> 0xf129
"info-circle" -> 0xf05a
"inkscape" -> 0xf312
"inr" -> 0xf156
"instagram" -> 0xf16d
"internet-explorer" -> 0xf26b
"ioxhost" -> 0xf208
"italic" -> 0xf033
"jirafeau" -> 0xf318
"joomla" -> 0xf1aa
"joplin" -> 0xf310
"jpy" -> 0xf157
"jsfiddle" -> 0xf1cc
"julia" -> 0xf334
"jupyter" -> 0xf335
"key" -> 0xf084
"key-modern" -> 0xf2f7
"keybase" -> 0xf2f4
"keyboard-o" -> 0xf11c
"krw" -> 0xf159
"language" -> 0xf1ab
"laptop" -> 0xf109
"laravel" -> 0xf30b
"lastfm" -> 0xf202
"lastfm-square" -> 0xf203
"leaf" -> 0xf06c
"leanpub" -> 0xf212
"lemon-o" -> 0xf094
"level-down" -> 0xf149
"level-up" -> 0xf148
"liberapay" -> 0xf2e9
"liberapay-square" -> 0xf2e8
"life-ring" -> 0xf1cd
"lightbulb-o" -> 0xf0eb
"line-chart" -> 0xf201
"link" -> 0xf0c1
"linkedin" -> 0xf0e1
"linkedin-square" -> 0xf08c
"linode" -> 0xf2b8
"linux" -> 0xf17c
"list" -> 0xf03a
"list-alt" -> 0xf022
"list-ol" -> 0xf0cb
"list-ul" -> 0xf0ca
"location-arrow" -> 0xf124
"lock" -> 0xf023
"lock-circle" -> 0xf341
"long-arrow-down" -> 0xf175
"long-arrow-left" -> 0xf177
"long-arrow-right" -> 0xf178
"long-arrow-up" -> 0xf176
"low-vision" -> 0xf2a8
"magic" -> 0xf0d0
"magnet" -> 0xf076
"male" -> 0xf183
"map" -> 0xf279
"map-marker" -> 0xf041
"map-o" -> 0xf278
"map-pin" -> 0xf276
"map-signs" -> 0xf277
"mars" -> 0xf222
"mars-double" -> 0xf227
"mars-stroke" -> 0xf229
"mars-stroke-h" -> 0xf22b
"mars-stroke-v" -> 0xf22a
"mastodon" -> 0xf2e1
"mastodon-alt" -> 0xf2e2
"mastodon-square" -> 0xf300
"matrix-org" -> 0xf313
"maxcdn" -> 0xf136
"meanpath" -> 0xf20c
"medium" -> 0xf23a
"medium-square" -> 0xf2f8
"medkit" -> 0xf0fa
"meetup" -> 0xf2e0
"meh-o" -> 0xf11a
"mercury" -> 0xf223
"microchip" -> 0xf2db
"microphone" -> 0xf130
"microphone-slash" -> 0xf131
"minus" -> 0xf068
"minus-circle" -> 0xf056
"minus-square" -> 0xf146
"minus-square-o" -> 0xf147
"mixcloud" -> 0xf289
"mobile" -> 0xf10b
"modx" -> 0xf285
"money" -> 0xf0d6
"moon" -> 0xf328
"moon-o" -> 0xf186
"motorcycle" -> 0xf21c
"mouse-pointer" -> 0xf245
"music" -> 0xf001
"neuter" -> 0xf22c
"newspaper-o" -> 0xf1ea
"nextcloud" -> 0xf306
"nextcloud-square" -> 0xf307
"nodejs" -> 0xf308
"object-group" -> 0xf247
"object-ungroup" -> 0xf248
"odnoklassniki" -> 0xf263
"odnoklassniki-square" -> 0xf264
"open-collective" -> 0xf336
"opencart" -> 0xf23d
"openid" -> 0xf19b
"opera" -> 0xf26a
"optin-monster" -> 0xf23c
"orcid" -> 0xf337
"outdent" -> 0xf03b
"pagelines" -> 0xf18c
"paint-brush" -> 0xf1fc
"paper-plane" -> 0xf1d8
"paper-plane-o" -> 0xf1d9
"paperclip" -> 0xf0c6
"paragraph" -> 0xf1dd
"patreon" -> 0xf2f0
"pause" -> 0xf04c
"pause-circle" -> 0xf28b
"pause-circle-o" -> 0xf28c
"paw" -> 0xf1b0
"paypal" -> 0xf1ed
"peertube" -> 0xf2e4
"pencil" -> 0xf040
"pencil-square" -> 0xf14b
"pencil-square-o" -> 0xf044
"percent" -> 0xf295
"phone" -> 0xf095
"phone-square" -> 0xf098
"php" -> 0xf30e
"picture-o" -> 0xf03e
"pie-chart" -> 0xf200
"pinterest" -> 0xf0d2
"pinterest-p" -> 0xf231
"pinterest-square" -> 0xf0d3
"pixelfed" -> 0xf314
"plane" -> 0xf072
"play" -> 0xf04b
"play-circle" -> 0xf144
"play-circle-o" -> 0xf01d
"pleroma" -> 0xf324
"plug" -> 0xf1e6
"plus" -> 0xf067
"plus-circle" -> 0xf055
"plus-square" -> 0xf0fe
"plus-square-o" -> 0xf196
"podcast" -> 0xf2ce
"power-off" -> 0xf011
"print" -> 0xf02f
"product-hunt" -> 0xf288
"puzzle-piece" -> 0xf12e
"python" -> 0xf322
"qq" -> 0xf1d6
"qrcode" -> 0xf029
"question" -> 0xf128
"question-circle" -> 0xf059
"question-circle-o" -> 0xf29c
"quora" -> 0xf2c4
"quote-left" -> 0xf10d
"quote-right" -> 0xf10e
"random" -> 0xf074
"ravelry" -> 0xf2d9
"react" -> 0xf302
"rebel" -> 0xf1d0
"recycle" -> 0xf1b8
"reddit" -> 0xf1a1
"reddit-alien" -> 0xf281
"reddit-square" -> 0xf1a2
"refresh" -> 0xf021
"registered" -> 0xf25d
"renren" -> 0xf18b
"repeat" -> 0xf01e
"reply" -> 0xf112
"reply-all" -> 0xf122
"researchgate" -> 0xf338
"retweet" -> 0xf079
"road" -> 0xf018
"rocket" -> 0xf135
"rss" -> 0xf09e
"rss-square" -> 0xf143
"rub" -> 0xf158
"safari" -> 0xf267
"scissors" -> 0xf0c4
"scribd" -> 0xf28a
"scuttlebutt" -> 0xf2ea
"search" -> 0xf002
"search-minus" -> 0xf010
"search-plus" -> 0xf00e
"sellsy" -> 0xf213
"server" -> 0xf233
"shaarli" -> 0xf2f5
"shaarli-o" -> 0xf2f6
"share" -> 0xf064
"share-alt" -> 0xf1e0
"share-alt-square" -> 0xf1e1
"share-circle" -> 0xf340
"share-closed" -> 0xf33b
"share-square" -> 0xf14d
"share-square-o" -> 0xf045
"shield" -> 0xf132
"ship" -> 0xf21a
"shirtsinbulk" -> 0xf214
"shopping-bag" -> 0xf290
"shopping-basket" -> 0xf291
"shopping-cart" -> 0xf07a
"shower" -> 0xf2cc
"sign-in" -> 0xf090
"sign-language" -> 0xf2a7
"sign-out" -> 0xf08b
"signal" -> 0xf012
"signalapp" -> 0xf30c
"simplybuilt" -> 0xf215
"sitemap" -> 0xf0e8
"skyatlas" -> 0xf216
"skype" -> 0xf17e
"slack" -> 0xf198
"sliders" -> 0xf1de
"slideshare" -> 0xf1e7
"smile-o" -> 0xf118
"snapchat" -> 0xf2ab
"snapchat-ghost" -> 0xf2ac
"snapchat-square" -> 0xf2ad
"snowdrift" -> 0xf2f1
"snowflake-o" -> 0xf2dc
"social-home" -> 0xf2ec
"sort" -> 0xf0dc
"sort-alpha-asc" -> 0xf15d
"sort-alpha-desc" -> 0xf15e
"sort-amount-asc" -> 0xf160
"sort-amount-desc" -> 0xf161
"sort-asc" -> 0xf0de
"sort-desc" -> 0xf0dd
"sort-numeric-asc" -> 0xf162
"sort-numeric-desc" -> 0xf163
"soundcloud" -> 0xf1be
"space-shuttle" -> 0xf197
"spell-check" -> 0xf327
"spinner" -> 0xf110
"spoon" -> 0xf1b1
"spotify" -> 0xf1bc
"square" -> 0xf0c8
"square-o" -> 0xf096
"stack-exchange" -> 0xf18d
"stack-overflow" -> 0xf16c
"star" -> 0xf005
"star-half" -> 0xf089
"star-half-o" -> 0xf123
"star-o" -> 0xf006
"steam" -> 0xf1b6
"steam-square" -> 0xf1b7
"step-backward" -> 0xf048
"step-forward" -> 0xf051
"stethoscope" -> 0xf0f1
"sticky-note" -> 0xf249
"sticky-note-o" -> 0xf24a
"stop" -> 0xf04d
"stop-circle" -> 0xf28d
"stop-circle-o" -> 0xf28e
"street-view" -> 0xf21d
"strikethrough" -> 0xf0cc
"stumbleupon" -> 0xf1a4
"stumbleupon-circle" -> 0xf1a3
"subscript" -> 0xf12c
"subway" -> 0xf239
"suitcase" -> 0xf0f2
"sun" -> 0xf329
"sun-o" -> 0xf185
"superpowers" -> 0xf2dd
"superscript" -> 0xf12b
"syncthing" -> 0xf311
"table" -> 0xf0ce
"tablet" -> 0xf10a
"tachometer" -> 0xf0e4
"tag" -> 0xf02b
"tags" -> 0xf02c
"tasks" -> 0xf0ae
"taxi" -> 0xf1ba
"telegram" -> 0xf2c6
"television" -> 0xf26c
"tencent-weibo" -> 0xf1d5
"terminal" -> 0xf120
"text-height" -> 0xf034
"text-width" -> 0xf035
"th" -> 0xf00a
"th-large" -> 0xf009
"th-list" -> 0xf00b
"themeisle" -> 0xf2b2
"thermometer-empty" -> 0xf2cb
"thermometer-full" -> 0xf2c7
"thermometer-half" -> 0xf2c9
"thermometer-quarter" -> 0xf2ca
"thermometer-three-quarters" -> 0xf2c8
"thumb-tack" -> 0xf08d
"thumbs-down" -> 0xf165
"thumbs-o-down" -> 0xf088
"thumbs-o-up" -> 0xf087
"thumbs-up" -> 0xf164
"ticket" -> 0xf145
"times" -> 0xf00d
"times-circle" -> 0xf057
"times-circle-o" -> 0xf05c
"tint" -> 0xf043
"tipeee" -> 0xf301
"toggle-off" -> 0xf204
"toggle-on" -> 0xf205
"tor-onion" -> 0xf32e
"trademark" -> 0xf25c
"train" -> 0xf238
"transgender" -> 0xf224
"transgender-alt" -> 0xf225
"trash" -> 0xf1f8
"trash-o" -> 0xf014
"tree" -> 0xf1bb
"trello" -> 0xf181
"tripadvisor" -> 0xf262
"trophy" -> 0xf091
"truck" -> 0xf0d1
"try" -> 0xf195
"tty" -> 0xf1e4
"tumblr" -> 0xf173
"tumblr-square" -> 0xf174
"twitch" -> 0xf1e8
"twitter" -> 0xf099
"twitter-square" -> 0xf081
"umbrella" -> 0xf0e9
"underline" -> 0xf0cd
"undo" -> 0xf0e2
"universal-access" -> 0xf29a
"university" -> 0xf19c
"unlock" -> 0xf09c
"unlock-alt" -> 0xf13e
"unslpash" -> 0xf325
"upload" -> 0xf093
"usb" -> 0xf287
"usd" -> 0xf155
"user" -> 0xf007
"user-circle" -> 0xf2bd
"user-circle-o" -> 0xf2be
"user-md" -> 0xf0f0
"user-o" -> 0xf2c0
"user-plus" -> 0xf234
"user-secret" -> 0xf21b
"user-times" -> 0xf235
"users" -> 0xf0c0
"users-closed" -> 0xf33c
"venus" -> 0xf221
"venus-double" -> 0xf226
"venus-mars" -> 0xf228
"viacoin" -> 0xf237
"viadeo" -> 0xf2a9
"viadeo-square" -> 0xf2aa
"video-camera" -> 0xf03d
"vimeo" -> 0xf27d
"vimeo-square" -> 0xf194
"vine" -> 0xf1ca
"vk" -> 0xf189
"volume-control-phone" -> 0xf2a0
"volume-down" -> 0xf027
"volume-mute" -> 0xf32f
"volume-off" -> 0xf026
"volume-up" -> 0xf028
"weibo" -> 0xf18a
"weixin" -> 0xf1d7
"whatsapp" -> 0xf232
"wheelchair" -> 0xf193
"wheelchair-alt" -> 0xf29b
"wifi" -> 0xf1eb
"wikidata" -> 0xf31a
"wikipedia-w" -> 0xf266
"window-close" -> 0xf2d3
"window-close-o" -> 0xf2d4
"window-maximize" -> 0xf2d0
"window-minimize" -> 0xf2d1
"window-restore" -> 0xf2d2
"windows" -> 0xf17a
"wire" -> 0xf32c
"wordpress" -> 0xf19a
"wpbeginner" -> 0xf297
"wpexplorer" -> 0xf2de
"wpforms" -> 0xf298
"wrench" -> 0xf0ad
"xing" -> 0xf168
"xing-square" -> 0xf169
"xmpp" -> 0xf2f9
"y-combinator" -> 0xf23b
"yahoo" -> 0xf19e
"yelp" -> 0xf1e9
"yoast" -> 0xf2b1
"youtube" -> 0xf167
"youtube-play" -> 0xf16a
"youtube-square" -> 0xf166
"zotero" -> 0xf309
-- default
_ -> 0x200B -- ie. zero-width non-breaking space
where
_toString i = singleton $ unsafePartial $ fromJust $ fromCharCode i
HighlightJS.js 0000664 0000000 0000000 00000000263 14111104351 0032140 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils 'use strict';
const hljs = require('highlightjs/highlight.pack.min.js');
function highlightBlock(el) {
hljs.highlightBlock(el);
}
exports._highlightBlock = highlightBlock;
HighlightJS.purs 0000664 0000000 0000000 00000000503 14111104351 0032512 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils module Gargantext.Utils.HighlightJS where
import DOM.Simple (Element)
import Effect (Effect)
import Effect.Uncurried (EffectFn1, runEffectFn1)
import Gargantext.Prelude
highlightBlock :: Element -> Effect Unit
highlightBlock el = runEffectFn1 _highlightBlock el
foreign import _highlightBlock :: EffectFn1 Element Unit
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils/JSON.purs 0000664 0000000 0000000 00000004421 14111104351 0031201 0 ustar 00root root 0000000 0000000 module Gargantext.Utils.JSON where
import Prelude
import Control.Monad.Except (withExcept)
import Data.Int as Int
import Data.List as List
import Data.Map as Map
import Data.Maybe (Maybe(..))
import Data.Sequence as Seq
import Data.Traversable (sequence)
import Data.TraversableWithIndex (traverseWithIndex)
import Data.Tuple (Tuple(..))
import Foreign (F, Foreign, ForeignError(..), readArray, unsafeToForeign)
import Foreign as F
import Foreign.Object as Object
import Simple.JSON as JSON
readSequence :: forall a. JSON.ReadForeign a => Foreign -> F (Seq.Seq a)
readSequence f = do
arr <- readArray f
y <- traverseWithIndex readAtIdx arr
pure $ Seq.fromFoldable y
where
readAtIdx i f' = withExcept (map (ErrorAtIndex i)) (JSON.readImpl f')
writeSequence :: forall a. JSON.WriteForeign a => Seq.Seq a -> Foreign
writeSequence xs = unsafeToForeign $ JSON.writeImpl $ (Seq.toUnfoldable xs :: Array a)
readList :: forall a. JSON.ReadForeign a => Foreign -> F (List.List a)
readList f = do
arr <- readArray f
y <- traverseWithIndex readAtIdx arr
pure $ List.fromFoldable y
where
readAtIdx i f' = withExcept (map (ErrorAtIndex i)) (JSON.readImpl f')
writeList :: forall a. JSON.WriteForeign a => List.List a -> Foreign
writeList xs = unsafeToForeign $ JSON.writeImpl <$> (List.toUnfoldable xs :: Array a)
readMapInt :: forall v. JSON.ReadForeign v => Foreign -> F (Map.Map Int v)
readMapInt f = do
(inst :: Object.Object Foreign) <- readObject' f
let (mapped :: Array (F (Tuple Int v))) = (\(Tuple k v) ->
case Int.fromString k of
Nothing -> F.fail $ ErrorAtProperty k $ ForeignError "Cannot convert to int"
Just kInt -> do
v' <- JSON.readImpl v
pure $ Tuple kInt v'
) <$> Object.toUnfoldable inst
seq <- sequence mapped
pure $ Map.fromFoldable seq
where
readObject' :: Foreign -> F (Object.Object Foreign)
readObject' value
| F.tagOf value == "Object" = pure $ F.unsafeFromForeign value
| otherwise = F.fail $ TypeMismatch "Object" $ F.tagOf value
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils/JitsiMeet.js0000664 0000000 0000000 00000000324 14111104351 0031746 0 ustar 00root root 0000000 0000000 'use strict';
var API = require('../../src/external-deps/JitsiMeetAPI.js');
console.log('API', API);
exports._api = API;
exports._jitsiMeetAPI = function(host, options) {
return new API(host, options);
};
JitsiMeet.purs 0000664 0000000 0000000 00000001100 14111104351 0032235 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils module Gargantext.Utils.JitsiMeet where
import Data.Function.Uncurried (Fn2, runFn2)
import DOM.Simple as DOM
import Effect (Effect)
import Effect.Uncurried (EffectFn2, runEffectFn2)
foreign import data JitsiMeet :: Type
type Jitsi =
{ parentNode :: DOM.Element
, roomName :: String }
foreign import _api :: JitsiMeet
foreign import _jitsiMeetAPI :: EffectFn2 String Jitsi JitsiMeet
jitsiMeetAPI :: String -> Jitsi -> Effect JitsiMeet
jitsiMeetAPI = runEffectFn2 _jitsiMeetAPI
--jitsiMeetAPIFn :: String -> Jitsi -> JitsiMeet
--jitsiMeetAPIFn = runFn2 _jitsiMeetAPI
KarpRabin.purs 0000664 0000000 0000000 00000015322 14111104351 0032224 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils -- |
-- The present module has been ported from Haskell to PureScript
-- by Nicolas Pouillard for the Gargantext projet.
--
-- Original Haskell code:
-- Copyright : (c) 2010 Daniel Fischer
-- Licence : BSD3
-- Maintainer : Daniel Fischer
--
-- Simultaneous search for multiple patterns in a 'String'
-- using the Karp-Rabin algorithm.
--
-- A description of the algorithm for a single pattern can be found at
-- .
module Gargantext.Utils.KarpRabin ( -- * Overview
-- $overview
-- ** Caution
-- $caution
-- * Function
indicesOfAny
) where
import Data.Array as A
import Data.Enum (fromEnum)
import Data.Foldable (class Foldable, minimum, foldl)
import Data.Int (quot)
import Data.List as L
import Data.Map as M
import Data.Maybe (Maybe(..), isJust)
import Data.String as S
import Data.String (CodePoint)
import Data.Tuple (Tuple(..))
import Data.UInt (UInt, shl, fromInt)
import Partial.Unsafe (unsafePartial)
import Prelude
fromCodePoint :: CodePoint -> UInt
fromCodePoint c = fromInt (fromEnum c)
-- $overview
--
-- The Karp-Rabin algorithm works by calculating a hash of the pattern and
-- comparing that hash with the hash of a slice of the target string with
-- the same length as the pattern. If the hashes are equal, the slice of the
-- target is compared to the pattern byte for byte (since the hash
-- function generally isn't injective).
--
-- For a single pattern, this tends to be more efficient than the naïve
-- algorithm, but it cannot compete with algorithms like
-- Knuth-Morris-Pratt or Boyer-Moore.
--
-- However, the algorithm can be generalised to search for multiple patterns
-- simultaneously. If the shortest pattern has length @k@, hash the prefix of
-- length @k@ of all patterns and compare the hash of the target's slices of
-- length @k@ to them. If there's a match, check whether the slice is part
-- of an occurrence of the corresponding pattern.
--
-- With a hash-function that
--
-- * allows to compute the hash of one slice in constant time from the hash
-- of the previous slice, the new and the dropped character, and
--
-- * produces few spurious matches,
--
-- searching for occurrences of any of @n@ patterns has a best-case complexity
-- of /O/(@targetLength@ * @lookup n@). The worst-case complexity is
-- /O/(@targetLength@ * @lookup n@ * @sum patternLengths@), the average is
-- not much worse than the best case.
--
-- The functions in this module store the hashes of the patterns in an
-- 'Map', so the lookup is /O/(@log n@). Re-hashing is done in constant
-- time and spurious matches of the hashes /should be/ sufficiently rare.
-- The maximal length of the prefixes to be hashed is 32.
-- $caution
--
-- Unfortunately, the constant factors are high, so these functions are slow.
-- Unless the number of patterns to search for is high (larger than 50 at
-- least), repeated search for single patterns using Boyer-Moore or DFA and
-- manual merging of the indices is faster. /Much/ faster for less than 40
-- or so patterns.
--
-- In summary, this module is more of an interesting curiosity than anything
-- else.
-- | @'indicesOfAny'@ finds all occurrences of any of several non-empty patterns
-- in a strict target string. If no non-empty patterns are given,
-- the result is an empty array. Otherwise the result array contains
-- the pairs of all indices where any of the (non-empty) patterns start
-- and the array of all patterns starting at that index, the patterns being
-- represented by their (zero-based) position in the pattern array.
-- Empty patterns are filtered out before processing begins.
indicesOfAny :: Array String -- ^ Array of non-empty patterns
-> String -- ^ String to search
-> Array (Tuple Int (Array Int)) -- ^ Array of matches
indicesOfAny pats = if A.null nepats then const []
else strictMatcher nepats
where
nepats = A.filter (not <<< S.null) pats
------------------------------------------------------------------------------
-- Workers --
------------------------------------------------------------------------------
rehash' :: UInt -> UInt -> UInt -> CodePoint -> CodePoint -> UInt
rehash' shDi out h o n =
(h `shl` shDi - (fromCodePoint o `shl` out)) + fromCodePoint n
minimum1 :: forall a f. Ord a => Foldable f => a -> f a -> a
minimum1 a fa =
case minimum fa of
Nothing -> a
Just b -> min a b
strictMatcher :: Array String -> String -> Array (Tuple Int (Array Int))
strictMatcher pats = unsafePartial search
where
hLen = minimum1 32 (S.length <$> pats)
hLen' = fromInt hLen
shDi = case 32 `quot` hLen of
q | q < 4 -> q
| otherwise -> 4
outS = fromInt (shDi * hLen)
patNum = A.length pats
rehash :: UInt -> CodePoint -> CodePoint -> UInt
rehash = case shDi of
1 -> rehash' (fromInt 1) hLen'
2 -> rehash' (fromInt 2) outS
3 -> rehash' (fromInt 3) outS
_ -> rehash' (fromInt 4) outS
hash :: String -> UInt
hash = foldl (\h w -> (h `shl` fromInt shDi) + fromCodePoint w) (fromInt 0)
<<< S.toCodePointArray
<<< S.take hLen
hashMap =
M.fromFoldableWith (flip (<>))
(A.mapWithIndex (\i a -> Tuple (hash a) [i]) pats)
search :: Partial => String -> Array (Tuple Int (Array Int))
search str = if strLen < hLen then []
else A.fromFoldable (go 0 shash)
where
strLen = S.length str
maxIdx = strLen - hLen
arr = S.toCodePointArray str
strAt i = A.unsafeIndex arr i
shash = hash str
go sI h =
case M.lookup h hashMap of
Nothing ->
if sI == maxIdx
then L.Nil
else go (sI + 1) (rehash h (strAt sI) (strAt (sI + hLen)))
Just ps ->
let rst = S.drop sI str
hd = strAt sI
more = if sI == maxIdx then L.Nil else
go (sI + 1) (rehash h hd (strAt (sI + hLen)))
okay bs =
isJust (S.stripPrefix (S.Pattern bs) rst)
in case A.filter (\x -> okay (A.unsafeIndex pats x)) ps of
[] -> more
qs -> Tuple sI qs L.: more
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils/Math.purs 0000664 0000000 0000000 00000000512 14111104351 0031316 0 ustar 00root root 0000000 0000000 module Gargantext.Utils.Math where
import Prelude
import Math as Math
roundToMultiple :: Number -> Number -> Number
roundToMultiple eps num = eps * Math.round (num / eps)
-- | Logarithm with given base
logb :: Number -> Number -> Number
logb base n = (Math.log n) / (Math.log base)
log10 :: Number -> Number
log10 = logb 10.0
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils/Popover.js 0000664 0000000 0000000 00000000346 14111104351 0031507 0 ustar 00root root 0000000 0000000 'use strict';
const popover = require('react-awesome-popover');
if (typeof window !== 'undefined') {
window.Popover = popover;
}
exports.popoverCpt = popover;
exports._setState = function(el, val) {
el.setState(val);
}
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils/Popover.purs0000664 0000000 0000000 00000001601 14111104351 0032057 0 ustar 00root root 0000000 0000000 module Gargantext.Utils.Popover where
import Data.Maybe (maybe)
import Data.Nullable (Nullable, toMaybe)
import DOM.Simple as DOM
import Effect (Effect)
import Effect.Uncurried (EffectFn2, runEffectFn2)
import Reactix as R
import Gargantext.Prelude
type PopoverRef = R.Ref (Nullable DOM.Element)
type Props =
(
arrow :: Boolean
, open :: Boolean
, onClose :: Unit -> Effect Unit
, onOpen :: Unit -> Effect Unit
, ref :: PopoverRef
)
foreign import popoverCpt :: R.Component Props
popover :: Record Props -> Array R.Element -> R.Element
popover = R.rawCreateElement popoverCpt
foreign import _setState :: forall a. EffectFn2 DOM.Element a Unit
setState :: forall a. DOM.Element -> a -> Effect Unit
setState = runEffectFn2 _setState
setOpen :: PopoverRef -> Boolean -> Effect Unit
setOpen ref val = maybe (pure unit) (\p -> setState p {open: val}) $ toMaybe $ R.readRef ref
QueryString.purs 0000664 0000000 0000000 00000001651 14111104351 0032647 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils module Gargantext.Utils.QueryString where
import Data.Array
import Data.Maybe
import Data.String.Common (joinWith)
import Gargantext.Prelude
queryParam :: forall a. Show a => String -> a -> String
queryParam key value = key <> "=" <> show value
queryParamS :: String -> String -> String
queryParamS key value = key <> "=" <> value
mQueryParam :: forall a. Show a => String -> Maybe a -> String
mQueryParam _ Nothing = ""
mQueryParam key (Just v) = queryParam key v
mQueryParamS :: forall a. String -> (a -> String) -> Maybe a -> String
mQueryParamS _ _ Nothing = ""
mQueryParamS key mFunc (Just v) = queryParamS key $ mFunc v
joinQueryStrings :: Array String -> String
joinQueryStrings qs =
case uncons qs of
Nothing -> ""
Just { head, tail } -> "?" <> head <> (joinQS tail)
where
joinQS ys =
case uncons ys of
Nothing -> ""
Just { tail: ys } -> "&" <> (joinWith "&" ys)
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils/Range.purs 0000664 0000000 0000000 00000002763 14111104351 0031473 0 ustar 00root root 0000000 0000000 module Gargantext.Utils.Range where
import Prelude hiding (clamp)
import Data.Newtype (class Newtype)
class Range r v where
clamp :: r -> v -> v
within :: r -> v -> Boolean
-- | A Closed Interval, in math speak
newtype Closed t = Closed { min :: t, max :: t }
derive instance Newtype (Closed t) _
instance Ord t => Range (Closed t) t where
clamp (Closed r) = max r.min <<< min r.max
within (Closed r) v = (v <= r.max) && (v >= r.min)
instance Eq t => Eq (Closed t) where
eq (Closed r1) (Closed r2) = (r1.min == r2.min) && (r1.max == r2.max)
type NumberRange = Closed Number
range :: NumberRange -> Number
range (Closed r) = r.max - r.min
-- | Clamps the value to within the range and returns a normalised
-- | (0-1) float indication progress along the range
normalise :: NumberRange -> Number -> Number
normalise r@(Closed {min}) v = (clamp r v - min) / range r
-- | Given a normal (0-1) float representing progress along a range,
-- | project it onto the range
projectNormal :: NumberRange -> Number -> Number
projectNormal r@(Closed {min}) v = (clamp closedProbability v * range r) + min
-- | A closed range between 0 and 1
closedProbability :: NumberRange
closedProbability = Closed { min: 0.0, max: 1.0 }
-- | Updates the minimum value in a closed range
withMin :: forall t. Closed t -> t -> Closed t
withMin (Closed {max}) min = Closed { min, max }
-- | Updates the maximum value in a closed range
withMax :: forall t. Closed t -> t -> Closed t
withMax (Closed {min}) max = Closed { min, max }
ReactBootstrap.js 0000664 0000000 0000000 00000000766 14111104351 0032740 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils 'use strict';
const ReactBootstrap = require('react-bootstrap');
if (typeof window !== 'undefined') {
window.ReactBootstrap = ReactBootstrap;
}
const Alert = require('react-bootstrap/Alert');
const OverlayTrigger = require('react-bootstrap/OverlayTrigger');
const Popover = require('react-bootstrap/Popover');
exports.alertCpt = Alert;
exports.overlayTriggerCpt = OverlayTrigger;
exports.popoverCpt = Popover;
exports.popoverContentCpt = Popover.Content;
exports.popoverTitleCpt = Popover.Title;
ReactBootstrap.purs 0000664 0000000 0000000 00000003164 14111104351 0033310 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils module Gargantext.Utils.ReactBootstrap where
import Effect (Effect)
import Reactix as R
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2
type OverlayTriggerProps =
(
overlay :: R.Element
, placement :: String
, trigger :: String
)
type Props =
(
)
type AlertProps =
( dismissible :: Boolean
, onClose :: Effect Unit
, variant :: String
)
type ContentProps =
(
)
type TitleProps =
(
"as" :: String
)
foreign import alertCpt :: R.Component AlertProps
foreign import overlayTriggerCpt :: R.Component OverlayTriggerProps
foreign import popoverCpt :: R.Component Props
foreign import popoverContentCpt :: R.Component ContentProps
foreign import popoverTitleCpt :: R.Component TitleProps
alert :: R2.Component AlertProps
alert = R.rawCreateElement alertCpt
overlayTrigger :: R2.Component OverlayTriggerProps
overlayTrigger = R.rawCreateElement overlayTriggerCpt
popover :: R2.Component Props
popover = R.rawCreateElement popoverCpt
popoverContent :: R2.Component ContentProps
popoverContent = R.rawCreateElement popoverContentCpt
popoverTitle :: R2.Component TitleProps
popoverTitle = R.rawCreateElement popoverTitleCpt
-- example
-- example =
-- let popover = GUB.popover {} [
-- GUB.popoverTitle { "as": "h3" } [ H.text "hello title" ]
-- , GUB.popoverContent {} [ H.div {} [ H.text "content" ] ]
-- ]
-- in GUB.overlayTrigger { overlay: popover
-- , placement: "right"
-- , trigger: "click" } [
-- H.button { className: "btn btn-default" } [ H.text "Click me" ]
-- ]
ReactTooltip.js 0000664 0000000 0000000 00000000267 14111104351 0032411 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils 'use strict';
const reactTooltip = require('react-tooltip');
if (typeof window !== 'undefined') {
window.ReactTooltip = reactTooltip;
}
exports.reactTooltipCpt = reactTooltip;
ReactTooltip.purs 0000664 0000000 0000000 00000001000 14111104351 0032750 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils module Gargantext.Utils.ReactTooltip where
import Data.Maybe (maybe)
import Data.Nullable (Nullable, toMaybe)
import DOM.Simple as DOM
import Effect (Effect)
import Effect.Uncurried (EffectFn2, runEffectFn2)
import Reactix as R
import Gargantext.Prelude
type Props =
(
effect :: String
, id :: String
, type :: String
)
foreign import reactTooltipCpt :: R.Component Props
reactTooltip :: Record Props -> Array R.Element -> R.Element
reactTooltip = R.rawCreateElement reactTooltipCpt
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils/Reactix.js 0000664 0000000 0000000 00000001531 14111104351 0031451 0 ustar 00root root 0000000 0000000 'use strict';
function addRootElement(rootElem) {
document.body.insertBefore(
rootElem,
document.body.lastElementChild.nextElementSibling
);
}
function getSelection(_u) {
return window.getSelection();
}
function stringify(j, indent) {
return JSON.stringify(j, null, indent);
}
function postMessage(obj, msg, src) {
obj.contentWindow.postMessage(msg, src);
}
function setCookie(c) {
document.cookie = c;
}
function domRectFromRect(obj) {
return DOMRectReadOnly.fromRect(obj)
}
exports._addRootElement = addRootElement;
exports._getSelection = getSelection;
exports._stringify = stringify;
exports._postMessage = postMessage;
exports._setCookie = setCookie;
exports._domRectFromRect = domRectFromRect;
exports._keyCode = function(e) {
// https://www.w3schools.com/jsref/event_key_keycode.asp
return e.which || e.keyCode;
}
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils/Reactix.purs0000664 0000000 0000000 00000034430 14111104351 0032032 0 ustar 00root root 0000000 0000000 module Gargantext.Utils.Reactix where
import Prelude
import Data.Array as A
import Data.Either (hush)
import Data.Function.Uncurried (Fn1, runFn1, Fn2, runFn2)
import Data.Maybe (Maybe(..), fromJust, fromMaybe, isJust)
import Data.Nullable (Nullable, null, toMaybe)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import DOM.Simple as DOM
import DOM.Simple.Console (log2)
import DOM.Simple.Document (document)
import DOM.Simple.Element as Element
import DOM.Simple.Event as DE
import DOM.Simple.Types (class IsNode, class IsElement, DOMRect)
import Effect (Effect)
import Effect.Console (logShow)
import Effect.Aff (Aff, launchAff, launchAff_, killFiber)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn3, mkEffectFn1, mkEffectFn2, runEffectFn1, runEffectFn2, runEffectFn3)
import Effect.Unsafe (unsafePerformEffect)
import FFI.Simple ((..), (...), (.=), defineProperty, delay, args2, args3)
import Partial.Unsafe (unsafePartial)
import React (class ReactPropFields, Children, ReactClass, ReactElement)
import React as React
import Reactix as R
import Reactix.DOM.HTML (ElemFactory, createDOM, text)
import Reactix.DOM.HTML as H
import Reactix.React (react)
import Reactix.SyntheticEvent as RE
import Reactix.Utils (currySecond, hook, tuple)
import Simple.JSON as JSON
import Toestand as T
import Unsafe.Coerce (unsafeCoerce)
import Web.File.Blob (Blob)
import Web.File.File as WF
import Web.File.FileList (FileList, item)
import Web.HTML (window)
import Web.HTML.Window (localStorage)
import Web.Storage.Storage (Storage, getItem, setItem)
type Module = String
type Component p = Record p -> Array R.Element -> R.Element
type Leaf p = Record p -> R.Element
type Here =
{ component :: forall p. String -> R.HooksComponent p -> R.Component p
, log :: forall l. l -> Effect Unit
, log2 :: forall l. String -> l -> Effect Unit
, ntComponent :: forall p. String -> NTHooksComponent p -> NTComponent p }
here :: Module -> Here
here mod =
{ component: R.hooksComponentWithModule mod
, log: log2 ("[" <> mod <> "]")
, log2: \msg -> log2 ("[" <> mod <> "] " <> msg)
, ntComponent: ntHooksComponentWithModule mod }
-- newtypes
type NTHooksComponent props = props -> Array R.Element -> R.Hooks R.Element
newtype NTComponent p = NTComponent (EffectFn1 p R.Element)
class NTIsComponent component (props :: Type) children
| component -> props, component -> children where
ntCreateElement :: component -> props -> children -> R.Element
instance componentIsNTComponent
:: NTIsComponent (NTComponent props) props (Array R.Element) where
ntCreateElement = R.rawCreateElement
-- | Turns a `HooksComponent` function into a Component
ntHooksComponent :: forall props. String -> NTHooksComponent props -> NTComponent props
ntHooksComponent name c = NTComponent $ named name $ mkEffectFn1 c'
where
c' :: props -> Effect R.Element
c' props = R.runHooks $ c props (children props)
ntHooksComponentWithModule
:: forall props. Module -> String -> NTHooksComponent props -> NTComponent props
ntHooksComponentWithModule module' name c =
ntHooksComponent (module' <> "." <> name) c
---------------------------
-- TODO Copied from reactix, export these:
children :: forall a. a -> Array R.Element
children a = react .. "Children" ... "toArray" $ [ (a .. "children") ]
---------------------------
newtype Point = Point { x :: Number, y :: Number }
-- a reducer function living in effector, for useReductor
type Actor s a = (a -> s -> Effect s)
-- | Turns a ReactElement into aReactix Element
-- | buff (v.) to polish
buff :: ReactElement -> R.Element
buff = unsafeCoerce
-- | Turns a Reactix Element into a ReactElement.
-- | scuff (v.) to spoil the gloss or finish of.
scuff :: R.Element -> ReactElement
scuff = unsafeCoerce
-- class ToElement a where
-- toElement :: a -> R.Element
-- instance ToElement R.Element where
-- toElement = identity
-- instance ToElement ReactElement where
-- toElement = buff
-- instance ToElement a => ToElement (Array a) where
-- toElement = R.fragment <<< map toElement
createElement' :: forall required given
. ReactPropFields required given
=> ReactClass { children :: Children | required }
-> Record given -> Array R.Element -> R.Element
createElement' reactClass props children =
buff $ React.createElement reactClass props $ scuff <$> children
{-
instance isComponentReactClass
:: R.IsComponent (ReactClass { children :: Children
| props
}) props (Array R.Element) where
createElement reactClass props children =
React.createElement reactClass props children
-}
-- | Turns an aff into a useEffect-compatible Effect (Effect Unit)
affEffect :: forall a. String -> Aff a -> Effect (Effect Unit)
affEffect errmsg aff = do
fiber <- launchAff aff
pure $ launchAff_ $ killFiber (error errmsg) fiber
mousePosition :: RE.SyntheticEvent DE.MouseEvent -> Point
mousePosition e = Point { x: RE.clientX e, y: RE.clientY e }
mouseClickInElement :: DE.MouseEvent -> DOM.Element -> Boolean
mouseClickInElement e el = x <= cx && cx <= x + width && y <= cy && cy <= y + height
where
{ x, y, width, height } = Element.boundingRect el
cx = DE.clientX e
cy = DE.clientY e
domMousePosition :: DE.MouseEvent -> Point
domMousePosition = mousePosition <<< unsafeCoerce
-- | This is naughty, it quietly mutates the input and returns it
named :: forall o. String -> o -> o
named = flip $ defineProperty "name"
overState :: forall t. (t -> t) -> R.State t -> Effect Unit
overState f (_state /\ setState) = setState f
small :: ElemFactory
small = createDOM "small"
select :: ElemFactory
select = createDOM "select"
menu :: ElemFactory
menu = createDOM "menu"
frame :: ElemFactory
frame = createDOM "frame"
frameset :: ElemFactory
frameset = createDOM "frameset"
keyCode :: forall event. event -> Effect Int
keyCode = runEffectFn1 _keyCode
foreign import _keyCode
:: forall e. EffectFn1 e Int
nullRef :: forall t. R.Hooks (R.Ref (Nullable t))
nullRef = R.useRef null
nothingRef :: forall t. R.Hooks (R.Ref (Maybe t))
nothingRef = R.useRef Nothing
useLayoutEffect1' :: forall a. a -> (Unit -> Effect Unit) -> R.Hooks Unit
useLayoutEffect1' a f = R.useLayoutEffect1 a $ do
liftEffect $ f unit
pure $ pure unit
useLayoutRef :: forall a b. (a -> b) -> b -> R.Ref a -> R.Hooks (R.Ref b)
useLayoutRef fn init ref = do
new <- R.useRef init
let old = R.readRef ref
useLayoutEffect1' old $ \_ -> R.setRef new (fn old)
pure new
usePositionRef :: R.Ref (Nullable DOM.Element) -> R.Hooks (R.Ref (Maybe DOM.DOMRect))
usePositionRef = useLayoutRef (map Element.boundingRect <<< toMaybe) Nothing
readPositionRef :: R.Ref (Nullable DOM.Element) -> Maybe DOM.DOMRect
readPositionRef el = do
let posRef = R.readRef el
Element.boundingRect <$> toMaybe posRef
getElementById :: String -> Effect (Maybe DOM.Element)
getElementById = (flip delay) h
where
h id = pure $ toMaybe $ document ... "getElementById" $ [id]
-- We just assume it works, so make sure it's in the html
getPortalHost :: R.Hooks DOM.Element
getPortalHost = R.unsafeHooksEffect $ delay unit $ \_ -> pure $ document ... "getElementById" $ ["portal"]
useLayoutEffectOnce :: Effect (Effect Unit) -> R.Hooks Unit
useLayoutEffectOnce e = R.unsafeUseLayoutEffect e []
singleParent :: forall props. R.Component props -> Record props -> R.Element -> R.Element
singleParent cpt props child = R.createElement cpt props [ child ]
childless :: forall props. R.Component props -> Record props -> R.Element
childless cpt props = R.createElement cpt props []
showText :: forall s. Show s => s -> R.Element
showText = text <<< show
----- Reactix's new effectful reducer: sneak-peek because anoe wants to demo on tuesday
-- | Like a reducer, but lives in Effect
type Reductor state action = Tuple state (action -> Effect Unit)
-- | Like useReductor, but lives in Effect
useReductor :: forall s a i. Actor s a -> (i -> Effect s) -> i -> R.Hooks (Reductor s a)
useReductor f i j =
hook $ \_ ->
pure $ currySecond $ tuple $ react ... "useReducer" $ args3 (mkEffectFn2 (flip f)) j (mkEffectFn1 i)
-- | Like `useReductor`, but takes an initial state instead of an
-- | initialiser function and argument
useReductor' :: forall s a. Actor s a -> s -> R.Hooks (Reductor s a)
useReductor' r = useReductor r pure
render :: R.Element -> DOM.Element -> Effect Unit
render e d = delay unit $ \_ -> pure $ R.reactDOM ... "render" $ args2 e d
addRootElement :: DOM.Element -> Effect Unit
addRootElement = runEffectFn1 _addRootElement
foreign import _addRootElement
:: EffectFn1 DOM.Element Unit
appendChild :: forall n m. IsNode n => IsNode m => n -> m -> Effect Unit
appendChild n c = delay unit $ \_ -> pure $ n ... "appendChild" $ [c]
appendChildToParentId :: forall c. IsNode c => String -> c -> Effect Unit
appendChildToParentId ps c = delay unit $ \_ -> do
parentEl <- getElementById ps
case parentEl of
Nothing -> pure unit
Just el -> appendChild el c
effectLink :: Effect Unit -> String -> R.Element
effectLink eff msg = H.a { on: {click: const eff} } [H.text msg]
useCache :: forall i o. Eq i => i -> (i -> R.Hooks o) -> R.Hooks o
useCache i f = do
iRef <- R.useRef Nothing
oRef <- R.useRef Nothing
let currI = R.readRef iRef
let currO = R.readRef oRef
if currI == Just i then
case currO of
Nothing -> f i -- this one shouldn't happen, but purescript
Just v -> pure v
else do
new <- f i
R.unsafeHooksEffect (R.setRef iRef $ Just i)
R.unsafeHooksEffect (R.setRef oRef $ Just new)
pure new
inputFile :: forall e. Int -> e -> Maybe WF.File
inputFile n e = item n $ ((el .. "files") :: FileList)
where
el = e .. "target"
-- | Get blob from an 'onchange' e.target event
inputFileBlob n e = unsafePartial $ do
let ff = fromJust $ inputFile n e
pure $ WF.toBlob ff
inputFileNameWithBlob :: forall e. Int -> e -> Maybe {blob :: Blob, name :: String}
inputFileNameWithBlob n e = case ff of
Nothing -> Nothing
Just f -> Just {blob: WF.toBlob f, name: WF.name f}
where
ff = inputFile n e
-- | Get blob from a drop event
--dataTransferFileBlob :: forall e. DE.IsEvent e => RE.SyntheticEvent e -> Effect Blob
dataTransferFileBlob e = unsafePartial $ do
let ff = fromJust $ item 0 $ ((e .. "dataTransfer" .. "files") :: FileList)
pure $ WF.toBlob ff
blur :: DOM.Element -> Effect Unit
blur el = el ... "blur" $ []
row :: Array R.Element -> R.Element
row children = H.div { className: "row" } children
col :: Int -> Array R.Element -> R.Element
col n children = H.div { className : "col-md-" <> show n } children
innerText :: DOM.Element -> String
innerText e = e .. "innerText"
foreign import data Selection :: Type
getSelection :: Unit -> Effect Selection
getSelection = runEffectFn1 _getSelection
foreign import _getSelection :: EffectFn1 Unit Selection
stringify :: forall a. a -> Int -> String
stringify j indent = runFn2 _stringify j indent
foreign import _stringify :: forall a. Fn2 a Int String
getls :: Effect Storage
getls = window >>= localStorage
openNodesKey :: LocalStorageKey
openNodesKey = "garg-open-nodes"
type LocalStorageKey = String
loadLocalStorageState :: forall s. JSON.ReadForeign s => LocalStorageKey -> T.Box s -> Effect Unit
loadLocalStorageState key cell = do
storage <- getls
item :: Maybe String <- getItem key storage
-- let json = hush <<< Argonaut.jsonParser =<< item
-- let parsed = hush <<< Argonaut.decodeJson =<< json
let parsed = hush <<< JSON.readJSON $ fromMaybe "" item
case parsed of
Nothing -> pure unit
Just p -> void $ T.write p cell
listenLocalStorageState :: forall s. JSON.WriteForeign s => LocalStorageKey -> T.Change s -> Effect Unit
listenLocalStorageState key { old, new } = do
--let json = Json.stringify $ Argonaut.encodeJson new
let json = JSON.writeJSON new
storage <- getls
setItem key json storage
getMessageDataStr :: DE.MessageEvent -> String
getMessageDataStr = getMessageData
getMessageOrigin :: DE.MessageEvent -> String
getMessageOrigin me = me .. "origin"
getMessageData :: forall o. DE.MessageEvent -> o
getMessageData me = me .. "data"
foreign import _postMessage
:: forall r. EffectFn3 r String String Unit
postMessage :: forall r. R.Ref (Nullable r) -> String -> Effect Unit
postMessage ref msg = do
case (R.readNullableRef ref) of
(Just ifr) -> do
runEffectFn3 _postMessage ifr msg (ifr .. "src")
(Nothing) -> pure unit
foreign import _setCookie :: EffectFn1 String Unit
setCookie :: String -> Effect Unit
setCookie = runEffectFn1 _setCookie
focus :: Nullable R.Element -> Effect Unit
focus nEl = case toMaybe nEl of
Nothing -> pure unit
Just el -> el ... "focus" $ []
setIndeterminateCheckbox :: R.Element -> Boolean -> Effect R.Element
setIndeterminateCheckbox el val = pure $ (el .= "indeterminate") val
-- A "trigger" is a ref to a function which is used to make changes without
-- modifying too much DOM.
-- This is to escape passing explicit state to nested child components.
type Trigger a = R.Ref (Maybe (a -> Effect Unit))
callTrigger :: forall a. Trigger a -> a -> Effect Unit
callTrigger tRef arg = case R.readRef tRef of
Nothing -> do
log2 "[callTrigger] trigger is empty" tRef
pure unit
Just t -> t arg
setTrigger :: forall a. Trigger a -> (a -> Effect Unit) -> Effect Unit
setTrigger tRef fun = R.setRef tRef $ Just fun
clearTrigger :: forall a. Trigger a -> Effect Unit
clearTrigger tRef = R.setRef tRef Nothing
type Rect =
( x :: Number
, y :: Number
, width :: Number
, height :: Number )
foreign import _domRectFromRect :: Fn1 (Record Rect) DOMRect
domRectFromRect :: Record Rect -> DOMRect
domRectFromRect = runFn1 _domRectFromRect
boundingRect :: forall e. IsElement e => Array e -> DOMRect
boundingRect els =
case A.uncons els of
Nothing -> domRectFromRect { x: 0.0, y: 0.0, width: 0.0, height: 0.0 }
Just { head, tail } ->
let br = Element.boundingRect head
in
case tail of
[] -> br
_ ->
let brs = boundingRect tail
minx = min br.left brs.left
maxx = max br.right brs.right
miny = min br.top brs.top
maxy = max br.bottom brs.bottom
in
domRectFromRect { x: minx
, y: miny
, width: maxx - minx
, height: maxy - miny }
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils/Regex.js 0000664 0000000 0000000 00000000444 14111104351 0031126 0 ustar 00root root 0000000 0000000 function _cloneRegex(r) {
return new RegExp(r.source, r.flags);
}
function _getRegexLastIndex(r) {
return r.lastIndex;
}
function _execRegex(r, s) {
return r.exec(s);
}
exports._cloneRegex = _cloneRegex;
exports._getRegexLastIndex = _getRegexLastIndex;
exports._execRegex = _execRegex;
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils/Regex.purs 0000664 0000000 0000000 00000001377 14111104351 0031511 0 ustar 00root root 0000000 0000000 -- | Utilities for working with regexes in a naughty mutable manner
module Gargantext.Utils.Regex where
import Effect (Effect)
import Prelude ((<$>))
import Data.Maybe (Maybe)
import Effect.Uncurried (EffectFn2, runEffectFn2)
import Data.Function.Uncurried (Fn1, runFn1)
import Data.Nullable (Nullable, toMaybe)
import Data.String.Regex (Regex)
foreign import _cloneRegex :: Fn1 Regex Regex
foreign import _getRegexLastIndex :: Fn1 Regex Int
foreign import _execRegex :: EffectFn2 Regex String (Nullable String)
cloneRegex :: Regex -> Regex
cloneRegex = runFn1 _cloneRegex
getRegexLastIndex :: Regex -> Int
getRegexLastIndex = runFn1 _getRegexLastIndex
execRegex :: Regex -> String -> Effect (Maybe String)
execRegex r s = toMaybe <$> runEffectFn2 _execRegex r s
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils/Selection.js0000664 0000000 0000000 00000000116 14111104351 0031775 0 ustar 00root root 0000000 0000000 exports._getSelection = function() { return window.getSelection() || null; };
Selection.purs 0000664 0000000 0000000 00000005055 14111104351 0032302 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils module Gargantext.Utils.Selection where
import Prelude
import Data.Maybe (Maybe, maybe)
import Data.Nullable (Nullable, toMaybe)
import Data.Tuple (Tuple(..))
import DOM.Simple.Types (Element, DOMRect)
import DOM.Simple.Element as Element
import Effect (Effect)
import FFI.Simple ((.?), (..), (...))
-- | Represents a text selection
foreign import data Selection :: Type
-- | Represents a single selection range
foreign import data Range :: Type
-- Terminology:
-- Anchor: point at which the selection was started
-- Focus: point at which the selection ends
-- | The Node in which the anchor lies
anchorNode :: Selection -> Maybe Element
anchorNode s = s .? "anchorNode"
-- | The Node in which the focus lies
focusNode :: Selection -> Maybe Element
focusNode s = s .? "focusNode"
-- | Whether the anchor and focus are at the same point
isSelectionCollapsed :: Selection -> Boolean
isSelectionCollapsed s = s .. "isCollapsed"
rangeCount :: Selection -> Int
rangeCount s = s .. "rangeCount"
getRange :: Selection -> Int -> Effect Range
getRange s i = pure $ s ... "getRangeAt" $ [i]
-- | Renders a selection or range as a string
selectionToString :: Selection -> String
selectionToString s = s ... "toString" $ []
-- | Renders a range as a string
rangeToString :: Range -> String
rangeToString s = s ... "toString" $ []
--- | Convert range to an offset tuple
rangeToTuple :: Range -> Tuple Int Int
rangeToTuple r = Tuple (r .. "startOffset") (r .. "endOffset")
-- | Whether the anchor and focus are at the same point
isRangeCollapsed :: Range -> Boolean
isRangeCollapsed r = r .. "isCollapsed"
cloneRange :: Range -> Range
cloneRange r = r ... "cloneRange" $ []
collapseRange :: Range -> Boolean -> Effect Unit
collapseRange r toStart = pure $ r ... "collapse" $ [toStart]
commonAncestorContainer :: Range -> Element
commonAncestorContainer r = r .. "commonAncestorContainer"
insertNode :: Range -> Element -> Effect Unit
insertNode r e = pure $ r ... "insertNode" $ [e]
boundingRect :: Range -> DOMRect
boundingRect r = r ... "getBoundingClientRect" $ []
-- getSelection
-- | Fetches the current text selection, if any
getSelection :: Effect (Maybe Selection)
getSelection = toMaybe <$> _getSelection
foreign import _getSelection :: Effect (Nullable Selection)
-- | Are both the start and end of the selection contained within an Element
doesSelectionLieWithin :: Selection -> Element -> Boolean
doesSelectionLieWithin sel elem = test anchorNode && test focusNode
where
test :: (Selection -> Maybe Element) -> Boolean
test f = maybe false (Element.contains elem) (f sel)
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils/Seq.purs 0000664 0000000 0000000 00000000431 14111104351 0031155 0 ustar 00root root 0000000 0000000 module Gargantext.Utils.Seq (mapMaybe) where
import Data.Maybe (Maybe, maybe)
import Data.Sequence (Seq, concatMap, empty, singleton)
import Gargantext.Prelude ((<<<))
mapMaybe :: forall a b. (a -> Maybe b) -> Seq a -> Seq b
mapMaybe f = concatMap (maybe empty singleton <<< f)
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils/String.js 0000664 0000000 0000000 00000000122 14111104351 0031313 0 ustar 00root root 0000000 0000000 exports._btoa = function(s) {
return btoa(unescape(encodeURIComponent(s)));
}
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils/String.purs 0000664 0000000 0000000 00000000476 14111104351 0031704 0 ustar 00root root 0000000 0000000 module Gargantext.Utils.String where
import Prelude
import Data.Function.Uncurried (Fn1, runFn1)
import Data.Int as Int
import Data.Number.Format as DNF
foreign import _btoa :: Fn1 String String
btoa :: String -> String
btoa = runFn1 _btoa
intToString :: Int -> String
intToString = DNF.toString <<< Int.toNumber
Toestand.purs 0000664 0000000 0000000 00000003453 14111104351 0032136 0 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils module Gargantext.Utils.Toestand
( class Reloadable, reload, Reload, ReloadS, newReload, InitReload(..), ready, useMemberBox )
where
import Prelude (class Ord, Unit, bind, pure, unit, (+))
import Data.Set as Set
import Data.Set (Set)
import Effect (Effect)
import Reactix as R
import Toestand as T
-- | Reload is a simple counter that can be used to force an update.
type Reload = Int
type ReloadS = T.Box Reload
class Reloadable t where
reload :: t -> Effect Unit
-- | An empty Reload is zero as it has not yet been reloaded.
newReload :: Reload
newReload = 0
instance Reloadable (T.Box Int) where
reload box = T.modify_ (_ + 1) box
instance Reloadable (c Reload) => Reloadable (T.Box (InitReload c)) where
reload box = do
val <- T.read box
case val of
Init -> pure unit
Ready r -> reload r
-- inner is a Box wrapping a Reload
data InitReload (inner :: Type -> Type) = Init | Ready (inner Reload)
-- | Initialises an InitReload box with the Reload box it contains,
-- | if it has not already been initialised.
ready :: forall box c. T.ReadWrite box (InitReload c) => T.ReadWrite (c Reload) Reload
=> box -> (c Reload) -> Effect Unit
ready box with = do
val <- T.read box
case val of
Init -> T.write_ (Ready with) box
Ready _ -> pure unit
-- | Creates a cursor which presents a Boolean over whether the member
-- | is in the set. Adjusting the value will toggle whether the value
-- | is in the underlying set.
useMemberBox
:: forall box v. Ord v => T.ReadWrite box (Set v)
=> v -> box -> R.Hooks (T.Box Boolean)
useMemberBox val box = T.useFocused (Set.member val) (toggleSet val) box
-- utility for useMemberBox
toggleSet :: forall s. Ord s => s -> Boolean -> Set s -> Set s
toggleSet val true set = Set.insert val set
toggleSet val false set = Set.delete val set
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Utils/Tuple.purs 0000664 0000000 0000000 00000000244 14111104351 0031520 0 ustar 00root root 0000000 0000000 module Gargantext.Utils.Tuple where
import Data.Tuple (Tuple(..))
mapFst :: forall a b c. (a -> c) -> Tuple a b -> Tuple c b
mapFst f (Tuple k v) = Tuple (f k) v
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Version.js 0000664 0000000 0000000 00000000132 14111104351 0030373 0 ustar 00root root 0000000 0000000 'use strict';
const pkg = require('../../package.json');
exports.version = pkg.version;
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Gargantext/Version.purs 0000664 0000000 0000000 00000004062 14111104351 0030756 0 ustar 00root root 0000000 0000000 module Gargantext.Version where
import Prelude
import DOM.Simple.Console (log2)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Config.REST as REST
import Gargantext.Ends (toUrl)
import Gargantext.Sessions (Session(..))
import Gargantext.Sessions as Sessions
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Version"
type Version = String
foreign import version :: Version
getBackendVersion :: Session -> Aff (Either REST.RESTError Version)
getBackendVersion (Session { backend }) = REST.get Nothing (toUrl backend "version")
type VersionProps =
(
session :: Sessions.Session
)
versionView :: R2.Component VersionProps
versionView = R.createElement versionCpt
versionCpt :: R.Component VersionProps
versionCpt = here.component "version" cpt
where
cpt { session } _ = do
versionBack <- T.useBox "No Backend Version"
versionBack' <- T.useLive T.unequal versionBack
R.useEffect' $ do
launchAff_ $ do
v <- getBackendVersion session
case v of
Right v' -> liftEffect $ T.write_ v' versionBack
Left err -> liftEffect $ log2 "[version] error" err
pure $ case version == versionBack' of
true -> H.a { className: "fa fa-check-circle-o"
, textDecoration: "none"
, title: "Versions match: frontend ("
<> version
<> "), backend ("
<> versionBack'
<> ")"
} []
false -> H.a { className: "fa fa-exclamation-triangle"
, textDecoration: "none"
, title: "Versions mismatch: frontend ("
<> version
<> "), backend ("
<> versionBack'
<> ")"
} []
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/Main.purs 0000664 0000000 0000000 00000001053 14111104351 0026106 0 ustar 00root root 0000000 0000000 module Main (main) where
import DOM.Simple (Element)
import DOM.Simple.Console (log)
import DOM.Simple.Document (document)
import Data.Maybe (Maybe(..))
import Data.Nullable (toMaybe)
import Effect (Effect)
import FFI.Simple ((...))
import Gargantext.Components.App (app)
import Gargantext.Utils.Reactix as R2
import Prelude (Unit, ($))
main :: Effect Unit
main = paint $ toMaybe (document ... "getElementById" $ [ "app" ])
paint :: Maybe Element -> Effect Unit
paint Nothing = log "[main] Container not found"
paint (Just c) = R2.render (app {} []) c
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/external-deps/ 0000775 0000000 0000000 00000000000 14111104351 0027063 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/external-deps/JitsiMeetAPI.js0000664 0000000 0000000 00000077205 14111104351 0031663 0 ustar 00root root 0000000 0000000 !function(e,t){"object"==typeof exports&&"object"==typeof module?module.exports=t():"function"==typeof define&&define.amd?define([],t):"object"==typeof exports?exports.JiitsiMeetExternalAPI=t():e.JiitsiMeetExternalAPI=t()}(window,(function(){return function(e){var t={};function n(r){if(t[r])return t[r].exports;var i=t[r]={i:r,l:!1,exports:{}};return e[r].call(i.exports,i,i.exports,n),i.l=!0,i.exports}return n.m=e,n.c=t,n.d=function(e,t,r){n.o(e,t)||Object.defineProperty(e,t,{enumerable:!0,get:r})},n.r=function(e){"undefined"!=typeof Symbol&&Symbol.toStringTag&&Object.defineProperty(e,Symbol.toStringTag,{value:"Module"}),Object.defineProperty(e,"__esModule",{value:!0})},n.t=function(e,t){if(1&t&&(e=n(e)),8&t)return e;if(4&t&&"object"==typeof e&&e&&e.__esModule)return e;var r=Object.create(null);if(n.r(r),Object.defineProperty(r,"default",{enumerable:!0,value:e}),2&t&&"string"!=typeof e)for(var i in e)n.d(r,i,function(t){return e[t]}.bind(null,i));return r},n.n=function(e){var t=e&&e.__esModule?function(){return e.default}:function(){return e};return n.d(t,"a",t),t},n.o=function(e,t){return Object.prototype.hasOwnProperty.call(e,t)},n.p="/libs/",n(n.s=7)}([function(e,t,n){"use strict";(function(e){n.d(t,"a",(function(){return s})),n.d(t,"b",(function(){return o})),n.d(t,"c",(function(){return a})),n.d(t,"d",(function(){return c})),n.d(t,"e",(function(){return l})),n.d(t,"f",(function(){return u})),n.d(t,"g",(function(){return d})),n.d(t,"h",(function(){return p}));var r=n(6);const i=n.n(r).a.getLogger(e);function s(e){return e.sendRequest({type:"devices",name:"getAvailableDevices"}).catch(e=>(i.error(e),{}))}function o(e){return e.sendRequest({type:"devices",name:"getCurrentDevices"}).catch(e=>(i.error(e),{}))}function a(e,t){return e.sendRequest({deviceType:t,type:"devices",name:"isDeviceChangeAvailable"})}function c(e){return e.sendRequest({type:"devices",name:"isDeviceListAvailable"})}function l(e){return e.sendRequest({type:"devices",name:"isMultipleAudioInputSupported"})}function u(e,t,n){return h(e,{id:n,kind:"audioinput",label:t})}function d(e,t,n){return h(e,{id:n,kind:"audiooutput",label:t})}function h(e,t){return e.sendRequest({type:"devices",name:"setDevice",device:t})}function p(e,t,n){return h(e,{id:n,kind:"videoinput",label:t})}}).call(this,"modules/API/external/functions.js")},function(e,t,n){"use strict";var r,i="object"==typeof Reflect?Reflect:null,s=i&&"function"==typeof i.apply?i.apply:function(e,t,n){return Function.prototype.apply.call(e,t,n)};r=i&&"function"==typeof i.ownKeys?i.ownKeys:Object.getOwnPropertySymbols?function(e){return Object.getOwnPropertyNames(e).concat(Object.getOwnPropertySymbols(e))}:function(e){return Object.getOwnPropertyNames(e)};var o=Number.isNaN||function(e){return e!=e};function a(){a.init.call(this)}e.exports=a,a.EventEmitter=a,a.prototype._events=void 0,a.prototype._eventsCount=0,a.prototype._maxListeners=void 0;var c=10;function l(e){if("function"!=typeof e)throw new TypeError('The "listener" argument must be of type Function. Received type '+typeof e)}function u(e){return void 0===e._maxListeners?a.defaultMaxListeners:e._maxListeners}function d(e,t,n,r){var i,s,o,a;if(l(n),void 0===(s=e._events)?(s=e._events=Object.create(null),e._eventsCount=0):(void 0!==s.newListener&&(e.emit("newListener",t,n.listener?n.listener:n),s=e._events),o=s[t]),void 0===o)o=s[t]=n,++e._eventsCount;else if("function"==typeof o?o=s[t]=r?[n,o]:[o,n]:r?o.unshift(n):o.push(n),(i=u(e))>0&&o.length>i&&!o.warned){o.warned=!0;var c=new Error("Possible EventEmitter memory leak detected. "+o.length+" "+String(t)+" listeners added. Use emitter.setMaxListeners() to increase limit");c.name="MaxListenersExceededWarning",c.emitter=e,c.type=t,c.count=o.length,a=c,console&&console.warn&&console.warn(a)}return e}function h(){if(!this.fired)return this.target.removeListener(this.type,this.wrapFn),this.fired=!0,0===arguments.length?this.listener.call(this.target):this.listener.apply(this.target,arguments)}function p(e,t,n){var r={fired:!1,wrapFn:void 0,target:e,type:t,listener:n},i=h.bind(r);return i.listener=n,r.wrapFn=i,i}function f(e,t,n){var r=e._events;if(void 0===r)return[];var i=r[t];return void 0===i?[]:"function"==typeof i?n?[i.listener||i]:[i]:n?function(e){for(var t=new Array(e.length),n=0;n0&&(o=t[0]),o instanceof Error)throw o;var a=new Error("Unhandled error."+(o?" ("+o.message+")":""));throw a.context=o,a}var c=i[e];if(void 0===c)return!1;if("function"==typeof c)s(c,this,t);else{var l=c.length,u=m(c,l);for(n=0;n=0;s--)if(n[s]===t||n[s].listener===t){o=n[s].listener,i=s;break}if(i<0)return this;0===i?n.shift():function(e,t){for(;t+1=0;r--)this.removeListener(e,t[r]);return this},a.prototype.listeners=function(e){return f(this,e,!0)},a.prototype.rawListeners=function(e){return f(this,e,!1)},a.listenerCount=function(e,t){return"function"==typeof e.listenerCount?e.listenerCount(t):g.call(e,t)},a.prototype.listenerCount=g,a.prototype.eventNames=function(){return this._eventsCount>0?r(this._events):[]}},function(e,t){var n={trace:0,debug:1,info:2,log:3,warn:4,error:5};a.consoleTransport=console;var r=[a.consoleTransport];a.addGlobalTransport=function(e){-1===r.indexOf(e)&&r.push(e)},a.removeGlobalTransport=function(e){var t=r.indexOf(e);-1!==t&&r.splice(t,1)};var i={};function s(){var e={methodName:"",fileLocation:"",line:null,column:null},t=new Error,n=t.stack?t.stack.split("\n"):[];if(!n||n.length<3)return e;var r=null;return n[3]&&(r=n[3].match(/\s*at\s*(.+?)\s*\((\S*)\s*:(\d*)\s*:(\d*)\)/)),!r||r.length<=4?(0===n[2].indexOf("log@")?e.methodName=n[3].substr(0,n[3].indexOf("@")):e.methodName=n[2].substr(0,n[2].indexOf("@")),e):(e.methodName=r[1],e.fileLocation=r[2],e.line=r[3],e.column=r[4],e)}function o(){var e=arguments[0],t=arguments[1],o=Array.prototype.slice.call(arguments,2);if(!(n[t]1&&h.push("<"+a.methodName+">: ");var p=h.concat(o);d.bind(u).apply(u,p)}}}function a(e,t,r,i){this.id=t,this.options=i||{},this.transports=r,this.transports||(this.transports=[]),this.level=n[e];for(var s=Object.keys(n),a=0;a1||!i?n[0]:void 0,o=n.length>1&&n[1]||i||{},a=JSON.parse(e,s);return"ignore"===o.protoAction?a:a&&"object"==typeof a&&e.match(r)?(t.scan(a,o),a):a},t.scan=function(e,t={}){let n=[e];for(;n.length;){const e=n;n=[];for(const r of e){if(Object.prototype.hasOwnProperty.call(r,"__proto__")){if("remove"!==t.protoAction)throw new SyntaxError("Object contains forbidden prototype property");delete r.__proto__}for(const e in r){const t=r[e];t&&"object"==typeof t&&n.push(r[e])}}}},t.safeParse=function(e,n){try{return t.parse(e,n)}catch(e){return null}}},function(e,t){function n(){return new DOMException("The request is not allowed","NotAllowedError")}
/*! clipboard-copy. MIT License. Feross Aboukhadijeh */
e.exports=async function(e){try{await async function(e){if(!navigator.clipboard)throw n();return navigator.clipboard.writeText(e)}(e)}catch(t){try{await async function(e){const t=document.createElement("span");t.textContent=e,t.style.whiteSpace="pre",t.style.webkitUserSelect="auto",t.style.userSelect="all",document.body.appendChild(t);const r=window.getSelection(),i=window.document.createRange();r.removeAllRanges(),i.selectNode(t),r.addRange(i);let s=!1;try{s=window.document.execCommand("copy")}finally{r.removeAllRanges(),window.document.body.removeChild(t)}if(!s)throw n()}(e)}catch(e){throw e||t||n()}}}},function(e,t){e.exports=function(e){var t,n=e.scope,r=e.window,i=e.windowForEventListening||window,s=e.allowedOrigin,o={},a=[],c={},l=!1,u=function(e){var t;try{t=JSON.parse(e.data)}catch(e){return}if((!s||e.origin===s)&&t&&t.postis&&t.scope===n){var r=o[t.method];if(r)for(var i=0;i=this.maxEntryLength&&this._flush(!0,!0)},i.prototype.start=function(){this._reschedulePublishInterval()},i.prototype._reschedulePublishInterval=function(){this.storeLogsIntervalID&&(window.clearTimeout(this.storeLogsIntervalID),this.storeLogsIntervalID=null),this.storeLogsIntervalID=window.setTimeout(this._flush.bind(this,!1,!0),this.storeInterval)},i.prototype.flush=function(){this._flush(!1,!0)},i.prototype._flush=function(e,t){this.totalLen>0&&(this.logStorage.isReady()||e)&&(this.logStorage.isReady()?(this.outputCache.length&&(this.outputCache.forEach(function(e){this.logStorage.storeLogs(e)}.bind(this)),this.outputCache=[]),this.logStorage.storeLogs(this.queue)):this.outputCache.push(this.queue),this.queue=[],this.totalLen=0),t&&this._reschedulePublishInterval()},i.prototype.stop=function(){this._flush(!1,!1)},e.exports=i},function(e,t,n){"use strict";n.r(t),n.d(t,"default",(function(){return M}));var r=n(1),i=n.n(r);class s extends i.a{constructor(...e){var t,n,r;super(...e),r={},(n="_storage")in(t=this)?Object.defineProperty(t,n,{value:r,enumerable:!0,configurable:!0,writable:!0}):t[n]=r}clear(){this._storage={}}get length(){return Object.keys(this._storage).length}getItem(e){return this._storage[e]}setItem(e,t){this._storage[e]=t}removeItem(e){delete this._storage[e]}key(e){const t=Object.keys(this._storage);if(!(t.length<=e))return t[e]}serialize(){return JSON.stringify(this._storage)}}class o extends i.a{constructor(){super();try{this._storage=window.localStorage,this._localStorageDisabled=!1}catch(e){}this._storage||(console.warn("Local storage is disabled."),this._storage=new s,this._localStorageDisabled=!0)}isLocalStorageDisabled(){return this._localStorageDisabled}clear(){this._storage.clear(),this.emit("changed")}get length(){return this._storage.length}getItem(e){return this._storage.getItem(e)}setItem(e,t,n=!1){this._storage.setItem(e,t),n||this.emit("changed")}removeItem(e){this._storage.removeItem(e),this.emit("changed")}key(e){return this._storage.key(e)}serialize(){if(this.isLocalStorageDisabled())return this._storage.serialize();const e=this._storage.length,t={};for(let n=0;n{const n=e.split("="),r=n[0];if(!r||u.includes(r.split(".")[0]))return;let s;try{if(s=n[1],!t){const e=decodeURIComponent(s).replace(/\\&/,"&");s="undefined"===e?void 0:l.a.parse(e)}}catch(e){return void function(e,t=""){console.error(t,e),window.onerror&&window.onerror(t,null,null,null,e)}(e,"Failed to parse URL parameter value: "+String(s))}i[r]=s}),i}function h(e){const t=new RegExp("^([a-z][a-z0-9\\.\\+-]*:)+","gi"),n=t.exec(e);if(n){let r=n[n.length-1].toLowerCase();"http:"!==r&&"https:"!==r&&(r="https:"),(e=e.substring(t.lastIndex)).startsWith("//")&&(e=r+e)}return e}function p(e={}){const t=[];for(const n in e)try{t.push(`${n}=${encodeURIComponent(JSON.stringify(e[n]))}`)}catch(e){console.warn(`Error encoding ${n}: ${e}`)}return t}function f(e){const t={toString:g};let n,r,i;if(e=e.replace(/\s/g,""),n=new RegExp("^([a-z][a-z0-9\\.\\+-]*:)","gi"),r=n.exec(e),r&&(t.protocol=r[1].toLowerCase(),e=e.substring(n.lastIndex)),n=new RegExp("^(//[^/?#]+)","gi"),r=n.exec(e),r){let i=r[1].substring(2);e=e.substring(n.lastIndex);const s=i.indexOf("@");-1!==s&&(i=i.substring(s+1)),t.host=i;const o=i.lastIndexOf(":");-1!==o&&(t.port=i.substring(o+1),i=i.substring(0,o)),t.hostname=i}if(n=new RegExp("^([^?#]*)","gi"),r=n.exec(e),r&&(i=r[1],e=e.substring(n.lastIndex)),i?i.startsWith("/")||(i="/"+i):i="/",t.pathname=i,e.startsWith("?")){let n=e.indexOf("#",1);-1===n&&(n=e.length),t.search=e.substring(0,n),e=e.substring(n)}else t.search="";return t.hash=e.startsWith("#")?e:"",t}function g(e){const{hash:t,host:n,pathname:r,protocol:i,search:s}=e||this;let o="";return i&&(o+=i),n&&(o+="//"+n),o+=r||"/",s&&(o+=s),t&&(o+=t),o}function m(e){let t;t=e.serverURL&&e.room?new URL(e.room,e.serverURL).toString():e.room?e.room:e.url||"";const n=f(h(t));if(!n.protocol){let t=e.protocol||e.scheme;t&&(t.endsWith(":")||(t+=":"),n.protocol=t)}let{pathname:r}=n;if(!n.host){const t=e.domain||e.host||e.hostname;if(t){const{host:e,hostname:i,pathname:s,port:o}=f(h("org.jitsi.meet://"+t));e&&(n.host=e,n.hostname=i,n.port=o),"/"===r&&"/"!==s&&(r=s)}}const i=e.roomName||e.room;!i||!n.pathname.endsWith("/")&&n.pathname.endsWith("/"+i)||(r.endsWith("/")||(r+="/"),r+=i),n.pathname=r;const{jwt:s}=e;if(s){let{search:e}=n;-1===e.indexOf("?jwt=")&&-1===e.indexOf("&jwt=")&&(e.startsWith("?")||(e="?"+e),1===e.length||(e+="&"),e+="jwt="+s,n.search=e)}let{hash:o}=n;for(const t of["config","interfaceConfig","devices","userInfo","appData"]){const n=p(e[t+"Overwrite"]||e[t]||e[t+"Override"]);if(n.length){let e=`${t}.${n.join(`&${t}.`)}`;o.length?e="&"+e:o="#",o+=e}}return n.hash=o,n.toString()||void 0}var v=n(5),y=n.n(v);function _(e,t,n){return t in e?Object.defineProperty(e,t,{value:n,enumerable:!0,configurable:!0,writable:!0}):e[t]=n,e}const b={window:window.opener||window.parent};class w{constructor({postisOptions:e}={}){this.postis=y()(function(e){for(var t=1;t{},this.postis.listen("message",e=>this._receiveCallback(e))}dispose(){this.postis.destroy()}send(e){this.postis.send({method:"message",params:e})}setReceiveCallback(e){this._receiveCallback=e}}class L{constructor({backend:e}={}){this._listeners=new Map,this._requestID=0,this._responseHandlers=new Map,this._unprocessedMessages=new Set,this.addListener=this.on,e&&this.setBackend(e)}_disposeBackend(){this._backend&&(this._backend.dispose(),this._backend=null)}_onMessageReceived(e){if("response"===e.type){const t=this._responseHandlers.get(e.id);t&&(t(e),this._responseHandlers.delete(e.id))}else"request"===e.type?this.emit("request",e.data,(t,n)=>{this._backend.send({type:"response",error:n,id:e.id,result:t})}):this.emit("event",e.data)}dispose(){this._responseHandlers.clear(),this._unprocessedMessages.clear(),this.removeAllListeners(),this._disposeBackend()}emit(e,...t){const n=this._listeners.get(e);let r=!1;return n&&n.size&&n.forEach(e=>{r=e(...t)||r}),r||this._unprocessedMessages.add(t),r}on(e,t){let n=this._listeners.get(e);return n||(n=new Set,this._listeners.set(e,n)),n.add(t),this._unprocessedMessages.forEach(e=>{t(...e)&&this._unprocessedMessages.delete(e)}),this}removeAllListeners(e){return e?this._listeners.delete(e):this._listeners.clear(),this}removeListener(e,t){const n=this._listeners.get(e);return n&&n.delete(t),this}sendEvent(e={}){this._backend&&this._backend.send({type:"event",data:e})}sendRequest(e){if(!this._backend)return Promise.reject(new Error("No transport backend defined!"));this._requestID++;const t=this._requestID;return new Promise((n,r)=>{this._responseHandlers.set(t,({error:e,result:t})=>{void 0!==t?n(t):r(void 0!==e?e:new Error("Unexpected response format!"))}),this._backend.send({type:"request",data:e,id:t})})}setBackend(e){this._disposeBackend(),this._backend=e,this._backend.setReceiveCallback(this._onMessageReceived.bind(this))}}const O=d(window.location).jitsi_meet_external_api_id,x={};let j;"number"==typeof O&&(x.scope="jitsi_meet_external_api_"+O),(window.JitsiMeetJS||(window.JitsiMeetJS={}),window.JitsiMeetJS.app||(window.JitsiMeetJS.app={}),window.JitsiMeetJS.app).setExternalTransportBackend=e=>j.setBackend(e);var C=n(0);function S(e,t){if(null==e)return{};var n,r,i=function(e,t){if(null==e)return{};var n,r,i={},s=Object.keys(e);for(r=0;r=0||(i[n]=e[n]);return i}(e,t);if(Object.getOwnPropertySymbols){var s=Object.getOwnPropertySymbols(e);for(r=0;r=0||Object.prototype.propertyIsEnumerable.call(e,n)&&(i[n]=e[n])}return i}function E(e,t,n){return t in e?Object.defineProperty(e,t,{value:n,enumerable:!0,configurable:!0,writable:!0}):e[t]=n,e}const I=["css/all.css","libs/alwaysontop.min.js"],k={avatarUrl:"avatar-url",cancelPrivateChat:"cancel-private-chat",displayName:"display-name",e2eeKey:"e2ee-key",email:"email",toggleLobby:"toggle-lobby",hangup:"video-hangup",initiatePrivateChat:"initiate-private-chat",kickParticipant:"kick-participant",muteEveryone:"mute-everyone",overwriteConfig:"overwrite-config",password:"password",pinParticipant:"pin-participant",resizeLargeVideo:"resize-large-video",sendEndpointTextMessage:"send-endpoint-text-message",sendTones:"send-tones",setLargeVideoParticipant:"set-large-video-participant",setTileView:"set-tile-view",setVideoQuality:"set-video-quality",startRecording:"start-recording",startShareVideo:"start-share-video",stopRecording:"stop-recording",stopShareVideo:"stop-share-video",subject:"subject",submitFeedback:"submit-feedback",toggleAudio:"toggle-audio",toggleCamera:"toggle-camera",toggleCameraMirror:"toggle-camera-mirror",toggleChat:"toggle-chat",toggleFilmStrip:"toggle-film-strip",toggleRaiseHand:"toggle-raise-hand",toggleShareScreen:"toggle-share-screen",toggleTileView:"toggle-tile-view",toggleVideo:"toggle-video"},R={"avatar-changed":"avatarChanged","audio-availability-changed":"audioAvailabilityChanged","audio-mute-status-changed":"audioMuteStatusChanged","camera-error":"cameraError","chat-updated":"chatUpdated","content-sharing-participants-changed":"contentSharingParticipantsChanged","device-list-changed":"deviceListChanged","display-name-change":"displayNameChange","email-change":"emailChange","endpoint-text-message-received":"endpointTextMessageReceived","feedback-submitted":"feedbackSubmitted","feedback-prompt-displayed":"feedbackPromptDisplayed","filmstrip-display-changed":"filmstripDisplayChanged","incoming-message":"incomingMessage",log:"log","mic-error":"micError","outgoing-message":"outgoingMessage","participant-joined":"participantJoined","participant-kicked-out":"participantKickedOut","participant-left":"participantLeft","participant-role-changed":"participantRoleChanged","password-required":"passwordRequired","proxy-connection-event":"proxyConnectionEvent","raise-hand-updated":"raiseHandUpdated","recording-status-changed":"recordingStatusChanged","video-ready-to-close":"readyToClose","video-conference-joined":"videoConferenceJoined","video-conference-left":"videoConferenceLeft","video-availability-changed":"videoAvailabilityChanged","video-mute-status-changed":"videoMuteStatusChanged","video-quality-changed":"videoQualityChanged","screen-sharing-status-changed":"screenSharingStatusChanged","dominant-speaker-changed":"dominantSpeakerChanged","subject-change":"subjectChange","suspend-detected":"suspendDetected","tile-view-changed":"tileViewChanged"};let P=0;function N(e,t){e._numberOfParticipants+=t}function D(e,t={}){return m(function(e){for(var t=1;t0&&this.invite(d),this._tmpE2EEKey=f,this._isLargeVideoVisible=!0,this._numberOfParticipants=0,this._participants={},this._myUserID=void 0,this._onStageParticipant=void 0,this._setupListeners(),P++}_createIFrame(e,t,n){const r="jitsiConferenceFrame"+P;this._frame=document.createElement("iframe"),this._frame.allow="camera; microphone; display-capture; autoplay; clipboard-write",this._frame.src=this._url,this._frame.name=r,this._frame.id=r,this._setSize(e,t),this._frame.setAttribute("allowFullScreen","true"),this._frame.style.border=0,n&&(this._frame.onload=n),this._frame=this._parentNode.appendChild(this._frame)}_getAlwaysOnTopResources(){const e=this._frame.contentWindow,t=e.document;let n="";const r=t.querySelector("base");if(r&&r.href)n=r.href;else{const{protocol:t,host:r}=e.location;n=`${t}//${r}`}return I.map(e=>new URL(e,n).href)}_getFormattedDisplayName(e){const{formattedDisplayName:t}=this._participants[e]||{};return t}_getOnStageParticipant(){return this._onStageParticipant}_getLargeVideo(){const e=this.getIFrame();if(this._isLargeVideoVisible&&e&&e.contentWindow&&e.contentWindow.document)return e.contentWindow.document.getElementById("largeVideo")}_getParticipantVideo(e){const t=this.getIFrame();if(t&&t.contentWindow&&t.contentWindow.document)return void 0===e||e===this._myUserID?t.contentWindow.document.getElementById("localVideo_container"):t.contentWindow.document.querySelector(`#participant_${e} video`)}_setSize(e,t){const n=A(e),r=A(t);void 0!==n&&(this._height=e,this._frame.style.height=n),void 0!==r&&(this._width=t,this._frame.style.width=r)}_setupListeners(){this._transport.on("event",e=>{let{name:t}=e,n=S(e,["name"]);const r=n.id;switch(t){case"video-conference-joined":void 0!==this._tmpE2EEKey&&(this.executeCommand(k.e2eeKey,this._tmpE2EEKey),this._tmpE2EEKey=void 0),this._myUserID=r,this._participants[r]={avatarURL:n.avatarURL};case"participant-joined":this._participants[r]=this._participants[r]||{},this._participants[r].displayName=n.displayName,this._participants[r].formattedDisplayName=n.formattedDisplayName,N(this,1);break;case"participant-left":N(this,-1),delete this._participants[r];break;case"display-name-change":{const e=this._participants[r];e&&(e.displayName=n.displayname,e.formattedDisplayName=n.formattedDisplayName);break}case"email-change":{const e=this._participants[r];e&&(e.email=n.email);break}case"avatar-changed":{const e=this._participants[r];e&&(e.avatarURL=n.avatarURL);break}case"on-stage-participant-changed":this._onStageParticipant=r,this.emit("largeVideoChanged");break;case"large-video-visibility-changed":this._isLargeVideoVisible=n.isVisible,this.emit("largeVideoChanged");break;case"video-conference-left":N(this,-1),delete this._participants[this._myUserID];break;case"video-quality-changed":this._videoQuality=n.videoQuality;break;case"local-storage-changed":return a.setItem("jitsiLocalStorage",n.localStorageContent),!0}const i=R[t];return!!i&&(this.emit(i,n),!0)})}addEventListener(e,t){this.on(e,t)}addEventListeners(e){for(const t in e)this.addEventListener(t,e[t])}captureLargeVideoScreenshot(){return this._transport.sendRequest({name:"capture-largevideo-screenshot"})}dispose(){this.emit("_willDispose"),this._transport.dispose(),this.removeAllListeners(),this._frame&&this._frame.parentNode&&this._frame.parentNode.removeChild(this._frame)}executeCommand(e,...t){e in k?this._transport.sendEvent({data:t,name:k[e]}):console.error("Not supported command name.")}executeCommands(e){for(const t in e)this.executeCommand(t,e[t])}getAvailableDevices(){return Object(C.a)(this._transport)}getContentSharingParticipants(){return this._transport.sendRequest({name:"get-content-sharing-participants"})}getCurrentDevices(){return Object(C.b)(this._transport)}getLivestreamUrl(){return this._transport.sendRequest({name:"get-livestream-url"})}getParticipantsInfo(){const e=Object.keys(this._participants),t=Object.values(this._participants);return t.forEach((t,n)=>{t.participantId=e[n]}),t}getVideoQuality(){return this._videoQuality}isAudioAvailable(){return this._transport.sendRequest({name:"is-audio-available"})}isDeviceChangeAvailable(e){return Object(C.c)(this._transport,e)}isDeviceListAvailable(){return Object(C.d)(this._transport)}isMultipleAudioInputSupported(){return Object(C.e)(this._transport)}invite(e){return Array.isArray(e)&&0!==e.length?this._transport.sendRequest({name:"invite",invitees:e}):Promise.reject(new TypeError("Invalid Argument"))}isAudioMuted(){return this._transport.sendRequest({name:"is-audio-muted"})}isSharingScreen(){return this._transport.sendRequest({name:"is-sharing-screen"})}getAvatarURL(e){const{avatarURL:t}=this._participants[e]||{};return t}getDisplayName(e){const{displayName:t}=this._participants[e]||{};return t}getEmail(e){const{email:t}=this._participants[e]||{};return t}getIFrame(){return this._frame}getNumberOfParticipants(){return this._numberOfParticipants}isVideoAvailable(){return this._transport.sendRequest({name:"is-video-available"})}isVideoMuted(){return this._transport.sendRequest({name:"is-video-muted"})}pinParticipant(e){this.executeCommand("pinParticipant",e)}removeEventListener(e){this.removeAllListeners(e)}removeEventListeners(e){e.forEach(e=>this.removeEventListener(e))}resizeLargeVideo(e,t){e<=this._width&&t<=this._height&&this.executeCommand("resizeLargeVideo",e,t)}sendProxyConnectionEvent(e){this._transport.sendEvent({data:[e],name:"proxy-connection-event"})}setAudioInputDevice(e,t){return Object(C.f)(this._transport,e,t)}setAudioOutputDevice(e,t){return Object(C.g)(this._transport,e,t)}setLargeVideoParticipant(e){this.executeCommand("setLargeVideoParticipant",e)}setVideoInputDevice(e,t){return Object(C.h)(this._transport,e,t)}startRecording(e){this.executeCommand("startRecording",e)}stopRecording(e){this.executeCommand("startRecording",e)}}}])}));
//# sourceMappingURL=external_api.min.map
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/sass/ 0000775 0000000 0000000 00000000000 14111104351 0025261 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/sass/_annotation.sass 0000664 0000000 0000000 00000003160 14111104351 0030465 0 ustar 00root root 0000000 0000000 // $annotation-candidate-color: #aaa
// $annotation-graph-color: #0f0
// $annotation-stop-color: #f00
// Copied from bootstrap's bg-warning, bg-success, bg-danger:
$annotation-graph-color: #95D29593
$annotation-candidate-color: #B8B8B876
// $annotation-candidate-color: #b8daff
$annotation-stop-color: #F5949931
@mixin lg1($color)
color: #000
background-color: $color
@mixin lg2($color1, $color2)
color: #000
background-image: linear-gradient(rgba($color1, 0.5), rgba($color1, 0.5)), linear-gradient(rgba($color2, 0.5), rgba($color2, 0.5))
@mixin lg3($color1, $color2, $color3)
color: #000
background-image: linear-gradient(rgba($color1, 0.34), rgba($color1, 0.34)), linear-gradient(rgba($color2, 0.33), rgba($color2, 0.33)), linear-gradient(rgba($color3, 0.33), rgba($color3, 0.33))
.annotation-run
cursor: pointer
&.candidate-term.graph-term.stop-term
@include lg3($annotation-candidate-color, $annotation-graph-color, $annotation-stop-color)
&.candidate-term.graph-term
@include lg2($annotation-candidate-color, $annotation-graph-color)
&.candidate-term.stop-term
@include lg2($annotation-candidate-color, $annotation-stop-color)
&.graph-term.stop-term
@include lg2($annotation-graph-color, $annotation-stop-color)
&.candidate-term
@include lg1($annotation-candidate-color)
&.graph-term
@include lg1($annotation-graph-color)
&.stop-term
@include lg1($annotation-stop-color)
.context-menu
.candidate-term
@include lg1($annotation-candidate-color)
.graph-term
@include lg1($annotation-graph-color)
.stop-term
@include lg1($annotation-stop-color)
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/sass/_code_editor.sass 0000664 0000000 0000000 00000004363 14111104351 0030601 0 ustar 00root root 0000000 0000000 @mixin font-inherit()
font-family: inherit
font-size: inherit
font-style: inherit
font-variant-ligatures: inherit
font-weight: inherit
letter-spacing: inherit
line-height: inherit
text-indent: inherit
text-rendering: inherit
text-transform: inherit
@mixin common-overlay-props()
box-sizing: inherit
display: inherit
margin: 0px
padding: 10px
overflow-wrap: break-word
white-space: pre-wrap
word-break: keep-all
.code-editor
.editor
.code-area
flex-grow: 1
max-height: 200px
min-width: 25%
overflow: auto
.code-container
background-color: #fafafa
box-sizing: border-box
position: relative
font-family: Fira code,Fira Mono,Consolas,Menlo,Courier,monospace
font-size: 12px
font-variant-ligatures: common-ligatures
line-height: 1.5
overflow: hidden
padding: 0px
text-align: left
textarea
border: 0px
color: inherit
position: absolute
left: 0px
top: 0px
resize: none
height: 100%
overflow: hidden
width: 100%
-webkit-text-fill-color: transparent
@include common-overlay-props()
@include font-inherit()
pre
background: rgba(0, 0, 0, 0) none repeat scroll 0% 0%
border: 0px none
color: #000
pointer-events: none
position: relative
@include common-overlay-props()
@include font-inherit()
.v-divider
border-left: 1px solid gray
cursor: sw-resize
height: 100%
margin-left: 5px
margin-right: 5px
width: 1px
.html
flex-grow: 2
margin-left: 25px
padding-left: 25px
&.language-haskell
font-family: Fira code,Fira Mono,Consolas,Menlo,Courier,monospace
white-space: pre
&.language-python
font-family: Fira code,Fira Mono,Consolas,Menlo,Courier,monospace
white-space: pre
&.language-json
font-family: Fira code,Fira Mono,Consolas,Menlo,Courier,monospace
white-space: pre
&.language-md
ul
li
list-style: disc !important
ol
li
list-style: decimal !important
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/sass/_context_menu.sass 0000664 0000000 0000000 00000000642 14111104351 0031025 0 ustar 00root root 0000000 0000000 .context-menu
position: absolute
left: 96px
top: -64px
background-color: white
z-index: 1000
.context-menu a.list-group-item
cursor: pointer
.search-bar-container
margin-top: 11px
text-align: center
max-width: 800px
height: 33px
float: left
display: grid
grid-template-columns: auto auto auto
.search-bar-toggle
padding: 2px
margin: 2px
border: 0
.search-bar.closed
display: none
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/sass/_folder_view.sass 0000664 0000000 0000000 00000000322 14111104351 0030615 0 ustar 00root root 0000000 0000000 .fv.folders
display: grid
grid-template-columns: 100px 100px 100px
gap: 25px
margin: 20px 0px
.fv.action
position: relative
left: 100px
top: -15px
color: blue
.fv.btn
size: 100%
width:100% purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/sass/_graph.sass 0000664 0000000 0000000 00000003054 14111104351 0027416 0 ustar 00root root 0000000 0000000 @mixin sidePanelCommon
position: absolute
max-height: 600px
//overflow-y: scroll
top: 170px
//z-index: 1
#graph-explorer
margin-left: 20rem
margin-right: 20rem
padding-top: 0px
.graph-container
#sp-container
@include sidePanelCommon
border: 1px white solid
background-color: white
width: 28%
z-index: 15
#myTab
marginBottom: 18px
marginTop: 18px
#myTabContent
borderBottom: 1px solid black
paddingBottom : 19px
#horizontal-checkbox
ul
display: inline
float : left
.lefthanded #sp-container
left: 0%
.righthanded #sp-container
left: 70%
.graph-tree
@include sidePanelCommon
background-color: #fff
z-index: 1
.lefthanded .graph-tree
left: 80%
.righthanded .graph-tree
left: 0%
/* #toggle-container
/* position: fixed
/* z-index: 999 // needs to appear above solid menu bar
/* right: 25%
/* top: 10px
/* width: 50%
/* .container-fluid
/* padding-top: 90px
#controls-container
// position: fixed
position: absolute
// needs to appear above graph elements
z-index: 900
backdrop-filter: blur(4px)
background: rgba(255,255,255,75%)
// overflow: auto
left: 0
right: 0
top: 60px
.nav-item
padding-left: 0.8rem
.graph-row
height: 100vh
#graph-view
height: 95vh
#tree
position: absolute
z-index: 1
.input-with-autocomplete
.completions
position: fixed
max-height: 300px
overflow-y: scroll
width: 300px
top: 50px
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/sass/_login.sass 0000664 0000000 0000000 00000005265 14111104351 0027433 0 ustar 00root root 0000000 0000000 //.logoSmall
// line-height: 15px
// height: 10px
// padding: 10px 10px
#logo-designed
border: 15px
img
height: 150px
border: 3px solid white
#page-wrapper
padding-top: 40px
padding-left: 16px
padding-right: 16px
width: 100%
#user-page-header
border-bottom : 1px solid black
#user-page-info
margin-top : 38px
.tableHeader
color: white
#toolbar
display: inline
ul
li
display: inline
margin-right : 19px
form
display: inline
#horizontal-checkbox
ul
li
display : inline
float : left
margin-top: 12px
margin-right : 21px
li#rename
#rename-a
display : none
position : absolute
left : 125px
#node-popup-tooltip
background-color: white
border-bottom-left-radius: 6px
border-bottom-right-radius: 6px
border-top-left-radius: 6px
border-top-right-radius: 6px
&:hover
border: none
text-decoration: none
.popup-container
display: flex
flex-direction: colum
& > .card
border: 1px solid rgba(0,0,0,0.2)
box-shadow: 0 2px 5px rgba(0,0,0,0.2)
margin-bottom: 0px
width: 34rem
.fa-pencil
color: black
.card-body
display: flex
justify-content: center
background-color: white
border: none
.spacer
margin: 10px
.frame-search.card
border: 1px solid rgba(0,0,0,0.2)
box-shadow: 0 2px 5px rgba(0,0,0,0.2)
height: 600px
width: 1000px
#create-node-tooltip
position : absolute
left : 96px
top: -64px
background-color: white
z-index: 1000
.card-body
input
min-width: 200px
#file-type-tooltip
position : absolute
left : 96px
top: -64px
background-color: white
z-index: 1000
.card-body
select
min-width: 200px
.glyphitem
top: 0
display: inline-block
float: right
opacity: 0.6
padding-right: 5px
cursor: pointer
transition: transform 0.1s ease-out 0s
font-size: 15px
text-align: center
&:hover
display: inline-block
opacity: 1
transform: scale(1.4)
#sp-container
-webkit-transition: width 2s // For Safari 3.1 to 6.0
transition: width 2s
.nooverflow
max-width: 300px
height : 24px
overflow: hidden
text-overflow: ellipsis
&:hover
overflow: visible
height: auto
#graph-tree
.tree
margin-top: 27px
.nopadding
padding: 0 !important
margin: 0 !important
.tab-pane
.reload-btn
padding-right: 6px
.flex
display: flex
.flex-end
display: flex
justify-content: flex-end
.flex-center
display: flex
flew-wrap: wrap
justify-content: center
.flex-space-between,.flex-center
display: flex
justify-content: space-between
a:focus, a:hover
cursor: pointer
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/sass/_menu.sass 0000664 0000000 0000000 00000001772 14111104351 0027266 0 ustar 00root root 0000000 0000000 /* styles for menu.html template (navbar etc) */
/* #dafixedtop .navbar-text, #graphsfixedtop .navbar-text
/* margin: 0
/* padding-top: 15px
/* padding-bottom: 15px
/* float: none
#dafixedtop
position: sticky
top: 0
left: 0
right: 0
// correction for the popover
z-index: 910
#corporatop.nav-tabs > li
padding-left: 1
padding-right: 1
#corporatop.nav-tabs > li > a
padding-top: 8
padding-bottom: 8
line-height: .85
margin-bottom: -5px
.spacing-class
margin-right: 10px
.exportbtn
/* border: 1px solid #333 */
margin-top:17px /* valigns with bootstrap h2 */
.btn .glyphicon
/* glyphicons are always rendered too high within bootstrap buttons */
vertical-align: middle
/* graph name => editable input => submitName() => minimsg */
.editable
color: grey
#graphname-edit
color: white
background-color: transparent
border: none
max-width: 8em
.minimsg
font-size: .7em
padding: 7p0x 9px
.minimsg *
line-height: 100%
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/sass/_range_slider.sass 0000664 0000000 0000000 00000001444 14111104351 0030754 0 ustar 00root root 0000000 0000000 .range
width: 400px
/* some space for the right knob */
padding-right: 30px
.range-slider
position: relative
width: 85%
.scale
position: absolute
width: 100%
height: 3px
margin-top: 2px
background-color: #d8d8d8
.scale-sel
position: absolute
background-color: rgb(39, 196, 112)
width: 100%
height: 7px
.knob
position: absolute
cursor: pointer
-moz-user-select: none
-webkit-user-select: none
-ms-user-select: none
user-select: none
-o-user-select: none
margin-top: -4px
z-index: 1
box-shadow: 1px 1px 3px grey
.button
margin-top: -3px
background: #eee
width: 30px
height: 20px
.range-simple
input
width: 85%
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/sass/_styles.sass 0000664 0000000 0000000 00000003476 14111104351 0027650 0 ustar 00root root 0000000 0000000 .cache-toggle
cursor: pointer
.left-handed
.side-panel
//background-color: $dark
left: 2%
padding: 0.3em
position: fixed
top: 3.7em
background-color: #fff
width: 28%
.header
float: left
.corpus-doc-view
.annotated-field-wrapper
.annotated-field-runs
max-height: 200px
overflow-y: scroll
.list-group
.list-group-item-heading
display: inline-block
width: 60px
.right-handed
.side-panel
//background-color: $dark
left: 70%
padding: 0.3em
position: fixed
top: 3.7em
background-color: #fff
width: 28%
.header
float: right
.corpus-doc-view
.annotated-field-wrapper
.annotated-field-runs
max-height: 200px
overflow-y: scroll
.list-group
.list-group-item-heading
display: inline-block
width: 60px
.simple-layout
height: 100%
.license
padding-top: 10px
.spinner
position: absolute
left: 50%
top: 50%
.table
tr
td
color: #005a9aff
.active
font-weight: bold
text-decoration: underline
.ngrams-selector
display: flex
.ngrams-chooser
padding: 3px
.trash
text-decoration: line-through
.action-search
margin: 10px
.context-menu
position: fixed
.search-bar
margin: 10px
/* */
.body
ul
li
color: #005a9aff
.nav
color: #005a9aff
.btn-primary
color: white
background-color: #005a9aff
border-color: black
ul
.nav
color: #005a9aff
li
color: #005a9aff
.frame
height: 100vh
iframe
border: 0
.join-button
padding-bottom: 100px
padding-top: 100px
#app
width: 100%
.router-inner
display: flex
&.left-handed
flex-direction: row
&.right-handed
flex-direction: row
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/sass/_tree.sass 0000664 0000000 0000000 00000015026 14111104351 0027256 0 ustar 00root root 0000000 0000000 body > .tree ul > li:first-child::before
top: 12px
li
.leaf
display: flex
flex-direction: row
color: #005a9aff
.folder-icon
padding: 0 2 0 2
cursor: pointer
.node-link
a
cursor: pointer
& > .node-text
color: #000000
a.settings
cursor: pointer
display: block
padding: 0 2 0 2
text-decoration: none
visibility: hidden
z-index: 1
&:hover
a.settings
visibility: visible
.forest-layout-content
& > .tree
margin-top: 20px
.tree
ul
li
position: relative
&::after
content: " "
height: 1px
position: absolute
top: 12px
&::before
bottom: -12px
content: " "
height: 7px
position: absolute
top: 5px
&:not(:first-child):last-child::before
display: none
&:only-child::before
bottom: 7px
content: " "
display: list-item
//height: 7px
position: absolute
width: 1px
top: 5px
&.with-children
&::after
background-color: #000
&::before
background-color: #000
.lefthanded
.leaf
justify-content : flex-end
ul
margin-right : 5px
li
margin-right: 10px
padding-right: 5px
&.with-children
&::after
right: -10px
width: 5px
&::before
right: -10px
width: 1px
&:only-child::before
//right: 1px
.righthanded
.leaf
justify-content : flex-start
ul
margin-left : 5px
li
margin-left: 10px
padding-left: 5px
&.with-children
&::after
left: -10px
width: 5px
&::before
left: -10px
width: 1px
&:only::before
background-color: #000
right: 10px
.file-dropped
background-color: #d8dfe5
.node-actions
padding-left: 5px
.update-button
&.enabled
cursor: pointer
&.disabled
cursor: wait
.node
margin-top: 1px
&.node-type-valid
.text
text-decoration: underline
// based on https://codeburst.io/how-to-pure-css-pie-charts-w-css-variables-38287aea161e
.progress-pie
background: rgba(51, 122, 183, 0.1)
border-radius: 100%
height: calc(var(--size, 14) * 1px)
overflow: hidden
position: relative
width: calc(var(--size, 14) * 1px)
.progress-pie-segment
--a: calc(var(--over50, 0) * -100%)
--b: calc((1 + var(--over50, 0)) * 100%)
--degrees: calc((var(--offset, 0) / 100) * 360)
-webkit-clip-path: polygon(var(--a) var(--a), var(--b) var(--a), var(--b) var(--b), var(--a) var(--b))
clip-path: polygon(var(--a) var(--a), var(--b) var(--a), var(--b) var(--b), var(--a) var(--b))
height: 100%
position: absolute
transform: translate(0, -50%) rotate(90deg) rotate(calc(var(--degrees) * 1deg))
transform-origin: 50% 100%
width: 100%
z-index: calc(1 + var(--over50))
&:after,
&:before
background: var(--bg, rgb(51, 122, 183))
content: ''
height: 100%
position: absolute
width: 100%
&:before
--degrees: calc((var(--value, 45) / 100) * 360)
transform: translate(0, 100%) rotate(calc(var(--degrees) * 1deg))
transform-origin: 50% 0%
&:after
opacity: var(--over50, 0)
#node-popup-tooltip
// @XXX "react-awesome-popover" lack of parent host parameter
//
// hence, the popover will be added from within the overflow context
// of component where its CTA lies, causing an issue with the hidden
// overflow of its parent component
//
// to avoid a truncated popover, this position workaround has to be set
// (so the popover will be hoisted to the overflow context of the window)
//
// @link https://gitlab.iscpif.fr/gargantext/purescript-gargantext/issues/302
position: fixed
.tree
.node
margin-top: 5px
.children
.node
padding-left: 15px
// @XXX "react-awesome-popover" lack of parent host parameter
//
// as the container where the popover will be appended is actually a
// a heighthy sidebar (which a large is hidden with a scrollbar),
// the library tends to add the tooltip position in the middle of the
// sidebar height: which can be off screen
//
// this workaround appends the tooltip in a static position
.right-handed #node-popup-tooltip
$offset-x: 16.6666666667% // simulate "col-2" sidebar attributes
top: 50%
left: $offset-x
transform: translateY(-50%)
.left-handed #node-popup-tooltip
$offset-x: 16.6666666667% // simulate "col-2" sidebar attributes
top: 50%
right: $offset-x
transform: translateY(-50%)
.panel-actions
.almost-useable
color: orange
.development-in-progress
color: red
.ok-to-use
color: black
.popup-container
// will enlarge popup when inner content is larger (see issue #315)
& > .card
width: auto !important
.popup-container-body
// empirical value (see issue #308, #315)
max-height: 70vh
overflow-y: auto
.forest-layout-wrapper
// removing Bootstrap "col" padding
padding-left: 0
padding-right: 0
.forest-layout
$offset-y: 56px
padding-top: 8px
z-index: 909
// make the sidebar a scrollable component
// `max-width` rule is an addition due to Bootstrap "col-2" applied on its
// parent
position: fixed
height: calc(100vh - #{ $offset-y })
width: 100%
max-width: inherit
// avoiding ugly scrollbar
scrollbar-width: none
overflow-y: scroll
overflow-x: visible
&::-webkit-scrollbar
display: none
transition: border 150ms
// UX addition: visually delimiting the sidebar on hover
// -- for now in "_common.scss" file (see @TODO: More SASS structure)
// UX best pratice: when a lengthy column is overflowy hidden (with a scroll), a teaser
// UI element shows to the user that a scroll is possible
.forest-layout-teaser
$height: 24px // ~line-height to 1.5
$width: 16.6666666667% // simulate "col-2" sidebar attributes
$minus-parent-border: 1px // border size of the sidebar on hover
pointer-events: none
position: fixed
bottom: 0
height: $height
width: calc(#{ $width } - #{ $minus-parent-border})
// background -- for now in "_common.scss" file (@TODO: More SASS structure)
.right-handed .forest-layout-teaser
left: 0
.left-handed .forest-layout-teaser
right: 0
.left-handed .forest-layout
padding-left: 8px
padding-right: 16px
.right-handed .forest-layout
padding-left: 16px
padding-right: 8px
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/sass/bootstrap/ 0000775 0000000 0000000 00000000000 14111104351 0027276 5 ustar 00root root 0000000 0000000 purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/sass/bootstrap/_common.scss 0000664 0000000 0000000 00000001577 14111104351 0031634 0 ustar 00root root 0000000 0000000 /// Abtstract
/// Add alpha channel to a color
/// @access public
/// @param {Color} $color - color to work with
/// @param {Number} $percentage - percentage of `$color` opacity
/// @return {Color}
@function mixAlpha($color, $percentage) {
@return rgba($color, $percentage);
}
/// Misc
.with-icon-font {
font-family: ForkAwesome, $font-family-base;
}
/// Tree
/// (?) @TODO: More SASS structure (eg. exporting variables into component
/// SASS files)
/// For now we have cut-copy the rules here
.right-handed .forest-layout {
border-right: 1px solid $body-bg;
&:hover { border-right: 1px solid $border-color; }
}
.left-handed .forest-layout {
border-left: 1px solid $body-bg;
&:hover { border-left: 1px solid $border-color; }
}
.forest-layout-teaser {
background: linear-gradient(to bottom, mixAlpha($body-bg, 0%) 0%, mixAlpha($body-bg, 100%) 45%);
}
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/sass/bootstrap/darkster.scss 0000664 0000000 0000000 00000005156 14111104351 0032021 0 ustar 00root root 0000000 0000000 /*! Themestr.app `Darkster` Bootstrap 4.3.1 theme */
@import url(https://fonts.googleapis.com/css?family=Comfortaa:200,300,400,700);
$headings-font-family:Comfortaa;
/*$enable-grid-classes:false;*/
$primary:#FF550B;
$secondary:#303030;
$success:#015668;
$danger:#FF304F;
$info:#0F81C7;
$warning:#0DE2EA;
$light:#e8e8e8;
$dark:#000000;
/*! Import Bootstrap 4 variables */
@import "../../../node_modules/bootstrap/scss/functions";
@import "../../../node_modules/bootstrap/scss/variables";
$enable-shadows:true;
$gray-300:#000000;
$gray-800:#555555;
$body-bg:$black;
$body-color:#cccccc;
$link-color:#f0f0f0;
$link-hover-color:darken($link-color,20%);
$font-size-base:1.1rem;
$table-accent-bg: rgba($white,.05);
$table-hover-bg:rgba($white,.075);
$table-border-color:rgba($white, 0.3);
$table-dark-border-color: $table-border-color;
$table-dark-color:$white;
$input-bg:$gray-300;
$input-disabled-bg: #ccc;
$dropdown-bg:$gray-800;
$dropdown-divider-bg:rgba($black,.15);
$dropdown-link-color:$body-color;
$dropdown-link-hover-color:$white;
$dropdown-link-hover-bg:$body-bg;
$nav-tabs-border-color:rgba($white, 0.3);
$nav-tabs-link-hover-border-color:$nav-tabs-border-color;
$nav-tabs-link-active-bg:transparent;
$nav-tabs-link-active-border-color:$nav-tabs-border-color;
$navbar-dark-hover-color:$white;
$navbar-light-hover-color:$gray-800;
$navbar-light-active-color:$gray-800;
$pagination-color:$white;
$pagination-bg:transparent;
$pagination-border-color:rgba($black, 0.6);
$pagination-hover-color:$white;
$pagination-hover-bg:transparent;
$pagination-hover-border-color:rgba($black, 0.6);
$pagination-active-bg:transparent;
$pagination-active-border-color:rgba($black, 0.6);
$pagination-disabled-bg:transparent;
$pagination-disabled-border-color:rgba($black, 0.6);
$jumbotron-bg:darken($gray-900, 5%);
$card-border-color:rgba($black, 0.6);
$card-cap-bg:lighten($gray-800, 10%);
$card-bg:lighten($body-bg, 5%);
$modal-content-bg:lighten($body-bg,5%);
$modal-header-border-color:rgba(0,0,0,.2);
$progress-bg:darken($gray-900,5%);
$progress-bar-color:$gray-600;
$list-group-bg:lighten($body-bg,5%);
$list-group-border-color:rgba($black,0.6);
$list-group-hover-bg:lighten($body-bg,10%);
$list-group-active-color:$white;
$list-group-active-bg:$list-group-hover-bg;
$list-group-active-border-color:$list-group-border-color;
$list-group-disabled-color:$gray-800;
$list-group-disabled-bg:$black;
$list-group-action-color:$white;
$breadcrumb-active-color:$gray-500;
@import "../../../node_modules/bootstrap/scss/bootstrap";
// Add SASS theme customizations here..
@import "./common";
.navbar-dark.bg-primary {background-color:#111111 !important;}
.table.able {color:#ccccc5}
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/sass/bootstrap/default.sass 0000664 0000000 0000000 00000000712 14111104351 0031615 0 ustar 00root root 0000000 0000000 /* @import ../../../node_modules/bootstrap/scss/bootstrap
@import ../../../node_modules/bootstrap/scss/functions
@import ../../../node_modules/bootstrap/scss/variables
@import ../../../node_modules/bootstrap/scss/mixins
// Your variable overrides
$theme-colors: ("primary": $blue, "secondary": $black)
// Bootstrap and its default variables
@import ../../../node_modules/bootstrap/scss/bootstrap
// Add SASS theme customizations here..
@import ./_common
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/sass/bootstrap/greyson.scss 0000664 0000000 0000000 00000001437 14111104351 0031666 0 ustar 00root root 0000000 0000000 /*! Themestr.app `Greyson` Bootstrap 4.3.1 theme */
/* https://github.com/ThemesGuide/bootstrap-themes/blob/master/greyson/ */
@import url(https://fonts.googleapis.com/css?family=Muli:200,300,400,700);
$font-family-base:Muli;
@import url(https://fonts.googleapis.com/css?family=Oswald:200,300,400,700);
$headings-font-family:Oswald;
// $enable-grid-classes:false;
$primary:#2f3c48;
$secondary:#6f7f8c;
$success:#3e4d59;
$danger:#cc330d;
$info:#5c8f94;
$warning:#6e9fa5;
$light:#eceeec;
$dark:#1e2b37;
/*! Import Bootstrap 4 variables */
@import "../../../node_modules/bootstrap/scss/functions";
@import "../../../node_modules/bootstrap/scss/variables";
$enable-rounded:false;
@import "../../../node_modules/bootstrap/scss/bootstrap";
// Add SASS theme customizations here..
@import "./common";
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/sass/bootstrap/herbie.scss 0000664 0000000 0000000 00000001060 14111104351 0031426 0 ustar 00root root 0000000 0000000 /*! Themestr.app `Herbie` Bootstrap 4.3.1 theme */
@import url(https://fonts.googleapis.com/css?family=Nunito:200,300,400,700);
$font-family-base:Nunito;
@import url(https://fonts.googleapis.com/css?family=Crete+Round:200,300,400,700);
$headings-font-family:Crete Round;
/*$enable-grid-classes:false;*/
$primary:#083358;
$secondary:#F67280;
$success:#0074E4;
$danger:#FF4057;
$info:#74DBEF;
$warning:#FC3C3C;
$light:#F2F2F0;
$dark:#072247;
@import "../../../node_modules/bootstrap/scss/bootstrap";
// Add SASS theme customizations here..
@import "./common";
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/sass/bootstrap/monotony.scss 0000664 0000000 0000000 00000001433 14111104351 0032056 0 ustar 00root root 0000000 0000000 /*! Themestr.app `Monotony` Bootstrap 4.3.1 theme */
/* https://github.com/ThemesGuide/bootstrap-themes/blob/master/monotony/ */
@import url(https://fonts.googleapis.com/css?family=Montserrat:200,300,400,700);
$font-family-base:Montserrat;
@import url(https://fonts.googleapis.com/css?family=Open+Sans:200,300,400,700);
$headings-font-family:Open Sans;
// $enable-grid-classes:false;
$primary:#222222;
$secondary:#666666;
$success:#333333;
$danger:#434343;
$info:#515151;
$warning:#5f5f5f;
$light:#eceeec;
$dark:#111111;
/*! Import Bootstrap 4 variables */
@import "../../../node_modules/bootstrap/scss/functions";
@import "../../../node_modules/bootstrap/scss/variables";
@import "../../../node_modules/bootstrap/scss/bootstrap";
// Add SASS theme customizations here..
@import "./common";
purescript-gargantext-1450f95fd332af37a214c0f0a0fb123c88604dc3-src/src/sass/sass.sass 0000664 0000000 0000000 00000000334 14111104351 0027125 0 ustar 00root root 0000000 0000000 @use "_menu.sass"
@use "_context_menu.sass"
@use "_graph.sass"
@use "_login.sass"
@use "_tree.sass"
@use "_code_editor.sass"
@use "_styles.sass"
@use "_range_slider.sass"
@use "_annotation.sass"
@use "_folder_view.sass"