[upload] fix upload sending 'Nothing' as lang

parent 9c06952e
Pipeline #7528 passed with stages
in 26 minutes and 56 seconds
...@@ -386,9 +386,6 @@ onChangeContents ...@@ -386,9 +386,6 @@ onChangeContents
T.write_ (Just $ { blob: UploadFileBlob blob, name }) mFile T.write_ (Just $ { blob: UploadFileBlob blob, name }) mFile
checkFileUpdateParams props checkFileUpdateParams props
uploadButton :: R2.Component UploadFileProps
uploadButton = R.createElement uploadButtonCpt
-- | String pattern used to parse extensions in file paths -- | String pattern used to parse extensions in file paths
fileExtensionPattern :: String fileExtensionPattern :: String
fileExtensionPattern = "(.*)\\.(.*)" fileExtensionPattern = "(.*)\\.(.*)"
...@@ -509,6 +506,9 @@ checkFileUpdateParams ...@@ -509,6 +506,9 @@ checkFileUpdateParams
T.write_ "The file extension is invalid." message T.write_ "The file extension is invalid." message
T.write_ "alert-danger" alertType T.write_ "alert-danger" alertType
uploadButton :: R2.Component UploadFileProps
uploadButton = R.createElement uploadButtonCpt
uploadButtonCpt :: R.Component UploadFileProps uploadButtonCpt :: R.Component UploadFileProps
uploadButtonCpt = here.component "uploadButton" cpt uploadButtonCpt = here.component "uploadButton" cpt
where where
...@@ -861,14 +861,14 @@ uploadFile { contents, fileFormat, lang, fileType, id, nodeType, mName, selectio ...@@ -861,14 +861,14 @@ uploadFile { contents, fileFormat, lang, fileType, id, nodeType, mName, selectio
postWwwUrlencoded session p body postWwwUrlencoded session p body
--postMultipartFormData session p fileContents --postMultipartFormData session p fileContents
where where
langParam key = if lang == No_extraction then [] else [ Tuple key (Just $ show lang) ]
bodyParams = bodyParams =
[ Tuple "_wf_data" (Just contents) [ Tuple "_wf_data" (Just contents)
, Tuple "_wf_filetype" (Just $ show fileType) , Tuple "_wf_filetype" (Just $ show fileType)
, Tuple "_wf_fileformat" (Just $ show fileFormat) , Tuple "_wf_fileformat" (Just $ show fileFormat)
, Tuple "_wf_lang" (Just $ show lang)
, Tuple "_wf_name" mName , Tuple "_wf_name" mName
, Tuple "_wf_selection" (Just $ show selection) , Tuple "_wf_selection" (Just $ show selection)
] ] <> (langParam "_wf_lang")
jsonBodyParams = jsonBodyParams =
[ Tuple "_wjf_data" (Just contents) [ Tuple "_wjf_data" (Just contents)
, Tuple "_wjf_filetype" (Just $ show fileType) , Tuple "_wjf_filetype" (Just $ show fileType)
...@@ -878,10 +878,9 @@ uploadFile { contents, fileFormat, lang, fileType, id, nodeType, mName, selectio ...@@ -878,10 +878,9 @@ uploadFile { contents, fileFormat, lang, fileType, id, nodeType, mName, selectio
[ Tuple "_wtf_data" (Just contents) [ Tuple "_wtf_data" (Just contents)
, Tuple "_wtf_filetype" (Just $ show fileType) , Tuple "_wtf_filetype" (Just $ show fileType)
, Tuple "_wtf_fileformat" (Just $ show fileFormat) , Tuple "_wtf_fileformat" (Just $ show fileFormat)
, Tuple "_wf_lang" (Just $ show lang)
, Tuple "_wtf_name" mName , Tuple "_wtf_name" mName
, Tuple "_wtf_selection" (Just $ show selection) , Tuple "_wtf_selection" (Just $ show selection)
] ] <> (langParam "_wtf_lang")
(typ /\ p /\ body) = case nodeType of (typ /\ p /\ body) = case nodeType of
Corpus -> GT.CorpusFormUpload /\ (GR.NodeAPI nodeType (Just id) $ GT.asyncTaskTypePath GT.CorpusFormUpload) /\ bodyParams Corpus -> GT.CorpusFormUpload /\ (GR.NodeAPI nodeType (Just id) $ GT.asyncTaskTypePath GT.CorpusFormUpload) /\ bodyParams
......
...@@ -53,7 +53,7 @@ derive instance Generic Lang _ ...@@ -53,7 +53,7 @@ derive instance Generic Lang _
derive instance Ord Lang derive instance Ord Lang
instance Show Lang where instance Show Lang where
show No_extraction = "Nothing" show No_extraction = "No language extraction"
show s = genericShow s show s = genericShow s
langReader :: String -> Maybe Lang langReader :: String -> Maybe Lang
...@@ -72,6 +72,7 @@ instance JSON.ReadForeign Lang where ...@@ -72,6 +72,7 @@ instance JSON.ReadForeign Lang where
Just l -> pure l Just l -> pure l
instance JSON.WriteForeign Lang where instance JSON.WriteForeign Lang where
writeImpl No_extraction = JSON.writeImpl (Nothing :: Maybe String)
writeImpl l = JSON.writeImpl $ show l writeImpl l = JSON.writeImpl $ show l
data ServerType = CoreNLP | Spacy | JohnSnow data ServerType = CoreNLP | Spacy | JohnSnow
......
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