diff --git a/src/Gargantext/Components/Annotation/AnnotatedField.purs b/src/Gargantext/Components/Annotation/AnnotatedField.purs index 7d370e206b9d84acb21a114f857efcaa8d03cf49..0a9cb98906d87c783aa15c0f5b7647c546cce8dd 100644 --- a/src/Gargantext/Components/Annotation/AnnotatedField.purs +++ b/src/Gargantext/Components/Annotation/AnnotatedField.purs @@ -15,6 +15,7 @@ import Prelude 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.Uncurried ( mkEffectFn1 ) @@ -51,8 +52,12 @@ annotatedFieldComponent = R.hooksComponent "AnnotatedField" cpt let wrapperProps = { className: "annotated-field-wrapper" } - onSelect _ Nothing event = maybeShowMenu setMenu setTermList ngrams event + onSelect text' Nothing event = do + log2 "[onSelect] text'" text' + maybeShowMenu setMenu setTermList ngrams event onSelect text' (Just list) event = do + log2 "[onSelect] text'" text' + log2 "[onSelect] list" list let x = E.clientX event y = E.clientY event setList t = do diff --git a/src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs b/src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs index affb817348320e9523bea7180bdaf62215d549a7..92bd567d711e9f151cc4f9cf209f198619696865 100644 --- a/src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs +++ b/src/Gargantext/Components/Forest/Tree/Node/Action/Upload.purs @@ -1,23 +1,57 @@ module Gargantext.Components.Forest.Tree.Node.Action.Upload where -import Data.Newtype (class Newtype) -import Effect.Aff (Aff, launchAff) -import Gargantext.Sessions (Session, postWwwUrlencoded) -import Gargantext.Types (class ToQuery, toQuery, NodeType(..)) -import Gargantext.Routes (SessionRoute(..)) -import Prelude (class Show, Unit, const, discard, map, pure, show, ($), (<>)) +import Prelude (class Show, Unit, const, discard, map, pure, show, ($), (<>), bind, void, unit) import Data.Maybe (Maybe(..)) -import URI.Extra.QueryPairs as QP -import Gargantext.Components.Forest.Tree.Node.Action -import Reactix as R +import Data.Newtype (class Newtype) import Data.Tuple (Tuple) -import URI.Query as Q -import Reactix.DOM.HTML as H +import Data.Tuple.Nested ((/\)) +import DOM.Simple.Console (log2) +import Effect.Aff (Aff, launchAff, runAff) +import Effect.Class (liftEffect) import Effect.Uncurried (mkEffectFn1) import FFI.Simple ((..)) +import React.SyntheticEvent as E +import Reactix as R +import Reactix.DOM.HTML as H +import URI.Extra.QueryPairs as QP +import URI.Query as Q +import Web.File.FileReader.Aff (readAsText) + +import Gargantext.Components.Forest.Tree.Node.Action +import Gargantext.Routes (SessionRoute(..)) +import Gargantext.Sessions (Session, postWwwUrlencoded) +import Gargantext.Types (class ToQuery, toQuery, NodeType(..)) import Gargantext.Utils (id) import Gargantext.Utils.Reactix as R2 -import Data.Tuple.Nested ((/\)) + + +type UploadFileProps = + ( id :: Int + , mFileType :: Maybe FileType + ) + + +uploadFileView :: (Action -> Aff Unit) -> Record UploadFileProps -> R.Element +uploadFileView d props = R.createElement (uploadFileViewCpt d) props [] + +uploadFileViewCpt :: (Action -> Aff Unit) -> R.Component UploadFileProps +uploadFileViewCpt d = R.hooksComponent "UploadFileView" cpt + where + cpt {mFileType} _ = do + pure $ H.div {} [ + H.div {} [ H.text "Upload file!" ] + , H.div {} [ H.input {type: "file", placeholder: "Choose file", on: {change: onChange}} ] + ] + onChange = mkEffectFn1 $ \e -> do + log2 "[uploadFileViewCpt onChange] e" e + blob <- R2.inputFileBlob e + E.preventDefault e + E.stopPropagation e + log2 "[uploadFileViewCpt onChange] blob" blob + void $ runAff (\_ -> pure unit) do + contents <- readAsText blob + liftEffect $ do + log2 "[uploadFileViewCpt] contents" contents -- START File Type View type FileTypeProps = @@ -107,5 +141,4 @@ uploadFile session id fileType (UploadFileContents fileContents) = postWwwUrlencoded session p fileContents where q = FileUploadQuery { fileType: fileType } - p = NodeAPI Node (Just id) $ "upload" <> Q.print (toQuery q) - + p = NodeAPI Node (Just id) $ "add/file" <> Q.print (toQuery q) diff --git a/src/Gargantext/Components/Forest/Tree/Node/Box.purs b/src/Gargantext/Components/Forest/Tree/Node/Box.purs index 8f470c3573e01bcba278bd676906889ded753b79..35acc0fad42b9547167eaf5ebef15b2b7b69c2ba 100644 --- a/src/Gargantext/Components/Forest/Tree/Node/Box.purs +++ b/src/Gargantext/Components/Forest/Tree/Node/Box.purs @@ -1,18 +1,20 @@ module Gargantext.Components.Forest.Tree.Node.Box where -import DOM.Simple.Console (log2) import Data.Maybe (Maybe(..), fromJust) import Data.Tuple (Tuple(..)) import Data.Tuple.Nested ((/\)) +import DOM.Simple.Console (log2) +import DOM.Simple.Event (class IsEvent) import Effect.Aff (Aff, launchAff, runAff) import Effect.Class (liftEffect) +import Effect (Effect) import Effect.Uncurried (mkEffectFn1) import FFI.Simple ((..)) import Gargantext.Components.Forest.Tree.Node (NodeAction(..), SettingsBox(..), glyphiconNodeAction, settingsBox) 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.Rename (renameBox) -import Gargantext.Components.Forest.Tree.Node.Action.Upload (fileTypeView) +import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFileView, fileTypeView) import Gargantext.Components.Search.Types (allLangs) import Gargantext.Components.Search.SearchBar (searchBar) import Gargantext.Components.Search.SearchField (Search, defaultSearch, isIsTex) @@ -29,6 +31,7 @@ import Prelude (Unit, bind, const, discard, identity, map, pure, show, unit, voi import React.SyntheticEvent as E import Reactix as R import Reactix.DOM.HTML as H +import Reactix.SyntheticEvent as RE import URI.Extra.QueryPairs as NQP import URI.Query as Query import Web.File.File (toBlob) @@ -105,13 +108,11 @@ nodeMainSpan d p folderOpen session frontends = R.createElement el p [] dropClass (Just _ /\ _) _ = "file-dropped" dropClass _ (true /\ _) = "file-dropped" dropClass (Nothing /\ _) _ = "" - dropHandler (_ /\ setDroppedFile) e = unsafePartial $ do - let ff = fromJust $ item 0 $ ((e .. "dataTransfer" .. "files") :: FileList) - liftEffect $ log2 "drop:" ff + dropHandler (_ /\ setDroppedFile) e = do -- prevent redirection when file is dropped E.preventDefault e E.stopPropagation e - let blob = toBlob $ ff + blob <- R2.dataTransferFileBlob e void $ runAff (\_ -> pure unit) do contents <- readAsText blob liftEffect $ setDroppedFile @@ -356,7 +357,7 @@ panelAction d {id, name, nodeType, action, session, search} p = case action of (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) -> fragmentPT "Soon, you will be able to upload your file here" + (Just Upload) -> uploadFileView d {id, mFileType: Nothing} (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." ] diff --git a/src/Gargantext/Components/Search/SearchField.purs b/src/Gargantext/Components/Search/SearchField.purs index 875682427d921b5165a585951041a67ef293e875..fe9a17decdd86ffe758fcdaece0a9baef753dc7a 100644 --- a/src/Gargantext/Components/Search/SearchField.purs +++ b/src/Gargantext/Components/Search/SearchField.purs @@ -1,12 +1,13 @@ module Gargantext.Components.Search.SearchField ( Search, Props, defaultSearch, searchField, searchFieldComponent, isIsTex) where -import Prelude (const, map, pure, show, ($), (&&), (<), (<$>), (<>), (==)) +import Prelude (const, map, pure, show, discard, ($), (&&), (<), (<$>), (<>), (==)) import Data.Maybe (Maybe(..), maybe) import Data.String (length) import Data.Set as Set import Data.Tuple (fst) import Data.Tuple.Nested ((/\)) +import DOM.Simple.Console (log2) import Gargantext.Utils.Reactix as R2 import FFI.Simple ((..)) import Reactix as R @@ -321,6 +322,7 @@ submitButton (search /\ setSearch) = } [ H.text "Launch Search" ] where doSearch = \_ -> do + log2 "[submitButton] searching" search case search.term of "" -> setSearch $ const defaultSearch _ -> setSearch $ const search diff --git a/src/Gargantext/Ends.purs b/src/Gargantext/Ends.purs index d6b963d8538fbd82aac6d432e4d7fc8868a20f44..0e84ba3b624c5241e6c53b27d678f8775a619813 100644 --- a/src/Gargantext/Ends.purs +++ b/src/Gargantext/Ends.purs @@ -3,16 +3,14 @@ module Gargantext.Ends -- ( ) where -import Prelude (class Eq, class Show, identity, show, ($), (<>), bind, pure, (<<<), (==)) -import Data.Argonaut ( class DecodeJson, decodeJson, class EncodeJson, (:=), (~>), jsonEmptyObject, (.:)) +import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, (:=), (~>), jsonEmptyObject, (.:)) import Data.Foldable (foldMap) import Data.Generic.Rep (class Generic) import Data.Generic.Rep.Eq (genericEq) -import Data.Maybe (Maybe, maybe) +import Data.Maybe (Maybe(..), maybe) import Gargantext.Routes as R -import Gargantext.Types - ( ApiVersion, Limit, NodePath, NodeType(..), Offset, TabType(..) - , TermSize(..), nodePath, nodeTypePath, showTabType') +import Gargantext.Types (ApiVersion, Limit, NodePath, NodeType(..), Offset, TabType(..), TermSize(..), nodePath, nodeTypePath, showTabType') +import Prelude (class Eq, class Show, identity, show, ($), (<>), bind, pure, (<<<), (==)) -- | A means of generating a url to visit, a destination class ToUrl conf p where @@ -149,12 +147,23 @@ sessionPath (R.PutNgrams t listId termList i) = sessionPath (R.NodeAPI nt i p) = nodeTypePath nt <> (maybe "" (\i' -> "/" <> show i') i) <> (if p == "" then "" else "/" <> p) -sessionPath (R.Search {listId,limit,offset,orderBy} i) = - sessionPath $ R.NodeAPI Corpus i +sessionPath (R.Search {listId, limit, offset, orderBy} Nothing) = + sessionPath $ R.NodeAPI Corpus Nothing + $ "search?list_id=" <> show listId + <> offsetUrl offset + <> limitUrl limit + <> orderUrl orderBy +sessionPath (R.Search {listId, limit, offset, orderBy} (Just corpusId)) = + sessionPath $ R.NodeAPI Corpus (Just corpusId) $ "search?list_id=" <> show listId <> offsetUrl offset <> limitUrl limit <> orderUrl orderBy +-- sessionPath (R.Search {listId, limit, offset, orderBy} (Just corpusId)) = +-- "search/" <> (show corpusId) <> "/list/" <> (show listId) <> "?" +-- <> offsetUrl offset +-- <> limitUrl limit +-- <> orderUrl orderBy sessionPath (R.CorpusMetrics {tabType, listId, limit} i) = sessionPath $ R.NodeAPI Corpus i $ "metrics" diff --git a/src/Gargantext/Utils/Reactix.purs b/src/Gargantext/Utils/Reactix.purs index 0655fe8440cc49b4c67aba48c219f7f353644a00..c68ab7184f931cb1d2f8337f384f5322aef1f24a 100644 --- a/src/Gargantext/Utils/Reactix.purs +++ b/src/Gargantext/Utils/Reactix.purs @@ -8,7 +8,7 @@ import DOM.Simple.Document (document) import DOM.Simple.Element as Element import DOM.Simple.Event as DE import DOM.Simple.Types (class IsNode) -import Data.Maybe (Maybe(..)) +import Data.Maybe (Maybe(..), fromJust) import Data.Nullable (Nullable, null, toMaybe) import Data.Tuple (Tuple) import Data.Tuple.Nested ((/\)) @@ -17,16 +17,19 @@ import Effect.Aff (Aff, launchAff, launchAff_, killFiber) import Effect.Class (liftEffect) import Effect.Exception (error) import Effect.Uncurried (EffectFn1, runEffectFn1, mkEffectFn1, mkEffectFn2) -import FFI.Simple ((...), defineProperty, delay, args2, args3) +import FFI.Simple ((..), (...), defineProperty, delay, args2, args3) +import Partial.Unsafe (unsafePartial) import React (class ReactPropFields, Children, ReactClass, ReactElement) import React as React import Reactix as R -import Reactix.DOM.HTML as H import Reactix.DOM.HTML (ElemFactory, createDOM, text) +import Reactix.DOM.HTML as H import Reactix.React (react) import Reactix.SyntheticEvent as RE import Reactix.Utils (currySecond, hook, tuple) import Unsafe.Coerce (unsafeCoerce) +import Web.File.File (toBlob) +import Web.File.FileList (FileList, item) newtype Point = Point { x :: Number, y :: Number } @@ -208,3 +211,15 @@ useCache i f = do R.unsafeHooksEffect (R.setRef iRef $ Just i) R.unsafeHooksEffect (R.setRef oRef $ Just new) pure new + +-- | Get blob from an 'onchange' e.target event +inputFileBlob e = unsafePartial $ do + let el = e .. "target" + let ff = fromJust $ item 0 $ ((el .. "files") :: FileList) + pure $ toBlob ff + +-- | Get blob from a drop event +--dataTransferFileBlob :: forall e. DE.IsEvent e => RE.SyntheticEvent e -> Effect Blob +dataTransferFileBlob e = unsafePartial $ do + let ff = fromJust $ item 0 $ ((e .. "dataTransfer" .. "files") :: FileList) + pure $ toBlob ff