Commit 8864fe75 authored by Alexandre Delanoë's avatar Alexandre Delanoë

[REFACT] class Read + fix warnings

parent 971366ab
......@@ -40,8 +40,8 @@ type CommonProps =
)
------------------------------------------------------------------------
type Props = ( root :: ID
, asyncTasks :: R.State GAT.Storage
type Props = ( root :: ID
, asyncTasks :: R.State GAT.Storage
| CommonProps
)
......@@ -58,16 +58,15 @@ treeView props = R.createElement treeViewCpt props []
, openNodes
, reload
, asyncTasks
} _children = do
pure $ treeLoadView { root
, mCurrentRoute
, session
, frontends
, openNodes
, reload
, asyncTasks
}
} _children = pure
$ treeLoadView { root
, mCurrentRoute
, session
, frontends
, openNodes
, reload
, asyncTasks
}
treeLoadView :: Record Props -> R.Element
treeLoadView p = R.createElement treeLoadViewCpt p []
......@@ -95,9 +94,9 @@ treeLoadView p = R.createElement treeLoadViewCpt p []
}
useLoader { root, counter: fst reload } fetch paint
type TreeViewProps = ( asyncTasks :: R.State GAT.Storage
, tree :: FTree
, tasks :: Record Tasks
type TreeViewProps = ( asyncTasks :: R.State GAT.Storage
, tree :: FTree
, tasks :: Record Tasks
| CommonProps
)
......@@ -130,8 +129,8 @@ loadedTreeView p = R.createElement loadedTreeViewCpt p []
------------------------------------------------------------------------
type ToHtmlProps =
( asyncTasks :: R.State GAT.Storage
, tasks :: Record Tasks
, tree :: FTree
, tasks :: Record Tasks
, tree :: FTree
| CommonProps
)
......@@ -183,7 +182,9 @@ toHtml p@{ asyncTasks
<> childNodes (Record.merge commonProps
{ asyncTasks
, children: ary
, folderOpen })
, folderOpen
}
)
)
]
......
......@@ -49,8 +49,6 @@ icon RefreshTree = glyphiconNodeAction Refresh
icon (ShareNode _) = glyphiconNodeAction Share
-- icon _ = "hand-o-right"
text :: Action -> String
text DeleteNode = "Delete !"
text RefreshTree = "Refresh Tree !"
......
......@@ -124,7 +124,10 @@ uploadFileViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadFileView" cpt
liftEffect $ do
setMFile $ const $ Just $ {contents: UploadFileContents contents, name}
onChangeFileType :: forall e. R.State FileType -> e -> Effect Unit
onChangeFileType :: forall e
. R.State FileType
-> e
-> Effect Unit
onChangeFileType (fileType /\ setFileType) e = do
setFileType $ const
$ unsafePartial
......@@ -132,7 +135,10 @@ uploadFileViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadFileView" cpt
$ readFileType
$ R2.unsafeEventValue e
onChangeLang :: forall e. R.State (Maybe Lang) -> e -> Effect Unit
onChangeLang :: forall e
. R.State (Maybe Lang)
-> e
-> Effect Unit
onChangeLang (lang /\ setLang) e = do
setLang $ const
$ unsafePartial
......@@ -155,13 +161,19 @@ uploadButton props = R.createElement uploadButtonCpt props []
uploadButtonCpt :: R.Component UploadButtonProps
uploadButtonCpt = R.hooksComponent "G.C.F.T.N.A.U.uploadButton" cpt
where
cpt {dispatch, fileType: (fileType /\ setFileType), id, lang: (lang /\ setLang), mFile: (mFile /\ setMFile), nodeType} _ = do
pure $ H.button { className: "btn btn-primary"
, "type" : "button"
, disabled
, style : { width: "100%" }
, on: {click: onClick}
} [ H.text "Upload" ]
cpt { dispatch
, fileType: (fileType /\ setFileType)
, id
, lang: (lang /\ setLang)
, mFile: (mFile /\ setMFile)
, nodeType
} _ = pure
$ H.button { className: "btn btn-primary"
, "type" : "button"
, disabled
, style : { width: "100%" }
, on: {click: onClick}
} [ H.text "Upload" ]
where
disabled = case mFile of
Nothing -> "1"
......@@ -191,19 +203,24 @@ fileTypeView p = R.createElement fileTypeViewCpt p []
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), isDragOver: (_ /\ setIsDragOver), nodeType} _ = do
pure $ H.div tooltipProps $
[ H.div {className: "panel panel-default"}
[ panelHeading
, panelBody
, panelFooter
]
]
cpt { dispatch
, droppedFile: Just (DroppedFile {contents, fileType}) /\ setDroppedFile
, isDragOver: (_ /\ setIsDragOver)
, nodeType
} _ = pure
$ H.div tooltipProps [ H.div { className: "panel panel-default"}
[ panelHeading
, panelBody
, panelFooter
]
]
where
tooltipProps = { className: ""
, id: "file-type-tooltip"
, title: "Choose file type"
, data: {toggle: "tooltip", placement: "right"}
, id : "file-type-tooltip"
, title : "Choose file type"
, data : { toggle: "tooltip"
, placement: "right"
}
}
panelHeading =
H.div {className: "panel-heading"}
......@@ -255,6 +272,14 @@ fileTypeViewCpt = R.hooksComponent "G.C.F.T.N.A.U.fileTypeView" cpt
cpt {droppedFile: (Nothing /\ _)} _ = do
pure $ H.div {} []
-- | UTils
readFileType :: String -> Maybe FileType
readFileType "CSV" = Just CSV
readFileType "CSV_HAL" = Just CSV_HAL
readFileType "PresseRIS" = Just PresseRIS
readFileType "WOS" = Just WOS
readFileType _ = Nothing
newtype FileUploadQuery = FileUploadQuery {
fileType :: FileType
......@@ -287,6 +312,8 @@ uploadFile session nodeType id fileType {mName, contents: UploadFileContents con
, Tuple "_wf_name" mName
]
------------------------------------------------------------------------
uploadTermListView :: Record Props -> R.Element
uploadTermListView props = R.createElement uploadTermListViewCpt props []
......@@ -306,7 +333,9 @@ uploadTermListViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadTermListView" cpt
, H.div {} [ uploadTermButton { dispatch, id, mFile, nodeType } ]
]
onChangeContents :: forall e. R.State (Maybe UploadFile) -> E.SyntheticEvent_ e -> Effect Unit
onChangeContents :: forall e. R.State (Maybe UploadFile)
-> E.SyntheticEvent_ e
-> Effect Unit
onChangeContents (mFile /\ setMFile) e = do
let mF = R2.inputFileNameWithBlob 0 e
E.preventDefault e
......@@ -316,7 +345,9 @@ uploadTermListViewCpt = R.hooksComponent "G.C.F.T.N.A.U.UploadTermListView" cpt
Just {blob, name} -> void $ launchAff do
contents <- readAsText blob
liftEffect $ do
setMFile $ const $ Just $ {contents: UploadFileContents contents, name}
setMFile $ const $ Just $ { contents: UploadFileContents contents
, name
}
type UploadTermButtonProps =
......@@ -337,7 +368,7 @@ uploadTermButtonCpt = R.hooksComponent "G.C.F.T.N.A.U.uploadTermButton" cpt
where
disabled = case mFile of
Nothing -> "1"
Just _ -> ""
Just _ -> ""
onClick e = do
let {name, contents} = unsafePartial $ fromJust mFile
......@@ -347,13 +378,4 @@ uploadTermButtonCpt = R.hooksComponent "G.C.F.T.N.A.U.uploadTermButton" cpt
setMFile $ const $ Nothing
-- | UTils
readFileType :: String -> Maybe FileType
readFileType "CSV" = Just CSV
readFileType "CSV_HAL" = Just CSV_HAL
readFileType "PresseRIS" = Just PresseRIS
readFileType "WOS" = Just WOS
readFileType _ = Nothing
......@@ -113,8 +113,7 @@ nodeMainSpan p@{ dispatch, folderOpen, frontends, session } = R.createElement el
}
[ H.i {className: GT.fldr nodeType open} [] ]
popOverIcon =
H.a { className: "settings fa fa-cog" } []
popOverIcon = H.a { className: "settings fa fa-cog" } []
mNodePopupView props@{id, nodeType} onPopoverClose =
nodePopupView { id
......@@ -313,8 +312,9 @@ nodePopupCpt = R.hooksComponent "G.C.F.T.N.B.nodePopupView" cpt
tooltipProps = { className : ""
, id : "node-popup-tooltip"
, title : "Node settings"
, data: { toggle: "tooltip"
, placement: "right"}
, data: { toggle : "tooltip"
, placement: "right"
}
--, style: { top: y - 65.0, left: x + 10.0 }
}
......@@ -336,9 +336,9 @@ nodePopupCpt = R.hooksComponent "G.C.F.T.N.B.nodePopupView" cpt
, H.div {className: "col-md-1"}
[ H.a { "type" : "button"
, className: glyphicon "window-close"
, on: { click: \e -> p.onPopoverClose
$ R2.unsafeEventTarget e
}
, on : { click: \e -> p.onPopoverClose
$ R2.unsafeEventTarget e
}
, title : "Close"
} []
]
......@@ -439,13 +439,13 @@ type NodeProps =
type PanelActionProps =
( id :: ID
, action :: NodeAction
, dispatch :: Action -> Aff Unit
, name :: Name
( id :: ID
, action :: NodeAction
, dispatch :: Action -> Aff Unit
, name :: Name
, nodePopup :: Maybe NodePopup
, nodeType :: GT.NodeType
, session :: Session
, nodeType :: GT.NodeType
, session :: Session
)
panelAction :: Record PanelActionProps -> R.Element
......
......@@ -2,8 +2,6 @@ module Gargantext.Components.GraphExplorer.Sidebar
(Props, sidebar)
where
import Prelude
import Control.Parallel (parTraverse)
import Data.Array (head, last)
import Data.Int (fromString)
......@@ -16,22 +14,20 @@ import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, launchAff_)
import Effect.Class (liftEffect)
import Partial.Unsafe (unsafePartial)
import Reactix as R
import Reactix.DOM.HTML as RH
import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.NgramsTable.Core as NTC
import Gargantext.Components.Nodes.Corpus.Graph.Tabs (tabs) as CGT
import Gargantext.Components.RandomText (words)
import Gargantext.Data.Array (mapMaybe)
import Gargantext.Ends (Frontends, url)
import Gargantext.Ends (Frontends)
import Gargantext.Hooks.Sigmax.Types as SigmaxT
import Gargantext.Routes as Routes
import Gargantext.Sessions (Session)
import Gargantext.Types (CTabNgramType, TabSubType(..), TabType(..), TermList(..), modeTabType)
import Gargantext.Types as GT
import Gargantext.Utils.Reactix as R2
import Partial.Unsafe (unsafePartial)
import Gargantext.Prelude
import Reactix as R
import Reactix.DOM.HTML as RH
type Props =
( frontends :: Frontends
......
......@@ -23,6 +23,8 @@ instance showLang :: Show Lang where
derive instance eqLang :: Eq Lang
-- instance readLang :: Read Lang where
readLang :: String -> Maybe Lang
readLang "FR" = Just FR
readLang "EN" = Just EN
......
......@@ -22,7 +22,6 @@ import Data.Set as Set
import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..), fst, snd)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Console (log2)
import Effect (Effect)
import Prelude (class Show, Unit, bind, const, discard, identity, map, mempty, not, pure, show, unit, (#), ($), (&&), (/=), (<$>), (<<<), (<>), (=<<), (==), (||))
import Reactix as R
......
......@@ -22,3 +22,5 @@ logs:: forall message effect.
-> effect Unit
logs = liftEffect <<< log <<< show
......@@ -40,6 +40,9 @@ derive instance eqTermSize :: Eq TermSize
class ToQuery a where
toQuery :: a -> Query
class Read a where
read :: String -> a
instance showTermSize :: Show TermSize where
show MonoTerm = "MonoTerm"
show MultiTerm = "MultiTerm"
......
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