Commit 78d116d9 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Merge branch 'dev' into 395-dev-ps-0.15-update

parents 48649410 d88f3037
# Contributor Covenant Code of Conduct # GarganText "Code of Conduct"
## Our Pledge The GarganText Project, the contributors of the GarganText eco-system,
have adopted a code of conduct for participants to any modes of
In the interest of fostering an open and welcoming environment, we as communication within the project.
contributors and maintainers pledge to making participation in our project and
our community a harassment-free experience for everyone, regardless of age, body ## Be respectful
size, disability, ethnicity, gender identity and expression, level of experience,
nationality, personal appearance, race, religion, or sexual identity and In a project the size of GarganText, inevitably there will be people
orientation. with whom you may disagree, or find it difficult to cooperate. Accept
that, but even so, remain respectful. Disagreement is no excuse for poor
## Our Standards behaviour or personal attacks, and a community in which people feel
threatened is not a healthy community.
Examples of behavior that contributes to creating a positive environment
include: ## Assume good faith
* Using welcoming and inclusive language GarganText Contributors have many ways of reaching our common goal of
* Being respectful of differing viewpoints and experiences a free digital ecosystem which may differ from your ways. Assume that
* Gracefully accepting constructive criticism other people are working towards this goal.
* Focusing on what is best for the community
* Showing empathy towards other community members Note that many of our Contributors are not native English speakers
or may have different cultural backgrounds.
Examples of unacceptable behavior by participants include:
## Be collaborative
* The use of sexualized language or imagery and unwelcome sexual attention or
advances GarganText is a large and complex project; there is always more to
* Trolling, insulting/derogatory comments, and personal or political attacks learn within GarganText. It's good to ask for help when you need it.
* Public or private harassment Similarly, offers for help should be seen in the context of our shared
* Publishing others' private information, such as a physical or electronic goal of improving GarganText.
address, without explicit permission
* Other conduct which could reasonably be considered inappropriate in a When you make something for the benefit of the project, be willing
professional setting to explain to others how it works, so that they can build on your work
to make it even better.
## Our Responsibilities
## Try to be concise
Project maintainers are responsible for clarifying the standards of acceptable
behavior and are expected to take appropriate and fair corrective action in Keep in mind that what you write once will be read by many others
response to any instances of unacceptable behavior. persons. Writing a short email means people can understand the
conversation as efficiently as possible. When a long explanation is
Project maintainers have the right and responsibility to remove, edit, or necessary, consider adding a summary.
reject comments, commits, code, wiki edits, issues, and other contributions
that are not aligned to this Code of Conduct, or to ban temporarily or Try to bring new arguments to a conversation so that each comment
permanently any contributor for other behaviors that they deem inappropriate, adds something unique to the thread, keeping in mind that the rest of
threatening, offensive, or harmful. the thread still contains the other messages with arguments that have
already been made.
## Scope
Try to stay on topic, especially in discussions that are already
This Code of Conduct applies both within project spaces and in public spaces fairly large.
when an individual is representing the project or its community. Examples of
representing a project or community include using an official project e-mail ## Be open
address, posting via an official social media account, or acting as an appointed
representative at an online or offline event. Representation of a project may be Most ways of communication used within GarganText allow for public and
further defined and clarified by project maintainers. private communication. You should preferably use public methods of
communication for GarganText-related messages, unless posting something
## Enforcement sensitive.
Instances of abusive, harassing, or otherwise unacceptable behavior may be This applies to messages for help or GarganText-related support,
reported by contacting the project team at [sos AT gargantext DOT org]. All too; not only is a public support request much more likely to
complaints will be reviewed and investigated and will result in a response that result in an answer to your question, it also makes sure that any
is deemed necessary and appropriate to the circumstances. The project team is inadvertent mistakes made by people answering your question will be
obligated to maintain confidentiality with regard to the reporter of an incident. more easily detected and corrected.
Further details of specific enforcement policies may be posted separately.
While this code of conduct should be adhered to by participants,
Project maintainers who do not follow or enforce the Code of Conduct in good we recognize that sometimes people may have a bad day, or be unaware
faith may face temporary or permanent repercussions as determined by other of some of the guidelines in this code of conduct. When that happens,
members of the project's leadership. you may reply to them and point out this code of conduct. Such messages
may be in public or in private, whatever is most appropriate. However,
## Attribution regardless of whether the message is public or not, it should still
adhere to the relevant parts of this code of conduct; in particular, it
This Code of Conduct is adapted from the [Contributor Covenant][homepage], version 1.4, should not be abusive or disrespectful. Assume good faith; it is more
available at [http://contributor-covenant.org/version/1/4][version] likely that participants are unaware of their bad behaviour than that
they intentionally try to degrade the quality of the discussion.
[homepage]: http://contributor-covenant.org
[version]: http://contributor-covenant.org/version/1/4/ Serious or persistent offenders will be temporarily or permanently
banned from communicating through GarganText's ecosystem. Complaints
should be made (in private) to the administrators of the GarganText
communication forum in question. To find contact information for these
administrators, please see the page on GarganText's organizational
structure.
...@@ -12,6 +12,8 @@ ...@@ -12,6 +12,8 @@
<body> <body>
<div id="app"></div> <div id="app"></div>
<div id="portal"></div> <div id="portal"></div>
<script src="js/jquery@3.5.1/jquery.slim.min.js"></script>
<script src="js/bootstrap@4.6.2/bootstrap.bundle.min.js"></script>
<script src="bundle.js"></script> <script src="bundle.js"></script>
</body> </body>
</html> </html>
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
{ pkgs ? import ./pinned.nix { } }: { pkgs ? import ./pinned.nix { } }:
import import /home/przemek/git-work/github/easy-purescript-nix
( # (
pkgs.fetchFromGitHub { # pkgs.fetchFromGitHub {
owner = "justinwoo"; # owner = "justinwoo";
repo = "easy-purescript-nix"; # repo = "easy-purescript-nix";
rev = "0ad5775c1e80cdd952527db2da969982e39ff592"; # rev = "5dca2f0f3b9ec0bceabb23fa1fd2b5f8ec30fa53";
sha256 = "bwbpXSTD8Hf7tlCXfZuLfo2QivvX1ZDJ1PijXXRTo3Q="; # sha256 = "1vsc08ik9rs7vhnv8bg6bqf6gyqvywjfr5502rw1wpird74whhcs";
} # }
) { # ) {
{
inherit pkgs; inherit pkgs;
} }
{ {
"name": "Gargantext", "name": "Gargantext",
"version": "0.0.5.8.9", "version": "0.0.5.9.6",
"scripts": { "scripts": {
"generate-purs-packages-nix": "./nix/generate-purs-packages.nix", "generate-purs-packages-nix": "./nix/generate-purs-packages.nix",
"generate-psc-packages-nix": "./nix/generate-packages-json.bash", "generate-psc-packages-nix": "./nix/generate-packages-json.bash",
......
This diff is collapsed.
...@@ -108,7 +108,7 @@ let ...@@ -108,7 +108,7 @@ let
in in
pkgs.mkShell { pkgs.mkShell {
buildInputs = [ buildInputs = [
easy-ps.purs-0_15_0 easy-ps.purs-0_15_4
easy-ps.psc-package easy-ps.psc-package
easy-ps.dhall-json-simple easy-ps.dhall-json-simple
easy-ps.zephyr easy-ps.zephyr
......
...@@ -9,38 +9,40 @@ ...@@ -9,38 +9,40 @@
-- | -- |
-- | 1. We must only re-search the text when the ngrams change for performance -- | 1. We must only re-search the text when the ngrams change for performance
-- | 2. We will need a more ambitious search algorithm for skipgrams. -- | 2. We will need a more ambitious search algorithm for skipgrams.
module Gargantext.Components.Annotation.AnnotatedField where module Gargantext.Components.Annotation.Field where
import Gargantext.Prelude
import DOM.Simple.Event as DE
import Data.Array as A import Data.Array as A
import Data.List (List(..), (:)) import Data.List (List(..), (:))
import Data.Maybe ( Maybe(..), maybe ) import Data.Maybe (Maybe(..), maybe)
import Data.String.Common ( joinWith ) import Data.String.Common (joinWith)
import Data.Tuple (Tuple(..), snd) import Data.Tuple (Tuple(..), snd)
import Data.Tuple.Nested ( (/\) ) import Data.Tuple.Nested ((/\))
import DOM.Simple.Event as DE
import Effect (Effect) import Effect (Effect)
import Gargantext.Components.Annotation.Menu (annotationMenu, AnnotationMenu)
import Gargantext.Components.Annotation.Types (MenuType(..), ModeType(..), termClass)
import Gargantext.Core.NgramsTable.Functions (findNgramTermList, highlightNgrams, normNgram)
import Gargantext.Core.NgramsTable.Types (NgramsTable, NgramsTerm)
import Gargantext.Types (CTabNgramType(..), TermList)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Selection as Sel
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as HTML import Reactix.DOM.HTML as H
import Reactix.SyntheticEvent as E import Reactix.SyntheticEvent as E
import Record as Record import Record as Record
import Toestand as T import Toestand as T
import Gargantext.Prelude
import Gargantext.Components.Annotation.Menu ( annotationMenuWrapper, AnnotationMenu, MenuType(..) )
import Gargantext.Components.Annotation.Utils (termClass)
import Gargantext.Components.NgramsTable.Core (NgramsTable, NgramsTerm, findNgramTermList, highlightNgrams, normNgram)
import Gargantext.Types (CTabNgramType(..), TermList)
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Selection as Sel
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Annotation.AnnotatedField" here = R2.here "Gargantext.Components.Annotation.AnnotatedField"
-- @NOTE #386: add parameter "type" ("Authors", "Terms")
type Props = type Props =
( ngrams :: NgramsTable ( ngrams :: NgramsTable
, setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit , setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit
, text :: Maybe String , text :: Maybe String
, mode :: ModeType
) )
type MouseEvent = E.SyntheticEvent DE.MouseEvent type MouseEvent = E.SyntheticEvent DE.MouseEvent
...@@ -48,8 +50,9 @@ type MouseEvent = E.SyntheticEvent DE.MouseEvent ...@@ -48,8 +50,9 @@ type MouseEvent = E.SyntheticEvent DE.MouseEvent
-- defaultProps :: Record Props -- defaultProps :: Record Props
-- defaultProps = { ngrams: NgramsTable Map.empty, text: Nothing, setTermList: \_ _ _ -> pure unit } -- defaultProps = { ngrams: NgramsTable Map.empty, text: Nothing, setTermList: \_ _ _ -> pure unit }
annotatedField :: R2.Component Props annotatedField :: R2.Leaf Props
annotatedField = R.createElement annotatedFieldCpt annotatedField = R2.leaf annotatedFieldCpt
annotatedFieldCpt :: R.Component Props annotatedFieldCpt :: R.Component Props
annotatedFieldCpt = here.component "annotatedField" cpt where annotatedFieldCpt = here.component "annotatedField" cpt where
cpt props _ = do cpt props _ = do
...@@ -58,18 +61,20 @@ annotatedFieldCpt = here.component "annotatedField" cpt where ...@@ -58,18 +61,20 @@ annotatedFieldCpt = here.component "annotatedField" cpt where
pure $ annotatedFieldInner (Record.merge { menuRef, redrawMenu } props) pure $ annotatedFieldInner (Record.merge { menuRef, redrawMenu } props)
-----------------------------------------------------------------
type InnerProps = type InnerProps =
( ( menuRef :: R.Ref (Maybe (Record AnnotationMenu))
menuRef :: R.Ref (Maybe (Record AnnotationMenu))
, redrawMenu :: T.Box Boolean , redrawMenu :: T.Box Boolean
| Props | Props
) )
annotatedFieldInner :: R2.Leaf InnerProps annotatedFieldInner :: R2.Leaf InnerProps
annotatedFieldInner = R2.leafComponent annotatedFieldInnerCpt annotatedFieldInner = R2.leafComponent annotatedFieldInnerCpt
annotatedFieldInnerCpt :: R.Component InnerProps annotatedFieldInnerCpt :: R.Component InnerProps
annotatedFieldInnerCpt = here.component "annotatedFieldInner" cpt where annotatedFieldInnerCpt = here.component "annotatedFieldInner" cpt where
cpt { menuRef, ngrams, redrawMenu, setTermList, text: fieldText } _ = do cpt { menuRef, ngrams, redrawMenu, setTermList, text: fieldText, mode } _ = do
_redrawMenu' <- T.useLive T.unequal redrawMenu _redrawMenu' <- T.useLive T.unequal redrawMenu
-- menu <- T.useBox (Nothing :: Maybe (Record AnnotationMenu)) -- menu <- T.useBox (Nothing :: Maybe (Record AnnotationMenu))
...@@ -78,23 +83,63 @@ annotatedFieldInnerCpt = here.component "annotatedFieldInner" cpt where ...@@ -78,23 +83,63 @@ annotatedFieldInnerCpt = here.component "annotatedFieldInner" cpt where
, onSelect: onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList } , onSelect: onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList }
, text } , text }
pure $ HTML.div { className: "annotated-field-wrapper" } pure $
[ annotationMenuWrapper { menuRef }
, HTML.div { className: "annotated-field-runs" } H.div
((\p -> annotateRun p []) <$> wrap <$> compile ngrams fieldText) { className: "annotated-field-wrapper" }
[
annotationMenu { menuRef }
,
case mode of
EditionMode ->
H.div
{ className: "annotated-field-runs" }
((\p -> annotateRun p) <$> wrap <$> compile ngrams fieldText)
AdditionMode ->
R2.fromMaybe fieldText \t ->
H.div
{ className: "annotated-field-runs" }
[
annotateRun
{ list: mempty
, text: t
, onSelect: onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList }
}
]
] ]
compile :: NgramsTable -> Maybe String -> Array (Tuple String (List (Tuple NgramsTerm TermList))) -----------------------------------------------------------
compile ::
NgramsTable
-> Maybe String
-> Array (Tuple String (List (Tuple NgramsTerm TermList)))
compile ngrams = maybe [] (highlightNgrams CTabTerms ngrams) compile ngrams = maybe [] (highlightNgrams CTabTerms ngrams)
-- Runs -- Runs
onAnnotationSelect :: forall e. DE.IsMouseEvent e => { menuRef :: R.Ref (Maybe (Record AnnotationMenu)) onAnnotationSelect :: forall e.
DE.IsMouseEvent e
=> { menuRef :: R.Ref (Maybe (Record AnnotationMenu))
, ngrams :: NgramsTable , ngrams :: NgramsTable
, redrawMenu :: T.Box Boolean , redrawMenu :: T.Box Boolean
, setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit } , setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit
-> Maybe (Tuple NgramsTerm TermList) -> E.SyntheticEvent e -> Effect Unit }
onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList } Nothing event = do -> Maybe (Tuple NgramsTerm TermList)
-> E.SyntheticEvent e
-> Effect Unit
onAnnotationSelect
{ menuRef, ngrams, redrawMenu, setTermList }
Nothing
event
= do
s <- Sel.getSelection s <- Sel.getSelection
case s of case s of
Just sel -> do Just sel -> do
...@@ -109,25 +154,36 @@ onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList } Nothing event = ...@@ -109,25 +154,36 @@ onAnnotationSelect { menuRef, ngrams, redrawMenu, setTermList } Nothing event =
, redrawMenu , redrawMenu
, setTermList } , setTermList }
Nothing -> hideMenu { menuRef, redrawMenu } Nothing -> hideMenu { menuRef, redrawMenu }
onAnnotationSelect { menuRef, redrawMenu, setTermList } (Just (Tuple ngram list)) event = do
showMenu { event onAnnotationSelect
{ menuRef, redrawMenu, setTermList }
(Just (Tuple ngram list))
event
= showMenu
{ event
, getList: const (Just list) , getList: const (Just list)
, menuRef , menuRef
, menuType: SetTermListItem , menuType: SetTermListItem
, ngram , ngram
, redrawMenu , redrawMenu
, setTermList } , setTermList
}
-- showMenu :: forall p e. DE.IsMouseEvent e => { event :: E.SyntheticEvent e | p } -> Effect Unit -- showMenu :: forall p e. DE.IsMouseEvent e => { event :: E.SyntheticEvent e | p } -> Effect Unit
showMenu :: forall e. DE.IsMouseEvent e => { event :: E.SyntheticEvent e showMenu :: forall e.
DE.IsMouseEvent e
=> { event :: E.SyntheticEvent e
, getList :: NgramsTerm -> Maybe TermList , getList :: NgramsTerm -> Maybe TermList
, menuRef :: R.Ref (Maybe (Record AnnotationMenu)) , menuRef :: R.Ref (Maybe (Record AnnotationMenu))
, menuType :: MenuType , menuType :: MenuType
, ngram :: NgramsTerm , ngram :: NgramsTerm
, redrawMenu :: T.Box Boolean , redrawMenu :: T.Box Boolean
, setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit } , setTermList :: NgramsTerm -> Maybe TermList -> TermList -> Effect Unit
}
-> Effect Unit -> Effect Unit
showMenu { event, getList, menuRef, menuType, ngram, redrawMenu, setTermList } = do showMenu
{ event, getList, menuRef, menuType, ngram, redrawMenu, setTermList }
= do
let x = E.clientX event let x = E.clientX event
y = E.clientY event y = E.clientY event
-- n = normNgram CTabTerms text -- n = normNgram CTabTerms text
...@@ -142,7 +198,7 @@ showMenu { event, getList, menuRef, menuType, ngram, redrawMenu, setTermList } = ...@@ -142,7 +198,7 @@ showMenu { event, getList, menuRef, menuType, ngram, redrawMenu, setTermList } =
let menu = Just let menu = Just
{ list { list
, menuType , menuType
, onClose: hideMenu { menuRef, redrawMenu } , closeCallback: const $ hideMenu { menuRef, redrawMenu }
, redrawMenu , redrawMenu
, setList , setList
, x , x
...@@ -150,30 +206,45 @@ showMenu { event, getList, menuRef, menuType, ngram, redrawMenu, setTermList } = ...@@ -150,30 +206,45 @@ showMenu { event, getList, menuRef, menuType, ngram, redrawMenu, setTermList } =
R.setRef menuRef menu R.setRef menuRef menu
T.modify_ not redrawMenu T.modify_ not redrawMenu
hideMenu ::
{ menuRef :: R.Ref (Maybe (Record AnnotationMenu))
, redrawMenu :: T.Box Boolean
}
-> Effect Unit
hideMenu { menuRef, redrawMenu } = do hideMenu { menuRef, redrawMenu } = do
R.setRef menuRef Nothing R.setRef menuRef Nothing
T.modify_ not redrawMenu T.modify_ not redrawMenu
type Run = --------------------------------------------------
type RunProps =
( list :: List (Tuple NgramsTerm TermList) ( list :: List (Tuple NgramsTerm TermList)
, onSelect :: Maybe (Tuple NgramsTerm TermList) -> MouseEvent -> Effect Unit , onSelect :: Maybe (Tuple NgramsTerm TermList) -> MouseEvent -> Effect Unit
, text :: String , text :: String
) )
annotateRun :: R2.Component Run annotateRun :: R2.Leaf RunProps
annotateRun = R.createElement annotatedRunCpt annotateRun = R2.leaf annotatedRunCpt
annotatedRunCpt :: R.Component Run
annotatedRunCpt = here.component "annotatedRun" cpt annotatedRunCpt :: R.Component RunProps
where annotatedRunCpt = here.component "annotatedRun" cpt where
cpt { list, onSelect, text } _ = do cpt { list, onSelect, text } _ = pure $ case list of
let el = case list of Nil ->
Nil -> HTML.span { on: { mouseUp: onSelect Nothing } } [ HTML.text text ] H.span
lst@(( ngram /\ list' ) : otherLists) -> { on: { mouseUp: onSelect Nothing }
let bgClasses = joinWith " " $ A.fromFoldable $ termClass <<< snd <$> lst }
className = "annotation-run " <> bgClasses [ H.text text ]
in
HTML.span { className
, on: { click: onSelect (Just (ngram /\ list')) } } [ HTML.text text ]
pure $ el lst@(( ngram /\ list' ) : _) ->
let
bgClasses
= joinWith " " $ A.fromFoldable $ termClass
<<< snd <$> lst
in
H.span
{ className: "annotation-run " <> bgClasses
, on: { click: onSelect (Just (ngram /\ list')) }
}
[ H.text text ]
-- | A ContextMenU that allows you to add terms to a list module Gargantext.Components.Annotation.Menu
module Gargantext.Components.Annotation.Menu where ( annotationMenu
, AnnotationMenu
) where
import Gargantext.Prelude
import Data.Array as A
import Data.Generic.Rep (class Generic)
import Data.Eq.Generic (genericEq)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.String (toLower)
import Effect (Effect) import Effect (Effect)
import Reactix as R import Gargantext.Components.Annotation.Types (MenuType(..), termClass)
import Reactix.DOM.HTML as HTML import Gargantext.Components.Bootstrap as B
import Toestand as T import Gargantext.Components.Bootstrap.Types (ComponentStatus(..))
import Gargantext.Prelude
import Gargantext.Types (TermList(..), termListName) import Gargantext.Types (TermList(..), termListName)
import Gargantext.Components.Annotation.Utils (termBootstrapClass)
import Gargantext.Components.ContextMenu.ContextMenu as CM
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
import Toestand as T
here :: R2.Here here :: R2.Here
here = R2.here "Gargantext.Components.Annotation.Menu" here = R2.here "Gargantext.Components.Annotation.Menu"
data MenuType = NewNgram | SetTermListItem
derive instance Generic MenuType _
instance Eq MenuType where
eq = genericEq
type Props = type Props =
( list :: Maybe TermList ( menuRef :: R.Ref (Maybe (Record AnnotationMenu))
, menuType :: MenuType
, setList :: TermList -> Effect Unit -- not a state hook setter
) )
type AnnotationMenu = ( type AnnotationMenu =
onClose :: Effect Unit ( closeCallback :: Unit -> Effect Unit
, redrawMenu :: T.Box Boolean , redrawMenu :: T.Box Boolean
, x :: Number , x :: Number
, y :: Number , y :: Number
| Props , list :: Maybe TermList
, menuType :: MenuType
, setList :: TermList -> Effect Unit -- not a state hook setter
) )
type AnnotationMenuWrapper = annotationMenu :: R2.Leaf Props
( annotationMenu = R2.leaf annotationMenuCpt
menuRef :: R.Ref (Maybe (Record AnnotationMenu))
)
eqAnnotationMenu :: Record AnnotationMenu -> Record AnnotationMenu -> Boolean annotationMenuCpt :: R.Component Props
eqAnnotationMenu new old = new.list == old.list && annotationMenuCpt = here.component "main" cpt where
new.menuType == old.menuType &&
new.x == old.x &&
new.y == old.y
eqAnnotationMenuWrapper :: { new :: Maybe (Record AnnotationMenu)
, old :: Maybe (Record AnnotationMenu) } -> Effect Boolean
eqAnnotationMenuWrapper { new: Nothing, old: Nothing } = pure $ true
eqAnnotationMenuWrapper { new: Nothing, old: Just _ } = pure $ false
eqAnnotationMenuWrapper { new: Just _, old: Nothing } = pure $ false
eqAnnotationMenuWrapper { new: Just n, old: Just o } = pure $ eqAnnotationMenu n o
annotationMenuWrapper :: R2.Leaf AnnotationMenuWrapper
annotationMenuWrapper = R2.leafComponent annotationMenuWrapperCpt
annotationMenuWrapperCpt :: R.Component AnnotationMenuWrapper
annotationMenuWrapperCpt = here.component "annotationMenuWrapper" cpt where
cpt { menuRef } _ = do cpt { menuRef } _ = do
case R.readRef menuRef of -- Render
Nothing -> pure $ HTML.div {} [] pure $
Just menu -> pure $ annotationMenu menu
R2.fromMaybe (R.readRef menuRef) \props' ->
-- | An Annotation Menu is parameterised by a Maybe Termlist of the
-- | TermList the currently selected text belongs to B.contextMenu
annotationMenu :: R2.Leaf AnnotationMenu { x: props'.x
annotationMenu = R2.leafComponent annotationMenuCpt , y: props'.y
annotationMenuCpt :: R.Component AnnotationMenu , closeCallback: props'.closeCallback
annotationMenuCpt = here.component "annotationMenu" cpt where } $
cpt { x, y, list, menuType, onClose, redrawMenu, setList } _ = do (addToList props') <$> [ MapTerm, CandidateTerm, StopTerm ]
redrawMenu' <- T.useLive T.unequal redrawMenu
--------------------------------------------------------------------------
pure $ CM.contextMenu {x, y, onClose} [
annotationMenuInner { list, menuType, setList } -- addToList :: Record AnnotationMenu -> TermList -> Maybe R.Element
-- addToList {list: Just t'} t
-- | t == t' = Nothing
-- addToList {menuType, setList} t = Just $
-- B.contextMenuItem
-- { callback: click }
-- [
-- B.icon
-- { name: "circle"
-- , className: "mr-2 " <> termClass t
-- }
-- ,
-- H.text (label menuType)
-- ]
-- where
-- label NewNgram = "Add to " <> (toLower $ termListName t)
-- label SetTermListItem = "Change to " <> (toLower $ termListName t)
-- click _ = setList t
addToList :: Record AnnotationMenu -> TermList -> R.Element
addToList {list: Just t', menuType} t
| t == t' =
B.contextMenuItem
{ callback: const R.nothing
, status: Disabled
}
[
B.icon
{ name: "circle"
, className: "mr-2 disabled-term"
}
,
H.text (label t menuType)
]
addToList {menuType, setList} t =
B.contextMenuItem
{ callback: const $ setList t }
[
B.icon
{ name: "circle"
, className: "mr-2 " <> termClass t
}
,
H.text (label t menuType)
] ]
annotationMenuInner :: R2.Leaf Props label :: TermList -> MenuType -> String
annotationMenuInner = R2.leafComponent annotationMenuInnerCpt label t NewNgram = "Add to " <> (toLower $ termListName t)
annotationMenuInnerCpt :: R.Component Props label t SetTermListItem = "Change to " <> (toLower $ termListName t)
annotationMenuInnerCpt = here.component "annotationMenuInner" cpt where
cpt props _ = pure $ R.fragment $ A.mapMaybe (addToList props) [ MapTerm, CandidateTerm, StopTerm ]
-- | Given the TermList to render the item for zand the Maybe TermList the item may belong to, possibly render the menuItem
addToList :: Record Props -> TermList -> Maybe R.Element
addToList {list: Just t'} t
| t == t' = Nothing
addToList {menuType, setList} t = Just $ CM.contextMenuItem {} [ link ]
where
link = HTML.a { on: { click }, className: className } [ HTML.text (label menuType) ]
label NewNgram = "Add to " <> termListName t
label SetTermListItem = "Change to " <> termListName t
className = "list-group-item list-group-item-" <> (termBootstrapClass t)
click _ = setList t
module Gargantext.Components.Annotation.Types
( MenuType(..)
, termClass
, ModeType(..)
)
where
import Gargantext.Prelude
import Data.Eq.Generic (genericEq)
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Data.Show.Generic (genericShow)
import Gargantext.Types (TermList(..))
---------------------------------------------------------
data MenuType = NewNgram | SetTermListItem
derive instance Generic MenuType _
instance Eq MenuType where
eq = genericEq
----------------------------------------------------------
termClass :: TermList -> String
termClass CandidateTerm = "candidate-term"
termClass MapTerm = "graph-term"
termClass StopTerm = "stop-term"
---------------------------------------------------------
data ModeType
= EditionMode
| AdditionMode
derive instance Generic ModeType _
instance Eq ModeType where eq = genericEq
instance Show ModeType where show = genericShow
instance Read ModeType where
read :: String -> Maybe ModeType
read = case _ of
"EditionMode" -> Just EditionMode
"AdditionMode" -> Just AdditionMode
_ -> Nothing
module Gargantext.Components.Annotation.Utils where
import Gargantext.Types ( TermList(..) )
termClass :: TermList -> String
termClass CandidateTerm = "candidate-term"
termClass MapTerm = "graph-term"
termClass StopTerm = "stop-term"
termBootstrapClass :: TermList -> String
-- termBootstrapClass CandidateTerm = "warning"
termBootstrapClass MapTerm = "success"
termBootstrapClass StopTerm = "danger"
termBootstrapClass CandidateTerm = "primary"
...@@ -170,9 +170,9 @@ component = R.hooksComponent cname cpt where ...@@ -170,9 +170,9 @@ component = R.hooksComponent cname cpt where
R.fragment R.fragment
[ [
R2.if' canCloakBeDisplayed props.cloakSlot R2.when canCloakBeDisplayed props.cloakSlot
, ,
R2.if' canContentBeDisplayed props.defaultSlot R2.when canContentBeDisplayed props.defaultSlot
] ]
......
module Gargantext.Components.Bootstrap.Preloader(preloader) where
import Gargantext.Prelude
import Data.Foldable (intercalate)
import Gargantext.Components.Bootstrap.Spinner (spinner)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
type Props = ( | Options)
type Options =
( className :: String
)
options :: Record Options
options =
{ className : ""
}
-- | Structural Component wrapping our <Spinner.BorderTheme> within
-- | a basic layout
preloader :: forall r. R2.OptLeaf Options Props r
preloader = R2.optLeaf component options
componentName :: String
componentName = "b-preloader"
component :: R.Component Props
component = R.hooksComponent componentName cpt where
cpt props _ = do
-- Computed
let
className = intercalate " "
-- provided custom className
[ props.className
-- BEM classNames
, componentName
]
-- Render
pure $
H.div
{ className }
[
spinner
{ className: componentName <> "__spinner" }
]
...@@ -36,7 +36,8 @@ component :: R.Component Props ...@@ -36,7 +36,8 @@ component :: R.Component Props
component = R.hooksComponent componentName cpt where component = R.hooksComponent componentName cpt where
cpt props _ = do cpt props _ = do
-- Computed -- Computed
className <- pure $ intercalate " " let
className = intercalate " "
-- provided custom className -- provided custom className
[ props.className [ props.className
-- BEM classNames -- BEM classNames
......
...@@ -4,14 +4,17 @@ module Gargantext.Components.Bootstrap ...@@ -4,14 +4,17 @@ module Gargantext.Components.Bootstrap
import Gargantext.Components.Bootstrap.BaseModal(baseModal) as Exports import Gargantext.Components.Bootstrap.BaseModal(baseModal) as Exports
import Gargantext.Components.Bootstrap.Button(button) as Exports import Gargantext.Components.Bootstrap.Button(button) as Exports
import Gargantext.Components.Bootstrap.ButtonGroup(buttonGroup) as Exports
import Gargantext.Components.Bootstrap.Caveat(caveat) as Exports import Gargantext.Components.Bootstrap.Caveat(caveat) as Exports
import Gargantext.Components.Bootstrap.Cloak (cloak) as Exports import Gargantext.Components.Bootstrap.Cloak (cloak) as Exports
import Gargantext.Components.Bootstrap.ContextMenu(contextMenu, contextMenuItem) as Exports
import Gargantext.Components.Bootstrap.Fieldset(fieldset) as Exports import Gargantext.Components.Bootstrap.Fieldset(fieldset) as Exports
import Gargantext.Components.Bootstrap.FormInput(formInput) as Exports import Gargantext.Components.Bootstrap.FormInput(formInput) as Exports
import Gargantext.Components.Bootstrap.FormSelect(formSelect, formSelect') as Exports import Gargantext.Components.Bootstrap.FormSelect(formSelect, formSelect') as Exports
import Gargantext.Components.Bootstrap.FormTextarea(formTextarea) as Exports import Gargantext.Components.Bootstrap.FormTextarea(formTextarea) as Exports
import Gargantext.Components.Bootstrap.Icon(icon) as Exports import Gargantext.Components.Bootstrap.Icon(icon) as Exports
import Gargantext.Components.Bootstrap.IconButton(iconButton) as Exports import Gargantext.Components.Bootstrap.IconButton(iconButton) as Exports
import Gargantext.Components.Bootstrap.Preloader(preloader) as Exports
import Gargantext.Components.Bootstrap.ProgressBar(progressBar) as Exports import Gargantext.Components.Bootstrap.ProgressBar(progressBar) as Exports
import Gargantext.Components.Bootstrap.Ripple(ripple) as Exports import Gargantext.Components.Bootstrap.Ripple(ripple) as Exports
import Gargantext.Components.Bootstrap.Spinner(spinner) as Exports import Gargantext.Components.Bootstrap.Spinner(spinner) as Exports
...@@ -32,4 +35,5 @@ import Gargantext.Components.Bootstrap.Shortcut( ...@@ -32,4 +35,5 @@ import Gargantext.Components.Bootstrap.Shortcut(
, b', b_ , b', b_
, code', code_ , code', code_
, label', label_ , label', label_
, p', p_
) as Exports ) as Exports
'use strict'; 'use strict';
exports._addClassName = function(window, className) { exports._show = show;
window.document.body.classList.add(className); exports._hide = hide;
/**
* @function show
* @param {Window} window
* @param {string} querySelector
* @unpure {Object} window.$
*/
function show(window, querySelector) {
window.$(querySelector).modal('show');
} }
/**
exports._removeClassName = function(window, className) { * @function hide
window.document.body.classList.remove(className); * @param {Window} window
* @param {string} querySelector
* @unpure {Object} window.$
*/
function hide(window, querySelector) {
window.$(querySelector).modal('hide');
// @XXX Bootstrap not removing some modal elements on "hide" method
// @https://stackoverflow.com/questions/50168312/bootstrap-4-close-modal-backdrop-doesnt-disappear
window.$('body').removeClass('modal-open');
window.$('body').css('padding-right', '0');
window.$('.modal-backdrop').remove();
} }
module Gargantext.Components.Bootstrap.ContextMenu
( contextMenu
, contextMenuItem
) where
import Gargantext.Prelude
import DOM.Simple as DOM
import DOM.Simple as Element
import DOM.Simple.Event as DE
import DOM.Simple.Types (DOMRect)
import DOM.Simple.Window (window)
import Data.Foldable (for_, intercalate)
import Data.Maybe (Maybe, maybe)
import Data.Nullable (Nullable, null, toMaybe)
import Data.UUID as UUID
import Effect (Effect)
import FFI.Simple (setProperty', (..))
import Gargantext.Components.Bootstrap.Ripple (ripple)
import Gargantext.Components.Bootstrap.Types (ComponentStatus(..), Variant(..))
import Gargantext.Hooks.Scrollbar (useScrollbar)
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix as SE
import Reactix.DOM.HTML as H
import Reactix.SyntheticEvent as RE
type Props =
( closeCallback :: Unit -> Effect Unit
, x :: Number
, y :: Number
)
contextMenu :: R2.Component Props
contextMenu = R2.component component
componentName :: String
componentName = "b-context-menu"
component :: R.Component Props
component = R.hooksComponent componentName cpt where
cpt { closeCallback
, x
, y
} children
= R.unsafeHooksEffect (UUID.genUUID >>= pure <<< UUID.toString)
>>= \uuid -> do
-- | States
-- |
ref <- R.useRef (null :: Nullable DOM.Element)
-- | Hooks
-- |
{ enableScroll, disableScroll } <- useScrollbar
R.useLayoutEffect1 [] do
-- Mount
disableScroll
-- Unmount
pure enableScroll
-- /!\ for some reason we have to use the hook's effect with cleanup
-- function (even if empty)
R.useLayoutEffect1 (R.readRef ref) do
for_ (toMaybe $ R.readRef ref) \el -> do
let rect = Element.boundingRect el
let pos = position { x, y } rect
let style = el .. "style"
void $ pure $ setProperty' style "left" [ show pos.left ]
void $ pure $ setProperty' style "top" [ show pos.top ]
R.nothing # R.thenNothing
-- | Computed
-- |
let
containerId :: String
containerId = componentName <> "-" <> uuid
containerCallback :: forall e. SE.SyntheticEvent e -> Effect Unit
containerCallback e =
let
eventTargetId :: Maybe String
eventTargetId = SE.unsafeEventTarget e # flip DOM.attr "id"
hasClickedOnContainer :: Boolean
hasClickedOnContainer = maybe false (eq containerId) eventTargetId
in
when hasClickedOnContainer $ closeCallback unit
-- | Render
-- |
R.createPortal
[
H.div
{ className: componentName
, on: { click: containerCallback }
, key: uuid
, id: containerId
}
[
H.div
{ className: componentName <> "__inner"
, data: { placement: "right", toggle: "popover" }
, ref
}
children
]
]
<$> R2.getPortalHost
position ::
{ x :: Number
, y :: Number
}
-> DOMRect
-> { left :: Number
, top :: Number
}
position mouse { width: menuWidth, height: menuHeight } = { left, top }
where
left = if isRight then mouse.x else mouse.x - menuWidth
top = if isAbove then mouse.y else mouse.y - menuHeight
isRight = screenWidth - mouse.x > menuWidth -- is there enough space to show above
isAbove = screenHeight - mouse.y > menuHeight -- is there enough space to show to the right?
screenWidth = window .. "innerWidth"
screenHeight = window .. "innerHeight"
--------------------------------------------------------------
type ItemProps =
( callback :: Unit -> Effect Unit
| ItemOptions
)
type ItemOptions =
( className :: String
, status :: ComponentStatus
)
itemOptions :: Record ItemOptions
itemOptions =
{ className : ""
, status : Enabled
}
contextMenuItem :: forall r. R2.OptComponent ItemOptions ItemProps r
contextMenuItem = R2.optComponent itemCpt itemOptions
itemComponentName :: String
itemComponentName = "b-context-menu-item"
itemCpt :: R.Component ItemProps
itemCpt = R.hooksComponent itemComponentName cpt where
cpt props@{ callback
, status
} children = do
-- Computed
let
className = intercalate " "
-- provided custom className
[ props.className
-- BEM classNames
, itemComponentName
, itemComponentName <> "--" <> show status
]
click = onClick status callback
-- Render
pure $
H.div
{ className
, on: { click }
} $
[
ripple
{ status
, variant: Dark
}
children
]
-- | Clicked event will effectively be triggered according to the
-- | component status props
onClick ::
ComponentStatus
-> (Unit -> Effect Unit)
-> RE.SyntheticEvent DE.Event
-> Effect Unit
onClick status callback event = do
RE.preventDefault event
when (status == Enabled) $ callback unit
module Gargantext.Components.Bootstrap.ButtonGroup
( buttonGroup
) where
import Gargantext.Prelude
import Data.Foldable (intercalate)
import Gargantext.Utils ((?))
import Gargantext.Utils.Reactix as R2
import Reactix as R
import Reactix.DOM.HTML as H
type Props = ( | Options )
type Options =
( className :: String
, collapse :: Boolean
)
options :: Record Options
options =
{ className : ""
, collapse : true
}
-- | Structural Component for the Bootstrap Button Group
-- |
-- | https://getbootstrap.com/docs/4.0/components/button-group/
buttonGroup :: forall r. R2.OptComponent Options Props r
buttonGroup = R2.optComponent component options
componentName :: String
componentName = "b-button-group"
bootstrapName :: String
bootstrapName = "btn-group"
component :: R.Component Props
component = R.hooksComponent componentName cpt where
cpt props children = do
-- Computed
let
className = intercalate " "
-- provided custom className
[ props.className
-- BEM classNames
, componentName
, props.collapse ?
componentName <> "--collapse" $
componentName <> "--no-collapse"
-- Bootstrap specific classNames
, bootstrapName
]
-- Render
pure $
H.div
{ className
, role: "group"
}
children
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
...@@ -33,7 +33,7 @@ searchBarCpt = here.component "searchBar" cpt ...@@ -33,7 +33,7 @@ searchBarCpt = here.component "searchBar" cpt
where where
cpt { errors, langs, onSearch, search, session } _ = do cpt { errors, langs, onSearch, search, session } _ = do
--onSearchChange session s --onSearchChange session s
pure $ H.div { className: "search-bar" } pure $ H.div { className: "search-bar m-1" }
[ searchField { databases: allDatabases [ searchField { databases: allDatabases
, errors , errors
, langs , langs
......
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
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