Skip to content

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

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

This reverts commit e7ca1d1f.
parent e7ca1d1f
Show whitespace changes
Inline Side-by-side
Showing with 2288 additions and 1172 deletions
bower.json
View file @ c6739d57
......@@ -8,7 +8,7 @@
],
"dependencies": {
"purescript-console": "^4.1.0",
"purescript-thermite": "https://github.com/np/purescript-thermite.git#hide",
"purescript-thermite": "https://github.com/np/purescript-thermite.git#d7395aec9ff4e7b8f820e882b4b07ed15c4f804d",
"purescript-affjax": "^7.0.0",
"purescript-routing": "^8.0.0",
"purescript-argonaut": "^4.0.1",
......
rebuild 0 → 100755
View file @ c6739d57
#!/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 0 → 100644
View file @ c6739d57
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 @ c6739d57
module Gargantext.Components.Login where
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.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.?), (:=), (~>))
import Data.Lens (over)
import Data.Maybe (Maybe(..))
import Data.MediaType.Common (applicationJSON)
import Data.Maybe (Maybe)
import Effect.Class (liftEffect)
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)
......@@ -25,7 +14,13 @@ import Web.HTML (window)
import Web.HTML.Window (localStorage)
import Web.Storage.Storage (getItem, setItem)
-- TODO: ask for login (modal) or account creation after 15 mn when user is not logged and has made one search at least
------------------------------------------------------------------------
import Gargantext.Prelude
import Gargantext.Config.REST (post)
import Gargantext.Components.Modals.Modal (modalHide)
-- TODO: ask for login (modal) or account creation after 15 mn when user
-- is not logged and has made one search at least
newtype State = State
{ username :: String
......@@ -51,31 +46,6 @@ 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"
......@@ -110,6 +80,27 @@ 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) _ =
[
......@@ -233,37 +224,8 @@ newtype LoginReq = LoginReq
, password :: String
}
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
loginReq :: LoginReq -> Aff LoginRes
loginReq = post "https://dev.gargantext.org/api/auth/token"
instance decodeLoginRes :: DecodeJson LoginRes where
decodeJson json = do
......
src/Gargantext/Components/Node.purs 0 → 100644
View file @ c6739d57
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 @ c6739d57
......@@ -27,6 +27,10 @@ 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]
......@@ -44,11 +48,6 @@ 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 0 → 100644
View file @ c6739d57
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 @ c6739d57
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, Json, decodeJson, encodeJson, jsonEmptyObject, (.?), (:=), (~>))
import Data.Argonaut.Core (Json)
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(..))
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.?), (:=), (~>))
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 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 (a, button, div, h5, i, input, li, text, ul)
import React.DOM.Props (Props, _type, className, href, onClick, onInput, placeholder, style, value)
import Thermite (PerformAction, Render, Spec, cotransform, modifyState, simpleSpec)
import Thermite (PerformAction, Render, Spec, 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
......@@ -37,7 +30,7 @@ data Action = ShowPopOver
| ToggleFolder ID
| RenameNode String
| Submit
--| Initialize
-- | Initialize
type State = FTree
......@@ -50,33 +43,6 @@ 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) =
......@@ -111,7 +77,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 "Facets" "#/corpus") []
-- [ NTree (Tuple "Tabs" "#/corpus") []
-- , NTree (Tuple "Dashboard" "#/dashboard") []
-- , NTree (Tuple "Graph" "#/graphExplorer") []
-- ]
......@@ -150,6 +116,22 @@ 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"]
......@@ -218,8 +200,8 @@ toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) [
( [ text (name <> " ")
]
<> nodeOptionsView false
<> (nodeOptionsRename d true)
<>[ if ((popOverValue s) == true) then (renameTreeView d s ) else (renameTreeView d s)]
<> (nodeOptionsRename d false)
-- <>[ if ((popOverValue s) == true) then (renameTreeView d s ) else (renameTreeView d s)]
)
]
]
......@@ -235,8 +217,8 @@ toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) a
map (toHtml d) ary
else []
<> nodeOptionsView false
<> (nodeOptionsRename d true)
<>[ if ((popOverValue s) == true) then (renameTreeView d s ) else (renameTreeView d s)]
<> (nodeOptionsRename d false)
-- <>[ if ((popOverValue s) == true) then (renameTreeView d s ) else (renameTreeView d s)]
)
]
......@@ -279,24 +261,8 @@ instance decodeJsonFTree :: DecodeJson (NTree LNode) where
nodes' <- decodeJson nodes
pure $ NTree node' nodes'
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
loadDefaultNode :: Aff (NTree LNode)
loadDefaultNode = get $ toUrl Back Tree defaultRoot
----- TREE CRUD Operations
......@@ -311,96 +277,25 @@ instance encodeJsonRenameValue :: EncodeJson RenameValue where
~> jsonEmptyObject
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 = []
}
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
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
deleteNode :: Int -> Aff Int
deleteNode = delete <<< toUrl Back Tree
-- 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 @ c6739d57
......@@ -98,7 +98,7 @@ 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 Children i = pathUrl c Node i <> "/" <> show Children
pathUrl c nt@(Tab _ _ _) i = pathUrl c Node i <> "/" <> show nt
pathUrl c nt i = c.prePath <> urlConfig nt <> "/" <> show i
------------------------------------------------------------
toUrl :: End -> NodeType -> Id -> Url
......@@ -110,10 +110,11 @@ toUrl e nt i = doUrl base path params
------------------------------------------------------------
data NodeType = NodeUser
| Annuaire
| Children
| Tab TabType Offset Limit
| Corpus
| CorpusV3
| Dashboard
| Document
| Url_Document
| Error
| Folder
| Graph
......@@ -122,19 +123,34 @@ 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 Children = show Children
urlConfig nt@(Tab _ _ _) = show nt
urlConfig Corpus = show Corpus
urlConfig CorpusV3 = show CorpusV3
urlConfig Dashboard = show Dashboard
urlConfig Document = show Document
urlConfig Url_Document = show Url_Document
urlConfig Error = show Error
urlConfig Folder = show Folder
urlConfig Graph = show Graph
......@@ -145,10 +161,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 Document = "document"
show Url_Document = "document"
show Error = "ErrorNodeType"
show Folder = "folder"
show Graph = "graph"
......@@ -156,19 +172,21 @@ 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 "Annuaire" = Annuaire
readNodeType "Children" = Children
readNodeType "Dashboard" = Dashboard
readNodeType "Document" = Document
readNodeType "Folder" = Folder
readNodeType "Graph" = Graph
readNodeType "NodeAnnuaire" = Annuaire
readNodeType "Tab" = (Tab TabDocs 0 0)
readNodeType "NodeDashboard" = Dashboard
readNodeType "Document" = Url_Document
readNodeType "NodeFolder" = Folder
readNodeType "NodeGraph" = 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 @ c6739d57
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)
import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson)
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(..))
import Data.MediaType.Common (applicationJSON)
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
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
}
case affResp.body of
Left err -> do
pure $ Left $ printResponseFormatError err
Right a -> do
let res = decodeJson a
pure res
_ <- 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
src/Gargantext/Pages/Annuaire.purs
View file @ c6739d57
module Gargantext.Pages.Annuaire where
import Prelude
import Data.Array (concat)
import Data.Traversable (foldl)
import Control.Monad.Trans.Class (lift)
import Data.Either (Either(..))
import Data.Lens (Lens', Prism', lens, prism, (?~))
import Data.Lens (Lens', lens, (?~))
import Data.Maybe (Maybe(..), maybe)
import Effect.Class (liftEffect)
import React (ReactElement)
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 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 Thermite (Render, Spec
, simpleSpec, defaultPerformAction
, simpleSpec
, PerformAction, modifyState)
import Effect.Console (log)
import Effect.Aff (Aff)
import Gargantext.Config (toUrl, NodeType(..), End(..))
------------------------------------------------------------------------------
import Gargantext.Prelude
import Gargantext.Config (toUrl, NodeType(..), TabType(..), End(..))
import Gargantext.Config.REST (get)
import Gargantext.Pages.Annuaire.User.Contacts.Types.Types (Contact(..), HyperData(..))
import Gargantext.Pages.Annuaire.User.Contacts.Types (Contact(..), HyperData(..))
import Gargantext.Utils.DecodeMaybe ((.?|))
import Data.Argonaut (class DecodeJson, decodeJson, (.?))
------------------------------------------------------------------------------
type State = { info :: Maybe AnnuaireInfo
, stable :: Maybe AnnuaireTable
......@@ -80,9 +74,20 @@ toRows (AnnuaireTable a) = a.annuaireTable
layoutAnnuaire :: Spec State {} Action
layoutAnnuaire = simpleSpec performAction render
render :: Render State {} Action
render dispatch _ state _ = [ div [className "row"]
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"]
[ div [className "col-md-3"] [ h3 [] [text info.name] ]
, div [className "col-md-9"] [ hr [style {height : "2px",backgroundColor : "black"}] ]
]
......@@ -130,7 +135,7 @@ showRow :: Maybe Contact -> ReactElement
showRow Nothing = tr [][]
showRow (Just (Contact { id : id, hyperdata : (HyperData contact) })) =
tr []
[ td [] [ a [ href (toUrl Back NodeUser id) ] [ text $ maybe' contact.nom <> " " <> maybe' contact.prenom ] ]
[ td [] [ a [ href (toUrl Front NodeUser id) ] [ text $ maybe' contact.nom <> " " <> maybe' contact.prenom ] ]
, td [] [text $ maybe' contact.fonction]
, td [] [text $ maybe' contact.service]
, td [] [text $ maybe' contact.groupe]
......@@ -175,28 +180,10 @@ instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where
rows <- decodeJson json
pure $ AnnuaireTable { annuaireTable : rows}
------------------------------------------------------------------------
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
getTable :: Int -> Aff AnnuaireTable
getTable id = get $ toUrl Back (Tab TabDocs 0 10) id
getInfo :: Int -> Aff (Either String AnnuaireInfo)
getInfo :: Int -> Aff AnnuaireInfo
getInfo id = get $ toUrl Back Node id
------------------------------------------------------------------------------
_table :: Lens' State (Maybe AnnuaireTable)
......
src/Gargantext/Pages/Annuaire/User/Contacts/API.purs
View file @ c6739d57
module Gargantext.Pages.Annuaire.User.Contacts.API where
import Prelude
import Control.Monad.Trans.Class (lift)
import Data.Either (Either(..))
import Data.Lens ((?~))
......@@ -9,22 +7,19 @@ 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)
getUser :: Int -> Aff (Either String Contact)
getUser id = get $ toUrl Back Node id
getContact :: Int -> Aff Contact
getContact id = get $ toUrl Back Node id
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
fetchContact :: Int -> StateCoTransformer State Unit
fetchContact contactId = do
contact <- lift $ getContact contactId
void $ modifyState $ _contact ?~ contact
logs "Fetching contact..."
src/Gargantext/Pages/Annuaire/User/Contacts/Specs.purs
View file @ c6739d57
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 Thermite (Spec, simpleSpec)
import Gargantext.Pages.Annuaire.User.Contacts.Types (Action, State)
import Gargantext.Pages.Annuaire.User.Contacts.API (performAction)
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)
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 @ c6739d57
......@@ -54,13 +54,14 @@ mapMyMap f m = toUnfoldable
infixl 4 mapMyMap as <.~$>
contactInfos :: Maybe HyperData -> ReactElement
contactInfos :: HyperData -> ReactElement
contactInfos hyperdata =
ul [className "list-group"] $
listInfo <.~$> (checkMaybe hyperdata)
ul [className "list-group"] [] {- $
listInfo <.~$> 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 @ c6739d57
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
module Gargantext.Pages.Annuaire.User.Contacts.Types where
import Prelude
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
]
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
src/Gargantext/Pages/Annuaire/User/Contacts/Types/Lens.purs deleted 100644 → 0
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 deleted 100644 → 0
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 deleted 100644 → 0
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 @ c6739d57
module Gargantext.Pages.Corpus where
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 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 React.DOM (div, h3, hr, i, p, text)
import React.DOM.Props (className, style)
import Thermite (Render, Spec, defaultPerformAction, simpleSpec)
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
-------------------------------------------------------------------
type Props = Tabs.Props
type State = { info :: Maybe CorpusInfo
type State = { tabsView :: Tabs.State
}
initialState :: State
initialState = { info : Nothing }
data Action = Load Int
newtype Node a = Node { id :: Int
, typename :: Int
, userId :: Int
, parentId :: Int
, name :: String
, date :: String
, hyperdata :: a
initialState = { tabsView : Tabs.initialState
}
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}
------------------------------------------------------------------------
_tabsView :: forall a b. Lens' { tabsView :: a | b } a
_tabsView = lens (\s -> s.tabsView) (\s ss -> s{tabsView = ss})
------------------------------------------------------------------------
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"
data Action
= TabsA Tabs.Action
hyperdata <- obj .? "hyperdata"
hyperdata' <- decodeJson hyperdata
_tabsAction :: Prism' Action Tabs.Action
_tabsAction = prism TabsA \ action ->
case action of
TabsA taction -> Right taction
-- _-> Left action
pure $ Node { id : id
, typename : typename
, userId : userId
, parentId : parentId
, name : name
, date : date
, hyperdata: hyperdata'
}
layout :: Spec State {} Action
layout = corpusSpec -- <> Tab.pureTab1
corpusSpec :: Spec State {} Action
corpusSpec = simpleSpec defaultPerformAction render
------------------------------------------------------------------------
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
corpusHeaderSpec :: Spec {} Props Void
corpusHeaderSpec = simpleSpec defaultPerformAction render
where
render :: Render State {} Action
render dispatch _ state _ =
render :: Render {} Props Void
render dispatch {loaded} _ _ =
[ div [className "row"]
[ div [className "col-md-3"] [ h3 [] [text corpus.title] ]
[ div [className "col-md-3"] [ h3 [] [text "Corpus " <> text 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 corpus.date
, text $ " " <> date'
]
, p [] [ i [className "fa fa-user"] []
, text corpus.authors
, text $ " " <> corpus.authors
]
]
]
]
-- , chart globalPublis TODO add chart data in state
]
where
CorpusInfo corpus = maybe corpusInfoDefault identity state.info
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
corpusLoader :: Loader.Props Int (NodePoly CorpusInfo) -> ReactElement
corpusLoader = React.createLeafElement corpusLoaderClass
src/Gargantext/Pages/Corpus/Doc/Facets/Dashboard.purs → src/Gargantext/Pages/Corpus/Dashboard.purs
View file @ c6739d57
module Gargantext.Pages.Corpus.Doc.Facets.Dashboard where
module Gargantext.Pages.Corpus.Dashboard where
import Prelude hiding (div)
......
src/Gargantext/Pages/Corpus/Doc/Annotation.purs deleted 100644 → 0
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 deleted 100644 → 0
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/Doc/Facets/Specs.purs deleted 100644 → 0
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 deleted 100644 → 0
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/Document.purs 0 → 100644
View file @ c6739d57
module Gargantext.Pages.Corpus.Document where
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.?), (:=), (~>))
import Data.Generic.Rep (class Generic)
import Data.Lens (Lens', Prism', lens, prism, (?~))
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..), maybe)
import Data.Either (Either(..))
import Effect.Aff (Aff)
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)
import Control.Monad.Trans.Class (lift)
import Gargantext.Prelude
import Gargantext.Config (toUrl, NodeType(..), End(..))
import Gargantext.Config.REST (get)
import Gargantext.Components.Node (NodePoly(..))
type State =
{ document :: Maybe (NodePoly DocumentV3)
, inputValue :: String
}
initialState :: State
initialState =
{ document : Nothing
, inputValue : ""
}
data Action
= Load Int
| ChangeString String
| SetInput String
newtype Status = Status { failed :: Int
, succeeded :: Int
, remaining :: Int
}
newtype DocumentV3 =
DocumentV3 { abstract :: Maybe String
, authors :: Maybe String
--, error :: Maybe String
, language_iso2 :: Maybe String
, language_iso3 :: Maybe String
, language_name :: Maybe String
, publication_date :: Maybe String
, publication_day :: Maybe Int
, publication_hour :: Maybe Int
, publication_minute :: Maybe Int
, publication_month :: Maybe Int
, publication_second :: Maybe Int
, publication_year :: Maybe Int
, realdate_full_ :: Maybe String
, source :: Maybe String
, statuses :: Maybe (Array Status)
, title :: Maybe String
}
defaultNodeDocumentV3 :: NodePoly DocumentV3
defaultNodeDocumentV3 =
NodePoly { id : 0
, typename : 0
, userId : 0
, parentId : 0
, name : "Default name"
, date : "Default date"
, hyperdata : defaultDocumentV3
}
defaultDocumentV3 :: DocumentV3
defaultDocumentV3 =
DocumentV3 { abstract : Nothing
, authors : Nothing
--, error : Nothing
, language_iso2 : Nothing
, language_iso3 : Nothing
, language_name : Nothing
, publication_date : Nothing
, publication_day : Nothing
, publication_hour : Nothing
, publication_minute : Nothing
, publication_month : Nothing
, publication_second : Nothing
, publication_year : Nothing
, realdate_full_ : Nothing
, source : Nothing
, statuses : Nothing
, title : Nothing
}
data Document =
Document { abstract :: Maybe String
, authors :: Maybe String
, bdd :: Maybe String
, doi :: Maybe Int
, language_iso2 :: Maybe String
, language_iso3 :: Maybe String
, page :: Maybe Int
, publication_date :: Maybe String
, publication_second :: Maybe Int
, publication_minute :: Maybe Int
, publication_hour :: Maybe Int
, publication_day :: Maybe String
, publication_month :: Maybe Int
, publication_year :: Maybe Int
, source :: Maybe String
, title :: Maybe String
, uniqId :: Maybe String
, url :: Maybe String
, text :: Maybe String
}
defaultNodeDocument :: NodePoly Document
defaultNodeDocument =
NodePoly { id : 0
, typename : 0
, userId : 0
, parentId : 0
, name : "Default name"
, date : "Default date"
, hyperdata : defaultDocument
}
defaultDocument :: Document
defaultDocument =
Document { abstract : Nothing
, authors : Nothing
, bdd : Nothing
, doi : Nothing
, language_iso2 : Nothing
, language_iso3 : Nothing
, page : Nothing
, publication_date : Nothing
, publication_second : Nothing
, publication_minute : Nothing
, publication_hour : Nothing
, publication_day : Nothing
, publication_month : Nothing
, publication_year : Nothing
, source : Nothing
, title : Nothing
, uniqId : Nothing
, url : Nothing
, text : Nothing
}
derive instance genericDocument :: Generic Document _
derive instance genericDocumentV3 :: Generic DocumentV3 _
derive instance genericStatus :: Generic Status _
instance showDocument :: Show Document where
show = genericShow
instance showDocumentV3 :: Show DocumentV3 where
show = genericShow
instance showStatus :: Show Status where
show = genericShow
instance decodeStatus :: DecodeJson Status
where
decodeJson json = do
obj <- decodeJson json
failed <- obj .? "failed"
succeeded <- obj .? "succeeded"
remaining <- obj .? "remaining"
pure $ Status {failed, succeeded, remaining}
instance decodeDocumentV3 :: DecodeJson DocumentV3
where
decodeJson json = do
obj <- decodeJson json
abstract <- obj .? "abstract"
authors <- obj .? "authors"
--error <- obj .? "error"
language_iso2 <- obj .? "language_iso2"
language_iso3 <- obj .? "language_iso3"
language_name <- obj .? "language_name"
publication_date <- obj .? "publication_date"
publication_day <- obj .? "publication_day"
publication_hour <- obj .? "publication_hour"
publication_minute <- obj .? "publication_minute"
publication_month <- obj .? "publication_month"
publication_second <- obj .? "publication_second"
publication_year <- obj .? "publication_year"
realdate_full_ <- obj .? "realdate_full_"
source <- obj .? "source"
statuses <- obj .? "statuses"
title <- obj .? "title"
pure $ DocumentV3 { abstract
, authors
--, error
, language_iso2
, language_iso3
, language_name
, publication_date
, publication_day
, publication_hour
, publication_minute
, publication_month
, publication_second
, publication_year
, realdate_full_
, source
, statuses
, title
}
instance decodeDocument :: DecodeJson Document
where
decodeJson json = do
obj <- decodeJson json
abstract <- obj .? "abstract"
authors <- obj .? "authors"
bdd <- obj .? "bdd"
doi <- obj .? "doi"
language_iso2 <- obj .? "language_iso2"
language_iso3 <- obj .? "language_iso3"
page <- obj .? "page"
publication_date <- obj .? "publication_date"
publication_second <- obj .? "publication_second"
publication_minute <- obj .? "publication_minute"
publication_hour <- obj .? "publication_hour"
publication_day <- obj .? "publication_day"
publication_month <- obj .? "publication_month"
publication_year <- obj .? "publication_year"
source <- obj .? "source"
title <- obj .? "title"
uniqId <- obj .? "uniqId"
url <- obj .? "url"
text <- obj .? "text"
pure $ Document { abstract
, authors
, bdd
, doi
, language_iso2
, language_iso3
, page
, publication_date
, publication_second
, publication_minute
, publication_hour
, publication_day
, publication_month
, publication_year
, source
, title
, uniqId
, url
, text
}
------------------------------------------------------------------------
performAction :: PerformAction State {} Action
performAction (Load nId) _ _ = do
node <- lift $ getNode nId
void $ modifyState $ _document ?~ node
logs $ "Node Document " <> show nId <> " fetched."
performAction (ChangeString ps) _ _ = pure unit
performAction (SetInput ps) _ _ = void <$> modifyState $ _ { inputValue = ps }
getNode :: Int -> Aff (NodePoly DocumentV3)
getNode = get <<< toUrl Back Node
_document :: Lens' State (Maybe (NodePoly DocumentV3))
_document = lens (\s -> s.document) (\s ss -> s{document = ss})
------------------------------------------------------------------------
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 "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' document.title]
, ul [className "list-group"]
[ li' [ span [] [text' document.source]
, badge "source"
]
-- TODO add href to /author/ if author present in
, li' [ span [] [text' document.authors]
, badge "authors"
]
, li' [ span [] [text' document.publication_date]
, badge "date"
]
]
, badge "abstract"
, p [] [text' document.abstract]
, div [className "jumbotron"]
[ p [] [text "Empty Full Text"]
]
]
]
]
]
where
li' = li [className "list-group-item justify-content-between"]
text' x = text $ maybe "Nothing" identity x
badge s = span [className "badge badge-default badge-pill"] [text s]
NodePoly {hyperdata : DocumentV3 document} =
maybe defaultNodeDocumentV3 identity state.document
aryPS :: Array String
aryPS = ["Map", "Main", "Stop"]
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/Graph.purs → src/Gargantext/Pages/Corpus/Graph.purs
View file @ c6739d57
module Gargantext.Pages.Corpus.Doc.Facets.Graph where
module Gargantext.Pages.Corpus.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)
......@@ -28,6 +15,13 @@ 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
......@@ -59,18 +53,16 @@ graphSpec = simpleSpec performAction render
performAction :: PerformAction State {} Action
performAction (LoadGraph fp) _ _ = void do
_ <- liftEffect $ log fp
_ <- logs 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
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'}
-- 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}
performAction (SelectNode node) _ _ = void do
modifyState $ \(State s) -> State s {selectedNode = pure node}
......@@ -117,7 +109,7 @@ render d p (State s) c =
, settings : mySettings
, style : sStyle { height : "95%"}
-- , onClickNode : \e -> do
-- log $ unsafeCoerce e
-- logs $ unsafeCoerce e
-- d $ SelectNode $ SelectedNode {id : (unsafeCoerce e).data.node.id, label : (unsafeCoerce e).data.node.label}
-- pure unit
-- TODO: fix this!
......@@ -221,27 +213,8 @@ mySettings = sigmaSettings { verbose : true
-- loadJSON {path : "http://localhost:2015/examples/sites_coords.json"}
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
getGraphData :: String -> Aff GraphData
getGraphData fp = get $ "http://localhost:2015/examples/" <> fp
defaultPalette :: Array Color
defaultPalette = map Color defaultPalette'
......@@ -392,7 +365,7 @@ specOld = simpleSpec performAction render'
, settings : mySettings
, style : sStyle { height : "95%"}
-- , onClickNode : \e -> do
-- log $ unsafeCoerce e
-- logs $ unsafeCoerce e
-- d $ SelectNode $ SelectedNode {id : (unsafeCoerce e).data.node.id, label : (unsafeCoerce e).data.node.label}
-- pure unit
}
......
src/Gargantext/Pages/Corpus/Tabs.purs 0 → 100644
View file @ c6739d57
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/Doc/Facets/Actions.purs → src/Gargantext/Pages/Corpus/Tabs/Actions.purs
View file @ c6739d57
module Gargantext.Pages.Corpus.Doc.Facets.Actions where
module Gargantext.Pages.Corpus.Tabs.Actions where
import Data.Lens (Prism', prism)
import Data.Either (Either(..))
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.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
data Action
......@@ -46,6 +46,3 @@ _tabAction = prism TabViewA \ action ->
case action of
TabViewA laction -> Right laction
_-> Left action
src/Gargantext/Pages/Corpus/Doc/Facets/Authors.purs → src/Gargantext/Pages/Corpus/Tabs/Authors.purs
View file @ c6739d57
module Gargantext.Pages.Corpus.Doc.Facets.Authors where
module Gargantext.Pages.Corpus.Tabs.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 = D.State
type State = {}
initialState :: State
initialState = D.tdata
initialState = {}
type Action = D.Action
type Action = Void
authorSpec :: Spec State {} Action
authorSpec = simpleSpec defaultPerformAction render
......@@ -20,6 +18,3 @@ 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/Doc/Facets/Documents.purs → src/Gargantext/Pages/Corpus/Tabs/Documents.purs
View file @ c6739d57
module Gargantext.Pages.Corpus.Doc.Facets.Documents where
module Gargantext.Pages.Corpus.Tabs.Documents where
import Prelude hiding (div)
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift)
import Data.Array (take, drop)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.?), (:=), (~>))
import Data.Array (filter)
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow)
import Data.HTTP.Method (Method(..))
import Data.Maybe (maybe)
import Data.Tuple (Tuple(..))
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Gargantext.Config (NodeType(..), toUrl, End(..))
import Gargantext.Config.REST (get)
import React.DOM (a, br', div, input, p, text)
import React.DOM.Props (_type, className, href)
import Thermite (Render, Spec, defaultPerformAction, simpleSpec)
------------------------------------------------------------------------
import Gargantext.Prelude
import Gargantext.Config (NodeType(..), TabType(..), toUrl, End(..))
import Gargantext.Config.REST (get, post)
import Gargantext.Utils.DecodeMaybe ((.|))
import React (ReactElement)
import React.DOM (a, b, b', br', div, input, option, select, span, table, tbody, td, text, th, thead, tr, p)
import React.DOM.Props (_type, className, href, onChange, onClick, scope, selected, value)
import Thermite (PerformAction, Render, Spec, modifyState, defaultPerformAction, simpleSpec)
import Unsafe.Coerce (unsafeCoerce)
--main :: forall e. Eff (dom:: DOM, console :: CONSOLE, ajax :: AJAX | e) Unit
--main = do
-- case createReactSpec layoutDocview tdata of
-- { spec, dispatcher } -> void $ do
-- document <- DOM.window >>= DOM.document
-- container <- unsafePartial (fromJust <$> DOM.querySelector (QuerySelector "#app") (DOM.htmlDocumentToParentNode document))
-- RDOM.render (R.createFactory (R.createClass spec) {}) container
--
import Gargantext.Components.Charts.Options.ECharts (chart)
import Gargantext.Components.Table as T
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Pages.Corpus.Tabs.Types
import Gargantext.Pages.Corpus.Dashboard (globalPublis)
------------------------------------------------------------------------
-- TODO: Pagination Details are not available from the BackEnd
-- TODO: PageSize Change manually sets the totalPages, need to get from backend and reload the data
-- TODO: Search is pending
-- TODO: Fav is pending
-- TODO: Sort is Pending
-- TODO: Filter is Pending
-- TODO: When a pagination link is clicked, reload data.
-- Right now it doesn't make sense to reload mock data.
data Action
= LoadData Int
| ChangePageSize PageSizes
| ChangePage Int
type State = {}
type State = CorpusTableData
type Action = Void
type CorpusTableData = TableData CorpusView
newtype TableData a
= TableData
{ rows :: Array { row :: a
, delete :: Boolean
}
, totalPages :: Int
, currentPage :: Int
, pageSize :: PageSizes
, totalRecords :: Int
, title :: String
-- , tree :: FTree
}
newtype CorpusView
= CorpusView
newtype DocumentsView
= DocumentsView
{ _id :: Int
, url :: String
, date :: String
......@@ -78,9 +45,9 @@ newtype CorpusView
}
derive instance genericCorpus :: Generic CorpusView _
derive instance genericCorpus :: Generic DocumentsView _
instance showCorpus :: Show CorpusView where
instance showCorpus :: Show DocumentsView where
show = genericShow
......@@ -143,283 +110,100 @@ filterSpec = simpleSpec defaultPerformAction render
, input []
]]
layoutDocview :: Spec State {} Action
layoutDocview = simpleSpec performAction render
-- | Main layout of the Documents Tab of a Corpus
layoutDocview :: Spec State Props Action
layoutDocview = simpleSpec absurd render
where
render :: Render State {} Action
render dispatch _ state@(TableData d) _ =
render :: Render State Props Action
render dispatch {path, loaded} _ _ =
[ div [className "container1"]
[ div [className "row"]
[
div [className "col-md-12"]
[ chart globalPublis
, div [className "col-md-12"]
[ p [] []
, div [] [ text " Filter ", input []]
, br'
, div [className "row"]
[ div [className "col-md-1"] [b [] [text d.title]]
, div [className "col-md-2"] [sizeDD d.pageSize dispatch]
, div [className "col-md-3"] [textDescription d.currentPage d.pageSize d.totalRecords]
, div [className "col-md-3"] [pagination dispatch d.totalPages d.currentPage]
]
, table [ className "table"]
[thead [ className "thead-dark"]
[tr [] [ th [scope "col"] [ b' [text ""] ]
, th [scope "col"] [ b' [text "Date"]]
, th [scope "col"] [ b' [text "Title"] ]
, th [scope "col"] [ b' [text "Delete"] ]
]
]
, tbody [] $ map showRow d.rows
]
, T.tableElt
{ loadRows
, title: "Documents"
, colNames:
[ ""
, "Date"
, "Title"
, "Source"
, "Delete"
]
, totalRecords: maybe 47361 -- TODO
identity
((\(NodePoly n) -> n.hyperdata)
>>>
(\(CorpusInfo c) -> c.totalRecords)
<$> loaded)
}
]
]
]
]
performAction :: PerformAction State {} Action
performAction (ChangePageSize ps) _ _ = void $ modifyState $ changePageSize ps
performAction (ChangePage p) _ _ = void $ modifyState \(TableData td) -> TableData $ td { currentPage = p }
performAction (LoadData n) _ _ = do
res <- lift $ loadPage n
case res of
Left err -> do
_ <- liftEffect $ log $ show err
_ <- liftEffect $ log $ show "Error: loading page documents"
pure unit
Right resData -> do
_ <- liftEffect $ log $ show "OK: loading page documents"
void $ modifyState $ const resData
loadPage :: Int -> Aff (Either String CorpusTableData)
loadPage n = do
res <- get $ toUrl Back Children n
-- TODO: offset and limit
-- res <- get "http://localhost:8008/corpus/472764/facet/documents/table?offset=0&limit=10"
case res of
Left err -> do
_ <- liftEffect $ log $ show "Err: loading page documents"
_ <- liftEffect $ log $ show err
pure $ Left $ show err
Right resData -> do
let docs = toTableData (res2corpus $ resData)
_ <- liftEffect $ log $ show "Ok: loading page documents"
_ <- liftEffect $ log $ show $ map (\({ row: r, delete :_}) -> show r) ((\(TableData docs') -> docs'.rows) docs)
pure $ Right docs
where
res2corpus :: Array Response -> Array CorpusView
res2corpus rs = map (\(Response r) ->
CorpusView { _id : r.cid
loadRows {offset, limit} = do
_ <- logs "loading documents page"
res <- loadPage {nodeId: path,offset,limit}
_ <- logs "OK: loading page documents."
pure $
(\(DocumentsView r) ->
{ row:
[ div [className $ fa r.fav <> "fa-star"] []
-- TODO show date: Year-Month-Day only
, text r.date
, a [ href (toUrl Front Url_Document r._id) ] [ text r.title ]
, text r.source
, input [ _type "checkbox"]
]
, delete: false
}) <$> res
fa true = "fas "
fa false = "far "
mock :: Boolean
mock = false
loadPage :: {nodeId :: Int, limit :: Int, offset :: Int} -> Aff (Array DocumentsView)
loadPage {nodeId, limit, offset} = do
logs "loading documents page: loadPage with Offset and limit"
--res <- get $ toUrl Back (Children Url_Document offset limit) nodeId
res <- get $ toUrl Back (Tab TabDocs offset limit ) nodeId
let docs = res2corpus <$> res
_ <- logs "Ok: loading page documents"
_ <- logs $ map show docs
pure $
if mock then take limit $ drop offset sampleData else
docs
where
res2corpus :: Response -> DocumentsView
res2corpus (Response r) =
DocumentsView { _id : r.cid
, url : ""
, date : r.created
, title : (\(Hyperdata hr) -> hr.title) r.hyperdata
, source : (\(Hyperdata hr) -> hr.source) r.hyperdata
, fav : r.favorite
, ngramCount : r.ngramCount
}) rs
toTableData :: Array CorpusView -> CorpusTableData
toTableData ds = TableData
{ rows : map (\d -> { row : d , delete : false}) ds
, totalPages : 474
, currentPage : 1
, pageSize : PS100
, totalRecords : 47361
, title : "Documents"
}
---------------------------------------------------------
sampleData' :: CorpusView
sampleData' = CorpusView {_id : 1, url : "", date : "date3", title : "title", source : "source", fav : false, ngramCount : 1}
---------------------------------------------------------
sampleData' :: DocumentsView
sampleData' = DocumentsView {_id : 1, url : "", date : "date3", title : "title", source : "source", fav : false, ngramCount : 1}
sampleData :: Array CorpusView
sampleData :: Array DocumentsView
--sampleData = replicate 10 sampleData'
sampleData = map (\(Tuple t s) -> CorpusView {_id : 1, url : "", date : "2017", title: t, source: s, fav : false, ngramCount : 10}) sampleDocuments
sampleData = map (\(Tuple t s) -> DocumentsView {_id : 1, url : "", date : "2017", title: t, source: s, fav : false, ngramCount : 10}) sampleDocuments
sampleDocuments :: Array (Tuple String String)
sampleDocuments = [Tuple "Macroscopic dynamics of the fusion process" "Journal de Physique Lettres",Tuple "Effects of static and cyclic fatigue at high temperature upon reaction bonded silicon nitride" "Journal de Physique Colloques",Tuple "Reliability of metal/glass-ceramic junctions made by solid state bonding" "Journal de Physique Colloques",Tuple "High temperature mechanical properties and intergranular structure of sialons" "Journal de Physique Colloques",Tuple "SOLUTIONS OF THE LANDAU-VLASOV EQUATION IN NUCLEAR PHYSICS" "Journal de Physique Colloques",Tuple "A STUDY ON THE FUSION REACTION 139La + 12C AT 50 MeV/u WITH THE VUU EQUATION" "Journal de Physique Colloques",Tuple "Atomic structure of \"vitreous\" interfacial films in sialon" "Journal de Physique Colloques",Tuple "MICROSTRUCTURAL AND ANALYTICAL CHARACTERIZATION OF Al2O3/Al-Mg COMPOSITE INTERFACES" "Journal de Physique Colloques",Tuple "Development of oxidation resistant high temperature NbTiAl alloys and intermetallics" "Journal de Physique IV Colloque",Tuple "Determination of brazed joint constitutive law by inverse method" "Journal de Physique IV Colloque",Tuple "Two dimensional estimates from ocean SAR images" "Nonlinear Processes in Geophysics",Tuple "Comparison Between New Carbon Nanostructures Produced by Plasma with Industrial Carbon Black Grades" "Journal de Physique III",Tuple "<i>Letter to the Editor:</i> SCIPION, a new flexible ionospheric sounder in Senegal" "Annales Geophysicae",Tuple "Is reducibility in nuclear multifragmentation related to thermal scaling?" "Physics Letters B",Tuple "Independence of fragment charge distributions of the size of heavy multifragmenting sources" "Physics Letters B",Tuple "Hard photons and neutral pions as probes of hot and dense nuclear matter" "Nuclear Physics A",Tuple "Surveying the nuclear caloric curve" "Physics Letters B",Tuple "A hot expanding source in 50 A MeV Xe+Sn central reactions" "Physics Letters B"]
data' :: Array CorpusView -> Array {row :: CorpusView, delete :: Boolean}
data' = map {row : _, delete : false}
sdata :: Array { row :: CorpusView, delete :: Boolean }
sdata = data' sampleData
tdata :: TableData CorpusView
tdata = TableData
{ rows : sdata
, totalPages : 10
, currentPage : 1
, pageSize : PS10
, totalRecords : 100
, title : "Documents"
-- , tree : exampleTree
}
showRow :: {row :: CorpusView, delete :: Boolean} -> ReactElement
showRow {row : (CorpusView c), delete} =
tr []
[ td [] [div [className $ fa <> "fa-star"][]]
-- TODO show date: Year-Month-Day only
, td [] [text c.date]
, td [] [ a [ href (toUrl Front Document c._id) ] [ text c.title ] ]
, td [] [text c.source]
, td [] [input [ _type "checkbox"]]
]
where
fa = case c.fav of
true -> "fas "
false -> "far "
--------------------------------------------------------------
-- | Action
-- ChangePageSize
changePageSize :: PageSizes -> CorpusTableData -> CorpusTableData
changePageSize ps (TableData td) =
TableData $ td { pageSize = ps
, totalPages = td.totalRecords / pageSizes2Int ps
, currentPage = 1
}
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
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
]
optps :: PageSizes -> PageSizes -> ReactElement
optps cv val = option [ selected (cv == val), value $ show val ] [text $ show val]
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 :: (Action -> Effect Unit) -> Int -> Int -> ReactElement
pagination d 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 -> d $ ChangePage $ cp - 1)
] [text "Previous"]
, text " "
]
next = if cp == tp then
text " Next "
else
span []
[ text " "
, a [ href "javascript:void()"
, onClick (\e -> d $ ChangePage $ cp + 1)
] [text "Next"]
, text " "
]
first = if cp == 1 then
text ""
else
span []
[ text " "
, a [ href "javascript:void()"
, onClick (\e -> d $ ChangePage 1)
] [text "1"]
, text " "
]
last = if cp == tp then
text ""
else
span []
[ text " "
, a [ href "javascript:void()"
, onClick (\e -> d $ 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 d i) $ filter (lessthan 1) [cp - 2, cp - 1]
rnums = map (\i -> fnmid d i) $ filter (greaterthan tp) [cp + 1, cp + 2]
fnmid :: (Action -> Effect Unit) -> Int -> ReactElement
fnmid d i
= span []
[ text " "
, a [ href "javascript:void()"
, onClick (\e -> d $ ChangePage 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
initialState :: State
initialState = {}
newtype SearchQuery = SearchQuery
{
......@@ -436,21 +220,6 @@ instance encodeJsonSQuery :: EncodeJson SearchQuery where
searchResults :: SearchQuery -> Aff (Either String (Int))
searchResults squery = do
res <- request $ defaultRequest
{ url = "http://localhost:8008/count"
, responseFormat = ResponseFormat.json
, method = Left POST
, 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
searchResults :: SearchQuery -> Aff Int
searchResults squery = post "http://localhost:8008/count" unit
-- TODO
src/Gargantext/Pages/Corpus/Doc/Facets/Sources.purs → src/Gargantext/Pages/Corpus/Tabs/Sources.purs
View file @ c6739d57
module Gargantext.Pages.Corpus.Doc.Facets.Sources where
module Gargantext.Pages.Corpus.Tabs.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 = D.State
type State = {}
initialState :: State
initialState = {}
initialState :: D.State
initialState = D.tdata
type Action = D.Action
type Action = Void
sourceSpec :: Spec State {} Action
sourceSpec = simpleSpec defaultPerformAction render
......@@ -22,6 +18,3 @@ 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/Tabs/Specs.purs 0 → 100644
View file @ c6739d57
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 0 → 100644
View file @ c6739d57
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/Doc/Facets/Terms.purs → src/Gargantext/Pages/Corpus/Tabs/Terms.purs
View file @ c6739d57
module Gargantext.Pages.Corpus.Doc.Facets.Terms where
module Gargantext.Pages.Corpus.Tabs.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 = {}
type State = D.State
initialState :: D.State
initialState = D.tdata
type Action = D.Action
initialState :: State
initialState = {}
type Action = Void
termsSpec :: Spec State {} Action
termsSpec = simpleSpec defaultPerformAction render
......@@ -23,6 +19,3 @@ 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/Doc/Facets/Terms/NgramsItem.purs → src/Gargantext/Pages/Corpus/Tabs/Terms/NgramsItem.purs
View file @ c6739d57
module Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsItem where
module Gargantext.Pages.Corpus.Tabs.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, hide, focusState)
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec, hideState, 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 = hide (unwrap initialState) $
ngramsItemSpec = hideState (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/Doc/Facets/Terms/NgramsTable.purs → src/Gargantext/Pages/Corpus/Tabs/Terms/NgramsTable.purs
View file @ c6739d57
module Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsTable where
module Gargantext.Pages.Corpus.Tabs.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.Doc.Facets.Terms.NgramsItem as NI
import Gargantext.Pages.Corpus.Tabs.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, hide)
import Thermite (PerformAction, Spec, _render, focus, foreach, modifyState, focusState, hideState)
import Unsafe.Coerce (unsafeCoerce)
newtype State = State
......@@ -60,6 +60,7 @@ _ItemAction = prism (uncurry ItemAction) \ta ->
type Dispatch = Action -> Effect Unit
{-
performAction :: PerformAction State {} Action
performAction (ChangePageSize ps) _ _ = void $ modifyState $ changePageSize ps
......@@ -77,6 +78,7 @@ 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 ->
......@@ -157,7 +159,7 @@ tableSpec = over _render \render dispatch p (State s) c ->
ngramsTableSpec :: Spec {} {} Void
ngramsTableSpec =
hide (unwrap initialState) $
hideState (unwrap initialState) $
focusState (re _Newtype) $
container $
tableSpec $
......@@ -314,8 +316,8 @@ pagination d tp cp
text " ... "
else
text ""
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]
lnums = map (\i -> fnmid d i) $ filter (1 < _) [cp - 2, cp - 1]
rnums = map (\i -> fnmid d i) $ filter (tp > _) [cp + 1, cp + 2]
fnmid :: Dispatch -> Int -> ReactElement
fnmid d i
......@@ -326,10 +328,3 @@ 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/Tabs/Types.purs 0 → 100644
View file @ c6739d57
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 @ c6739d57
......@@ -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, hide, focusState)
import Thermite (Render, Spec, simpleSpec, hideState, focusState)
-- Layout |
......@@ -26,7 +26,7 @@ landingData FR = Fr.landingData
landingData EN = En.landingData
layoutLanding :: Lang -> Spec {} {} Void
layoutLanding = hide (unwrap initialState)
layoutLanding = hideState (unwrap initialState)
<<< focusState (re _Newtype)
<<< layoutLanding' <<< landingData
......
src/Gargantext/Pages/Layout.purs
View file @ c6739d57
......@@ -4,13 +4,11 @@ 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.Doc.Facets as TV
-- import Gargantext.Pages.Corpus.Doc.Annotation as D
-- import Gargantext.Pages.Corpus.Tabs as TV
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.Corpus.Document as Document
import Gargantext.Pages.Corpus.Graph as GE
-- import Gargantext.Pages.Corpus.Tabs.Terms.NgramsTable as NG
import Gargantext.Pages.Annuaire.User.Contacts as C
import Gargantext.Pages.Annuaire as Annuaire
......@@ -36,13 +34,8 @@ 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 $ CorpusAction $ Corpus.Load n
dispatchAction dispatcher _ SearchView = do
dispatcher $ SetRoute SearchView
......@@ -60,13 +53,9 @@ dispatchAction dispatcher _ (Annuaire id) = do
dispatchAction dispatcher _ (Folder id) = do
dispatcher $ SetRoute $ Folder id
dispatchAction dispatcher _ (DocAnnotation i) = do
dispatcher $ SetRoute $ DocAnnotation i
-- dispatcher $ DocAnnotationViewA TODO
dispatchAction dispatcher _ Tabview = do
dispatcher $ SetRoute Tabview
-- dispatcher $ TabViewA TODO
dispatchAction dispatcher _ (Document n) = do
dispatcher $ SetRoute $ Document n
dispatcher $ DocumentViewA $ Document.Load n
dispatchAction dispatcher _ PGraphExplorer = do
dispatcher $ SetRoute PGraphExplorer
......
src/Gargantext/Pages/Layout/Actions.purs
View file @ c6739d57
......@@ -2,28 +2,24 @@
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 Effect.Console (log)
import Thermite (PerformAction, modifyState)
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)
------------------------------------------------------------------------
......@@ -31,14 +27,12 @@ data Action
= Initialize
| LoginA LN.Action
| SetRoute Routes
| AddCorpusA AC.Action
| DocViewA DV.Action
| TreeViewA Tree.Action
| SearchA S.Action
| Search String
| TreeViewA Tree.Action
| CorpusAction Corpus.Action
| AddCorpusA AC.Action
| GraphExplorerA GE.Action
| DocAnnotationViewA D.Action
| DocumentViewA D.Action
| AnnuaireAction Annuaire.Action
| UserPageA C.Action
| Go
......@@ -70,40 +64,19 @@ performAction Go _ _ = void do
---------------------------------------------------------
performAction Initialize _ state = void do
_ <- liftEffect $ log "loading Initial nodes"
_ <- logs "loading Initial nodes"
case state.initialized of
false -> do
lnodes <- lift $ Tree.loadDefaultNode
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
-- }
void $ modifyState $ _ { initialized = true, ntreeState = lnodes }
_ -> 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 (DocAnnotationViewA _) _ _ = pure unit
performAction (DocumentViewA _) _ _ = pure unit
performAction (TreeViewA _) _ _ = pure unit
performAction (GraphExplorerA _) _ _ = pure unit
performAction (AnnuaireAction _) _ _ = pure unit
......@@ -122,18 +95,6 @@ _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
......@@ -152,10 +113,10 @@ _annuaireAction = prism AnnuaireAction \action ->
AnnuaireAction a -> Right a
_ -> Left action
_docAnnotationViewAction :: Prism' Action D.Action
_docAnnotationViewAction = prism DocAnnotationViewA \action ->
_documentViewAction :: Prism' Action D.Action
_documentViewAction = prism DocumentViewA \action ->
case action of
DocAnnotationViewA caction -> Right caction
DocumentViewA caction -> Right caction
_-> Left action
_treeAction :: Prism' Action Tree.Action
......
src/Gargantext/Pages/Layout/Specs.purs
View file @ c6739d57
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.Pages.Annuaire as A
import Gargantext.Folder as F
import Gargantext.Pages.Corpus as Corpus
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 as A
import Gargantext.Pages.Annuaire.User.Contacts as C
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.Home as L
import Gargantext.Pages.Layout.Actions (Action(..), _corpusAction, _addCorpusAction, _docAnnotationViewAction, _docViewAction, _graphExplorerAction, _loginAction, _searchAction, _treeAction, _userPageAction, performAction, _annuaireAction)
import Gargantext.Pages.Layout.Actions (Action(..), _addCorpusAction, _documentViewAction, _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, _corpusState, _addCorpusState, _docAnnotationViewState, _docViewState, _graphExplorerState, _loginState, _searchState, _treeState, _userPageState, _annuaireState)
import Gargantext.Pages.Layout.States (AppState, _addCorpusState, _documentViewState, _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 =
......@@ -48,28 +46,26 @@ 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
Nothing -> selectSpec Home -- TODO add Error page here: url requested does not exist (with funny Garg image)
where
selectSpec :: Routes -> Spec AppState {} Action
selectSpec (Corpus i) = layout0 $ focus _corpusState _corpusAction Corpus.layout
selectSpec Login = focus _loginState _loginAction LN.renderSpec
selectSpec Home = layout0 $ noState (L.layoutLanding EN)
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 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 NGramsTable = layout0 $ noState NG.ngramsTableSpec
selectSpec (Document i) = layout0 $ focus _documentViewState _documentViewAction Annotation.docview
selectSpec PGraphExplorer = focus _graphExplorerState _graphExplorerAction GE.specOld
selectSpec Dashboard = layout0 $ noState Dsh.layoutDashboard
selectSpec (Annuaire i) = layout0 $ focus _annuaireState _annuaireAction A.layoutAnnuaire
selectSpec (Folder i) = layout0 $ noState F.layoutFolder
selectSpec (UserPage i) = layout0 $ focus _userPageState _userPageAction C.layoutUser
-- To be removed
selectSpec NGramsTable = layout0 $ noState NG.ngramsTableSpec
-- selectSpec _ = simpleSpec defaultPerformAction defaultRender
......
src/Gargantext/Pages/Layout/Specs/AddCorpus/Actions.purs
View file @ c6739d57
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, decodeJson, encodeJson, jsonEmptyObject, stringify, (:=), (~>))
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(Just))
import Data.MediaType.Common (applicationJSON)
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
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)
import Gargantext.Prelude
import Gargantext.Config.REST (post)
import Gargantext.Components.Modals.Modal (modalHide)
import Gargantext.Pages.Layout.Specs.AddCorpus.States (Response, State)
data Action
= SelectDatabase Boolean
| UnselectDatabase Boolean
......@@ -35,10 +27,7 @@ performAction (UnselectDatabase unselected) _ _ = void do
performAction (LoadDatabaseDetails) _ _ = do
res <- lift $ getDatabaseDetails $ QueryString { query_query: "string",query_name: ["Pubmed"]}
case res of
Left err -> pure unit
Right resData -> do
void $ modifyState $ _ {response = resData}
void $ modifyState $ _ {response = res}
performAction GO _ _ = do
liftEffect $ setHash "/corpus"
......@@ -68,25 +57,7 @@ instance encodeJsonQueryString :: EncodeJson QueryString where
~> "query_name" := obj.query_name
~> jsonEmptyObject
getDatabaseDetails :: QueryString -> Aff (Either String (Array Response))
getDatabaseDetails :: QueryString -> Aff (Array Response)
getDatabaseDetails reqBody = do
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
-- TODO let token = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJleHAiOjE1MTk5OTg1ODMsInVzZXJfaWQiOjUsImVtYWlsIjoiYWxleGFuZHJlLmRlbGFub2VAaXNjcGlmLmZyIiwidXNlcm5hbWUiOiJkZXZlbG9wZXIifQ.Os-3wuFNSmRIxCZi98oFNBu2zqGc0McO-dgDayozHJg"
post "http://localhost:8009/count" reqBody
src/Gargantext/Pages/Layout/Specs/AddCorpus/Specs.purs
View file @ c6739d57
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 (PerformAction, Render, Spec, _render, simpleSpec)
import Thermite (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 ->
......@@ -125,22 +113,5 @@ layoutAddcorpus = simpleSpec performAction render
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
countResults :: Query -> Aff Int
countResults = post "http://localhost:8008/count"
src/Gargantext/Pages/Layout/Specs/Search.purs
View file @ c6739d57
......@@ -27,20 +27,19 @@ 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 @ c6739d57
......@@ -7,11 +7,10 @@ import Data.Maybe (Maybe(Just))
import Gargantext.Components.Login as LN
import Gargantext.Components.Tree as Tree
import Gargantext.Pages.Corpus as Corpus
import Gargantext.Pages.Corpus.Doc.Annotation as D
import Gargantext.Pages.Corpus.Document 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.Corpus.Tabs.Documents as DV
import Gargantext.Pages.Corpus.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
......@@ -20,12 +19,11 @@ 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
, docAnnotationState :: D.State
, documentState :: D.State
, annuaireState :: Annuaire.State
, ntreeState :: Tree.State
, search :: String
......@@ -38,13 +36,12 @@ type AppState =
initAppState :: AppState
initAppState =
{ currentRoute : Just Home
, corpus : Corpus.initialState
, loginState : LN.initialState
, addCorpusState : AC.initialState
, docViewState : DV.tdata
, docViewState : DV.initialState
, searchState : S.initialState
, userPageState : C.initialState
, docAnnotationState : D.initialState
, documentState : D.initialState
, ntreeState : Tree.exampleTree
, annuaireState : Annuaire.initialState
, search : ""
......@@ -61,9 +58,6 @@ _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})
......@@ -76,8 +70,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})
_docAnnotationViewState :: Lens' AppState D.State
_docAnnotationViewState = lens (\s -> s.docAnnotationState) (\s ss -> s{docAnnotationState = ss})
_documentViewState :: Lens' AppState D.State
_documentViewState = lens (\s -> s.documentState) (\s ss -> s{documentState = ss})
_treeState :: Lens' AppState Tree.State
_treeState = lens (\s -> s.ntreeState) (\s ss -> s {ntreeState = ss})
......
src/Gargantext/Prelude.purs 0 → 100644
View file @ c6739d57
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 @ c6739d57
module Gargantext.Router where
import Prelude
import Gargantext.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)
......@@ -20,9 +19,7 @@ data Routes
| Folder Int
| Corpus Int
| AddCorpus
| Tabview
| DocView Int
| DocAnnotation Int
| Document Int
| PGraphExplorer
| NGramsTable
| Dashboard
......@@ -36,10 +33,8 @@ routing =
<|> AddCorpus <$ route "addCorpus"
<|> Folder <$> (route "folder" *> int)
<|> Corpus <$> (route "corpus" *> int)
<|> Tabview <$ route "tabview"
<|> DocView <$> (route "docView" *> int)
<|> NGramsTable <$ route "ngrams"
<|> DocAnnotation <$> (route "document" *> int)
<|> Document <$> (route "document" *> int)
<|> Dashboard <$ route "dashboard"
<|> PGraphExplorer <$ route "graph"
<|> Annuaire <$> (route "annuaire" *> int)
......@@ -57,10 +52,8 @@ instance showRoutes :: Show Routes where
show AddCorpus = "AddCorpus"
show SearchView = "Search"
show (UserPage i) = "User" <> show i
show (DocAnnotation i)= "Document"
show (Document 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
......@@ -72,19 +65,19 @@ instance showRoutes :: Show Routes where
routeHandler :: (Maybe Routes -> Routes -> Effect Unit)
-> Maybe Routes -> Routes -> Effect Unit
routeHandler dispatchAction old new = do
liftEffect $ log $ "change route : " <> show new
logs $ "change route : " <> show new
w <- window
ls <- localStorage w
token <- getItem "accessToken" ls
let tkn = token
liftEffect $ log $ "JWToken : " <> show tkn
logs $ "JWToken : " <> show tkn
case tkn of
Nothing -> do
dispatchAction old new
liftEffect $ log $ "called SignIn Route :"
logs $ "called SignIn Route :"
Just t -> do
dispatchAction old new
liftEffect $ log $ "called Route : " <> show new
logs $ "called Route : " <> show new
yarn.lock
View file @ c6739d57
This source diff could not be displayed because it is too large. You can view the blob instead.
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