Commit 6fc84226 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

[upload] more work on JSON upload

parent a0fc0f27
...@@ -324,12 +324,16 @@ uploadFile session nodeType id fileType {mName, blob: UploadFileBlob blob} = do ...@@ -324,12 +324,16 @@ uploadFile session nodeType id fileType {mName, blob: UploadFileBlob blob} = do
p = case nodeType of p = case nodeType of
Corpus -> GR.NodeAPI nodeType (Just id) $ GT.asyncTaskTypePath GT.Form Corpus -> GR.NodeAPI nodeType (Just id) $ GT.asyncTaskTypePath GT.Form
Annuaire -> GR.NodeAPI nodeType (Just id) "annuaire" Annuaire -> GR.NodeAPI nodeType (Just id) "annuaire"
NodeList -> GR.NodeAPI nodeType (Just id) $ GT.asyncTaskTypePath GT.ListUpload
_ -> GR.NodeAPI nodeType (Just id) "" _ -> GR.NodeAPI nodeType (Just id) ""
bodyParams c = [ Tuple "_wf_data" (Just c) -- { input: { data: ..., filetype: "JSON", name: "..." } }
, Tuple "_wf_filetype" (Just $ show fileType) bodyParams c = case nodeType of
, Tuple "_wf_name" mName NodeList -> []
] _ -> [ Tuple "_wf_data" (Just c)
, Tuple "_wf_filetype" (Just $ show fileType)
, Tuple "_wf_name" mName
]
uploadArbitraryFile :: Session uploadArbitraryFile :: Session
...@@ -366,20 +370,34 @@ uploadTermListViewCpt = here.component "uploadTermListView" cpt ...@@ -366,20 +370,34 @@ uploadTermListViewCpt = here.component "uploadTermListView" cpt
where where
cpt {dispatch, id, nodeType} _ = do cpt {dispatch, id, nodeType} _ = do
mFile <- T.useBox (Nothing :: Maybe UploadFile) mFile <- T.useBox (Nothing :: Maybe UploadFile)
uploadType <- T.useBox CSV
let body = H.input { type: "file" let input = H.input { type: "file"
, placeholder: "Choose file" , placeholder: "Choose file"
, on: {change: onChangeContents mFile} , on: {change: onChangeContents mFile}
} , className: "form-control"
}
let opt fileType = H.option { value: show fileType } [ H.text $ show fileType ]
let uploadTypeHtml = R2.select { className: "form-control"
, defaultValue: show JSON
, on: { change: onUploadTypeChange uploadType } } (opt <$> [ CSV, JSON ])
let footer = H.div {} [ uploadTermButton { dispatch let footer = H.div {} [ uploadTermButton { dispatch
, id , id
, mFile , mFile
, nodeType , nodeType
, uploadType
} }
] ]
pure $ panel [body] footer pure $ panel
[ H.form {}
[ R2.row [ R2.col 12 [ input ] ]
, R2.row [ R2.col 12 [ uploadTypeHtml ] ]
]
] footer
onChangeContents :: forall e. T.Box (Maybe UploadFile) onChangeContents :: forall e. T.Box (Maybe UploadFile)
-> E.SyntheticEvent_ e -> E.SyntheticEvent_ e
...@@ -396,12 +414,18 @@ uploadTermListViewCpt = here.component "uploadTermListView" cpt ...@@ -396,12 +414,18 @@ uploadTermListViewCpt = here.component "uploadTermListView" cpt
T.write_ (Just $ { blob: UploadFileBlob blob T.write_ (Just $ { blob: UploadFileBlob blob
, name }) mFile , name }) mFile
onUploadTypeChange uploadType e = do
case read (R.unsafeEventValue e) of
Nothing -> pure unit
Just fileType -> T.write_ fileType uploadType
type UploadTermButtonProps = type UploadTermButtonProps =
( dispatch :: Action -> Aff Unit ( dispatch :: Action -> Aff Unit
, id :: Int , id :: Int
, mFile :: T.Box (Maybe UploadFile) , mFile :: T.Box (Maybe UploadFile)
, nodeType :: GT.NodeType , nodeType :: GT.NodeType
, uploadType :: T.Box FileType
) )
uploadTermButton :: R2.Leaf UploadTermButtonProps uploadTermButton :: R2.Leaf UploadTermButtonProps
...@@ -412,21 +436,23 @@ uploadTermButtonCpt = here.component "uploadTermButton" cpt ...@@ -412,21 +436,23 @@ uploadTermButtonCpt = here.component "uploadTermButton" cpt
cpt { dispatch cpt { dispatch
, id , id
, mFile , mFile
, nodeType } _ = do , nodeType
, uploadType } _ = do
mFile' <- T.useLive T.unequal mFile mFile' <- T.useLive T.unequal mFile
uploadType' <- T.useLive T.unequal uploadType
let disabled = case mFile' of let disabled = case mFile' of
Nothing -> "1" Nothing -> "1"
Just _ -> "" Just _ -> ""
pure $ H.button { className: "btn btn-primary" pure $ H.button { className: "btn btn-primary"
, disabled , disabled
, on: {click: onClick mFile'} , on: { click: onClick mFile' uploadType' }
} [ H.text "Upload" ] } [ H.text "Upload" ]
where where
onClick mFile' e = do onClick mFile' uploadType' e = do
let {name, blob} = unsafePartial $ fromJust mFile' let {name, blob} = unsafePartial $ fromJust mFile'
void $ launchAff do void $ launchAff do
_ <- dispatch $ UploadFile nodeType CSV (Just name) blob _ <- dispatch $ UploadFile nodeType uploadType' (Just name) blob
liftEffect $ do liftEffect $ do
T.write_ Nothing mFile T.write_ Nothing mFile
...@@ -9,7 +9,7 @@ import Web.File.Blob (Blob, size) ...@@ -9,7 +9,7 @@ import Web.File.Blob (Blob, size)
import Gargantext.Prelude import Gargantext.Prelude
data FileType = CSV | CSV_HAL | WOS | PresseRIS | Arbitrary data FileType = CSV | CSV_HAL | WOS | PresseRIS | Arbitrary | JSON
derive instance Generic FileType _ derive instance Generic FileType _
instance Eq FileType where instance Eq FileType where
...@@ -23,6 +23,7 @@ instance Read FileType where ...@@ -23,6 +23,7 @@ instance Read FileType where
read "CSV_HAL" = Just CSV_HAL read "CSV_HAL" = Just CSV_HAL
read "PresseRIS" = Just PresseRIS read "PresseRIS" = Just PresseRIS
read "WOS" = Just WOS read "WOS" = Just WOS
read "JSON" = Just JSON
read _ = Nothing read _ = Nothing
......
...@@ -655,6 +655,7 @@ modeFromString _ = Nothing ...@@ -655,6 +655,7 @@ modeFromString _ = Nothing
data AsyncTaskType = AddNode data AsyncTaskType = AddNode
| Form -- this is file upload too | Form -- this is file upload too
| GraphRecompute | GraphRecompute
| ListUpload
| Query | Query
| UpdateNgramsCharts | UpdateNgramsCharts
| UpdateNode | UpdateNode
...@@ -672,6 +673,7 @@ asyncTaskTypePath :: AsyncTaskType -> String ...@@ -672,6 +673,7 @@ asyncTaskTypePath :: AsyncTaskType -> String
asyncTaskTypePath AddNode = "async/nobody/" asyncTaskTypePath AddNode = "async/nobody/"
asyncTaskTypePath Form = "add/form/async/" asyncTaskTypePath Form = "add/form/async/"
asyncTaskTypePath GraphRecompute = "async/recompute/" asyncTaskTypePath GraphRecompute = "async/recompute/"
asyncTaskTypePath ListUpload = "add/form/async/"
asyncTaskTypePath Query = "query/" asyncTaskTypePath Query = "query/"
asyncTaskTypePath UpdateNgramsCharts = "ngrams/async/charts/update/" asyncTaskTypePath UpdateNgramsCharts = "ngrams/async/charts/update/"
asyncTaskTypePath UpdateNode = "update/" asyncTaskTypePath UpdateNode = "update/"
......
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