Commit 3b8f6267 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Merge branch 'dev' into dev-user-page

parents 9e228236 0e052718
...@@ -211,4 +211,15 @@ a:focus, a:hover { ...@@ -211,4 +211,15 @@ a:focus, a:hover {
cursor: pointer; cursor: pointer;
} }
.copy-from-corpus .tree .node {
padding-left: 10px;
}
.copy-from-corpus .tree .node .name.clickable {
color: #337ab7;
cursor: pointer;
}
.copy-from-corpus .tree .node .name.clickable:hover {
text-decoration: underline;
}
/*# sourceMappingURL=Login.css.map */ /*# sourceMappingURL=Login.css.map */
...@@ -197,3 +197,14 @@ li ...@@ -197,3 +197,14 @@ li
a:focus, a:hover a:focus, a:hover
cursor: pointer cursor: pointer
.copy-from-corpus
.tree
.node
padding-left: 10px
.name
&.clickable
color: #337ab7
cursor: pointer
&:hover
text-decoration: underline
...@@ -176,4 +176,4 @@ performAction session (NTree (LNode {id}) _) (_ /\ setReload) (_ /\ setOpenNodes ...@@ -176,4 +176,4 @@ performAction session (NTree (LNode {id}) _) (_ /\ setReload) (_ /\ setOpenNodes
performAction session (NTree (LNode {id}) _) _ _ (_ /\ setAsyncTasks) (UploadFile nodeType fileType contents) = do performAction session (NTree (LNode {id}) _) _ _ (_ /\ setAsyncTasks) (UploadFile nodeType fileType contents) = do
task <- uploadFile session nodeType id fileType contents task <- uploadFile session nodeType id fileType contents
liftEffect $ setAsyncTasks $ A.cons task liftEffect $ setAsyncTasks $ A.cons task
liftEffect $ log2 "uploaded, task:" task liftEffect $ log2 "uploaded, task:" task
\ No newline at end of file
...@@ -22,6 +22,7 @@ data NodeAction = Documentation NodeType ...@@ -22,6 +22,7 @@ data NodeAction = Documentation NodeType
| Move | Clone | Delete | Move | Clone | Delete
| Share | Link NodeType | Share | Link NodeType
| Add (Array NodeType) | Add (Array NodeType)
| CopyFromCorpus
instance eqNodeAction :: Eq NodeAction where instance eqNodeAction :: Eq NodeAction where
...@@ -36,6 +37,7 @@ instance eqNodeAction :: Eq NodeAction where ...@@ -36,6 +37,7 @@ instance eqNodeAction :: Eq NodeAction where
eq Share Share = true eq Share Share = true
eq (Link x) (Link y) = true && (x == y) eq (Link x) (Link y) = true && (x == y)
eq (Add x) (Add y) = true && (x == y) eq (Add x) (Add y) = true && (x == y)
eq CopyFromCorpus CopyFromCorpus = true
eq _ _ = false eq _ _ = false
instance showNodeAction :: Show NodeAction where instance showNodeAction :: Show NodeAction where
...@@ -50,6 +52,7 @@ instance showNodeAction :: Show NodeAction where ...@@ -50,6 +52,7 @@ instance showNodeAction :: Show NodeAction where
show Share = "Share" show Share = "Share"
show (Link x) = "Link to " <> show x show (Link x) = "Link to " <> show x
show (Add xs) = foldl (\a b -> a <> show b) "Add " xs show (Add xs) = foldl (\a b -> a <> show b) "Add " xs
show CopyFromCorpus = "Copy from corpus"
glyphiconNodeAction :: NodeAction -> String glyphiconNodeAction :: NodeAction -> String
...@@ -60,6 +63,7 @@ glyphiconNodeAction SearchBox = "search" ...@@ -60,6 +63,7 @@ glyphiconNodeAction SearchBox = "search"
glyphiconNodeAction Upload = "upload" glyphiconNodeAction Upload = "upload"
glyphiconNodeAction (Link _) = "transfer" glyphiconNodeAction (Link _) = "transfer"
glyphiconNodeAction Download = "download" glyphiconNodeAction Download = "download"
glyphiconNodeAction CopyFromCorpus = "random"
glyphiconNodeAction _ = "" glyphiconNodeAction _ = ""
...@@ -183,6 +187,7 @@ settingsBox NodeList = SettingsBox { ...@@ -183,6 +187,7 @@ settingsBox NodeList = SettingsBox {
, edit : false , edit : false
, doc : Documentation NodeList , doc : Documentation NodeList
, buttons : [ Upload , buttons : [ Upload
, CopyFromCorpus
, Download , Download
, Delete , Delete
] ]
......
module Gargantext.Components.Forest.Tree.Node.Action.Upload where module Gargantext.Components.Forest.Tree.Node.Action.Upload where
import Prelude (class Show, Unit, bind, const, discard, map, pure, show, void, ($)) import Data.Array as A
import Data.Maybe (Maybe(..), fromJust) import Data.Maybe (Maybe(..), fromJust)
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect.Aff (Aff, launchAff) import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect (Effect)
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import React.SyntheticEvent as E import React.SyntheticEvent as E
import Reactix as R import Reactix as R
...@@ -14,36 +16,38 @@ import Reactix.DOM.HTML as H ...@@ -14,36 +16,38 @@ import Reactix.DOM.HTML as H
import URI.Extra.QueryPairs as QP import URI.Extra.QueryPairs as QP
import Web.File.FileReader.Aff (readAsText) import Web.File.FileReader.Aff (readAsText)
import Gargantext.Prelude
import Gargantext.Components.Data.Lang (readLang, Lang(..)) import Gargantext.Components.Data.Lang (readLang, Lang(..))
import Gargantext.Components.Forest.Tree.Node.Action import Gargantext.Components.Forest.Tree.Node.Action
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes as GR import Gargantext.Routes as GR
import Gargantext.Sessions (Session, postWwwUrlencoded) import Gargantext.Sessions (Session(..), postWwwUrlencoded, get)
import Gargantext.Types as GT import Gargantext.Types as GT
import Gargantext.Utils (id) import Gargantext.Utils (id)
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
type Props = type Props =
( id :: Int ( dispatch :: Action -> Aff Unit
, id :: Int
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
, session :: Session , session :: Session
) )
uploadFileView :: (Action -> Aff Unit) -> Record Props -> R.Element uploadFileView :: Record Props -> R.Element
uploadFileView d props = R.createElement (uploadFileViewCpt d) props [] uploadFileView props = R.createElement uploadFileViewCpt props []
uploadFileViewCpt :: (Action -> Aff Unit) -> R.Component Props uploadFileViewCpt :: R.Component Props
uploadFileViewCpt d = R.hooksComponent "UploadFileView" cpt uploadFileViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadFileView" cpt
where where
cpt {id, nodeType} _ = do cpt {dispatch: d, id, nodeType} _ = do
mContents :: R.State (Maybe UploadFileContents) <- R.useState' Nothing mContents :: R.State (Maybe UploadFileContents) <- R.useState' Nothing
fileType :: R.State FileType <- R.useState' CSV fileType :: R.State FileType <- R.useState' CSV
lang :: R.State (Maybe Lang) <- R.useState' (Just EN) lang :: R.State (Maybe Lang) <- R.useState' (Just EN)
pure $ H.div {} [ pure $ H.div {} [
H.div {} [ H.text "Upload file!" ] H.div {} [ H.input { type: "file"
, H.div {} [ H.input { type: "file"
, placeholder: "Choose file" , placeholder: "Choose file"
, on: {change: onChangeContents mContents} , on: {change: onChangeContents mContents}
} }
...@@ -75,6 +79,7 @@ uploadFileViewCpt d = R.hooksComponent "UploadFileView" cpt ...@@ -75,6 +79,7 @@ uploadFileViewCpt d = R.hooksComponent "UploadFileView" cpt
renderOptionLang :: Lang -> R.Element renderOptionLang :: Lang -> R.Element
renderOptionLang opt = H.option {} [ H.text $ show opt ] renderOptionLang opt = H.option {} [ H.text $ show opt ]
onChangeContents :: forall e. R.State (Maybe UploadFileContents) -> E.SyntheticEvent_ e -> Effect Unit
onChangeContents (mContents /\ setMContents) e = do onChangeContents (mContents /\ setMContents) e = do
blob <- R2.inputFileBlob e blob <- R2.inputFileBlob e
E.preventDefault e E.preventDefault e
...@@ -84,6 +89,7 @@ uploadFileViewCpt d = R.hooksComponent "UploadFileView" cpt ...@@ -84,6 +89,7 @@ uploadFileViewCpt d = R.hooksComponent "UploadFileView" cpt
liftEffect $ do liftEffect $ do
setMContents $ const $ Just $ UploadFileContents contents setMContents $ const $ Just $ UploadFileContents contents
onChangeFileType :: forall e. R.State FileType -> e -> Effect Unit
onChangeFileType (fileType /\ setFileType) e = do onChangeFileType (fileType /\ setFileType) e = do
setFileType $ const setFileType $ const
$ unsafePartial $ unsafePartial
...@@ -91,6 +97,7 @@ uploadFileViewCpt d = R.hooksComponent "UploadFileView" cpt ...@@ -91,6 +97,7 @@ uploadFileViewCpt d = R.hooksComponent "UploadFileView" cpt
$ readFileType $ readFileType
$ R2.unsafeEventValue e $ R2.unsafeEventValue e
onChangeLang :: forall e. R.State (Maybe Lang) -> e -> Effect Unit
onChangeLang (lang /\ setLang) e = do onChangeLang (lang /\ setLang) e = do
setLang $ const setLang $ const
$ unsafePartial $ unsafePartial
...@@ -234,3 +241,129 @@ uploadFile session nodeType id fileType (UploadFileContents fileContents) = do ...@@ -234,3 +241,129 @@ uploadFile session nodeType id fileType (UploadFileContents fileContents) = do
Tuple "_wf_data" (Just fileContents) Tuple "_wf_data" (Just fileContents)
, Tuple "_wf_filetype" (Just $ show fileType) , Tuple "_wf_filetype" (Just $ show fileType)
] ]
uploadTermListView :: Record Props -> R.Element
uploadTermListView props = R.createElement uploadTermListViewCpt props []
uploadTermListViewCpt :: R.Component Props
uploadTermListViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadTermListView" cpt
where
cpt {dispatch, id, nodeType} _ = do
mContents :: R.State (Maybe UploadFileContents) <- R.useState' Nothing
pure $ H.div {} [
H.div {} [ H.input { type: "file"
, placeholder: "Choose file"
, on: {change: onChangeContents mContents}
}
]
, H.div {} [ uploadTermButton { dispatch, id, mContents, nodeType } ]
]
onChangeContents :: forall e. R.State (Maybe UploadFileContents) -> E.SyntheticEvent_ e -> Effect Unit
onChangeContents (mContents /\ setMContents) e = do
blob <- R2.inputFileBlob e
E.preventDefault e
E.stopPropagation e
void $ launchAff do
contents <- readAsText blob
liftEffect $ do
setMContents $ const $ Just $ UploadFileContents contents
type UploadTermButtonProps =
(
dispatch :: Action -> Aff Unit
, id :: Int
, mContents :: R.State (Maybe UploadFileContents)
, nodeType :: GT.NodeType
)
uploadTermButton :: Record UploadTermButtonProps -> R.Element
uploadTermButton props = R.createElement uploadTermButtonCpt props []
uploadTermButtonCpt :: R.Component UploadTermButtonProps
uploadTermButtonCpt = R.hooksComponent "G.C.F.T.N.A.U.uploadTermButton" cpt
where
cpt {dispatch, id, mContents: (mContents /\ setMContents), nodeType} _ = do
pure $ H.button {className: "btn btn-primary", disabled, on: {click: onClick}} [ H.text "Upload" ]
where
disabled = case mContents of
Nothing -> "1"
Just _ -> ""
onClick e = do
let contents = unsafePartial $ fromJust mContents
void $ launchAff do
_ <- dispatch $ UploadFile nodeType CSV contents
liftEffect $ do
setMContents $ const $ Nothing
copyFromCorpusView :: Record Props -> R.Element
copyFromCorpusView props = R.createElement copyFromCorpusViewCpt props []
copyFromCorpusViewCpt :: R.Component Props
copyFromCorpusViewCpt = R.hooksComponent "G.C.F.T.N.A.U.copyFromCorpusView" cpt
where
cpt {dispatch, id, nodeType, session} _ = do
useLoader session loadCorporaTree $
\tree ->
copyFromCorpusViewLoaded {dispatch, id, nodeType, session, tree}
type CorpusTreeProps =
(
tree :: FTree
| Props
)
copyFromCorpusViewLoaded :: Record CorpusTreeProps -> R.Element
copyFromCorpusViewLoaded props = R.createElement copyFromCorpusViewLoadedCpt props []
copyFromCorpusViewLoadedCpt :: R.Component CorpusTreeProps
copyFromCorpusViewLoadedCpt = R.hooksComponent "G.C.F.T.N.A.U.copyFromCorpusViewLoadedCpt" cpt
where
cpt p@{dispatch, id, nodeType, session, tree} _ = do
pure $ H.div { className: "copy-from-corpus" } [
H.div { className: "tree" } [copyFromCorpusTreeView p]
]
copyFromCorpusTreeView :: Record CorpusTreeProps -> R.Element
copyFromCorpusTreeView props = R.createElement copyFromCorpusTreeViewCpt props []
copyFromCorpusTreeViewCpt :: R.Component CorpusTreeProps
copyFromCorpusTreeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.copyFromCorpusTreeViewCpt" cpt
where
cpt p@{id, tree: NTree (LNode { id: sourceId, name, nodeType }) ary} _ = do
pure $ {- H.div {} [ H.h5 { className: GT.fldr nodeType true} []
, -} H.div { className: "node" } ([ H.span { className: "name " <> clickable
, on: { click: onClick }
} [ H.text name ]
] <> children)
-- ]
where
children = map (\c -> copyFromCorpusTreeView (p { tree = c })) ary
validNodeType = (A.elem nodeType [GT.NodeList]) && (id /= sourceId)
clickable = if validNodeType then "clickable" else ""
onClick _ = case validNodeType of
false -> pure unit
true -> do
log2 "[copyFromCorpusTreeViewCpt] issue copy into" id
log2 "[copyFromCorpusTreeViewCpt] issue copy from" sourceId
loadCorporaTree :: Session -> Aff FTree
loadCorporaTree session = getCorporaTree session treeId
where
Session { treeId } = session
getCorporaTree :: Session -> Int -> Aff FTree
getCorporaTree session treeId = get session $ GR.NodeAPI GT.Tree (Just treeId) nodeTypes
where
nodeTypes = A.foldl (\a b -> a <> "type=" <> show b <> "&") "?" [ GT.FolderPrivate
, GT.FolderShared
, GT.Team
, GT.FolderPublic
, GT.Folder
, GT.Corpus
, GT.NodeList]
...@@ -5,6 +5,7 @@ import Gargantext.Prelude ...@@ -5,6 +5,7 @@ import Gargantext.Prelude
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..), snd) import Data.Tuple (Tuple(..), snd)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, launchAff) import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
...@@ -14,7 +15,7 @@ import Gargantext.Components.Forest.Tree.Node (NodeAction(..), SettingsBox(..), ...@@ -14,7 +15,7 @@ import Gargantext.Components.Forest.Tree.Node (NodeAction(..), SettingsBox(..),
import Gargantext.Components.Forest.Tree.Node.Action (Action(..), DroppedFile(..), FileType(..), ID, Name, UploadFileContents(..)) import Gargantext.Components.Forest.Tree.Node.Action (Action(..), DroppedFile(..), FileType(..), ID, Name, UploadFileContents(..))
import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup(..), createNodeView) import Gargantext.Components.Forest.Tree.Node.Action.Add (NodePopup(..), createNodeView)
import Gargantext.Components.Forest.Tree.Node.Action.Rename (renameBox) import Gargantext.Components.Forest.Tree.Node.Action.Rename (renameBox)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFileView, fileTypeView) import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFileView, fileTypeView, uploadTermListView, copyFromCorpusView)
import Gargantext.Components.Forest.Tree.Node.ProgressBar (asyncProgressBar) import Gargantext.Components.Forest.Tree.Node.ProgressBar (asyncProgressBar)
import Gargantext.Components.Search.SearchBar (searchBar) import Gargantext.Components.Search.SearchBar (searchBar)
import Gargantext.Components.Search.SearchField (Search, defaultSearch, isIsTex) import Gargantext.Components.Search.SearchField (Search, defaultSearch, isIsTex)
...@@ -34,6 +35,9 @@ import URI.Query as Query ...@@ -34,6 +35,9 @@ import URI.Query as Query
import Web.File.FileReader.Aff (readAsText) import Web.File.FileReader.Aff (readAsText)
type Dispatch = Action -> Aff Unit
-- Main Node -- Main Node
type NodeMainSpanProps = type NodeMainSpanProps =
( id :: ID ( id :: ID
...@@ -44,7 +48,7 @@ type NodeMainSpanProps = ...@@ -44,7 +48,7 @@ type NodeMainSpanProps =
, onAsyncTaskFinish :: GT.AsyncTaskWithType -> Effect Unit , onAsyncTaskFinish :: GT.AsyncTaskWithType -> Effect Unit
) )
nodeMainSpan :: (Action -> Aff Unit) nodeMainSpan :: Dispatch
-> Record NodeMainSpanProps -> Record NodeMainSpanProps
-> R.State Boolean -> R.State Boolean
-> Session -> Session
...@@ -105,13 +109,14 @@ nodeMainSpan d p folderOpen session frontends = R.createElement el p [] ...@@ -105,13 +109,14 @@ nodeMainSpan d p folderOpen session frontends = R.createElement el p []
mNodePopupView _ _ (Nothing /\ _) _ = H.div {} [] mNodePopupView _ _ (Nothing /\ _) _ = H.div {} []
mNodePopupView _ _ _ (Nothing /\ _) = H.div {} [] mNodePopupView _ _ _ (Nothing /\ _) = H.div {} []
mNodePopupView props@{asyncTasks, id, nodeType} true popupOpen (Just position /\ _) = mNodePopupView props@{asyncTasks, id, nodeType} true popupOpen (Just position /\ _) =
nodePopupView d { id nodePopupView { id
, action: Nothing , dispatch: d
, name: name' props , name: name' props
, nodeType , nodePopupState: popupOpen
, position , nodeType
, session , position
} popupOpen , session
}
dropProps droppedFile isDragOver = dropProps droppedFile isDragOver =
{ className: dropClass droppedFile isDragOver { className: dropClass droppedFile isDragOver
...@@ -182,8 +187,9 @@ mCorpusId _ = Nothing ...@@ -182,8 +187,9 @@ mCorpusId _ = Nothing
-- | START Popup View -- | START Popup View
type NodePopupProps = type NodePopupProps =
( id :: ID ( id :: ID
, action :: Maybe NodeAction , dispatch :: Dispatch
, name :: Name , name :: Name
, nodePopupState :: R.State (Maybe NodePopup)
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
, position :: R2.Point , position :: R2.Point
, session :: Session , session :: Session
...@@ -195,35 +201,34 @@ iconAStyle = { color : "black" ...@@ -195,35 +201,34 @@ iconAStyle = { color : "black"
, paddingBottom : "6px" , paddingBottom : "6px"
} }
nodePopupView :: (Action -> Aff Unit) nodePopupView :: Record NodePopupProps -> R.Element
-> Record NodePopupProps nodePopupView p = R.createElement nodePopupCpt p []
-> R.State (Maybe NodePopup)
-> R.Element nodePopupCpt :: R.Component NodePopupProps
nodePopupView d p mPop@(Just NodePopup /\ setPopupOpen) = R.createElement el p [] nodePopupCpt = R.hooksComponent "G.C.F.T.N.B.nodePopupView" cpt
where where
el = R.hooksComponent "NodePopupView" cpt cpt p@{nodePopupState: mPop@(Just NodePopup /\ setPopupOpen)} _ = do
cpt {id, action, name, nodeType, position, session} _ = do
renameBoxOpen <- R.useState' false renameBoxOpen <- R.useState' false
nodePopupState@(nodePopup /\ setNodePopup) <- R.useState' {id, name, nodeType, action} nodePopupState@(nodePopup /\ setNodePopup) <- R.useState' {action: Nothing, id: p.id, name: p.name, nodeType: p.nodeType}
search <- R.useState' $ defaultSearch { node_id = Just id } search <- R.useState' $ defaultSearch { node_id = Just p.id }
pure $ H.div (tooltipProps position) $ pure $ H.div (tooltipProps p.position) $
[ H.div {id: "arrow"} [] [ H.div {id: "arrow"} []
, H.div { className: "popup-container" } , H.div { className: "popup-container" }
[ H.div { className: "panel panel-default" } [ H.div { className: "panel panel-default" }
[ H.div {className: ""} [ H.div {className: ""}
[ H.div { className : "col-md-11"} [ H.div { className : "col-md-11"}
[ H.h3 { className: GT.fldr nodeType true} [H.text $ show nodeType] [ H.h3 { className: GT.fldr p.nodeType true} [H.text $ show p.nodeType]
, H.p {className: "text-primary center"} [H.text name] , H.p {className: "text-primary center"} [H.text p.name]
] ]
] ]
, panelHeading renameBoxOpen , panelHeading renameBoxOpen p
, panelBody nodePopupState d , panelBody nodePopupState p
, panelAction d {id, name, nodeType, action:nodePopup.action, session, search} mPop , mPanelAction nodePopup.action p search
] ]
, if nodePopup.action == Just SearchBox then , if nodePopup.action == Just SearchBox then
H.div {} H.div {}
[ [
searchIsTexIframe id session search searchIsTexIframe p search
] ]
else else
H.div {} [] H.div {} []
...@@ -239,16 +244,7 @@ nodePopupView d p mPop@(Just NodePopup /\ setPopupOpen) = R.createElement el p [ ...@@ -239,16 +244,7 @@ nodePopupView d p mPop@(Just NodePopup /\ setPopupOpen) = R.createElement el p [
style: { top: y - 65.0, left: x + 10.0 } style: { top: y - 65.0, left: x + 10.0 }
} }
SettingsBox {edit, doc, buttons} = settingsBox nodeType panelHeading renameBoxOpen@(open /\ _) {dispatch: d, id, name, nodeType} =
removeCircleGeneral (Just _) setNodePopup = removeCircle setNodePopup
removeCircleGeneral Nothing _ = H.div {} []
removeCircle setNodePopup =
H.div { className: glyphicon "remove-circle"
, onClick : setNodePopup $ const {id, name, nodeType, action :Nothing}
} []
panelHeading renameBoxOpen@(open /\ _) =
H.div {className: "panel-heading"} H.div {className: "panel-heading"}
[ R2.row [ R2.row
[ H.div {className: "col-md-8"} [ H.div {className: "col-md-8"}
...@@ -267,6 +263,9 @@ nodePopupView d p mPop@(Just NodePopup /\ setPopupOpen) = R.createElement el p [ ...@@ -267,6 +263,9 @@ nodePopupView d p mPop@(Just NodePopup /\ setPopupOpen) = R.createElement el p [
] ]
] ]
where where
SettingsBox {edit, doc, buttons} = settingsBox nodeType
editIcon :: R.State Boolean -> R.Element
editIcon (false /\ setRenameBoxOpen) = editIcon (false /\ setRenameBoxOpen) =
H.div {className : "col-md-1"} H.div {className : "col-md-1"}
[ H.a { className: glyphicon "pencil" [ H.a { className: glyphicon "pencil"
...@@ -279,14 +278,31 @@ nodePopupView d p mPop@(Just NodePopup /\ setPopupOpen) = R.createElement el p [ ...@@ -279,14 +278,31 @@ nodePopupView d p mPop@(Just NodePopup /\ setPopupOpen) = R.createElement el p [
] ]
editIcon (true /\ _) = H.div {} [] editIcon (true /\ _) = H.div {} []
panelBody nodePopupState d' = panelBody :: R.State (Record ActionState) -> Record NodePopupProps -> R.Element
panelBody nodePopupState {dispatch: d, nodeType} =
H.div {className: "panel-body flex-space-between"} H.div {className: "panel-body flex-space-between"}
[ H.div {className: "flex-center"} [buttonClick nodePopupState d' doc] [ H.div {className: "flex-center"} [buttonClick {action: doc, state: nodePopupState}]
, H.div {className: "flex-center"} , H.div {className: "flex-center"}
$ map (buttonClick nodePopupState d') buttons $ map (\t -> buttonClick {action: t, state: nodePopupState}) buttons
] ]
where
SettingsBox {edit, doc, buttons} = settingsBox nodeType
mPanelAction :: Maybe NodeAction -> Record NodePopupProps -> R.State Search -> R.Element
mPanelAction Nothing _ _ = H.div {} []
mPanelAction (Just a) p search =
panelAction {
action: a
, dispatch: p.dispatch
, id: p.id
, name: p.name
, nodePopupState: mPop
, nodeType: p.nodeType
, search
, session: p.session
}
searchIsTexIframe _id _session search@(search' /\ _) = searchIsTexIframe {nodeType} search@(search' /\ _) =
if isIsTex search'.datafield then if isIsTex search'.datafield then
H.div { className: "istex-search panel panel-default" } H.div { className: "istex-search panel panel-default" }
[ [
...@@ -308,36 +324,48 @@ nodePopupView d p mPop@(Just NodePopup /\ setPopupOpen) = R.createElement el p [ ...@@ -308,36 +324,48 @@ nodePopupView d p mPop@(Just NodePopup /\ setPopupOpen) = R.createElement el p [
Tuple (NQP.keyFromString "query") (Just (NQP.valueFromString term)) Tuple (NQP.keyFromString "query") (Just (NQP.valueFromString term))
] ]
nodePopupView _ p _ = R.createElement el p []
where
el = R.hooksComponent "CreateNodeView" cpt
cpt _ _ = pure $ H.div {} [] cpt _ _ = pure $ H.div {} []
buttonClick :: R.State { id :: ID type ActionState =
, name :: Name (
, nodeType :: GT.NodeType action :: Maybe NodeAction
, action :: Maybe NodeAction , id :: ID
} , name :: Name
-> (Action -> Aff Unit) , nodeType :: GT.NodeType
-> NodeAction )
-> R.Element
buttonClick (node@{action} /\ setNodePopup) _ todo = H.div {className: "col-md-1"}
[ H.a { style: iconAStyle type ButtonClickProps =
, className: glyphiconActive (glyphiconNodeAction todo) (
(action == (Just todo) ) action :: NodeAction
, id: show todo , state :: R.State (Record ActionState)
, title: show todo )
, onClick : mkEffectFn1
$ \_ -> setNodePopup
$ const (node { action = action' }) buttonClick :: Record ButtonClickProps -> R.Element
} buttonClick p = R.createElement buttonClickCpt p []
[]
] buttonClickCpt :: R.Component ButtonClickProps
where buttonClickCpt = R.hooksComponent "G.C.F.T.N.B.buttonClick" cpt
action' = if action == (Just todo) where
then Nothing cpt {action: todo, state: (node@{action} /\ setNodePopup)} _ = do
else (Just todo) pure $ H.div {className: "col-md-1"}
[ H.a { style: iconAStyle
, className: glyphiconActive (glyphiconNodeAction todo)
(action == (Just todo) )
, id: show todo
, title: show todo
, onClick : mkEffectFn1
$ \_ -> setNodePopup
$ const (node { action = action' })
}
[]
]
where
action' = if action == (Just todo)
then Nothing
else (Just todo)
-- END Popup View -- END Popup View
...@@ -352,45 +380,70 @@ type Open = Boolean ...@@ -352,45 +380,70 @@ type Open = Boolean
type PanelActionProps = type PanelActionProps =
( id :: ID ( id :: ID
, action :: Maybe NodeAction , action :: NodeAction
, dispatch :: Dispatch
, name :: Name , name :: Name
, nodePopupState :: R.State (Maybe NodePopup)
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
, session :: Session , session :: Session
, search :: R.State Search , search :: R.State Search
) )
panelAction :: (Action -> Aff Unit) panelAction :: Record PanelActionProps -> R.Element
-> Record PanelActionProps panelAction p = R.createElement panelActionCpt p []
-> R.State (Maybe NodePopup)
-> R.Element panelActionCpt :: R.Component PanelActionProps
panelAction d {id, name, nodeType, action, session, search} p = case action of panelActionCpt = R.hooksComponent "G.C.F.T.N.B.panelAction" cpt
(Just (Documentation GT.NodeUser)) -> R.fragment [H.div {style: {margin: "10px"}} [ infoTitle GT.NodeUser
, H.p {} [ H.text "This account is personal"]
, H.p {} [ H.text "See the instances terms of uses."]
]
]
(Just (Documentation GT.FolderPrivate)) -> fragmentPT "This folder and its children are private only!"
(Just (Documentation GT.FolderPublic)) -> fragmentPT "Soon, you will be able to build public folders to share your work with the world!"
(Just (Documentation GT.FolderShared)) -> fragmentPT "Soon, you will be able to build teams folders to share your work"
(Just (Documentation x)) -> fragmentPT $ "More information on" <> show nodeType
(Just (Link _)) -> fragmentPT "Soon, you will be able to link the corpus with your Annuaire (and reciprocally)."
(Just Upload) -> uploadFileView d {id, nodeType, session}
(Just Download) -> fragmentPT "Soon, you will be able to dowload your file here"
(Just SearchBox) -> R.fragment [ H.p {"style": {"margin" :"10px"}} [ H.text $ "Search and create a private corpus with the search query as corpus name." ]
, searchBar {langs: allLangs, onSearch, search, session}
]
(Just Delete) -> case nodeType of
GT.NodeUser -> R.fragment [ H.div {style: {margin: "10px"}} [H.text "Yes, we are RGPD compliant! But you can not delete User Node yet (we are still on development). Thanks for your comprehensin."]]
_ -> R.fragment [ H.div {style: {margin: "10px"}} (map (\t -> H.p {} [H.text t]) ["Are your sure you want to delete it ?", "If yes, click again below."]), reallyDelete d]
(Just (Add xs)) -> createNodeView d {id, name, nodeType} p xs
_ -> H.div {} []
where where
cpt {action: Documentation GT.NodeUser} _ = do
pure $ R.fragment [
H.div {style: {margin: "10px"}} [ infoTitle GT.NodeUser
, H.p {} [ H.text "This account is personal"]
, H.p {} [ H.text "See the instances terms of uses."]
]
]
cpt {action: Documentation GT.FolderPrivate} _ = do
pure $ fragmentPT "This folder and its children are private only!"
cpt {action: Documentation GT.FolderPublic} _ = do
pure $ fragmentPT "Soon, you will be able to build public folders to share your work with the world!"
cpt {action: Documentation GT.FolderShared} _ = do
pure $ fragmentPT "Soon, you will be able to build teams folders to share your work"
cpt {action: Documentation x, nodeType} _ = do
pure $ fragmentPT $ "More information on" <> show nodeType
cpt {action: Link _} _ = do
pure $ fragmentPT "Soon, you will be able to link the corpus with your Annuaire (and reciprocally)."
cpt {action: Upload, dispatch, id, nodeType: GT.NodeList, session} _ = do
pure $ uploadTermListView {dispatch, id, nodeType: GT.NodeList, session}
cpt {action: Upload, dispatch, id, nodeType, session} _ = do
pure $ uploadFileView {dispatch, id, nodeType, session}
cpt {action: Download} _ = do
pure $ fragmentPT "Soon, you will be able to dowload your file here"
cpt props@{action: SearchBox, search, session} _ = do
pure $ R.fragment [
H.p {"style": {"margin" :"10px"}} [ H.text $ "Search and create a private corpus with the search query as corpus name." ]
, searchBar {langs: allLangs, onSearch: onSearch props, search, session}
]
cpt {action: Delete, nodeType: GT.NodeUser} _ = do
pure $ R.fragment [
H.div {style: {margin: "10px"}} [H.text "Yes, we are RGPD compliant! But you can not delete User Node yet (we are still on development). Thanks for your comprehensin."]
]
cpt {action: Delete, dispatch: d} _ = do
pure $ R.fragment [
H.div {style: {margin: "10px"}} (map (\t -> H.p {} [H.text t]) ["Are your sure you want to delete it ?", "If yes, click again below."])
, reallyDelete d
]
cpt {action: Add xs, dispatch: d, id, name, nodePopupState: p, nodeType} _ = do
pure $ createNodeView d {id, name, nodeType} p xs
cpt {action: CopyFromCorpus, dispatch, id, nodeType, session} _ = do
pure $ copyFromCorpusView {dispatch, id, nodeType, session}
cpt _ _ = do
pure $ H.div {} []
fragmentPT text = H.div {style: {margin: "10px"}} [H.text text] fragmentPT text = H.div {style: {margin: "10px"}} [H.text text]
onSearch :: GT.AsyncTaskWithType -> Effect Unit onSearch :: Record PanelActionProps -> GT.AsyncTaskWithType -> Effect Unit
onSearch task = do onSearch {dispatch: d, nodePopupState: p} task = do
_ <- launchAff $ d (SearchQuery task) _ <- launchAff $ d (SearchQuery task)
-- close popup -- close popup
snd p $ const Nothing snd p $ const Nothing
...@@ -402,7 +455,7 @@ infoTitle nt = H.div {style: {margin: "10px"}} [ H.h3 {} [H.text "Documentation ...@@ -402,7 +455,7 @@ infoTitle nt = H.div {style: {margin: "10px"}} [ H.h3 {} [H.text "Documentation
, H.h3 {className: GT.fldr nt true} [ H.text $ show nt ] , H.h3 {className: GT.fldr nt true} [ H.text $ show nt ]
] ]
reallyDelete :: (Action -> Aff Unit) -> R.Element reallyDelete :: Dispatch -> R.Element
reallyDelete d = H.div {className: "panel-footer"} reallyDelete d = H.div {className: "panel-footer"}
[ H.a { type: "button" [ H.a { type: "button"
, className: "btn glyphicon glyphicon-trash" , className: "btn glyphicon glyphicon-trash"
......
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