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 Hide whitespace changes
Inline Side-by-side
Showing with 1628 additions and 2063 deletions
bower.json
View file @ e7ca1d1f
......@@ -8,7 +8,7 @@
],
"dependencies": {
"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-routing": "^8.0.0",
"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
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.Maybe (Maybe)
import Effect.Class (liftEffect)
import Data.Maybe (Maybe(..))
import Data.MediaType.Common (applicationJSON)
import Effect (Effect)
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.Props (_data, _id, _type, aria, className, href, maxLength, name, onClick, onInput, placeholder, role, target, value)
import Thermite (PerformAction, Render, Spec, _render, modifyState, simpleSpec)
......@@ -14,13 +25,7 @@ import Web.HTML (window)
import Web.HTML.Window (localStorage)
import Web.Storage.Storage (getItem, setItem)
------------------------------------------------------------------------
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
-- 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
{ username :: String
......@@ -46,6 +51,31 @@ data Action
| 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 sm t = over _render \render d p s c ->
[ div [ _id "loginModal", className $ "modal myModal" <> if sm then "" else " fade"
......@@ -80,27 +110,6 @@ spec' = modalSpec true "Login" renderSpec
renderSpec :: Spec State {} Action
renderSpec = simpleSpec performAction render
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 dispatch _ (State state) _ =
[
......@@ -224,8 +233,37 @@ newtype LoginReq = LoginReq
, password :: String
}
loginReq :: LoginReq -> Aff LoginRes
loginReq = post "https://dev.gargantext.org/api/auth/token"
loginReq :: LoginReq -> Aff (Either String LoginRes)
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
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 ->
, wrapper $ fold $ mapWithIndex ( tab (activeTab st)) ls
]
where
performAction :: forall props.
PerformAction State props Action
performAction (ChangeTab i) _ _ =
void $ modifyState $ const i
activeTab = view l
wrapper = over _render \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
]
performAction :: forall props.
PerformAction State props Action
performAction (ChangeTab i) _ _ =
void $ modifyState $ const i
render :: forall state props action.
State -> List (Tuple String (Spec state props action))
-> Render State props Action
......
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
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, 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.Traversable (traverse)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Prelude (identity)
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 Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
import Thermite (PerformAction, Render, Spec, cotransform, modifyState, simpleSpec)
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 Open = Boolean
type URL = String
......@@ -30,7 +37,7 @@ data Action = ShowPopOver
| ToggleFolder ID
| RenameNode String
| Submit
-- | Initialize
--| Initialize
type State = FTree
......@@ -43,6 +50,33 @@ initialState = NTree (LNode { id : 3
, 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 sid (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) ary) =
......@@ -77,7 +111,7 @@ exampleTree = NTree (LNode { id : 1
-- corpus :: Int -> String -> NTree (Tuple String String)
-- 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 "Graph" "#/graphExplorer") []
-- ]
......@@ -116,22 +150,6 @@ nodeOptionsRename d activated = case activated of
treeview :: Spec State {} Action
treeview = simpleSpec performAction render
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 dispatch _ state _ =
[ div [className "tree"]
......@@ -200,8 +218,8 @@ toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) [
( [ text (name <> " ")
]
<> nodeOptionsView false
<> (nodeOptionsRename d false)
-- <>[ if ((popOverValue s) == true) then (renameTreeView d s ) else (renameTreeView d s)]
<> (nodeOptionsRename d true)
<>[ 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
map (toHtml d) ary
else []
<> nodeOptionsView false
<> (nodeOptionsRename d false)
-- <>[ if ((popOverValue s) == true) then (renameTreeView d s ) else (renameTreeView d s)]
<> (nodeOptionsRename d true)
<>[ if ((popOverValue s) == true) then (renameTreeView d s ) else (renameTreeView d s)]
)
]
......@@ -261,8 +279,24 @@ instance decodeJsonFTree :: DecodeJson (NTree LNode) where
nodes' <- decodeJson nodes
pure $ NTree node' nodes'
loadDefaultNode :: Aff (NTree LNode)
loadDefaultNode = get $ toUrl Back Tree defaultRoot
loadDefaultNode :: Aff (Either String (NTree LNode))
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
......@@ -277,25 +311,96 @@ instance encodeJsonRenameValue :: EncodeJson RenameValue where
~> jsonEmptyObject
renameNode :: Int -> RenameValue -> Aff Int --- need to change return type herre
renameNode renameNodeId reqbody =
put ("http://localhost:8008/api/v1.0/node/" <> show renameNodeId <> "/rename")
reqbody
deleteNode :: Int -> Aff Int
deleteNode = delete <<< toUrl Back Tree
renameNode :: Int -> RenameValue -> Aff (Either String (Int)) --- need to change return type herre
renameNode renameNodeId reqbody = do
res <- request $ defaultRequest
{ 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 = []
}
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
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 n = NTree n []
unsafeEventValue :: forall event. event -> String
unsafeEventValue e = (unsafeCoerce e).target.value
src/Gargantext/Config.purs
View file @ e7ca1d1f
......@@ -94,11 +94,11 @@ baseUrl :: Config -> UrlBase
baseUrl conf = conf.proto <> conf.domain <> ":" <> show conf.port
------------------------------------------------------------
endPathUrl :: End -> EndConfig -> NodeType -> Id -> UrlPath
endPathUrl Back c nt i = pathUrl c.back nt i
endPathUrl Back c nt i = pathUrl c.back nt i
endPathUrl Front c nt i = pathUrl c.front nt i
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
------------------------------------------------------------
toUrl :: End -> NodeType -> Id -> Url
......@@ -110,11 +110,10 @@ toUrl e nt i = doUrl base path params
------------------------------------------------------------
data NodeType = NodeUser
| Annuaire
| Tab TabType Offset Limit
| Children
| Corpus
| CorpusV3
| Dashboard
| Url_Document
| Document
| Error
| Folder
| Graph
......@@ -123,34 +122,19 @@ data NodeType = NodeUser
| Tree
data End = Back | Front
type Id = Int
type Limit = Int
type Offset = Int
------------------------------------------------------------
data ApiVersion = V10 | V11
instance showApiVersion :: Show ApiVersion where
show V10 = "v1.0"
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 Annuaire = show Annuaire
urlConfig nt@(Tab _ _ _) = show nt
urlConfig Children = show Children
urlConfig Corpus = show Corpus
urlConfig CorpusV3 = show CorpusV3
urlConfig Dashboard = show Dashboard
urlConfig Url_Document = show Url_Document
urlConfig Document = show Document
urlConfig Error = show Error
urlConfig Folder = show Folder
urlConfig Graph = show Graph
......@@ -161,10 +145,10 @@ urlConfig Tree = show Tree
------------------------------------------------------------
instance showNodeType :: Show NodeType where
show Annuaire = "annuaire"
show Children = "children"
show Corpus = "corpus"
show CorpusV3 = "corpus"
show Dashboard = "dashboard"
show Url_Document = "document"
show Document = "document"
show Error = "ErrorNodeType"
show Folder = "folder"
show Graph = "graph"
......@@ -172,21 +156,19 @@ instance showNodeType :: Show NodeType where
show Node = "node"
show NodeUser = "user"
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 ?
-- instance readNodeType :: Read NodeType where
readNodeType :: String -> NodeType
readNodeType "NodeAnnuaire" = Annuaire
readNodeType "Tab" = (Tab TabDocs 0 0)
readNodeType "NodeDashboard" = Dashboard
readNodeType "Document" = Url_Document
readNodeType "NodeFolder" = Folder
readNodeType "NodeGraph" = Graph
readNodeType "Annuaire" = Annuaire
readNodeType "Children" = Children
readNodeType "Dashboard" = Dashboard
readNodeType "Document" = Document
readNodeType "Folder" = Folder
readNodeType "Graph" = Graph
readNodeType "Individu" = Individu
readNodeType "Node" = Node
readNodeType "NodeCorpus" = Corpus
readNodeType "NodeCorpusV3" = CorpusV3
readNodeType "NodeUser" = NodeUser
readNodeType "Tree" = Tree
readNodeType _ = Error
......
src/Gargantext/Config/REST.purs
View file @ e7ca1d1f
module Gargantext.Config.REST where
import Prelude
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..))
import Affjax.RequestHeader (RequestHeader(..))
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.HTTP.Method (Method(..))
import Data.Maybe (Maybe(..))
import Data.MediaType.Common (applicationJSON)
import Effect.Aff (Aff, throwError)
import Effect.Exception (error)
import Gargantext.Prelude
send :: forall a b. EncodeJson a => DecodeJson b =>
Method -> String -> Maybe a -> Aff b
send m url reqbody = do
affResp <- request $ defaultRequest
{ url = url
, responseFormat = ResponseFormat.json
, method = Left m
, headers = [ ContentType applicationJSON
, Accept applicationJSON
-- , RequestHeader "Authorization" $ "Bearer " <> token
]
, content = (Json <<< encodeJson) <$> reqbody
}
import Effect.Aff (Aff)
get :: forall t31. DecodeJson t31 => String ->
Aff (Either String t31)
get url = do
affResp <- request defaultRequest
{ method = Left GET
, url = url
, responseFormat = ResponseFormat.json
, headers = [ ContentType applicationJSON
, Accept applicationJSON
-- , RequestHeader "Authorization" $ "Bearer " <> token
]
}
case affResp.body of
Left err -> do
_ <- logs $ printResponseFormatError err
throwError $ error $ printResponseFormatError err
Right json -> do
--_ <- logs $ show json.status
--_ <- 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
pure $ Left $ printResponseFormatError err
Right a -> do
let res = decodeJson a
pure res
src/Gargantext/Pages/Annuaire.purs
View file @ e7ca1d1f
module Gargantext.Pages.Annuaire where
import Prelude
import Data.Array (concat)
import Data.Traversable (foldl)
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 Effect.Class (liftEffect)
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.Props (className, href, scope, style)
import Effect.Aff (Aff)
import React.DOM (div, h1, h3, hr, i, p, text, thead, tbody, input, br', b, b', tr, th, table, td, a)
import React.DOM.Props (_type, className, href, onChange, onClick, scope, selected, value, style)
import Thermite (Render, Spec
, simpleSpec
, simpleSpec, defaultPerformAction
, PerformAction, modifyState)
import Effect.Console (log)
import Effect.Aff (Aff)
------------------------------------------------------------------------------
import Gargantext.Prelude
import Gargantext.Config (toUrl, NodeType(..), TabType(..), End(..))
import Gargantext.Config (toUrl, NodeType(..), End(..))
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 Data.Argonaut (class DecodeJson, decodeJson, (.?))
------------------------------------------------------------------------------
type State = { info :: Maybe AnnuaireInfo
, stable :: Maybe AnnuaireTable
......@@ -74,20 +80,9 @@ toRows (AnnuaireTable a) = a.annuaireTable
layoutAnnuaire :: Spec State {} Action
layoutAnnuaire = simpleSpec performAction render
where
performAction :: PerformAction State {} Action
performAction (Load aId) _ _ = do
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"]
render :: Render State {} Action
render dispatch _ state _ = [ div [className "row"]
[ div [className "col-md-3"] [ h3 [] [text info.name] ]
, div [className "col-md-9"] [ hr [style {height : "2px",backgroundColor : "black"}] ]
]
......@@ -135,7 +130,7 @@ showRow :: Maybe Contact -> ReactElement
showRow Nothing = tr [][]
showRow (Just (Contact { id : id, hyperdata : (HyperData contact) })) =
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.service]
, td [] [text $ maybe' contact.groupe]
......@@ -180,10 +175,28 @@ instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where
rows <- decodeJson json
pure $ AnnuaireTable { annuaireTable : rows}
------------------------------------------------------------------------
getTable :: Int -> Aff AnnuaireTable
getTable id = get $ toUrl Back (Tab TabDocs 0 10) id
performAction :: PerformAction State {} Action
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
------------------------------------------------------------------------------
_table :: Lens' State (Maybe AnnuaireTable)
......
src/Gargantext/Pages/Annuaire/User/Contacts/API.purs
View file @ e7ca1d1f
module Gargantext.Pages.Annuaire.User.Contacts.API where
import Prelude
import Control.Monad.Trans.Class (lift)
import Data.Either (Either(..))
import Data.Lens ((?~))
......@@ -7,19 +9,22 @@ import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Thermite (StateCoTransformer, modifyState)
import Gargantext.Config (toUrl, NodeType(..), End(..))
import Gargantext.Config.REST (get)
import Gargantext.Prelude
import Gargantext.Pages.Annuaire.User.Contacts.Types (Action(..), State, Contact, _contact)
import Thermite (PerformAction, modifyState)
getContact :: Int -> Aff Contact
getContact id = get $ toUrl Back Node id
getUser :: Int -> Aff (Either String Contact)
getUser id = get $ toUrl Back Node id
fetchContact :: Int -> StateCoTransformer State Unit
fetchContact contactId = do
contact <- lift $ getContact contactId
void $ modifyState $ _contact ?~ contact
logs "Fetching contact..."
performAction :: PerformAction State {} Action
performAction (FetchContact contactId) _ _ = do
value <- lift $ getUser contactId
_ <- case value of
(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.Renders,
brevetSpec,
projectSpec,
facets,
layoutUser)
where
import Gargantext.Pages.Annuaire.User.Contacts.Specs.Renders
import Data.List (fromFoldable)
import Data.Tuple (Tuple(..))
import Thermite (Render, PerformAction, Spec, focus, noState, defaultPerformAction, simpleSpec)
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)
import Thermite (Spec, simpleSpec)
import Gargantext.Pages.Annuaire.User.Contacts.Types (Action, State)
import Gargantext.Pages.Annuaire.User.Contacts.API (performAction)
layoutUser :: Spec State {} Action
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
infixl 4 mapMyMap as <.~$>
contactInfos :: HyperData -> ReactElement
contactInfos :: Maybe HyperData -> ReactElement
contactInfos hyperdata =
ul [className "list-group"] [] {- $
listInfo <.~$> hyperdata
ul [className "list-group"] $
listInfo <.~$> (checkMaybe hyperdata)
where
checkMaybe (Nothing) = empty
checkMaybe (Just (HyperData a)) = a
-}
listInfo :: Tuple String String -> ReactElement
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 Data.Argonaut (class DecodeJson, decodeJson, (.?))
import Data.Either (Either(..))
import Data.Lens (Lens', Prism', lens, prism)
import Data.Maybe (Maybe(..))
import Gargantext.Components.Tab as Tab
import Gargantext.Utils.DecodeMaybe ((.?|))
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
}
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
import Gargantext.Pages.Annuaire.User.Contacts.Types.Lens
import Gargantext.Pages.Annuaire.User.Contacts.Types.Types
import Gargantext.Pages.Annuaire.User.Contacts.Types.States
import Gargantext.Pages.Annuaire.User.Brevets as B
import Data.List (fromFoldable)
import Data.Tuple (Tuple(..))
import Gargantext.Components.Tab (tabs)
import Thermite (Render, Spec, focus, noState, defaultPerformAction, simpleSpec)
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
facets :: Spec State {} Action
facets = tabs _tablens _tabAction $ fromFoldable
[ Tuple "Publications (12)" publicationSpec
, Tuple "Brevets (2)" brevetSpec
, Tuple "Projets IMT (5)" projectSpec
]
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
import Data.Either (Either(..))
import Data.Lens (Lens', Prism', lens, prism)
import Data.Maybe (maybe)
import Effect.Aff (Aff)
import React as React
import React (ReactClass, ReactElement)
import Data.Maybe (Maybe(..), maybe)
import Prelude hiding (div)
import Data.Argonaut (class DecodeJson, decodeJson, (.?))
import Gargantext.Components.Charts.Options.ECharts (chart)
import Gargantext.Pages.Corpus.Doc.Facets.Dashboard (globalPublis)
import Gargantext.Pages.Corpus.Doc.Facets as Tab
import React.DOM (div, h3, hr, i, p, text)
import React.DOM.Props (className, style)
import Thermite ( Render, Spec, createClass, defaultPerformAction, focus
, 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
import Thermite (Render, Spec, defaultPerformAction, simpleSpec)
-------------------------------------------------------------------
type Props = Tabs.Props
type State = { tabsView :: Tabs.State
type State = { info :: Maybe CorpusInfo
}
initialState :: State
initialState = { tabsView : Tabs.initialState
}
initialState = { info : Nothing }
------------------------------------------------------------------------
_tabsView :: forall a b. Lens' { tabsView :: a | b } a
_tabsView = lens (\s -> s.tabsView) (\s ss -> s{tabsView = ss})
------------------------------------------------------------------------
data Action = Load Int
data Action
= TabsA Tabs.Action
newtype Node a = Node { id :: Int
, typename :: Int
, userId :: Int
, parentId :: Int
, name :: String
, date :: String
, hyperdata :: a
}
_tabsAction :: Prism' Action Tabs.Action
_tabsAction = prism TabsA \ action ->
case action of
TabsA taction -> Right taction
-- _-> Left action
newtype CorpusInfo = CorpusInfo { title :: String
, desc :: String
, query :: String
, date :: String
, authors :: String
, chart :: (Maybe (Array Number))
}
corpusInfoDefault :: CorpusInfo
corpusInfoDefault = CorpusInfo
{ title : "Global Publications"
, desc : " Hal Database"
, query : " Query: all publications"
, date : " June. 26 2018, 10:59 am"
, authors : " Author(s): first.last name"
, chart : Nothing
}
instance decodeCorpusInfo :: DecodeJson CorpusInfo where
decodeJson json = do
obj <- decodeJson json
title <- obj .? "title"
desc <- obj .? "desc"
query <- obj .? "query"
date <- obj .? "date"
authors <- obj .? "authors"
chart <- obj .? "chart"
pure $ CorpusInfo {title, desc, query, date, authors, chart}
------------------------------------------------------------------------
layout :: Spec {} {nodeId :: Int} Void
layout = simpleSpec defaultPerformAction render
where
render :: Render {} {nodeId :: Int} Void
render _ {nodeId} _ _ =
[ corpusLoader { path: nodeId
, component: createClass "Layout" layout' initialState
} ]
layout' :: Spec State Props Action
layout' = noState corpusHeaderSpec
<> focus _tabsView _tabsAction Tabs.statefulTabs
instance decodeNode :: (DecodeJson a) => DecodeJson (Node a) where
decodeJson json = do
obj <- decodeJson json
id <- obj .? "id"
typename <- obj .? "typename"
userId <- obj .? "userId"
parentId <- obj .? "parentId"
name <- obj .? "name"
date <- obj .? "date"
hyperdata <- obj .? "hyperdata"
hyperdata' <- decodeJson hyperdata
pure $ Node { id : id
, typename : typename
, userId : userId
, parentId : parentId
, name : name
, date : date
, hyperdata: hyperdata'
}
corpusHeaderSpec :: Spec {} Props Void
corpusHeaderSpec = simpleSpec defaultPerformAction render
layout :: Spec State {} Action
layout = corpusSpec -- <> Tab.pureTab1
corpusSpec :: Spec State {} Action
corpusSpec = simpleSpec defaultPerformAction render
where
render :: Render {} Props Void
render dispatch {loaded} _ _ =
render :: Render State {} Action
render dispatch _ state _ =
[ 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 "row"] [ div [className "jumbotron1", style {padding : "12px 0px 20px 12px"}]
[ div [ className "col-md-8 content"]
[ p [] [ i [className "fa fa-globe"] []
, text $ " " <> corpus.desc
, text corpus.desc
]
, p [] [ i [className "fab fa-searchengin"] []
, text $ " " <> corpus.query
, text corpus.query
]
]
, div [ className "col-md-4 content"]
[ p [] [ i [className "fa fa-calendar"] []
, text $ " " <> date'
, text corpus.date
]
, p [] [ i [className "fa fa-user"] []
, text $ " " <> corpus.authors
, text corpus.authors
]
]
]
]
-- , chart globalPublis TODO add chart data in state
]
where
NodePoly { name: title
, 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
CorpusInfo corpus = maybe corpusInfoDefault identity state.info
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.Either (Either(..))
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.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
data Action
......@@ -46,3 +46,6 @@ _tabAction = prism TabViewA \ action ->
case action of
TabViewA laction -> Right laction
_-> 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 React.DOM (h3, text)
import Thermite (PerformAction, Render, Spec, defaultPerformAction, simpleSpec)
type State = {}
type State = D.State
initialState :: State
initialState = {}
initialState = D.tdata
type Action = Void
type Action = D.Action
authorSpec :: Spec State {} Action
authorSpec = simpleSpec defaultPerformAction render
......@@ -18,3 +20,6 @@ authorSpec = simpleSpec defaultPerformAction render
render :: Render State {} Action
render dispatch _ state _ =
[ 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)
......
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 Data.Argonaut (decodeJson, stringify)
import Data.Array (length, mapWithIndex, (!!))
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Int (toNumber)
import Data.Maybe (Maybe(..), fromJust)
import Data.MediaType.Common (applicationJSON)
import Data.Newtype (class Newtype)
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 Partial.Unsafe (unsafePartial)
import React (ReactElement)
......@@ -15,13 +28,6 @@ import React.DOM.Props (_id, _type, checked, className, href, name, onChange, pl
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
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
= LoadGraph String
| SelectNode SelectedNode
......@@ -53,16 +59,18 @@ graphSpec = simpleSpec performAction render
performAction :: PerformAction State {} Action
performAction (LoadGraph fp) _ _ = void do
_ <- logs fp
_ <- liftEffect $ log fp
case fp of
"" -> do
modifyState \(State s) -> State s {filePath = fp, graphData = GraphData {nodes : [], edges : []}, sigmaGraphData = Nothing}
_ -> do
_ <- modifyState \(State s) -> State s {filePath = fp, sigmaGraphData = Nothing}
gd <- lift $ getGraphData fp
-- TODO: here one might `catchError getGraphData` to visually empty the
-- graph.
modifyState \(State s) -> State s {filePath = fp, graphData = gd, sigmaGraphData = Just $ convert gd, legendData = getLegendData gd}
case gd of
Left err -> do
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
modifyState $ \(State s) -> State s {selectedNode = pure node}
......@@ -109,7 +117,7 @@ render d p (State s) c =
, settings : mySettings
, style : sStyle { height : "95%"}
-- , onClickNode : \e -> do
-- logs $ unsafeCoerce e
-- log $ unsafeCoerce e
-- d $ SelectNode $ SelectedNode {id : (unsafeCoerce e).data.node.id, label : (unsafeCoerce e).data.node.label}
-- pure unit
-- TODO: fix this!
......@@ -213,8 +221,27 @@ mySettings = sigmaSettings { verbose : true
-- loadJSON {path : "http://localhost:2015/examples/sites_coords.json"}
getGraphData :: String -> Aff GraphData
getGraphData fp = get $ "http://localhost:2015/examples/" <> fp
getGraphData :: String -> Aff (Either String GraphData)
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 = map Color defaultPalette'
......@@ -365,7 +392,7 @@ specOld = simpleSpec performAction render'
, settings : mySettings
, style : sStyle { height : "95%"}
-- , onClickNode : \e -> do
-- logs $ unsafeCoerce e
-- log $ unsafeCoerce e
-- d $ SelectNode $ SelectedNode {id : (unsafeCoerce e).data.node.id, label : (unsafeCoerce e).data.node.label}
-- 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 React.DOM (h3, text)
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 = simpleSpec defaultPerformAction render
......@@ -18,3 +22,6 @@ sourceSpec = simpleSpec defaultPerformAction render
render :: Render State {} Action
render dispatch _ state _ =
[ 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 Gargantext.Pages.Corpus.Doc.Facets.Documents as D
import Prelude hiding (div)
import React.DOM (h3, text)
import Thermite (PerformAction, Render, Spec, defaultPerformAction, simpleSpec)
type State = {}
initialState :: State
initialState = {}
type State = D.State
initialState :: D.State
initialState = D.tdata
type Action = D.Action
type Action = Void
termsSpec :: Spec State {} Action
termsSpec = simpleSpec defaultPerformAction render
......@@ -19,3 +23,6 @@ termsSpec = simpleSpec defaultPerformAction render
render :: Render State {} Action
render dispatch _ state _ =
[ 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
......@@ -8,7 +8,7 @@ import Data.Lens.Iso.Newtype (_Newtype)
import React (ReactElement)
import React.DOM (input, span, td, text, tr)
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)
newtype State = State
......@@ -37,18 +37,18 @@ data Action
= SetMap Boolean
| SetStop Boolean
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}
performAction (SetStop b) _ _ = void do
modifyState \(State s) -> State s {term = setter (_{_type = (if b then StopTerm else None)}) s.term}
ngramsItemSpec :: Spec {} {} Void
ngramsItemSpec = hideState (unwrap initialState) $
ngramsItemSpec = hide (unwrap initialState) $
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}
performAction (SetStop b) _ _ = void do
modifyState \(State s) -> State s {term = setter (_{_type = (if b then StopTerm else None)}) s.term}
render :: Render State {} Action
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)
......@@ -12,12 +12,12 @@ import Data.Tuple (Tuple(..), uncurry)
import Data.Void (Void)
import Data.Unit (Unit)
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 React (ReactElement)
import React.DOM hiding (style, map)
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)
newtype State = State
......@@ -60,7 +60,6 @@ _ItemAction = prism (uncurry ItemAction) \ta ->
type Dispatch = Action -> Effect Unit
{-
performAction :: PerformAction State {} Action
performAction (ChangePageSize ps) _ _ = void $ modifyState $ changePageSize ps
......@@ -78,7 +77,6 @@ performAction (SetInput s) _ _ = void do
modifyState \(State state) -> State $ state { search = s }
performAction _ _ _ = pure unit
-}
tableSpec :: Spec State {} Action -> Spec State {} Action
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 =
hideState (unwrap initialState) $
hide (unwrap initialState) $
focusState (re _Newtype) $
container $
tableSpec $
......@@ -316,8 +314,8 @@ pagination d tp cp
text " ... "
else
text ""
lnums = map (\i -> fnmid d i) $ filter (1 < _) [cp - 2, cp - 1]
rnums = map (\i -> fnmid d i) $ filter (tp > _) [cp + 1, cp + 2]
lnums = map (\i -> fnmid d i) $ filter (lessthan 1) [cp - 2, cp - 1]
rnums = map (\i -> fnmid d i) $ filter (greaterthan tp) [cp + 1, cp + 2]
fnmid :: Dispatch -> Int -> ReactElement
fnmid d i
......@@ -328,3 +326,10 @@ fnmid d i
] [text $ show i]
, 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)
import React (ReactElement)
import React.DOM (a, div, h3, i, img, p, span, text)
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 |
......@@ -26,7 +26,7 @@ landingData FR = Fr.landingData
landingData EN = En.landingData
layoutLanding :: Lang -> Spec {} {} Void
layoutLanding = hideState (unwrap initialState)
layoutLanding = hide (unwrap initialState)
<<< focusState (re _Newtype)
<<< layoutLanding' <<< landingData
......
src/Gargantext/Pages/Layout.purs
View file @ e7ca1d1f
......@@ -4,11 +4,13 @@ import Prelude hiding (div)
-- import Gargantext.Components.Login as LN
import Gargantext.Pages.Layout.Actions (Action(..))
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.Graph as GE
-- import Gargantext.Pages.Corpus.Tabs.Terms.NgramsTable as NG
import Gargantext.Pages.Corpus as Corpus
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.Annuaire as Annuaire
......@@ -34,8 +36,13 @@ dispatchAction dispatcher _ AddCorpus = do
dispatcher $ SetRoute AddCorpus
dispatcher $ AddCorpusA AC.LoadDatabaseDetails
dispatchAction dispatcher _ (DocView n) = do
dispatcher $ SetRoute (DocView n)
dispatcher $ DocViewA $ DV.LoadData n
dispatchAction dispatcher _ (Corpus n) = do
dispatcher $ SetRoute $ Corpus n
dispatcher $ SetRoute $ Corpus n
dispatcher $ CorpusAction $ Corpus.Load n
dispatchAction dispatcher _ SearchView = do
dispatcher $ SetRoute SearchView
......@@ -53,9 +60,13 @@ dispatchAction dispatcher _ (Annuaire id) = do
dispatchAction dispatcher _ (Folder id) = do
dispatcher $ SetRoute $ Folder id
dispatchAction dispatcher _ (Document n) = do
dispatcher $ SetRoute $ Document n
dispatcher $ DocumentViewA $ Document.Load n
dispatchAction dispatcher _ (DocAnnotation i) = do
dispatcher $ SetRoute $ DocAnnotation i
-- dispatcher $ DocAnnotationViewA TODO
dispatchAction dispatcher _ Tabview = do
dispatcher $ SetRoute Tabview
-- dispatcher $ TabViewA TODO
dispatchAction dispatcher _ PGraphExplorer = do
dispatcher $ SetRoute PGraphExplorer
......
src/Gargantext/Pages/Layout/Actions.purs
View file @ e7ca1d1f
......@@ -2,24 +2,28 @@
module Gargantext.Pages.Layout.Actions where
import Prelude hiding (div)
import Control.Monad.Cont.Trans (lift)
import Data.Either (Either(..))
import Data.Lens (Prism', prism)
import Effect.Class (liftEffect)
import Thermite (PerformAction, modifyState)
import Effect.Console (log)
import Gargantext.Components.Login as LN
import Gargantext.Components.Modals.Modal (modalShow)
import Gargantext.Components.Tree as Tree
import Gargantext.Pages.Corpus as Corpus
import Gargantext.Pages.Corpus.Doc.Annotation as D
import Gargantext.Pages.Corpus.Doc.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 as Annuaire
import Gargantext.Pages.Annuaire.User.Contacts as C
import Gargantext.Pages.Corpus.Document as D
import Gargantext.Pages.Corpus.Graph as GE
import Gargantext.Pages.Layout.Specs.AddCorpus as AC
import Gargantext.Pages.Layout.Specs.Search as S
import Gargantext.Pages.Layout.States (AppState)
import Gargantext.Prelude
import Gargantext.Router (Routes)
import Thermite (PerformAction, modifyState)
------------------------------------------------------------------------
......@@ -27,12 +31,14 @@ data Action
= Initialize
| LoginA LN.Action
| SetRoute Routes
| AddCorpusA AC.Action
| DocViewA DV.Action
| SearchA S.Action
| Search String
| TreeViewA Tree.Action
| SearchA S.Action
| Search String
| AddCorpusA AC.Action
| CorpusAction Corpus.Action
| GraphExplorerA GE.Action
| DocumentViewA D.Action
| DocAnnotationViewA D.Action
| AnnuaireAction Annuaire.Action
| UserPageA C.Action
| Go
......@@ -64,19 +70,40 @@ performAction Go _ _ = void do
---------------------------------------------------------
performAction Initialize _ state = void do
_ <- logs "loading Initial nodes"
_ <- liftEffect $ log "loading Initial nodes"
case state.initialized of
false -> do
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
pure unit
performAction (LoginA _) _ _ = pure unit
performAction (AddCorpusA _) _ _ = pure unit
performAction (CorpusAction _) _ _ = pure unit
performAction (DocViewA _) _ _ = pure unit
performAction (SearchA _) _ _ = pure unit
performAction (UserPageA _) _ _ = pure unit
performAction (DocumentViewA _) _ _ = pure unit
performAction (DocAnnotationViewA _) _ _ = pure unit
performAction (TreeViewA _) _ _ = pure unit
performAction (GraphExplorerA _) _ _ = pure unit
performAction (AnnuaireAction _) _ _ = pure unit
......@@ -95,6 +122,18 @@ _addCorpusAction = prism AddCorpusA \action ->
AddCorpusA caction -> Right caction
_-> 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 SearchA \action ->
case action of
......@@ -113,10 +152,10 @@ _annuaireAction = prism AnnuaireAction \action ->
AnnuaireAction a -> Right a
_ -> Left action
_documentViewAction :: Prism' Action D.Action
_documentViewAction = prism DocumentViewA \action ->
_docAnnotationViewAction :: Prism' Action D.Action
_docAnnotationViewAction = prism DocAnnotationViewA \action ->
case action of
DocumentViewA caction -> Right caction
DocAnnotationViewA caction -> Right caction
_-> Left action
_treeAction :: Prism' Action Tree.Action
......
src/Gargantext/Pages/Layout/Specs.purs
View file @ e7ca1d1f
module Gargantext.Pages.Layout.Specs where
import Prelude hiding (div)
import Data.Foldable (fold, intercalate)
import Data.Lens (over)
import Data.Maybe (Maybe(Nothing, Just))
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.Login as LN
import Gargantext.Components.Tree as Tree
import Gargantext.Folder as F
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.Document as Annotation
import Gargantext.Pages.Corpus.Dashboard as Dsh
import Gargantext.Pages.Corpus.Graph as GE
import Gargantext.Pages.Corpus.Tabs.Terms.NgramsTable as NG
import Gargantext.Pages.Corpus.Doc.Annotation as Annotation
import Gargantext.Pages.Corpus.Doc.Facets as TV
import Gargantext.Pages.Corpus.Doc.Facets.Dashboard as Dsh
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.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.Search as S
import Gargantext.Pages.Layout.States (AppState, _addCorpusState, _documentViewState, _graphExplorerState, _loginState, _searchState, _treeState, _userPageState, _annuaireState)
import Gargantext.Pages.Layout.Specs.Search as S
import Gargantext.Pages.Layout.States (AppState, _corpusState, _addCorpusState, _docAnnotationViewState, _docViewState, _graphExplorerState, _loginState, _searchState, _treeState, _userPageState, _annuaireState)
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 =
......@@ -46,26 +48,28 @@ layoutSpec =
(render d p s c)
pagesComponent :: AppState -> Spec AppState {} Action
pagesComponent s = case s.currentRoute of
pagesComponent s =
case s.currentRoute of
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
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 (Folder i) = layout0 $ noState F.layoutFolder
selectSpec (Corpus i) = layout0 $ cmapProps (const {nodeId: i}) $ noState Corpus.layout
selectSpec Home = layout0 $ noState (L.layoutLanding EN)
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 (Document i) = layout0 $ focus _documentViewState _documentViewAction Annotation.docview
selectSpec NGramsTable = layout0 $ noState NG.ngramsTableSpec
selectSpec PGraphExplorer = focus _graphExplorerState _graphExplorerAction GE.specOld
selectSpec Dashboard = layout0 $ noState Dsh.layoutDashboard
selectSpec (Annuaire i) = layout0 $ focus _annuaireState _annuaireAction A.layoutAnnuaire
selectSpec (UserPage i) = layout0 $ focus _userPageState _userPageAction C.layoutUser
-- To be removed
selectSpec NGramsTable = layout0 $ noState NG.ngramsTableSpec
selectSpec (Folder i) = layout0 $ noState F.layoutFolder
-- selectSpec _ = simpleSpec defaultPerformAction defaultRender
......
src/Gargantext/Pages/Layout/Specs/AddCorpus/Actions.purs
View file @ e7ca1d1f
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 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.Class (liftEffect)
import Routing.Hash (setHash)
import Thermite (PerformAction, modifyState)
import Gargantext.Prelude
import Gargantext.Config.REST (post)
import Effect.Console (log)
import Gargantext.Components.Modals.Modal (modalHide)
import Gargantext.Pages.Layout.Specs.AddCorpus.States (Response, State)
import Routing.Hash (setHash)
import Thermite (PerformAction, modifyState)
data Action
= SelectDatabase Boolean
......@@ -27,7 +35,10 @@ performAction (UnselectDatabase unselected) _ _ = void do
performAction (LoadDatabaseDetails) _ _ = do
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
liftEffect $ setHash "/corpus"
......@@ -57,7 +68,25 @@ instance encodeJsonQueryString :: EncodeJson QueryString where
~> "query_name" := obj.query_name
~> jsonEmptyObject
getDatabaseDetails :: QueryString -> Aff (Array Response)
getDatabaseDetails :: QueryString -> Aff (Either String (Array Response))
getDatabaseDetails reqBody = do
-- TODO let token = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJleHAiOjE1MTk5OTg1ODMsInVzZXJfaWQiOjUsImVtYWlsIjoiYWxleGFuZHJlLmRlbGFub2VAaXNjcGlmLmZyIiwidXNlcm5hbWUiOiJkZXZlbG9wZXIifQ.Os-3wuFNSmRIxCZi98oFNBu2zqGc0McO-dgDayozHJg"
post "http://localhost:8009/count" reqBody
let token = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJleHAiOjE1MTk5OTg1ODMsInVzZXJfaWQiOjUsImVtYWlsIjoiYWxleGFuZHJlLmRlbGFub2VAaXNjcGlmLmZyIiwidXNlcm5hbWUiOiJkZXZlbG9wZXIifQ.Os-3wuFNSmRIxCZi98oFNBu2zqGc0McO-dgDayozHJg"
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
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.Maybe (Maybe(Just))
import Data.MediaType.Common (applicationJSON)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Gargantext.Components.Modals.Modal (modalHide)
import React (ReactElement)
import React.DOM (button, div, h3, h5, li, span, text, ul)
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 sm t = over _render \render d p s c ->
......@@ -113,5 +125,22 @@ layoutAddcorpus = simpleSpec performAction render
countResults :: Query -> Aff Int
countResults = post "http://localhost:8008/count"
countResults :: Query -> Aff (Either String (Int))
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
| 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 e = (unsafeCoerce e).target.value
searchSpec :: Spec State {} Action
searchSpec = simpleSpec performAction render
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 dispatch _ state _ =
[ div [className "container1"] []
......
src/Gargantext/Pages/Layout/States.purs
View file @ e7ca1d1f
......@@ -7,10 +7,11 @@ import Data.Maybe (Maybe(Just))
import Gargantext.Components.Login as LN
import Gargantext.Components.Tree as Tree
import Gargantext.Pages.Corpus.Document as D
import Gargantext.Pages.Annuaire as Annuaire
import Gargantext.Pages.Corpus.Tabs.Documents as DV
import Gargantext.Pages.Corpus.Graph as GE
import Gargantext.Pages.Corpus as Corpus
import Gargantext.Pages.Corpus.Doc.Annotation as D
import Gargantext.Pages.Annuaire as Annuaire
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.Layout.Specs.AddCorpus as AC
import Gargantext.Pages.Layout.Specs.Search as S
......@@ -19,11 +20,12 @@ import Gargantext.Router (Routes(..))
type AppState =
{ currentRoute :: Maybe Routes
, loginState :: LN.State
, corpus :: Corpus.State
, addCorpusState :: AC.State
, docViewState :: DV.State
, searchState :: S.State
, userPageState :: C.State
, documentState :: D.State
, docAnnotationState :: D.State
, annuaireState :: Annuaire.State
, ntreeState :: Tree.State
, search :: String
......@@ -36,12 +38,13 @@ type AppState =
initAppState :: AppState
initAppState =
{ currentRoute : Just Home
, corpus : Corpus.initialState
, loginState : LN.initialState
, addCorpusState : AC.initialState
, docViewState : DV.initialState
, docViewState : DV.tdata
, searchState : S.initialState
, userPageState : C.initialState
, documentState : D.initialState
, docAnnotationState : D.initialState
, ntreeState : Tree.exampleTree
, annuaireState : Annuaire.initialState
, search : ""
......@@ -58,6 +61,9 @@ _loginState = lens (\s -> s.loginState) (\s ss -> s{loginState = ss})
_addCorpusState :: Lens' AppState AC.State
_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 (\s -> s.docViewState) (\s ss -> s{docViewState = ss})
......@@ -70,8 +76,8 @@ _userPageState = lens (\s -> s.userPageState) (\s ss -> s{userPageState = ss})
_annuaireState :: Lens' AppState Annuaire.State
_annuaireState = lens (\s -> s.annuaireState) (\s ss -> s{annuaireState = ss})
_documentViewState :: Lens' AppState D.State
_documentViewState = lens (\s -> s.documentState) (\s ss -> s{documentState = ss})
_docAnnotationViewState :: Lens' AppState D.State
_docAnnotationViewState = lens (\s -> s.docAnnotationState) (\s ss -> s{docAnnotationState = ss})
_treeState :: Lens' AppState Tree.State
_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
import Gargantext.Prelude
import Prelude
import Control.Alt ((<|>))
import Data.Int (floor)
import Data.Maybe (Maybe(..))
import Effect (Effect)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Routing.Match (Match, lit, num)
import Web.HTML (window)
import Web.HTML.Window (localStorage)
......@@ -19,7 +20,9 @@ data Routes
| Folder Int
| Corpus Int
| AddCorpus
| Document Int
| Tabview
| DocView Int
| DocAnnotation Int
| PGraphExplorer
| NGramsTable
| Dashboard
......@@ -33,8 +36,10 @@ routing =
<|> AddCorpus <$ route "addCorpus"
<|> Folder <$> (route "folder" *> int)
<|> Corpus <$> (route "corpus" *> int)
<|> NGramsTable <$ route "ngrams"
<|> Document <$> (route "document" *> int)
<|> Tabview <$ route "tabview"
<|> DocView <$> (route "docView" *> int)
<|> NGramsTable <$ route "ngrams"
<|> DocAnnotation <$> (route "document" *> int)
<|> Dashboard <$ route "dashboard"
<|> PGraphExplorer <$ route "graph"
<|> Annuaire <$> (route "annuaire" *> int)
......@@ -52,8 +57,10 @@ instance showRoutes :: Show Routes where
show AddCorpus = "AddCorpus"
show SearchView = "Search"
show (UserPage i) = "User" <> show i
show (Document i)= "Document"
show (DocAnnotation i)= "Document"
show (Corpus i) = "Corpus" <> show i
show Tabview = "Tabview"
show (DocView i) = "DocView"
show NGramsTable = "NGramsTable"
show (Annuaire i) = "Annuaire" <> show i
show (Folder i) = "Folder" <> show i
......@@ -65,19 +72,19 @@ instance showRoutes :: Show Routes where
routeHandler :: (Maybe Routes -> Routes -> Effect Unit)
-> Maybe Routes -> Routes -> Effect Unit
routeHandler dispatchAction old new = do
logs $ "change route : " <> show new
liftEffect $ log $ "change route : " <> show new
w <- window
ls <- localStorage w
token <- getItem "accessToken" ls
let tkn = token
logs $ "JWToken : " <> show tkn
liftEffect $ log $ "JWToken : " <> show tkn
case tkn of
Nothing -> do
dispatchAction old new
logs $ "called SignIn Route :"
liftEffect $ log $ "called SignIn Route :"
Just t -> do
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