Commit 5fe07605 authored by James Laver's avatar James Laver

new toestand, kill warnings

parent b87af132
......@@ -4478,7 +4478,7 @@
"typelevel-prelude"
],
"repo": "https://github.com/poorscript/purescript-toestand",
"version": "v0.5.1"
"version": "v0.6.1"
},
"tolerant-argonaut": {
"dependencies": [
......@@ -5027,4 +5027,4 @@
"repo": "https://github.com/athanclark/purescript-zeta-extra.git",
"version": "v0.0.1"
}
}
}
\ No newline at end of file
......@@ -126,7 +126,7 @@ let additions =
[ "prelude", "effect", "foldable-traversable", "reactix"
, "record", "tuples", "typelevel-prelude" ]
, repo = "https://github.com/poorscript/purescript-toestand"
, version = "v0.5.1"
, version = "v0.6.1"
}
, typisch =
{ dependencies = [ "prelude" ]
......
......@@ -9,7 +9,7 @@ import Data.Array as A
import Data.Either (Either(..))
import Data.Map as Map
import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Data.Tuple (fst, snd)
import Data.Tuple (fst)
import Effect (Effect)
import Gargantext.Types as GT
import Gargantext.Utils as GU
......@@ -55,15 +55,15 @@ removeTaskFromList ts (GT.AsyncTaskWithType { task: GT.AsyncTask { id: id' } })
A.filter (\(GT.AsyncTaskWithType { task: GT.AsyncTask { id: id'' } }) -> id' /= id'') ts
type ReductorProps = (
reloadForest :: T.Cursor T2.Reload
, reloadRoot :: T.Cursor T2.Reload
reloadForest :: T.Box T2.Reload
, reloadRoot :: T.Box T2.Reload
, storage :: Storage
)
type Reductor = R2.Reductor (Record ReductorProps) Action
type ReductorAction = Action -> Effect Unit
useTasks :: T.Cursor T2.Reload -> T.Cursor T2.Reload -> R.Hooks Reductor
useTasks :: T.Box T2.Reload -> T.Box T2.Reload -> R.Hooks Reductor
useTasks reloadRoot reloadForest = R2.useReductor act initializer unit
where
act :: R2.Actor (Record ReductorProps) Action
......@@ -79,18 +79,18 @@ data Action =
action :: Record ReductorProps -> Action -> Effect (Record ReductorProps)
action p@{ reloadForest, storage } (Insert nodeId t) = do
_ <- GUR.bumpCursor reloadForest
_ <- GUR.bumpBox reloadForest
let newStorage = Map.alter (maybe (Just [t]) (\ts -> Just $ A.cons t ts)) nodeId storage
pure $ p { storage = newStorage }
action p (Finish nodeId t) = do
action p (Remove nodeId t)
action p@{ reloadRoot, reloadForest, storage } (Remove nodeId t@(GT.AsyncTaskWithType { typ })) = do
_ <- if GT.asyncTaskTriggersAppReload typ then
GUR.bumpCursor reloadRoot
GUR.bumpBox reloadRoot
else
pure unit
_ <- if GT.asyncTaskTriggersTreeReload typ then
GUR.bumpCursor reloadForest
GUR.bumpBox reloadForest
else
pure unit
let newStorage = Map.alter (maybe Nothing $ (\ts -> Just $ removeTaskFromList ts t)) nodeId storage
......
......@@ -11,22 +11,22 @@
-- | 2. We will need a more ambitious search algorithm for skipgrams.
module Gargantext.Components.Annotation.AnnotatedField where
import Data.Maybe ( Maybe(..), maybe )
import Data.Tuple ( Tuple )
import Data.Tuple.Nested ( (/\) )
import Gargantext.Prelude (Unit, bind, const, discard, not, pure, ($), (<$>), (<>))
import Data.Maybe (Maybe(..), maybe)
import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\))
--import DOM.Simple.Console (log2)
import DOM.Simple.Event as DE
import Effect ( Effect )
import Effect (Effect)
import Reactix as R
import Reactix.DOM.HTML as HTML
import Reactix.SyntheticEvent as E
import Gargantext.Prelude
import Gargantext.Types (CTabNgramType(..), TermList)
import Gargantext.Components.Annotation.Utils ( termBootstrapClass, termClass )
import Gargantext.Components.Annotation.Utils (termClass)
import Gargantext.Components.NgramsTable.Core
import Gargantext.Components.Annotation.Menu ( annotationMenu, MenuType(..) )
( NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams, normNgram )
import Gargantext.Components.Annotation.Menu (annotationMenu, MenuType(..))
import Gargantext.Utils.Selection as Sel
import Gargantext.Utils.Reactix as R2
......
......@@ -9,9 +9,7 @@ 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
import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.App"
......@@ -22,9 +20,8 @@ app = R.createElement appCpt
appCpt :: R.Component ()
appCpt = here.component "app" cpt where
cpt _ _ = do
cell <- T.useCell emptyApp -- global data
cursors <- T.useFieldCursors cell {} -- read-write access for children
-- tasks <- R.useRef Nothing -- storage for asynchronous tasks
tasks <- T2.useCursed Nothing -- storage for asynchronous tasks
useHashRouter Router.router cursors.route -- Install router to window
pure $ router { cursors, tasks } -- Render router component
box <- T.useBox emptyApp -- global data
boxes <- T.useFocusedFields box {} -- read-write access for children
tasks <- T.useBox Nothing -- storage for asynchronous tasks
useHashRouter Router.router boxes.route -- Install router to window
pure $ router { boxes, tasks } -- Render router component
module Gargantext.Components.App.Data (App, Cursors, emptyApp) where
module Gargantext.Components.App.Data (App, Boxes, emptyApp) where
import Data.Set as Set
import Data.Maybe (Maybe(..))
......@@ -36,15 +36,15 @@ emptyApp =
, showLogin: false
}
type Cursors =
{ backend :: T.Cursor (Maybe Backend)
, handed :: T.Cursor Handed
, forestOpen :: T.Cursor OpenNodes
, reloadRoot :: T.Cursor T2.Reload
, reloadForest :: T.Cursor T2.Reload
, route :: T.Cursor AppRoute
, sessions :: T.Cursor Sessions
, showCorpus :: T.Cursor Boolean
, showLogin :: T.Cursor Boolean
type Boxes =
{ backend :: T.Box (Maybe Backend)
, handed :: T.Box Handed
, forestOpen :: T.Box OpenNodes
, reloadRoot :: T.Box T2.Reload
, reloadForest :: T.Box T2.Reload
, route :: T.Box AppRoute
, sessions :: T.Box Sessions
, showCorpus :: T.Box Boolean
, showLogin :: T.Box Boolean
}
-- TODO: this module should be replaced by FacetsTable
module Gargantext.Components.Category where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>), encodeJson)
import Gargantext.Prelude (discard, map, pure, void, ($), (-), (<), (<>), (==))
import Data.Argonaut (class EncodeJson, encodeJson, jsonEmptyObject, (:=), (~>))
import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.Lens ((^.))
import Data.Lens.At (at)
import Data.Lens.Record (prop)
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe, isJust)
import Data.Ord.Down (Down(..))
import Data.Set (Set)
import Data.Set as Set
import Data.String as Str
import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..), fst)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Event as DE
import Effect (Effect)
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.Category.Types
import Gargantext.Components.DocsTable.Types (DocumentsView(..), LocalCategories, LocalUserScore)
import Gargantext.Ends (Frontends, url)
import Gargantext.Hooks.Loader (useLoaderWithCacheAPI, HashedResponse(..))
( Category(..), Star(..), cat2score, categories, star2score, stars )
import Gargantext.Components.DocsTable.Types
( DocumentsView(..), LocalCategories, LocalUserScore )
import Gargantext.Utils.Reactix as R2
import Gargantext.Routes as Routes
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, sessionId, get, delete, put)
import Gargantext.Types (NodeID, NodeType(..), OrderBy(..), TableResult, TabType, showTabType')
import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Sessions (Session, put)
import Gargantext.Types (NodeID, NodeType(..))
here :: R2.Here
here = R2.here "Gargantext.Components.Category"
------------------------------------------------------------------------
type RatingProps =
( score :: Star
, nodeId :: NodeID
......@@ -55,31 +33,20 @@ rating :: R2.Component RatingProps
rating = R.createElement ratingCpt
ratingCpt :: R.Component RatingProps
ratingCpt = here.component "rating" cpt
where
cpt { score, nodeId, row: DocumentsView r, session, setLocalCategories } _ = do
pure $ H.div {className:"flex"} divs
where
divs = map (\s -> H.div { className : icon score s
, on: {click: onClick score 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 score c = \_-> do
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
}
ratingCpt = here.component "rating" cpt where
cpt { score, nodeId, row: DocumentsView r, 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
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 }
instance encodeJsonRatingQuery :: EncodeJson RatingQuery where
encodeJson (RatingQuery post) =
......@@ -88,14 +55,9 @@ instance encodeJsonRatingQuery :: EncodeJson RatingQuery where
~> jsonEmptyObject
putRating :: Session -> Int -> RatingQuery -> Aff (Array Int)
putRating session nodeId = put session $ ratingRoute nodeId
where
ratingRoute :: Int -> SessionRoute
ratingRoute nodeId = NodeAPI Node (Just nodeId) "category"
putRating session nodeId = put session $ ratingRoute where
ratingRoute = NodeAPI Node (Just nodeId) "category"
------------------------------------------------------------------------
type CarousselProps =
( category :: Category
, nodeId :: NodeID
......@@ -104,7 +66,6 @@ type CarousselProps =
, setLocalCategories :: R.Setter LocalCategories
)
caroussel :: R2.Component CarousselProps
caroussel = R.createElement carousselCpt
......
-- TODO: this module should be replaced by FacetsTable
module Gargantext.Components.DocsTable where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Gargantext.Prelude
( class Ord, Unit, bind, const, discard, identity, mempty
, otherwise, pure, show, unit, ($), (/=), (<$>), (<<<), (<>), (==) )
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
import Data.Array as A
import Data.Lens ((^.))
import Data.Lens.At (at)
import Data.Lens.Record (prop)
import Data.Map (Map)
import Data.Maybe (Maybe(..), fromMaybe, isJust, maybe)
import Data.Ord.Down (Down(..))
import Data.Set (Set)
......@@ -15,19 +17,18 @@ import Data.String as Str
import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..), fst)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log, log2)
import DOM.Simple.Console (log2)
import DOM.Simple.Event as DE
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.Category (caroussel, rating)
import Gargantext.Components.Category.Types (Category(..), decodeCategory, Star(..), decodeStar)
import Gargantext.Components.Category (rating)
import Gargantext.Components.Category.Types (Star(..))
import Gargantext.Components.DocsTable.Types
( DocumentsView(..), Hyperdata(..), LocalUserScore, Query, Response(..), sampleData )
import Gargantext.Components.Table.Types as T
import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Nodes.Texts.Types (SidePanelTriggers)
......@@ -43,11 +44,9 @@ import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.QueryString (joinQueryStrings, mQueryParamS, queryParam, queryParamS)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reload as GUR
import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.DocsTable"
------------------------------------------------------------------------
type TotalRecords = Int
......
......@@ -3,9 +3,10 @@
-- has not been ported to this module yet.
module Gargantext.Components.FacetsTable where
------------------------------------------------------------------------
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Array (concat, filter)
import Prelude
( class Show, Unit, bind, const, discard, identity, mempty, not
, otherwise, pure, unit, void, ($), (*>), (<$>), (<<<), (<>), (==), (>) )
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..), fromMaybe)
......@@ -13,19 +14,20 @@ import Data.Sequence (Seq)
import Data.Sequence as Seq
import Data.Set (Set)
import Data.Set as Set
import Data.String (Pattern(..), split)
import Data.String as String
import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Prelude
import Reactix as R
import Reactix.DOM.HTML as H
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.Ends (url, Frontends)
......@@ -35,11 +37,10 @@ import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, sessionId, post, deleteWithBody)
import Gargantext.Types (NodeType(..), OrderBy(..), NodePath(..), NodeID)
import Gargantext.Utils (toggleSet, zeroPad)
import Gargantext.Utils.DecodeMaybe ((.|))
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.FacetsTable"
------------------------------------------------------------------------
type Props =
( chart :: R.Element
......@@ -360,7 +361,7 @@ pageCpt = here.component "page" cpt
}
where
markClick _ = markCategory session nodeId Favorite [id]
contactUrl aId id = url frontends $ Routes.ContactPage (sessionId session) annuaireId id
contactUrl aId id' = url frontends $ Routes.ContactPage (sessionId session) annuaireId id'
docRow dv@(DocumentsView {id, score, title, source, authors, pairs, delete, category}) =
{ row:
......
module Gargantext.Components.Footer where
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Prelude
import Gargantext.Sessions as Sessions
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Footer"
......
......@@ -35,26 +35,26 @@ here = R2.here "Gargantext.Components.Forest"
-- Shared by components here with Tree
type Common =
( frontends :: Frontends
, handed :: T.Cursor Handed
, reloadRoot :: T.Cursor T2.Reload
, route :: T.Cursor AppRoute
, tasks :: T.Cursor (Maybe GAT.Reductor)
, handed :: T.Box Handed
, reloadRoot :: T.Box T2.Reload
, route :: T.Box AppRoute
, tasks :: T.Box (Maybe GAT.Reductor)
)
type LayoutProps =
( backend :: T.Cursor (Maybe Backend)
, reloadForest :: T.Cursor T2.Reload
, sessions :: T.Cursor Sessions
, showLogin :: T.Cursor Boolean
( backend :: T.Box (Maybe Backend)
, reloadForest :: T.Box T2.Reload
, sessions :: T.Box Sessions
, showLogin :: T.Box Boolean
| Common
)
type Props = (
forestOpen :: T.Cursor OpenNodes
forestOpen :: T.Box OpenNodes
| LayoutProps )
type TreeExtra = (
forestOpen :: T.Cursor OpenNodes
forestOpen :: T.Box OpenNodes
, session :: Session
)
......@@ -74,7 +74,7 @@ forestCpt = here.component "forest" cpt where
, showLogin
, tasks } _ = do
tasks' <- GAT.useTasks reloadRoot reloadForest
R.useEffect' $ T2.write_ (Just tasks') tasks
R.useEffect' $ T.write_ (Just tasks') tasks
handed' <- T.useLive T.unequal handed
reloadForest' <- T.useLive T.unequal reloadForest
reloadRoot' <- T.useLive T.unequal reloadRoot
......@@ -107,7 +107,7 @@ forestCpt = here.component "forest" cpt where
, session: s
, tasks } []
plus :: Handed -> T.Cursor Boolean -> T.Cursor (Maybe Backend) -> R.Element
plus :: Handed -> T.Box Boolean -> T.Box (Maybe Backend) -> R.Element
plus handed showLogin backend = H.div { className: "row" }
[ H.button { className: buttonClass
, on: { click }
......@@ -122,7 +122,7 @@ plus handed showLogin backend = H.div { className: "row" }
where
click _ = do
-- _ <- T.write Nothing backend
T2.write_ true showLogin
T.write_ true showLogin
title = "Add or remove connections to the server(s)."
divClass = "fa fa-universal-access"
buttonClass =
......@@ -174,7 +174,7 @@ forestLayoutRawCpt = here.component "forestLayoutRaw" cpt where
, showLogin
, tasks } children = do
handed' <- T.useLive T.unequal p.handed
forestOpen <- T2.useCursed $ Set.empty
forestOpen <- T.useBox $ Set.empty
pure $ R2.row $ reverseHanded
[ H.div { className: "col-md-2"
......
......@@ -16,7 +16,6 @@ import Reactix.DOM.HTML as H
import Record as Record
import Record.Extra as RecordE
import Toestand as T
import Web.HTML.Event.EventTypes (offline)
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest.Tree.Node (nodeSpan)
......@@ -48,20 +47,20 @@ here = R2.here "Gargantext.Components.Forest.Tree"
-- Shared by every component here + performAction + nodeSpan
type Universal =
( reloadRoot :: T.Cursor T2.Reload
, tasks :: T.Cursor (Maybe GAT.Reductor) )
( reloadRoot :: T.Box T2.Reload
, tasks :: T.Box (Maybe GAT.Reductor) )
-- Shared by every component here + nodeSpan
type Global =
( frontends :: Frontends
, handed :: Handed
, route :: T.Cursor AppRoute
, route :: T.Box AppRoute
| Universal )
-- Shared by every component here
type Common = (
forestOpen :: T.Cursor OpenNodes
, reload :: T.Cursor T2.Reload
forestOpen :: T.Box OpenNodes
, reload :: T.Box T2.Reload
| Global
)
......@@ -89,7 +88,7 @@ getNodeTree session nodeId = get session $ GR.NodeAPI GT.Tree (Just nodeId) ""
getNodeTreeFirstLevel :: Session -> ID -> Aff FTree
getNodeTreeFirstLevel session nodeId = get session $ GR.TreeFirstLevel (Just nodeId) ""
type NodeProps = ( reloadTree :: T.Cursor T2.Reload, session :: Session | Common )
type NodeProps = ( reloadTree :: T.Box T2.Reload, session :: Session | Common )
type TreeProps = ( tree :: FTree | NodeProps )
......@@ -100,7 +99,7 @@ treeCpt :: R.Component TreeProps
treeCpt = here.component "tree" cpt where
cpt p@{ session, tree: NTree (LNode { id, name, nodeType }) children } _ = do
setPopoverRef <- R.useRef Nothing
folderOpen <- T2.useMemberCursor nodeId p.forestOpen
folderOpen <- T2.useMemberBox nodeId p.forestOpen
open <- T.useLive T.unequal folderOpen
pure $ H.ul { className: ulClass }
[ H.div { className: divClass } -- TODO: naughty div should not be in a ul
......@@ -131,8 +130,8 @@ treeCpt = here.component "tree" cpt where
--- The properties tree shares in common with performAction
type PACommon =
( forestOpen :: T.Cursor OpenNodes
, reloadTree :: T.Cursor T2.Reload
( forestOpen :: T.Box OpenNodes
, reloadTree :: T.Box T2.Reload
, session :: Session
, tree :: FTree
| Universal )
......@@ -151,7 +150,7 @@ childLoader = R.createElement childLoaderCpt
childLoaderCpt :: R.Component ChildLoaderProps
childLoaderCpt = here.component "childLoader" cpt where
cpt p@{ render } _ = do
reload <- T2.useCursed T2.newReload
reload <- T.useBox T2.newReload
let reloads = [ reload, p.reloadTree, p.reloadRoot ]
cache <- (A.cons p.id) <$> traverse (T.useLive T.unequal) reloads
useLoader cache fetch (paint reload)
......@@ -175,7 +174,7 @@ performAction (DeleteNode nt) p@{ forestOpen
GT.NodePublic GT.FolderPublic -> void $ deleteNode session nt id
GT.NodePublic _ -> void $ unpublishNode session parent_id id
_ -> void $ deleteNode session nt id
liftEffect $ T2.modify_ (Set.delete (mkNodeId session id)) forestOpen
liftEffect $ T.modify_ (Set.delete (mkNodeId session id)) forestOpen
performAction RefreshTree p
performAction (DoSearch task) p@{ tasks
, tree: (NTree (LNode {id}) _) } = liftEffect $ do
......@@ -201,14 +200,14 @@ performAction (ShareTeam username) p@{ tree: (NTree (LNode {id}) _)} =
performAction (SharePublic { params }) p@{ forestOpen } = traverse_ f params where
f (SubTreeOut { in: inId, out }) = do
void $ Share.shareReq p.session inId $ Share.SharePublicParams { node_id: out }
liftEffect $ T2.modify_ (Set.insert (mkNodeId p.session out)) forestOpen
liftEffect $ T.modify_ (Set.insert (mkNodeId p.session out)) forestOpen
performAction RefreshTree p
performAction (AddContact params) p@{ tree: (NTree (LNode {id}) _) } =
void $ Contact.contactReq p.session id params
performAction (AddNode name nodeType) p@{ forestOpen
, tree: (NTree (LNode { id }) _) } = do
task <- addNode p.session id $ AddNodeValue {name, nodeType}
liftEffect $ T2.modify_ (Set.insert (mkNodeId p.session id)) forestOpen
liftEffect $ T.modify_ (Set.insert (mkNodeId p.session id)) forestOpen
performAction RefreshTree p
performAction (UploadFile nodeType fileType mName blob) p@{ tasks
, tree: (NTree (LNode { id }) _) } = do
......@@ -233,7 +232,7 @@ performAction (MoveNode {params}) p@{ forestOpen
, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
void $ moveNodeReq p.session in' out
liftEffect $ T2.modify_ (Set.insert (mkNodeId session out)) forestOpen
liftEffect $ T.modify_ (Set.insert (mkNodeId session out)) forestOpen
performAction RefreshTree p
performAction (MergeNode { params }) p = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
......
......@@ -2,7 +2,6 @@ module Gargantext.Components.Forest.Tree.Node where
import Gargantext.Prelude
import Data.Array (reverse)
import Data.Maybe (Maybe(..))
import Data.Nullable (null)
import Data.Symbol (SProxy(..))
......@@ -16,7 +15,6 @@ import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
import Web.HTML.Event.EventTypes (offline)
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
......@@ -47,16 +45,16 @@ here = R2.here "Gargantext.Components.Forest.Tree.Node"
-- Main Node
type NodeMainSpanProps =
( folderOpen :: T.Cursor Boolean
( folderOpen :: T.Box Boolean
, frontends :: Frontends
, id :: ID
, isLeaf :: IsLeaf
, name :: Name
, nodeType :: GT.NodeType
, reloadRoot :: T.Cursor T2.Reload
, route :: T.Cursor Routes.AppRoute
, reloadRoot :: T.Box T2.Reload
, route :: T.Box Routes.AppRoute
, setPopoverRef :: R.Ref (Maybe (Boolean -> Effect Unit))
, tasks :: T.Cursor (Maybe GAT.Reductor)
, tasks :: T.Box (Maybe GAT.Reductor)
| CommonProps
)
......@@ -103,7 +101,7 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
tasks' <- T.read tasks
pure $ H.span (dropProps droppedFile isDragOver)
$ GT.reverseHanded
$ reverseHanded
[ folderIcon { folderOpen, nodeType } []
, chevronIcon { folderOpen, handed, isLeaf, nodeType } []
, nodeLink { frontends, handed, folderOpen, id, isSelected
......@@ -140,27 +138,21 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
} []
] handed
where
onTaskFinish id t _ = do
onTaskFinish id' t _ = do
mT <- T.read tasks
case mT of
Just t' -> snd t' $ GAT.Finish id t
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, nodeType} = if nodeType == GT.NodeUser then show session else name
name' {name: n, nodeType: nt} = if nt == GT.NodeUser then show session else n
mNodePopupView props@{id, nodeType} onPopoverClose =
nodePopupView { dispatch
, handed : props.handed
, id
, name: name' props
, nodeType
, onPopoverClose
, session
}
mNodePopupView props'@{ id: i, nodeType: nt, handed: h } opc =
nodePopupView { dispatch, handed: h, id: i, name: name' props'
, nodeType: nt, onPopoverClose: opc, session }
popOverIcon =
H.a { className: "settings fa fa-cog"
......@@ -199,7 +191,7 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
onDragLeave (_ /\ setIsDragOver) _ = setIsDragOver $ const false
type FolderIconProps = (
folderOpen :: T.Cursor Boolean
folderOpen :: T.Box Boolean
, nodeType :: GT.NodeType
)
......@@ -211,11 +203,11 @@ folderIconCpt = here.component "folderIcon" cpt
where
cpt { folderOpen, nodeType } _ = do
open <- T.read folderOpen
pure $ H.a { className: "folder-icon", on: { click: \_ -> T2.modify_ not folderOpen } }
pure $ H.a { className: "folder-icon", on: { click: \_ -> T.modify_ not folderOpen } }
[ H.i { className: GT.fldr nodeType open } [] ]
type ChevronIconProps = (
folderOpen :: T.Cursor Boolean
folderOpen :: T.Box Boolean
, handed :: GT.Handed
, isLeaf :: Boolean
, nodeType :: GT.NodeType
......@@ -232,7 +224,7 @@ chevronIconCpt = here.component "chevronIcon" cpt
cpt { folderOpen, handed, isLeaf: false, nodeType } _ = do
open <- T.read folderOpen
pure $ H.a { className: "chevron-icon"
, on: { click: \_ -> T2.modify_ not folderOpen }
, on: { click: \_ -> T.modify_ not folderOpen }
}
[ H.i { className: if open
then "fa fa-chevron-down"
......
......@@ -20,9 +20,9 @@ import Gargantext.Types as GT
import Gargantext.Types (NodeType(..))
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Add"
----------------------------------------------------------------------
addNode :: Session -> GT.ID -> AddNodeValue -> Aff (Array GT.ID)
addNode session parentId = post session $ GR.NodeAPI GT.Node (Just parentId) ""
......@@ -33,8 +33,7 @@ addNodeAsync :: Session
addNodeAsync session parentId q = do
task <- post session p q
pure $ GT.AsyncTaskWithType {task, typ: GT.AddNode}
where
p = GR.NodeAPI GT.Node (Just parentId) (GT.asyncTaskTypePath GT.AddNode)
where p = GR.NodeAPI GT.Node (Just parentId) (GT.asyncTaskTypePath GT.AddNode)
----------------------------------------------------------------------
-- TODO AddNodeParams
......
......@@ -2,9 +2,7 @@ module Gargantext.Components.Forest.Tree.Node.Action.Contact where
import Prelude
import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff)
import Effect.Uncurried (mkEffectFn1)
import Formula as F
import Reactix as R
import Reactix.DOM.HTML as H
......@@ -13,13 +11,11 @@ import Toestand as T
import Gargantext.Components.Forest.Tree.Node.Action (Action)
import Gargantext.Components.Forest.Tree.Node.Action.Contact.Types (AddContactParams(..))
-- import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTreeParamsIn)
import Gargantext.Prelude (Unit, bind, const, discard, pure, (<<<), (<>))
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
import Gargantext.Types (ID)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Contact"
......@@ -32,7 +28,7 @@ type TextInputBoxProps =
( id :: ID
, dispatch :: Action -> Aff Unit
, params :: Record AddContactProps
, isOpen :: T.Cursor Boolean
, isOpen :: T.Box Boolean
, boxName :: String
, boxAction :: AddContactParams -> Action
)
......@@ -47,7 +43,7 @@ textInputBoxCpt = here.component "textInputBox" cpt where
cpt p@{ boxName, boxAction, dispatch, isOpen
, params: { firstname, lastname } } _ =
content <$> T.useLive T.unequal isOpen
<*> T.useCell firstname <*> T.useCell lastname
<*> T.useBox firstname <*> T.useBox lastname
where
content false _ _ = H.div {} []
content true firstName lastName =
......@@ -68,14 +64,14 @@ textInputBoxCpt = here.component "textInputBox" cpt where
, type: "button", on: { click }, title:"Submit"
} [] where
click _ = do
firstname <- T.read first
lastname <- T.read last
T2.write_ false isOpen
f <- T.read first
l <- T.read last
T.write_ false isOpen
launchAff $
dispatch (boxAction $ AddContactParams { firstname, lastname })
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 _ = T2.write_ false isOpen
click _ = T.write_ false isOpen
module Gargantext.Components.Forest.Tree.Node.Action.Contact.Types where
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Prelude (($))
import Reactix as R
import Gargantext.Types as GT
import Gargantext.Types (ID)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, post)
import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Gargantext.Prelude
import Gargantext.Sessions (Session, put_)
import Gargantext.Types as GT
import Reactix as R
import Reactix.DOM.HTML as H
import Data.Argonaut as Argonaut
import Gargantext.Prelude (class Eq, class Show)
import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson)
import Data.Argonaut (class DecodeJson, class EncodeJson)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson, genericEnumDecodeJson, genericEnumEncodeJson)
import Data.Maybe (Maybe(..))
import Gargantext.Prelude (class Eq, class Read, class Show)
------------------------------------------------------------------------
data AddContactParams =
AddContactParams { firstname :: String
, lastname :: String
}
AddContactParams { firstname :: String, lastname :: String }
derive instance eqAddContactParams :: Eq AddContactParams
......@@ -38,10 +16,8 @@ derive instance genericAddContactParams :: Generic AddContactParams _
instance showAddContactParams :: Show AddContactParams where
show = genericShow
instance decodeJsonAddContactParams :: Argonaut.DecodeJson AddContactParams where
instance decodeJsonAddContactParams :: DecodeJson AddContactParams where
decodeJson = genericSumDecodeJson
instance encodeJsonAddContactParams :: Argonaut.EncodeJson AddContactParams where
instance encodeJsonAddContactParams :: EncodeJson AddContactParams where
encodeJson = genericSumEncodeJson
------------------------------------------------------------------------
......@@ -15,18 +15,14 @@ import Gargantext.Components.Forest.Tree.Node.Tools.SubTree (subTreeView, SubTre
import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, post)
import Gargantext.Routes as GR
import Gargantext.Types as GT
import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson)
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Action.Link"
data LinkNodeReq = LinkNodeReq { nodeType :: GT.NodeType
, id :: GT.ID
}
data LinkNodeReq = LinkNodeReq { nodeType :: GT.NodeType, id :: GT.ID }
derive instance eqLinkNodeReq :: Eq LinkNodeReq
derive instance genericLinkNodeReq :: Generic LinkNodeReq _
......@@ -41,13 +37,8 @@ instance encodeJsonLinkNodeReq :: Argonaut.EncodeJson LinkNodeReq where
linkNodeReq :: Session -> Maybe GT.NodeType -> GT.ID -> GT.ID -> Aff GT.AsyncTaskWithType
linkNodeReq session nt fromId toId = do
task <- post session (NodeAPI GT.Node (Just fromId) "update")
(LinkNodeReq { nodeType: linkNodeType nt
, id: toId
}
)
(LinkNodeReq { nodeType: linkNodeType nt, id: toId })
pure $ GT.AsyncTaskWithType {task, typ: GT.UpdateNode }
where
p = GR.NodeAPI GT.Node (Just fromId) "update"
linkNodeType :: Maybe GT.NodeType -> GT.NodeType
linkNodeType (Just GT.Corpus) = GT.Annuaire
......
......@@ -16,6 +16,7 @@ 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 (Array GT.ID)
......
......@@ -3,7 +3,6 @@ module Gargantext.Components.Forest.Tree.Node.Action.Search where
import Data.Maybe (Maybe)
import Effect (Effect)
import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect)
import Reactix as R
import Reactix.DOM.HTML as H
......
module Gargantext.Components.Forest.Tree.Node.Action.Search.Frame where
import Gargantext.Prelude (discard, identity, pure, unit, ($), (<>), (==), class Show)
import DOM.Simple as DOM
import DOM.Simple.Event (MessageEvent)
import DOM.Simple.EventListener (Callback, addEventListener, callback)
......@@ -8,7 +9,6 @@ import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable)
import Data.String (toLower)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Reactix as R
......@@ -16,10 +16,11 @@ import Reactix.DOM.HTML as H
import URI.Extra.QueryPairs as NQP
import URI.Query as Query
import Gargantext.Components.Forest.Tree.Node.Action.Search.Types (DataField(..), Search, isIsTex_Advanced)
import Gargantext.Prelude (discard, identity, pure, unit, ($), (<>), (==), class Show, show)
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"
--------------------
......
......@@ -14,7 +14,6 @@ import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Tools (panel)
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)
......@@ -405,11 +404,11 @@ triggerSearch :: (GT.AsyncTaskWithType -> Effect Unit)
triggerSearch os 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)
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"
......
......@@ -9,9 +9,8 @@ import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (Aff, launchAff, throwError)
import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Partial.Unsafe (unsafePartial)
import React.SyntheticEvent as E
import Reactix as R
......@@ -32,6 +31,7 @@ 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.Upload"
-- UploadFile Action
......
......@@ -33,7 +33,6 @@ import Gargantext.Types (Name, ID)
import Gargantext.Types as GT
import Gargantext.Utils (glyphicon, glyphiconActive)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Box"
......@@ -46,10 +45,10 @@ nodePopupView p = R.createElement nodePopupCpt p []
nodePopupCpt :: R.Component NodePopupProps
nodePopupCpt = here.component "nodePopupView" cpt where
cpt p@{ id, name, nodeType } _ = do
renameIsOpen <- T.useCell false >>= T2.useIdentityCursor
renameIsOpen <- T.useBox false
open <- T.useLive T.unequal renameIsOpen
nodePopup <- T.useCell { action: Nothing, id, name, nodeType }
action <- T.useCursor (_.action) (\a b -> b { action = a }) nodePopup
nodePopup <- T.useBox { action: Nothing, id, name, nodeType }
action <- T.useFocused (_.action) (\a b -> b { action = a }) nodePopup
nodePopup' <- T.useLive T.unequal nodePopup
search <- R.useState' $ defaultSearch { node_id = Just p.id }
pure $ H.div tooltipProps
......@@ -81,8 +80,8 @@ nodePopupCpt = here.component "nodePopupView" cpt where
editIcon _ true = H.div {} []
editIcon isOpen false =
H.a { className: glyphicon "pencil", id: "rename1"
, title : "Rename", on: { click: \_ -> T2.write_ true isOpen } } []
panelBody :: T.Cursor (Maybe NodeAction) -> Record NodePopupProps -> R.Element
, 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"}
......@@ -121,7 +120,7 @@ type ActionState =
type ButtonClickProps =
( action :: NodeAction
, state :: T.Cursor (Maybe NodeAction)
, state :: T.Box (Maybe NodeAction)
, nodeType :: GT.NodeType
)
......@@ -134,7 +133,7 @@ buttonClickCpt = here.component "buttonClick" cpt where
action <- T.useLive T.unequal state
let className = glyphiconActive (glyphiconNodeAction todo) (action == (Just todo))
let style = iconAStyle nodeType todo
let click _ = T2.write_ (if action == Just todo then Nothing else Just todo) state
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
......@@ -188,14 +187,14 @@ panelActionCpt = here.component "panelAction" cpt
cpt {action: Link {subTreeParams}, dispatch, id, nodeType, session, handed} _ =
pure $ linkNode {dispatch, id, nodeType, session, subTreeParams, handed} []
cpt {action : Share, dispatch, id, name } _ = do
isOpen <- T.useCell true >>= T.useCursor identity (\a _ -> a)
isOpen <- T.useBox true >>= T.useFocused identity (\a _ -> a)
pure $ panel
[ textInputBox
{ boxAction: Share.shareAction, boxName: "Share"
, dispatch, id, text: "username", isOpen } []
] (H.div {} [])
cpt {action : AddingContact, dispatch, id, name } _ = do
isOpen <- T.useCell true >>= T.useCursor identity (\a _ -> a)
isOpen <- T.useBox true >>= T.useFocused identity (\a _ -> a)
pure $ Contact.textInputBox
{ id, dispatch, isOpen, boxName:"addContact"
, params : {firstname:"First Name", lastname: "Last Name"}
......
......@@ -2,7 +2,7 @@ module Gargantext.Components.Forest.Tree.Node.Tools where
import Gargantext.Prelude
( class Ord, class Read, class Show, Unit
, bind, const, discard, map, not, pure, read, show, when, void
, bind, const, discard, map, not, pure, read, show, when
, ($), (<), (<<<), (<>), (<$>), (<*>) )
import Data.Maybe (fromMaybe, Maybe(..))
import Data.Nullable (null)
......@@ -26,7 +26,6 @@ import Gargantext.Types as GT
import Gargantext.Utils (glyphicon, toggleSet)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.ReactTooltip as ReactTooltip
import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.Forest.Tree.Node.Tools"
......@@ -53,7 +52,7 @@ type TextInputBoxProps =
( id :: ID
, dispatch :: Action -> Aff Unit
, text :: String
, isOpen :: T.Cursor Boolean
, isOpen :: T.Box Boolean
, boxName :: String
, boxAction :: String -> Action
)
......@@ -82,8 +81,8 @@ textInputBoxCpt = here.component "textInputBox" cpt where
, className: "text-danger col-2 " <> glyphicon "times" } [] ]
submit ref _ = do
launchAff_ $ dispatch (boxAction $ R.readRef ref)
T2.write_ false isOpen
click _ = T2.write_ false isOpen
T.write_ false isOpen
click _ = T.write_ false isOpen
type DefaultText = String
......@@ -195,7 +194,7 @@ prettyNodeType
type NodeLinkProps = (
frontends :: Frontends
, id :: Int
, folderOpen :: T.Cursor Boolean
, folderOpen :: T.Box Boolean
, isSelected :: Boolean
, name :: Name
, nodeType :: GT.NodeType
......@@ -224,7 +223,7 @@ nodeLinkCpt = here.component "nodeLink" cpt where
-- NOTE Don't toggle tree if it is not selected
-- click on closed -> open
-- click on open -> ?
click _ = when (not isSelected) (T2.write_ true folderOpen)
click _ = when (not isSelected) (T.write_ true folderOpen)
tooltipId = "node-link-" <> show id
href = url frontends $ GT.NodePath (sessionId session) nodeType (Just id)
......
......@@ -102,66 +102,31 @@ subTreeTreeView :: Record CorpusTreeProps -> R.Element
subTreeTreeView props = R.createElement subTreeTreeViewCpt props []
subTreeTreeViewCpt :: R.Component CorpusTreeProps
subTreeTreeViewCpt = here.component "subTreeTreeViewCpt" cpt
where
cpt p@{ id
, tree: NTree (LNode { id: targetId
, name
, nodeType
}
) ary
, subTreeParams
, dispatch
, action
, handed
} _ = do
let ordering =
case handed of
GT.LeftHanded -> A.reverse
GT.RightHanded -> identity
pure $ H.div {} $ ordering [
H.div { className: nodeClass validNodeType } [
H.span { className: "text"
, on: { click: onClick }
} [
nodeText { isSelected: isSelected targetId valAction
, name: " " <> name
, handed
}
, 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
children = map (\ctree -> subTreeTreeView (p { tree = ctree })) sortedAry
validNodeType = (A.elem nodeType valitypes) && (id /= targetId)
clickable = if validNodeType then "clickable" else ""
(valAction /\ setAction) = action
isSelected n action' = case (subTreeOut action') of
Nothing -> false
(Just (SubTreeOut {out})) -> n == out
onClick e = do
let action = if not validNodeType then Nothing else Just $ SubTreeOut { in: id, out: targetId }
E.preventDefault e
E.stopPropagation e
setAction $ const $ setTreeOut valAction action
--------------------------------------------------------------------------------------------
subTreeTreeViewCpt = here.component "subTreeTreeViewCpt" cpt where
cpt p@{ tree: NTree (LNode { id: targetId, name, nodeType }) ary
, id, subTreeParams, dispatch, action, handed } _ =
pure $ H.div {} $ GT.reverseHanded
[ H.div { className: nodeClass validNodeType }
[ H.span { className: "text", on: { click } }
[ nodeText { isSelected: isSelected targetId valAction
, name: " " <> name, handed }
, H.span { className: "children" } children ]]]
handed
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
children = map (\ctree -> subTreeTreeView (p { tree = ctree })) sortedAry
validNodeType = (A.elem nodeType valitypes) && (id /= targetId)
clickable = if validNodeType then "clickable" else ""
(valAction /\ setAction) = action
isSelected n action' = case (subTreeOut action') of
Nothing -> false
(Just (SubTreeOut {out})) -> n == out
click e = do
let action' = if not validNodeType then Nothing else Just $ SubTreeOut { in: id, out: targetId }
E.preventDefault e
E.stopPropagation e
setAction $ const $ setTreeOut valAction action'
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(..))
......@@ -9,12 +11,11 @@ import Reactix.DOM.HTML as H
import Reactix as R
import Gargantext.Components.GraphExplorer.API as GraphAPI
import Gargantext.Components.NgramsTable.API as NTAPI
import Gargantext.Prelude (Unit, bind, const, discard, pure, unit, ($), (<>), (==))
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"
......
......@@ -11,7 +11,6 @@ import Data.Maybe (Maybe(..))
import Data.Nullable (Nullable)
import DOM.Simple.Console (log, log2)
import DOM.Simple.Types (Element)
import FFI.Simple (delay)
import Reactix as R
import Reactix.DOM.HTML as RH
import Record as Record
......@@ -35,17 +34,17 @@ derive instance genericStage :: Generic Stage _
derive instance eqStage :: Eq Stage
type Props sigma forceatlas2 = (
elRef :: R.Ref (Nullable Element)
type Props sigma forceatlas2 =
( elRef :: R.Ref (Nullable Element)
, forceAtlas2Settings :: forceatlas2
, graph :: SigmaxTypes.SGraph
, mCamera :: Maybe GET.Camera
, multiSelectEnabledRef :: R.Ref Boolean
, selectedNodeIds :: T.Cursor SigmaxTypes.NodeIds
, showEdges :: T.Cursor SigmaxTypes.ShowEdgesState
, selectedNodeIds :: T.Box SigmaxTypes.NodeIds
, showEdges :: T.Box SigmaxTypes.ShowEdgesState
, sigmaRef :: R.Ref Sigmax.Sigma
, sigmaSettings :: sigma
, stage :: T.Cursor Stage
, stage :: T.Box Stage
, startForceAtlas :: Boolean
, transformedGraph :: SigmaxTypes.SGraph
)
......@@ -54,17 +53,13 @@ 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
graphCpt = here.component "graph" cpt where
cpt props@{ elRef
, forceAtlas2Settings
, graph
, mCamera
, multiSelectEnabledRef
, selectedNodeIds
, showEdges
, sigmaRef
, sigmaSettings
, stage
, startForceAtlas
, transformedGraph } _ = do
......@@ -89,15 +84,8 @@ graphCpt = here.component "graph" cpt
Nothing -> RH.div {} []
Just el -> R.createPortal [] el
stageHooks { elRef
, graph
, mCamera
, multiSelectEnabledRef
, selectedNodeIds
, sigmaRef
, stage
, stage': Init
, startForceAtlas } = do
stageHooks props@{ elRef, mCamera, multiSelectEnabledRef, selectedNodeIds, forceAtlas2Settings: fa2, graph: graph'
, sigmaRef, stage, stage': Init, startForceAtlas } = do
R.useEffectOnce' $ do
let rSigma = R.readRef sigmaRef
......@@ -117,7 +105,7 @@ graphCpt = here.component "graph" cpt
}
pure unit
Sigmax.refreshData sig $ Sigmax.sigmafy graph
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
......@@ -129,7 +117,7 @@ graphCpt = here.component "graph" cpt
-- log2 "[graph] startForceAtlas" startForceAtlas
if startForceAtlas then
Sigma.startForceAtlas2 sig forceAtlas2Settings
Sigma.startForceAtlas2 sig fa2
else
Sigma.stopForceAtlas2 sig
......@@ -144,6 +132,7 @@ graphCpt = here.component "graph" cpt
T.write Ready stage
stageHooks { showEdges'
, sigmaRef
, stage': Ready
......
......@@ -45,28 +45,23 @@ import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer"
type BaseProps = (
backend :: T.Cursor (Maybe Backend)
type BaseProps =
( backend :: T.Box (Maybe Backend)
, frontends :: Frontends
, graphId :: GET.GraphId
, handed :: T.Cursor Types.Handed
, route :: T.Cursor AppRoute
, sessions :: T.Cursor Sessions
, showLogin :: T.Cursor Boolean
, tasks :: T.Cursor (Maybe GAT.Reductor)
)
, handed :: T.Box Types.Handed
, route :: T.Box AppRoute
, sessions :: T.Box Sessions
, showLogin :: T.Box Boolean
, tasks :: T.Box (Maybe GAT.Reductor)
)
type LayoutLoaderProps = ( session :: R.Context Session | BaseProps )
type LayoutProps = (
graphVersion :: GUR.ReloadS
, session :: Session
| BaseProps
)
type LayoutProps = ( graphVersion :: GUR.ReloadS, session :: Session | BaseProps )
type Props = (
graph :: SigmaxT.SGraph
type Props =
( graph :: SigmaxT.SGraph
, hyperdataGraph :: GET.HyperdataGraph
, mMetaData :: Maybe GET.MetaData
| LayoutProps
......@@ -90,10 +85,7 @@ explorerLayout = R.createElement explorerLayoutCpt
explorerLayoutCpt :: R.Component LayoutProps
explorerLayoutCpt = here.component "explorerLayout" cpt where
cpt props@{ backend
, graphId
, graphVersion
, session } _ = do
cpt props@{ backend, graphId, graphVersion, session } _ = do
useLoader graphId (getNodes session graphVersion) handler
where
handler loaded = explorer (Record.merge props { graph, hyperdataGraph: loaded, mMetaData }) []
......@@ -125,7 +117,7 @@ explorerCpt = here.component "explorer" cpt
} _ = do
handed' <- T.useLive T.unequal handed
let startForceAtlas = maybe true (\(GET.MetaData { startForceAtlas }) -> startForceAtlas) mMetaData
let startForceAtlas = maybe true (\(GET.MetaData { startForceAtlas: sfa }) -> sfa) mMetaData
let forceAtlasS = if startForceAtlas
then SigmaxT.InitialRunning
......@@ -134,21 +126,21 @@ explorerCpt = here.component "explorer" cpt
dataRef <- R.useRef graph
graphRef <- R.useRef null
graphVersionRef <- R.useRef (GUR.value graphVersion)
-- reloadForest <- T2.useCursed $ T2.Ready 0
reloadForest <- T2.useCursed 0
-- reloadForest <- T.useBox $ T2.Ready 0
reloadForest <- T.useBox 0
-- reloadForest <- GUR.newIInitialized reloadForest
controls <- Controls.useGraphControls { forceAtlasS
, graph
, graphId
, hyperdataGraph
, reloadForest: \_ -> GUR.bumpCursor reloadForest
, reloadForest: \_ -> GUR.bumpBox reloadForest
, session
}
multiSelectEnabled' <- T.useLive T.unequal controls.multiSelectEnabled
showTree' <- T.useLive T.unequal controls.showTree
multiSelectEnabledRef <- R.useRef multiSelectEnabled'
forestOpen <- T2.useCursed $ Set.empty
forestOpen <- T.useBox $ Set.empty
R.useEffect' $ do
let readData = R.readRef dataRef
......@@ -162,12 +154,12 @@ explorerCpt = here.component "explorer" cpt
R.setRef dataRef graph
R.setRef graphVersionRef (GUR.value graphVersion)
-- Reinitialize bunch of state as well.
T2.write_ SigmaxT.emptyNodeIds controls.removedNodeIds
T2.write_ SigmaxT.emptyNodeIds controls.selectedNodeIds
T2.write_ SigmaxT.EShow controls.showEdges
T2.write_ forceAtlasS controls.forceAtlasState
T2.write_ Graph.Init controls.graphStage
T2.write_ GET.InitialClosed controls.showSidePanel
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_ GET.InitialClosed controls.showSidePanel
pure $
RH.div { className: "graph-meta-container" } [
......@@ -265,17 +257,17 @@ explorerCpt = here.component "explorer" cpt
Sidebar.sidebar (Record.merge props { metaData })
type TreeProps = (
backend :: T.Cursor (Maybe Backend)
, forestOpen :: T.Cursor OpenNodes
backend :: T.Box (Maybe Backend)
, forestOpen :: T.Box OpenNodes
, frontends :: Frontends
, handed :: T.Cursor Types.Handed
, reload :: T.Cursor T2.Reload
, reloadForest :: T.Cursor T2.Reload
, route :: T.Cursor AppRoute
, sessions :: T.Cursor Sessions
, handed :: T.Box Types.Handed
, reload :: T.Box T2.Reload
, reloadForest :: T.Box T2.Reload
, route :: T.Box AppRoute
, sessions :: T.Box Sessions
, show :: Boolean
, showLogin :: T.Cursor Boolean
, tasks :: T.Cursor (Maybe GAT.Reductor)
, showLogin :: T.Box Boolean
, tasks :: T.Box (Maybe GAT.Reductor)
)
type MSidebarProps =
......@@ -283,11 +275,11 @@ type MSidebarProps =
, graph :: SigmaxT.SGraph
, graphId :: GET.GraphId
, graphVersion :: GUR.ReloadS
, reloadForest :: T.Cursor T2.Reload
, removedNodeIds :: T.Cursor SigmaxT.NodeIds
, selectedNodeIds :: T.Cursor SigmaxT.NodeIds
, reloadForest :: T.Box T2.Reload
, removedNodeIds :: T.Box SigmaxT.NodeIds
, selectedNodeIds :: T.Box SigmaxT.NodeIds
, session :: Session
, showSidePanel :: T.Cursor GET.SidePanelState
, showSidePanel :: T.Box GET.SidePanelState
)
type GraphProps = (
......@@ -337,7 +329,7 @@ graphViewCpt = here.component "graphView" cpt
, removedNodeIds'
, selectedNodeIds'
, showEdges' }
let startForceAtlas = maybe true (\(GET.MetaData { startForceAtlas }) -> startForceAtlas) mMetaData
let startForceAtlas = maybe true (\(GET.MetaData { startForceAtlas: sfa }) -> sfa) mMetaData
R.useEffect1' multiSelectEnabled' $ do
R.setRef multiSelectEnabledRef multiSelectEnabled'
......
module Gargantext.Components.GraphExplorer.API where
import Data.Maybe (Maybe(..))
import Data.Maybe (Maybe)
import Effect.Aff (Aff)
import Gargantext.Components.GraphExplorer.Types as GET
......
module Gargantext.Components.GraphExplorer.Button
( centerButton
, Props
, simpleButton
, cameraButton
) where
( Props, centerButton, simpleButton, cameraButton ) where
import Prelude
......@@ -12,7 +8,6 @@ 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)
......@@ -29,6 +24,7 @@ import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Sessions (Session)
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.Button"
type Props = (
......@@ -92,16 +88,11 @@ cameraButton { id
, nodes = 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 }
[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
clonedGraphId <- cloneGraph { id, hyperdataGraph, session }
clonedGraphId <- cloneGraph { id, hyperdataGraph: hyperdataGraph', session }
ret <- uploadArbitraryDataURL session clonedGraphId (Just $ nowStr <> "-" <> "screenshot.png") screen
liftEffect $ reloadForest unit
pure ret
......
......@@ -12,8 +12,6 @@ import Data.Int as I
import Data.Maybe (Maybe(..), maybe)
import Data.Sequence as Seq
import Data.Set as Set
import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Timer (setTimeout)
import Prelude
......@@ -33,47 +31,39 @@ import Gargantext.Hooks.Sigmax.Types as SigmaxT
import Gargantext.Sessions (Session)
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.Cursor Range.NumberRange
, edgeWeight :: T.Cursor Range.NumberRange
, forceAtlasState :: T.Cursor SigmaxT.ForceAtlasState
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.Cursor Graph.Stage
, graphStage :: T.Box Graph.Stage
, hyperdataGraph :: GET.HyperdataGraph
, multiSelectEnabled :: T.Cursor Boolean
, nodeSize :: T.Cursor Range.NumberRange
, multiSelectEnabled :: T.Box Boolean
, nodeSize :: T.Box Range.NumberRange
, reloadForest :: Unit -> Effect Unit
, removedNodeIds :: T.Cursor SigmaxT.NodeIds
, selectedNodeIds :: T.Cursor SigmaxT.NodeIds
, removedNodeIds :: T.Box SigmaxT.NodeIds
, selectedNodeIds :: T.Box SigmaxT.NodeIds
, session :: Session
, showControls :: T.Cursor Boolean
, showEdges :: T.Cursor SigmaxT.ShowEdgesState
, showLouvain :: T.Cursor Boolean
, showSidePanel :: T.Cursor GET.SidePanelState
, showTree :: T.Cursor Boolean
, showControls :: T.Box Boolean
, showEdges :: T.Box SigmaxT.ShowEdgesState
, showLouvain :: T.Box Boolean
, showSidePanel :: T.Box GET.SidePanelState
, showTree :: T.Box Boolean
, sigmaRef :: R.Ref Sigmax.Sigma
)
type LocalControls = (
labelSize :: T.Cursor Number
, mouseSelectorSize :: T.Cursor Number
)
type LocalControls = ( labelSize :: T.Box Number, mouseSelectorSize :: T.Box Number )
initialLocalControls :: R.Hooks (Record LocalControls)
initialLocalControls = do
labelSize <- T2.useCursed 14.0
mouseSelectorSize <- T2.useCursed 15.0
pure $ {
labelSize
, mouseSelectorSize
}
labelSize <- T.useBox 14.0
mouseSelectorSize <- T.useBox 15.0
pure $ { labelSize, mouseSelectorSize }
controls :: Record Controls -> R.Element
controls props = R.createElement controlsCpt props []
......@@ -122,12 +112,12 @@ controlsCpt = here.component "controls" cpt
-- Handle automatic edge hiding when FA is running (to prevent flickering).
R.useEffect2' sigmaRef forceAtlasState' $ do
T2.modify_ (SigmaxT.forceAtlasEdgeState forceAtlasState') showEdges
T.modify_ (SigmaxT.forceAtlasEdgeState forceAtlasState') showEdges
-- Automatic opening of sidebar when a node is selected (but only first time).
R.useEffect' $ do
if showSidePanel' == GET.InitialClosed && (not Set.isEmpty selectedNodeIds') then
T2.write_ (GET.Opened GET.SideTabData) showSidePanel
T.write_ (GET.Opened GET.SideTabData) showSidePanel
else
pure unit
......@@ -138,7 +128,7 @@ controlsCpt = here.component "controls" cpt
timeoutId <- setTimeout 9000 $ do
case forceAtlasState' of
SigmaxT.InitialRunning ->
T2.write_ SigmaxT.Paused forceAtlasState
T.write_ SigmaxT.Paused forceAtlasState
_ -> pure unit
R.setRef mFAPauseRef Nothing
R.setRef mFAPauseRef $ Just timeoutId
......@@ -243,22 +233,22 @@ useGraphControls { forceAtlasS
, hyperdataGraph
, session
, reloadForest } = do
edgeConfluence <- T2.useCursed $ Range.Closed { min: 0.0, max: 1.0 }
edgeWeight <- T2.useCursed $ Range.Closed {
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 <- T2.useCursed forceAtlasS
graphStage <- T2.useCursed Graph.Init
multiSelectEnabled <- T2.useCursed false
nodeSize <- T2.useCursed $ Range.Closed { min: 0.0, max: 100.0 }
removedNodeIds <- T2.useCursed SigmaxT.emptyNodeIds
selectedNodeIds <- T2.useCursed SigmaxT.emptyNodeIds
showControls <- T2.useCursed false
showEdges <- T2.useCursed SigmaxT.EShow
showLouvain <- T2.useCursed false
showSidePanel <- T2.useCursed GET.InitialClosed
showTree <- T2.useCursed false
forceAtlasState <- T.useBox forceAtlasS
graphStage <- T.useBox Graph.Init
multiSelectEnabled <- T.useBox false
nodeSize <- T.useBox $ Range.Closed { min: 0.0, max: 100.0 }
removedNodeIds <- T.useBox SigmaxT.emptyNodeIds
selectedNodeIds <- T.useBox SigmaxT.emptyNodeIds
showControls <- T.useBox false
showEdges <- T.useBox SigmaxT.EShow
showLouvain <- T.useBox false
showSidePanel <- T.useBox GET.InitialClosed
showTree <- T.useBox false
sigma <- Sigmax.initSigma
sigmaRef <- R.useRef sigma
......@@ -284,7 +274,7 @@ useGraphControls { forceAtlasS
}
setShowControls :: Record Controls -> Boolean -> Effect Unit
setShowControls { showControls } v = T2.write_ v showControls
setShowControls { showControls } v = T.write_ v showControls
setShowTree :: Record Controls -> Boolean -> Effect Unit
setShowTree { showTree } v = T2.write_ (not v) showTree
setShowTree { showTree } v = T.write_ (not v) showTree
......@@ -7,7 +7,6 @@ module Gargantext.Components.GraphExplorer.RangeControl
) where
import Prelude
import Data.Tuple.Nested ((/\))
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
......@@ -15,7 +14,6 @@ import Toestand as T
import Gargantext.Components.RangeSlider as RS
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.RangeControl"
......@@ -40,7 +38,7 @@ rangeControlCpt = here.component "rangeButton" cpt
type EdgeConfluenceControlProps = (
range :: Range.NumberRange
, state :: T.Cursor Range.NumberRange
, state :: T.Box Range.NumberRange
)
edgeConfluenceControl :: R2.Component EdgeConfluenceControlProps
......@@ -62,13 +60,13 @@ edgeConfluenceControlCpt = here.component "edgeConfluenceControl" cpt
, step: 1.0
, width: 10.0
, height: 5.0
, onChange: \rng -> T2.write_ rng state
, onChange: \rng -> T.write_ rng state
}
} []
type EdgeWeightControlProps = (
range :: Range.NumberRange
, state :: T.Cursor Range.NumberRange
, state :: T.Box Range.NumberRange
)
edgeWeightControl :: R2.Component EdgeWeightControlProps
......@@ -90,13 +88,13 @@ edgeWeightControlCpt = here.component "edgeWeightControl" cpt
, step: 1.0
, width: 10.0
, height: 5.0
, onChange: \rng -> T2.write_ rng state
, onChange: \rng -> T.write_ rng state
}
} []
type NodeSideControlProps = (
range :: Range.NumberRange
, state :: T.Cursor Range.NumberRange
, state :: T.Box Range.NumberRange
)
nodeSizeControl :: R2.Component NodeSideControlProps
......@@ -118,6 +116,6 @@ nodeSizeControlCpt = here.component "nodeSizeControl" cpt
, step: 1.0
, width: 10.0
, height: 5.0
, onChange: \rng -> T2.write_ rng state
, onChange: \rng -> T.write_ rng state
}
} []
module Gargantext.Components.GraphExplorer.Search
( Props
, nodeSearchControl
) where
( Props, nodeSearchControl ) where
import Prelude
import Data.Sequence as Seq
......@@ -17,15 +15,14 @@ import Gargantext.Components.InputWithAutocomplete (inputWithAutocomplete)
import Gargantext.Hooks.Sigmax.Types as SigmaxT
import Gargantext.Utils (queryMatchesLabel)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.Search"
type Props = (
graph :: SigmaxT.SGraph
, multiSelectEnabled :: T.Cursor Boolean
, selectedNodeIds :: T.Cursor SigmaxT.NodeIds
, multiSelectEnabled :: T.Box Boolean
, selectedNodeIds :: T.Box SigmaxT.NodeIds
)
-- | Whether a node matches a search string
......@@ -68,7 +65,7 @@ autocompleteSearch graph s = Seq.toUnfoldable $ (_.label) <$> searchNodes s node
triggerSearch :: SigmaxT.SGraph
-> String
-> Boolean
-> T.Cursor SigmaxT.NodeIds
-> T.Box SigmaxT.NodeIds
-> Effect Unit
triggerSearch graph search multiSelectEnabled selectedNodeIds = do
let graphNodes = SigmaxT.graphNodes graph
......@@ -76,5 +73,5 @@ triggerSearch graph search multiSelectEnabled selectedNodeIds = do
log2 "[triggerSearch] search" search
T2.modify_ (\nodes ->
T.modify_ (\nodes ->
Set.union matching $ if multiSelectEnabled then nodes else SigmaxT.emptyNodeIds) selectedNodeIds
......@@ -9,8 +9,6 @@ import Data.Map as Map
import Data.Maybe (Maybe(..), fromJust)
import Data.Sequence as Seq
import Data.Set as Set
import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
......@@ -47,9 +45,9 @@ here = R2.here "Gargantext.Components.GraphExplorer.Sidebar"
type Common = (
graphId :: NodeID
, metaData :: GET.MetaData
, reloadForest :: T.Cursor T2.Reload
, removedNodeIds :: T.Cursor SigmaxT.NodeIds
, selectedNodeIds :: T.Cursor SigmaxT.NodeIds
, reloadForest :: T.Box T2.Reload
, removedNodeIds :: T.Box SigmaxT.NodeIds
, selectedNodeIds :: T.Box SigmaxT.NodeIds
, session :: Session
)
......@@ -57,7 +55,7 @@ type Props = (
frontends :: Frontends
, graph :: SigmaxT.SGraph
, graphVersion :: GUR.ReloadS
, showSidePanel :: T.Cursor GET.SidePanelState
, showSidePanel :: T.Box GET.SidePanelState
| Common
)
......@@ -78,8 +76,6 @@ sidebarCpt = here.component "sidebar" cpt
SideTabLegend -> sideTabLegend sideTabProps []
SideTabData -> sideTabData sideTabProps []
SideTabCommunity -> sideTabCommunity sideTabProps []
_ -> H.div {} []
pure $ RH.div { id: "sp-container" }
[ sideTabNav { sidePanel: showSidePanel
, sideTabs: [SideTabLegend, SideTabData, SideTabCommunity] } []
......@@ -89,7 +85,7 @@ sidebarCpt = here.component "sidebar" cpt
sideTabProps = RX.pick props :: Record SideTabProps
type SideTabNavProps = (
sidePanel :: T.Cursor GET.SidePanelState
sidePanel :: T.Box GET.SidePanelState
, sideTabs :: Array SideTab
)
......@@ -299,34 +295,32 @@ removeButtonCpt = here.component "removeButton" cpt
, session: session
, termList: rType
, reloadForest }
T2.write_ selectedNodeIds' removedNodeIds
T2.write_ SigmaxT.emptyNodeIds selectedNodeIds
T.write_ selectedNodeIds' removedNodeIds
T.write_ SigmaxT.emptyNodeIds selectedNodeIds
badge :: T.Cursor SigmaxT.NodeIds -> Record SigmaxT.Node -> R.Element
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 e = do
T2.write_ (Set.singleton id) selectedNodeIds
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
neighbourBadges graph selectedNodeIds = SigmaxT.neighbours graph selectedNodes' where
selectedNodes' = SigmaxT.graphNodes $ SigmaxT.nodesById graph selectedNodeIds
type DeleteNodes =
( graphId :: NodeID
, metaData :: GET.MetaData
, nodes :: Array (Record SigmaxT.Node)
, reloadForest :: T.Cursor T2.Reload
, reloadForest :: T.Box T2.Reload
, session :: Session
, termList :: TermList
)
......@@ -339,7 +333,7 @@ deleteNodes { graphId, metaData, nodes, session, termList, reloadForest } = do
case mPatch of
Nothing -> pure unit
Just (NTC.Versioned patch) -> do
liftEffect $ GUR.bumpCursor reloadForest
liftEffect $ GUR.bumpBox reloadForest
-- Why is this called delete node?
deleteNode :: TermList
......
......@@ -7,7 +7,6 @@ module Gargantext.Components.GraphExplorer.SlideButton
import Global (readFloat)
import Prelude
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Reactix as R
import Reactix.DOM.HTML as H
......@@ -16,40 +15,35 @@ import Toestand as T
import Gargantext.Hooks.Sigmax as Sigmax
import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.SlideButton"
type Props = (
caption :: String
type Props =
( caption :: String
, min :: Number
, max :: Number
, onChange :: forall e. e -> Effect Unit
, state :: T.Cursor Number
, 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
state' <- T.useLive T.unequal state
pure $
H.span { class: "range-simple" }
[ H.label {} [ R2.small {} [ H.text caption ] ]
, H.input { type: "range"
, className: "form-control"
, min: show min
, max: show max
, defaultValue: state'
, on: {input: onChange}
}
]
sizeButtonCpt = here.component "sizeButton" cpt where
cpt { state, caption, min, max, onChange } _ = do
defaultValue <- T.useLive T.unequal state
pure $ H.span { class: "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.Cursor Number -> R.Element
labelSizeButton :: R.Ref Sigmax.Sigma -> T.Box Number -> R.Element
labelSizeButton sigmaRef state =
sizeButton {
state
......@@ -66,10 +60,10 @@ labelSizeButton sigmaRef state =
, maxNodeSize: newValue / 2.5
--, labelSizeRatio: newValue / 2.5
}
T2.write_ newValue state
T.write_ newValue state
}
mouseSelectorSizeButton :: R.Ref Sigmax.Sigma -> T.Cursor Number -> R.Element
mouseSelectorSizeButton :: R.Ref Sigmax.Sigma -> T.Box Number -> R.Element
mouseSelectorSizeButton sigmaRef state =
sizeButton {
state
......@@ -83,5 +77,5 @@ mouseSelectorSizeButton sigmaRef state =
Sigma.setSettings s {
mouseSelectorSize: newValue
}
T2.write_ newValue state
T.write_ newValue state
}
......@@ -13,8 +13,6 @@ module Gargantext.Components.GraphExplorer.ToggleButton
import Prelude
import Data.Tuple (snd)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Reactix as R
import Reactix.DOM.HTML as H
......@@ -23,13 +21,12 @@ import Toestand as T
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Hooks.Sigmax.Types as SigmaxTypes
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.GraphExplorer.ToggleButton"
type Props = (
state :: T.Cursor Boolean
state :: T.Box Boolean
, onMessage :: String
, offMessage :: String
, style :: String
......@@ -59,7 +56,7 @@ toggleButtonCpt = here.component "toggleButton" cpt
text _on off false = off
type ControlsToggleButtonProps = (
state :: T.Cursor Boolean
state :: T.Box Boolean
)
controlsToggleButton :: R2.Component ControlsToggleButtonProps
......@@ -73,12 +70,12 @@ controlsToggleButtonCpt = here.component "controlsToggleButton" cpt
state: state
, onMessage: "Hide Controls"
, offMessage: "Show Controls"
, onClick: \_ -> T2.modify_ not state
, onClick: \_ -> T.modify_ not state
, style: "light"
} []
type EdgesButtonProps = (
state :: T.Cursor SigmaxTypes.ShowEdgesState
state :: T.Box SigmaxTypes.ShowEdgesState
)
edgesToggleButton :: R2.Component EdgesButtonProps
......@@ -100,10 +97,10 @@ edgesToggleButtonCpt = here.component "edgesToggleButton" cpt
cls _ = "active"
-- TODO: Move this to Graph.purs to the R.useEffect handler which renders nodes/edges
onClick state _ = T2.modify_ SigmaxTypes.toggleShowEdgesState state
onClick state _ = T.modify_ SigmaxTypes.toggleShowEdgesState state
type LouvainToggleButtonProps = (
state :: T.Cursor Boolean
state :: T.Box Boolean
)
louvainToggleButton :: R2.Component LouvainToggleButtonProps
......@@ -117,12 +114,12 @@ louvainToggleButtonCpt = here.component "louvainToggleButton" cpt
state: state
, onMessage: "Louvain off"
, offMessage: "Louvain on"
, onClick: \_ -> T2.modify_ not state
, onClick: \_ -> T.modify_ not state
, style: "primary"
} []
type MultiSelectEnabledButtonProps = (
state :: T.Cursor Boolean
state :: T.Box Boolean
)
multiSelectEnabledButton :: R2.Component MultiSelectEnabledButtonProps
......@@ -136,12 +133,12 @@ multiSelectEnabledButtonCpt = here.component "lmultiSelectEnabledButton" cpt
state: state
, onMessage: "Single-node"
, offMessage: "Multi-node"
, onClick: \_ -> T2.modify_ not state
, onClick: \_ -> T.modify_ not state
, style : "primary"
} []
type ForceAtlasProps = (
state :: T.Cursor SigmaxTypes.ForceAtlasState
state :: T.Box SigmaxTypes.ForceAtlasState
)
pauseForceAtlasButton :: R2.Component ForceAtlasProps
......@@ -166,10 +163,10 @@ pauseForceAtlasButtonCpt = here.component "forceAtlasToggleButton" cpt
text SigmaxTypes.Running = "Pause Force Atlas"
text SigmaxTypes.Paused = "Start Force Atlas"
onClick state _ = T2.modify_ SigmaxTypes.toggleForceAtlasState state
onClick state _ = T.modify_ SigmaxTypes.toggleForceAtlasState state
type TreeToggleButtonProps = (
state :: T.Cursor Boolean
state :: T.Box Boolean
)
treeToggleButton :: R2.Component TreeToggleButtonProps
......@@ -183,12 +180,12 @@ treeToggleButtonCpt = here.component "treeToggleButton" cpt
state: state
, onMessage: "Hide Tree"
, offMessage: "Show Tree"
, onClick: \_ -> T2.modify_ not state
, onClick: \_ -> T.modify_ not state
, style: "light"
} []
type SidebarToggleButtonProps = (
state :: T.Cursor GET.SidePanelState
state :: T.Box GET.SidePanelState
)
sidebarToggleButton :: R2.Component SidebarToggleButtonProps
......@@ -214,7 +211,7 @@ sidebarToggleButtonCpt = here.component "sidebarToggleButton" cpt
text _on off GET.Closed = off
onClick state = \_ ->
T2.modify_ (\s -> case s of
T.modify_ (\s -> case s of
GET.InitialClosed -> GET.Opened GET.SideTabLegend
GET.Closed -> GET.Opened GET.SideTabLegend
(GET.Opened _) -> GET.Closed) state
......@@ -21,7 +21,6 @@ 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
import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.Login"
......@@ -31,11 +30,11 @@ here = R2.here "Gargantext.Components.Login"
-- 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.Cursor (Maybe Backend)
type Props =
( backend :: T.Box (Maybe Backend)
, backends :: Array Backend
, sessions :: T.Cursor Sessions
, visible :: T.Cursor Boolean
, sessions :: T.Box Sessions
, visible :: T.Box Boolean
)
login :: R2.Leaf Props
......@@ -110,7 +109,7 @@ renderBackend cursor backend@(Backend {name}) =
, 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 _ = T2.write_ (Just backend) cursor
click _ = T.write_ (Just backend) cursor
backendLabel :: String -> String
backendLabel =
......
......@@ -11,6 +11,7 @@ import Reactix as R
import Reactix.SyntheticEvent as E
import Reactix.DOM.HTML as H
import Toestand as T
import Toestand.Records (useFocusedFields)
import Gargantext.Components.Login.Types (AuthRequest(..))
import Gargantext.Components.Forms (clearfix, formGroup)
......@@ -33,14 +34,14 @@ type Form =
emptyForm :: Form
emptyForm = { error: "", username: "", password: "", agreed: false }
type Cursors =
{ error :: T.Cursor String
, username :: T.Cursor String
, password :: T.Cursor String
, agreed :: T.Cursor Boolean }
type Boxes =
{ error :: T.Box String
, username :: T.Box String
, password :: T.Box String
, agreed :: T.Box Boolean }
formCursors :: T.Cell Form -> R.Hooks Cursors
formCursors cell = T.useFieldCursors cell {}
formBoxes :: T.Box Form -> R.Hooks Boxes
formBoxes box = useFocusedFields box {}
type Props s v =
( backend :: Backend
......@@ -56,8 +57,8 @@ 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.useCell emptyForm
cursors <- T.useFieldCursors cell {}
cell <- T.useBox emptyForm
cursors <- useFocusedFields cell {}
pure $ R2.row
[ H.form { className: "col-md-12" }
[ formLoginLink backend
......@@ -81,7 +82,7 @@ formLoginLink backend =
H.h4 { className: "text-center" } {-className: "text-muted"-}
[ H.text $ "Login to garg://" <> show backend ]
type SubmitButtonProps s v = ( cell :: T.Cell Form | Props s v )
type SubmitButtonProps s v = ( cell :: T.Box Form | Props s v )
submitButton
:: forall s v. T.ReadWrite s Sessions => T.Write v Boolean
......@@ -102,7 +103,7 @@ submitButtonCpt = here.component "submitButton" cpt where
-- Attempts to submit the form
submitForm :: forall s v. T.ReadWrite s Sessions => T.Write v Boolean
=> Record (Props s v) -> T.Cell Form -> ChangeEvent -> Effect Unit
=> Record (Props s v) -> T.Box Form -> ChangeEvent -> Effect Unit
submitForm { backend, sessions, visible } cell e = do
E.preventDefault e
state <- T.read cell
......
module Gargantext.Components.Login.Modal (Props, modal) where
import Prelude (bind, (<*), (>>=), (<$>))
import Prelude (bind, (<*), (<$>))
import Data.Semigroup ((<>))
import Reactix as R
import Reactix.DOM.HTML as H
......
......@@ -25,7 +25,7 @@ import Data.Tuple (Tuple(..), fst)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff)
import Reactix (Component, Element, Ref, State, createElement, fragment, hooksComponentWithModule, unsafeEventValue, useState') as R
import Reactix (Component, Element, State, createElement, fragment, unsafeEventValue, useState') as R
import Reactix.DOM.HTML as H
import Toestand as T
......@@ -48,7 +48,6 @@ import Gargantext.Types (CTabNgramType, OrderBy(..), SearchQuery, TabType, TermL
import Gargantext.Utils (queryMatchesLabel, toggleSet, sortWith)
import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reload as GUR
import Gargantext.Utils.Seq as Seq
import Gargantext.Utils.Toestand as T2
......@@ -258,11 +257,11 @@ tableContainerCpt { dispatch
type CommonProps = (
afterSync :: Unit -> Aff Unit
, reloadForest :: T.Cursor T2.Reload
, reloadRoot :: T.Cursor T2.Reload
, reloadForest :: T.Box T2.Reload
, reloadRoot :: T.Box T2.Reload
, sidePanelTriggers :: Record NT.SidePanelTriggers
, tabNgramType :: CTabNgramType
, tasks :: T.Cursor (Maybe GAT.Reductor)
, tasks :: T.Box (Maybe GAT.Reductor)
, withAutoUpdate :: Boolean
)
......
......@@ -17,12 +17,19 @@ import Reactix as R
import Reactix.DOM.HTML as H
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 =
......
......@@ -8,7 +8,7 @@ module Gargantext.Components.NgramsTable.Core
, ngramsRepoElementToNgramsElement
, NgramsTable(..)
, NewElems
, NgramsPatch
, NgramsPatch(..)
, NgramsPatches
, _NgramsTable
, NgramsTerm
......@@ -26,7 +26,6 @@ module Gargantext.Components.NgramsTable.Core
, VersionedNgramsTable
, VersionedWithCountNgramsTable
, NgramsTablePatch
, NgramsPatch(..)
, CoreState
, highlightNgrams
, initialPageParams
......@@ -1178,9 +1177,9 @@ chartsAfterSync :: forall props discard.
, tabType :: TabType
| props
}
-> T.Cursor (Maybe GAT.Reductor)
-> T.Box (Maybe GAT.Reductor)
-> Int
-> T.Cursor T2.Reload
-> T.Box T2.Reload
-> discard
-> Aff Unit
chartsAfterSync path' tasks nodeId reloadForest _ = do
......@@ -1192,7 +1191,7 @@ chartsAfterSync path' tasks nodeId reloadForest _ = do
Nothing -> log "[chartsAfterSync] tasks is Nothing"
Just tasks' -> do
snd tasks' (GAT.Insert nodeId task) -- *> T2.reload reloadForest
GUR.bumpCursor reloadForest
GUR.bumpBox reloadForest
postNgramsChartsAsync :: forall s. CoreParams s -> Aff AsyncTaskWithType
postNgramsChartsAsync { listIds, nodeId, session, tabType } = do
......
......@@ -4,7 +4,6 @@ import Data.Argonaut (class DecodeJson)
import Data.Maybe (Maybe(..), maybe, isJust)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log, log2)
import Effect.Aff (Aff, launchAff_, throwError)
import Effect.Class (liftEffect)
import Effect.Exception (error)
......@@ -13,7 +12,7 @@ import Reactix as R
import Gargantext.Prelude
import Gargantext.Components.LoadingSpinner (loadingSpinner)
import Gargantext.Components.NgramsTable.Core (Version(..), Versioned(..))
import Gargantext.Components.NgramsTable.Core (Version, Versioned(..))
import Gargantext.Utils.CacheAPI as GUC
......@@ -85,9 +84,9 @@ useCachedAPILoaderEffect { cacheEndpoint
-- log2 "[useCachedAPILoaderEffect] cached version" version
-- log2 "[useCachedAPILoaderEffect] real version" cacheReal
_ <- GUC.deleteReq cache req
vr@(Versioned { version, "data": d }) <- GUC.cachedJson cache req
vr'@(Versioned { version: _, data: _ }) <- GUC.cachedJson cache req
if version == cacheReal then
pure vr
pure vr'
else
throwError $ error $ "Fetched clean cache but hashes don't match"
liftEffect $ do
......
......@@ -212,7 +212,7 @@ contactCellsCpt = here.component "contactCells" cpt where
--nodepath = NodePath (sessionId session) NodeContact (Just id)
nodepath = Routes.ContactPage (sessionId session) annuaireId id
href = url frontends nodepath
contactUrl aId id = url frontends $ Routes.ContactPage (sessionId session) aId id
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)
......
......@@ -55,11 +55,11 @@ type TabsProps =
, contactData :: ContactData
, frontends :: Frontends
, nodeId :: Int
, reloadForest :: T.Cursor T2.Reload
, reloadRoot :: T.Cursor T2.Reload
, reloadForest :: T.Box T2.Reload
, reloadRoot :: T.Box T2.Reload
, session :: Session
, sidePanelTriggers :: Record LTypes.SidePanelTriggers
, tasks :: T.Cursor (Maybe GAT.Reductor)
, tasks :: T.Box (Maybe GAT.Reductor)
)
tabs :: R2.Leaf TabsProps
......@@ -130,9 +130,9 @@ type NTCommon =
( cacheState :: R.State LTypes.CacheState
, defaultListId :: Int
, nodeId :: Int
, reloadForest :: T.Cursor T2.Reload
, reloadRoot :: T.Cursor T2.Reload
, reloadForest :: T.Box T2.Reload
, reloadRoot :: T.Box T2.Reload
, session :: Session
, sidePanelTriggers :: Record LTypes.SidePanelTriggers
, tasks :: T.Cursor (Maybe GAT.Reductor)
, tasks :: T.Box (Maybe GAT.Reductor)
)
......@@ -4,10 +4,9 @@ module Gargantext.Components.Nodes.Annuaire.User
)
where
import DOM.Simple.Console (log2)
import Gargantext.Prelude (Unit, bind, const, discard, pure, show, ($), (<$>), (<<<), (<>))
import Data.Lens as L
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
......@@ -23,7 +22,6 @@ import Gargantext.Components.Nodes.Annuaire.Tabs as Tabs
import Gargantext.Components.Nodes.Lists.Types as LT
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude (Unit, bind, const, discard, pure, show, unit, ($), (+), (<$>), (<<<), (<>), (==))
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, get, put, sessionId)
import Gargantext.Types (NodeType(..))
......@@ -34,9 +32,7 @@ import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Annuaire.User"
type DisplayProps = (
title :: String
)
type DisplayProps = ( title :: String )
display :: R2.Component DisplayProps
display = R.createElement displayCpt
......@@ -115,7 +111,7 @@ contactInfoItemCpt = here.component "contactInfoItem" cpt
item (false /\ setIsEditing) valueRef =
H.div { className: "input-group col-sm-6" } [
H.input { className: "form-control"
, defaultValue: placeholder
, defaultValue: placeholder'
, disabled: 1
, type: "text" }
, H.div { className: "btn input-group-append"
......@@ -124,7 +120,7 @@ contactInfoItemCpt = here.component "contactInfoItem" cpt
]
]
where
placeholder = R.readRef valueRef
placeholder' = R.readRef valueRef
onClick _ = setIsEditing $ const true
item (true /\ setIsEditing) valueRef =
H.div { className: "input-group col-sm-6" } [
......@@ -154,10 +150,10 @@ listElement = H.li { className: "list-group-item justify-content-between" }
type LayoutProps =
( frontends :: Frontends
, nodeId :: Int
, reloadForest :: T.Cursor T2.Reload
, reloadRoot :: T.Cursor T2.Reload
, reloadForest :: T.Box T2.Reload
, reloadRoot :: T.Box T2.Reload
, session :: Session
, tasks :: T.Cursor (Maybe GAT.Reductor)
, tasks :: T.Box (Maybe GAT.Reductor)
)
type KeyLayoutProps = (
......
......@@ -4,7 +4,7 @@ module Gargantext.Components.Nodes.Annuaire.User.Contact
) where
import Gargantext.Prelude
( Unit, bind, const, discard, pure, show, void, ($), (<$>), (*>), (<<<), (<>) )
( Unit, bind, const, discard, pure, show, ($), (<$>), (*>), (<<<), (<>) )
import Data.Lens as L
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple.Nested ((/\))
......@@ -18,7 +18,13 @@ import Toestand as T
import Gargantext.AsyncTasks as GAT
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.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.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
......@@ -26,7 +32,6 @@ 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.Reload as GUR
import Gargantext.Utils.Toestand as T2
here :: R2.Here
......@@ -131,12 +136,12 @@ listElement = H.li { className: "list-group-item justify-content-between" }
type BasicProps =
( frontends :: Frontends
, nodeId :: Int
, tasks :: T.Cursor (Maybe GAT.Reductor)
, tasks :: T.Box (Maybe GAT.Reductor)
)
type ReloadProps =
( reloadForest :: T.Cursor T2.Reload
, reloadRoot :: T.Cursor T2.Reload
( reloadForest :: T.Box T2.Reload
, reloadRoot :: T.Box T2.Reload
| BasicProps
)
......@@ -176,7 +181,7 @@ contactLayoutWithKeyCpt = here.component "contactLayoutWithKey" cpt where
, nodeId
, session
, tasks } _ = do
reload <- T.useCell T2.newReload
reload <- T.useBox T2.newReload
_ <- T.useLive T.unequal reload
cacheState <- R.useState' LT.CacheOn
sidePanelTriggers <- LT.emptySidePanelTriggers
......@@ -189,7 +194,7 @@ contactLayoutWithKeyCpt = here.component "contactLayoutWithKey" cpt where
{ cacheState, contactData, frontends, nodeId, session
, sidePanelTriggers, reloadForest, reloadRoot, tasks } ]
where
onUpdateHyperdata :: T.Cell T2.Reload -> HyperdataContact -> Effect Unit
onUpdateHyperdata :: T.Box T2.Reload -> HyperdataContact -> Effect Unit
onUpdateHyperdata reload hd =
launchAff_ $
saveContactHyperdata session nodeId hd *> liftEffect (T2.reload reload)
......
......@@ -53,11 +53,11 @@ type TabsProps = (
, contactData :: ContactData'
, frontends :: Frontends
, nodeId :: Int
, reloadForest :: T.Cursor T2.Reload
, reloadRoot :: T.Cursor T2.Reload
, reloadForest :: T.Box T2.Reload
, reloadRoot :: T.Box T2.Reload
, session :: Session
, sidePanelTriggers :: Record LTypes.SidePanelTriggers
, tasks :: T.Cursor (Maybe GAT.Reductor)
, tasks :: T.Box (Maybe GAT.Reductor)
)
tabs :: Record TabsProps -> R.Element
......@@ -135,11 +135,11 @@ type NgramsViewTabsProps = (
, defaultListId :: Int
, mode :: Mode
, nodeId :: Int
, reloadForest :: T.Cursor T2.Reload
, reloadRoot :: T.Cursor T2.Reload
, reloadForest :: T.Box T2.Reload
, reloadRoot :: T.Box T2.Reload
, session :: Session
, sidePanelTriggers :: Record LTypes.SidePanelTriggers
, tasks :: T.Cursor (Maybe GAT.Reductor)
, tasks :: T.Box (Maybe GAT.Reductor)
)
ngramsView :: R2.Component NgramsViewTabsProps
......
module Gargantext.Components.Nodes.Corpus where
import Gargantext.Prelude
( Unit, bind, const, discard, pure, show, unit
, ($), (+), (-), (<), (<$>), (<<<), (<>), (==), (>))
import Data.Argonaut (class DecodeJson, decodeJson, encodeJson)
import Data.Argonaut.Parser (jsonParser)
import Data.Array as A
import Data.Either (Either(..))
import Data.List as List
import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
......@@ -15,13 +18,13 @@ import Effect.Class (liftEffect)
import Effect.Exception (error)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.CodeEditor as CE
import Gargantext.Components.InputWithEnter (inputWithEnter)
import Gargantext.Components.Node (NodePoly(..), HyperdataList)
import Gargantext.Components.Nodes.Types
( FTField, FTFieldWithIndex, FTFieldsWithIndex, Field(..), FieldType(..), Hash, Index
, defaultField, defaultHaskell', defaultJSON', defaultMarkdown', defaultPython' )
import Gargantext.Components.Nodes.Corpus.Types (CorpusData, Hyperdata(..))
import Gargantext.Data.Array as GDA
import Gargantext.Hooks.Loader (useLoader)
......@@ -31,7 +34,6 @@ import Gargantext.Types (NodeType(..), AffTableResult)
import Gargantext.Utils.Crypto as Crypto
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reload as GUR
import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus"
......
......@@ -6,7 +6,7 @@ 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 (Path, Props)
import Gargantext.Components.Nodes.Corpus.Chart.Types (Props)
import Gargantext.Types (ChartType(..))
getChartFunction :: ChartType -> (Record Props -> R.Element)
......
......@@ -2,7 +2,6 @@ module Gargantext.Components.Nodes.Corpus.Chart.API where
import Effect.Aff (Aff)
import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, post)
import Gargantext.Types as T
......
module Gargantext.Components.Nodes.Corpus.Chart.Common where
import Data.Argonaut (class DecodeJson, class EncodeJson)
import Data.Tuple (fst, Tuple(..))
import Data.Argonaut (class DecodeJson)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Reactix as R
import Gargantext.Prelude
import Gargantext.Components.Nodes.Corpus.Chart.Types (Path, Props, MetricsProps, ReloadPath)
import Gargantext.Components.Nodes.Corpus.Chart.Types (MetricsProps, ReloadPath)
import Gargantext.Hooks.Loader (HashedResponse, useLoader, useLoaderWithCacheAPI)
import Gargantext.Utils.Crypto (Hash)
import Gargantext.Sessions (Session)
......
module Gargantext.Components.Nodes.Corpus.Chart.Metrics where
import Gargantext.Prelude (bind, negate, pure, ($), (<$>), (<>))
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (~>), (:=))
import Data.Argonaut.Core (jsonEmptyObject)
import Data.Map as Map
......@@ -7,28 +9,27 @@ import Data.Map (Map)
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff_)
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
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 (metricsLoadView, metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
(MetricsProps, Path, Props, ReloadPath)
import Gargantext.Hooks.Loader (HashedResponse(..))
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..), TabType, TermList(..))
import Gargantext.Types (TermList(..))
import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus.Chart.Metrics"
newtype Metric = Metric
......@@ -134,9 +135,9 @@ metricsCpt = here.component "etrics" cpt
loaded :: Record MetricsProps -> Loaded -> R.Element
loaded { path, reload, session } loaded =
loaded { path, reload, session } loaded' =
H.div {} [
{- U.reloadButton reload
, U.chartUpdateButton { chartType: Scatter, path, reload, session }
, -} chart $ scatterOptions loaded
, -} chart $ scatterOptions loaded'
]
module Gargantext.Components.Nodes.Corpus.Chart.Pie where
import Gargantext.Prelude (bind, map, pure, ($), (==), (>))
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (~>), (:=))
import Data.Argonaut.Core (jsonEmptyObject)
import Data.Array (zip, filter)
......@@ -17,14 +18,13 @@ 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.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types
import Gargantext.Components.Nodes.Corpus.Chart.Utils as U
(MetricsProps, Path, Props, ReloadPath)
import Gargantext.Hooks.Loader (HashedResponse(..))
import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
import Gargantext.Types (ChartType(..), TabType)
import Gargantext.Types (ChartType(..))
import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.Reactix as R2
......
module Gargantext.Components.Nodes.Corpus.Chart.Tree where
import Prelude (bind, pure, ($), (==))
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, (.:), (~>), (:=))
import Data.Argonaut.Core (jsonEmptyObject)
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
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.Utils as U
import Gargantext.Components.Nodes.Corpus.Chart.Common (metricsLoadView, metricsWithCacheLoadView)
import Gargantext.Components.Nodes.Corpus.Chart.Types
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(..), TabType)
import Gargantext.Types (ChartType(..))
import Gargantext.Utils.CacheAPI as GUC
import Gargantext.Utils.Reactix as R2
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus.Chart.Tree"
newtype Metrics = Metrics {
......@@ -92,9 +90,9 @@ treeCpt = here.component "tree" cpt
}
loaded :: Record MetricsProps -> Loaded -> R.Element
loaded { path, reload, session } loaded =
loaded { path, reload, session } loaded' =
H.div {} [
{- U.reloadButton reload
, U.chartUpdateButton { chartType: ChartTree, path, reload, session }
, -} chart (scatterOptions loaded)
, -} chart (scatterOptions loaded')
]
......@@ -2,7 +2,6 @@ module Gargantext.Components.Nodes.Corpus.Chart.Types where
import Data.Maybe (Maybe)
import Data.Tuple (Tuple)
import Reactix as R
import Gargantext.Sessions (Session)
import Gargantext.Types (TabType)
......
module Gargantext.Components.Nodes.Corpus.Chart.Utils where
import Data.Maybe (Maybe(..))
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (launchAff_)
import Effect.Class (liftEffect)
import Effect.Uncurried (mkEffectFn1)
import Reactix as R
import Reactix.DOM.HTML as H
......@@ -17,6 +15,7 @@ import Gargantext.Types as T
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reload as GUR
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Corpus.Chart.Utils"
reloadButtonWrap :: GUR.ReloadS -> R.Element -> R.Element
......@@ -26,24 +25,19 @@ reloadButtonWrap setReload el = H.div {} [
]
reloadButton :: GUR.ReloadS -> R.Element
reloadButton reloadS = H.a { className
, on: { click: onClick }
, title: "Reload" } []
where
className = "reload-btn fa fa-refresh"
onClick _ = GUR.bump reloadS
reloadButton reloadS = H.a { className, on: { click }, title: "Reload" } [] where
className = "reload-btn fa fa-refresh"
click _ = GUR.bump reloadS
mNgramsTypeFromTabType :: T.TabType -> Maybe T.CTabNgramType
mNgramsTypeFromTabType (T.TabCorpus (T.TabNgramType ngramType)) = Just ngramType
mNgramsTypeFromTabType (T.TabCorpus _) = Nothing
mNgramsTypeFromTabType (T.TabDocument (T.TabNgramType ngramType)) = Just ngramType
mNgramsTypeFromTabType (T.TabDocument _) = Nothing
mNgramsTypeFromTabType (T.TabPairing _) = Nothing
mNgramsTypeFromTabType _ = Nothing
type ChartUpdateButtonProps = (
chartType :: T.ChartType
type ChartUpdateButtonProps =
( chartType :: T.ChartType
, path :: Record Path
, reload :: GUR.ReloadS
, session :: Session
......@@ -53,22 +47,17 @@ chartUpdateButton :: Record ChartUpdateButtonProps -> R.Element
chartUpdateButton p = R.createElement chartUpdateButtonCpt p []
chartUpdateButtonCpt :: R.Component ChartUpdateButtonProps
chartUpdateButtonCpt = here.component "chartUpdateButton" cpt
where
cpt { chartType
, path: { corpusId, listId, tabType }
, reload
, session } _ = do
pure $ H.a { className: "chart-update-button fa fa-database"
, on: { click: onClick }
, title: "Update chart data" } []
where
onClick :: forall a. a -> Effect Unit
onClick _ = do
launchAff_ $ do
case mNgramsTypeFromTabType tabType of
Just ngramsType -> do
_ <- recomputeChart session chartType ngramsType corpusId listId
liftEffect $ GUR.bump reload
Nothing -> pure unit
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 $ GUR.bump reload
Nothing -> pure unit
......@@ -13,6 +13,7 @@ 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 =
......
......@@ -6,7 +6,7 @@ import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Gargantext.Components.Nodes.Corpus.Chart.Predefined as P
import Gargantext.Components.Nodes.Types (FTField, Field(..), FieldType(..), isJSON)
import Gargantext.Components.Nodes.Types (FTField)
import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(NodeAPI))
import Gargantext.Sessions (Session, get, put)
......
module Gargantext.Components.Nodes.File where
import Data.Argonaut (class DecodeJson, decodeJson, (.:))
import Data.Maybe (Maybe(..), maybe)
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.Ends (toUrl)
......
......@@ -5,12 +5,9 @@ import Data.Argonaut (decodeJson, (.:))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
--import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson, genericEnumDecodeJson, genericEnumEncodeJson)
import Data.Maybe (Maybe(..), maybe)
import Data.Tuple (fst)
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.Node (NodePoly(..))
import Gargantext.Hooks.Loader (useLoader)
......@@ -21,7 +18,6 @@ import Gargantext.Types (NodeType(..))
import Gargantext.Utils.Argonaut (genericSumEncodeJson)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reload as GUR
import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Frame"
......
......@@ -9,13 +9,11 @@ import Data.Tuple (fst)
import Effect.Aff (Aff)
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Config (publicBackend)
import Gargantext.Config.REST (get)
import Gargantext.Ends (Backend, backendUrl)
import Gargantext.Ends (backendUrl)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Sessions (Sessions)
import Gargantext.Prelude
import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson)
import Gargantext.Utils.Reactix as R2
......
module Gargantext.Components.Nodes.Lists where
import Gargantext.Prelude (Unit, bind, const, discard, pure, show, unit, ($), (<>))
import Data.Maybe (Maybe(..))
import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
......@@ -9,29 +10,31 @@ import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
------------------------------------------------------------------------
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Forest as Forest
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.Corpus.Types
( getCorpusInfo, CorpusInfo(..), Hyperdata(..) )
import Gargantext.Components.Nodes.Lists.Tabs as Tabs
import Gargantext.Components.Nodes.Lists.Types
( CacheState(..), ListsLayoutControls, SidePanelState(..)
, initialControls, toggleSidePanelState )
import Gargantext.Components.Table as Table
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude
import Gargantext.Sessions (Session, sessionId, getCacheState, setCacheState)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reload as GUR
import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.Nodes.Lists"
------------------------------------------------------------------------
type ListsWithForest = (
forestProps :: Record Forest.LayoutProps
type ListsWithForest =
( forestProps :: Record Forest.LayoutProps
, listsProps :: Record CommonProps
)
......@@ -39,89 +42,61 @@ listsWithForest :: R2.Component ListsWithForest
listsWithForest = R.createElement listsWithForestCpt
listsWithForestCpt :: R.Component ListsWithForest
listsWithForestCpt = here.component "listsWithForest" cpt
where
cpt { forestProps
, listsProps: listsProps@{ session } } _ = do
controls <- initialControls
pure $ Forest.forestLayoutWithTopBar forestProps [
topBar { controls } []
listsWithForestCpt = here.component "listsWithForest" cpt where
cpt { forestProps, listsProps: listsProps@{ session } } _ = do
controls <- initialControls
pure $ Forest.forestLayoutWithTopBar forestProps
[ topBar { controls } []
, listsLayout (Record.merge listsProps { controls }) []
, H.div { className: "side-panel" } [
sidePanel { controls, session } []
]
, H.div { className: "side-panel" } [ sidePanel { controls, session } [] ]
]
--------------------------------------------------------
type TopBarProps = (
controls :: Record ListsLayoutControls
)
type TopBarProps = ( controls :: Record ListsLayoutControls )
topBar :: R2.Component TopBarProps
topBar = R.createElement topBarCpt
topBarCpt :: R.Component TopBarProps
topBarCpt = here.component "topBar" cpt
where
cpt { controls } _ = do
-- empty for now because the button is moved to the side panel
pure $ H.div {} []
-- H.ul { className: "nav navbar-nav" } [
-- H.li {} [
-- sidePanelToggleButton { state: controls.showSidePanel } []
-- ]
-- ] -- head (goes to top bar)
--------------------------------------------------------
type CommonProps = (
nodeId :: Int
, reloadForest :: T.Cursor T2.Reload
, reloadRoot :: T.Cursor T2.Reload
topBarCpt = here.component "topBar" cpt where
cpt { controls } _ = do
-- empty for now because the button is moved to the side panel
pure $ H.div {} []
-- H.ul { className: "nav navbar-nav" } [
-- H.li {} [
-- sidePanelToggleButton { state: controls.showSidePanel } []
-- ]
-- ] -- head (goes to top bar)
type CommonProps =
( nodeId :: Int
, reloadForest :: T.Box T2.Reload
, reloadRoot :: T.Box T2.Reload
, session :: Session
, sessionUpdate :: Session -> Effect Unit
, tasks :: T.Cursor (Maybe GAT.Reductor)
, tasks :: T.Box (Maybe GAT.Reductor)
)
type Props = (
controls :: Record ListsLayoutControls
| CommonProps
)
type Props = ( controls :: Record ListsLayoutControls | CommonProps )
type WithTreeProps = (
handed :: GT.Handed
| Props
)
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 path@{ nodeId, session } _ = do
let sid = sessionId session
pure $ listsLayoutWithKey $ Record.merge path { key: show sid <> "-" <> show nodeId }
listsLayoutCpt = here.component "listsLayout" cpt where
cpt path@{ nodeId, session } _ = do
let sid = sessionId session
pure $ listsLayoutWithKey $ Record.merge path { key: show sid <> "-" <> show nodeId }
type KeyProps = (
key :: String
| Props
)
type KeyProps = ( key :: String | Props )
listsLayoutWithKey :: Record KeyProps -> R.Element
listsLayoutWithKey props = R.createElement listsLayoutWithKeyCpt props []
listsLayoutWithKeyCpt :: R.Component KeyProps
listsLayoutWithKeyCpt = here.component "listsLayoutWithKey" cpt
where
cpt { controls
, nodeId
, reloadForest
, reloadRoot
, session
, sessionUpdate
, tasks } _ = do
listsLayoutWithKeyCpt = here.component "listsLayoutWithKey" cpt where
cpt { controls, nodeId, reloadForest, reloadRoot, session, sessionUpdate, tasks } _ = do
let path = { nodeId, session }
cacheState <- R.useState' $ getCacheState CacheOn session nodeId
......@@ -157,10 +132,9 @@ listsLayoutWithKeyCpt = here.component "listsLayoutWithKey" cpt
afterCacheStateChange cacheState = do
launchAff_ $ clearCache unit
sessionUpdate $ setCacheState session nodeId cacheState
------------------------------------------------------------------------
type SidePanelProps = (
controls :: Record ListsLayoutControls
type SidePanelProps =
( controls :: Record ListsLayoutControls
, session :: Session
)
......@@ -168,52 +142,36 @@ sidePanel :: R2.Component SidePanelProps
sidePanel = R.createElement sidePanelCpt
sidePanelCpt :: R.Component SidePanelProps
sidePanelCpt = here.component "sidePanel" cpt
where
cpt { controls: { triggers: { toggleSidePanel
, triggerSidePanel
} }
, session } _ = do
showSidePanel <- R.useState' InitialClosed
R.useEffect' $ do
let toggleSidePanel' _ = snd showSidePanel toggleSidePanelState
triggerSidePanel' _ = snd showSidePanel $ 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
let mainStyle = case fst showSidePanel of
Opened -> { display: "block" }
_ -> { display: "none" }
let closeSidePanel _ = do
snd showSidePanel $ const Closed
pure $ H.div { style: mainStyle } [
H.div { className: "header" } [
H.span { className: "btn btn-danger"
, on: { click: closeSidePanel } } [
H.span { className: "fa fa-times" } []
]
]
sidePanelCpt = here.component "sidePanel" cpt where
cpt { controls: { triggers: { toggleSidePanel, triggerSidePanel } }
, session } _ = do
showSidePanel <- R.useState' InitialClosed
R.useEffect' $ do
let toggleSidePanel' _ = snd showSidePanel toggleSidePanelState
triggerSidePanel' _ = snd showSidePanel $ 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
let mainStyle = case fst showSidePanel of
Opened -> { display: "block" }
_ -> { display: "none" }
let closeSidePanel _ = snd showSidePanel $ const Closed
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
)
type SidePanelDocView = ( session :: Session )
sidePanelDocView :: R2.Component SidePanelDocView
sidePanelDocView = R.createElement sidePanelDocViewCpt
sidePanelDocViewCpt :: R.Component SidePanelDocView
sidePanelDocViewCpt = here.component "sidePanelDocView" cpt
where
cpt { session } _ = do
-- pure $ H.h4 {} [ H.text txt ]
pure $ H.div {} [ H.text "Hello ngrams" ]
sidePanelDocViewCpt = here.component "sidePanelDocView" cpt where
cpt { session } _ = do
-- pure $ H.h4 {} [ H.text txt ]
pure $ H.div {} [ H.text "Hello ngrams" ]
module Gargantext.Components.Nodes.Lists.Tabs where
import Gargantext.Prelude (bind, pure, unit, ($), (<>))
import Data.Array as A
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple (fst)
......@@ -11,7 +12,6 @@ import Record as Record
import Record.Extra as RX
import Toestand as T
import Gargantext.Prelude
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.NgramsTable as NT
......@@ -20,12 +20,12 @@ import Gargantext.Components.Nodes.Corpus.Types (CorpusData)
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 (getChartFunction)
import Gargantext.Components.Nodes.Corpus.Chart.Utils (mNgramsTypeFromTabType)
import Gargantext.Components.Nodes.Lists.Types
import Gargantext.Components.Nodes.Lists.Types (CacheState, SidePanelTriggers)
import Gargantext.Components.Tab as Tab
import Gargantext.Sessions (Session)
import Gargantext.Types (ChartType(..), CTabNgramType(..), Mode(..), TabSubType(..), TabType(..), chartTypeFromString, modeTabType)
import Gargantext.Types
( ChartType(..), CTabNgramType(..), Mode(..), TabSubType(..), TabType(..), modeTabType )
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reload as GUR
import Gargantext.Utils.Toestand as T2
......@@ -37,11 +37,11 @@ type Props = (
cacheState :: R.State CacheState
, corpusData :: CorpusData
, corpusId :: Int
, reloadForest :: T.Cursor T2.Reload
, reloadRoot :: T.Cursor T2.Reload
, reloadForest :: T.Box T2.Reload
, reloadRoot :: T.Box T2.Reload
, session :: Session
, sidePanelTriggers :: Record SidePanelTriggers
, tasks :: T.Cursor (Maybe GAT.Reductor)
, tasks :: T.Box (Maybe GAT.Reductor)
)
type PropsWithKey = ( key :: String | Props )
......
module Gargantext.Components.Nodes.Texts where
import Prelude
( class Eq, class Show, Unit, bind, const, discard
, pure, show, unit, ($), (&&), (<>), (==) )
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..))
import Data.Tuple (fst, snd)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log, log2)
import Effect (Effect)
import Effect.Aff (launchAff_)
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
--------------------------------------------------------
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.DocsTable as DT
import Gargantext.Components.Forest as Forest
import Gargantext.Components.Loader (loader)
......@@ -22,15 +22,18 @@ 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, Hyperdata(..), getCorpusInfo, CorpusInfo(..))
import Gargantext.Components.Nodes.Corpus.Types
( CorpusData, Hyperdata(..), getCorpusInfo, CorpusInfo(..) )
import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Nodes.Texts.SidePanelToggleButton (sidePanelToggleButton)
import Gargantext.Components.Nodes.Texts.Types
( SidePanelState(..), SidePanelTriggers, TextsLayoutControls
, TriggerAnnotatedDocIdChangeParams, initialControls, toggleSidePanelState )
import Gargantext.Components.Tab as Tab
import Gargantext.Components.Table as Table
import Gargantext.Ends (Frontends)
import Gargantext.Sessions (Session, Sessions, sessionId, getCacheState, setCacheState)
import Gargantext.Types (CTabNgramType(..), Handed(..), ListId, NodeID, TabSubType(..), TabType(..))
import Gargantext.Sessions (Session, sessionId, getCacheState)
import Gargantext.Types (CTabNgramType(..), ListId, NodeID, TabSubType(..), TabType(..))
import Gargantext.Utils.Reactix as R2
here :: R2.Here
......
......@@ -19,11 +19,9 @@ import DOM.Simple.EventListener as EL
import DOM.Simple (DOMRect)
import Global (toFixed)
import Effect (Effect)
import Effect.Uncurried (mkEffectFn1)
import Math as M
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
import Gargantext.Utils.Math (roundToMultiple)
import Gargantext.Utils.Range as Range
......
This diff is collapsed.
module Gargantext.Components.Search where
------------------------------------------------------------------------
import Gargantext.Prelude (class Eq, class Show)
import Data.Argonaut as Argonaut
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..))
import Gargantext.Prelude (class Eq, class Read, class Show)
import Data.Maybe (Maybe)
import Gargantext.Components.Category.Types (Category)
import Gargantext.Utils.Argonaut (genericSumDecodeJson, genericSumEncodeJson, genericEnumDecodeJson, genericEnumEncodeJson)
import Gargantext.Utils.Toestand as T2
-- Example:
-- [["machine","learning"],["artificial","intelligence"]]
......@@ -30,10 +25,7 @@ instance encodeJsonSearchType :: Argonaut.EncodeJson SearchType where
encodeJson = genericEnumEncodeJson
------------------------------------------------------------------------
data SearchQuery =
SearchQuery { query :: Array String
, expected :: SearchType
}
data SearchQuery = SearchQuery { query :: Array String, expected :: SearchType }
derive instance eqSearchQuery :: Eq SearchQuery
derive instance genericSearchQuery :: Generic SearchQuery _
......
......@@ -23,7 +23,7 @@ type Props =
fallback :: R.Element
, context :: R.Context Session
, sessionId :: SessionId
, sessions :: T.Cursor Sessions
, sessions :: T.Box Sessions
)
sessionWrapper :: R2.Component Props
......
......@@ -16,7 +16,7 @@ here = R2.here "Gargantext.Components.SimpleLayout"
-- Simple layout does not accommodate the tree
type SimpleLayoutProps = (
handed :: T.Cursor GT.Handed
handed :: T.Box GT.Handed
)
simpleLayout :: R2.Component SimpleLayoutProps
......
module Gargantext.Components.Table.Types where
import Prelude
import Prelude (class Eq, class Show, (<>))
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..))
import Data.Maybe (Maybe)
import Data.Sequence as Seq
import Data.Tuple (fst, snd)
import Effect.Aff (Aff, launchAff_)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Gargantext.Sessions (Session, get)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Components.Search
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Reactix (effectLink)
import Gargantext.Components.Search (SearchType)
import Data.Generic.Rep (class Generic)
type Params = { limit :: Int
, offset :: Int
, orderBy :: OrderBy
......@@ -36,8 +25,6 @@ orderByToForm :: OrderByDirection ColumnName -> String
orderByToForm (ASC (ColumnName x)) = x <> "Asc"
orderByToForm (DESC (ColumnName x)) = x <> "Desc"
newtype ColumnName = ColumnName String
derive instance genericColumnName :: Generic ColumnName _
instance showColumnName :: Show ColumnName where
......@@ -46,7 +33,6 @@ derive instance eqColumnName :: Eq ColumnName
columnName :: ColumnName -> String
columnName (ColumnName c) = c
type Props =
( syncResetButton :: Array R.Element
, colNames :: Array ColumnName
......@@ -66,8 +52,6 @@ type TableContainerProps =
, tableBody :: Array R.Element
)
type Row = { row :: R.Element, delete :: Boolean }
type Rows = Seq.Seq Row
module Gargantext.Components.TopBar where
import Data.Array (reverse)
import Data.Foldable (intercalate)
import Data.Tuple (fst)
import Data.Tuple.Nested ((/\))
import Reactix as R
import Reactix.DOM.HTML as H
......@@ -13,14 +11,11 @@ import Gargantext.Prelude
import Gargantext.Components.Themes (themeSwitcher, defaultTheme, allThemes)
import Gargantext.Types (Handed(..), reverseHanded)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
here :: R2.Here
here = R2.here "Gargantext.Components.TopBar"
type TopBarProps = (
handed :: T.Cursor Handed
)
type TopBarProps = ( handed :: T.Box Handed )
topBar :: R2.Component TopBarProps
topBar = R.createElement topBarCpt
......@@ -229,7 +224,7 @@ liNav (LiNav { title : title'
type HandedChooserProps = (
handed :: T.Cursor Handed
handed :: T.Box Handed
)
handedChooser :: R2.Component HandedChooserProps
......@@ -249,6 +244,6 @@ handedChooserCpt = here.component "handedChooser" cpt
handedClass LeftHanded = "fa fa-hand-o-left"
handedClass RightHanded = "fa fa-hand-o-right"
onClick handed = T2.modify_ (\h -> case h of
onClick handed = T.modify_ (\h -> case h of
LeftHanded -> RightHanded
RightHanded -> LeftHanded) handed
module Gargantext.Hooks ( useHashRouter ) where
import Prelude (Unit, void, ($))
import Prelude (Unit, ($))
import Reactix as R
import Routing.Match (Match)
import Routing.Hash (matches)
import Toestand as T
import Gargantext.Utils.Toestand as T2
-- | 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 = T2.write_ new cell
h _old new = T.write_ new cell
-- useSession cell =
module Gargantext.Hooks.Sigmax
where
import Prelude (Unit, bind, discard, flip, pure, unit, ($), (*>), (<<<), (<>), (>>=), (&&), not, const, map)
import Prelude
( Unit, bind, discard, flip, map, not, pure, unit
, ($), (&&), (*>), (<<<), (<>), (>>=))
import Data.Array as A
import Data.Either (either)
import Data.Foldable (sequence_, foldl)
......@@ -27,7 +28,6 @@ import Toestand as T
import Gargantext.Hooks.Sigmax.Sigma as Sigma
import Gargantext.Hooks.Sigmax.Types as ST
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
type Sigma =
{ sigma :: R.Ref (Maybe Sigma.Sigma)
......@@ -114,7 +114,7 @@ dependOnContainer container notFoundMsg f = do
-- | pausing can be done not only via buttons but also from the initial
-- | setTimer.
--handleForceAtlasPause sigmaRef (toggled /\ setToggled) mFAPauseRef = do
handleForceAtlas2Pause :: R.Ref Sigma -> T.Cursor ST.ForceAtlasState -> R.Ref (Maybe TimeoutId) -> Effect Unit
handleForceAtlas2Pause :: R.Ref Sigma -> T.Box ST.ForceAtlasState -> R.Ref (Maybe TimeoutId) -> Effect Unit
handleForceAtlas2Pause sigmaRef forceAtlasState mFAPauseRef = do
let sigma = R.readRef sigmaRef
toggled <- T.read forceAtlasState
......@@ -192,15 +192,15 @@ multiSelectUpdate new selected = foldl fld selected new
Set.insert item selectedAcc
bindSelectedNodesClick :: Sigma.Sigma -> T.Cursor ST.NodeIds -> R.Ref Boolean -> Effect Unit
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
T2.modify_ (multiSelectUpdate nodeIds) selectedNodeIds
T.modify_ (multiSelectUpdate nodeIds) selectedNodeIds
else
T2.write_ nodeIds selectedNodeIds
T.write_ nodeIds selectedNodeIds
bindSelectedEdgesClick :: R.Ref Sigma -> R.State ST.EdgeIds -> Effect Unit
bindSelectedEdgesClick sigmaRef (_ /\ setEdgeIds) =
......
......@@ -24,7 +24,7 @@ import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (Aff)
import Prelude
( Unit, bind, discard, otherwise, pure, unit, ($), (*>), (<$>), (<*), (>>=))
( Unit, bind, otherwise, pure, unit, ($), (*>), (<$>), (<*), (>>=))
import Toestand as T
import Web.Storage.Storage (getItem, removeItem, setItem)
......@@ -34,7 +34,6 @@ import Gargantext.Components.Nodes.Lists.Types as NT
import Gargantext.Config.REST as REST
import Gargantext.Ends (class ToUrl, Backend, toUrl)
import Gargantext.Utils.Reactix (getls)
import Gargantext.Utils.Toestand as T2
load :: forall c. T.Write c Sessions => c -> Effect Sessions
load cell = do
......
......@@ -2,23 +2,19 @@ module Gargantext.Utils.CacheAPI where
import Control.Monad.Except (runExcept)
import Control.Promise (Promise, toAffE)
import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson, (:=), (~>), (.:), fromString)
import Data.Argonaut (class DecodeJson, decodeJson)
import Data.Either (Either(..))
import Data.Function.Uncurried (Fn3)
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (Aff, throwError)
import Effect.Aff.Compat (EffectFnAff, fromEffectFnAff)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Foreign as F
import Foreign.Object as O
import Milkis as M
import Type.Row (class Union)
import Gargantext.Prelude
import Gargantext.Prelude hiding (add)
import Gargantext.Ends (class ToUrl, toUrl)
import Gargantext.Sessions (Session(..))
......
......@@ -2,14 +2,11 @@ module Gargantext.Utils.Reload where
import Gargantext.Prelude
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Reactix as R
import Toestand as T
import Gargantext.Utils.Toestand as T2
type Reload = Int
type ReloadS = R.State Reload
type ReloadSRef = R.Ref
......@@ -20,11 +17,8 @@ new = R.useState' 0
bump :: ReloadS -> Effect Unit
bump (_ /\ setReload) = setReload (_ + 1)
bumpCursor :: T.Cursor Reload -> Effect Unit
bumpCursor c = T2.modify_ (_ + 1) c
bumpCell :: T.Cell Reload -> Effect Unit
bumpCell c = T2.modify_ (_ + 1) c
bumpBox :: T.Box Reload -> Effect Unit
bumpBox c = T.modify_ (_ + 1) c
value :: ReloadS -> Reload
value (val /\ _) = val
......
module Gargantext.Utils.Toestand
( class Reloadable, reload
, Reload, newReload, InitReload(..), ready
, useCursed, useIdentityCursor, useMemberCursor
, write_, modify_
) where
( class Reloadable, reload, Reload, newReload, InitReload(..), ready, useMemberBox )
where
import Prelude (class Eq, class Ord, Unit, bind, identity, pure, unit, void, ($), (+), (>>=))
import Prelude (class Ord, Unit, bind, pure, unit, (+))
import Data.Set as Set
import Data.Set (Set)
import Effect (Effect)
......@@ -22,62 +19,38 @@ class Reloadable t where
newReload :: Reload
newReload = 0
instance reloadableCellReload :: Reloadable (T.Cell Int) where
reload cell = modify_ (_ + 1) cell
instance reloadableBoxReload :: Reloadable (T.Box Int) where
reload box = T.modify_ (_ + 1) box
instance reloadableCursorReload :: Reloadable (T.Cursor Int) where
reload cell = modify_ (_ + 1) cell
instance reloadableInitReloadCell :: Reloadable (c Reload) => Reloadable (T.Cell (InitReload c)) where
reload cell = do
val <- T.read cell
case val of
Init -> pure unit
Ready r -> reload r
instance reloadableInitReloadCursor :: Reloadable (c Reload) => Reloadable (T.Cursor (InitReload c)) where
reload cell = do
val <- T.read cell
instance reloadableInitReloadBox :: 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
-- c is a cell or cursor wrapping a Reload
data InitReload (c :: Type -> Type) = Init | Ready (c Reload)
-- inner is a Box wrapping a Reload
data InitReload (inner :: Type -> Type) = Init | Ready (inner Reload)
-- | Initialises an InitReload cell with the Reload cell it contains,
-- | Initialises an InitReload box with the Reload box it contains,
-- | if it has not already been initialised.
ready :: forall cell c. T.ReadWrite cell (InitReload c) => T.ReadWrite (c Reload) Reload
=> cell -> (c Reload) -> Effect Unit
ready cell with = do
val <- T.read cell
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 -> write_ (Ready with) cell
Init -> T.write_ (Ready with) box
Ready _ -> pure unit
-- | Turns a Cell into a Cursor.
useIdentityCursor :: forall cell c. T.ReadWrite cell c => cell -> R.Hooks (T.Cursor c)
useIdentityCursor = T.useCursor identity (\a _ -> a)
-- | Creates a cursor directly from a value by creating a cell first.
useCursed :: forall t. t -> R.Hooks (T.Cursor t)
useCursed val = T.useCell val >>= useIdentityCursor
-- | 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.
useMemberCursor
:: forall cell v. Ord v => T.ReadWrite cell (Set v)
=> v -> cell -> R.Hooks (T.Cursor Boolean)
useMemberCursor val cell = T.useCursor (Set.member val) (toggleSet val) cell
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 useMemberCursor
-- 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
modify_ :: forall cell val. T.ReadWrite cell val => (val -> val) -> cell -> Effect Unit
modify_ f cell = void $ T.modify f cell
write_ :: forall cell val. T.Write cell val => val -> cell -> Effect Unit
write_ val cell = void $ T.write val cell
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment