Commit 750a8661 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[MERGE]

parents c04f9e84 b454c023
{
"name": "Gargantext",
"version": "0.0.1.7.3",
"version": "0.0.1.7.4",
"scripts": {
"rebase-set": "spago package-set-upgrade && spago psc-package-insdhall",
"rebuild-set": "spago psc-package-insdhall",
......
......@@ -19,6 +19,7 @@ import Gargantext.Components.Nodes.Annuaire.User.Contacts (annuaireUserLayout, u
import Gargantext.Components.Nodes.Corpus (corpusLayout)
import Gargantext.Components.Nodes.Corpus.Dashboard (dashboardLayout)
import Gargantext.Components.Nodes.Corpus.Document (documentLayout)
import Gargantext.Components.Nodes.File (fileLayout)
import Gargantext.Components.Nodes.Frame (frameLayout)
import Gargantext.Components.Nodes.Home (homeLayout)
import Gargantext.Components.Nodes.Lists (listsLayout)
......@@ -80,6 +81,7 @@ appCpt = R.hooksComponent "G.C.App.app" cpt where
Team sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
RouteFrameWrite sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session }
RouteFrameCalc sid nodeId -> withSession sid $ \session -> forested $ frameLayout { nodeId, session }
RouteFile sid nodeId -> withSession sid $ \session -> forested $ fileLayout { nodeId, session }
Corpus sid nodeId -> withSession sid $ \session -> forested $ corpusLayout { nodeId, session }
Texts sid nodeId -> withSession sid $ \session -> forested $ textsLayout { nodeId, session, frontends }
Lists sid nodeId -> withSession sid $ \session -> forested $ listsLayout { nodeId, session }
......
......@@ -26,7 +26,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.Contact as Contact
import Gargantext.Components.Forest.Tree.Node.Action.Update (updateRequest)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile)
import Gargantext.Components.Forest.Tree.Node.Action.Upload (uploadFile, uploadArbitraryFile)
import Gargantext.Components.Forest.Tree.Node.Tools.FTree (FTree, LNode(..), NTree(..))
import Gargantext.Components.Forest.Tree.Node.Tools.Task (Tasks, tasksStruct)
import Gargantext.Ends (Frontends)
......@@ -338,12 +338,21 @@ performAction (AddNode name nodeType) p@{ openNodes: (_ /\ setOpenNodes)
performAction RefreshTree p
-------
performAction (UploadFile nodeType fileType mName contents) { session
, tasks: { onTaskAdd }
, tree: (NTree (LNode {id}) _)
} =
performAction (UploadFile nodeType fileType mName blob) { session
, tasks: { onTaskAdd }
, tree: (NTree (LNode {id}) _)
} =
do
task <- uploadFile session nodeType id fileType {mName, contents}
task <- uploadFile session nodeType id fileType {mName, blob}
liftEffect $ onTaskAdd task
liftEffect $ log2 "Uploaded, task:" task
performAction (UploadArbitraryFile nodeType mName blob) { session
, tasks: { onTaskAdd }
, tree: (NTree (LNode {id}) _)
} =
do
task <- uploadArbitraryFile session nodeType id { blob, mName }
liftEffect $ onTaskAdd task
liftEffect $ log2 "Uploaded, task:" task
......
......@@ -13,7 +13,7 @@ import Web.File.FileReader.Aff (readAsText)
import Gargantext.Components.Forest.Tree.Node.Settings (SettingsBox(..), settingsBox)
import Gargantext.Components.Forest.Tree.Node.Action (Action(..))
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileContents(..))
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileBlob(..))
import Gargantext.Components.Forest.Tree.Node.Action.Upload (DroppedFile(..), fileTypeView)
import Gargantext.Components.Forest.Tree.Node.Box (nodePopupView)
import Gargantext.Components.Forest.Tree.Node.Box.Types (CommonProps)
......@@ -122,8 +122,9 @@ nodeMainSpan p@{ dispatch, folderOpen, frontends, handed, session } = R.createEl
folderIcon nodeType folderOpen'@(open /\ _) =
H.a { className: "folder-icon"
, onClick: R2.effToggler folderOpen'
}
[ H.i {className: GT.fldr nodeType open} [] ]
} [
H.i {className: GT.fldr nodeType open} []
]
popOverIcon = H.a { className: "settings fa fa-cog" } []
......@@ -151,11 +152,11 @@ nodeMainSpan p@{ dispatch, folderOpen, frontends, handed, session } = R.createEl
E.stopPropagation e
blob <- R2.dataTransferFileBlob e
void $ launchAff do
contents <- readAsText blob
--contents <- readAsText blob
liftEffect $ setDroppedFile
$ const
$ Just
$ DroppedFile { contents: (UploadFileContents contents)
$ DroppedFile { blob: (UploadFileBlob blob)
, fileType: Just CSV
, lang : EN
}
......
......@@ -7,7 +7,7 @@ import Gargantext.Sessions (Session)
import Gargantext.Types as GT
import Gargantext.Components.Forest.Tree.Node.Tools.SubTree.Types (SubTreeOut, SubTreeParams(..))
import Gargantext.Components.Forest.Tree.Node.Settings (NodeAction(..), glyphiconNodeAction)
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType, UploadFileContents)
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType, UploadFileBlob)
import Gargantext.Components.Forest.Tree.Node.Action.Update.Types (UpdateNodeParams)
import Gargantext.Components.Forest.Tree.Node.Action.Contact.Types (AddContactParams)
......@@ -24,7 +24,8 @@ data Action = AddNode String GT.NodeType
| RenameNode String
| UpdateNode UpdateNodeParams
| DoSearch GT.AsyncTaskWithType
| UploadFile GT.NodeType FileType (Maybe String) UploadFileContents
| UploadFile GT.NodeType FileType (Maybe String) UploadFileBlob
| UploadArbitraryFile GT.NodeType (Maybe String) UploadFileBlob
| DownloadNode
| RefreshTree
......@@ -54,57 +55,60 @@ setTreeOut a _ = a
instance showShow :: Show Action where
show (AddNode _ _ )= "AddNode"
show (DeleteNode _ )= "DeleteNode"
show (RenameNode _ )= "RenameNode"
show (UpdateNode _ )= "UpdateNode"
show (ShareTeam _ )= "ShareTeam"
show (AddContact _ )= "AddContact"
show (SharePublic _ )= "SharePublic"
show (DoSearch _ )= "SearchQuery"
show (UploadFile _ _ _ _)= "UploadFile"
show RefreshTree = "RefreshTree"
show DownloadNode = "Download"
show (MoveNode _ ) = "MoveNode"
show (MergeNode _ ) = "MergeNode"
show (LinkNode _ ) = "LinkNode"
show NoAction = "NoAction"
show (AddNode _ _ ) = "AddNode"
show (DeleteNode _ ) = "DeleteNode"
show (RenameNode _ ) = "RenameNode"
show (UpdateNode _ ) = "UpdateNode"
show (ShareTeam _ ) = "ShareTeam"
show (AddContact _ ) = "AddContact"
show (SharePublic _ ) = "SharePublic"
show (DoSearch _ ) = "SearchQuery"
show (UploadFile _ _ _ _) = "UploadFile"
show (UploadArbitraryFile _ _ _) = "UploadArbitraryFile"
show RefreshTree = "RefreshTree"
show DownloadNode = "Download"
show (MoveNode _ ) = "MoveNode"
show (MergeNode _ ) = "MergeNode"
show (LinkNode _ ) = "LinkNode"
show NoAction = "NoAction"
-----------------------------------------------------------------------
icon :: Action -> String
icon (AddNode _ _) = glyphiconNodeAction (Add [])
icon (DeleteNode _) = glyphiconNodeAction Delete
icon (RenameNode _) = glyphiconNodeAction Config
icon (UpdateNode _) = glyphiconNodeAction Refresh
icon (ShareTeam _) = glyphiconNodeAction Share
icon (AddContact _) = glyphiconNodeAction Share
icon (SharePublic _ ) = glyphiconNodeAction (Publish { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (DoSearch _) = glyphiconNodeAction SearchBox
icon (UploadFile _ _ _ _) = glyphiconNodeAction Upload
icon RefreshTree = glyphiconNodeAction Refresh
icon DownloadNode = glyphiconNodeAction Download
icon (MoveNode _ ) = glyphiconNodeAction (Move { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (MergeNode _ ) = glyphiconNodeAction (Merge { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (LinkNode _ ) = glyphiconNodeAction (Link { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (AddNode _ _) = glyphiconNodeAction (Add [])
icon (DeleteNode _) = glyphiconNodeAction Delete
icon (RenameNode _) = glyphiconNodeAction Config
icon (UpdateNode _) = glyphiconNodeAction Refresh
icon (ShareTeam _) = glyphiconNodeAction Share
icon (AddContact _) = glyphiconNodeAction Share
icon (SharePublic _ ) = glyphiconNodeAction (Publish { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (DoSearch _) = glyphiconNodeAction SearchBox
icon (UploadFile _ _ _ _) = glyphiconNodeAction Upload
icon (UploadArbitraryFile _ _ _ ) = glyphiconNodeAction Upload
icon RefreshTree = glyphiconNodeAction Refresh
icon DownloadNode = glyphiconNodeAction Download
icon (MoveNode _ ) = glyphiconNodeAction (Move { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (MergeNode _ ) = glyphiconNodeAction (Merge { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon (LinkNode _ ) = glyphiconNodeAction (Link { subTreeParams : SubTreeParams {showtypes:[], valitypes:[] }})
icon NoAction = "hand-o-right"
icon NoAction = "hand-o-right"
-- icon _ = "hand-o-right"
text :: Action -> String
text (AddNode _ _ )= "Add !"
text (DeleteNode _ )= "Delete !"
text (RenameNode _ )= "Rename !"
text (UpdateNode _ )= "Update !"
text (ShareTeam _ )= "Share with team !"
text (AddContact _ )= "Add contact !"
text (SharePublic _ )= "Publish !"
text (DoSearch _ )= "Launch search !"
text (UploadFile _ _ _ _)= "Upload File !"
text RefreshTree = "Refresh Tree !"
text DownloadNode = "Download !"
text (MoveNode _ ) = "Move !"
text (MergeNode _ ) = "Merge !"
text (LinkNode _ ) = "Link !"
text NoAction = "No Action"
text (AddNode _ _ ) = "Add !"
text (DeleteNode _ ) = "Delete !"
text (RenameNode _ ) = "Rename !"
text (UpdateNode _ ) = "Update !"
text (ShareTeam _ ) = "Share with team !"
text (AddContact _ ) = "Add contact !"
text (SharePublic _ ) = "Publish !"
text (DoSearch _ ) = "Launch search !"
text (UploadFile _ _ _ _) = "Upload File !"
text (UploadArbitraryFile _ _ _) = "Upload arbitrary file !"
text RefreshTree = "Refresh Tree !"
text DownloadNode = "Download !"
text (MoveNode _ ) = "Move !"
text (MergeNode _ ) = "Merge !"
text (LinkNode _ ) = "Link !"
text NoAction = "No Action"
-----------------------------------------------------------------------
module Gargantext.Components.Forest.Tree.Node.Action.Upload where
import Data.Either (fromRight)
import Data.Maybe (Maybe(..), fromJust, fromMaybe)
import Data.Newtype (class Newtype)
import Data.String.Regex as DSR
import Data.String.Regex.Flags as DSRF
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Effect.Aff (Aff, launchAff)
import Effect.Aff (Aff, launchAff, throwError)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Partial.Unsafe (unsafePartial)
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import URI.Extra.QueryPairs as QP
import Web.File.Blob (Blob)
import Web.File.FileReader.Aff (readAsDataURL, readAsText)
import Gargantext.Prelude
import Gargantext.Components.Forest.Tree.Node.Action (Action(..), Props)
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileContents(..))
import Gargantext.Components.Forest.Tree.Node.Action.Upload.Types (FileType(..), UploadFileBlob(..))
import Gargantext.Components.Forest.Tree.Node.Tools (fragmentPT, formChoiceSafe, panel)
import Gargantext.Components.Lang (Lang(..))
import Gargantext.Prelude (class Show, Unit, discard, bind, const, id, map, pure, show, unit, void, ($), read)
import Gargantext.Routes as GR
import Gargantext.Sessions (Session, postWwwUrlencoded)
import Gargantext.Types (NodeType(..), ID)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Partial.Unsafe (unsafePartial)
import React.SyntheticEvent as E
import Reactix as R
import Reactix.DOM.HTML as H
import URI.Extra.QueryPairs as QP
import Web.File.FileReader.Aff (readAsText)
import Gargantext.Utils.String as GUS
-- UploadFile Action
......@@ -45,7 +54,7 @@ actionUpload _ _ _ _ =
-- file upload types
data DroppedFile =
DroppedFile { contents :: UploadFileContents
DroppedFile { blob :: UploadFileBlob
, fileType :: Maybe FileType
, lang :: Lang
}
......@@ -54,7 +63,7 @@ type FileHash = String
type UploadFile =
{ contents :: UploadFileContents
{ blob :: UploadFileBlob
, name :: String
}
......@@ -81,6 +90,7 @@ uploadFileViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadFileView" cpt
, CSV_HAL
, WOS
, PresseRIS
, Arbitrary
] CSV setFileType
]
......@@ -112,20 +122,10 @@ uploadFileViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadFileView" cpt
case mF of
Nothing -> pure unit
Just {blob, name} -> void $ launchAff do
contents <- readAsText blob
--contents <- readAsText blob
--contents <- readAsDataURL blob
liftEffect $ do
setMFile $ const $ Just $ {contents: UploadFileContents contents, name}
onChangeFileType :: forall e
. R.State FileType
-> e
-> Effect Unit
onChangeFileType (fileType /\ setFileType) e = do
setFileType $ const
$ unsafePartial
$ fromJust
$ read
$ R2.unsafeEventValue e
setMFile $ const $ Just $ {blob: UploadFileBlob blob, name}
type UploadButtonProps =
......@@ -162,9 +162,14 @@ uploadButtonCpt = R.hooksComponent "G.C.F.T.N.A.U.uploadButton" cpt
Just _ -> ""
onClick e = do
let {name, contents} = unsafePartial $ fromJust mFile
let { blob, name } = unsafePartial $ fromJust mFile
log2 "[uploadButton] fileType" fileType
void $ launchAff do
_ <- dispatch $ UploadFile nodeType fileType (Just name) contents
case fileType of
Arbitrary ->
dispatch $ UploadArbitraryFile nodeType (Just name) blob
_ ->
dispatch $ UploadFile nodeType fileType (Just name) blob
liftEffect $ do
setMFile $ const $ Nothing
setFileType $ const $ CSV
......@@ -186,7 +191,7 @@ fileTypeViewCpt :: R.Component FileTypeProps
fileTypeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.fileTypeView" cpt
where
cpt { dispatch
, droppedFile: Just (DroppedFile {contents, fileType}) /\ setDroppedFile
, droppedFile: Just (DroppedFile {blob, fileType}) /\ setDroppedFile
, isDragOver: (_ /\ setIsDragOver)
, nodeType
} _ = pure
......@@ -229,7 +234,7 @@ fileTypeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.fileTypeView" cpt
]
where
onChange e l =
setDroppedFile $ const $ Just $ DroppedFile $ { contents
setDroppedFile $ const $ Just $ DroppedFile $ { blob
, fileType: read $ R2.unsafeEventValue e
, lang : fromMaybe EN $ read $ R2.unsafeEventValue l
}
......@@ -244,7 +249,7 @@ fileTypeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.fileTypeView" cpt
, type: "button"
, on: {click: \_ -> do
setDroppedFile $ const Nothing
launchAff $ dispatch $ UploadFile nodeType ft Nothing contents
launchAff $ dispatch $ UploadFile nodeType ft Nothing blob
}
} [H.text "Upload"]
Nothing ->
......@@ -272,24 +277,47 @@ uploadFile :: Session
-> GT.NodeType
-> ID
-> FileType
-> {contents :: UploadFileContents, mName :: Maybe String}
-> {blob :: UploadFileBlob, mName :: Maybe String}
-> Aff GT.AsyncTaskWithType
uploadFile session nodeType id fileType {mName, contents: UploadFileContents contents} = do
task <- postWwwUrlencoded session p bodyParams
pure $ GT.AsyncTaskWithType {task, typ: GT.Form}
uploadFile session nodeType id fileType {mName, blob: UploadFileBlob blob} = do
contents <- readAsText blob
task <- postWwwUrlencoded session p (bodyParams contents)
pure $ GT.AsyncTaskWithType {task, typ: GT.Form}
--postMultipartFormData session p fileContents
where
q = FileUploadQuery { fileType: fileType }
--p = NodeAPI GT.Corpus (Just id) $ "add/file/async/nobody" <> Q.print (toQuery q)
p = case nodeType of
Corpus -> GR.NodeAPI nodeType (Just id) $ GT.asyncTaskTypePath GT.Form
Annuaire -> GR.NodeAPI nodeType (Just id) "annuaire"
_ -> GR.NodeAPI nodeType (Just id) ""
bodyParams = [ Tuple "_wf_data" (Just contents)
, Tuple "_wf_filetype" (Just $ show fileType)
, Tuple "_wf_name" mName
]
bodyParams c = [ Tuple "_wf_data" (Just c)
, Tuple "_wf_filetype" (Just $ show fileType)
, Tuple "_wf_name" mName
]
uploadArbitraryFile :: Session
-> GT.NodeType
-> ID
-> {blob :: UploadFileBlob, mName :: Maybe String}
-> Aff GT.AsyncTaskWithType
uploadArbitraryFile session nodeType id {mName, blob: UploadFileBlob blob} = do
if nodeType == Corpus then
pure unit
else
throwError $ error $ "[uploadArbitraryFile] NodeType " <> (show nodeType) <> " not supported"
contents' <- readAsDataURL blob
let re = unsafePartial $ fromRight $ DSR.regex "data:.*;base64," DSRF.noFlags
contents = DSR.replace re "" contents'
task <- postWwwUrlencoded session p (bodyParams contents)
pure $ GT.AsyncTaskWithType { task, typ: GT.Form }
where
p = GR.NodeAPI nodeType (Just id) $ GT.asyncTaskTypePath GT.UploadFile
bodyParams c = [ Tuple "_wfi_b64_data" (Just c)
, Tuple "_wfi_name" mName
]
------------------------------------------------------------------------
......@@ -325,9 +353,9 @@ uploadTermListViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadTermListView" cpt
case mF of
Nothing -> pure unit
Just {blob, name} -> void $ launchAff do
contents <- readAsText blob
--contents <- readAsText blob
liftEffect $ do
setMFile $ const $ Just $ { contents: UploadFileContents contents
setMFile $ const $ Just $ { blob: UploadFileBlob blob
, name
}
......@@ -353,9 +381,9 @@ uploadTermButtonCpt = R.hooksComponent "G.C.F.T.N.A.U.uploadTermButton" cpt
Just _ -> ""
onClick e = do
let {name, contents} = unsafePartial $ fromJust mFile
let {name, blob} = unsafePartial $ fromJust mFile
void $ launchAff do
_ <- dispatch $ UploadFile nodeType CSV (Just name) contents
_ <- dispatch $ UploadFile nodeType CSV (Just name) blob
liftEffect $ do
setMFile $ const $ Nothing
......
......@@ -4,10 +4,12 @@ import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..))
import Web.File.Blob (Blob)
import Gargantext.Prelude (class Read, class Show, class Eq)
data FileType = CSV | CSV_HAL | WOS | PresseRIS
data FileType = CSV | CSV_HAL | WOS | PresseRIS | Arbitrary
derive instance genericFileType :: Generic FileType _
......@@ -23,9 +25,8 @@ instance readFileType :: Read FileType where
read "CSV_HAL" = Just CSV_HAL
read "PresseRIS" = Just PresseRIS
read "WOS" = Just WOS
read "Arbitrary" = Just Arbitrary
read _ = Nothing
newtype UploadFileContents = UploadFileContents String
newtype UploadFileBlob = UploadFileBlob Blob
......@@ -303,6 +303,14 @@ settingsBox NodeFrameCalc =
}
settingsBox NodeFile =
SettingsBox { show: true
, edit: true
, doc: Documentation NodeFile
, buttons: [ Delete ]
}
settingsBox _ =
SettingsBox { show : false
, edit : false
......
......@@ -164,7 +164,7 @@ formChoice :: forall a b c d
formChoice nodeTypes defaultNodeType setNodeType =
H.div { className: "form-group"}
[ R2.select { className: "form-control"
, on: { change: \_ -> setNodeType
, on: { change: setNodeType
<<< const
<<< fromMaybe defaultNodeType
<<< read
......
module Gargantext.Components.Nodes.File where
import Data.Argonaut (class DecodeJson, decodeJson, (.:))
import Data.Maybe (Maybe(..))
import DOM.Simple.Console (log2)
import Effect.Aff (Aff, launchAff_)
import Reactix as R
import Reactix.DOM.HTML as H
import Gargantext.Prelude
import Gargantext.Hooks.Loader (useLoader)
import Gargantext.Routes (SessionRoute(..))
import Gargantext.Sessions (Session, get)
import Gargantext.Types as T
newtype HyperdataFile = HyperdataFile {
mime :: String
, name :: String
, path :: String
}
instance decodeHyperdataFile :: DecodeJson HyperdataFile where
decodeJson json = do
obj <- decodeJson json
mime <- obj .: "mime"
name <- obj .: "name"
path <- obj .: "path"
pure $ HyperdataFile {
mime
, name
, path
}
newtype File = File {
id :: Int
, date :: String
, hyperdata :: HyperdataFile
, name :: String
}
instance decodeFile :: DecodeJson File where
decodeJson json = do
obj <- decodeJson json
id <- obj .: "id"
date <- obj .: "date"
hyperdata' <- obj .: "hyperdata"
hyperdata <- decodeJson hyperdata'
name <- obj .: "name"
pure $ File {
id
, date
, hyperdata
, name
}
type FileLayoutProps = (
nodeId :: Int
, session :: Session
)
fileLayout :: Record FileLayoutProps -> R.Element
fileLayout props = R.createElement fileLayoutCpt props []
fileLayoutCpt :: R.Component FileLayoutProps
fileLayoutCpt = R.hooksComponent "G.C.N.F.fileLayout" cpt
where
cpt { nodeId, session } _ = do
useLoader { nodeId } (loadFile session) $ \loaded ->
fileLayoutLoaded { loaded, nodeId, session }
type LoadFileProps = (
nodeId :: Int
)
loadFile :: Session -> Record LoadFileProps -> Aff File
loadFile session { nodeId } = get session $ NodeAPI T.Node (Just nodeId) ""
type FileLayoutLoadedProps = (
loaded :: File
| FileLayoutProps
)
fileLayoutLoaded :: Record FileLayoutLoadedProps -> R.Element
fileLayoutLoaded props = R.createElement fileLayoutLoadedCpt props []
fileLayoutLoadedCpt :: R.Component FileLayoutLoadedProps
fileLayoutLoadedCpt = R.hooksComponent "G.C.N.F.fileLayoutLoaded" cpt
where
cpt { loaded: File { hyperdata: HyperdataFile hyperdata }, nodeId, session } _ = do
R.useEffect' $ do
log2 "[fileLayoutLoaded] hyperdata" hyperdata
pure $ H.div { className: "col-md-12" } [
H.div { className: "row" } [
H.h2 {} [ H.text hyperdata.name ]
]
, H.div { className: "row" } [
H.div { className: "btn btn-default" } [
H.a { href: "/api/v1.0/node/" <> show nodeId <> "/file/download"
, target: "_blank"
} [ H.text "Download" ]
]
]
]
......@@ -33,6 +33,7 @@ router = oneOf
, RouteFrameWrite <$> (route "write" *> sid) <*> int
, RouteFrameCalc <$> (route "calc" *> sid) <*> int
, RouteFile <$> (route "file" *> sid) <*> int
, Home <$ lit ""
]
where
......
......@@ -27,6 +27,7 @@ data AppRoute
| ContactPage SessionId Int Int
| RouteFrameWrite SessionId Int
| RouteFrameCalc SessionId Int
| RouteFile SessionId Int
derive instance eqAppRoute :: Eq AppRoute
......@@ -74,6 +75,7 @@ instance showAppRoute :: Show AppRoute where
show (ContactPage s a i) = "Contact" <> show a <> "::" <> show i <> " (" <> show s <> ")"
show (RouteFrameWrite s i) = "write" <> show i <> " (" <> show s <> ")"
show (RouteFrameCalc s i) = "calc" <> show i <> " (" <> show s <> ")"
show (RouteFile s i) = "file" <> show i <> " (" <> show s <> ")"
appPath :: AppRoute -> String
......@@ -94,8 +96,9 @@ appPath (Lists s i) = "lists/" <> show s <> "/" <> show i
appPath (Annuaire s i) = "annuaire/" <> show s <> "/" <> show i
appPath (UserPage s i) = "user/" <> show s <> "/" <> show i
appPath (ContactPage s a i) = "annuaire/" <> show s <> "/" <> show a <> "/contact/" <> show i
appPath (RouteFrameWrite s i) = "write/" <> show s <> "/" <> show i
appPath (RouteFrameCalc s i) = "calc/" <> show s <> "/" <> show i
appPath (RouteFrameWrite s i) = "write/" <> show s <> "/" <> show i
appPath (RouteFrameCalc s i) = "calc/" <> show s <> "/" <> show i
appPath (RouteFile s i) = "file/" <> show s <> "/" <> show i
nodeTypeAppRoute :: NodeType -> SessionId -> Int -> Maybe AppRoute
nodeTypeAppRoute GT.Annuaire s i = Just $ Annuaire s i
......
......@@ -166,36 +166,38 @@ data NodeType = NodeUser
| NodeFrameWrite
| NodeFrameCalc
| NodePublic NodeType
| NodeFile
derive instance eqNodeType :: Eq NodeType
instance showNodeType :: Show NodeType where
show NodeUser = "NodeUser"
show Folder = "NodeFolder"
show FolderPrivate = "NodeFolderPrivate" -- Node Private Worktop
show FolderShared = "NodeFolderShared" -- Node Share Worktop
show FolderPublic = "NodeFolderPublic" -- Node Public Worktop
show Annuaire = "NodeAnnuaire"
show NodeContact = "NodeContact"
show Corpus = "NodeCorpus"
show Dashboard = "NodeDashboard"
show Url_Document = "NodeDocument"
show Error = "NodeError"
show Graph = "NodeGraph"
show Phylo = "NodePhylo"
show Individu = "NodeIndividu"
show Node = "Node"
show Nodes = "Nodes"
show Tree = "NodeTree"
show Team = "NodeTeam"
show NodeList = "NodeList"
show Texts = "NodeTexts"
show NodeFrameWrite = "NodeFrameWrite"
show NodeFrameCalc = "NodeFrameCalc"
show NodeUser = "NodeUser"
show Folder = "NodeFolder"
show FolderPrivate = "NodeFolderPrivate" -- Node Private Worktop
show FolderShared = "NodeFolderShared" -- Node Share Worktop
show FolderPublic = "NodeFolderPublic" -- Node Public Worktop
show Annuaire = "NodeAnnuaire"
show NodeContact = "NodeContact"
show Corpus = "NodeCorpus"
show Dashboard = "NodeDashboard"
show Url_Document = "NodeDocument"
show Error = "NodeError"
show Graph = "NodeGraph"
show Phylo = "NodePhylo"
show Individu = "NodeIndividu"
show Node = "Node"
show Nodes = "Nodes"
show Tree = "NodeTree"
show Team = "NodeTeam"
show NodeList = "NodeList"
show Texts = "NodeTexts"
show NodeFrameWrite = "NodeFrameWrite"
show NodeFrameCalc = "NodeFrameCalc"
show (NodePublic nt) = "NodePublic" <> show nt
show NodeFile = "NodeFile"
instance readNodeType :: Read NodeType where
......@@ -204,25 +206,26 @@ instance readNodeType :: Read NodeType where
read "NodeFolderPrivate" = Just FolderPrivate
read "NodeFolderShared" = Just FolderShared
read "NodeFolderPublic" = Just FolderPublic
read "NodeAnnuaire" = Just Annuaire
read "NodeDashboard" = Just Dashboard
read "Document" = Just Url_Document
read "NodeGraph" = Just Graph
read "NodePhylo" = Just Phylo
read "Individu" = Just Individu
read "Node" = Just Node
read "Nodes" = Just Nodes
read "NodeCorpus" = Just Corpus
read "NodeContact" = Just NodeContact
read "Tree" = Just Tree
read "NodeTeam" = Just Team
read "NodeList" = Just NodeList
read "NodeTexts" = Just Texts
read "Annuaire" = Just Annuaire
read "NodeFrameWrite" = Just NodeFrameWrite
read "NodeFrameCalc" = Just NodeFrameCalc
read "NodeAnnuaire" = Just Annuaire
read "NodeDashboard" = Just Dashboard
read "Document" = Just Url_Document
read "NodeGraph" = Just Graph
read "NodePhylo" = Just Phylo
read "Individu" = Just Individu
read "Node" = Just Node
read "Nodes" = Just Nodes
read "NodeCorpus" = Just Corpus
read "NodeContact" = Just NodeContact
read "Tree" = Just Tree
read "NodeTeam" = Just Team
read "NodeList" = Just NodeList
read "NodeTexts" = Just Texts
read "Annuaire" = Just Annuaire
read "NodeFrameWrite" = Just NodeFrameWrite
read "NodeFrameCalc" = Just NodeFrameCalc
read "NodeFile" = Just NodeFile
-- TODO NodePublic read ?
read _ = Nothing
read _ = Nothing
fldr :: NodeType -> Boolean -> String
......@@ -253,6 +256,7 @@ fldr Graph _ = "fa fa-hubzilla"
fldr Texts _ = "fa fa-newspaper-o"
fldr Dashboard _ = "fa fa-signal"
fldr NodeList _ = "fa fa-list"
fldr NodeFile _ = "fa fa-file" -- TODO depending on mime type we can use fa-file-image etc
fldr Annuaire true = "fa fa-address-card-o"
fldr Annuaire false = "fa fa-address-card"
......@@ -299,29 +303,30 @@ instance encodeJsonNodeType :: EncodeJson NodeType where
encodeJson nodeType = encodeJson $ show nodeType
nodeTypePath :: NodeType -> String
nodeTypePath Folder = "folder"
nodeTypePath FolderPrivate = "folderPrivate"
nodeTypePath FolderShared = "folderShared"
nodeTypePath FolderPublic = "folderPublic"
nodeTypePath Annuaire = "annuaire"
nodeTypePath Corpus = "corpus"
nodeTypePath Dashboard = "dashboard"
nodeTypePath Url_Document = "document"
nodeTypePath Error = "ErrorNodeType"
nodeTypePath Graph = "graph"
nodeTypePath Phylo = "phylo"
nodeTypePath Individu = "individu"
nodeTypePath Node = "node"
nodeTypePath Nodes = "nodes"
nodeTypePath NodeUser = "user"
nodeTypePath NodeContact = "contact"
nodeTypePath Tree = "tree"
nodeTypePath NodeList = "lists"
nodeTypePath Texts = "texts"
nodeTypePath Team = "team"
nodeTypePath NodeFrameWrite = "write"
nodeTypePath NodeFrameCalc = "calc"
nodeTypePath Folder = "folder"
nodeTypePath FolderPrivate = "folderPrivate"
nodeTypePath FolderShared = "folderShared"
nodeTypePath FolderPublic = "folderPublic"
nodeTypePath Annuaire = "annuaire"
nodeTypePath Corpus = "corpus"
nodeTypePath Dashboard = "dashboard"
nodeTypePath Url_Document = "document"
nodeTypePath Error = "ErrorNodeType"
nodeTypePath Graph = "graph"
nodeTypePath Phylo = "phylo"
nodeTypePath Individu = "individu"
nodeTypePath Node = "node"
nodeTypePath Nodes = "nodes"
nodeTypePath NodeUser = "user"
nodeTypePath NodeContact = "contact"
nodeTypePath Tree = "tree"
nodeTypePath NodeList = "lists"
nodeTypePath Texts = "texts"
nodeTypePath Team = "team"
nodeTypePath NodeFrameWrite = "write"
nodeTypePath NodeFrameCalc = "calc"
nodeTypePath (NodePublic nt) = nodeTypePath nt
nodeTypePath NodeFile = "file"
------------------------------------------------------------
......@@ -577,6 +582,7 @@ modeFromString _ = Nothing
-- corresponds to /add/form/async or /add/query/async
data AsyncTaskType = Form
| UploadFile
| GraphT
| Query
| AddNode
......@@ -594,16 +600,18 @@ instance decodeJsonAsyncTaskType :: DecodeJson AsyncTaskType where
obj <- decodeJson json
case obj of
"Form" -> pure Form
"UploadFile" -> pure UploadFile
"GraphT" -> pure GraphT
"Query" -> pure Query
"AddNode" -> pure AddNode
s -> Left ("Unknown string " <> s)
asyncTaskTypePath :: AsyncTaskType -> String
asyncTaskTypePath Form = "add/form/async/"
asyncTaskTypePath Query = "query/"
asyncTaskTypePath GraphT = "async/"
asyncTaskTypePath AddNode = "async/nobody/"
asyncTaskTypePath Form = "add/form/async/"
asyncTaskTypePath UploadFile = "add/file/async/"
asyncTaskTypePath Query = "query/"
asyncTaskTypePath GraphT = "async/"
asyncTaskTypePath AddNode = "async/nobody/"
asyncTaskTypePath UpdateNode = "update/"
......
exports._btoa = function(s) {
return btoa(unescape(encodeURIComponent(s)));
}
module Gargantext.Utils.String where
import Data.Function.Uncurried (Fn1, runFn1)
foreign import _btoa :: Fn1 String String
btoa :: String -> String
btoa = runFn1 _btoa
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