Commit 63c4610a authored by Mael NICOLAS's avatar Mael NICOLAS

merged

parents 9a6d8cc0 7da3fe09
...@@ -9,34 +9,49 @@ import Data.Tuple (Tuple(..)) ...@@ -9,34 +9,49 @@ import Data.Tuple (Tuple(..))
import React (ReactElement) import React (ReactElement)
import React.DOM (a, div, nav, text) import React.DOM (a, div, nav, text)
import React.DOM.Props (className, onClick) import React.DOM.Props (className, onClick)
import Thermite (PerformAction, Render, Spec, _render, modifyState, focus, simpleSpec, withState) import Thermite ( PerformAction, Render, Spec
, _render, modifyState, focus
, simpleSpec, withState)
type State = Int type State = Int
data Action = ChangeTab Int data Action = ChangeTab Int
tabs :: forall state props action . Lens' state State -> Prism' action Action -> List (Tuple String (Spec state props action)) -> Spec state props action tabs :: forall state props action.
Lens' state State -> Prism' action Action
-> List (Tuple String (Spec state props action))
-> Spec state props action
tabs l p ls = withState \st -> tabs l p ls = withState \st ->
fold fold
[ focus l p $ simpleSpec performAction (render (activeTab st) ls) [ focus l p $ simpleSpec performAction (render (activeTab st) ls)
, wrapper $ fold $ mapWithIndex (tab (activeTab st)) ls , wrapper $ fold $ mapWithIndex ( tab (activeTab st)) ls
] ]
where where
activeTab = view l activeTab = view l
wrapper = over _render \render d p s c -> wrapper = over _render \render d p s c ->
[div [className "tab-content"] $ render d p s c] [div [className "tab-content"] $ render d p s c]
tab :: forall state props action. Int -> Int -> Tuple String (Spec state props action) -> Spec state props action tab :: forall state props action.
Int -> Int -> Tuple String (Spec state props action)
-> Spec state props action
tab sid iid (Tuple name spec) = over _render tabRender spec tab sid iid (Tuple name spec) = over _render tabRender spec
where where
tabRender renderer d p s c = tabRender renderer d p s c =
[div [ className $ "tab-pane " <> if sid ==iid then " show active" else " fade"] $ renderer d p s c] [ div [ className $ "tab-pane " <>
if sid ==iid
then " show active"
else " fade"] $ renderer d p s c
]
performAction :: forall props. PerformAction State props Action performAction :: forall props.
performAction (ChangeTab i) _ _ = void $ modifyState $ const i PerformAction State props Action
performAction (ChangeTab i) _ _ =
void $ modifyState $ const i
render :: forall state props action. State -> List (Tuple String (Spec state props action)) -> Render State props Action render :: forall state props action.
State -> List (Tuple String (Spec state props action))
-> Render State props Action
render at ls d p s c = render at ls d p s c =
[ nav [] [ nav []
[ div [className "nav nav-tabs"] [ div [className "nav nav-tabs"]
...@@ -46,4 +61,7 @@ render at ls d p s c = ...@@ -46,4 +61,7 @@ render at ls d p s c =
where where
item :: forall a. Int -> Int -> (Tuple String a) -> ReactElement item :: forall a. Int -> Int -> (Tuple String a) -> ReactElement
item sid iid (Tuple name _) = item sid iid (Tuple name _) =
a [className $ "nav-item nav-link" <> if sid == iid then " active" else "", onClick \e -> d $ ChangeTab iid] [text name] a [className $ "nav-item nav-link" <>
if sid == iid
then " active"
else "", onClick \e -> d $ ChangeTab iid] [text name]
...@@ -6,7 +6,7 @@ import Affjax (defaultRequest, printResponseFormatError, request) ...@@ -6,7 +6,7 @@ import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..)) import Affjax.RequestBody (RequestBody(..))
import Affjax.ResponseFormat as ResponseFormat import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift) import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (class DecodeJson, Json, decodeJson, encodeJson, (.?)) import Data.Argonaut (class DecodeJson, class EncodeJson, Json, decodeJson, encodeJson, jsonEmptyObject, (.?), (:=), (~>))
import Data.Argonaut.Core (Json) import Data.Argonaut.Core (Json)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.HTTP.Method (Method(..)) import Data.HTTP.Method (Method(..))
...@@ -16,12 +16,13 @@ import Effect (Effect) ...@@ -16,12 +16,13 @@ import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Console (log) import Effect.Console (log)
import Prelude (identity)
import React (ReactElement) import React (ReactElement)
import React.DOM (a, div, i, li, text, ul) import Gargantext.Config (NodeType(..), readNodeType, toUrl, readNodeType, End(..), ApiVersion, defaultRoot)
import React.DOM.Props (Props, className, href, onClick) import React.DOM (a, button, div, h5, i, input, li, span, text, ul)
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec) import React.DOM.Props (Props, _type, className, href, onClick, onInput, placeholder, style, value)
import Thermite (PerformAction, Render, Spec, cotransform, modifyState, simpleSpec)
import Gargantext.Config (NodeType(..), toUrl, readNodeType, End(..), ApiVersion, defaultRoot) import Unsafe.Coerce (unsafeCoerce)
type Name = String type Name = String
type Open = Boolean type Open = Boolean
...@@ -32,15 +33,43 @@ data NTree a = NTree a (Array (NTree a)) ...@@ -32,15 +33,43 @@ data NTree a = NTree a (Array (NTree a))
type FTree = NTree LNode type FTree = NTree LNode
data Action = ToggleFolder ID --| Initialize data Action = ShowPopOver
| ToggleFolder ID
| RenameNode String
| Submit
--| Initialize
type State = FTree type State = FTree
initialState :: State initialState :: State
initialState = NTree (LNode {id : 1, name : "", nodeType : "", open : true}) [] initialState = NTree (LNode { id : 3
, name : ""
, nodeType : NodeUser
, open : true
, popOver : false
, renameNodeValue : ""
}) []
performAction :: PerformAction State {} Action performAction :: PerformAction State {} Action
performAction (ToggleFolder i) _ _ = void $ modifyState $ toggleNode i performAction (ToggleFolder i) _ _ =
void $ cotransform (\td -> toggleNode i td)
performAction ShowPopOver _ _ = void $
modifyState $ \(NTree (LNode lnode) ary) -> NTree (LNode $ lnode { popOver = true }) ary
performAction Submit _ s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) ary) = void $ do
s' <- lift $ renameNode id $ RenameValue { name : getRenameNodeValue s}
case s' of
Left err -> modifyState identity
Right d -> modifyState identity
performAction (RenameNode r) _ _ = void $
modifyState $ \(NTree (LNode lnode) ary) -> NTree (LNode $ lnode { renameNodeValue = r }) ary
-- performAction Initialize _ _ = void $ do -- performAction Initialize _ _ = void $ do
-- s <- lift $ loadDefaultNode -- s <- lift $ loadDefaultNode
...@@ -50,8 +79,8 @@ performAction (ToggleFolder i) _ _ = void $ modifyState $ toggleNode i ...@@ -50,8 +79,8 @@ performAction (ToggleFolder i) _ _ = void $ modifyState $ toggleNode i
toggleNode :: Int -> NTree LNode -> NTree LNode toggleNode :: Int -> NTree LNode -> NTree LNode
toggleNode sid (NTree (LNode {id, name, nodeType, open}) ary) = toggleNode sid (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) ary) =
NTree (LNode {id,name, nodeType, open : nopen}) $ map (toggleNode sid) ary NTree (LNode {id,name, nodeType, open : nopen, popOver, renameNodeValue}) $ map (toggleNode sid) ary
where where
nopen = if sid == id then not open else open nopen = if sid == id then not open else open
...@@ -59,7 +88,14 @@ toggleNode sid (NTree (LNode {id, name, nodeType, open}) ary) = ...@@ -59,7 +88,14 @@ toggleNode sid (NTree (LNode {id, name, nodeType, open}) ary) =
-- Realistic Tree for the UI -- Realistic Tree for the UI
exampleTree :: NTree LNode exampleTree :: NTree LNode
exampleTree = NTree (LNode {id : 1, name : "", nodeType : "", open : false}) [] exampleTree = NTree (LNode { id : 1
, name : ""
, nodeType : NodeUser
, open : false
, popOver : false
, renameNodeValue : ""
}
) []
-- exampleTree :: NTree LNode -- exampleTree :: NTree LNode
-- exampleTree = -- exampleTree =
...@@ -101,44 +137,122 @@ nodeOptionsView activated = case activated of ...@@ -101,44 +137,122 @@ nodeOptionsView activated = case activated of
false -> [] false -> []
nodeOptionsRename :: (Action -> Effect Unit) -> Boolean -> Array ReactElement
nodeOptionsRename d activated = case activated of
true -> [ a [className "glyphicon glyphicon-pencil", style {marginLeft : "15px"}
, onClick $ (\_-> d $ ShowPopOver)
] []
]
false -> []
treeview :: Spec State {} Action treeview :: Spec State {} Action
treeview = simpleSpec performAction render treeview = simpleSpec performAction render
where where
render :: Render State {} Action render :: Render State {} Action
render dispatch _ state _ = render dispatch _ state _ =
[div [className "tree"] [toHtml dispatch state]] [ div [className "tree"]
[ toHtml dispatch state
]
]
renameTreeView :: (Action -> Effect Unit) -> State -> ReactElement
renameTreeView d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue }) ary) =
div [className ""]
[ div [className "panel panel-default"]
[
div [className "panel-heading"]
[
h5 [] [text "Rename Node"]
]
,div [className "panel-body"]
[
input [ _type "text"
, placeholder "Rename Node"
, value $ getRenameNodeValue s
, className "col-md-12 form-control"
, onInput \e -> d (RenameNode (unsafeEventValue e))
]
]
, div [className "panel-footer"]
[ button [className "btn btn-danger"
, _type "button"
, onClick \_ -> d $ Submit
] [text "Rename"]
]
]
]
renameTreeViewDummy :: (Action -> Effect Unit) -> State -> ReactElement
renameTreeViewDummy d s = div [] []
popOverValue :: State -> Boolean
popOverValue (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue }) ary) = popOver
getRenameNodeValue :: State -> String
getRenameNodeValue (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue }) ary) = renameNodeValue
toHtml :: (Action -> Effect Unit) -> FTree -> ReactElement toHtml :: (Action -> Effect Unit) -> FTree -> ReactElement
toHtml d (NTree (LNode {id, name, nodeType, open}) []) = toHtml d (NTree (LNode {id, name, nodeType : Folder, open, popOver, renameNodeValue}) []) =
ul [ ]
[ li [] $
( [ a [onClick $ (\e-> d $ ToggleFolder id)] [i [fldr open] []]
, a [ href (toUrl Front Folder id )]
[ text $ " " <> name <> " " ]
] <> nodeOptionsCorp false
)
]
toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) []) =
ul [] ul []
[ [
li [] li [ style {width:"100%"}]
[ [
a [ href (toUrl Front (readNodeType nodeType) id)] a [ href (toUrl Front nodeType id)]
( [ text (name <> " ") ( [ text (name <> " ")
] <> nodeOptionsView false ]
<> nodeOptionsView false
<> (nodeOptionsRename d true)
<>[ if ((popOverValue s) == true) then (renameTreeView d s ) else (renameTreeView d s)]
) )
] ]
] ]
toHtml d (NTree (LNode {id, name, nodeType, open}) ary) = --- need to add renameTreeview value to this function
toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) ary) =
ul [ ] ul [ ]
[ li [] $ [ li [style {width : "100%"}] $
( [ a [onClick $ (\e-> d $ ToggleFolder id)] [i [fldr open] []] ( [ a [onClick $ (\e-> d $ ToggleFolder id)] [i [fldr open] []]
, a [ href (toUrl Front (readNodeType nodeType) id )] , a [ href (toUrl Front nodeType id )]
[ text $ " " <> name <> " " ] [ text $ " " <> name <> " " ]
] <> nodeOptionsCorp false <> ] <> nodeOptionsCorp false <>
if open then if open then
map (toHtml d) ary map (toHtml d) ary
else [] else []
<> nodeOptionsView false
<> (nodeOptionsRename d true)
<>[ if ((popOverValue s) == true) then (renameTreeView d s ) else (renameTreeView d s)]
) )
] ]
fldr :: Boolean -> Props fldr :: Boolean -> Props
fldr open = if open then className "fas fa-folder-open" else className "fas fa-folder" fldr open = if open then className "fas fa-folder-open" else className "fas fa-folder"
newtype LNode = LNode {id :: Int, name :: String, nodeType :: String, open :: Boolean} newtype LNode = LNode { id :: Int
, name :: String
, nodeType :: NodeType
, open :: Boolean
, popOver :: Boolean
, renameNodeValue :: String
}
derive instance newtypeLNode :: Newtype LNode _ derive instance newtypeLNode :: Newtype LNode _
...@@ -148,7 +262,13 @@ instance decodeJsonLNode :: DecodeJson LNode where ...@@ -148,7 +262,13 @@ instance decodeJsonLNode :: DecodeJson LNode where
id_ <- obj .? "id" id_ <- obj .? "id"
name <- obj .? "name" name <- obj .? "name"
nodeType <- obj .? "type" nodeType <- obj .? "type"
pure $ LNode {id : id_, name, nodeType, open : true} pure $ LNode { id : id_
, name
, nodeType
, open : true
, popOver : false
, renameNodeValue : ""
}
instance decodeJsonFTree :: DecodeJson (NTree LNode) where instance decodeJsonFTree :: DecodeJson (NTree LNode) where
decodeJson json = do decodeJson json = do
...@@ -180,13 +300,25 @@ loadDefaultNode = do ...@@ -180,13 +300,25 @@ loadDefaultNode = do
----- TREE CRUD Operations ----- TREE CRUD Operations
renameNode :: Aff (Either String (Int)) --- need to change return type herre newtype RenameValue = RenameValue
renameNode = do {
name :: String
}
instance encodeJsonRenameValue :: EncodeJson RenameValue where
encodeJson (RenameValue post)
= "name" := post.name
~> jsonEmptyObject
renameNode :: Int -> RenameValue -> Aff (Either String (Int)) --- need to change return type herre
renameNode renameNodeId reqbody = do
res <- request $ defaultRequest res <- request $ defaultRequest
{ url = toUrl Back Tree 1 { url = "http://localhost:8008/api/v1.0/node/" <> show renameNodeId <> "/rename"
, responseFormat = ResponseFormat.json , responseFormat = ResponseFormat.json
, method = Left PUT , method = Left PUT
, headers = [] , headers = []
, content = Just $ Json $ encodeJson reqbody
} }
case res.body of case res.body of
Left err -> do Left err -> do
...@@ -268,3 +400,7 @@ createNode reqbody= do ...@@ -268,3 +400,7 @@ createNode reqbody= do
fnTransform :: LNode -> FTree fnTransform :: LNode -> FTree
fnTransform n = NTree n [] fnTransform n = NTree n []
unsafeEventValue :: forall event. event -> String
unsafeEventValue e = (unsafeCoerce e).target.value
...@@ -9,9 +9,8 @@ toUrl Front Corpus 1 == "http://localhost:2015/#/corpus/1" ...@@ -9,9 +9,8 @@ toUrl Front Corpus 1 == "http://localhost:2015/#/corpus/1"
-} -}
module Gargantext.Config where module Gargantext.Config where
import Prelude ( class Eq, class Ord, class Show import Prelude
, compare, eq, show, (<>), identity) import Data.Argonaut (class DecodeJson, decodeJson)
import Data.Map (Map) import Data.Map (Map)
import Data.Map as DM import Data.Map as DM
import Data.Maybe (maybe) import Data.Maybe (maybe)
...@@ -180,3 +179,7 @@ instance ordNodeType :: Ord NodeType where ...@@ -180,3 +179,7 @@ instance ordNodeType :: Ord NodeType where
instance eqNodeType :: Eq NodeType where instance eqNodeType :: Eq NodeType where
eq n1 n2 = eq (show n1) (show n2) eq n1 n2 = eq (show n1) (show n2)
------------------------------------------------------------ ------------------------------------------------------------
instance decodeJsonNodeType :: DecodeJson NodeType where
decodeJson json = do
obj <- decodeJson json
pure $ readNodeType obj
module Gargantext.Pages.Corpus.Annuaire where module Gargantext.Pages.Annuaire where
import Prelude import Prelude
...@@ -9,34 +9,58 @@ import Data.Either (Either(..)) ...@@ -9,34 +9,58 @@ import Data.Either (Either(..))
import Data.Lens (Lens', Prism', lens, prism, (?~)) import Data.Lens (Lens', Prism', lens, prism, (?~))
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import React.DOM (div, h1, h3, hr, i, p, text) import React (ReactElement)
import React.DOM.Props (className, style) import React.DOM (div, h1, h3, hr, i, p, text, thead, tbody, input, br', b, b', tr, th, table, td, a)
import React.DOM.Props (_type, className, href, onChange, onClick, scope, selected, value, style)
import Thermite (Render, Spec import Thermite (Render, Spec
, simpleSpec, defaultPerformAction , simpleSpec, defaultPerformAction
, PerformAction, modifyState) , PerformAction, modifyState)
import Effect.Console (log) import Effect.Console (log)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Gargantext.Config (toUrl, NodeType(..), End(..)) import Gargantext.Config (toUrl, NodeType(..), End(..))
import Gargantext.Config.REST (get) import Gargantext.Config.REST (get)
import Gargantext.Pages.Annuaire.User.Users.Types.Types (User(..), HyperData(..))
import Gargantext.Pages.Corpus.User.Users.Types.Types (User(..))
import Gargantext.Utils.DecodeMaybe ((.?|)) import Gargantext.Utils.DecodeMaybe ((.?|))
import Data.Argonaut (class DecodeJson, decodeJson, (.?)) import Data.Argonaut (class DecodeJson, decodeJson, (.?))
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
type State = { info :: Maybe AnnuaireInfo type State = { info :: Maybe AnnuaireInfo
, table :: Maybe AnnuaireTable , stable :: Maybe AnnuaireTable
} }
type Offset = Int type Offset = Int
type Limit = Int type Limit = Int
type PageSize = Int
data Action = Load Int data Action = Load Int
-- | ChangePageSize PageSizes | ChangePageSize PageSize -- TODO
-- | ChangePage Int | ChangePage Int -- TODO
type AnnuaireTable' = Table IndividuView
newtype Table a
= Table
{ rows :: Array { row :: a }
, totalPages :: Int
, currentPage :: Int
, pageSize :: PageSize
, totalRecords :: Int
, title :: String
}
newtype IndividuView
= CorpusView
{ id :: Int
, name :: String
, role :: String
, company :: String
}
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
initialState :: State initialState :: State
initialState = { info : Nothing, table : Nothing } initialState = { info : Nothing, stable : Nothing }
defaultAnnuaireTable :: AnnuaireTable defaultAnnuaireTable :: AnnuaireTable
defaultAnnuaireTable = AnnuaireTable { annuaireTable : [Nothing] } defaultAnnuaireTable = AnnuaireTable { annuaireTable : [Nothing] }
...@@ -70,18 +94,50 @@ render dispatch _ state _ = [ div [className "row"] ...@@ -70,18 +94,50 @@ render dispatch _ state _ = [ div [className "row"]
] ]
, div [ className "col-md-4 content"] , div [ className "col-md-4 content"]
[ p [] [ i [className "fa fa-calendar"] [] [ p [] [ i [className "fa fa-calendar"] []
, text info.date , text ("Last update: " <> info.date)
]
]
] ]
] ]
, p [] []
, div [] [ text " Filter ", input []]
, br'
, div [className "row"]
[ div [className "col-md-1"] [b [] [text "title"]]
--, div [className "col-md-2"] [sizeDD d.pageSize dispatch]
--, div [className "col-md-3"] [textDescription d.currentPage d.pageSize d.totalRecords]
--, div [className "col-md-3"] [pagination dispatch d.totalPages d.currentPage]
] ]
, table [ className "table"]
[thead [ className "thead-dark"]
[tr [] [ th [scope "col"] [ b' [text ""] ]
, th [scope "col"] [ b' [text "Name"] ]
, th [scope "col"] [ b' [text "Role"] ]
, th [scope "col"] [ b' [text "Service"] ]
, th [scope "col"] [ b' [text "Company"] ]
]
]
, tbody [] $ map showRow individuals
] ]
, p [] [text $ foldl (<>) " "
$ map (maybe "Nothing" (\(User u) -> show u.name))
$ maybe (toRows defaultAnnuaireTable) toRows state.table]
] ]
where where
(AnnuaireInfo info) = maybe defaultAnnuaireInfo identity state.info (AnnuaireInfo info) = maybe defaultAnnuaireInfo identity state.info
(AnnuaireTable table) = maybe defaultAnnuaireTable identity state.table (AnnuaireTable stable) = maybe defaultAnnuaireTable identity state.stable
individuals = maybe (toRows defaultAnnuaireTable) toRows state.stable
showRow :: Maybe User -> ReactElement
showRow Nothing = tr [][]
showRow (Just (User { id : id, hyperdata : (HyperData user) })) =
tr []
[ td [] [ a [ href (toUrl Back NodeUser id) ] [ text $ maybe' user.nom <> " " <> maybe' user.prenom ] ]
, td [] [text $ maybe' user.fonction]
, td [] [text $ maybe' user.service]
, td [] [text $ maybe' user.groupe]
]
where
maybe' = maybe "" identity
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
newtype AnnuaireInfo = AnnuaireInfo { id :: Int newtype AnnuaireInfo = AnnuaireInfo { id :: Int
...@@ -118,16 +174,9 @@ instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where ...@@ -118,16 +174,9 @@ instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where
decodeJson json = do decodeJson json = do
rows <- decodeJson json rows <- decodeJson json
pure $ AnnuaireTable { annuaireTable : rows} pure $ AnnuaireTable { annuaireTable : rows}
------------------------------------------------------------------------ ------------------------------------------------------------------------
performAction :: PerformAction State {} Action performAction :: PerformAction State {} Action
performAction (Load aId) _ _ = do performAction (Load aId) _ _ = do
eitherTable <- lift $ getTable aId
liftEffect $ log "Feching Table"
_ <- case eitherTable of
(Right table') -> void $ modifyState $ _table ?~ table'
(Left err) -> do
liftEffect $ log err
eitherInfo <- lift $ getInfo aId eitherInfo <- lift $ getInfo aId
_ <- case eitherInfo of _ <- case eitherInfo of
...@@ -135,7 +184,14 @@ performAction (Load aId) _ _ = do ...@@ -135,7 +184,14 @@ performAction (Load aId) _ _ = do
(Left err) -> do (Left err) -> do
liftEffect $ log err liftEffect $ log err
liftEffect <<< log $ "Fetching annuaire page..." eitherTable <- lift $ getTable aId
liftEffect $ log "Feching Table"
_ <- case eitherTable of
(Right table') -> void $ modifyState $ _table ?~ table'
(Left err) -> do
liftEffect $ log err
liftEffect <<< log $ "Annuaire page fetched."
performAction _ _ _ = pure unit performAction _ _ _ = pure unit
------------------------------------------------------------------------ ------------------------------------------------------------------------
getTable :: Int -> Aff (Either String AnnuaireTable) getTable :: Int -> Aff (Either String AnnuaireTable)
...@@ -145,7 +201,7 @@ getInfo :: Int -> Aff (Either String AnnuaireInfo) ...@@ -145,7 +201,7 @@ getInfo :: Int -> Aff (Either String AnnuaireInfo)
getInfo id = get $ toUrl Back Node id getInfo id = get $ toUrl Back Node id
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
_table :: Lens' State (Maybe AnnuaireTable) _table :: Lens' State (Maybe AnnuaireTable)
_table = lens (\s -> s.table) (\s ss -> s{table = ss}) _table = lens (\s -> s.stable) (\s ss -> s{stable = ss})
_info :: Lens' State (Maybe AnnuaireInfo) _info :: Lens' State (Maybe AnnuaireInfo)
_info = lens (\s -> s.info) (\s ss -> s{info = ss}) _info = lens (\s -> s.info) (\s ss -> s{info = ss})
......
module Gargantext.Pages.Corpus.User.Brevets where module Gargantext.Pages.Annuaire.User.Brevets where
import Prelude import Prelude
import Thermite (Render, Spec, defaultPerformAction, simpleSpec) import Thermite (Render, Spec, defaultPerformAction, simpleSpec)
......
module Gargantext.Pages.Annuaire.User.Users
(module Gargantext.Pages.Annuaire.User.Users.Types,
module Gargantext.Pages.Annuaire.User.Users.Specs)
where
import Gargantext.Pages.Annuaire.User.Users.Types
import Gargantext.Pages.Annuaire.User.Users.Specs
module Gargantext.Pages.Corpus.User.Users.API where module Gargantext.Pages.Annuaire.User.Users.API where
import Prelude import Prelude
...@@ -12,7 +12,7 @@ import Effect.Console (log) ...@@ -12,7 +12,7 @@ import Effect.Console (log)
import Gargantext.Config (toUrl, NodeType(..), End(..)) import Gargantext.Config (toUrl, NodeType(..), End(..))
import Gargantext.Config.REST (get) import Gargantext.Config.REST (get)
import Gargantext.Pages.Corpus.User.Users.Types (Action(..), State, User, _user) import Gargantext.Pages.Annuaire.User.Users.Types (Action(..), State, User, _user)
import Thermite (PerformAction, modifyState) import Thermite (PerformAction, modifyState)
getUser :: Int -> Aff (Either String User) getUser :: Int -> Aff (Either String User)
......
module Gargantext.Pages.Annuaire.User.Users.Specs
(module Gargantext.Pages.Annuaire.User.Users.Specs.Renders,
layoutUser)
where
import Gargantext.Pages.Annuaire.User.Users.Specs.Renders
import Thermite (Spec, simpleSpec)
import Gargantext.Pages.Annuaire.User.Users.Types (Action, State)
import Gargantext.Pages.Annuaire.User.Users.API (performAction)
layoutUser :: Spec State {} Action
layoutUser = simpleSpec performAction render
module Gargantext.Pages.Corpus.User.Users.Specs.Documents where module Gargantext.Pages.Annuaire.User.Users.Specs.Documents where
import Prelude import Prelude
import React.DOM (table, tbody, td, text, th, thead, tr) import React.DOM (table, tbody, td, text, th, thead, tr)
......
module Gargantext.Pages.Corpus.User.Users.Specs.Renders module Gargantext.Pages.Annuaire.User.Users.Specs.Renders
where where
import Gargantext.Pages.Corpus.User.Users.Actions import Gargantext.Pages.Annuaire.User.Users.Types
import Gargantext.Pages.Corpus.User.Users.States
import Gargantext.Pages.Corpus.User.Users.Types
import Data.List (List, toUnfoldable, zip) import Data.List (List, toUnfoldable, zip)
import Data.Map (Map, empty, keys, values) import Data.Map (Map, empty, keys, values)
......
module Gargantext.Pages.Corpus.User.Users.Types module Gargantext.Pages.Annuaire.User.Users.Types
(module Gargantext.Pages.Corpus.User.Users.Types.Types, (module Gargantext.Pages.Annuaire.User.Users.Types.Types,
module Gargantext.Pages.Corpus.User.Users.Types.Lens, module Gargantext.Pages.Annuaire.User.Users.Types.Lens,
module Gargantext.Pages.Corpus.User.Users.Types.States, module Gargantext.Pages.Annuaire.User.Users.Types.States,
brevetSpec, brevetSpec,
projectSpec, projectSpec,
facets facets
...@@ -10,10 +10,10 @@ module Gargantext.Pages.Corpus.User.Users.Types ...@@ -10,10 +10,10 @@ module Gargantext.Pages.Corpus.User.Users.Types
import Prelude import Prelude
import Gargantext.Pages.Corpus.User.Users.Types.Lens import Gargantext.Pages.Annuaire.User.Users.Types.Lens
import Gargantext.Pages.Corpus.User.Users.Types.Types import Gargantext.Pages.Annuaire.User.Users.Types.Types
import Gargantext.Pages.Corpus.User.Users.Types.States import Gargantext.Pages.Annuaire.User.Users.Types.States
import Gargantext.Pages.Corpus.User.Brevets as B import Gargantext.Pages.Annuaire.User.Brevets as B
import Data.List (fromFoldable) import Data.List (fromFoldable)
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Gargantext.Components.Tab (tabs) import Gargantext.Components.Tab (tabs)
......
module Gargantext.Pages.Corpus.User.Users.Types.Lens where module Gargantext.Pages.Annuaire.User.Users.Types.Lens where
import Gargantext.Pages.Corpus.User.Brevets as B import Gargantext.Pages.Annuaire.User.Brevets as B
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Lens (Lens', Prism', lens, prism) import Data.Lens (Lens', Prism', lens, prism)
import Data.Maybe (Maybe) import Data.Maybe (Maybe)
import Gargantext.Pages.Corpus.User.Users.Types.States (Action(..), State) import Gargantext.Pages.Annuaire.User.Users.Types.States (Action(..), State)
import Gargantext.Pages.Corpus.User.Users.Types.Types (User) import Gargantext.Pages.Annuaire.User.Users.Types.Types (User)
import Gargantext.Pages.Corpus.User.Users.Specs.Documents as P import Gargantext.Pages.Annuaire.User.Users.Specs.Documents as P
import Gargantext.Components.Tab as Tab import Gargantext.Components.Tab as Tab
import Thermite (Spec, noState) import Thermite (Spec, noState)
......
module Gargantext.Pages.Corpus.User.Users.Types.States where module Gargantext.Pages.Annuaire.User.Users.Types.States where
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Gargantext.Pages.Corpus.User.Users.Types.Types (User) import Gargantext.Pages.Annuaire.User.Users.Types.Types (User)
import Gargantext.Pages.Corpus.User.Users.Specs.Documents as P import Gargantext.Pages.Annuaire.User.Users.Specs.Documents as P
import Gargantext.Components.Tab as Tab import Gargantext.Components.Tab as Tab
data Action data Action
......
module Gargantext.Pages.Corpus.User.Users.Types.Types where module Gargantext.Pages.Annuaire.User.Users.Types.Types where
import Prelude import Prelude
......
module Gargantext.Pages.Corpus where module Gargantext.Pages.Corpus where
import Data.Maybe (Maybe(..), maybe)
import Prelude hiding (div) import Prelude hiding (div)
import Data.Argonaut (class DecodeJson, decodeJson, (.?))
import Gargantext.Components.Charts.Options.ECharts (chart) import Gargantext.Components.Charts.Options.ECharts (chart)
import Gargantext.Pages.Corpus.Doc.Facets.Dashboard (globalPublis) import Gargantext.Pages.Corpus.Doc.Facets.Dashboard (globalPublis)
import Gargantext.Pages.Corpus.Doc.Facets as Tab import Gargantext.Pages.Corpus.Doc.Facets as Tab
...@@ -9,21 +10,86 @@ import React.DOM (div, h3, hr, i, p, text) ...@@ -9,21 +10,86 @@ import React.DOM (div, h3, hr, i, p, text)
import React.DOM.Props (className, style) import React.DOM.Props (className, style)
import Thermite (Render, Spec, defaultPerformAction, simpleSpec) import Thermite (Render, Spec, defaultPerformAction, simpleSpec)
type Corpus = { title :: String -------------------------------------------------------------------
type State = { info :: Maybe CorpusInfo
}
initialState :: State
initialState = { info : Nothing }
data Action = Load Int
newtype Node a = Node { id :: Int
, typename :: Int
, userId :: Int
, parentId :: Int
, name :: String
, date :: String
, hyperdata :: a
}
newtype CorpusInfo = CorpusInfo { title :: String
, desc :: String , desc :: String
, query :: String , query :: String
, date :: String , date :: String
, authors :: String , authors :: String
, chart :: (Maybe (Array Number))
}
corpusInfoDefault :: CorpusInfo
corpusInfoDefault = CorpusInfo
{ title : "Global Publications"
, desc : " Hal Database"
, query : " Query: all publications"
, date : " June. 26 2018, 10:59 am"
, authors : " Author(s): first.last name"
, chart : Nothing
}
instance decodeCorpusInfo :: DecodeJson CorpusInfo where
decodeJson json = do
obj <- decodeJson json
title <- obj .? "title"
desc <- obj .? "desc"
query <- obj .? "query"
date <- obj .? "date"
authors <- obj .? "authors"
chart <- obj .? "chart"
pure $ CorpusInfo {title, desc, query, date, authors, chart}
instance decodeNode :: (DecodeJson a) => DecodeJson (Node a) where
decodeJson json = do
obj <- decodeJson json
id <- obj .? "id"
typename <- obj .? "typename"
userId <- obj .? "userId"
parentId <- obj .? "parentId"
name <- obj .? "name"
date <- obj .? "date"
hyperdata <- obj .? "hyperdata"
hyperdata' <- decodeJson hyperdata
pure $ Node { id : id
, typename : typename
, userId : userId
, parentId : parentId
, name : name
, date : date
, hyperdata: hyperdata'
} }
spec' :: Spec {} {} Void
spec' = corpusSpec <> Tab.pureTab1
corpusSpec :: Spec {} {} Void layout :: Spec State {} Action
layout = corpusSpec -- <> Tab.pureTab1
corpusSpec :: Spec State {} Action
corpusSpec = simpleSpec defaultPerformAction render corpusSpec = simpleSpec defaultPerformAction render
where where
render :: Render {} {} Void render :: Render State {} Action
render _ _ _ _ = render dispatch _ state _ =
[ div [className "row"] [ div [className "row"]
[ div [className "col-md-3"] [ h3 [] [text corpus.title] ] [ div [className "col-md-3"] [ h3 [] [text corpus.title] ]
, div [className "col-md-9"] [ hr [style {height : "2px",backgroundColor : "black"}] ] , div [className "col-md-9"] [ hr [style {height : "2px",backgroundColor : "black"}] ]
...@@ -47,13 +113,8 @@ corpusSpec = simpleSpec defaultPerformAction render ...@@ -47,13 +113,8 @@ corpusSpec = simpleSpec defaultPerformAction render
] ]
] ]
] ]
, chart globalPublis -- , chart globalPublis TODO add chart data in state
] ]
where where
corpus :: Corpus CorpusInfo corpus = maybe corpusInfoDefault identity state.info
corpus = { title : "IMT Global Publications"
, desc : " Hal Database"
, query : " Query: all publications"
, date : " June. 26 2018, 10:59 am"
, authors : " Author(s): françois.pineau"
}
...@@ -17,7 +17,7 @@ import Effect.Aff (Aff) ...@@ -17,7 +17,7 @@ import Effect.Aff (Aff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Console (log) import Effect.Console (log)
import Gargantext.Config (NodeType(..), toUrl, End(Back)) import Gargantext.Config (NodeType(..), toUrl, End(..))
import Gargantext.Config.REST (get) import Gargantext.Config.REST (get)
import Gargantext.Utils.DecodeMaybe ((.|)) import Gargantext.Utils.DecodeMaybe ((.|))
...@@ -83,6 +83,7 @@ derive instance genericCorpus :: Generic CorpusView _ ...@@ -83,6 +83,7 @@ derive instance genericCorpus :: Generic CorpusView _
instance showCorpus :: Show CorpusView where instance showCorpus :: Show CorpusView where
show = genericShow show = genericShow
newtype Response = Response newtype Response = Response
{ cid :: Int { cid :: Int
, created :: String , created :: String
...@@ -91,6 +92,7 @@ newtype Response = Response ...@@ -91,6 +92,7 @@ newtype Response = Response
, ngramCount :: Int , ngramCount :: Int
} }
newtype Hyperdata = Hyperdata newtype Hyperdata = Hyperdata
{ title :: String { title :: String
, source :: String , source :: String
...@@ -163,10 +165,7 @@ layoutDocview = simpleSpec performAction render ...@@ -163,10 +165,7 @@ layoutDocview = simpleSpec performAction render
[thead [ className "thead-dark"] [thead [ className "thead-dark"]
[tr [] [ th [scope "col"] [ b' [text ""] ] [tr [] [ th [scope "col"] [ b' [text ""] ]
, th [scope "col"] [ b' [text "Date"]] , th [scope "col"] [ b' [text "Date"]]
, th [scope "col"] [ b' [text "Name"] ] , th [scope "col"] [ b' [text "Title"] ]
--, th [scope "col"] [ b' [text "Title"] ]
--, th [scope "col"] [ b' [text "Source"] ]
, th [scope "col"] [ b' [text "Fonction"] ]
, th [scope "col"] [ b' [text "Delete"] ] , th [scope "col"] [ b' [text "Delete"] ]
] ]
] ]
...@@ -270,7 +269,7 @@ showRow {row : (CorpusView c), delete} = ...@@ -270,7 +269,7 @@ showRow {row : (CorpusView c), delete} =
[ td [] [div [className $ fa <> "fa-star"][]] [ td [] [div [className $ fa <> "fa-star"][]]
-- TODO show date: Year-Month-Day only -- TODO show date: Year-Month-Day only
, td [] [text c.date] , td [] [text c.date]
, td [] [ a [ href (toUrl Back Document 1) ] [ text c.title ] ] , td [] [ a [ href (toUrl Front Document c._id) ] [ text c.title ] ]
, td [] [text c.source] , td [] [text c.source]
, td [] [input [ _type "checkbox"]] , td [] [input [ _type "checkbox"]]
] ]
......
module Gargantext.Pages.Corpus.User.Users
(module Gargantext.Pages.Corpus.User.Users.Types,
module Gargantext.Pages.Corpus.User.Users.Specs)
where
import Gargantext.Pages.Corpus.User.Users.Types
import Gargantext.Pages.Corpus.User.Users.Specs
module Gargantext.Pages.Corpus.User.Users.Specs
(module Gargantext.Pages.Corpus.User.Users.Specs.Renders,
layoutUser)
where
import Gargantext.Pages.Corpus.User.Users.Specs.Renders
import Thermite (Spec, simpleSpec)
import Gargantext.Pages.Corpus.User.Users.Actions
import Gargantext.Pages.Corpus.User.Users.States
import Gargantext.Pages.Corpus.User.Users.API (performAction)
layoutUser :: Spec State {} Action
layoutUser = simpleSpec performAction render
publicationSpec :: forall eff props. Spec (dom :: DOM, console :: CONSOLE, ajax :: AJAX | eff) State props Action
publicationSpec = focus _publens _pubAction P.publicationSpec
brevetSpec :: forall eff props. Spec (dom :: DOM, console::CONSOLE, ajax :: AJAX | eff) State props Action
brevetSpec = focus _brevetslens _brevetsAction B.brevetsSpec
projectSpec :: forall eff props. Spec (dom :: DOM, console :: CONSOLE, ajax :: AJAX | eff) State props Action
projectSpec = focus _projectslens _projectsAction PS.projets
facets :: forall eff props. Spec ( dom :: DOM, console :: CONSOLE, ajax :: AJAX| eff) State props Action
facets = tabs _tablens _tabAction $ fromFoldable
[ Tuple "Publications (12)" publicationSpec
, Tuple "Brevets (2)" brevetSpec
, Tuple "Projets IMT (5)" projectSpec
]
...@@ -7,12 +7,13 @@ import Gargantext.Pages.Layout.Specs.AddCorpus as AC ...@@ -7,12 +7,13 @@ import Gargantext.Pages.Layout.Specs.AddCorpus as AC
-- import Gargantext.Pages.Corpus.Doc.Facets as TV -- import Gargantext.Pages.Corpus.Doc.Facets as TV
-- import Gargantext.Pages.Corpus.Doc.Annotation as D -- import Gargantext.Pages.Corpus.Doc.Annotation as D
import Gargantext.Pages.Corpus as Corpus
import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV
import Gargantext.Pages.Corpus.Doc.Facets.Graph as GE import Gargantext.Pages.Corpus.Doc.Facets.Graph as GE
-- import Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsTable as NG -- import Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsTable as NG
import Gargantext.Pages.Corpus.User.Users as U import Gargantext.Pages.Annuaire.User.Users as U
import Gargantext.Pages.Corpus.Annuaire as Annuaire import Gargantext.Pages.Annuaire as Annuaire
-- import Gargantext.Pages.Home as L -- import Gargantext.Pages.Home as L
-- import Gargantext.Pages.Layout.Specs.Search as S -- import Gargantext.Pages.Layout.Specs.Search as S
import Gargantext.Router (Routes(..)) import Gargantext.Router (Routes(..))
...@@ -39,6 +40,10 @@ dispatchAction dispatcher _ (DocView n) = do ...@@ -39,6 +40,10 @@ dispatchAction dispatcher _ (DocView n) = do
dispatcher $ SetRoute (DocView n) dispatcher $ SetRoute (DocView n)
dispatcher $ DocViewA $ DV.LoadData n dispatcher $ DocViewA $ DV.LoadData n
dispatchAction dispatcher _ (Corpus n) = do
dispatcher $ SetRoute $ Corpus n
dispatcher $ CorpusAction $ Corpus.Load n
dispatchAction dispatcher _ SearchView = do dispatchAction dispatcher _ SearchView = do
dispatcher $ SetRoute SearchView dispatcher $ SetRoute SearchView
-- dispatcher $ SearchA TODO -- dispatcher $ SearchA TODO
...@@ -63,10 +68,6 @@ dispatchAction dispatcher _ Tabview = do ...@@ -63,10 +68,6 @@ dispatchAction dispatcher _ Tabview = do
dispatcher $ SetRoute Tabview dispatcher $ SetRoute Tabview
-- dispatcher $ TabViewA TODO -- dispatcher $ TabViewA TODO
dispatchAction dispatcher _ CorpusAnalysis = do
dispatcher $ SetRoute CorpusAnalysis
-- dispatcher $ CorpusAnalysisA TODO
dispatchAction dispatcher _ PGraphExplorer = do dispatchAction dispatcher _ PGraphExplorer = do
dispatcher $ SetRoute PGraphExplorer dispatcher $ SetRoute PGraphExplorer
dispatcher $ GraphExplorerA $ GE.LoadGraph "imtNew.json" dispatcher $ GraphExplorerA $ GE.LoadGraph "imtNew.json"
......
...@@ -12,11 +12,13 @@ import Effect.Console (log) ...@@ -12,11 +12,13 @@ import Effect.Console (log)
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.Components.Tree as Tree import Gargantext.Components.Tree as Tree
import Gargantext.Pages.Corpus as Corpus
import Gargantext.Pages.Corpus.Doc.Annotation as D import Gargantext.Pages.Corpus.Doc.Annotation as D
import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV
import Gargantext.Pages.Corpus.Doc.Facets.Graph as GE import Gargantext.Pages.Corpus.Doc.Facets.Graph as GE
import Gargantext.Pages.Corpus.User.Users as U import Gargantext.Pages.Annuaire.User.Users as U
import Gargantext.Pages.Corpus.Annuaire as Annuaire import Gargantext.Pages.Annuaire as Annuaire
import Gargantext.Pages.Layout.Specs.AddCorpus as AC import Gargantext.Pages.Layout.Specs.AddCorpus as AC
import Gargantext.Pages.Layout.Specs.Search as S import Gargantext.Pages.Layout.Specs.Search as S
import Gargantext.Pages.Layout.States (AppState) import Gargantext.Pages.Layout.States (AppState)
...@@ -32,12 +34,13 @@ data Action ...@@ -32,12 +34,13 @@ data Action
| AddCorpusA AC.Action | AddCorpusA AC.Action
| DocViewA DV.Action | DocViewA DV.Action
| SearchA S.Action | SearchA S.Action
| UserPageA U.Action | Search String
| DocAnnotationViewA D.Action
| TreeViewA Tree.Action | TreeViewA Tree.Action
| CorpusAction Corpus.Action
| GraphExplorerA GE.Action | GraphExplorerA GE.Action
| Search String | DocAnnotationViewA D.Action
| AnnuaireAction Annuaire.Action | AnnuaireAction Annuaire.Action
| UserPageA U.Action
| Go | Go
| ShowLogin | ShowLogin
| ShowAddcorpus | ShowAddcorpus
...@@ -53,6 +56,8 @@ performAction (ShowLogin) _ _ = void do ...@@ -53,6 +56,8 @@ performAction (ShowLogin) _ _ = void do
liftEffect $ modalShow "loginModal" liftEffect $ modalShow "loginModal"
modifyState $ _ {showLogin = true} modifyState $ _ {showLogin = true}
---------------------------------------------------------
-- TODO chose one of them
performAction (ShowAddcorpus) _ _ = void do performAction (ShowAddcorpus) _ _ = void do
liftEffect $ modalShow "addCorpus" liftEffect $ modalShow "addCorpus"
modifyState $ _ {showCorpus = true} modifyState $ _ {showCorpus = true}
...@@ -62,6 +67,7 @@ performAction Go _ _ = void do ...@@ -62,6 +67,7 @@ performAction Go _ _ = void do
modifyState $ _ {showCorpus = true} modifyState $ _ {showCorpus = true}
-- _ <- lift $ setHash "/addCorpus" -- _ <- lift $ setHash "/addCorpus"
--modifyState id --modifyState id
---------------------------------------------------------
performAction Initialize _ state = void do performAction Initialize _ state = void do
_ <- liftEffect $ log "loading Initial nodes" _ <- liftEffect $ log "loading Initial nodes"
...@@ -93,6 +99,7 @@ performAction Initialize _ state = void do ...@@ -93,6 +99,7 @@ performAction Initialize _ state = void do
performAction (LoginA _) _ _ = pure unit performAction (LoginA _) _ _ = pure unit
performAction (AddCorpusA _) _ _ = pure unit performAction (AddCorpusA _) _ _ = pure unit
performAction (CorpusAction _) _ _ = pure unit
performAction (DocViewA _) _ _ = pure unit performAction (DocViewA _) _ _ = pure unit
performAction (SearchA _) _ _ = pure unit performAction (SearchA _) _ _ = pure unit
performAction (UserPageA _) _ _ = pure unit performAction (UserPageA _) _ _ = pure unit
...@@ -115,6 +122,12 @@ _addCorpusAction = prism AddCorpusA \action -> ...@@ -115,6 +122,12 @@ _addCorpusAction = prism AddCorpusA \action ->
AddCorpusA caction -> Right caction AddCorpusA caction -> Right caction
_-> Left action _-> Left action
_corpusAction :: Prism' Action Corpus.Action
_corpusAction = prism CorpusAction \action ->
case action of
CorpusAction caction -> Right caction
_-> Left action
_docViewAction :: Prism' Action DV.Action _docViewAction :: Prism' Action DV.Action
_docViewAction = prism DocViewA \action -> _docViewAction = prism DocViewA \action ->
case action of case action of
......
...@@ -9,21 +9,21 @@ import Effect (Effect) ...@@ -9,21 +9,21 @@ import Effect (Effect)
import Gargantext.Components.Data.Lang (Lang(..)) import Gargantext.Components.Data.Lang (Lang(..))
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.Pages.Corpus.Annuaire as A import Gargantext.Pages.Annuaire as A
import Gargantext.Folder as F import Gargantext.Folder as F
import Gargantext.Pages.Corpus as CA import Gargantext.Pages.Corpus as Corpus
import Gargantext.Pages.Corpus.Doc.Annotation as D import Gargantext.Pages.Corpus.Doc.Annotation as Annotation
import Gargantext.Pages.Corpus.Doc.Facets as TV import Gargantext.Pages.Corpus.Doc.Facets as TV
import Gargantext.Pages.Corpus.Doc.Facets.Dashboard as Dsh import Gargantext.Pages.Corpus.Doc.Facets.Dashboard as Dsh
import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV
import Gargantext.Pages.Corpus.Doc.Facets.Graph as GE import Gargantext.Pages.Corpus.Doc.Facets.Graph as GE
import Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsTable as NG import Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsTable as NG
import Gargantext.Pages.Corpus.User.Users as U import Gargantext.Pages.Annuaire.User.Users as U
import Gargantext.Pages.Home as L import Gargantext.Pages.Home as L
import Gargantext.Pages.Layout.Actions (Action(..), _addCorpusAction, _docAnnotationViewAction, _docViewAction, _graphExplorerAction, _loginAction, _searchAction, _treeAction, _userPageAction, performAction, _annuaireAction) import Gargantext.Pages.Layout.Actions (Action(..), _corpusAction, _addCorpusAction, _docAnnotationViewAction, _docViewAction, _graphExplorerAction, _loginAction, _searchAction, _treeAction, _userPageAction, performAction, _annuaireAction)
import Gargantext.Pages.Layout.Specs.AddCorpus as AC import Gargantext.Pages.Layout.Specs.AddCorpus as AC
import Gargantext.Pages.Layout.Specs.Search as S import Gargantext.Pages.Layout.Specs.Search as S
import Gargantext.Pages.Layout.States (AppState, _addCorpusState, _docAnnotationViewState, _docViewState, _graphExplorerState, _loginState, _searchState, _treeState, _userPageState, _annuaireState) import Gargantext.Pages.Layout.States (AppState, _corpusState, _addCorpusState, _docAnnotationViewState, _docViewState, _graphExplorerState, _loginState, _searchState, _treeState, _userPageState, _annuaireState)
import Gargantext.Router (Routes(..)) import Gargantext.Router (Routes(..))
import React (ReactElement) import React (ReactElement)
import React.DOM (a, button, div, footer, hr', img, input, li, p, span, text, ul) import React.DOM (a, button, div, footer, hr', img, input, li, p, span, text, ul)
...@@ -54,15 +54,16 @@ pagesComponent s = ...@@ -54,15 +54,16 @@ pagesComponent s =
Nothing -> selectSpec Home Nothing -> selectSpec Home
where where
selectSpec :: Routes -> Spec AppState {} Action selectSpec :: Routes -> Spec AppState {} Action
selectSpec CorpusAnalysis = layout0 $ noState CA.spec' selectSpec (Corpus i) = layout0 $ focus _corpusState _corpusAction Corpus.layout
selectSpec Login = focus _loginState _loginAction LN.renderSpec selectSpec Login = focus _loginState _loginAction LN.renderSpec
selectSpec Home = layout0 $ noState (L.layoutLanding EN) selectSpec Home = layout0 $ noState (L.layoutLanding EN)
selectSpec AddCorpus = layout0 $ focus _addCorpusState _addCorpusAction AC.layoutAddcorpus selectSpec AddCorpus = layout0 $ focus _addCorpusState _addCorpusAction AC.layoutAddcorpus
selectSpec (DocView i) = layout0 $ focus _docViewState _docViewAction DV.layoutDocview selectSpec (DocView i) = layout0 $ focus _docViewState _docViewAction DV.layoutDocview
selectSpec (UserPage i) = layout0 $ focus _userPageState _userPageAction U.layoutUser selectSpec (UserPage i) = layout0 $ focus _userPageState _userPageAction U.layoutUser
selectSpec (DocAnnotation i) = layout0 $ focus _docAnnotationViewState _docAnnotationViewAction D.docview selectSpec (DocAnnotation i) = layout0 $ focus _docAnnotationViewState
selectSpec Tabview = layout0 $ noState TV.pureTab1 _docAnnotationViewAction Annotation.docview
-- To be removed -- To be removed
selectSpec Tabview = layout0 $ noState TV.pureTab1
selectSpec SearchView = layout0 $ focus _searchState _searchAction S.searchSpec selectSpec SearchView = layout0 $ focus _searchState _searchAction S.searchSpec
selectSpec NGramsTable = layout0 $ noState NG.ngramsTableSpec selectSpec NGramsTable = layout0 $ noState NG.ngramsTableSpec
selectSpec PGraphExplorer = focus _graphExplorerState _graphExplorerAction GE.specOld selectSpec PGraphExplorer = focus _graphExplorerState _graphExplorerAction GE.specOld
......
...@@ -6,11 +6,13 @@ import Data.Lens (Lens', lens) ...@@ -6,11 +6,13 @@ import Data.Lens (Lens', lens)
import Data.Maybe (Maybe(Just)) import Data.Maybe (Maybe(Just))
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.Pages.Corpus as Corpus
import Gargantext.Pages.Corpus.Doc.Annotation as D import Gargantext.Pages.Corpus.Doc.Annotation as D
import Gargantext.Pages.Corpus.Annuaire as Annuaire import Gargantext.Pages.Annuaire as Annuaire
import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV
import Gargantext.Pages.Corpus.Doc.Facets.Graph as GE import Gargantext.Pages.Corpus.Doc.Facets.Graph as GE
import Gargantext.Pages.Corpus.User.Users as U import Gargantext.Pages.Annuaire.User.Users as U
import Gargantext.Pages.Layout.Specs.AddCorpus as AC import Gargantext.Pages.Layout.Specs.AddCorpus as AC
import Gargantext.Pages.Layout.Specs.Search as S import Gargantext.Pages.Layout.Specs.Search as S
import Gargantext.Router (Routes(..)) import Gargantext.Router (Routes(..))
...@@ -18,6 +20,7 @@ import Gargantext.Router (Routes(..)) ...@@ -18,6 +20,7 @@ import Gargantext.Router (Routes(..))
type AppState = type AppState =
{ currentRoute :: Maybe Routes { currentRoute :: Maybe Routes
, loginState :: LN.State , loginState :: LN.State
, corpus :: Corpus.State
, addCorpusState :: AC.State , addCorpusState :: AC.State
, docViewState :: DV.State , docViewState :: DV.State
, searchState :: S.State , searchState :: S.State
...@@ -35,6 +38,7 @@ type AppState = ...@@ -35,6 +38,7 @@ type AppState =
initAppState :: AppState initAppState :: AppState
initAppState = initAppState =
{ currentRoute : Just Home { currentRoute : Just Home
, corpus : Corpus.initialState
, loginState : LN.initialState , loginState : LN.initialState
, addCorpusState : AC.initialState , addCorpusState : AC.initialState
, docViewState : DV.tdata , docViewState : DV.tdata
...@@ -57,6 +61,9 @@ _loginState = lens (\s -> s.loginState) (\s ss -> s{loginState = ss}) ...@@ -57,6 +61,9 @@ _loginState = lens (\s -> s.loginState) (\s ss -> s{loginState = ss})
_addCorpusState :: Lens' AppState AC.State _addCorpusState :: Lens' AppState AC.State
_addCorpusState = lens (\s -> s.addCorpusState) (\s ss -> s{addCorpusState = ss}) _addCorpusState = lens (\s -> s.addCorpusState) (\s ss -> s{addCorpusState = ss})
_corpusState :: Lens' AppState Corpus.State
_corpusState = lens (\s -> s.corpus) (\s ss -> s{corpus = ss})
_docViewState :: Lens' AppState DV.State _docViewState :: Lens' AppState DV.State
_docViewState = lens (\s -> s.docViewState) (\s ss -> s{docViewState = ss}) _docViewState = lens (\s -> s.docViewState) (\s ss -> s{docViewState = ss})
......
...@@ -16,66 +16,71 @@ import Web.Storage.Storage (getItem) ...@@ -16,66 +16,71 @@ import Web.Storage.Storage (getItem)
data Routes data Routes
= Home = Home
| Login | Login
| SearchView
| Folder Int
| Corpus Int
| AddCorpus | AddCorpus
| Tabview
| DocView Int | DocView Int
| SearchView
| UserPage Int
| DocAnnotation Int | DocAnnotation Int
| Tabview
| CorpusAnalysis
| PGraphExplorer | PGraphExplorer
| NGramsTable | NGramsTable
| Dashboard | Dashboard
| Annuaire Int | Annuaire Int
| Folder Int | UserPage Int
instance showRoutes :: Show Routes where
show Login = "Login"
show AddCorpus = "AddCorpus"
show (DocView i) = "DocView"
show SearchView = "Search"
show (UserPage i) = "User"
show (DocAnnotation i)= "Document"
show Tabview = "Tabview"
show CorpusAnalysis = "Corpus"
show PGraphExplorer = "graphExplorer"
show NGramsTable = "NGramsTable"
show Dashboard = "Dashboard"
show (Annuaire i) = "Annuaire"
show (Folder i) = "Folder"
show Home = "Home"
int :: Match Int
int = floor <$> num
routing :: Match Routes routing :: Match Routes
routing = routing =
Login <$ route "login" Login <$ route "login"
<|> Tabview <$ route "tabview"
<|> DocAnnotation <$> (route "document" *> int)
<|> UserPage <$> (route "user" *> int)
<|> SearchView <$ route "search" <|> SearchView <$ route "search"
<|> DocView <$> (route "docView" *> int)
<|> AddCorpus <$ route "addCorpus" <|> AddCorpus <$ route "addCorpus"
<|> CorpusAnalysis <$ route "corpus" <|> Folder <$> (route "folder" *> int)
<|> PGraphExplorer <$ route "graph" <|> Corpus <$> (route "corpus" *> int)
<|> Tabview <$ route "tabview"
<|> DocView <$> (route "docView" *> int)
<|> NGramsTable <$ route "ngrams" <|> NGramsTable <$ route "ngrams"
<|> DocAnnotation <$> (route "document" *> int)
<|> Dashboard <$ route "dashboard" <|> Dashboard <$ route "dashboard"
<|> PGraphExplorer <$ route "graph"
<|> Annuaire <$> (route "annuaire" *> int) <|> Annuaire <$> (route "annuaire" *> int)
<|> Folder <$> (route "folder" *> int) <|> UserPage <$> (route "user" *> int)
<|> Home <$ lit "" <|> Home <$ lit ""
where where
route str = lit "" *> lit str route str = lit "" *> lit str
routeHandler :: (Maybe Routes -> Routes -> Effect Unit) -> Maybe Routes -> Routes -> Effect Unit int :: Match Int
int = floor <$> num
instance showRoutes :: Show Routes where
show Login = "Login"
show AddCorpus = "AddCorpus"
show SearchView = "Search"
show (UserPage i) = "User" <> show i
show (DocAnnotation i)= "Document"
show (Corpus i) = "Corpus" <> show i
show Tabview = "Tabview"
show (DocView i) = "DocView"
show NGramsTable = "NGramsTable"
show (Annuaire i) = "Annuaire" <> show i
show (Folder i) = "Folder" <> show i
show Dashboard = "Dashboard"
show PGraphExplorer = "graphExplorer"
show Home = "Home"
routeHandler :: (Maybe Routes -> Routes -> Effect Unit)
-> Maybe Routes -> Routes -> Effect Unit
routeHandler dispatchAction old new = do routeHandler dispatchAction old new = do
liftEffect $ log $ "change route : " <> show new liftEffect $ log $ "change route : " <> show new
w <- window w <- window
ls <- localStorage w ls <- localStorage w
token <- getItem "accessToken" ls token <- getItem "accessToken" ls
let tkn = token let tkn = token
liftEffect $ log $ "JWToken : " <> show tkn liftEffect $ log $ "JWToken : " <> show tkn
case tkn of case tkn of
Nothing -> do Nothing -> do
dispatchAction old new dispatchAction old new
......
...@@ -9,7 +9,8 @@ import Foreign.Object (Object) ...@@ -9,7 +9,8 @@ import Foreign.Object (Object)
foreign import isNull :: forall a. a -> Boolean foreign import isNull :: forall a. a -> Boolean
getFieldOptional' :: forall a. DecodeJson a => Object Json -> String -> Either String (Maybe a) getFieldOptional' :: forall a. DecodeJson a =>
Object Json -> String -> Either String (Maybe a)
getFieldOptional' o s = (case _ of getFieldOptional' o s = (case _ of
Just v -> if isNull v then Nothing else v Just v -> if isNull v then Nothing else v
Nothing -> Nothing Nothing -> Nothing
...@@ -17,7 +18,9 @@ getFieldOptional' o s = (case _ of ...@@ -17,7 +18,9 @@ getFieldOptional' o s = (case _ of
infix 7 getFieldOptional' as .?| infix 7 getFieldOptional' as .?|
getFieldOptionalAsMempty :: forall a. DecodeJson a => Monoid a => Object Json -> String -> Either String a getFieldOptionalAsMempty :: forall a. DecodeJson a =>
getFieldOptionalAsMempty o s = fromMaybe mempty <$> (getFieldOptional' o s) Monoid a => Object Json -> String -> Either String a
getFieldOptionalAsMempty o s =
fromMaybe mempty <$> (getFieldOptional' o s)
infix 7 getFieldOptionalAsMempty as .| infix 7 getFieldOptionalAsMempty as .|
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