Commit 0d447f7d authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski Committed by James Laver

[Config] allow to switch the current backend

NOTE This doesn't work yet, especially the dropdown is problematic...
parent b04fd6a8
"use strict";
exports.createDropdown = function(iid) {
var el = document.getElementById(iid);
if (!window.Dropdown) return;
new window.Dropdown(el, {});
};
module Gargantext.BootstrapNative where
import Effect (Effect)
import Gargantext.Prelude
foreign import createDropdown :: String -> Effect Unit
...@@ -382,7 +382,7 @@ renderPage loaderDispatch { totalRecords, dispatch, container ...@@ -382,7 +382,7 @@ renderPage loaderDispatch { totalRecords, dispatch, container
] ]
-- TODO show date: Year-Month-Day only -- TODO show date: Year-Month-Day only
, div strikeIfDeleted [text date] , div strikeIfDeleted [text date]
, a (strikeIfDeleted <> [ href $ toLink $ Router.Document listId id , a (strikeIfDeleted <> [ href $ toLink endConfigStateful $ Router.Document listId id
, target "blank"]) , target "blank"])
[ text title ] [ text title ]
, div strikeIfDeleted [text source] , div strikeIfDeleted [text source]
......
...@@ -12,8 +12,9 @@ import Effect.Aff (Aff) ...@@ -12,8 +12,9 @@ import Effect.Aff (Aff)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Types (class ToQuery) import Gargantext.Types (class ToQuery)
import Gargantext.Config (End(..), NodeType(..), toUrl) import Gargantext.Config (endConfigStateful, End(..), NodeType(..), Path(..), toUrl)
import Gargantext.Config.REST (put) import Gargantext.Config.REST (post, put)
import Gargantext.Components.Modals.Modal (modalHide)
import Gargantext.Utils (id) import Gargantext.Utils (id)
import URI.Extra.QueryPairs as QP import URI.Extra.QueryPairs as QP
...@@ -167,7 +168,7 @@ instance encodeJsonCategoryQuery :: EncodeJson CategoryQuery where ...@@ -167,7 +168,7 @@ instance encodeJsonCategoryQuery :: EncodeJson CategoryQuery where
~> jsonEmptyObject ~> jsonEmptyObject
categoryUrl :: Int -> String categoryUrl :: Int -> String
categoryUrl nodeId = toUrl Back Node (Just nodeId) <> "/category" categoryUrl nodeId = toUrl endConfigStateful Back Node (Just nodeId) <> "/category"
putCategories :: Int -> CategoryQuery -> Aff (Array Int) putCategories :: Int -> CategoryQuery -> Aff (Array Int)
putCategories nodeId = put $ categoryUrl nodeId putCategories nodeId = put $ categoryUrl nodeId
...@@ -4,7 +4,7 @@ import Prelude hiding (div) ...@@ -4,7 +4,7 @@ import Prelude hiding (div)
import DOM.Simple.Console (log2) import DOM.Simple.Console (log2)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>)) import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>))
import Data.Array (filter, sortWith) import Data.Array (filter, sortWith, head)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq) import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
...@@ -14,13 +14,14 @@ import Data.Tuple (Tuple) ...@@ -14,13 +14,14 @@ import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\)) import Data.Tuple.Nested ((/\))
import Effect.Aff (Aff, launchAff, runAff) import Effect.Aff (Aff, launchAff, runAff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect (Effect)
import Effect.Uncurried (mkEffectFn1) import Effect.Uncurried (mkEffectFn1)
import FFI.Simple ((..)) import FFI.Simple ((..))
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import React.SyntheticEvent as E import React.SyntheticEvent as E
import Reactix as R import Reactix as R
import Reactix.DOM.HTML as H import Reactix.DOM.HTML as H
import Thermite as T import Thermite (PerformAction, Spec, Render, modifyState_, simpleSpec, defaultPerformAction)
import URI.Extra.QueryPairs as QP import URI.Extra.QueryPairs as QP
import URI.Query as Q import URI.Query as Q
import Web.File.File (toBlob) import Web.File.File (toBlob)
...@@ -28,9 +29,9 @@ import Web.File.FileList (FileList, item) ...@@ -28,9 +29,9 @@ import Web.File.FileList (FileList, item)
import Web.File.FileReader.Aff (readAsText) import Web.File.FileReader.Aff (readAsText)
import Gargantext.Components.Loader2 (useLoader) import Gargantext.Components.Loader2 (useLoader)
import Gargantext.Config (toUrl, endConfigStateful, End(..), NodeType(..), readNodeType) import Gargantext.Config (toUrl, EndConfig, endConfig, End(..), NodeType(..), readNodeType)
import Gargantext.Config as C
import Gargantext.Config.REST (get, put, post, postWwwUrlencoded, delete) import Gargantext.Config.REST (get, put, post, postWwwUrlencoded, delete)
import Gargantext.Pages.Layout.States (AppState)
import Gargantext.Router as Router import Gargantext.Router as Router
import Gargantext.Types (class ToQuery, toQuery) import Gargantext.Types (class ToQuery, toQuery)
import Gargantext.Utils (id) import Gargantext.Utils (id)
...@@ -40,10 +41,11 @@ type Name = String ...@@ -40,10 +41,11 @@ type Name = String
type Open = Boolean type Open = Boolean
type URL = String type URL = String
type ID = Int type ID = Int
type Reload = Int
data NodePopup = CreatePopup | NodePopup data NodePopup = CreatePopup | NodePopup
type Props = { root :: ID, mCurrentRoute :: Maybe Router.Routes } type Props = { root :: ID, mCurrentRoute :: Maybe Router.Routes, endConfig :: EndConfig }
data NTree a = NTree a (Array (NTree a)) data NTree a = NTree a (Array (NTree a))
...@@ -110,35 +112,29 @@ data Action = Submit String ...@@ -110,35 +112,29 @@ data Action = Submit String
| UploadFile FileType UploadFileContents | UploadFile FileType UploadFileContents
type State = { tree :: FTree type Tree = {
tree :: FTree
} }
mapFTree :: (FTree -> FTree) -> State -> State mapFTree :: (FTree -> FTree) -> Tree -> Tree
mapFTree f s@{tree} = s {tree = f tree} mapFTree f s@{tree} = s {tree = f tree}
-- TODO: make it a local function performAction :: EndConfig -> R.State Int -> R.State Tree -> Action -> Aff Unit
--performAction :: forall props. PerformAction State props Action
performAction :: R.State Int -> R.State State -> Action -> Aff Unit performAction endConfig (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) DeleteNode = do
void $ deleteNode endConfig id
performAction (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setState) DeleteNode = do
void $ deleteNode id
--modifyState_ $ mapFTree $ filterNTree (\(LNode {id}) -> id /= nid)
--liftEffect $ setState $ mapFTree $ filterNTree $ \(LNode {id: nid}) -> nid /= id
liftEffect $ setReload $ \r -> r + 1 liftEffect $ setReload $ \r -> r + 1
performAction _ ({tree: NTree (LNode {id}) _} /\ setState) (Submit name) = do performAction endConfig _ ({tree: NTree (LNode {id}) _} /\ setTree) (Submit name) = do
void $ renameNode id $ RenameValue {name} void $ renameNode endConfig id $ RenameValue {name}
--modifyState_ $ mapFTree $ setNodeName rid name liftEffect $ setTree $ \s@{tree: NTree (LNode node) arr} -> s {tree = NTree (LNode node {name = name}) arr}
liftEffect $ setState $ \s@{tree: NTree (LNode node) arr} -> s {tree = NTree (LNode node {name = name}) arr}
performAction (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setState) (CreateSubmit name nodeType) = do performAction endConfig (_ /\ setReload) (s@{tree: NTree (LNode {id}) _} /\ setTree) (CreateSubmit name nodeType) = do
void $ createNode id $ CreateValue {name, nodeType} void $ createNode endConfig id $ CreateValue {name, nodeType}
--modifyState_ $ mapFTree $ map $ hidePopOverNode nid
liftEffect $ setReload $ \r -> r + 1 liftEffect $ setReload $ \r -> r + 1
performAction _ ({tree: NTree (LNode {id}) _} /\ _) (UploadFile fileType contents) = do performAction endConfig _ ({tree: NTree (LNode {id}) _} /\ _) (UploadFile fileType contents) = do
hashes <- uploadFile id fileType contents hashes <- uploadFile endConfig id fileType contents
liftEffect $ log2 "uploaded:" hashes liftEffect $ log2 "uploaded:" hashes
...@@ -152,49 +148,43 @@ mCorpusId _ = Nothing ...@@ -152,49 +148,43 @@ mCorpusId _ = Nothing
type TreeViewProps = { tree :: FTree type TreeViewProps = { tree :: FTree
, mCurrentRoute :: Maybe Router.Routes , mCurrentRoute :: Maybe Router.Routes
, endConfig :: EndConfig
} }
loadedTreeView :: R.State Int -> TreeViewProps -> R.Element treeview :: Spec {} Props Void
loadedTreeView setReload p = R.createElement el p [] treeview = R2.elSpec $ R.hooksComponent "TreeView" cpt
where where
el = R.hooksComponent "LoadedTreeView" cpt cpt props _children = do
cpt {tree, mCurrentRoute} _ = do -- NOTE: this is a hack to reload the tree view on demand
setState <- R.useState' {tree} reload <- R.useState' (0 :: Reload)
pure $ H.div {className: "tree"} pure $ treeLoadView reload props
[ toHtml setReload setState mCurrentRoute ]
treeLoadView :: R.State Int -> Props -> R.Element treeLoadView :: R.State Reload -> Props -> R.Element
treeLoadView setReload p = R.createElement el p [] treeLoadView reload p = R.createElement el p []
where where
el = R.hooksComponent "TreeLoadView" cpt el = R.hooksComponent "TreeLoadView" cpt
cpt {root, mCurrentRoute} _ = do cpt {root, mCurrentRoute, endConfig} _ = do
useLoader root loadNode $ \{loaded} -> useLoader root (loadNode endConfig) $ \{loaded} ->
loadedTreeView setReload {tree: loaded, mCurrentRoute} loadedTreeView reload {tree: loaded, mCurrentRoute, endConfig}
elTreeview :: Props -> R.Element loadedTreeView :: R.State Reload -> TreeViewProps -> R.Element
elTreeview props = R.createElement el props [] loadedTreeView reload p = R.createElement el p []
where where
el = R.hooksComponent "TreeView" treeviewCpt el = R.hooksComponent "LoadedTreeView" cpt
cpt {tree, mCurrentRoute, endConfig} _ = do
treeState <- R.useState' {tree}
treeview :: Spec {} Props Void
treeview = R2.elSpec $ R.hooksComponent "TreeView" treeviewCpt
treeviewCpt {root, mCurrentRoute} _children = do
-- NOTE: this is a hack to reload the tree view on demand
setReload <- R.useState' 0
pure $ treeLoadView setReload {root, mCurrentRoute} pure $ H.div {className: "tree"}
[ toHtml reload treeState endConfig mCurrentRoute ]
-- START toHtml -- START toHtml
toHtml :: R.State Int -> R.State State -> Maybe Router.Routes -> R.Element toHtml :: R.State Reload -> R.State Tree -> EndConfig -> Maybe Router.Routes -> R.Element
--toHtml d s@(NTree (LNode {id, name, nodeType}) ary) n = R.createElement el {} [] toHtml reload treeState@({tree: (NTree (LNode {id, name, nodeType}) ary)} /\ _) endConfig mCurrentRoute = R.createElement el {} []
toHtml setReload setState@({tree: (NTree (LNode {id, name, nodeType}) ary)} /\ _) mCurrentRoute = R.createElement el {} []
where where
el = R.hooksComponent "NodeView" cpt el = R.hooksComponent "NodeView" cpt
pAction = performAction setReload setState pAction = performAction endConfig reload treeState
cpt props _ = do cpt props _ = do
folderOpen <- R.useState' true folderOpen <- R.useState' true
...@@ -202,9 +192,8 @@ toHtml setReload setState@({tree: (NTree (LNode {id, name, nodeType}) ary)} /\ _ ...@@ -202,9 +192,8 @@ toHtml setReload setState@({tree: (NTree (LNode {id, name, nodeType}) ary)} /\ _
pure $ H.ul {} pure $ H.ul {}
[ H.li {} [ H.li {}
( [ nodeMainSpan pAction {id, name, nodeType, mCurrentRoute} folderOpen ] ( [ nodeMainSpan pAction {id, name, nodeType, mCurrentRoute} folderOpen endConfig ]
<> childNodes setReload folderOpen mCurrentRoute (sortWith withId ary) <> childNodes endConfig reload folderOpen mCurrentRoute ary
) )
] ]
...@@ -217,8 +206,9 @@ type NodeMainSpanProps = ...@@ -217,8 +206,9 @@ type NodeMainSpanProps =
nodeMainSpan :: (Action -> Aff Unit) nodeMainSpan :: (Action -> Aff Unit)
-> Record NodeMainSpanProps -> Record NodeMainSpanProps
-> R.State Boolean -> R.State Boolean
-> EndConfig
-> R.Element -> R.Element
nodeMainSpan d p folderOpen = R.createElement el p [] nodeMainSpan d p folderOpen endConfig = R.createElement el p []
where where
el = R.hooksComponent "NodeMainSpan" cpt el = R.hooksComponent "NodeMainSpan" cpt
cpt {id, name, nodeType, mCurrentRoute} _ = do cpt {id, name, nodeType, mCurrentRoute} _ = do
...@@ -229,8 +219,9 @@ nodeMainSpan d p folderOpen = R.createElement el p [] ...@@ -229,8 +219,9 @@ nodeMainSpan d p folderOpen = R.createElement el p []
pure $ H.span (dropProps droppedFile isDragOver) pure $ H.span (dropProps droppedFile isDragOver)
[ folderIcon folderOpen [ folderIcon folderOpen
, H.a { href: (toUrl Front nodeType (Just id)) , H.a { href: (toUrl endConfig Front nodeType (Just id))
, style: {marginLeft: "22px"} } , style: {marginLeft: "22px"}
}
[ nodeText {isSelected: (mCorpusId mCurrentRoute) == (Just id), name} ] [ nodeText {isSelected: (mCorpusId mCurrentRoute) == (Just id), name} ]
, popOverIcon popupOpen , popOverIcon popupOpen
, nodePopupView d {id, name} popupOpen , nodePopupView d {id, name} popupOpen
...@@ -280,18 +271,18 @@ fldr :: Boolean -> String ...@@ -280,18 +271,18 @@ fldr :: Boolean -> String
fldr open = if open then "glyphicon glyphicon-folder-open" else "glyphicon glyphicon-folder-close" fldr open = if open then "glyphicon glyphicon-folder-open" else "glyphicon glyphicon-folder-close"
childNodes :: R.State Int -> R.State Boolean -> Maybe Router.Routes -> Array FTree -> Array R.Element childNodes :: EndConfig -> R.State Reload -> R.State Boolean -> Maybe Router.Routes -> Array FTree -> Array R.Element
childNodes _ _ _ [] = [] childNodes _ _ _ _ [] = []
childNodes _ (false /\ _) _ _ = [] childNodes _ _ (false /\ _) _ _ = []
childNodes setReload (true /\ _) mCurrentRoute ary = map (\ctree -> childNode {tree: ctree}) ary childNodes endConfig reload (true /\ _) mCurrentRoute ary = map (\ctree -> childNode {tree: ctree}) ary
where where
childNode :: State -> R.Element childNode :: Tree -> R.Element
childNode props = R.createElement el props [] childNode props = R.createElement el props []
el = R.hooksComponent "ChildNodeView" cpt el = R.hooksComponent "ChildNodeView" cpt
cpt {tree} _ = do cpt {tree} _ = do
setState <- R.useState' {tree} treeState <- R.useState' {tree}
pure $ toHtml setReload setState mCurrentRoute pure $ toHtml reload treeState endConfig mCurrentRoute
-- END toHtml -- END toHtml
...@@ -631,9 +622,8 @@ nodeText p = R.createElement el p [] ...@@ -631,9 +622,8 @@ nodeText p = R.createElement el p []
-- END node text -- END node text
loadNode :: ID -> Aff FTree loadNode :: EndConfig -> ID -> Aff FTree
-- loadNode a = lift ((get <<< toUrl endConfigStateful Back Tree <<< Just) a) loadNode ec = get <<< toUrl ec Back Tree <<< Just
loadNode = get <<< toUrl endConfigStateful Back Tree <<< Just
----- TREE CRUD Operations ----- TREE CRUD Operations
...@@ -659,15 +649,15 @@ instance encodeJsonCreateValue :: EncodeJson CreateValue where ...@@ -659,15 +649,15 @@ instance encodeJsonCreateValue :: EncodeJson CreateValue where
~> "pn_typename" := nodeType ~> "pn_typename" := nodeType
~> jsonEmptyObject ~> jsonEmptyObject
createNode :: ID -> CreateValue -> Aff ID createNode :: EndConfig -> ID -> CreateValue -> Aff ID
--createNode = post $ urlPlease Back $ "new" --createNode = post $ urlPlease Back $ "new"
createNode parentId = post $ toUrl endConfigStateful Back Node (Just parentId) createNode ec parentId = post $ toUrl ec Back Node (Just parentId)
renameNode :: ID -> RenameValue -> Aff (Array ID) renameNode :: EndConfig -> ID -> RenameValue -> Aff (Array ID)
renameNode renameNodeId = put $ toUrl endConfigStateful Back Node (Just renameNodeId) <> "/rename" renameNode ec renameNodeId = put $ toUrl ec Back Node (Just renameNodeId) <> "/rename"
deleteNode :: ID -> Aff ID deleteNode :: EndConfig -> ID -> Aff ID
deleteNode = delete <<< toUrl endConfigStateful Back Node <<< Just deleteNode ec = delete <<< toUrl ec Back Node <<< Just
newtype FileUploadQuery = FileUploadQuery { newtype FileUploadQuery = FileUploadQuery {
fileType :: FileType fileType :: FileType
...@@ -680,19 +670,11 @@ instance fileUploadQueryToQuery :: ToQuery FileUploadQuery where ...@@ -680,19 +670,11 @@ instance fileUploadQueryToQuery :: ToQuery FileUploadQuery where
where pair :: forall a. Show a => String -> a -> Array (Tuple QP.Key (Maybe QP.Value)) where pair :: forall a. Show a => String -> a -> Array (Tuple QP.Key (Maybe QP.Value))
pair k v = [ QP.keyFromString k /\ (Just $ QP.valueFromString $ show v) ] pair k v = [ QP.keyFromString k /\ (Just $ QP.valueFromString $ show v) ]
uploadFile :: ID -> FileType -> UploadFileContents -> Aff (Array FileHash) uploadFile :: EndConfig -> ID -> FileType -> UploadFileContents -> Aff (Array FileHash)
uploadFile id fileType (UploadFileContents fileContents) = postWwwUrlencoded url fileContents uploadFile ec id fileType (UploadFileContents fileContents) = postWwwUrlencoded url fileContents
where where
q = FileUploadQuery { fileType: fileType } q = FileUploadQuery { fileType: fileType }
url = toUrl endConfigStateful Back Node (Just id) <> "/upload" <> Q.print (toQuery q) url = toUrl ec Back Node (Just id) <> "/upload" <> Q.print (toQuery q)
-- UNUSED
-- deleteNodes :: TODO -> Aff ID
-- deleteNodes = deleteWithBody (toUrl endConfigStateful Back Nodes Nothing)
-- UNUSED
-- createNode :: TODO -> Aff ID
-- createNode = post (toUrl endConfigStateful Back Node Nothing)
fnTransform :: LNode -> FTree fnTransform :: LNode -> FTree
fnTransform n = NTree n [] fnTransform n = NTree n []
...@@ -11,12 +11,15 @@ module Gargantext.Config where ...@@ -11,12 +11,15 @@ module Gargantext.Config where
import Prelude import Prelude
import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson, (:=), (~>), jsonEmptyObject) import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson, (:=), (~>), jsonEmptyObject)
import Data.Array (filter, head)
import Data.Foldable (foldMap) import Data.Foldable (foldMap)
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe, fromJust)
import Gargantext.Router as R import Partial.Unsafe (unsafePartial)
import Thermite (PerformAction, modifyState_)
import Gargantext.Router as R
import Gargantext.Types (TermList, TermSize(..)) import Gargantext.Types (TermList, TermSize(..))
urlPlease :: End -> String -> String urlPlease :: End -> String -> String
...@@ -28,15 +31,63 @@ endConfigStateful :: EndConfig ...@@ -28,15 +31,63 @@ endConfigStateful :: EndConfig
endConfigStateful = endConfig endConfigStateful = endConfig
endConfig :: EndConfig endConfig :: EndConfig
endConfig = endConfig' V10 endConfig = devEndConfig
devEndConfig :: EndConfig
devEndConfig = devEndConfig' V10
devEndConfig' :: ApiVersion -> EndConfig
devEndConfig' v = { front : frontRelative
, back: backDev v
, static : staticRelative
}
endConfig' :: ApiVersion -> EndConfig localEndConfig :: EndConfig
endConfig' v = { front : frontRelative localEndConfig = localEndConfig' V10
localEndConfig' :: ApiVersion -> EndConfig
localEndConfig' v = { front : frontRelative
, back : backLocal v , back : backLocal v
--, back: backDev v
, static : staticRelative , static : staticRelative
} }
-- , back : backDemo v }
type EndConfigOption = {
endConfig :: EndConfig
, displayName :: String
}
endConfigOptions :: Array EndConfigOption
endConfigOptions = [
{
endConfig: devEndConfig
, displayName: "dev"
}
, {
endConfig: localEndConfig
, displayName: "local"
}
]
endConfigDisplayName :: EndConfig -> String
endConfigDisplayName endConfig = (unsafePartial $ fromJust h).displayName
where
h = head $ filter (\ec -> ec.endConfig == endConfig) endConfigOptions
type State = {
endConfig :: EndConfig
}
initialState :: State
initialState = {
endConfig: endConfig
}
data StateAction = UpdateState State
statePerformAction :: forall props. PerformAction State props StateAction
statePerformAction (UpdateState state) _ _ =
void $ modifyState_ $ const state
------------------------------------------------------------------------ ------------------------------------------------------------------------
frontRelative :: Config frontRelative :: Config
......
...@@ -12,6 +12,7 @@ import Routing.Hash (setHash) ...@@ -12,6 +12,7 @@ import Routing.Hash (setHash)
import Gargantext.Components.GraphExplorer.Types as GET import Gargantext.Components.GraphExplorer.Types as GET
import Gargantext.Components.Login as LN import Gargantext.Components.Login as LN
import Gargantext.Components.Modals.Modal (modalShow) import Gargantext.Components.Modals.Modal (modalShow)
import Gargantext.Config as C
import Gargantext.Pages.Annuaire as Annuaire import Gargantext.Pages.Annuaire as Annuaire
import Gargantext.Pages.Layout.States (AppState) import Gargantext.Pages.Layout.States (AppState)
import Gargantext.Prelude import Gargantext.Prelude
...@@ -28,6 +29,7 @@ data Action ...@@ -28,6 +29,7 @@ data Action
| Logout | Logout
| ShowAddCorpus | ShowAddCorpus
| ToggleTree | ToggleTree
| ConfigStateA C.StateAction
performAction :: PerformAction AppState {} Action performAction :: PerformAction AppState {} Action
...@@ -62,6 +64,8 @@ performAction (AnnuaireAction _) _ _ = pure unit ...@@ -62,6 +64,8 @@ performAction (AnnuaireAction _) _ _ = pure unit
-- liftEffect $ modalShow "addCorpus" -- liftEffect $ modalShow "addCorpus"
-- modifyState $ _ {showCorpus = true} -- modifyState $ _ {showCorpus = true}
performAction (ConfigStateA _) _ _ = pure unit
---------------------------------------------------------- ----------------------------------------------------------
_loginAction :: Prism' Action LN.Action _loginAction :: Prism' Action LN.Action
...@@ -70,6 +74,12 @@ _loginAction = prism LoginA \action -> ...@@ -70,6 +74,12 @@ _loginAction = prism LoginA \action ->
LoginA caction -> Right caction LoginA caction -> Right caction
_-> Left action _-> Left action
_configStateAction :: Prism' Action C.StateAction
_configStateAction = prism ConfigStateA \action ->
case action of
ConfigStateA caction -> Right caction
_-> Left action
_annuaireAction :: Prism' Action Annuaire.Action _annuaireAction :: Prism' Action Annuaire.Action
_annuaireAction = prism AnnuaireAction \action -> _annuaireAction = prism AnnuaireAction \action ->
case action of case action of
......
...@@ -3,6 +3,7 @@ module Gargantext.Pages.Layout.Specs where ...@@ -3,6 +3,7 @@ module Gargantext.Pages.Layout.Specs where
import Data.Foldable (fold, intercalate) import Data.Foldable (fold, intercalate)
import Data.Lens (over) import Data.Lens (over)
import Data.Maybe (Maybe(Nothing, Just)) import Data.Maybe (Maybe(Nothing, Just))
import Data.Tuple.Nested((/\))
import Effect (Effect) import Effect (Effect)
import React.DOM (button, div, text) import React.DOM (button, div, text)
import React.DOM.Props (_id, className, onClick, role, style) import React.DOM.Props (_id, className, onClick, role, style)
...@@ -11,12 +12,14 @@ import Reactix.DOM.HTML as H ...@@ -11,12 +12,14 @@ import Reactix.DOM.HTML as H
import Thermite (Spec, _render, defaultPerformAction, defaultRender, focus, simpleSpec, withState, noState, cmapProps) import Thermite (Spec, _render, defaultPerformAction, defaultRender, focus, simpleSpec, withState, noState, cmapProps)
-- import Unsafe.Coerce (unsafeCoerce) -- import Unsafe.Coerce (unsafeCoerce)
import Gargantext.BootstrapNative (createDropdown)
import Gargantext.Prelude import Gargantext.Prelude
import Gargantext.Components.Data.Lang (Lang(..)) import Gargantext.Components.Data.Lang (Lang(..))
import Gargantext.Components.GraphExplorer as GE import Gargantext.Components.GraphExplorer as GE
import Gargantext.Components.Login.Types (AuthData(..)) import Gargantext.Components.Login.Types (AuthData(..))
import Gargantext.Components.Login as LN import Gargantext.Components.Login as LN
import Gargantext.Components.Tree as Tree import Gargantext.Components.Tree as Tree
import Gargantext.Config as C
import Gargantext.Folder as F import Gargantext.Folder as F
import Gargantext.Pages.Annuaire as A import Gargantext.Pages.Annuaire as A
import Gargantext.Pages.Annuaire.User.Contacts as C import Gargantext.Pages.Annuaire.User.Contacts as C
...@@ -26,9 +29,9 @@ import Gargantext.Pages.Corpus.Dashboard as Dsh ...@@ -26,9 +29,9 @@ import Gargantext.Pages.Corpus.Dashboard as Dsh
import Gargantext.Pages.Lists as Lists import Gargantext.Pages.Lists as Lists
import Gargantext.Pages.Texts as Texts import Gargantext.Pages.Texts as Texts
import Gargantext.Pages.Home as L import Gargantext.Pages.Home as L
import Gargantext.Pages.Layout.Actions (Action(..), _graphExplorerAction, _loginAction, performAction) import Gargantext.Pages.Layout.Actions (Action(..), _graphExplorerAction, _loginAction, performAction, _configStateAction)
import Gargantext.Pages.Layout.Specs.SearchBar as SB import Gargantext.Pages.Layout.Specs.SearchBar as SB
import Gargantext.Pages.Layout.States (AppState, _graphExplorerState, _searchState, _loginState, _addCorpusState) import Gargantext.Pages.Layout.States (AppState, _graphExplorerState, _loginState, _configState)
import Gargantext.Router (Routes(..)) import Gargantext.Router (Routes(..))
import Gargantext.Utils.Reactix as R2 import Gargantext.Utils.Reactix as R2
...@@ -152,7 +155,7 @@ layout1 layout = ...@@ -152,7 +155,7 @@ layout1 layout =
[ withState \st -> [ withState \st ->
case st.loginState.authData of case st.loginState.authData of
Just (AuthData {tree_id}) -> Just (AuthData {tree_id}) ->
ls $ cmapProps (const {root: tree_id, mCurrentRoute: st.currentRoute}) $ noState $ Tree.treeview ls $ cmapProps (const {root: tree_id, mCurrentRoute: st.currentRoute, endConfig: st.configState.endConfig}) $ noState $ Tree.treeview
Nothing -> Nothing ->
outerLayout1 outerLayout1
, rs bs , rs bs
...@@ -345,11 +348,50 @@ logLinks d s = case s.loginState.authData of ...@@ -345,11 +348,50 @@ logLinks d s = case s.loginState.authData of
[H.text " Logout"] [H.text " Logout"]
endConfigChooser :: R.State C.State -> R.Element
endConfigChooser (configState /\ setConfigState) = R.createElement el {} []
where
el = R.hooksComponent "EndConfigChooser" cpt
cpt {} _ = do
-- NOTE Need to rebind the component after rerender
R.useEffect $
pure $ createDropdown "end-config-chooser"
pure $ H.li {className: "dropdown"}
[ H.a { className: "navbar-text dropdown-toggle"
, href: "#"
, role: "button"
, data: {toggle: "dropdown"}
, id: "end-config-chooser"
}
[ H.text $ C.endConfigDisplayName configState.endConfig ]
, H.ul { className: "dropdown-menu"
} (liItem <$> C.endConfigOptions)
]
liItem :: C.EndConfigOption -> R.Element
liItem {endConfig, displayName} =
--H.li {on: {click: \_ -> setConfigState $ \st -> st {endConfig = endConfig}}}
H.li {}
[ H.a {href: "#"} [H.text displayName] ]
divDropdownRight :: (Action -> Effect Unit) -> AppState -> R.Element divDropdownRight :: (Action -> Effect Unit) -> AppState -> R.Element
divDropdownRight d s = divDropdownRight d s = R.createElement el {} []
H.ul {className: "nav navbar-nav pull-right"} where
[ H.li {className: "dropdown"} el = R.hooksComponent "DivDropdownRight" cpt
[ logLinks d s ] cpt {} _children = do
(configState /\ setConfigState) <- R.useState' s.configState
R.useEffect $
if (configState /= s.configState) then do
pure $ d $ ConfigStateA $ C.UpdateState configState
else
pure $ pure $ unit
pure $ H.ul {className: "nav navbar-nav pull-right"}
[ endConfigChooser (configState /\ setConfigState)
, logLinks d s
] ]
layoutFooter :: Spec {} {} Void layoutFooter :: Spec {} {} Void
......
...@@ -5,8 +5,8 @@ import Prelude hiding (div) ...@@ -5,8 +5,8 @@ import Prelude hiding (div)
import Data.Lens (Lens', lens) import Data.Lens (Lens', lens)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Effect (Effect) import Effect (Effect)
import Gargantext.Config as C
import Gargantext.Components.Login as LN import Gargantext.Components.Login as LN
import Gargantext.Config (EndConfig, endConfigStateful)
import Gargantext.Components.Login as LN import Gargantext.Components.Login as LN
--import Gargantext.Components.Login.Types as LNT --import Gargantext.Components.Login.Types as LNT
...@@ -21,7 +21,7 @@ type AppState = ...@@ -21,7 +21,7 @@ type AppState =
, showCorpus :: Boolean , showCorpus :: Boolean
--, graphExplorerState :: Record GET.StateGlue --, graphExplorerState :: Record GET.StateGlue
, showTree :: Boolean , showTree :: Boolean
, endConfig :: EndConfig , configState :: C.State
} }
initAppState :: Effect AppState initAppState :: Effect AppState
...@@ -35,7 +35,7 @@ initAppState = do ...@@ -35,7 +35,7 @@ initAppState = do
, showCorpus : false , showCorpus : false
--, graphExplorerState : GET.initialStateGlue --, graphExplorerState : GET.initialStateGlue
, showTree : false , showTree : false
, endConfig : endConfigStateful , configState : C.initialState
} }
...@@ -44,13 +44,9 @@ initAppState = do ...@@ -44,13 +44,9 @@ initAppState = do
_loginState :: Lens' AppState LN.State _loginState :: Lens' AppState LN.State
_loginState = lens (\s -> s.loginState) (\s ss -> s{loginState = ss}) _loginState = lens (\s -> s.loginState) (\s ss -> s{loginState = ss})
_graphExplorerState :: Lens' AppState (Record GET.StateGlue) _configState :: Lens' AppState C.State
_graphExplorerState = lens getter setter _configState = lens (\s -> s.configState) (\s ss -> s{configState = ss})
where
getter :: AppState -> Record GET.StateGlue _graphExplorerState :: Lens' AppState GE.State
getter s = { _graphExplorerState = lens (\s -> s.graphExplorerState) (\s ss -> s{graphExplorerState = ss})
}
--setter s ss = s {graphExplorerState = ss}
setter :: AppState -> (Record GET.StateGlue) -> AppState
setter s ss = s
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