Skip to content

P
purescript-gargantext
Commit e7ca1d1f authored by Mael NICOLAS's avatar Mael NICOLAS
Browse files
Options

Revert "Merge remote-tracking branch 'origin/user-form' into annuaire" 

This reverts commit 390aa390, reversing
changes made to 32c5689d.
parent 390aa390
Expand all Show whitespace changes
Inline Side-by-side
Showing with 1628 additions and 2063 deletions
bower.json
View file @ e7ca1d1f
...@@ -8,7 +8,7 @@ ...@@ -8,7 +8,7 @@
], ],
"dependencies": { "dependencies": {
"purescript-console": "^4.1.0", "purescript-console": "^4.1.0",
"purescript-thermite": "https://github.com/np/purescript-thermite.git#d7395aec9ff4e7b8f820e882b4b07ed15c4f804d", "purescript-thermite": "https://github.com/np/purescript-thermite.git#hide",
"purescript-affjax": "^7.0.0", "purescript-affjax": "^7.0.0",
"purescript-routing": "^8.0.0", "purescript-routing": "^8.0.0",
"purescript-argonaut": "^4.0.1", "purescript-argonaut": "^4.0.1",
......
rebuild deleted 100755 → 0
View file @ 390aa390
#!/bin/bash
rm -rf output bower_components node_modules
bower install && yarn install && pulp build && pulp browserify --to dist/bundle.js
src/Gargantext/Components/Loader.purs deleted 100644 → 0
View file @ 390aa390
module Gargantext.Components.Loader where
import Data.Maybe (Maybe(..))
import Data.Either (Either(..))
import Data.Traversable (traverse_)
import React as React
import React (ReactClass)
import Gargantext.Prelude
import Effect.Aff (Aff, launchAff, launchAff_, makeAff, nonCanceler, killFiber)
import Effect.Exception (error)
type InnerProps a b =
{ path :: a
, loaded :: Maybe b
, children :: React.Children
}
type Props a b = { path :: a
, component :: ReactClass (InnerProps a b)
}
createLoaderClass :: forall a b
. String
-> (a -> Aff b)
-> ReactClass (Props a b)
createLoaderClass name loader = React.component name mk
where
mk this =
pure
{ state: { loaded: Nothing, fiber: Nothing }
, componentDidMount: do
logs "componentDidMount"
{path} <- React.getProps this
fiber <- launchAff $ do
newState <- loader path
makeAff $ \cb -> do
void $ React.modifyStateWithCallback
this
(_ {loaded = Just newState})
(cb (Right unit))
pure nonCanceler
React.modifyState this (_ { fiber = Just fiber })
, componentWillUnmount: do
{fiber} <- React.getState this
traverse_ (launchAff_ <<< killFiber (error "Loader: killFiber"))
fiber
, render: do
{path, component} <- React.getProps this
{loaded} <- React.getState this
pure $ React.createElement component {path, loaded} []
}
src/Gargantext/Components/Login.purs
View file @ e7ca1d1f
module Gargantext.Components.Login where module Gargantext.Components.Login where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.?), (:=), (~>)) import Prelude hiding (div)
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..))
import Affjax.RequestHeader (RequestHeader(..))
import Affjax.ResponseFormat as ResponseFormat
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, stringify, (.?), (:=), (~>))
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Lens (over) import Data.Lens (over)
import Data.Maybe (Maybe) import Data.Maybe (Maybe(..))
import Effect.Class (liftEffect) import Data.MediaType.Common (applicationJSON)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Gargantext.Components.Modals.Modal (modalHide)
import React.DOM (a, button, div, h2, h4, h5, i, input, label, p, span, text) import React.DOM (a, button, div, h2, h4, h5, i, input, label, p, span, text)
import React.DOM.Props (_data, _id, _type, aria, className, href, maxLength, name, onClick, onInput, placeholder, role, target, value) import React.DOM.Props (_data, _id, _type, aria, className, href, maxLength, name, onClick, onInput, placeholder, role, target, value)
import Thermite (PerformAction, Render, Spec, _render, modifyState, simpleSpec) import Thermite (PerformAction, Render, Spec, _render, modifyState, simpleSpec)
...@@ -14,13 +25,7 @@ import Web.HTML (window) ...@@ -14,13 +25,7 @@ import Web.HTML (window)
import Web.HTML.Window (localStorage) import Web.HTML.Window (localStorage)
import Web.Storage.Storage (getItem, setItem) import Web.Storage.Storage (getItem, setItem)
------------------------------------------------------------------------ -- TODO: ask for login (modal) or account creation after 15 mn when user is not logged and has made one search at least
import Gargantext.Prelude
import Gargantext.Config.REST (post)
import Gargantext.Components.Modals.Modal (modalHide)
-- TODO: ask for login (modal) or account creation after 15 mn when user
-- is not logged and has made one search at least
newtype State = State newtype State = State
{ username :: String { username :: String
...@@ -46,6 +51,31 @@ data Action ...@@ -46,6 +51,31 @@ data Action
| SetPassword String | SetPassword String
performAction :: PerformAction State {} Action
performAction (SetUserName usr) _ _ = void do
modifyState \(State state) -> State $ state { username = usr }
performAction (SetPassword pwd) _ _ = void do
modifyState \(State state) -> State $ state { password = pwd }
performAction Login _ _ = void do
--lift $ setHash "/search"
liftEffect $ modalHide "loginModal"
modifyState \(State state) -> State $ state {loginC = true}
-- res <- lift $ loginReq $ LoginReq { username : state.username, password : state.password }
-- case res of
-- Left e -> do
-- lift $ log $ show e
-- modifyState \(State s) -> State $ s { errorMessage = e}
-- Right r@(LoginRes response) -> do
-- lift $ setHash "/addCorpus"
-- modifyState \(State s) -> State $ s {response = r, errorMessage = ""}
modalSpec :: forall props. Boolean -> String -> Spec State props Action -> Spec State props Action modalSpec :: forall props. Boolean -> String -> Spec State props Action -> Spec State props Action
modalSpec sm t = over _render \render d p s c -> modalSpec sm t = over _render \render d p s c ->
[ div [ _id "loginModal", className $ "modal myModal" <> if sm then "" else " fade" [ div [ _id "loginModal", className $ "modal myModal" <> if sm then "" else " fade"
...@@ -80,27 +110,6 @@ spec' = modalSpec true "Login" renderSpec ...@@ -80,27 +110,6 @@ spec' = modalSpec true "Login" renderSpec
renderSpec :: Spec State {} Action renderSpec :: Spec State {} Action
renderSpec = simpleSpec performAction render renderSpec = simpleSpec performAction render
where where
performAction :: PerformAction State {} Action
performAction (SetUserName usr) _ _ = void do
modifyState \(State state) -> State $ state { username = usr }
performAction (SetPassword pwd) _ _ = void do
modifyState \(State state) -> State $ state { password = pwd }
performAction Login _ _ = void do
--lift $ setHash "/search"
liftEffect $ modalHide "loginModal"
modifyState \(State state) -> State $ state {loginC = true}
-- res <- lift $ loginReq $ LoginReq { username : state.username, password : state.password }
-- case res of
-- Left e -> do
-- logs e
-- modifyState \(State s) -> State $ s { errorMessage = e}
-- Right r@(LoginRes response) -> do
-- lift $ setHash "/addCorpus"
-- modifyState \(State s) -> State $ s {response = r, errorMessage = ""}
render :: Render State {} Action render :: Render State {} Action
render dispatch _ (State state) _ = render dispatch _ (State state) _ =
[ [
...@@ -224,8 +233,37 @@ newtype LoginReq = LoginReq ...@@ -224,8 +233,37 @@ newtype LoginReq = LoginReq
, password :: String , password :: String
} }
loginReq :: LoginReq -> Aff LoginRes loginReq :: LoginReq -> Aff (Either String LoginRes)
loginReq = post "https://dev.gargantext.org/api/auth/token" loginReq encodeData =
let
setting =
defaultRequest
{ url = "https://dev.gargantext.org/api/auth/token"
, method = Left POST
, responseFormat = ResponseFormat.json
, headers =
[ ContentType applicationJSON
, Accept applicationJSON
]
, content = Just $ Json $ encodeJson encodeData
}
in
do
affResp <- request setting
case affResp.body of
Left err -> do
liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
liftEffect $ log $ "POST method Completed"
liftEffect $ log $ "GET /api response: " <> stringify json
let obj = decodeJson json
case obj of
Left e ->
liftEffect $ log $ "Error Decoding : " <> show e
Right (LoginRes res1) ->
liftEffect $ setToken res1.token
pure obj
instance decodeLoginRes :: DecodeJson LoginRes where instance decodeLoginRes :: DecodeJson LoginRes where
decodeJson json = do decodeJson json = do
......
src/Gargantext/Components/Node.purs deleted 100644 → 0
View file @ 390aa390
module Gargantext.Components.Node
where
import Gargantext.Prelude
import Data.Argonaut (class DecodeJson, decodeJson, (.?))
newtype NodePoly a =
NodePoly { id :: Int
, typename :: Int
, userId :: Int
, parentId :: Int
, name :: String
, date :: String
, hyperdata :: a
}
instance decodeNodePoly :: (DecodeJson a)
=> DecodeJson (NodePoly 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 $ NodePoly { id : id
, typename : typename
, userId : userId
, parentId : parentId
, name : name
, date : date
, hyperdata: hyperdata'
}
src/Gargantext/Components/Tab.purs
View file @ e7ca1d1f
...@@ -27,10 +27,6 @@ tabs l p ls = withState \st -> ...@@ -27,10 +27,6 @@ tabs l p ls = withState \st ->
, wrapper $ fold $ mapWithIndex ( tab (activeTab st)) ls , wrapper $ fold $ mapWithIndex ( tab (activeTab st)) ls
] ]
where where
performAction :: forall props.
PerformAction State props Action
performAction (ChangeTab i) _ _ =
void $ modifyState $ const i
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]
...@@ -48,6 +44,11 @@ tab sid iid (Tuple name spec) = over _render tabRender spec ...@@ -48,6 +44,11 @@ tab sid iid (Tuple name spec) = over _render tabRender spec
] ]
performAction :: forall props.
PerformAction State props Action
performAction (ChangeTab i) _ _ =
void $ modifyState $ const i
render :: forall state props action. render :: forall state props action.
State -> List (Tuple String (Spec state props action)) State -> List (Tuple String (Spec state props action))
-> Render State props Action -> Render State props Action
......
src/Gargantext/Components/Table.purs deleted 100644 → 0
View file @ 390aa390
module Gargantext.Components.Table where
import Control.Monad.Cont.Trans (lift)
import Data.Array (filter)
import Data.Maybe (Maybe(..), maybe)
import Data.Either (Either(..))
import Effect (Effect)
import Effect.Aff (Aff)
import React as React
import React (ReactElement, ReactClass, Children, createElement)
import React.DOM (a, b, b', div, option, select, span, table, tbody, td, text, th, thead, tr)
import React.DOM.Props (className, href, onChange, onClick, scope, selected, value)
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec,
createReactSpec, StateCoTransformer)
import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Prelude
type Rows = Array { row :: Array ReactElement
, delete :: Boolean
}
type LoadRows = { offset :: Int, limit :: Int } -> Aff Rows
type Props' =
( title :: String
, colNames :: Array String
, totalRecords :: Int
, loadRows :: LoadRows
)
type Props = Record Props'
type State =
{ rows :: Maybe Rows
, currentPage :: Int
, pageSize :: PageSizes
--, tree :: FTree
}
initialState :: State
initialState =
{ rows : Nothing
, currentPage : 1
, pageSize : PS10
--, tree : exampleTree
}
data Action
= ChangePageSize PageSizes
| ChangePage Int
type ChangePageAction = Int -> Effect Unit
-- | Action
-- ChangePageSize
changePageSize :: PageSizes -> State -> State
changePageSize ps td =
td { pageSize = ps
, currentPage = 1
}
tableSpec :: Spec State Props Action
tableSpec = simpleSpec performAction render
where
modifyStateAndReload :: (State -> State) -> Props -> State -> StateCoTransformer State Unit
modifyStateAndReload f {loadRows} state = do
void $ modifyState f
loadAndSetRows {loadRows} $ f state
performAction :: PerformAction State Props Action
performAction (ChangePageSize ps) =
modifyStateAndReload $ changePageSize ps
performAction (ChangePage p) =
modifyStateAndReload $ _ { currentPage = p }
render :: Render State Props Action
render dispatch {title, colNames, totalRecords}
{pageSize, currentPage, rows} _ =
let
ps = pageSizes2Int pageSize
totalPages = (totalRecords / ps) + min 1 (totalRecords `mod` ps)
in
[ div [className "row"]
[ div [className "col-md-1"] [b [] [text title]]
, div [className "col-md-2"] [sizeDD pageSize dispatch]
, div [className "col-md-3"] [textDescription currentPage pageSize totalRecords]
, div [className "col-md-3"] [pagination (dispatch <<< ChangePage) totalPages currentPage]
]
, table [ className "table"]
[ thead [className "thead-dark"]
[tr [] ((\colName -> th [scope "col"] [ b' [text colName]]) <$> colNames)]
, tbody [] $ map (tr [] <<< map (\c -> td [] [c]) <<< _.row)
(maybe [] identity rows)
-- TODO display a loading spinner when rows == Nothing
-- instead of an empty list of results.
]
]
loadAndSetRows :: {loadRows :: LoadRows} -> State -> StateCoTransformer State Unit
loadAndSetRows {loadRows} {pageSize, currentPage} = do
let limit = pageSizes2Int pageSize
offset = limit * (currentPage - 1)
rows <- lift $ loadRows {offset, limit}
void $ modifyState (_ { rows = Just rows })
tableClass :: ReactClass {children :: Children | Props'}
tableClass =
React.component "Table"
(\this -> do
{state, render} <- spec this
pure { state, render
, componentDidMount: do
{loadRows} <- React.getProps this
state' <- React.getState this
dispatcher' this $ loadAndSetRows {loadRows} state'
})
where
{ spec, dispatcher' } = createReactSpec tableSpec initialState
tableElt :: Props -> ReactElement
tableElt props = createElement tableClass props []
sizeDD :: PageSizes -> (Action -> Effect Unit) -> ReactElement
sizeDD ps d
= span []
[ text "Show : "
, select [onChange (\e -> d (ChangePageSize $ string2PageSize $ (unsafeCoerce e).target.value))] $ map (optps ps) aryPS
]
textDescription :: Int -> PageSizes -> Int -> ReactElement
textDescription currPage pageSize totalRecords
= div [className "row1"]
[ div [className ""]
[ text $ "Showing " <> show start <> " to " <> show end <> " of " <> show totalRecords ]
]
where
start = (currPage - 1) * pageSizes2Int pageSize + 1
end' = currPage * pageSizes2Int pageSize
end = if end' > totalRecords then totalRecords else end'
pagination :: ChangePageAction -> Int -> Int -> ReactElement
pagination changePage tp cp
= span [] $
[ text "Pages: ", prev, first, ldots]
<>
lnums
<>
[b' [text $ " " <> show cp <> " "]]
<>
rnums
<>
[ rdots, last, next ]
where
prev = if cp == 1 then
text " Previous "
else
span []
[ text " "
, a [ href "javascript:void()"
, onClick (\e -> changePage $ cp - 1)
] [text "Previous"]
, text " "
]
next = if cp == tp then
text " Next "
else
span []
[ text " "
, a [ href "javascript:void()"
, onClick (\e -> changePage $ cp + 1)
] [text "Next"]
, text " "
]
first = if cp == 1 then
text ""
else
span []
[ text " "
, a [ href "javascript:void()"
, onClick (\e -> changePage 1)
] [text "1"]
, text " "
]
last = if cp == tp then
text ""
else
span []
[ text " "
, a [ href "javascript:void()"
, onClick (\e -> changePage tp)
] [text $ show tp]
, text " "
]
ldots = if cp >= 5 then
text " ... "
else
text ""
rdots = if cp + 3 < tp then
text " ... "
else
text ""
lnums = map (\i -> fnmid changePage i) $ filter (1 < _) [cp - 2, cp - 1]
rnums = map (\i -> fnmid changePage i) $ filter (tp > _) [cp + 1, cp + 2]
fnmid :: ChangePageAction -> Int -> ReactElement
fnmid changePage i
= span []
[ text " "
, a [ href "javascript:void()"
, onClick (\e -> changePage i)
] [text $ show i]
, text " "
]
data PageSizes = PS10 | PS20 | PS50 | PS100
derive instance eqPageSizes :: Eq PageSizes
instance showPageSize :: Show PageSizes where
show PS10 = "10"
show PS20 = "20"
show PS50 = "50"
show PS100 = "100"
pageSizes2Int :: PageSizes -> Int
pageSizes2Int PS10 = 10
pageSizes2Int PS20 = 20
pageSizes2Int PS50 = 50
pageSizes2Int PS100 = 100
aryPS :: Array PageSizes
aryPS = [PS10, PS20, PS50, PS100]
string2PageSize :: String -> PageSizes
string2PageSize "10" = PS10
string2PageSize "20" = PS20
string2PageSize "50" = PS50
string2PageSize "100" = PS100
string2PageSize _ = PS10
optps :: PageSizes -> PageSizes -> ReactElement
optps cv val = option [ selected (cv == val), value $ show val ] [text $ show val]
src/Gargantext/Components/Tree.purs
View file @ e7ca1d1f
module Gargantext.Components.Tree where module Gargantext.Components.Tree where
import Prelude hiding (div)
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..))
import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift) import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.?), (:=), (~>)) import Data.Argonaut (class DecodeJson, class EncodeJson, Json, decodeJson, encodeJson, jsonEmptyObject, (.?), (:=), (~>))
import Data.Argonaut.Core (Json)
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Data.Traversable (traverse)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Prelude (identity) import Prelude (identity)
import React (ReactElement) import React (ReactElement)
import React.DOM (a, button, div, h5, i, input, li, text, ul) import Gargantext.Config (NodeType(..), readNodeType, toUrl, readNodeType, End(..), ApiVersion, defaultRoot)
import React.DOM (a, button, div, h5, i, input, li, span, text, ul)
import React.DOM.Props (Props, _type, className, href, onClick, onInput, placeholder, style, value) import React.DOM.Props (Props, _type, className, href, onClick, onInput, placeholder, style, value)
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec) import Thermite (PerformAction, Render, Spec, cotransform, modifyState, simpleSpec)
import Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Prelude
import Gargantext.Config.REST (get, put, post, delete)
import Gargantext.Config (NodeType(..), toUrl, End(..), defaultRoot)
type Name = String type Name = String
type Open = Boolean type Open = Boolean
type URL = String type URL = String
...@@ -30,7 +37,7 @@ data Action = ShowPopOver ...@@ -30,7 +37,7 @@ data Action = ShowPopOver
| ToggleFolder ID | ToggleFolder ID
| RenameNode String | RenameNode String
| Submit | Submit
-- | Initialize --| Initialize
type State = FTree type State = FTree
...@@ -43,6 +50,33 @@ initialState = NTree (LNode { id : 3 ...@@ -43,6 +50,33 @@ initialState = NTree (LNode { id : 3
, renameNodeValue : "" , renameNodeValue : ""
}) [] }) []
performAction :: PerformAction State {} Action
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
-- s <- lift $ loadDefaultNode
-- case s of
-- Left err -> modifyState identity
-- Right d -> modifyState (\state -> d)
toggleNode :: Int -> NTree LNode -> NTree LNode toggleNode :: Int -> NTree LNode -> NTree LNode
toggleNode sid (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) ary) = toggleNode sid (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) ary) =
...@@ -77,7 +111,7 @@ exampleTree = NTree (LNode { id : 1 ...@@ -77,7 +111,7 @@ exampleTree = NTree (LNode { id : 1
-- corpus :: Int -> String -> NTree (Tuple String String) -- corpus :: Int -> String -> NTree (Tuple String String)
-- corpus n name = NTree (LNode {id : n, name, nodeType : "", open : false}) -- corpus n name = NTree (LNode {id : n, name, nodeType : "", open : false})
-- [ NTree (Tuple "Tabs" "#/corpus") [] -- [ NTree (Tuple "Facets" "#/corpus") []
-- , NTree (Tuple "Dashboard" "#/dashboard") [] -- , NTree (Tuple "Dashboard" "#/dashboard") []
-- , NTree (Tuple "Graph" "#/graphExplorer") [] -- , NTree (Tuple "Graph" "#/graphExplorer") []
-- ] -- ]
...@@ -116,22 +150,6 @@ nodeOptionsRename d activated = case activated of ...@@ -116,22 +150,6 @@ nodeOptionsRename d activated = case activated of
treeview :: Spec State {} Action treeview :: Spec State {} Action
treeview = simpleSpec performAction render treeview = simpleSpec performAction render
where where
performAction :: PerformAction State {} Action
performAction (ToggleFolder i) _ _ =
void $ modifyState (\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
d <- lift $ renameNode id $ RenameValue { name : getRenameNodeValue s}
modifyState identity -- TODO why ???
performAction (RenameNode r) _ _ = void $
modifyState $ \(NTree (LNode lnode) ary) -> NTree (LNode $ lnode { renameNodeValue = r }) ary
-- performAction Initialize _ _ = void $ do
-- s <- lift $ loadDefaultNode
-- case s of
-- Left err -> modifyState identity
-- Right d -> modifyState (\state -> d)
render :: Render State {} Action render :: Render State {} Action
render dispatch _ state _ = render dispatch _ state _ =
[ div [className "tree"] [ div [className "tree"]
...@@ -200,8 +218,8 @@ toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) [ ...@@ -200,8 +218,8 @@ toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) [
( [ text (name <> " ") ( [ text (name <> " ")
] ]
<> nodeOptionsView false <> nodeOptionsView false
<> (nodeOptionsRename d false) <> (nodeOptionsRename d true)
-- <>[ if ((popOverValue s) == true) then (renameTreeView d s ) else (renameTreeView d s)] <>[ if ((popOverValue s) == true) then (renameTreeView d s ) else (renameTreeView d s)]
) )
] ]
] ]
...@@ -217,8 +235,8 @@ toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) a ...@@ -217,8 +235,8 @@ toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) a
map (toHtml d) ary map (toHtml d) ary
else [] else []
<> nodeOptionsView false <> nodeOptionsView false
<> (nodeOptionsRename d false) <> (nodeOptionsRename d true)
-- <>[ if ((popOverValue s) == true) then (renameTreeView d s ) else (renameTreeView d s)] <>[ if ((popOverValue s) == true) then (renameTreeView d s ) else (renameTreeView d s)]
) )
] ]
...@@ -261,8 +279,24 @@ instance decodeJsonFTree :: DecodeJson (NTree LNode) where ...@@ -261,8 +279,24 @@ instance decodeJsonFTree :: DecodeJson (NTree LNode) where
nodes' <- decodeJson nodes nodes' <- decodeJson nodes
pure $ NTree node' nodes' pure $ NTree node' nodes'
loadDefaultNode :: Aff (NTree LNode) loadDefaultNode :: Aff (Either String (NTree LNode))
loadDefaultNode = get $ toUrl Back Tree defaultRoot loadDefaultNode = do
res <- request $ defaultRequest
{ url = toUrl Back Tree defaultRoot
, responseFormat = ResponseFormat.json
, method = Left GET
, headers = []
}
case res.body of
Left err -> do
_ <- liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- liftEffect $ log $ show a.status
--_ <- liftEffect $ log $ show a.headers
--_ <- liftEffect $ log $ show a.body
let obj = decodeJson json
pure obj
----- TREE CRUD Operations ----- TREE CRUD Operations
...@@ -277,25 +311,96 @@ instance encodeJsonRenameValue :: EncodeJson RenameValue where ...@@ -277,25 +311,96 @@ instance encodeJsonRenameValue :: EncodeJson RenameValue where
~> jsonEmptyObject ~> jsonEmptyObject
renameNode :: Int -> RenameValue -> Aff Int --- need to change return type herre renameNode :: Int -> RenameValue -> Aff (Either String (Int)) --- need to change return type herre
renameNode renameNodeId reqbody = renameNode renameNodeId reqbody = do
put ("http://localhost:8008/api/v1.0/node/" <> show renameNodeId <> "/rename") res <- request $ defaultRequest
reqbody { url = "http://localhost:8008/api/v1.0/node/" <> show renameNodeId <> "/rename"
, responseFormat = ResponseFormat.json
, method = Left PUT
, headers = []
, content = Just $ Json $ encodeJson reqbody
}
case res.body of
Left err -> do
_ <- liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- liftEffect $ log $ show a.status
--_ <- liftEffect $ log $ show a.headers
--_ <- liftEffect $ log $ show a.body
let obj = decodeJson json
pure obj
deleteNode :: Aff (Either String (Int))
deleteNode = do
res <- request $ defaultRequest
{ url = toUrl Back Tree 1
, responseFormat = ResponseFormat.json
, method = Left DELETE
, headers = []
}
deleteNode :: Int -> Aff Int case res.body of
deleteNode = delete <<< toUrl Back Tree Left err -> do
_ <- liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- liftEffect $ log $ show a.status
--_ <- liftEffect $ log $ show a.headers
--_ <- liftEffect $ log $ show a.body
let obj = decodeJson json
pure obj
deleteNodes :: String -> Aff (Either String Int)
deleteNodes reqbody = do
res <- request $ defaultRequest
{ url = toUrl Back Tree 1
, responseFormat = ResponseFormat.json
, method = Left DELETE
, headers = []
, content = Just $ Json $ encodeJson reqbody
}
case res.body of
Left err -> do
_ <- liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- liftEffect $ log $ show a.status
--_ <- liftEffect $ log $ show a.headers
--_ <- liftEffect $ log $ show a.body
let obj = decodeJson json
pure obj
createNode :: String -> Aff (Either String (Int))
createNode reqbody= do
res <- request $ defaultRequest
{ url = toUrl Back Tree 1
, responseFormat = ResponseFormat.json
, method = Left POST
, headers = []
, content = Just $ Json $ encodeJson reqbody
}
case res.body of
Left err -> do
_ <- liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- liftEffect $ log $ show a.status
--_ <- liftEffect $ log $ show a.headers
--_ <- liftEffect $ log $ show a.body
let obj = decodeJson json
pure obj
-- See https://stackoverflow.com/questions/21863326/delete-multiple-records-using-rest
-- As of now I would recommend simply issuing many requests.
-- In a second time implement a set of end points for batch edition.
deleteNodes :: Array Int -> Aff (Array Int)
deleteNodes = traverse deleteNode
createNode :: String -> Aff Int
createNode reqbody = post (toUrl Back Tree 1) reqbody
fnTransform :: LNode -> FTree fnTransform :: LNode -> FTree
fnTransform n = NTree n [] fnTransform n = NTree n []
unsafeEventValue :: forall event. event -> String unsafeEventValue :: forall event. event -> String
unsafeEventValue e = (unsafeCoerce e).target.value unsafeEventValue e = (unsafeCoerce e).target.value
src/Gargantext/Config.purs
View file @ e7ca1d1f
...@@ -98,7 +98,7 @@ endPathUrl Back c nt i = pathUrl c.back nt i ...@@ -98,7 +98,7 @@ endPathUrl Back c nt i = pathUrl c.back nt i
endPathUrl Front c nt i = pathUrl c.front nt i endPathUrl Front c nt i = pathUrl c.front nt i
pathUrl :: Config -> NodeType -> Id -> UrlPath pathUrl :: Config -> NodeType -> Id -> UrlPath
pathUrl c nt@(Tab _ _ _) i = pathUrl c Node i <> "/" <> show nt pathUrl c Children i = pathUrl c Node i <> "/" <> show Children
pathUrl c nt i = c.prePath <> urlConfig nt <> "/" <> show i pathUrl c nt i = c.prePath <> urlConfig nt <> "/" <> show i
------------------------------------------------------------ ------------------------------------------------------------
toUrl :: End -> NodeType -> Id -> Url toUrl :: End -> NodeType -> Id -> Url
...@@ -110,11 +110,10 @@ toUrl e nt i = doUrl base path params ...@@ -110,11 +110,10 @@ toUrl e nt i = doUrl base path params
------------------------------------------------------------ ------------------------------------------------------------
data NodeType = NodeUser data NodeType = NodeUser
| Annuaire | Annuaire
| Tab TabType Offset Limit | Children
| Corpus | Corpus
| CorpusV3
| Dashboard | Dashboard
| Url_Document | Document
| Error | Error
| Folder | Folder
| Graph | Graph
...@@ -123,34 +122,19 @@ data NodeType = NodeUser ...@@ -123,34 +122,19 @@ data NodeType = NodeUser
| Tree | Tree
data End = Back | Front data End = Back | Front
type Id = Int type Id = Int
type Limit = Int
type Offset = Int
------------------------------------------------------------ ------------------------------------------------------------
data ApiVersion = V10 | V11 data ApiVersion = V10 | V11
instance showApiVersion :: Show ApiVersion where instance showApiVersion :: Show ApiVersion where
show V10 = "v1.0" show V10 = "v1.0"
show V11 = "v1.1" show V11 = "v1.1"
------------------------------------------------------------ ------------------------------------------------------------
data TabType = TabDocs | TabTerms | TabSources | TabAuthors | TabTrash
instance showTabType :: Show TabType where
show TabDocs = "Docs"
show TabTerms = "Terms"
show TabSources = "Sources"
show TabAuthors = "Authors"
show TabTrash = "Trash"
------------------------------------------------------------ ------------------------------------------------------------
urlConfig :: NodeType -> Url urlConfig :: NodeType -> Url
urlConfig Annuaire = show Annuaire urlConfig Annuaire = show Annuaire
urlConfig nt@(Tab _ _ _) = show nt urlConfig Children = show Children
urlConfig Corpus = show Corpus urlConfig Corpus = show Corpus
urlConfig CorpusV3 = show CorpusV3
urlConfig Dashboard = show Dashboard urlConfig Dashboard = show Dashboard
urlConfig Url_Document = show Url_Document urlConfig Document = show Document
urlConfig Error = show Error urlConfig Error = show Error
urlConfig Folder = show Folder urlConfig Folder = show Folder
urlConfig Graph = show Graph urlConfig Graph = show Graph
...@@ -161,10 +145,10 @@ urlConfig Tree = show Tree ...@@ -161,10 +145,10 @@ urlConfig Tree = show Tree
------------------------------------------------------------ ------------------------------------------------------------
instance showNodeType :: Show NodeType where instance showNodeType :: Show NodeType where
show Annuaire = "annuaire" show Annuaire = "annuaire"
show Children = "children"
show Corpus = "corpus" show Corpus = "corpus"
show CorpusV3 = "corpus"
show Dashboard = "dashboard" show Dashboard = "dashboard"
show Url_Document = "document" show Document = "document"
show Error = "ErrorNodeType" show Error = "ErrorNodeType"
show Folder = "folder" show Folder = "folder"
show Graph = "graph" show Graph = "graph"
...@@ -172,21 +156,19 @@ instance showNodeType :: Show NodeType where ...@@ -172,21 +156,19 @@ instance showNodeType :: Show NodeType where
show Node = "node" show Node = "node"
show NodeUser = "user" show NodeUser = "user"
show Tree = "tree" show Tree = "tree"
show (Tab t o l) = "table?view=" <> show t <> "&offset=" <> show o <> "&limit=" <> show l <> "&order=DateAsc"
-- | TODO : where is the Read Class ? -- | TODO : where is the Read Class ?
-- instance readNodeType :: Read NodeType where -- instance readNodeType :: Read NodeType where
readNodeType :: String -> NodeType readNodeType :: String -> NodeType
readNodeType "NodeAnnuaire" = Annuaire readNodeType "Annuaire" = Annuaire
readNodeType "Tab" = (Tab TabDocs 0 0) readNodeType "Children" = Children
readNodeType "NodeDashboard" = Dashboard readNodeType "Dashboard" = Dashboard
readNodeType "Document" = Url_Document readNodeType "Document" = Document
readNodeType "NodeFolder" = Folder readNodeType "Folder" = Folder
readNodeType "NodeGraph" = Graph readNodeType "Graph" = Graph
readNodeType "Individu" = Individu readNodeType "Individu" = Individu
readNodeType "Node" = Node readNodeType "Node" = Node
readNodeType "NodeCorpus" = Corpus readNodeType "NodeCorpus" = Corpus
readNodeType "NodeCorpusV3" = CorpusV3
readNodeType "NodeUser" = NodeUser readNodeType "NodeUser" = NodeUser
readNodeType "Tree" = Tree readNodeType "Tree" = Tree
readNodeType _ = Error readNodeType _ = Error
......
src/Gargantext/Config/REST.purs
View file @ e7ca1d1f
module Gargantext.Config.REST where module Gargantext.Config.REST where
import Prelude
import Affjax (defaultRequest, printResponseFormatError, request) import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..))
import Affjax.RequestHeader (RequestHeader(..)) import Affjax.RequestHeader (RequestHeader(..))
import Affjax.ResponseFormat as ResponseFormat import Affjax.ResponseFormat as ResponseFormat
import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson) import Data.Argonaut (class DecodeJson, decodeJson)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.HTTP.Method (Method(..)) import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(..))
import Data.MediaType.Common (applicationJSON) import Data.MediaType.Common (applicationJSON)
import Effect.Aff (Aff, throwError) import Effect.Aff (Aff)
import Effect.Exception (error)
get :: forall t31. DecodeJson t31 => String ->
import Gargantext.Prelude Aff (Either String t31)
get url = do
send :: forall a b. EncodeJson a => DecodeJson b => affResp <- request defaultRequest
Method -> String -> Maybe a -> Aff b { method = Left GET
send m url reqbody = do , url = url
affResp <- request $ defaultRequest
{ url = url
, responseFormat = ResponseFormat.json , responseFormat = ResponseFormat.json
, method = Left m
, headers = [ ContentType applicationJSON , headers = [ ContentType applicationJSON
, Accept applicationJSON , Accept applicationJSON
-- , RequestHeader "Authorization" $ "Bearer " <> token -- , RequestHeader "Authorization" $ "Bearer " <> token
] ]
, content = (Json <<< encodeJson) <$> reqbody
} }
case affResp.body of case affResp.body of
Left err -> do Left err -> do
_ <- logs $ printResponseFormatError err pure $ Left $ printResponseFormatError err
throwError $ error $ printResponseFormatError err Right a -> do
Right json -> do let res = decodeJson a
--_ <- logs $ show json.status pure res
--_ <- logs $ show json.headers
--_ <- logs $ show json.body
case decodeJson json of
Left err -> throwError $ error $ "decodeJson affResp.body: " <> err
Right b -> pure b
noReqBody :: Maybe Unit
noReqBody = Nothing
get :: forall a. DecodeJson a => String -> Aff a
get url = send GET url noReqBody
put :: forall a b. EncodeJson a => DecodeJson b => String -> a -> Aff b
put url = send PUT url <<< Just
delete :: forall a. DecodeJson a => String -> Aff a
delete url = send DELETE url noReqBody
post :: forall a b. EncodeJson a => DecodeJson b => String -> a -> Aff b
post url = send POST url <<< Just
src/Gargantext/Pages/Annuaire.purs
View file @ e7ca1d1f
module Gargantext.Pages.Annuaire where module Gargantext.Pages.Annuaire where
import Prelude
import Data.Array (concat)
import Data.Traversable (foldl)
import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Class (lift)
import Data.Lens (Lens', lens, (?~)) import Data.Either (Either(..))
import Data.Lens (Lens', Prism', lens, prism, (?~))
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe)
import Effect.Class (liftEffect)
import React (ReactElement) import React (ReactElement)
import React.DOM (a, b, b', br', div, h3, hr, i, input, p, table, tbody, td, text, th, thead, tr) 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 (className, href, scope, style) import React.DOM.Props (_type, className, href, onChange, onClick, scope, selected, value, style)
import Effect.Aff (Aff)
import Thermite (Render, Spec import Thermite (Render, Spec
, simpleSpec , simpleSpec, defaultPerformAction
, PerformAction, modifyState) , PerformAction, modifyState)
import Effect.Console (log)
import Effect.Aff (Aff)
------------------------------------------------------------------------------ import Gargantext.Config (toUrl, NodeType(..), End(..))
import Gargantext.Prelude
import Gargantext.Config (toUrl, NodeType(..), TabType(..), End(..))
import Gargantext.Config.REST (get) import Gargantext.Config.REST (get)
import Gargantext.Pages.Annuaire.User.Contacts.Types (Contact(..), HyperData(..)) import Gargantext.Pages.Annuaire.User.Contacts.Types.Types (Contact(..), HyperData(..))
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
, stable :: Maybe AnnuaireTable , stable :: Maybe AnnuaireTable
...@@ -74,20 +80,9 @@ toRows (AnnuaireTable a) = a.annuaireTable ...@@ -74,20 +80,9 @@ toRows (AnnuaireTable a) = a.annuaireTable
layoutAnnuaire :: Spec State {} Action layoutAnnuaire :: Spec State {} Action
layoutAnnuaire = simpleSpec performAction render layoutAnnuaire = simpleSpec performAction render
where
performAction :: PerformAction State {} Action render :: Render State {} Action
performAction (Load aId) _ _ = do render dispatch _ state _ = [ div [className "row"]
info' <- lift $ getInfo aId
void $ modifyState $ _info ?~ info'
table' <- lift $ getTable aId
logs "Feching Table"
void $ modifyState $ _table ?~ table'
logs "Annuaire page fetched."
performAction (ChangePageSize _) _ _ = pure unit -- TODO
performAction (ChangePage _) _ _ = pure unit -- TODO
render :: Render State {} Action
render dispatch _ state _ = [ div [className "row"]
[ div [className "col-md-3"] [ h3 [] [text info.name] ] [ div [className "col-md-3"] [ h3 [] [text info.name] ]
, div [className "col-md-9"] [ hr [style {height : "2px",backgroundColor : "black"}] ] , div [className "col-md-9"] [ hr [style {height : "2px",backgroundColor : "black"}] ]
] ]
...@@ -135,7 +130,7 @@ showRow :: Maybe Contact -> ReactElement ...@@ -135,7 +130,7 @@ showRow :: Maybe Contact -> ReactElement
showRow Nothing = tr [][] showRow Nothing = tr [][]
showRow (Just (Contact { id : id, hyperdata : (HyperData contact) })) = showRow (Just (Contact { id : id, hyperdata : (HyperData contact) })) =
tr [] tr []
[ td [] [ a [ href (toUrl Front NodeUser id) ] [ text $ maybe' contact.nom <> " " <> maybe' contact.prenom ] ] [ td [] [ a [ href (toUrl Back NodeUser id) ] [ text $ maybe' contact.nom <> " " <> maybe' contact.prenom ] ]
, td [] [text $ maybe' contact.fonction] , td [] [text $ maybe' contact.fonction]
, td [] [text $ maybe' contact.service] , td [] [text $ maybe' contact.service]
, td [] [text $ maybe' contact.groupe] , td [] [text $ maybe' contact.groupe]
...@@ -180,10 +175,28 @@ instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where ...@@ -180,10 +175,28 @@ instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where
rows <- decodeJson json rows <- decodeJson json
pure $ AnnuaireTable { annuaireTable : rows} pure $ AnnuaireTable { annuaireTable : rows}
------------------------------------------------------------------------ ------------------------------------------------------------------------
getTable :: Int -> Aff AnnuaireTable performAction :: PerformAction State {} Action
getTable id = get $ toUrl Back (Tab TabDocs 0 10) id performAction (Load aId) _ _ = do
eitherInfo <- lift $ getInfo aId
_ <- case eitherInfo of
(Right info') -> void $ modifyState $ _info ?~ info'
(Left err) -> do
liftEffect $ log err
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
------------------------------------------------------------------------
getTable :: Int -> Aff (Either String AnnuaireTable)
getTable id = get $ toUrl Back Children id
getInfo :: Int -> Aff AnnuaireInfo 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)
......
src/Gargantext/Pages/Annuaire/User/Contacts/API.purs
View file @ e7ca1d1f
module Gargantext.Pages.Annuaire.User.Contacts.API where module Gargantext.Pages.Annuaire.User.Contacts.API where
import Prelude
import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Class (lift)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Lens ((?~)) import Data.Lens ((?~))
...@@ -7,19 +9,22 @@ import Data.Maybe (Maybe(..)) ...@@ -7,19 +9,22 @@ import Data.Maybe (Maybe(..))
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 Thermite (StateCoTransformer, modifyState)
import Gargantext.Config (toUrl, NodeType(..), End(..)) import Gargantext.Config (toUrl, NodeType(..), End(..))
import Gargantext.Config.REST (get) import Gargantext.Config.REST (get)
import Gargantext.Prelude
import Gargantext.Pages.Annuaire.User.Contacts.Types (Action(..), State, Contact, _contact) import Gargantext.Pages.Annuaire.User.Contacts.Types (Action(..), State, Contact, _contact)
import Thermite (PerformAction, modifyState) import Thermite (PerformAction, modifyState)
getContact :: Int -> Aff Contact getUser :: Int -> Aff (Either String Contact)
getContact id = get $ toUrl Back Node id getUser id = get $ toUrl Back Node id
fetchContact :: Int -> StateCoTransformer State Unit performAction :: PerformAction State {} Action
fetchContact contactId = do performAction (FetchContact contactId) _ _ = do
contact <- lift $ getContact contactId value <- lift $ getUser contactId
void $ modifyState $ _contact ?~ contact _ <- case value of
logs "Fetching contact..." (Right contact) -> void $ modifyState $ _contact ?~ contact
(Left err) -> do
liftEffect $ log err
liftEffect <<< log $ "Fetching contact..."
performAction _ _ _ = pure unit
src/Gargantext/Pages/Annuaire/User/Contacts/Specs.purs
View file @ e7ca1d1f
module Gargantext.Pages.Annuaire.User.Contacts.Specs module Gargantext.Pages.Annuaire.User.Contacts.Specs
(module Gargantext.Pages.Annuaire.User.Contacts.Specs.Renders, (module Gargantext.Pages.Annuaire.User.Contacts.Specs.Renders,
brevetSpec,
projectSpec,
facets,
layoutUser) layoutUser)
where where
import Gargantext.Pages.Annuaire.User.Contacts.Specs.Renders
import Data.List (fromFoldable) import Thermite (Spec, simpleSpec)
import Data.Tuple (Tuple(..)) import Gargantext.Pages.Annuaire.User.Contacts.Types (Action, State)
import Thermite (Render, PerformAction, Spec, focus, noState, defaultPerformAction, simpleSpec) import Gargantext.Pages.Annuaire.User.Contacts.API (performAction)
import Gargantext.Prelude
import Gargantext.Components.Tab as Tab
import Gargantext.Pages.Annuaire.User.Brevets as B
import Gargantext.Pages.Annuaire.User.Contacts.Specs.Documents as P
import Gargantext.Pages.Annuaire.User.Contacts.Types (Action(..), State, _tablens, _tabAction)
import Gargantext.Pages.Annuaire.User.Contacts.API (fetchContact)
import Gargantext.Pages.Annuaire.User.Contacts.Specs.Renders (render)
layoutUser :: Spec State {} Action layoutUser :: Spec State {} Action
layoutUser = simpleSpec performAction render layoutUser = simpleSpec performAction render
where
performAction :: PerformAction State {} Action
performAction (FetchContact contactId) _ _ = fetchContact contactId
performAction (TabA _) _ _ = pure unit
brevetSpec :: Spec State {} Action
brevetSpec = noState B.brevetsSpec
projets :: Spec {} {} Void
projets = simpleSpec defaultPerformAction render
where
render :: Render {} {} Void
render dispatch _ state _ =
[]
projectSpec :: Spec State {} Action
projectSpec = noState projets
publicationSpec :: Spec State {} Action
publicationSpec = noState P.publicationSpec
facets :: Spec State {} Action
facets = Tab.tabs _tablens _tabAction $ fromFoldable
[ Tuple "Publications (12)" publicationSpec
, Tuple "Brevets (2)" brevetSpec
, Tuple "Projets IMT (5)" projectSpec
]
src/Gargantext/Pages/Annuaire/User/Contacts/Specs/Renders.purs
View file @ e7ca1d1f
...@@ -54,14 +54,13 @@ mapMyMap f m = toUnfoldable ...@@ -54,14 +54,13 @@ mapMyMap f m = toUnfoldable
infixl 4 mapMyMap as <.~$> infixl 4 mapMyMap as <.~$>
contactInfos :: HyperData -> ReactElement contactInfos :: Maybe HyperData -> ReactElement
contactInfos hyperdata = contactInfos hyperdata =
ul [className "list-group"] [] {- $ ul [className "list-group"] $
listInfo <.~$> hyperdata listInfo <.~$> (checkMaybe hyperdata)
where where
checkMaybe (Nothing) = empty checkMaybe (Nothing) = empty
checkMaybe (Just (HyperData a)) = a checkMaybe (Just (HyperData a)) = a
-}
listInfo :: Tuple String String -> ReactElement listInfo :: Tuple String String -> ReactElement
listInfo s = listElement $ infoRender s listInfo s = listElement $ infoRender s
......
src/Gargantext/Pages/Annuaire/User/Contacts/Types.purs
View file @ e7ca1d1f
module Gargantext.Pages.Annuaire.User.Contacts.Types where module Gargantext.Pages.Annuaire.User.Contacts.Types
(module Gargantext.Pages.Annuaire.User.Contacts.Types.Types,
module Gargantext.Pages.Annuaire.User.Contacts.Types.Lens,
module Gargantext.Pages.Annuaire.User.Contacts.Types.States,
brevetSpec,
projectSpec,
facets
)
where
import Prelude import Prelude
import Data.Argonaut (class DecodeJson, decodeJson, (.?)) import Gargantext.Pages.Annuaire.User.Contacts.Types.Lens
import Data.Either (Either(..)) import Gargantext.Pages.Annuaire.User.Contacts.Types.Types
import Data.Lens (Lens', Prism', lens, prism) import Gargantext.Pages.Annuaire.User.Contacts.Types.States
import Data.Maybe (Maybe(..)) import Gargantext.Pages.Annuaire.User.Brevets as B
import Data.List (fromFoldable)
import Gargantext.Components.Tab as Tab import Data.Tuple (Tuple(..))
import Gargantext.Utils.DecodeMaybe ((.?|)) import Gargantext.Components.Tab (tabs)
import Thermite (Render, Spec, focus, noState, defaultPerformAction, simpleSpec)
newtype Contact = Contact
{ id :: Int brevetSpec :: Spec State {} Action
, typename :: Maybe Int brevetSpec = noState B.brevetsSpec
, userId :: Int
, parentId :: Int projets :: Spec {} {} Void
, name :: String projets = simpleSpec defaultPerformAction render
, date :: Maybe String where
, hyperdata :: HyperData render :: Render {} {} Void
} render dispatch _ state _ =
[]
newtype HyperData =
HyperData projectSpec :: Spec State {} Action
{ bureau :: Maybe String projectSpec = noState projets
, atel :: Maybe String
, fax :: Maybe String facets :: Spec State {} Action
, aprecision :: Maybe String facets = tabs _tablens _tabAction $ fromFoldable
, service :: Maybe String [ Tuple "Publications (12)" publicationSpec
, service2 :: Maybe String , Tuple "Brevets (2)" brevetSpec
, groupe :: Maybe String , Tuple "Projets IMT (5)" projectSpec
, lieu :: Maybe String ]
, pservice :: Maybe String
, date_modification :: Maybe String
, fonction :: Maybe String
, pfonction :: Maybe String
, url :: Maybe String
, prenom :: Maybe String
, nom :: Maybe String
, idutilentite :: Maybe String
, afonction :: Maybe String
, grprech :: Maybe String
, entite :: Maybe String
, entite2 :: Maybe String
, mail :: Maybe String
}
instance decodeUserHyperData :: DecodeJson HyperData where
decodeJson json = do
obj <- decodeJson json
bureau <- obj .?| "bureau"
atel <- obj .?| "atel"
fax <- obj .?| "fax"
aprecision <- obj .?| "aprecision"
service <- obj .?| "service"
service2 <- obj .?| "service2"
groupe <- obj .?| "groupe"
lieu <- obj .?| "lieu"
pservice <- obj .?| "pservice"
date_modification <- obj .?| "date_modification"
fonction <- obj .?| "fonction"
pfonction <- obj .?| "pfonction"
url <- obj .?| "url"
prenom <- obj .?| "prenom"
nom <- obj .?| "nom"
idutilentite <- obj .?| "idutilentite"
afonction <- obj .?| "afonction"
grprech <- obj .?| "grprech"
entite <- obj .?| "entite"
entite2 <- obj .?| "entite2"
mail <- obj .?| "mail"
pure $ HyperData { bureau, atel, fax
, aprecision, service
, service2, groupe, lieu
, pservice, date_modification
, fonction, pfonction, url
, prenom, nom, idutilentite
, afonction, grprech, entite
, entite2, mail
}
instance decodeUser :: DecodeJson Contact 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"
pure $ Contact { id, typename, userId
, parentId, name, date
, hyperdata
}
data Action
= TabA Tab.Action
| FetchContact Int
type State =
{ activeTab :: Int
, contact :: Maybe Contact
}
initialState :: State
initialState =
{ activeTab : 0
, contact: Nothing
}
_contact :: Lens' State (Maybe Contact)
_contact = lens (\s -> s.contact) (\s ss -> s{contact = ss})
_tablens :: Lens' State Tab.State
_tablens = lens (\s -> s.activeTab) (\s ss -> s {activeTab = ss})
_tabAction :: Prism' Action Tab.Action
_tabAction = prism TabA \ action ->
case action of
TabA laction -> Right laction
_-> Left action
src/Gargantext/Pages/Annuaire/User/Contacts/Types/Lens.purs 0 → 100644
View file @ e7ca1d1f
module Gargantext.Pages.Annuaire.User.Contacts.Types.Lens where
import Gargantext.Pages.Annuaire.User.Brevets as B
import Data.Either (Either(..))
import Data.Lens (Lens', Prism', lens, prism)
import Data.Maybe (Maybe)
import Gargantext.Pages.Annuaire.User.Contacts.Types.States (Action(..), State)
import Gargantext.Pages.Annuaire.User.Contacts.Types.Types (Contact)
import Gargantext.Pages.Annuaire.User.Contacts.Specs.Documents as P
import Gargantext.Components.Tab as Tab
import Thermite (Spec, noState)
_contact :: Lens' State (Maybe Contact)
_contact = lens (\s -> s.contact) (\s ss -> s{contact = ss})
_tablens :: Lens' State Tab.State
_tablens = lens (\s -> s.activeTab) (\s ss -> s {activeTab = ss})
_tabAction :: Prism' Action Tab.Action
_tabAction = prism TabA \ action ->
case action of
TabA laction -> Right laction
_-> Left action
publicationSpec :: Spec State {} Action
publicationSpec = noState P.publicationSpec
src/Gargantext/Pages/Annuaire/User/Contacts/Types/States.purs 0 → 100644
View file @ e7ca1d1f
module Gargantext.Pages.Annuaire.User.Contacts.Types.States where
import Data.Maybe (Maybe(..))
import Gargantext.Pages.Annuaire.User.Contacts.Types.Types (Contact)
import Gargantext.Pages.Annuaire.User.Contacts.Specs.Documents as P
import Gargantext.Components.Tab as Tab
data Action
= TabA Tab.Action
| FetchContact Int
type State =
{ activeTab :: Int
, contact :: Maybe Contact
}
initialState :: State
initialState =
{ activeTab : 0
, contact : Nothing
}
src/Gargantext/Pages/Annuaire/User/Contacts/Types/Types.purs 0 → 100644
View file @ e7ca1d1f
module Gargantext.Pages.Annuaire.User.Contacts.Types.Types where
import Prelude
import Data.Argonaut (class DecodeJson, decodeJson, (.?))
import Data.Maybe (Maybe)
import Gargantext.Utils.DecodeMaybe ((.?|))
{-
newtype User =
User {
id :: Int,
... fields for all the gargantext utilities
authors :: [Author]
}
newtype Author =
Author {
user :: Maybe User,
name :: String,
hyperdata :: [Map String String]
...
}
newtype Document =
Document {
authors :: [Author],
...
}
So Users have many Author and Authors have one User. This relation permit to
retrieve all the authors of a user to create corpus with it.
It also permit to have multiple authors name to permit to retrace document signed with a nickname.
It will happend that we can't establish a link between an Author and a User, this is why
the "user" field is encapsulated in a Maybe.
-}
newtype Contact =
Contact { id :: Int
, typename :: Maybe Int
, userId :: Int
, parentId :: Int
, name :: String
, date :: Maybe String
, hyperdata :: HyperData
}
newtype HyperData =
HyperData
{ bureau :: Maybe String
, atel :: Maybe String
, fax :: Maybe String
, aprecision :: Maybe String
, service :: Maybe String
, service2 :: Maybe String
, groupe :: Maybe String
, lieu :: Maybe String
, pservice :: Maybe String
, date_modification :: Maybe String
, fonction :: Maybe String
, pfonction :: Maybe String
, url :: Maybe String
, prenom :: Maybe String
, nom :: Maybe String
, idutilentite :: Maybe String
, afonction :: Maybe String
, grprech :: Maybe String
, entite :: Maybe String
, entite2 :: Maybe String
, mail :: Maybe String
}
instance decodeUserHyperData :: DecodeJson HyperData where
decodeJson json = do
obj <- decodeJson json
bureau <- obj .?| "bureau"
atel <- obj .?| "atel"
fax <- obj .?| "fax"
aprecision <- obj .?| "aprecision"
service <- obj .?| "service"
service2 <- obj .?| "service2"
groupe <- obj .?| "groupe"
lieu <- obj .?| "lieu"
pservice <- obj .?| "pservice"
date_modification <- obj .?| "date_modification"
fonction <- obj .?| "fonction"
pfonction <- obj .?| "pfonction"
url <- obj .?| "url"
prenom <- obj .?| "prenom"
nom <- obj .?| "nom"
idutilentite <- obj .?| "idutilentite"
afonction <- obj .?| "afonction"
grprech <- obj .?| "grprech"
entite <- obj .?| "entite"
entite2 <- obj .?| "entite2"
mail <- obj .?| "mail"
pure $ HyperData { bureau, atel, fax
, aprecision, service
, service2, groupe, lieu
, pservice, date_modification
, fonction, pfonction, url
, prenom, nom, idutilentite
, afonction, grprech, entite
, entite2, mail
}
instance decodeUser :: DecodeJson Contact 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"
pure $ Contact { id, typename, userId
, parentId, name, date
, hyperdata
}
src/Gargantext/Pages/Corpus.purs
View file @ e7ca1d1f
module Gargantext.Pages.Corpus where module Gargantext.Pages.Corpus where
import Data.Maybe (Maybe(..), maybe)
import Data.Either (Either(..)) import Prelude hiding (div)
import Data.Lens (Lens', Prism', lens, prism) import Data.Argonaut (class DecodeJson, decodeJson, (.?))
import Data.Maybe (maybe) import Gargantext.Components.Charts.Options.ECharts (chart)
import Effect.Aff (Aff) import Gargantext.Pages.Corpus.Doc.Facets.Dashboard (globalPublis)
import React as React import Gargantext.Pages.Corpus.Doc.Facets as Tab
import React (ReactClass, ReactElement)
import React.DOM (div, h3, hr, i, p, text) 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, createClass, defaultPerformAction, focus import Thermite (Render, Spec, defaultPerformAction, simpleSpec)
, simpleSpec, noState )
--------------------------------------------------------
import Gargantext.Prelude
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Loader as Loader
import Gargantext.Components.Loader (createLoaderClass)
import Gargantext.Config (toUrl, NodeType(..), End(..))
import Gargantext.Config.REST (get)
import Gargantext.Pages.Corpus.Tabs.Types (CorpusInfo(..), corpusInfoDefault)
import Gargantext.Pages.Corpus.Tabs.Types (Props) as Tabs
import Gargantext.Pages.Corpus.Tabs.States (State, initialState) as Tabs
import Gargantext.Pages.Corpus.Tabs.Actions (Action) as Tabs
import Gargantext.Pages.Corpus.Tabs.Specs (statefulTabs) as Tabs
------------------------------------------------------------------- -------------------------------------------------------------------
type Props = Tabs.Props
type State = { tabsView :: Tabs.State type State = { info :: Maybe CorpusInfo
} }
initialState :: State initialState :: State
initialState = { tabsView : Tabs.initialState 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
_tabsView :: forall a b. Lens' { tabsView :: a | b } a , desc :: String
_tabsView = lens (\s -> s.tabsView) (\s ss -> s{tabsView = ss}) , query :: String
------------------------------------------------------------------------ , date :: String
, authors :: String
, chart :: (Maybe (Array Number))
}
data Action corpusInfoDefault :: CorpusInfo
= TabsA Tabs.Action 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
}
_tabsAction :: Prism' Action Tabs.Action instance decodeCorpusInfo :: DecodeJson CorpusInfo where
_tabsAction = prism TabsA \ action -> decodeJson json = do
case action of obj <- decodeJson json
TabsA taction -> Right taction title <- obj .? "title"
-- _-> Left action desc <- obj .? "desc"
query <- obj .? "query"
date <- obj .? "date"
authors <- obj .? "authors"
chart <- obj .? "chart"
pure $ CorpusInfo {title, desc, query, date, authors, chart}
------------------------------------------------------------------------
layout :: Spec {} {nodeId :: Int} Void instance decodeNode :: (DecodeJson a) => DecodeJson (Node a) where
layout = simpleSpec defaultPerformAction render decodeJson json = do
where obj <- decodeJson json
render :: Render {} {nodeId :: Int} Void id <- obj .? "id"
render _ {nodeId} _ _ = typename <- obj .? "typename"
[ corpusLoader { path: nodeId userId <- obj .? "userId"
, component: createClass "Layout" layout' initialState parentId <- obj .? "parentId"
} ] name <- obj .? "name"
date <- obj .? "date"
layout' :: Spec State Props Action
layout' = noState corpusHeaderSpec hyperdata <- obj .? "hyperdata"
<> focus _tabsView _tabsAction Tabs.statefulTabs hyperdata' <- decodeJson hyperdata
corpusHeaderSpec :: Spec {} Props Void pure $ Node { id : id
corpusHeaderSpec = simpleSpec defaultPerformAction render , typename : typename
, userId : userId
, parentId : parentId
, name : name
, date : date
, hyperdata: hyperdata'
}
layout :: Spec State {} Action
layout = corpusSpec -- <> Tab.pureTab1
corpusSpec :: Spec State {} Action
corpusSpec = simpleSpec defaultPerformAction render
where where
render :: Render {} Props Void render :: Render State {} Action
render dispatch {loaded} _ _ = render dispatch _ state _ =
[ div [className "row"] [ div [className "row"]
[ div [className "col-md-3"] [ h3 [] [text "Corpus " <> text 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"}] ]
] ]
, div [className "row"] [ div [className "jumbotron1", style {padding : "12px 0px 20px 12px"}] , div [className "row"] [ div [className "jumbotron1", style {padding : "12px 0px 20px 12px"}]
[ div [ className "col-md-8 content"] [ div [ className "col-md-8 content"]
[ p [] [ i [className "fa fa-globe"] [] [ p [] [ i [className "fa fa-globe"] []
, text $ " " <> corpus.desc , text corpus.desc
] ]
, p [] [ i [className "fab fa-searchengin"] [] , p [] [ i [className "fab fa-searchengin"] []
, text $ " " <> corpus.query , text corpus.query
] ]
] ]
, 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 $ " " <> date' , text corpus.date
] ]
, p [] [ i [className "fa fa-user"] [] , p [] [ i [className "fa fa-user"] []
, text $ " " <> corpus.authors , text corpus.authors
] ]
] ]
] ]
] ]
-- , chart globalPublis TODO add chart data in state
] ]
where where
NodePoly { name: title CorpusInfo corpus = maybe corpusInfoDefault identity state.info
, date: date'
, hyperdata : CorpusInfo corpus
}
= maybe corpusInfoDefault identity loaded
------------------------------------------------------------------------
getCorpus :: Int -> Aff (NodePoly CorpusInfo)
getCorpus = get <<< toUrl Back Corpus
corpusLoaderClass :: ReactClass (Loader.Props Int (NodePoly CorpusInfo))
corpusLoaderClass = createLoaderClass "CorpusLoader" getCorpus
corpusLoader :: Loader.Props Int (NodePoly CorpusInfo) -> ReactElement
corpusLoader = React.createLeafElement corpusLoaderClass
src/Gargantext/Pages/Corpus/Doc/Annotation.purs 0 → 100644
View file @ e7ca1d1f
module Gargantext.Pages.Corpus.Doc.Annotation where
import Prelude hiding (div)
import React (ReactElement)
import React.DOM (a, button, div, h4, h6, input, li, nav, option, p, select, span, text, ul)
import React.DOM.Props (_data, _id, _type, aria, className, href, name, onChange, onInput, placeholder, role, style, value)
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
import Unsafe.Coerce (unsafeCoerce)
type State =
{
inputValue :: String
}
initialState :: State
initialState =
{
inputValue : ""
}
data Action
= ChangeString String
| ChangeAnotherString String
| SetInput String
performAction :: PerformAction State {} Action
performAction (ChangeString ps) _ _ = pure unit
performAction (ChangeAnotherString ps) _ _ = pure unit
performAction (SetInput ps) _ _ = void do
modifyState $ _ { inputValue = ps }
docview :: Spec State {} Action
docview = simpleSpec performAction render
where
render :: Render State {} Action
render dispatch _ state _ =
[
div [className "container1"]
[
div [className "row"]
[
div [className "col-md-4", style {border : "1px solid black", padding : "34px"}]
[
div [className "row"]
[
div [className "col-md-12 input-group mb-3"] [select [className "form-control custom-select",onChange (\e -> dispatch (ChangeString $ (unsafeCoerce e).target.value)) ] $ map optps aryPS ]
, div [className "col-md-12 form-control input-group mb-3"] [ select [className "form-control custom-select",onChange (\e -> dispatch (ChangeAnotherString $ (unsafeCoerce e).target.value)) ] $ map optps aryPS1 ]
]
, div [className "row", style { marginTop : "35px"}]
[
nav [ ]
[ div [className "nav nav-tabs", _id "nav-tab",role "tablist"]
[ a [className "nav-item nav-link active",_id "nav-home-tab" , _data {toggle : "tab"},href "#nav-home" ,role "tab",aria {controls : "nav-home"} ,aria {selected:true}] [ text "STOPLIST"]
, a [className "nav-item nav-link" ,_id "nav-profile-tab", _data {toggle : "tab"},href "#nav-profile",role "tab",aria {controls : "nav-profile"},aria {selected:true}] [ text "MAINLIST"]
, a [className "nav-item nav-link" ,_id "nav-contact-tab", _data {toggle : "tab"},href "#nav-contact",role "tab",aria {controls : "nav-contact"},aria {selected:true}] [ text "MAPLIST"]
]
]
, div [className "tab-content" , _id "nav-tabContent"]
[
div [ className "tab-pane fade show active"
, role "tabpanel"
, aria {labelledby : "nav-home-tab"}
, _id "nav-home"
]
[
h6 [] [text "Add a free term to STOPLIST"]
, div [className "form-group"]
[ input [className "form-control", _id "id_password", name "password", placeholder "Any text", _type "value",value state.inputValue,onInput \e -> dispatch (SetInput (unsafeEventValue e))]
, div [className "clearfix"] []
]
, button [className "btn btn-primary", _type "button"] [text "Create and Add"]
]
, div [ className "tab-pane fade show"
, role "tabpanel"
, aria {labelledby : "nav-profile-tab"}
, _id "nav-profile"
]
[ ]
, div [ className "tab-pane fade show"
, role "tabpanel"
, aria {labelledby : "nav-contact-tab"}
, _id "nav-contact"
]
[ ]
]
]
]
, div [className "col-md-8"]
[ h4 [] [text "Ultrasonic sensors in urban traffic driving-aid systems"]
, ul [className "list-group"]
[ li [className "list-group-item justify-content-between"]
[ span [] [text "Sensors (Basel, switzerland)"]
, span [className "badge badge-default badge-pill"] [text "source"]
]
, li [className "list-group-item justify-content-between"]
[ a [href "http://localhost:2015/#/userPage"] [text "Luciano Alonso, Vicente Milanes, Carlos Torre-Ferarro, Jorge Godoy, Juan P oria, Teresa de pedro"]
, span [className "badge badge-default badge-pill"] [text "authors"]
]
, li [className "list-group-item justify-content-between"]
[ span [] [text "2011-01-11 0.00"]
, span [className "badge badge-default badge-pill"] [text "date"]
]
]
, span [className "badge badge-default badge-pill"] [text "abstract"]
, p [] [text "It is a long established fact that a reader will be distracted by the readable content of a page when looking at its layout. The point of using Lorem Ipsum is that it has a more-or-less normal distribution of letters, as opposed to using 'Content here, content here', making it look like readable English. Many desktop publishing packages and web page editors now use Lorem Ipsum as their default model text, and a search for 'lorem ipsum' will uncover many web sites still in their infancy. Various versions have evolved over the years, sometimes by accident, sometimes on purpose (injected humour and the like)."]
, div [className "jumbotron"]
[ p [] [text "Empty Full Text"]
]
]
]
]
]
aryPS :: Array String
aryPS = ["STOPLIST", "MAINLIST", "MAPLIST"]
aryPS1 :: Array String
aryPS1 = ["Nothing Selected","STOPLIST", "MAINLIST", "MAPLIST"]
optps :: String -> ReactElement
optps val = option [ value val ] [text val]
unsafeEventValue :: forall event. event -> String
unsafeEventValue e = (unsafeCoerce e).target.value
src/Gargantext/Pages/Corpus/Doc/Facets.purs 0 → 100644
View file @ e7ca1d1f
module Gargantext.Pages.Corpus.Doc.Facets
( module Gargantext.Pages.Corpus.Doc.Facets.States
, module Gargantext.Pages.Corpus.Doc.Facets.Actions
, module Gargantext.Pages.Corpus.Doc.Facets.Specs
) where
import Gargantext.Pages.Corpus.Doc.Facets.States
import Gargantext.Pages.Corpus.Doc.Facets.Actions
import Gargantext.Pages.Corpus.Doc.Facets.Specs
src/Gargantext/Pages/Corpus/Tabs/Actions.purs → src/Gargantext/Pages/Corpus/Doc/Facets/Actions.purs
View file @ e7ca1d1f
module Gargantext.Pages.Corpus.Tabs.Actions where module Gargantext.Pages.Corpus.Doc.Facets.Actions where
import Data.Lens (Prism', prism) import Data.Lens (Prism', prism)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Gargantext.Pages.Corpus.Tabs.Documents as DV import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV
import Gargantext.Pages.Corpus.Tabs.Sources as SV import Gargantext.Pages.Corpus.Doc.Facets.Sources as SV
import Gargantext.Pages.Corpus.Tabs.Authors as AV import Gargantext.Pages.Corpus.Doc.Facets.Authors as AV
import Gargantext.Pages.Corpus.Tabs.Terms as TV import Gargantext.Pages.Corpus.Doc.Facets.Terms as TV
import Gargantext.Components.Tab as Tab import Gargantext.Components.Tab as Tab
data Action data Action
...@@ -46,3 +46,6 @@ _tabAction = prism TabViewA \ action -> ...@@ -46,3 +46,6 @@ _tabAction = prism TabViewA \ action ->
case action of case action of
TabViewA laction -> Right laction TabViewA laction -> Right laction
_-> Left action _-> Left action
src/Gargantext/Pages/Corpus/Tabs/Authors.purs → src/Gargantext/Pages/Corpus/Doc/Facets/Authors.purs
View file @ e7ca1d1f
module Gargantext.Pages.Corpus.Tabs.Authors where module Gargantext.Pages.Corpus.Doc.Facets.Authors where
import Data.Array (fold)
import Gargantext.Pages.Corpus.Doc.Facets.Documents as D
import Prelude hiding (div) import Prelude hiding (div)
import React.DOM (h3, text) import React.DOM (h3, text)
import Thermite (PerformAction, Render, Spec, defaultPerformAction, simpleSpec) import Thermite (PerformAction, Render, Spec, defaultPerformAction, simpleSpec)
type State = {} type State = D.State
initialState :: State initialState :: State
initialState = {} initialState = D.tdata
type Action = Void type Action = D.Action
authorSpec :: Spec State {} Action authorSpec :: Spec State {} Action
authorSpec = simpleSpec defaultPerformAction render authorSpec = simpleSpec defaultPerformAction render
...@@ -18,3 +20,6 @@ authorSpec = simpleSpec defaultPerformAction render ...@@ -18,3 +20,6 @@ authorSpec = simpleSpec defaultPerformAction render
render :: Render State {} Action render :: Render State {} Action
render dispatch _ state _ = render dispatch _ state _ =
[ h3 [] [text "AuthorView"]] [ h3 [] [text "AuthorView"]]
authorspec' :: Spec State {} Action
authorspec' = fold [authorSpec, D.layoutDocview]
src/Gargantext/Pages/Corpus/Dashboard.purs → src/Gargantext/Pages/Corpus/Doc/Facets/Dashboard.purs
View file @ e7ca1d1f
module Gargantext.Pages.Corpus.Dashboard where module Gargantext.Pages.Corpus.Doc.Facets.Dashboard where
import Prelude hiding (div) import Prelude hiding (div)
......
src/Gargantext/Pages/Corpus/Graph.purs → src/Gargantext/Pages/Corpus/Doc/Facets/Graph.purs
View file @ e7ca1d1f
module Gargantext.Pages.Corpus.Graph where module Gargantext.Pages.Corpus.Doc.Facets.Graph where
import Prelude hiding (div)
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestHeader (RequestHeader(..))
import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift) import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (decodeJson, stringify)
import Data.Array (length, mapWithIndex, (!!)) import Data.Array (length, mapWithIndex, (!!))
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Int (toNumber) import Data.Int (toNumber)
import Data.Maybe (Maybe(..), fromJust) import Data.Maybe (Maybe(..), fromJust)
import Data.MediaType.Common (applicationJSON)
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Gargantext.Components.GraphExplorer.Sigmajs (Color(Color), SigmaEasing, SigmaGraphData(SigmaGraphData), SigmaNode, SigmaSettings, canvas, edgeShape, edgeShapes, forceAtlas2, sStyle, sigma, sigmaEasing, sigmaEdge, sigmaEnableWebGL, sigmaNode, sigmaSettings)
import Gargantext.Components.GraphExplorer.Types (Cluster(..), Edge(..), GraphData(..), Legend(..), Node(..), getLegendData)
import Gargantext.Utils (getter)
import Math (cos, sin) import Math (cos, sin)
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import React (ReactElement) import React (ReactElement)
...@@ -15,13 +28,6 @@ import React.DOM.Props (_id, _type, checked, className, href, name, onChange, pl ...@@ -15,13 +28,6 @@ import React.DOM.Props (_id, _type, checked, className, href, name, onChange, pl
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec) import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
import Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Prelude
import Gargantext.Config.REST (get)
import Gargantext.Components.GraphExplorer.Sigmajs (Color(Color), SigmaEasing, SigmaGraphData(SigmaGraphData), SigmaNode, SigmaSettings, canvas, edgeShape, edgeShapes, forceAtlas2, sStyle, sigma, sigmaEasing, sigmaEdge, sigmaEnableWebGL, sigmaNode, sigmaSettings)
import Gargantext.Components.GraphExplorer.Types (Cluster(..), Edge(..), GraphData(..), Legend(..), Node(..), getLegendData)
import Gargantext.Utils (getter)
data Action data Action
= LoadGraph String = LoadGraph String
| SelectNode SelectedNode | SelectNode SelectedNode
...@@ -53,16 +59,18 @@ graphSpec = simpleSpec performAction render ...@@ -53,16 +59,18 @@ graphSpec = simpleSpec performAction render
performAction :: PerformAction State {} Action performAction :: PerformAction State {} Action
performAction (LoadGraph fp) _ _ = void do performAction (LoadGraph fp) _ _ = void do
_ <- logs fp _ <- liftEffect $ log fp
case fp of case fp of
"" -> do "" -> do
modifyState \(State s) -> State s {filePath = fp, graphData = GraphData {nodes : [], edges : []}, sigmaGraphData = Nothing} modifyState \(State s) -> State s {filePath = fp, graphData = GraphData {nodes : [], edges : []}, sigmaGraphData = Nothing}
_ -> do _ -> do
_ <- modifyState \(State s) -> State s {filePath = fp, sigmaGraphData = Nothing} _ <- modifyState \(State s) -> State s {filePath = fp, sigmaGraphData = Nothing}
gd <- lift $ getGraphData fp gd <- lift $ getGraphData fp
-- TODO: here one might `catchError getGraphData` to visually empty the case gd of
-- graph. Left err -> do
modifyState \(State s) -> State s {filePath = fp, graphData = gd, sigmaGraphData = Just $ convert gd, legendData = getLegendData gd} modifyState \(State s) -> State s {filePath = fp, graphData = GraphData {nodes : [], edges : []}}
Right gd' -> do
modifyState \(State s) -> State s {filePath = fp, graphData = gd', sigmaGraphData = Just $ convert gd', legendData = getLegendData gd'}
performAction (SelectNode node) _ _ = void do performAction (SelectNode node) _ _ = void do
modifyState $ \(State s) -> State s {selectedNode = pure node} modifyState $ \(State s) -> State s {selectedNode = pure node}
...@@ -109,7 +117,7 @@ render d p (State s) c = ...@@ -109,7 +117,7 @@ render d p (State s) c =
, settings : mySettings , settings : mySettings
, style : sStyle { height : "95%"} , style : sStyle { height : "95%"}
-- , onClickNode : \e -> do -- , onClickNode : \e -> do
-- logs $ unsafeCoerce e -- log $ unsafeCoerce e
-- d $ SelectNode $ SelectedNode {id : (unsafeCoerce e).data.node.id, label : (unsafeCoerce e).data.node.label} -- d $ SelectNode $ SelectedNode {id : (unsafeCoerce e).data.node.id, label : (unsafeCoerce e).data.node.label}
-- pure unit -- pure unit
-- TODO: fix this! -- TODO: fix this!
...@@ -213,8 +221,27 @@ mySettings = sigmaSettings { verbose : true ...@@ -213,8 +221,27 @@ mySettings = sigmaSettings { verbose : true
-- loadJSON {path : "http://localhost:2015/examples/sites_coords.json"} -- loadJSON {path : "http://localhost:2015/examples/sites_coords.json"}
getGraphData :: String -> Aff GraphData getGraphData :: String -> Aff (Either String GraphData)
getGraphData fp = get $ "http://localhost:2015/examples/" <> fp getGraphData fp = do
resp <- request defaultRequest
{ url =("http://localhost:2015/examples/" <> fp)
, method = Left GET
, responseFormat = ResponseFormat.json
, headers =
[ ContentType applicationJSON
, Accept applicationJSON
]
}
case resp.body of
Left err -> do
liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
liftEffect $ log $ stringify json
let gd = decodeJson json
pure gd
defaultPalette :: Array Color defaultPalette :: Array Color
defaultPalette = map Color defaultPalette' defaultPalette = map Color defaultPalette'
...@@ -365,7 +392,7 @@ specOld = simpleSpec performAction render' ...@@ -365,7 +392,7 @@ specOld = simpleSpec performAction render'
, settings : mySettings , settings : mySettings
, style : sStyle { height : "95%"} , style : sStyle { height : "95%"}
-- , onClickNode : \e -> do -- , onClickNode : \e -> do
-- logs $ unsafeCoerce e -- log $ unsafeCoerce e
-- d $ SelectNode $ SelectedNode {id : (unsafeCoerce e).data.node.id, label : (unsafeCoerce e).data.node.label} -- d $ SelectNode $ SelectedNode {id : (unsafeCoerce e).data.node.id, label : (unsafeCoerce e).data.node.label}
-- pure unit -- pure unit
} }
......
src/Gargantext/Pages/Corpus/Tabs/Sources.purs → src/Gargantext/Pages/Corpus/Doc/Facets/Sources.purs
View file @ e7ca1d1f
module Gargantext.Pages.Corpus.Tabs.Sources where module Gargantext.Pages.Corpus.Doc.Facets.Sources where
import Data.Array (fold)
import Gargantext.Pages.Corpus.Doc.Facets.Documents as D
import Prelude hiding (div) import Prelude hiding (div)
import React.DOM (h3, text) import React.DOM (h3, text)
import Thermite (Render, Spec, defaultPerformAction, simpleSpec) import Thermite (Render, Spec, defaultPerformAction, simpleSpec)
type State = {} type State = D.State
initialState :: State
initialState = {}
type Action = Void initialState :: D.State
initialState = D.tdata
type Action = D.Action
sourceSpec :: Spec State {} Action sourceSpec :: Spec State {} Action
sourceSpec = simpleSpec defaultPerformAction render sourceSpec = simpleSpec defaultPerformAction render
...@@ -18,3 +22,6 @@ sourceSpec = simpleSpec defaultPerformAction render ...@@ -18,3 +22,6 @@ sourceSpec = simpleSpec defaultPerformAction render
render :: Render State {} Action render :: Render State {} Action
render dispatch _ state _ = render dispatch _ state _ =
[ h3 [] [text "Source view"]] [ h3 [] [text "Source view"]]
sourcespec' :: Spec State {} Action
sourcespec' = fold [sourceSpec, D.layoutDocview]
src/Gargantext/Pages/Corpus/Doc/Facets/Specs.purs 0 → 100644
View file @ e7ca1d1f
module Gargantext.Pages.Corpus.Doc.Facets.Specs where
import Prelude hiding (div)
import Data.List (fromFoldable)
import Data.Tuple (Tuple(..))
import Gargantext.Pages.Corpus.Doc.Facets.States (State(), _doclens, _sourcelens, _authorlens, _termslens, _tablens, initialState)
import Gargantext.Pages.Corpus.Doc.Facets.Actions (Action(), _docAction, _sourceAction, _authorAction, _termsAction, _tabAction)
import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV
import Gargantext.Pages.Corpus.Doc.Facets.Sources as SV
import Gargantext.Pages.Corpus.Doc.Facets.Authors as AV
import Gargantext.Pages.Corpus.Doc.Facets.Terms as TV
import Gargantext.Components.Tab as Tab
import Thermite (Spec, focus, hide)
pureTab1 :: Spec {} {} Void
pureTab1 = hide initialState statefulTab1
statefulTab1 :: Spec State {} Action
statefulTab1 =
Tab.tabs _tablens _tabAction $ fromFoldable [ Tuple "Doc View" docPageSpec
, Tuple "Author View" authorPageSpec
, Tuple "Source View" sourcePageSpec
, Tuple "Terms View" termsPageSpec
]
docPageSpec :: Spec State {} Action
docPageSpec = focus _doclens _docAction DV.layoutDocview
authorPageSpec :: Spec State {} Action
authorPageSpec = focus _authorlens _authorAction AV.authorspec'
sourcePageSpec :: Spec State {} Action
sourcePageSpec = focus _sourcelens _sourceAction SV.sourcespec'
termsPageSpec :: Spec State {} Action
termsPageSpec = focus _termslens _termsAction TV.termSpec'
src/Gargantext/Pages/Corpus/Doc/Facets/States.purs 0 → 100644
View file @ e7ca1d1f
module Gargantext.Pages.Corpus.Doc.Facets.States where
import Data.Lens (Lens', lens)
import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV
import Gargantext.Pages.Corpus.Doc.Facets.Sources as SV
import Gargantext.Pages.Corpus.Doc.Facets.Authors as AV
import Gargantext.Pages.Corpus.Doc.Facets.Terms as TV
import Gargantext.Components.Tab as Tab
type State =
{ docview :: DV.State
, authorview :: AV.State
, sourceview :: SV.State
, termsview :: TV.State
, activeTab :: Int
}
initialState :: State
initialState =
{ docview : DV.tdata
, authorview : AV.initialState
, sourceview : SV.initialState
, termsview : TV.initialState
, activeTab : 0
}
_doclens :: Lens' State DV.State
_doclens = lens (\s -> s.docview) (\s ss -> s {docview = ss})
_authorlens :: Lens' State AV.State
_authorlens = lens (\s -> s.authorview) (\s ss -> s {authorview = ss})
_sourcelens :: Lens' State SV.State
_sourcelens = lens (\s -> s.sourceview) (\s ss -> s {sourceview = ss})
_termslens :: Lens' State TV.State
_termslens = lens (\s -> s.termsview) (\s ss -> s {termsview = ss})
_tablens :: Lens' State Tab.State
_tablens = lens (\s -> s.activeTab) (\s ss -> s {activeTab = ss})
src/Gargantext/Pages/Corpus/Tabs/Terms.purs → src/Gargantext/Pages/Corpus/Doc/Facets/Terms.purs
View file @ e7ca1d1f
module Gargantext.Pages.Corpus.Tabs.Terms where module Gargantext.Pages.Corpus.Doc.Facets.Terms where
import Data.Array (fold) import Data.Array (fold)
import Gargantext.Pages.Corpus.Doc.Facets.Documents as D
import Prelude hiding (div) import Prelude hiding (div)
import React.DOM (h3, text) import React.DOM (h3, text)
import Thermite (PerformAction, Render, Spec, defaultPerformAction, simpleSpec) import Thermite (PerformAction, Render, Spec, defaultPerformAction, simpleSpec)
type State = {}
initialState :: State type State = D.State
initialState = {}
initialState :: D.State
initialState = D.tdata
type Action = D.Action
type Action = Void
termsSpec :: Spec State {} Action termsSpec :: Spec State {} Action
termsSpec = simpleSpec defaultPerformAction render termsSpec = simpleSpec defaultPerformAction render
...@@ -19,3 +23,6 @@ termsSpec = simpleSpec defaultPerformAction render ...@@ -19,3 +23,6 @@ termsSpec = simpleSpec defaultPerformAction render
render :: Render State {} Action render :: Render State {} Action
render dispatch _ state _ = render dispatch _ state _ =
[ h3 [] [text "Terms view"]] [ h3 [] [text "Terms view"]]
termSpec' :: Spec State {} Action
termSpec' = fold [termsSpec, D.layoutDocview]
src/Gargantext/Pages/Corpus/Tabs/Terms/NgramsItem.purs → src/Gargantext/Pages/Corpus/Doc/Facets/Terms/NgramsItem.purs
View file @ e7ca1d1f
module Gargantext.Pages.Corpus.Tabs.Terms.NgramsItem where module Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsItem where
import Prelude import Prelude
...@@ -8,7 +8,7 @@ import Data.Lens.Iso.Newtype (_Newtype) ...@@ -8,7 +8,7 @@ import Data.Lens.Iso.Newtype (_Newtype)
import React (ReactElement) import React (ReactElement)
import React.DOM (input, span, td, text, tr) import React.DOM (input, span, td, text, tr)
import React.DOM.Props (_type, checked, className, onChange, style, title) import React.DOM.Props (_type, checked, className, onChange, style, title)
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec, hideState, focusState) import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec, hide, focusState)
import Gargantext.Utils (getter, setter) import Gargantext.Utils (getter, setter)
newtype State = State newtype State = State
...@@ -37,18 +37,18 @@ data Action ...@@ -37,18 +37,18 @@ data Action
= SetMap Boolean = SetMap Boolean
| SetStop Boolean | SetStop Boolean
ngramsItemSpec :: Spec {} {} Void performAction :: PerformAction State {} Action
ngramsItemSpec = hideState (unwrap initialState) $ performAction (SetMap b) _ _ = void do
focusState (re _Newtype) $
simpleSpec performAction render
where
performAction :: PerformAction State {} Action
performAction (SetMap b) _ _ = void do
modifyState \(State s) -> State s {term = setter (_{_type = (if b then MapTerm else None)}) s.term} modifyState \(State s) -> State s {term = setter (_{_type = (if b then MapTerm else None)}) s.term}
performAction (SetStop b) _ _ = void do performAction (SetStop b) _ _ = void do
modifyState \(State s) -> State s {term = setter (_{_type = (if b then StopTerm else None)}) s.term} modifyState \(State s) -> State s {term = setter (_{_type = (if b then StopTerm else None)}) s.term}
ngramsItemSpec :: Spec {} {} Void
ngramsItemSpec = hide (unwrap initialState) $
focusState (re _Newtype) $
simpleSpec performAction render
where
render :: Render State {} Action render :: Render State {} Action
render dispatch _ (State state) _ = render dispatch _ (State state) _ =
[ [
......
src/Gargantext/Pages/Corpus/Tabs/Terms/NgramsTable.purs → src/Gargantext/Pages/Corpus/Doc/Facets/Terms/NgramsTable.purs
View file @ e7ca1d1f
module Gargantext.Pages.Corpus.Tabs.Terms.NgramsTable where module Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsTable where
import Data.Array (filter, toUnfoldable) import Data.Array (filter, toUnfoldable)
...@@ -12,12 +12,12 @@ import Data.Tuple (Tuple(..), uncurry) ...@@ -12,12 +12,12 @@ import Data.Tuple (Tuple(..), uncurry)
import Data.Void (Void) import Data.Void (Void)
import Data.Unit (Unit) import Data.Unit (Unit)
import Effect (Effect) import Effect (Effect)
import Gargantext.Pages.Corpus.Tabs.Terms.NgramsItem as NI import Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsItem as NI
import Prelude (class Eq, class Ord, class Show, map, show, void, ($), (*), (+), (-), (/), (<), (<>), (==), (>), (>=), pure, unit) import Prelude (class Eq, class Ord, class Show, map, show, void, ($), (*), (+), (-), (/), (<), (<>), (==), (>), (>=), pure, unit)
import React (ReactElement) import React (ReactElement)
import React.DOM hiding (style, map) import React.DOM hiding (style, map)
import React.DOM.Props (_id, _type, className, href, name, onChange, onClick, onInput, placeholder, scope, selected, style, value) import React.DOM.Props (_id, _type, className, href, name, onChange, onClick, onInput, placeholder, scope, selected, style, value)
import Thermite (PerformAction, Spec, _render, focus, foreach, modifyState, focusState, hideState) import Thermite (PerformAction, Spec, _render, focus, foreach, modifyState, focusState, hide)
import Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
newtype State = State newtype State = State
...@@ -60,7 +60,6 @@ _ItemAction = prism (uncurry ItemAction) \ta -> ...@@ -60,7 +60,6 @@ _ItemAction = prism (uncurry ItemAction) \ta ->
type Dispatch = Action -> Effect Unit type Dispatch = Action -> Effect Unit
{-
performAction :: PerformAction State {} Action performAction :: PerformAction State {} Action
performAction (ChangePageSize ps) _ _ = void $ modifyState $ changePageSize ps performAction (ChangePageSize ps) _ _ = void $ modifyState $ changePageSize ps
...@@ -78,7 +77,6 @@ performAction (SetInput s) _ _ = void do ...@@ -78,7 +77,6 @@ performAction (SetInput s) _ _ = void do
modifyState \(State state) -> State $ state { search = s } modifyState \(State state) -> State $ state { search = s }
performAction _ _ _ = pure unit performAction _ _ _ = pure unit
-}
tableSpec :: Spec State {} Action -> Spec State {} Action tableSpec :: Spec State {} Action -> Spec State {} Action
tableSpec = over _render \render dispatch p (State s) c -> tableSpec = over _render \render dispatch p (State s) c ->
...@@ -159,7 +157,7 @@ tableSpec = over _render \render dispatch p (State s) c -> ...@@ -159,7 +157,7 @@ tableSpec = over _render \render dispatch p (State s) c ->
ngramsTableSpec :: Spec {} {} Void ngramsTableSpec :: Spec {} {} Void
ngramsTableSpec = ngramsTableSpec =
hideState (unwrap initialState) $ hide (unwrap initialState) $
focusState (re _Newtype) $ focusState (re _Newtype) $
container $ container $
tableSpec $ tableSpec $
...@@ -316,8 +314,8 @@ pagination d tp cp ...@@ -316,8 +314,8 @@ pagination d tp cp
text " ... " text " ... "
else else
text "" text ""
lnums = map (\i -> fnmid d i) $ filter (1 < _) [cp - 2, cp - 1] lnums = map (\i -> fnmid d i) $ filter (lessthan 1) [cp - 2, cp - 1]
rnums = map (\i -> fnmid d i) $ filter (tp > _) [cp + 1, cp + 2] rnums = map (\i -> fnmid d i) $ filter (greaterthan tp) [cp + 1, cp + 2]
fnmid :: Dispatch -> Int -> ReactElement fnmid :: Dispatch -> Int -> ReactElement
fnmid d i fnmid d i
...@@ -328,3 +326,10 @@ fnmid d i ...@@ -328,3 +326,10 @@ fnmid d i
] [text $ show i] ] [text $ show i]
, text " " , text " "
] ]
lessthan :: forall t28. Ord t28 => t28 -> t28 -> Boolean
lessthan x y = x < y
greaterthan :: forall t28. Ord t28 => t28 -> t28 -> Boolean
greaterthan x y = x > y
src/Gargantext/Pages/Corpus/Document.purs deleted 100644 → 0
View file @ 390aa390
This diff is collapsed.
src/Gargantext/Pages/Corpus/Tabs.purs deleted 100644 → 0
View file @ 390aa390
module Gargantext.Pages.Corpus.Tabs
( module Gargantext.Pages.Corpus.Tabs.States
, module Gargantext.Pages.Corpus.Tabs.Actions
, module Gargantext.Pages.Corpus.Tabs.Specs
) where
import Gargantext.Pages.Corpus.Tabs.States
import Gargantext.Pages.Corpus.Tabs.Actions
import Gargantext.Pages.Corpus.Tabs.Specs
src/Gargantext/Pages/Corpus/Tabs/Specs.purs deleted 100644 → 0
View file @ 390aa390
module Gargantext.Pages.Corpus.Tabs.Specs where
import Prelude hiding (div)
import Data.List (fromFoldable)
import Data.Tuple (Tuple(..))
import Gargantext.Pages.Corpus.Tabs.Types (Props)
import Gargantext.Pages.Corpus.Tabs.States (State(), _doclens, _sourcelens, _authorlens, _termslens, _tablens, initialState)
import Gargantext.Pages.Corpus.Tabs.Actions (Action(), _docAction, _sourceAction, _authorAction, _termsAction, _tabAction)
import Gargantext.Pages.Corpus.Tabs.Documents as DV
import Gargantext.Pages.Corpus.Tabs.Sources as SV
import Gargantext.Pages.Corpus.Tabs.Authors as AV
import Gargantext.Pages.Corpus.Tabs.Terms as TV
import Gargantext.Components.Tab as Tab
import Thermite (Spec, focus, hideState, cmapProps)
pureTabs :: Spec {} Props Void
pureTabs = hideState initialState statefulTabs
statefulTabs :: Spec State Props Action
statefulTabs =
Tab.tabs _tablens _tabAction $ fromFoldable [ Tuple "Documents" docPageSpec
, Tuple "Authors" authorPageSpec
, Tuple "Sources" sourcePageSpec
, Tuple "Terms" termsPageSpec
]
docPageSpec :: Spec State Props Action
docPageSpec = focus _doclens _docAction DV.layoutDocview
authorPageSpec :: Spec State Props Action
authorPageSpec = cmapProps (const {}) (focus _authorlens _authorAction AV.authorSpec)
<> docPageSpec
sourcePageSpec :: Spec State Props Action
sourcePageSpec = cmapProps (const {}) (focus _sourcelens _sourceAction SV.sourceSpec)
<> docPageSpec
termsPageSpec :: Spec State Props Action
termsPageSpec = cmapProps (const {}) (focus _termslens _termsAction TV.termsSpec)
<> docPageSpec
src/Gargantext/Pages/Corpus/Tabs/States.purs deleted 100644 → 0
View file @ 390aa390
module Gargantext.Pages.Corpus.Tabs.States where
import Data.Lens (Lens', lens)
import Gargantext.Pages.Corpus.Tabs.Documents as D
import Gargantext.Pages.Corpus.Tabs.Sources as S
import Gargantext.Pages.Corpus.Tabs.Authors as A
import Gargantext.Pages.Corpus.Tabs.Terms as T
import Gargantext.Components.Tab as Tab
type State =
{ docsView :: D.State
, authorsView :: A.State
, sourcesView :: S.State
, termsView :: T.State
, activeTab :: Int
}
initialState :: State
initialState =
{ docsView : D.initialState
, authorsView : A.initialState
, sourcesView : S.initialState
, termsView : T.initialState
, activeTab : 0
}
_doclens :: Lens' State D.State
_doclens = lens (\s -> s.docsView) (\s ss -> s {docsView = ss})
_authorlens :: Lens' State A.State
_authorlens = lens (\s -> s.authorsView) (\s ss -> s {authorsView = ss})
_sourcelens :: Lens' State S.State
_sourcelens = lens (\s -> s.sourcesView) (\s ss -> s {sourcesView = ss})
_termslens :: Lens' State T.State
_termslens = lens (\s -> s.termsView) (\s ss -> s {termsView = ss})
_tablens :: Lens' State Tab.State
_tablens = lens (\s -> s.activeTab) (\s ss -> s {activeTab = ss})
src/Gargantext/Pages/Corpus/Tabs/Types.purs deleted 100644 → 0
View file @ 390aa390
module Gargantext.Pages.Corpus.Tabs.Types where
import Data.Argonaut (class DecodeJson, decodeJson, (.?), (.??))
import Data.Maybe (Maybe(..))
--------------------------------------------------------
import Gargantext.Prelude
import Gargantext.Components.Node (NodePoly(..))
newtype CorpusInfo = CorpusInfo { title :: String
, desc :: String
, query :: String
, authors :: String
, chart :: (Maybe (Array Number))
, totalRecords :: Int
}
corpusInfoDefault :: NodePoly CorpusInfo
corpusInfoDefault = NodePoly { id : 0
, typename : 0
, userId : 0
, parentId : 0
, name : "Default name"
, date : " Default date"
, hyperdata : CorpusInfo
{ title : "Default title"
, desc : " Default desc"
, query : " Default Query"
, authors : " Author(s): default"
, chart : Nothing
, totalRecords : 0
}
}
instance decodeCorpusInfo :: DecodeJson CorpusInfo where
decodeJson json = do
obj <- decodeJson json
title <- obj .? "title"
desc <- obj .? "desc"
query <- obj .? "query"
authors <- obj .? "authors"
chart <- obj .?? "chart"
let totalRecords = 47361 -- TODO
pure $ CorpusInfo {title, desc, query, authors, chart, totalRecords}
-- TODO type Props = {nodeId :: Int, info :: Maybe (NodePoly CorpusInfo) }
type Props = {path :: Int, loaded :: Maybe (NodePoly CorpusInfo) }
-- TODO include Gargantext.Pages.Corpus.Tabs.States
-- TODO include Gargantext.Pages.Corpus.Tabs.Actions
src/Gargantext/Pages/Home/Specs.purs
View file @ e7ca1d1f
...@@ -16,7 +16,7 @@ import Gargantext.Pages.Home.Actions (Action, performAction) ...@@ -16,7 +16,7 @@ import Gargantext.Pages.Home.Actions (Action, performAction)
import React (ReactElement) import React (ReactElement)
import React.DOM (a, div, h3, i, img, p, span, text) import React.DOM (a, div, h3, i, img, p, span, text)
import React.DOM.Props (Props, _id, aria, className, href, src, target, title) import React.DOM.Props (Props, _id, aria, className, href, src, target, title)
import Thermite (Render, Spec, simpleSpec, hideState, focusState) import Thermite (Render, Spec, simpleSpec, hide, focusState)
-- Layout | -- Layout |
...@@ -26,7 +26,7 @@ landingData FR = Fr.landingData ...@@ -26,7 +26,7 @@ landingData FR = Fr.landingData
landingData EN = En.landingData landingData EN = En.landingData
layoutLanding :: Lang -> Spec {} {} Void layoutLanding :: Lang -> Spec {} {} Void
layoutLanding = hideState (unwrap initialState) layoutLanding = hide (unwrap initialState)
<<< focusState (re _Newtype) <<< focusState (re _Newtype)
<<< layoutLanding' <<< landingData <<< layoutLanding' <<< landingData
......
src/Gargantext/Pages/Layout.purs
View file @ e7ca1d1f
...@@ -4,11 +4,13 @@ import Prelude hiding (div) ...@@ -4,11 +4,13 @@ import Prelude hiding (div)
-- import Gargantext.Components.Login as LN -- import Gargantext.Components.Login as LN
import Gargantext.Pages.Layout.Actions (Action(..)) import Gargantext.Pages.Layout.Actions (Action(..))
import Gargantext.Pages.Layout.Specs.AddCorpus as AC import Gargantext.Pages.Layout.Specs.AddCorpus as AC
-- import Gargantext.Pages.Corpus.Tabs as TV -- import Gargantext.Pages.Corpus.Doc.Facets as TV
-- import Gargantext.Pages.Corpus.Doc.Annotation as D
import Gargantext.Pages.Corpus.Document as Document import Gargantext.Pages.Corpus as Corpus
import Gargantext.Pages.Corpus.Graph as GE import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV
-- import Gargantext.Pages.Corpus.Tabs.Terms.NgramsTable as NG import Gargantext.Pages.Corpus.Doc.Facets.Graph as GE
-- import Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsTable as NG
import Gargantext.Pages.Annuaire.User.Contacts as C import Gargantext.Pages.Annuaire.User.Contacts as C
import Gargantext.Pages.Annuaire as Annuaire import Gargantext.Pages.Annuaire as Annuaire
...@@ -34,8 +36,13 @@ dispatchAction dispatcher _ AddCorpus = do ...@@ -34,8 +36,13 @@ dispatchAction dispatcher _ AddCorpus = do
dispatcher $ SetRoute AddCorpus dispatcher $ SetRoute AddCorpus
dispatcher $ AddCorpusA AC.LoadDatabaseDetails dispatcher $ AddCorpusA AC.LoadDatabaseDetails
dispatchAction dispatcher _ (DocView n) = do
dispatcher $ SetRoute (DocView n)
dispatcher $ DocViewA $ DV.LoadData n
dispatchAction dispatcher _ (Corpus n) = do dispatchAction dispatcher _ (Corpus n) = do
dispatcher $ SetRoute $ Corpus n dispatcher $ SetRoute $ Corpus n
dispatcher $ CorpusAction $ Corpus.Load n
dispatchAction dispatcher _ SearchView = do dispatchAction dispatcher _ SearchView = do
dispatcher $ SetRoute SearchView dispatcher $ SetRoute SearchView
...@@ -53,9 +60,13 @@ dispatchAction dispatcher _ (Annuaire id) = do ...@@ -53,9 +60,13 @@ dispatchAction dispatcher _ (Annuaire id) = do
dispatchAction dispatcher _ (Folder id) = do dispatchAction dispatcher _ (Folder id) = do
dispatcher $ SetRoute $ Folder id dispatcher $ SetRoute $ Folder id
dispatchAction dispatcher _ (Document n) = do dispatchAction dispatcher _ (DocAnnotation i) = do
dispatcher $ SetRoute $ Document n dispatcher $ SetRoute $ DocAnnotation i
dispatcher $ DocumentViewA $ Document.Load n -- dispatcher $ DocAnnotationViewA TODO
dispatchAction dispatcher _ Tabview = do
dispatcher $ SetRoute Tabview
-- dispatcher $ TabViewA TODO
dispatchAction dispatcher _ PGraphExplorer = do dispatchAction dispatcher _ PGraphExplorer = do
dispatcher $ SetRoute PGraphExplorer dispatcher $ SetRoute PGraphExplorer
......
src/Gargantext/Pages/Layout/Actions.purs
View file @ e7ca1d1f
...@@ -2,24 +2,28 @@ ...@@ -2,24 +2,28 @@
module Gargantext.Pages.Layout.Actions where module Gargantext.Pages.Layout.Actions where
import Prelude hiding (div)
import Control.Monad.Cont.Trans (lift) import Control.Monad.Cont.Trans (lift)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Lens (Prism', prism) import Data.Lens (Prism', prism)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Thermite (PerformAction, modifyState) 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.Annuaire as Annuaire
import Gargantext.Pages.Corpus as Corpus
import Gargantext.Pages.Corpus.Doc.Annotation as D
import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV
import Gargantext.Pages.Corpus.Doc.Facets.Graph as GE
import Gargantext.Pages.Annuaire.User.Contacts as C import Gargantext.Pages.Annuaire.User.Contacts as C
import Gargantext.Pages.Corpus.Document as D import Gargantext.Pages.Annuaire as Annuaire
import Gargantext.Pages.Corpus.Graph as GE
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)
import Gargantext.Prelude
import Gargantext.Router (Routes) import Gargantext.Router (Routes)
import Thermite (PerformAction, modifyState)
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -27,12 +31,14 @@ data Action ...@@ -27,12 +31,14 @@ data Action
= Initialize = Initialize
| LoginA LN.Action | LoginA LN.Action
| SetRoute Routes | SetRoute Routes
| TreeViewA Tree.Action | AddCorpusA AC.Action
| DocViewA DV.Action
| SearchA S.Action | SearchA S.Action
| Search String | Search String
| AddCorpusA AC.Action | TreeViewA Tree.Action
| CorpusAction Corpus.Action
| GraphExplorerA GE.Action | GraphExplorerA GE.Action
| DocumentViewA D.Action | DocAnnotationViewA D.Action
| AnnuaireAction Annuaire.Action | AnnuaireAction Annuaire.Action
| UserPageA C.Action | UserPageA C.Action
| Go | Go
...@@ -64,19 +70,40 @@ performAction Go _ _ = void do ...@@ -64,19 +70,40 @@ performAction Go _ _ = void do
--------------------------------------------------------- ---------------------------------------------------------
performAction Initialize _ state = void do performAction Initialize _ state = void do
_ <- logs "loading Initial nodes" _ <- liftEffect $ log "loading Initial nodes"
case state.initialized of case state.initialized of
false -> do false -> do
lnodes <- lift $ Tree.loadDefaultNode lnodes <- lift $ Tree.loadDefaultNode
void $ modifyState $ _ { initialized = true, ntreeState = lnodes } case lnodes of
Left err -> do
pure unit
Right d -> do
_ <- modifyState $ _ { initialized = true, ntreeState = d}
pure unit
-- page <- lift $ DV.loadPage
-- case page of
-- Left err -> do
-- pure unit
-- Right docs -> void do
-- modifyState $ _ { initialized = true
-- , ntreeState = d
-- -- if length d > 0
-- -- then Tree.exampleTree
-- -- --then fnTransform $ unsafePartial $ fromJust $ head d
-- -- else Tree.initialState
--
-- , docViewState = docs
-- }
_ -> do _ -> do
pure unit pure unit
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 (SearchA _) _ _ = pure unit performAction (SearchA _) _ _ = pure unit
performAction (UserPageA _) _ _ = pure unit performAction (UserPageA _) _ _ = pure unit
performAction (DocumentViewA _) _ _ = pure unit performAction (DocAnnotationViewA _) _ _ = pure unit
performAction (TreeViewA _) _ _ = pure unit performAction (TreeViewA _) _ _ = pure unit
performAction (GraphExplorerA _) _ _ = pure unit performAction (GraphExplorerA _) _ _ = pure unit
performAction (AnnuaireAction _) _ _ = pure unit performAction (AnnuaireAction _) _ _ = pure unit
...@@ -95,6 +122,18 @@ _addCorpusAction = prism AddCorpusA \action -> ...@@ -95,6 +122,18 @@ _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 DocViewA \action ->
case action of
DocViewA caction -> Right caction
_-> Left action
_searchAction :: Prism' Action S.Action _searchAction :: Prism' Action S.Action
_searchAction = prism SearchA \action -> _searchAction = prism SearchA \action ->
case action of case action of
...@@ -113,10 +152,10 @@ _annuaireAction = prism AnnuaireAction \action -> ...@@ -113,10 +152,10 @@ _annuaireAction = prism AnnuaireAction \action ->
AnnuaireAction a -> Right a AnnuaireAction a -> Right a
_ -> Left action _ -> Left action
_documentViewAction :: Prism' Action D.Action _docAnnotationViewAction :: Prism' Action D.Action
_documentViewAction = prism DocumentViewA \action -> _docAnnotationViewAction = prism DocAnnotationViewA \action ->
case action of case action of
DocumentViewA caction -> Right caction DocAnnotationViewA caction -> Right caction
_-> Left action _-> Left action
_treeAction :: Prism' Action Tree.Action _treeAction :: Prism' Action Tree.Action
......
src/Gargantext/Pages/Layout/Specs.purs
View file @ e7ca1d1f
module Gargantext.Pages.Layout.Specs where module Gargantext.Pages.Layout.Specs where
import Prelude hiding (div)
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 Effect (Effect) import Effect (Effect)
import React (ReactElement)
import React.DOM (a, button, div, footer, hr', img, input, li, p, span, text, ul)
import React.DOM.Props (_data, _id, _type, aria, className, href, onChange, onClick, placeholder, role, src, style, tabIndex, target, title)
import Thermite (Render, Spec, _render, defaultPerformAction, defaultRender, focus, simpleSpec, withState, noState, cmapProps)
import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Prelude
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.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.Folder as F
import Gargantext.Pages.Corpus as Corpus import Gargantext.Pages.Corpus as Corpus
import Gargantext.Pages.Corpus.Document as Annotation import Gargantext.Pages.Corpus.Doc.Annotation as Annotation
import Gargantext.Pages.Corpus.Dashboard as Dsh import Gargantext.Pages.Corpus.Doc.Facets as TV
import Gargantext.Pages.Corpus.Graph as GE import Gargantext.Pages.Corpus.Doc.Facets.Dashboard as Dsh
import Gargantext.Pages.Corpus.Tabs.Terms.NgramsTable as NG import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV
import Gargantext.Pages.Corpus.Doc.Facets.Graph as GE
import Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsTable as NG
import Gargantext.Pages.Annuaire.User.Contacts as C
import Gargantext.Pages.Home as L import Gargantext.Pages.Home as L
import Gargantext.Pages.Layout.Actions (Action(..), _addCorpusAction, _documentViewAction, _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, _documentViewState, _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.DOM (a, button, div, footer, hr', img, input, li, p, span, text, ul)
import React.DOM.Props (_data, _id, _type, aria, className, href, onChange, onClick, placeholder, role, src, style, tabIndex, target, title)
import Thermite (Render, Spec, _render, defaultPerformAction, defaultRender, focus, simpleSpec, withState, noState)
import Unsafe.Coerce (unsafeCoerce)
layoutSpec :: Spec AppState {} Action layoutSpec :: Spec AppState {} Action
layoutSpec = layoutSpec =
...@@ -46,26 +48,28 @@ layoutSpec = ...@@ -46,26 +48,28 @@ layoutSpec =
(render d p s c) (render d p s c)
pagesComponent :: AppState -> Spec AppState {} Action pagesComponent :: AppState -> Spec AppState {} Action
pagesComponent s = case s.currentRoute of pagesComponent s =
case s.currentRoute of
Just route -> selectSpec route Just route -> selectSpec route
Nothing -> selectSpec Home -- TODO add Error page here: url requested does not exist (with funny Garg image) Nothing -> selectSpec Home
where where
selectSpec :: Routes -> Spec AppState {} Action selectSpec :: Routes -> Spec AppState {} Action
selectSpec Home = layout0 $ noState (L.layoutLanding EN) selectSpec (Corpus i) = layout0 $ focus _corpusState _corpusAction Corpus.layout
selectSpec Login = focus _loginState _loginAction LN.renderSpec selectSpec Login = focus _loginState _loginAction LN.renderSpec
selectSpec (Folder i) = layout0 $ noState F.layoutFolder selectSpec Home = layout0 $ noState (L.layoutLanding EN)
selectSpec (Corpus i) = layout0 $ cmapProps (const {nodeId: i}) $ noState Corpus.layout
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 (UserPage i) = layout0 $ focus _userPageState _userPageAction C.layoutUser
selectSpec (DocAnnotation i) = layout0 $ focus _docAnnotationViewState
_docAnnotationViewAction Annotation.docview
-- 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 (Document i) = layout0 $ focus _documentViewState _documentViewAction Annotation.docview selectSpec NGramsTable = layout0 $ noState NG.ngramsTableSpec
selectSpec PGraphExplorer = focus _graphExplorerState _graphExplorerAction GE.specOld selectSpec PGraphExplorer = focus _graphExplorerState _graphExplorerAction GE.specOld
selectSpec Dashboard = layout0 $ noState Dsh.layoutDashboard selectSpec Dashboard = layout0 $ noState Dsh.layoutDashboard
selectSpec (Annuaire i) = layout0 $ focus _annuaireState _annuaireAction A.layoutAnnuaire selectSpec (Annuaire i) = layout0 $ focus _annuaireState _annuaireAction A.layoutAnnuaire
selectSpec (UserPage i) = layout0 $ focus _userPageState _userPageAction C.layoutUser selectSpec (Folder i) = layout0 $ noState F.layoutFolder
-- To be removed
selectSpec NGramsTable = layout0 $ noState NG.ngramsTableSpec
-- selectSpec _ = simpleSpec defaultPerformAction defaultRender -- selectSpec _ = simpleSpec defaultPerformAction defaultRender
......
src/Gargantext/Pages/Layout/Specs/AddCorpus/Actions.purs
View file @ e7ca1d1f
module Gargantext.Pages.Layout.Specs.AddCorpus.Actions where module Gargantext.Pages.Layout.Specs.AddCorpus.Actions where
import Prelude hiding (div)
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..))
import Affjax.RequestHeader (RequestHeader(..))
import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift) import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>)) import Data.Argonaut (class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, stringify, (:=), (~>))
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(Just))
import Data.MediaType.Common (applicationJSON)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Routing.Hash (setHash) import Effect.Console (log)
import Thermite (PerformAction, modifyState)
import Gargantext.Prelude
import Gargantext.Config.REST (post)
import Gargantext.Components.Modals.Modal (modalHide) import Gargantext.Components.Modals.Modal (modalHide)
import Gargantext.Pages.Layout.Specs.AddCorpus.States (Response, State) import Gargantext.Pages.Layout.Specs.AddCorpus.States (Response, State)
import Routing.Hash (setHash)
import Thermite (PerformAction, modifyState)
data Action data Action
= SelectDatabase Boolean = SelectDatabase Boolean
...@@ -27,7 +35,10 @@ performAction (UnselectDatabase unselected) _ _ = void do ...@@ -27,7 +35,10 @@ performAction (UnselectDatabase unselected) _ _ = void do
performAction (LoadDatabaseDetails) _ _ = do performAction (LoadDatabaseDetails) _ _ = do
res <- lift $ getDatabaseDetails $ QueryString { query_query: "string",query_name: ["Pubmed"]} res <- lift $ getDatabaseDetails $ QueryString { query_query: "string",query_name: ["Pubmed"]}
void $ modifyState $ _ {response = res} case res of
Left err -> pure unit
Right resData -> do
void $ modifyState $ _ {response = resData}
performAction GO _ _ = do performAction GO _ _ = do
liftEffect $ setHash "/corpus" liftEffect $ setHash "/corpus"
...@@ -57,7 +68,25 @@ instance encodeJsonQueryString :: EncodeJson QueryString where ...@@ -57,7 +68,25 @@ instance encodeJsonQueryString :: EncodeJson QueryString where
~> "query_name" := obj.query_name ~> "query_name" := obj.query_name
~> jsonEmptyObject ~> jsonEmptyObject
getDatabaseDetails :: QueryString -> Aff (Array Response) getDatabaseDetails :: QueryString -> Aff (Either String (Array Response))
getDatabaseDetails reqBody = do getDatabaseDetails reqBody = do
-- TODO let token = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJleHAiOjE1MTk5OTg1ODMsInVzZXJfaWQiOjUsImVtYWlsIjoiYWxleGFuZHJlLmRlbGFub2VAaXNjcGlmLmZyIiwidXNlcm5hbWUiOiJkZXZlbG9wZXIifQ.Os-3wuFNSmRIxCZi98oFNBu2zqGc0McO-dgDayozHJg" let token = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJleHAiOjE1MTk5OTg1ODMsInVzZXJfaWQiOjUsImVtYWlsIjoiYWxleGFuZHJlLmRlbGFub2VAaXNjcGlmLmZyIiwidXNlcm5hbWUiOiJkZXZlbG9wZXIifQ.Os-3wuFNSmRIxCZi98oFNBu2zqGc0McO-dgDayozHJg"
post "http://localhost:8009/count" reqBody affResp <- request $ defaultRequest
{ method = Left POST
, responseFormat = ResponseFormat.json
, url = "http://localhost:8009/count"
, headers = [ ContentType applicationJSON
, Accept applicationJSON
-- , RequestHeader "Authorization" $ "Bearer " <> token
]
, content = Just $ Json $ encodeJson reqBody
}
case affResp.body of
Left err -> do
liftEffect $ log $ "error" <> printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
liftEffect $ log $ "POST method Completed"
liftEffect $ log $ "GET /api response: " <> stringify json
let obj = decodeJson json
pure obj
src/Gargantext/Pages/Layout/Specs/AddCorpus/Specs.purs
View file @ e7ca1d1f
module Gargantext.Pages.Layout.Specs.AddCorpus.Specs where module Gargantext.Pages.Layout.Specs.AddCorpus.Specs where
import Gargantext.Pages.Layout.Specs.AddCorpus.Actions
import Gargantext.Pages.Layout.Specs.AddCorpus.States
import Prelude hiding (div)
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..))
import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, (.?), (:=), (~>))
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Lens (over) import Data.Lens (over)
import Data.Maybe (Maybe(Just))
import Data.MediaType.Common (applicationJSON)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Gargantext.Components.Modals.Modal (modalHide)
import React (ReactElement) import React (ReactElement)
import React.DOM (button, div, h3, h5, li, span, text, ul) import React.DOM (button, div, h3, h5, li, span, text, ul)
import React.DOM.Props (_data, _id, _type, aria, className, onClick, role) import React.DOM.Props (_data, _id, _type, aria, className, onClick, role)
import Thermite (Render, Spec, _render, simpleSpec) import Thermite (PerformAction, Render, Spec, _render, simpleSpec)
import Gargantext.Prelude
import Gargantext.Config.REST (post)
import Gargantext.Pages.Layout.Specs.AddCorpus.Actions (Action(..), performAction)
import Gargantext.Pages.Layout.Specs.AddCorpus.States (Query, Response(..), State)
modalSpec :: Boolean -> String -> Spec State {} Action -> Spec State {} Action modalSpec :: Boolean -> String -> Spec State {} Action -> Spec State {} Action
modalSpec sm t = over _render \render d p s c -> modalSpec sm t = over _render \render d p s c ->
...@@ -113,5 +125,22 @@ layoutAddcorpus = simpleSpec performAction render ...@@ -113,5 +125,22 @@ layoutAddcorpus = simpleSpec performAction render
countResults :: Query -> Aff Int countResults :: Query -> Aff (Either String (Int))
countResults = post "http://localhost:8008/count" countResults query = do
res <- request $ defaultRequest
{ url = "http://localhost:8008/count"
, responseFormat = ResponseFormat.json
, method = Left POST
, headers = []
, content = Just $ Json $ encodeJson query
}
case res.body of
Left err -> do
_ <- liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- liftEffect $ log $ show a.status
--_ <- liftEffect $ log $ show a.headers
--_ <- liftEffect $ log $ show a.body
let obj = decodeJson json
pure obj
src/Gargantext/Pages/Layout/Specs/Search.purs
View file @ e7ca1d1f
...@@ -27,19 +27,20 @@ data Action ...@@ -27,19 +27,20 @@ data Action
| SetQuery String | SetQuery String
performAction :: PerformAction State {} Action
performAction (SetQuery q) _ _ = void do
modifyState $ _ { query = q }
performAction GO _ _ = void do
liftEffect $ setHash "/addCorpus"
unsafeEventValue :: forall event. event -> String unsafeEventValue :: forall event. event -> String
unsafeEventValue e = (unsafeCoerce e).target.value unsafeEventValue e = (unsafeCoerce e).target.value
searchSpec :: Spec State {} Action searchSpec :: Spec State {} Action
searchSpec = simpleSpec performAction render searchSpec = simpleSpec performAction render
where where
performAction :: PerformAction State {} Action
performAction (SetQuery q) _ _ = void do
modifyState $ _ { query = q }
performAction GO _ _ = void do
liftEffect $ setHash "/addCorpus"
render :: Render State {} Action render :: Render State {} Action
render dispatch _ state _ = render dispatch _ state _ =
[ div [className "container1"] [] [ div [className "container1"] []
......
src/Gargantext/Pages/Layout/States.purs
View file @ e7ca1d1f
...@@ -7,10 +7,11 @@ import Data.Maybe (Maybe(Just)) ...@@ -7,10 +7,11 @@ 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.Document as D import Gargantext.Pages.Corpus as Corpus
import Gargantext.Pages.Corpus.Doc.Annotation as D
import Gargantext.Pages.Annuaire as Annuaire import Gargantext.Pages.Annuaire as Annuaire
import Gargantext.Pages.Corpus.Tabs.Documents as DV import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV
import Gargantext.Pages.Corpus.Graph as GE import Gargantext.Pages.Corpus.Doc.Facets.Graph as GE
import Gargantext.Pages.Annuaire.User.Contacts as C import Gargantext.Pages.Annuaire.User.Contacts as C
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
...@@ -19,11 +20,12 @@ import Gargantext.Router (Routes(..)) ...@@ -19,11 +20,12 @@ 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
, userPageState :: C.State , userPageState :: C.State
, documentState :: D.State , docAnnotationState :: D.State
, annuaireState :: Annuaire.State , annuaireState :: Annuaire.State
, ntreeState :: Tree.State , ntreeState :: Tree.State
, search :: String , search :: String
...@@ -36,12 +38,13 @@ type AppState = ...@@ -36,12 +38,13 @@ 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.initialState , docViewState : DV.tdata
, searchState : S.initialState , searchState : S.initialState
, userPageState : C.initialState , userPageState : C.initialState
, documentState : D.initialState , docAnnotationState : D.initialState
, ntreeState : Tree.exampleTree , ntreeState : Tree.exampleTree
, annuaireState : Annuaire.initialState , annuaireState : Annuaire.initialState
, search : "" , search : ""
...@@ -58,6 +61,9 @@ _loginState = lens (\s -> s.loginState) (\s ss -> s{loginState = ss}) ...@@ -58,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})
...@@ -70,8 +76,8 @@ _userPageState = lens (\s -> s.userPageState) (\s ss -> s{userPageState = ss}) ...@@ -70,8 +76,8 @@ _userPageState = lens (\s -> s.userPageState) (\s ss -> s{userPageState = ss})
_annuaireState :: Lens' AppState Annuaire.State _annuaireState :: Lens' AppState Annuaire.State
_annuaireState = lens (\s -> s.annuaireState) (\s ss -> s{annuaireState = ss}) _annuaireState = lens (\s -> s.annuaireState) (\s ss -> s{annuaireState = ss})
_documentViewState :: Lens' AppState D.State _docAnnotationViewState :: Lens' AppState D.State
_documentViewState = lens (\s -> s.documentState) (\s ss -> s{documentState = ss}) _docAnnotationViewState = lens (\s -> s.docAnnotationState) (\s ss -> s{docAnnotationState = ss})
_treeState :: Lens' AppState Tree.State _treeState :: Lens' AppState Tree.State
_treeState = lens (\s -> s.ntreeState) (\s ss -> s {ntreeState = ss}) _treeState = lens (\s -> s.ntreeState) (\s ss -> s {ntreeState = ss})
......
src/Gargantext/Prelude.purs deleted 100644 → 0
View file @ 390aa390
module Gargantext.Prelude (module Prelude, logs)
where
import Prelude hiding (div)
import Effect.Console (log)
import Effect.Class -- (MonadEffect(), liftEffect) -- TODO fix import
logs:: forall message effect.
(MonadEffect effect) => Show message => message
-> effect Unit
logs = liftEffect <<< log <<< show
src/Gargantext/Router.purs
View file @ e7ca1d1f
module Gargantext.Router where module Gargantext.Router where
import Gargantext.Prelude import Prelude
import Control.Alt ((<|>)) import Control.Alt ((<|>))
import Data.Int (floor) import Data.Int (floor)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Effect (Effect) import Effect (Effect)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Console (log)
import Routing.Match (Match, lit, num) import Routing.Match (Match, lit, num)
import Web.HTML (window) import Web.HTML (window)
import Web.HTML.Window (localStorage) import Web.HTML.Window (localStorage)
...@@ -19,7 +20,9 @@ data Routes ...@@ -19,7 +20,9 @@ data Routes
| Folder Int | Folder Int
| Corpus Int | Corpus Int
| AddCorpus | AddCorpus
| Document Int | Tabview
| DocView Int
| DocAnnotation Int
| PGraphExplorer | PGraphExplorer
| NGramsTable | NGramsTable
| Dashboard | Dashboard
...@@ -33,8 +36,10 @@ routing = ...@@ -33,8 +36,10 @@ routing =
<|> AddCorpus <$ route "addCorpus" <|> AddCorpus <$ route "addCorpus"
<|> Folder <$> (route "folder" *> int) <|> Folder <$> (route "folder" *> int)
<|> Corpus <$> (route "corpus" *> int) <|> Corpus <$> (route "corpus" *> int)
<|> Tabview <$ route "tabview"
<|> DocView <$> (route "docView" *> int)
<|> NGramsTable <$ route "ngrams" <|> NGramsTable <$ route "ngrams"
<|> Document <$> (route "document" *> int) <|> DocAnnotation <$> (route "document" *> int)
<|> Dashboard <$ route "dashboard" <|> Dashboard <$ route "dashboard"
<|> PGraphExplorer <$ route "graph" <|> PGraphExplorer <$ route "graph"
<|> Annuaire <$> (route "annuaire" *> int) <|> Annuaire <$> (route "annuaire" *> int)
...@@ -52,8 +57,10 @@ instance showRoutes :: Show Routes where ...@@ -52,8 +57,10 @@ instance showRoutes :: Show Routes where
show AddCorpus = "AddCorpus" show AddCorpus = "AddCorpus"
show SearchView = "Search" show SearchView = "Search"
show (UserPage i) = "User" <> show i show (UserPage i) = "User" <> show i
show (Document i)= "Document" show (DocAnnotation i)= "Document"
show (Corpus i) = "Corpus" <> show i show (Corpus i) = "Corpus" <> show i
show Tabview = "Tabview"
show (DocView i) = "DocView"
show NGramsTable = "NGramsTable" show NGramsTable = "NGramsTable"
show (Annuaire i) = "Annuaire" <> show i show (Annuaire i) = "Annuaire" <> show i
show (Folder i) = "Folder" <> show i show (Folder i) = "Folder" <> show i
...@@ -65,19 +72,19 @@ instance showRoutes :: Show Routes where ...@@ -65,19 +72,19 @@ instance showRoutes :: Show Routes where
routeHandler :: (Maybe Routes -> Routes -> Effect Unit) routeHandler :: (Maybe Routes -> Routes -> Effect Unit)
-> Maybe Routes -> Routes -> Effect Unit -> Maybe Routes -> Routes -> Effect Unit
routeHandler dispatchAction old new = do routeHandler dispatchAction old new = do
logs $ "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
logs $ "JWToken : " <> show tkn liftEffect $ log $ "JWToken : " <> show tkn
case tkn of case tkn of
Nothing -> do Nothing -> do
dispatchAction old new dispatchAction old new
logs $ "called SignIn Route :" liftEffect $ log $ "called SignIn Route :"
Just t -> do Just t -> do
dispatchAction old new dispatchAction old new
logs $ "called Route : " <> show new liftEffect $ log $ "called Route : " <> show new
yarn.lock
View file @ e7ca1d1f
This diff is collapsed.
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