Verified Commit 7ec15fbf authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Merge branch 'dev' into dev-searx-parser

parents 66cfeb1f caccdc99
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
......@@ -35,8 +35,6 @@ let
'';
build-watch = pkgs.writeShellScriptBin "build-watch" ''
#!/usr/bin/env bash
set -e
......@@ -45,6 +43,15 @@ let
spago build -w --then browserify
'';
build-zephyr = pkgs.writeShellScriptBin "build-zephyr" ''
#!/usr/bin/env bash
set -e
spago build --purs-args '--codegen corefn,js'
zephyr -f Main.main
yarn parcel build dist/index.html --public-url '.' --no-source-maps
'';
browserify = pkgs.writeShellScriptBin "browserify" ''
#!/usr/bin/env bash
set -e
......@@ -82,10 +89,12 @@ pkgs.mkShell {
easy-ps.purs-0_14_4
easy-ps.psc-package
easy-ps.dhall-json-simple
easy-ps.zephyr
browserify
build-css
build-purs
build-watch
build-zephyr
build
minify-bundle
pkgs.minify
......
......@@ -94,9 +94,9 @@ asyncTaskTTriggersMainPageReload :: GT.AsyncTaskWithType -> Boolean
asyncTaskTTriggersMainPageReload (GT.AsyncTaskWithType { typ }) = asyncTaskTriggersMainPageReload typ
asyncTaskTriggersTreeReload :: GT.AsyncTaskType -> Boolean
asyncTaskTriggersTreeReload GT.Form = true
asyncTaskTriggersTreeReload GT.UploadFile = true
asyncTaskTriggersTreeReload _ = false
asyncTaskTriggersTreeReload GT.CorpusFormUpload = true
asyncTaskTriggersTreeReload GT.UploadFile = true
asyncTaskTriggersTreeReload _ = false
asyncTaskTTriggersTreeReload :: GT.AsyncTaskWithType -> Boolean
asyncTaskTTriggersTreeReload (GT.AsyncTaskWithType { typ }) = asyncTaskTriggersTreeReload typ
......@@ -8,6 +8,11 @@ import Data.Traversable (traverse_)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
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.App.Data (Boxes)
import Gargantext.Components.Forest.Tree.Node.Action.Add (AddNodeValue(..), addNode)
......@@ -35,10 +40,6 @@ import Gargantext.Types as GT
import Gargantext.Utils.Popover as Popover
import Gargantext.Utils.Reactix as R2
import Gargantext.Utils.Toestand as T2
import Reactix as R
import Reactix.DOM.HTML as H
import Record as Record
import Toestand as T
foreign import back :: Effect Unit
foreign import link :: String -> Effect Unit
......
......@@ -22,7 +22,7 @@ import Gargantext.Components.Forest.Tree.Node.Action.Rename (RenameValue(..), re
import Gargantext.Components.Forest.Tree.Node.Action.Share as Share
import Gargantext.Components.Forest.Tree.Node.Action.Types (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Update (updateRequest)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile, uploadArbitraryFile)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile, uploadArbitraryFile, uploadFrameCalc)
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..), fTreeID)
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut(..))
import Gargantext.Config.REST (RESTError)
......@@ -283,6 +283,12 @@ uploadArbitraryFile' mName blob p@{ boxes: { errors, tasks }, session, tree: (NT
GAT.insert id task tasks
here.log2 "[uploadArbitraryFile'] UploadArbitraryFile, uploaded, task:" task
uploadFrameCalc' p@{ boxes: { errors, tasks }, session, tree: (NTree (LNode { id }) _) } = do
eTask <- uploadFrameCalc session id
handleRESTError errors eTask $ \task -> liftEffect $ do
GAT.insert id task tasks
here.log2 "[performAction] UploadFrameCalc, uploaded, task:" task
moveNode params p@{ boxes: { errors, forestOpen }, session } = traverse_ f params where
f (SubTreeOut { in: in', out }) = do
eTask <- moveNodeReq session in' out
......@@ -313,6 +319,7 @@ performAction (ShareTeam username) p = shareTeam userna
performAction (SharePublic { params }) p = sharePublic params p
performAction (AddContact params) p = addContact params p
performAction (AddNode name nodeType) p = addNode' name nodeType p
performAction UploadFrameCalc p = uploadFrameCalc' p
performAction (UploadFile nodeType fileType mName contents selection) p =
uploadFile' nodeType fileType mName contents p selection
performAction (UploadArbitraryFile mName blob selection) p =
......
......@@ -123,7 +123,7 @@ nodeMainSpanCpt = here.component "nodeMainSpan" cpt
, nodeType
, session } []
, fileTypeView { dispatch, droppedFile, id, isDragOver, nodeType }
, fileTypeView { dispatch, droppedFile, id, isDragOver, nodeType } []
, H.div {} (map (\t -> asyncProgressBar { asyncTask: t
, barType: Pie
, errors
......
......@@ -18,7 +18,6 @@ type Props =
, session :: Session
)
subTreeOut :: Action -> Maybe SubTreeOut
subTreeOut (MoveNode {params}) = params
subTreeOut (MergeNode {params}) = params
......@@ -45,6 +44,7 @@ icon (SharePublic _ ) = glyphiconNodeAction (Publish { subTreeParams
icon (DoSearch _) = glyphiconNodeAction SearchBox
icon (UploadFile _ _ _ _ _) = glyphiconNodeAction Upload
icon (UploadArbitraryFile _ _ _ ) = glyphiconNodeAction Upload
icon UploadFrameCalc = glyphiconNodeAction Upload
icon RefreshTree = glyphiconNodeAction Refresh
icon ClosePopover = glyphiconNodeAction CloseNodePopover
icon DownloadNode = glyphiconNodeAction Download
......@@ -67,6 +67,7 @@ text (SharePublic _ ) = "Publish !"
text (DoSearch _ ) = "Launch search !"
text (UploadFile _ _ _ _ _) = "Upload File !"
text (UploadArbitraryFile _ _ _) = "Upload arbitrary file !"
text UploadFrameCalc = "Upload frame calc"
text RefreshTree = "Refresh Tree !"
text ClosePopover = "Close Popover !"
text DownloadNode = "Download !"
......
......@@ -18,6 +18,7 @@ data Action = AddNode String GT.NodeType
| DoSearch GT.AsyncTaskWithType
| UploadFile GT.NodeType FileType (Maybe String) String Selection
| UploadArbitraryFile (Maybe String) UploadFileBlob Selection
| UploadFrameCalc
| DownloadNode
| RefreshTree
| ClosePopover
......@@ -42,6 +43,7 @@ instance Eq Action where
eq (UploadFile nt1 ft1 s1 _ _) (UploadFile nt2 ft2 s2 _ _) =
(eq nt1 nt2) && (eq ft1 ft2) && (eq s1 s2)
eq (UploadArbitraryFile s1 _ _) (UploadArbitraryFile s2 _ _) = eq s1 s2
eq UploadFrameCalc UploadFrameCalc = true
eq DownloadNode DownloadNode = true
eq RefreshTree RefreshTree = true
eq ClosePopover ClosePopover = true
......@@ -65,6 +67,7 @@ instance Show Action where
show (DoSearch _ ) = "SearchQuery"
show (UploadFile _ _ _ _ _) = "UploadFile"
show (UploadArbitraryFile _ _ _) = "UploadArbitraryFile"
show UploadFrameCalc = "UploadFrameCalc"
show RefreshTree = "RefreshTree"
show ClosePopover = "ClosePopover"
show DownloadNode = "Download"
......
......@@ -24,8 +24,8 @@ import Gargantext.Components.ListSelection.Types (Selection(..))
import Gargantext.Components.ListSelection.Types as ListSelection
import Gargantext.Config.REST (RESTError)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session(..), postWwwUrlencoded)
import Gargantext.Types (NodeType(..), ID)
import Gargantext.Types (ID, NodeType(..))
import Gargantext.Sessions (Session, postWwwUrlencoded, post)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Partial.Unsafe (unsafePartial, unsafeCrashWith)
......@@ -55,7 +55,8 @@ actionUploadCpt = here.component "actionUpload" cpt where
cpt { nodeType: Corpus, dispatch, id, session } _ =
pure $ uploadFileView { dispatch, id, nodeType: GT.Corpus, session }
cpt { nodeType: NodeList, dispatch, id, session } _ =
pure $ uploadTermListView { dispatch, id, nodeType: GT.NodeList, session }
pure $ uploadTermListView { dispatch, id, nodeType: GT.NodeList, session } []
cpt props@{ nodeType: NodeFrameCalc } _ = pure $ uploadFrameCalcView props []
cpt props@{ nodeType: _ } _ = pure $ actionUploadOther props []
{-
......@@ -143,7 +144,7 @@ uploadFileViewCpt = here.component "uploadFileView" cpt
, mFile
, nodeType
, selection
}
} []
]
pure $ panel bodies footer
......@@ -170,8 +171,8 @@ type UploadButtonProps =
, selection :: T.Box ListSelection.Selection
)
uploadButton :: Record UploadButtonProps -> R.Element
uploadButton props = R.createElement uploadButtonCpt props []
uploadButton :: R2.Component UploadButtonProps
uploadButton = R.createElement uploadButtonCpt
uploadButtonCpt :: R.Component UploadButtonProps
uploadButtonCpt = here.component "uploadButton" cpt
where
......@@ -222,8 +223,8 @@ type FileTypeProps =
, nodeType :: GT.NodeType
)
fileTypeView :: Record FileTypeProps -> R.Element
fileTypeView p = R.createElement fileTypeViewCpt p []
fileTypeView :: R2.Component FileTypeProps
fileTypeView = R.createElement fileTypeViewCpt
fileTypeViewCpt :: R.Component FileTypeProps
fileTypeViewCpt = here.component "fileTypeView" cpt
where
......@@ -236,7 +237,7 @@ fileTypeViewCpt = here.component "fileTypeView" cpt
case droppedFile' of
Nothing -> pure $ H.div {} []
Just df@(DroppedFile _) ->
Just df ->
pure $ H.div tooltipProps [ H.div { className: "card"}
[ panelHeading
, panelBody df
......@@ -303,6 +304,7 @@ fileTypeViewCpt = here.component "fileTypeView" cpt
]
newtype FileUploadQuery = FileUploadQuery {
fileType :: FileType
}
......@@ -338,20 +340,20 @@ uploadFile { contents, fileType: CSV, id, nodeType: NodeList, mName, session } =
, Tuple "_wtf_filetype" (Just $ show NodeList)
, Tuple "_wtf_name" mName ]
eTask <- postWwwUrlencoded session url body
pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.Form }) <$> eTask
pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.ListCSVUpload }) <$> eTask
uploadFile { contents, fileType, id, nodeType, mName, session } = do
-- contents <- readAsText blob
eTask :: Either RESTError GT.AsyncTask <- postWwwUrlencoded session p bodyParams
pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.Form }) <$> eTask
pure $ (\task -> GT.AsyncTaskWithType { task, typ }) <$> eTask
--postMultipartFormData session p fileContents
where
p = case nodeType of
Corpus -> GR.NodeAPI nodeType (Just id) $ GT.asyncTaskTypePath GT.Form
Annuaire -> GR.NodeAPI nodeType (Just id) "annuaire"
Tuple typ p = case nodeType of
Corpus -> Tuple GT.CorpusFormUpload (GR.NodeAPI nodeType (Just id) $ GT.asyncTaskTypePath GT.CorpusFormUpload)
Annuaire -> Tuple GT.UploadFile (GR.NodeAPI nodeType (Just id) "annuaire")
NodeList -> case fileType of
JSON -> GR.NodeAPI nodeType (Just id) $ GT.asyncTaskTypePath GT.ListUpload
_ -> GR.NodeAPI nodeType (Just id) ""
_ -> GR.NodeAPI nodeType (Just id) ""
JSON -> Tuple GT.ListUpload (GR.NodeAPI nodeType (Just id) $ GT.asyncTaskTypePath GT.ListUpload)
_ -> Tuple GT.UploadFile (GR.NodeAPI nodeType (Just id) "")
_ -> Tuple GT.UploadFile (GR.NodeAPI nodeType (Just id) "")
bodyParams = [ Tuple "_wf_data" (Just contents)
, Tuple "_wf_filetype" (Just $ show fileType)
......@@ -377,7 +379,7 @@ uploadArbitraryDataURL session id mName contents' = do
let re = fromRight' (\_ -> unsafeCrashWith "Unexpected Left") $ DSR.regex "data:.*;base64," DSRF.noFlags
contents = DSR.replace re "" contents'
eTask :: Either RESTError GT.AsyncTask <- postWwwUrlencoded session p (bodyParams contents)
pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.Form }) <$> eTask
pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.UploadFile }) <$> eTask
where
p = GR.NodeAPI GT.Node (Just id) $ GT.asyncTaskTypePath GT.UploadFile
......@@ -387,12 +389,12 @@ uploadArbitraryDataURL session id mName contents' = do
------------------------------------------------------------------------
uploadTermListView :: Record Props -> R.Element
uploadTermListView props = R.createElement uploadTermListViewCpt props []
uploadTermListView :: R2.Component Props
uploadTermListView = R.createElement uploadTermListViewCpt
uploadTermListViewCpt :: R.Component Props
uploadTermListViewCpt = here.component "uploadTermListView" cpt
where
cpt {dispatch, id, nodeType} _ = do
cpt { dispatch, nodeType } _ = do
let defaultUploadType = JSON
mFile <- T.useBox (Nothing :: Maybe UploadFile)
uploadType <- T.useBox defaultUploadType
......@@ -410,7 +412,6 @@ uploadTermListViewCpt = here.component "uploadTermListView" cpt
, on: { change: onUploadTypeChange uploadType } } (opt <$> [ CSV, JSON ])
let footer = H.div {} [ uploadTermButton { dispatch
, id
, mFile
, nodeType
, uploadType
......@@ -447,7 +448,6 @@ uploadTermListViewCpt = here.component "uploadTermListView" cpt
type UploadTermButtonProps =
( dispatch :: Action -> Aff Unit
, id :: Int
, mFile :: T.Box (Maybe UploadFile)
, nodeType :: GT.NodeType
, uploadType :: T.Box FileType
......@@ -484,3 +484,40 @@ uploadTermButtonCpt = here.component "uploadTermButton" cpt
_ <- dispatch $ UploadFile nodeType uploadType' (Just name) contents (SelectedLists [])
liftEffect $ do
T.write_ Nothing mFile
------------------------------------------------------------------------
uploadFrameCalcView :: R2.Component Props
uploadFrameCalcView = R.createElement uploadFrameCalcViewCpt
uploadFrameCalcViewCpt :: R.Component Props
uploadFrameCalcViewCpt = here.component "uploadFrameCalcView" cpt
where
cpt { dispatch } _ = do
let bodies =
[ R2.row
[ H.div { className: "col-12 flex-space-around" }
[ H.h4 {}
[ H.text "This will upload current calc as Corpus CSV" ]
]
]
]
let footer = H.div {}
[ H.button { className: "btn btn-primary"
, on: { click: onClick } }
[ H.text "Upload!" ]
]
pure $ panel bodies footer
where
onClick _ = do
void $ launchAff do
dispatch UploadFrameCalc
uploadFrameCalc :: Session
-> ID
-> Aff (Either RESTError GT.AsyncTaskWithType)
uploadFrameCalc session id = do
let p = GR.NodeAPI GT.Node (Just id) $ GT.asyncTaskTypePath GT.UploadFrameCalc
eTask <- post session p ([] :: Array String)
pure $ (\task -> GT.AsyncTaskWithType { task, typ: GT.UploadFrameCalc }) <$> eTask
......@@ -202,5 +202,5 @@ panelActionCpt = here.component "panelAction" cpt
cpt { action : Publish {subTreeParams}, boxes, dispatch, id, nodeType, session } _ =
pure $ Share.publishNode { boxes, dispatch, id, nodeType, session, subTreeParams } []
cpt { action: SearchBox, boxes, dispatch, id, session } _ =
pure $ actionSearch { boxes, dispatch, id: (Just id), session } []
pure $ actionSearch { boxes, dispatch, id: Just id, session } []
cpt _ _ = pure $ H.div {} []
......@@ -323,7 +323,8 @@ settingsBox NodeFrameCalc =
SettingsBox { show : true
, edit : true
, doc : Documentation NodeFrameCalc
, buttons : [ Add [ NodeFrameCalc
, buttons : [ Upload
, Add [ NodeFrameCalc
, NodeFrameWrite
]
, Move moveFrameParameters
......
module Gargantext.Components.Forest.Tree.Node.Tools.Sync where
import Gargantext.Prelude
( Unit, bind, discard, pure, unit, ($), (<>), (==) )
import Gargantext.Prelude (Unit, bind, discard, pure, unit, ($), (<>), (==))
import Effect.Aff (Aff, launchAff_)
import Data.Maybe (Maybe(..))
import Effect.Class (liftEffect)
......
......@@ -137,6 +137,8 @@ listTreeChildrenLoadedCpt = here.component "listTreeChildrenLoaded" cpt where
cpt { loaded, render, root, selection, session } _ = do
pure $ H.div { className: "children" } (element <$> loaded)
where
element (NodeSimple { id, name, nodeType: nodeType@Corpus }) =
render { root: id, name, nodeType, selection, session }
element (NodeSimple { id, name, nodeType: nodeType@Folder }) =
render { root: id, name, nodeType, selection, session }
element (NodeSimple { id, name, nodeType: nodeType@FolderPrivate }) =
......@@ -145,10 +147,10 @@ listTreeChildrenLoadedCpt = here.component "listTreeChildrenLoaded" cpt where
render { root: id, name, nodeType, selection, session }
element (NodeSimple { id, name, nodeType: nodeType@FolderShared }) =
render { root: id, name, nodeType, selection, session }
element (NodeSimple { id, name, nodeType: nodeType@Corpus }) =
render { root: id, name, nodeType, selection, session }
element (NodeSimple { id, name, nodeType: NodeList}) =
renderListElement { id, name, selection }
element (NodeSimple { id, name, nodeType: nodeType@Team }) =
render { root: id, name, nodeType, selection, session }
element _ = H.div {} []
type RenderListElementProps =
......
......@@ -79,8 +79,6 @@ module Gargantext.Components.NgramsTable.Core
)
where
import Gargantext.Prelude
import Control.Monad.State (class MonadState, execState)
import DOM.Simple.Console (log2)
import Data.Array (head)
......@@ -127,21 +125,23 @@ import Effect.Exception.Unsafe (unsafeThrow)
import FFI.Simple.Functions (delay)
import Foreign as F
import Foreign.Object as FO
import Reactix (Component, Element, createElement) as R
import Reactix.DOM.HTML as H
import Partial (crashWith)
import Partial.Unsafe (unsafePartial)
import Gargantext.AsyncTasks as GAT
import Gargantext.Components.Table as T
import Gargantext.Components.Table.Types as T
import Gargantext.Config.REST (RESTError)
import Gargantext.Config.Utils (handleRESTError)
import Gargantext.Prelude
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get, post, put)
import Gargantext.Types (AsyncTask, AsyncTaskType(..), AsyncTaskWithType(..), CTabNgramType(..), FrontendError, ListId, OrderBy(..), ScoreType(..), TabSubType(..), TabType(..), TermList(..), TermSize(..))
import Gargantext.Utils.Either (eitherMap)
import Gargantext.Utils.KarpRabin (indicesOfAny)
import Gargantext.Utils.Reactix as R2
import Partial (crashWith)
import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as H
import Simple.JSON as JSON
import Toestand as T
......
......@@ -3,8 +3,6 @@ module Gargantext.Components.Nodes.Annuaire.User.Contact
, contactLayout
) where
import Gargantext.Prelude
import Data.Either (Either)
import Data.Lens as L
import Data.Maybe (Maybe(..), fromMaybe)
......@@ -19,6 +17,7 @@ import Gargantext.Components.Nodes.Lists.Types as LT
import Gargantext.Config.REST (RESTError)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Prelude
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session, get, put, sessionId)
import Gargantext.Types (NodeType(..))
......
module Gargantext.Config.REST where
import Gargantext.Prelude
import Affjax (Error(..), defaultRequest, request)
import Affjax as Affjax
import Affjax.RequestBody (formData, formURLEncoded, string)
......@@ -19,6 +17,7 @@ import Data.Tuple (Tuple)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Foreign as Foreign
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2
import Simple.JSON as JSON
import Web.XHR.FormData as XHRFormData
......
......@@ -655,7 +655,7 @@ modeFromString _ = Nothing
-- corresponds to /add/form/async or /add/query/async
data AsyncTaskType = AddNode
| Form -- this is file upload too
| CorpusFormUpload -- this is file upload too
| GraphRecompute
| ListUpload
| ListCSVUpload -- legacy v3 CSV upload for lists
......@@ -663,6 +663,7 @@ data AsyncTaskType = AddNode
| UpdateNgramsCharts
| UpdateNode
| UploadFile
| UploadFrameCalc
derive instance Generic AsyncTaskType _
instance JSON.ReadForeign AsyncTaskType where
......@@ -674,7 +675,7 @@ instance Show AsyncTaskType where
asyncTaskTypePath :: AsyncTaskType -> String
asyncTaskTypePath AddNode = "async/nobody/"
asyncTaskTypePath Form = "add/form/async/"
asyncTaskTypePath CorpusFormUpload = "add/form/async/"
asyncTaskTypePath GraphRecompute = "async/recompute/"
asyncTaskTypePath ListUpload = "add/form/async/"
asyncTaskTypePath ListCSVUpload = "csv/add/form/async/"
......@@ -682,6 +683,7 @@ asyncTaskTypePath Query = "query/"
asyncTaskTypePath UpdateNgramsCharts = "ngrams/async/charts/update/"
asyncTaskTypePath UpdateNode = "update/"
asyncTaskTypePath UploadFile = "async/file/add/"
asyncTaskTypePath UploadFrameCalc = "add/framecalc/async/"
type AsyncTaskID = String
......
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