Commit c6739d57 authored by Mael NICOLAS's avatar Mael NICOLAS

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

This reverts commit e7ca1d1f.
parent e7ca1d1f
...@@ -8,7 +8,7 @@ ...@@ -8,7 +8,7 @@
], ],
"dependencies": { "dependencies": {
"purescript-console": "^4.1.0", "purescript-console": "^4.1.0",
"purescript-thermite": "https://github.com/np/purescript-thermite.git#hide", "purescript-thermite": "https://github.com/np/purescript-thermite.git#d7395aec9ff4e7b8f820e882b4b07ed15c4f804d",
"purescript-affjax": "^7.0.0", "purescript-affjax": "^7.0.0",
"purescript-routing": "^8.0.0", "purescript-routing": "^8.0.0",
"purescript-argonaut": "^4.0.1", "purescript-argonaut": "^4.0.1",
......
#!/bin/bash
rm -rf output bower_components node_modules
bower install && yarn install && pulp build && pulp browserify --to dist/bundle.js
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} []
}
module Gargantext.Components.Login where module Gargantext.Components.Login where
import Prelude hiding (div) import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.?), (:=), (~>))
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..))
import Affjax.RequestHeader (RequestHeader(..))
import Affjax.ResponseFormat as ResponseFormat
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, stringify, (.?), (:=), (~>))
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Lens (over) import Data.Lens (over)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe)
import Data.MediaType.Common (applicationJSON) import Effect.Class (liftEffect)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Gargantext.Components.Modals.Modal (modalHide)
import React.DOM (a, button, div, h2, h4, h5, i, input, label, p, span, text) import React.DOM (a, button, div, h2, h4, h5, i, input, label, p, span, text)
import React.DOM.Props (_data, _id, _type, aria, className, href, maxLength, name, onClick, onInput, placeholder, role, target, value) import React.DOM.Props (_data, _id, _type, aria, className, href, maxLength, name, onClick, onInput, placeholder, role, target, value)
import Thermite (PerformAction, Render, Spec, _render, modifyState, simpleSpec) import Thermite (PerformAction, Render, Spec, _render, modifyState, simpleSpec)
...@@ -25,7 +14,13 @@ import Web.HTML (window) ...@@ -25,7 +14,13 @@ import Web.HTML (window)
import Web.HTML.Window (localStorage) import Web.HTML.Window (localStorage)
import Web.Storage.Storage (getItem, setItem) import Web.Storage.Storage (getItem, setItem)
-- TODO: ask for login (modal) or account creation after 15 mn when user is not logged and has made one search at least ------------------------------------------------------------------------
import Gargantext.Prelude
import Gargantext.Config.REST (post)
import Gargantext.Components.Modals.Modal (modalHide)
-- TODO: ask for login (modal) or account creation after 15 mn when user
-- is not logged and has made one search at least
newtype State = State newtype State = State
{ username :: String { username :: String
...@@ -51,31 +46,6 @@ data Action ...@@ -51,31 +46,6 @@ data Action
| SetPassword String | SetPassword String
performAction :: PerformAction State {} Action
performAction (SetUserName usr) _ _ = void do
modifyState \(State state) -> State $ state { username = usr }
performAction (SetPassword pwd) _ _ = void do
modifyState \(State state) -> State $ state { password = pwd }
performAction Login _ _ = void do
--lift $ setHash "/search"
liftEffect $ modalHide "loginModal"
modifyState \(State state) -> State $ state {loginC = true}
-- res <- lift $ loginReq $ LoginReq { username : state.username, password : state.password }
-- case res of
-- Left e -> do
-- lift $ log $ show e
-- modifyState \(State s) -> State $ s { errorMessage = e}
-- Right r@(LoginRes response) -> do
-- lift $ setHash "/addCorpus"
-- modifyState \(State s) -> State $ s {response = r, errorMessage = ""}
modalSpec :: forall props. Boolean -> String -> Spec State props Action -> Spec State props Action modalSpec :: forall props. Boolean -> String -> Spec State props Action -> Spec State props Action
modalSpec sm t = over _render \render d p s c -> modalSpec sm t = over _render \render d p s c ->
[ div [ _id "loginModal", className $ "modal myModal" <> if sm then "" else " fade" [ div [ _id "loginModal", className $ "modal myModal" <> if sm then "" else " fade"
...@@ -110,6 +80,27 @@ spec' = modalSpec true "Login" renderSpec ...@@ -110,6 +80,27 @@ spec' = modalSpec true "Login" renderSpec
renderSpec :: Spec State {} Action renderSpec :: Spec State {} Action
renderSpec = simpleSpec performAction render renderSpec = simpleSpec performAction render
where where
performAction :: PerformAction State {} Action
performAction (SetUserName usr) _ _ = void do
modifyState \(State state) -> State $ state { username = usr }
performAction (SetPassword pwd) _ _ = void do
modifyState \(State state) -> State $ state { password = pwd }
performAction Login _ _ = void do
--lift $ setHash "/search"
liftEffect $ modalHide "loginModal"
modifyState \(State state) -> State $ state {loginC = true}
-- res <- lift $ loginReq $ LoginReq { username : state.username, password : state.password }
-- case res of
-- Left e -> do
-- logs e
-- modifyState \(State s) -> State $ s { errorMessage = e}
-- Right r@(LoginRes response) -> do
-- lift $ setHash "/addCorpus"
-- modifyState \(State s) -> State $ s {response = r, errorMessage = ""}
render :: Render State {} Action render :: Render State {} Action
render dispatch _ (State state) _ = render dispatch _ (State state) _ =
[ [
...@@ -233,37 +224,8 @@ newtype LoginReq = LoginReq ...@@ -233,37 +224,8 @@ newtype LoginReq = LoginReq
, password :: String , password :: String
} }
loginReq :: LoginReq -> Aff (Either String LoginRes) loginReq :: LoginReq -> Aff LoginRes
loginReq encodeData = loginReq = post "https://dev.gargantext.org/api/auth/token"
let
setting =
defaultRequest
{ url = "https://dev.gargantext.org/api/auth/token"
, method = Left POST
, responseFormat = ResponseFormat.json
, headers =
[ ContentType applicationJSON
, Accept applicationJSON
]
, content = Just $ Json $ encodeJson encodeData
}
in
do
affResp <- request setting
case affResp.body of
Left err -> do
liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
liftEffect $ log $ "POST method Completed"
liftEffect $ log $ "GET /api response: " <> stringify json
let obj = decodeJson json
case obj of
Left e ->
liftEffect $ log $ "Error Decoding : " <> show e
Right (LoginRes res1) ->
liftEffect $ setToken res1.token
pure obj
instance decodeLoginRes :: DecodeJson LoginRes where instance decodeLoginRes :: DecodeJson LoginRes where
decodeJson json = do decodeJson json = do
......
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'
}
...@@ -27,6 +27,10 @@ tabs l p ls = withState \st -> ...@@ -27,6 +27,10 @@ tabs l p ls = withState \st ->
, wrapper $ fold $ mapWithIndex ( tab (activeTab st)) ls , wrapper $ fold $ mapWithIndex ( tab (activeTab st)) ls
] ]
where where
performAction :: forall props.
PerformAction State props Action
performAction (ChangeTab i) _ _ =
void $ modifyState $ const i
activeTab = view l activeTab = view l
wrapper = over _render \render d p s c -> wrapper = over _render \render d p s c ->
[div [className "tab-content"] $ render d p s c] [div [className "tab-content"] $ render d p s c]
...@@ -44,11 +48,6 @@ tab sid iid (Tuple name spec) = over _render tabRender spec ...@@ -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. render :: forall state props action.
State -> List (Tuple String (Spec state props action)) State -> List (Tuple String (Spec state props action))
-> Render State props Action -> Render State props Action
......
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]
module Gargantext.Components.Tree where module Gargantext.Components.Tree where
import Prelude hiding (div)
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..))
import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift) import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (class DecodeJson, class EncodeJson, Json, decodeJson, encodeJson, jsonEmptyObject, (.?), (:=), (~>)) import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.?), (:=), (~>))
import Data.Argonaut.Core (Json)
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Data.Traversable (traverse)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Prelude (identity) import Prelude (identity)
import React (ReactElement) import React (ReactElement)
import Gargantext.Config (NodeType(..), readNodeType, toUrl, readNodeType, End(..), ApiVersion, defaultRoot) import React.DOM (a, button, div, h5, i, input, li, text, ul)
import React.DOM (a, button, div, h5, i, input, li, span, text, ul)
import React.DOM.Props (Props, _type, className, href, onClick, onInput, placeholder, style, value) import React.DOM.Props (Props, _type, className, href, onClick, onInput, placeholder, style, value)
import Thermite (PerformAction, Render, Spec, cotransform, modifyState, simpleSpec) import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
import Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Prelude
import Gargantext.Config.REST (get, put, post, delete)
import Gargantext.Config (NodeType(..), toUrl, End(..), defaultRoot)
type Name = String type Name = String
type Open = Boolean type Open = Boolean
type URL = String type URL = String
...@@ -37,7 +30,7 @@ data Action = ShowPopOver ...@@ -37,7 +30,7 @@ data Action = ShowPopOver
| ToggleFolder ID | ToggleFolder ID
| RenameNode String | RenameNode String
| Submit | Submit
--| Initialize -- | Initialize
type State = FTree type State = FTree
...@@ -50,33 +43,6 @@ initialState = NTree (LNode { id : 3 ...@@ -50,33 +43,6 @@ initialState = NTree (LNode { id : 3
, renameNodeValue : "" , renameNodeValue : ""
}) [] }) []
performAction :: PerformAction State {} Action
performAction (ToggleFolder i) _ _ =
void $ cotransform (\td -> toggleNode i td)
performAction ShowPopOver _ _ = void $
modifyState $ \(NTree (LNode lnode) ary) -> NTree (LNode $ lnode { popOver = true }) ary
performAction Submit _ s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) ary) = void $ do
s' <- lift $ renameNode id $ RenameValue { name : getRenameNodeValue s}
case s' of
Left err -> modifyState identity
Right d -> modifyState identity
performAction (RenameNode r) _ _ = void $
modifyState $ \(NTree (LNode lnode) ary) -> NTree (LNode $ lnode { renameNodeValue = r }) ary
-- performAction Initialize _ _ = void $ do
-- s <- lift $ loadDefaultNode
-- case s of
-- Left err -> modifyState identity
-- Right d -> modifyState (\state -> d)
toggleNode :: Int -> NTree LNode -> NTree LNode toggleNode :: Int -> NTree LNode -> NTree LNode
toggleNode sid (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) ary) = toggleNode sid (NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) ary) =
...@@ -111,7 +77,7 @@ exampleTree = NTree (LNode { id : 1 ...@@ -111,7 +77,7 @@ exampleTree = NTree (LNode { id : 1
-- corpus :: Int -> String -> NTree (Tuple String String) -- corpus :: Int -> String -> NTree (Tuple String String)
-- corpus n name = NTree (LNode {id : n, name, nodeType : "", open : false}) -- corpus n name = NTree (LNode {id : n, name, nodeType : "", open : false})
-- [ NTree (Tuple "Facets" "#/corpus") [] -- [ NTree (Tuple "Tabs" "#/corpus") []
-- , NTree (Tuple "Dashboard" "#/dashboard") [] -- , NTree (Tuple "Dashboard" "#/dashboard") []
-- , NTree (Tuple "Graph" "#/graphExplorer") [] -- , NTree (Tuple "Graph" "#/graphExplorer") []
-- ] -- ]
...@@ -150,6 +116,22 @@ nodeOptionsRename d activated = case activated of ...@@ -150,6 +116,22 @@ nodeOptionsRename d activated = case activated of
treeview :: Spec State {} Action treeview :: Spec State {} Action
treeview = simpleSpec performAction render treeview = simpleSpec performAction render
where where
performAction :: PerformAction State {} Action
performAction (ToggleFolder i) _ _ =
void $ modifyState (\td -> toggleNode i td)
performAction ShowPopOver _ _ = void $
modifyState $ \(NTree (LNode lnode) ary) -> NTree (LNode $ lnode { popOver = true }) ary
performAction Submit _ s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) ary) = void $ do
d <- lift $ renameNode id $ RenameValue { name : getRenameNodeValue s}
modifyState identity -- TODO why ???
performAction (RenameNode r) _ _ = void $
modifyState $ \(NTree (LNode lnode) ary) -> NTree (LNode $ lnode { renameNodeValue = r }) ary
-- performAction Initialize _ _ = void $ do
-- s <- lift $ loadDefaultNode
-- case s of
-- Left err -> modifyState identity
-- Right d -> modifyState (\state -> d)
render :: Render State {} Action render :: Render State {} Action
render dispatch _ state _ = render dispatch _ state _ =
[ div [className "tree"] [ div [className "tree"]
...@@ -218,8 +200,8 @@ toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) [ ...@@ -218,8 +200,8 @@ toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) [
( [ text (name <> " ") ( [ text (name <> " ")
] ]
<> nodeOptionsView false <> nodeOptionsView false
<> (nodeOptionsRename d true) <> (nodeOptionsRename d false)
<>[ if ((popOverValue s) == true) then (renameTreeView d s ) else (renameTreeView d s)] -- <>[ 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 ...@@ -235,8 +217,8 @@ toHtml d s@(NTree (LNode {id, name, nodeType, open, popOver, renameNodeValue}) a
map (toHtml d) ary map (toHtml d) ary
else [] else []
<> nodeOptionsView false <> nodeOptionsView false
<> (nodeOptionsRename d true) <> (nodeOptionsRename d false)
<>[ if ((popOverValue s) == true) then (renameTreeView d s ) else (renameTreeView d s)] -- <>[ if ((popOverValue s) == true) then (renameTreeView d s ) else (renameTreeView d s)]
) )
] ]
...@@ -279,24 +261,8 @@ instance decodeJsonFTree :: DecodeJson (NTree LNode) where ...@@ -279,24 +261,8 @@ instance decodeJsonFTree :: DecodeJson (NTree LNode) where
nodes' <- decodeJson nodes nodes' <- decodeJson nodes
pure $ NTree node' nodes' pure $ NTree node' nodes'
loadDefaultNode :: Aff (Either String (NTree LNode)) loadDefaultNode :: Aff (NTree LNode)
loadDefaultNode = do loadDefaultNode = get $ toUrl Back Tree defaultRoot
res <- request $ defaultRequest
{ url = toUrl Back Tree defaultRoot
, responseFormat = ResponseFormat.json
, method = Left GET
, headers = []
}
case res.body of
Left err -> do
_ <- liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- liftEffect $ log $ show a.status
--_ <- liftEffect $ log $ show a.headers
--_ <- liftEffect $ log $ show a.body
let obj = decodeJson json
pure obj
----- TREE CRUD Operations ----- TREE CRUD Operations
...@@ -311,96 +277,25 @@ instance encodeJsonRenameValue :: EncodeJson RenameValue where ...@@ -311,96 +277,25 @@ instance encodeJsonRenameValue :: EncodeJson RenameValue where
~> jsonEmptyObject ~> jsonEmptyObject
renameNode :: Int -> RenameValue -> Aff (Either String (Int)) --- need to change return type herre renameNode :: Int -> RenameValue -> Aff Int --- need to change return type herre
renameNode renameNodeId reqbody = do renameNode renameNodeId reqbody =
res <- request $ defaultRequest put ("http://localhost:8008/api/v1.0/node/" <> show renameNodeId <> "/rename")
{ url = "http://localhost:8008/api/v1.0/node/" <> show renameNodeId <> "/rename" reqbody
, responseFormat = ResponseFormat.json
, method = Left PUT
, headers = []
, content = Just $ Json $ encodeJson reqbody
}
case res.body of
Left err -> do
_ <- liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- liftEffect $ log $ show a.status
--_ <- liftEffect $ log $ show a.headers
--_ <- liftEffect $ log $ show a.body
let obj = decodeJson json
pure obj
deleteNode :: Aff (Either String (Int))
deleteNode = do
res <- request $ defaultRequest
{ url = toUrl Back Tree 1
, responseFormat = ResponseFormat.json
, method = Left DELETE
, headers = []
}
case res.body of deleteNode :: Int -> Aff Int
Left err -> do deleteNode = delete <<< toUrl Back Tree
_ <- liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- liftEffect $ log $ show a.status
--_ <- liftEffect $ log $ show a.headers
--_ <- liftEffect $ log $ show a.body
let obj = decodeJson json
pure obj
deleteNodes :: String -> Aff (Either String Int)
deleteNodes reqbody = do
res <- request $ defaultRequest
{ url = toUrl Back Tree 1
, responseFormat = ResponseFormat.json
, method = Left DELETE
, headers = []
, content = Just $ Json $ encodeJson reqbody
}
case res.body of
Left err -> do
_ <- liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- liftEffect $ log $ show a.status
--_ <- liftEffect $ log $ show a.headers
--_ <- liftEffect $ log $ show a.body
let obj = decodeJson json
pure obj
createNode :: String -> Aff (Either String (Int))
createNode reqbody= do
res <- request $ defaultRequest
{ url = toUrl Back Tree 1
, responseFormat = ResponseFormat.json
, method = Left POST
, headers = []
, content = Just $ Json $ encodeJson reqbody
}
case res.body of
Left err -> do
_ <- liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
--_ <- liftEffect $ log $ show a.status
--_ <- liftEffect $ log $ show a.headers
--_ <- liftEffect $ log $ show a.body
let obj = decodeJson json
pure obj
-- See https://stackoverflow.com/questions/21863326/delete-multiple-records-using-rest
-- As of now I would recommend simply issuing many requests.
-- In a second time implement a set of end points for batch edition.
deleteNodes :: Array Int -> Aff (Array Int)
deleteNodes = traverse deleteNode
createNode :: String -> Aff Int
createNode reqbody = post (toUrl Back Tree 1) reqbody
fnTransform :: LNode -> FTree fnTransform :: LNode -> FTree
fnTransform n = NTree n [] fnTransform n = NTree n []
unsafeEventValue :: forall event. event -> String unsafeEventValue :: forall event. event -> String
unsafeEventValue e = (unsafeCoerce e).target.value unsafeEventValue e = (unsafeCoerce e).target.value
...@@ -98,7 +98,7 @@ endPathUrl Back c nt i = pathUrl c.back nt i ...@@ -98,7 +98,7 @@ endPathUrl Back c nt i = pathUrl c.back nt i
endPathUrl Front c nt i = pathUrl c.front nt i endPathUrl Front c nt i = pathUrl c.front nt i
pathUrl :: Config -> NodeType -> Id -> UrlPath pathUrl :: Config -> NodeType -> Id -> UrlPath
pathUrl c 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 pathUrl c nt i = c.prePath <> urlConfig nt <> "/" <> show i
------------------------------------------------------------ ------------------------------------------------------------
toUrl :: End -> NodeType -> Id -> Url toUrl :: End -> NodeType -> Id -> Url
...@@ -110,10 +110,11 @@ toUrl e nt i = doUrl base path params ...@@ -110,10 +110,11 @@ toUrl e nt i = doUrl base path params
------------------------------------------------------------ ------------------------------------------------------------
data NodeType = NodeUser data NodeType = NodeUser
| Annuaire | Annuaire
| Children | Tab TabType Offset Limit
| Corpus | Corpus
| CorpusV3
| Dashboard | Dashboard
| Document | Url_Document
| Error | Error
| Folder | Folder
| Graph | Graph
...@@ -122,19 +123,34 @@ data NodeType = NodeUser ...@@ -122,19 +123,34 @@ data NodeType = NodeUser
| Tree | Tree
data End = Back | Front data End = Back | Front
type Id = Int type Id = Int
type Limit = Int
type Offset = Int
------------------------------------------------------------ ------------------------------------------------------------
data ApiVersion = V10 | V11 data ApiVersion = V10 | V11
instance showApiVersion :: Show ApiVersion where instance showApiVersion :: Show ApiVersion where
show V10 = "v1.0" show V10 = "v1.0"
show V11 = "v1.1" show V11 = "v1.1"
------------------------------------------------------------ ------------------------------------------------------------
data TabType = TabDocs | TabTerms | TabSources | TabAuthors | TabTrash
instance showTabType :: Show TabType where
show TabDocs = "Docs"
show TabTerms = "Terms"
show TabSources = "Sources"
show TabAuthors = "Authors"
show TabTrash = "Trash"
------------------------------------------------------------ ------------------------------------------------------------
urlConfig :: NodeType -> Url urlConfig :: NodeType -> Url
urlConfig Annuaire = show Annuaire urlConfig Annuaire = show Annuaire
urlConfig Children = show Children urlConfig nt@(Tab _ _ _) = show nt
urlConfig Corpus = show Corpus urlConfig Corpus = show Corpus
urlConfig CorpusV3 = show CorpusV3
urlConfig Dashboard = show Dashboard urlConfig Dashboard = show Dashboard
urlConfig Document = show Document urlConfig Url_Document = show Url_Document
urlConfig Error = show Error urlConfig Error = show Error
urlConfig Folder = show Folder urlConfig Folder = show Folder
urlConfig Graph = show Graph urlConfig Graph = show Graph
...@@ -145,10 +161,10 @@ urlConfig Tree = show Tree ...@@ -145,10 +161,10 @@ urlConfig Tree = show Tree
------------------------------------------------------------ ------------------------------------------------------------
instance showNodeType :: Show NodeType where instance showNodeType :: Show NodeType where
show Annuaire = "annuaire" show Annuaire = "annuaire"
show Children = "children"
show Corpus = "corpus" show Corpus = "corpus"
show CorpusV3 = "corpus"
show Dashboard = "dashboard" show Dashboard = "dashboard"
show Document = "document" show Url_Document = "document"
show Error = "ErrorNodeType" show Error = "ErrorNodeType"
show Folder = "folder" show Folder = "folder"
show Graph = "graph" show Graph = "graph"
...@@ -156,19 +172,21 @@ instance showNodeType :: Show NodeType where ...@@ -156,19 +172,21 @@ instance showNodeType :: Show NodeType where
show Node = "node" show Node = "node"
show NodeUser = "user" show NodeUser = "user"
show Tree = "tree" show Tree = "tree"
show (Tab t o l) = "table?view=" <> show t <> "&offset=" <> show o <> "&limit=" <> show l <> "&order=DateAsc"
-- | TODO : where is the Read Class ? -- | TODO : where is the Read Class ?
-- instance readNodeType :: Read NodeType where -- instance readNodeType :: Read NodeType where
readNodeType :: String -> NodeType readNodeType :: String -> NodeType
readNodeType "Annuaire" = Annuaire readNodeType "NodeAnnuaire" = Annuaire
readNodeType "Children" = Children readNodeType "Tab" = (Tab TabDocs 0 0)
readNodeType "Dashboard" = Dashboard readNodeType "NodeDashboard" = Dashboard
readNodeType "Document" = Document readNodeType "Document" = Url_Document
readNodeType "Folder" = Folder readNodeType "NodeFolder" = Folder
readNodeType "Graph" = Graph readNodeType "NodeGraph" = Graph
readNodeType "Individu" = Individu readNodeType "Individu" = Individu
readNodeType "Node" = Node readNodeType "Node" = Node
readNodeType "NodeCorpus" = Corpus readNodeType "NodeCorpus" = Corpus
readNodeType "NodeCorpusV3" = CorpusV3
readNodeType "NodeUser" = NodeUser readNodeType "NodeUser" = NodeUser
readNodeType "Tree" = Tree readNodeType "Tree" = Tree
readNodeType _ = Error readNodeType _ = Error
......
module Gargantext.Config.REST where module Gargantext.Config.REST where
import Prelude
import Affjax (defaultRequest, printResponseFormatError, request) import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..))
import Affjax.RequestHeader (RequestHeader(..)) import Affjax.RequestHeader (RequestHeader(..))
import Affjax.ResponseFormat as ResponseFormat import Affjax.ResponseFormat as ResponseFormat
import Data.Argonaut (class DecodeJson, decodeJson) import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.HTTP.Method (Method(..)) import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(..))
import Data.MediaType.Common (applicationJSON) import Data.MediaType.Common (applicationJSON)
import Effect.Aff (Aff) import Effect.Aff (Aff, throwError)
import Effect.Exception (error)
get :: forall t31. DecodeJson t31 => String ->
Aff (Either String t31) import Gargantext.Prelude
get url = do
affResp <- request defaultRequest send :: forall a b. EncodeJson a => DecodeJson b =>
{ method = Left GET Method -> String -> Maybe a -> Aff b
, url = url send m url reqbody = do
affResp <- request $ defaultRequest
{ url = url
, responseFormat = ResponseFormat.json , responseFormat = ResponseFormat.json
, method = Left m
, headers = [ ContentType applicationJSON , headers = [ ContentType applicationJSON
, Accept applicationJSON , Accept applicationJSON
-- , RequestHeader "Authorization" $ "Bearer " <> token -- , RequestHeader "Authorization" $ "Bearer " <> token
] ]
, content = (Json <<< encodeJson) <$> reqbody
} }
case affResp.body of case affResp.body of
Left err -> do Left err -> do
pure $ Left $ printResponseFormatError err _ <- logs $ printResponseFormatError err
Right a -> do throwError $ error $ printResponseFormatError err
let res = decodeJson a Right json -> do
pure res --_ <- 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
module Gargantext.Pages.Annuaire where module Gargantext.Pages.Annuaire where
import Prelude
import Data.Array (concat)
import Data.Traversable (foldl)
import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Class (lift)
import Data.Either (Either(..)) import Data.Lens (Lens', lens, (?~))
import Data.Lens (Lens', Prism', lens, prism, (?~))
import Data.Maybe (Maybe(..), maybe) import Data.Maybe (Maybe(..), maybe)
import Effect.Class (liftEffect)
import React (ReactElement) import React (ReactElement)
import React.DOM (div, h1, h3, hr, i, p, text, thead, tbody, input, br', b, b', tr, th, table, td, a) import React.DOM (a, b, b', br', div, h3, hr, i, input, p, table, tbody, td, text, th, thead, tr)
import React.DOM.Props (_type, className, href, onChange, onClick, scope, selected, value, style) import React.DOM.Props (className, href, scope, style)
import Effect.Aff (Aff)
import Thermite (Render, Spec import Thermite (Render, Spec
, simpleSpec, defaultPerformAction , simpleSpec
, PerformAction, modifyState) , PerformAction, modifyState)
import Effect.Console (log)
import Effect.Aff (Aff)
import Gargantext.Config (toUrl, NodeType(..), End(..)) ------------------------------------------------------------------------------
import Gargantext.Prelude
import Gargantext.Config (toUrl, NodeType(..), TabType(..), End(..))
import Gargantext.Config.REST (get) import Gargantext.Config.REST (get)
import Gargantext.Pages.Annuaire.User.Contacts.Types.Types (Contact(..), HyperData(..)) import Gargantext.Pages.Annuaire.User.Contacts.Types (Contact(..), HyperData(..))
import Gargantext.Utils.DecodeMaybe ((.?|)) import Gargantext.Utils.DecodeMaybe ((.?|))
import Data.Argonaut (class DecodeJson, decodeJson, (.?)) import Data.Argonaut (class DecodeJson, decodeJson, (.?))
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
type State = { info :: Maybe AnnuaireInfo type State = { info :: Maybe AnnuaireInfo
, stable :: Maybe AnnuaireTable , stable :: Maybe AnnuaireTable
...@@ -80,9 +74,20 @@ toRows (AnnuaireTable a) = a.annuaireTable ...@@ -80,9 +74,20 @@ toRows (AnnuaireTable a) = a.annuaireTable
layoutAnnuaire :: Spec State {} Action layoutAnnuaire :: Spec State {} Action
layoutAnnuaire = simpleSpec performAction render layoutAnnuaire = simpleSpec performAction render
where
render :: Render State {} Action performAction :: PerformAction State {} Action
render dispatch _ state _ = [ div [className "row"] 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-3"] [ h3 [] [text info.name] ]
, div [className "col-md-9"] [ hr [style {height : "2px",backgroundColor : "black"}] ] , div [className "col-md-9"] [ hr [style {height : "2px",backgroundColor : "black"}] ]
] ]
...@@ -130,7 +135,7 @@ showRow :: Maybe Contact -> ReactElement ...@@ -130,7 +135,7 @@ showRow :: Maybe Contact -> ReactElement
showRow Nothing = tr [][] showRow Nothing = tr [][]
showRow (Just (Contact { id : id, hyperdata : (HyperData contact) })) = showRow (Just (Contact { id : id, hyperdata : (HyperData contact) })) =
tr [] tr []
[ td [] [ a [ href (toUrl 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.fonction]
, td [] [text $ maybe' contact.service] , td [] [text $ maybe' contact.service]
, td [] [text $ maybe' contact.groupe] , td [] [text $ maybe' contact.groupe]
...@@ -175,28 +180,10 @@ instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where ...@@ -175,28 +180,10 @@ instance decodeAnnuaireTable :: DecodeJson AnnuaireTable where
rows <- decodeJson json rows <- decodeJson json
pure $ AnnuaireTable { annuaireTable : rows} pure $ AnnuaireTable { annuaireTable : rows}
------------------------------------------------------------------------ ------------------------------------------------------------------------
performAction :: PerformAction State {} Action getTable :: Int -> Aff AnnuaireTable
performAction (Load aId) _ _ = do getTable id = get $ toUrl Back (Tab TabDocs 0 10) id
eitherInfo <- lift $ getInfo aId
_ <- case eitherInfo of
(Right info') -> void $ modifyState $ _info ?~ info'
(Left err) -> do
liftEffect $ log err
eitherTable <- lift $ getTable aId
liftEffect $ log "Feching Table"
_ <- case eitherTable of
(Right table') -> void $ modifyState $ _table ?~ table'
(Left err) -> do
liftEffect $ log err
liftEffect <<< log $ "Annuaire page fetched."
performAction _ _ _ = pure unit
------------------------------------------------------------------------
getTable :: Int -> Aff (Either String AnnuaireTable)
getTable id = get $ toUrl Back Children id
getInfo :: Int -> Aff (Either String AnnuaireInfo) getInfo :: Int -> Aff AnnuaireInfo
getInfo id = get $ toUrl Back Node id getInfo id = get $ toUrl Back Node id
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
_table :: Lens' State (Maybe AnnuaireTable) _table :: Lens' State (Maybe AnnuaireTable)
......
module Gargantext.Pages.Annuaire.User.Contacts.API where module Gargantext.Pages.Annuaire.User.Contacts.API where
import Prelude
import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Class (lift)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Lens ((?~)) import Data.Lens ((?~))
...@@ -9,22 +7,19 @@ import Data.Maybe (Maybe(..)) ...@@ -9,22 +7,19 @@ import Data.Maybe (Maybe(..))
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Console (log) import Effect.Console (log)
import Thermite (StateCoTransformer, modifyState)
import Gargantext.Config (toUrl, NodeType(..), End(..)) import Gargantext.Config (toUrl, NodeType(..), End(..))
import Gargantext.Config.REST (get) import Gargantext.Config.REST (get)
import Gargantext.Prelude
import Gargantext.Pages.Annuaire.User.Contacts.Types (Action(..), State, Contact, _contact) import Gargantext.Pages.Annuaire.User.Contacts.Types (Action(..), State, Contact, _contact)
import Thermite (PerformAction, modifyState) import Thermite (PerformAction, modifyState)
getUser :: Int -> Aff (Either String Contact) getContact :: Int -> Aff Contact
getUser id = get $ toUrl Back Node id getContact id = get $ toUrl Back Node id
performAction :: PerformAction State {} Action fetchContact :: Int -> StateCoTransformer State Unit
performAction (FetchContact contactId) _ _ = do fetchContact contactId = do
value <- lift $ getUser contactId contact <- lift $ getContact contactId
_ <- case value of void $ modifyState $ _contact ?~ contact
(Right contact) -> void $ modifyState $ _contact ?~ contact logs "Fetching contact..."
(Left err) -> do
liftEffect $ log err
liftEffect <<< log $ "Fetching contact..."
performAction _ _ _ = pure unit
module Gargantext.Pages.Annuaire.User.Contacts.Specs module Gargantext.Pages.Annuaire.User.Contacts.Specs
(module Gargantext.Pages.Annuaire.User.Contacts.Specs.Renders, (module Gargantext.Pages.Annuaire.User.Contacts.Specs.Renders,
brevetSpec,
projectSpec,
facets,
layoutUser) layoutUser)
where where
import Gargantext.Pages.Annuaire.User.Contacts.Specs.Renders
import Thermite (Spec, simpleSpec) import Data.List (fromFoldable)
import Gargantext.Pages.Annuaire.User.Contacts.Types (Action, State) import Data.Tuple (Tuple(..))
import Gargantext.Pages.Annuaire.User.Contacts.API (performAction) 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 :: Spec State {} Action
layoutUser = simpleSpec performAction render layoutUser = simpleSpec performAction render
where
performAction :: PerformAction State {} Action
performAction (FetchContact contactId) _ _ = fetchContact contactId
performAction (TabA _) _ _ = pure unit
brevetSpec :: Spec State {} Action
brevetSpec = noState B.brevetsSpec
projets :: Spec {} {} Void
projets = simpleSpec defaultPerformAction render
where
render :: Render {} {} Void
render dispatch _ state _ =
[]
projectSpec :: Spec State {} Action
projectSpec = noState projets
publicationSpec :: Spec State {} Action
publicationSpec = noState P.publicationSpec
facets :: Spec State {} Action
facets = Tab.tabs _tablens _tabAction $ fromFoldable
[ Tuple "Publications (12)" publicationSpec
, Tuple "Brevets (2)" brevetSpec
, Tuple "Projets IMT (5)" projectSpec
]
...@@ -54,13 +54,14 @@ mapMyMap f m = toUnfoldable ...@@ -54,13 +54,14 @@ mapMyMap f m = toUnfoldable
infixl 4 mapMyMap as <.~$> infixl 4 mapMyMap as <.~$>
contactInfos :: Maybe HyperData -> ReactElement contactInfos :: HyperData -> ReactElement
contactInfos hyperdata = contactInfos hyperdata =
ul [className "list-group"] $ ul [className "list-group"] [] {- $
listInfo <.~$> (checkMaybe hyperdata) listInfo <.~$> hyperdata
where where
checkMaybe (Nothing) = empty checkMaybe (Nothing) = empty
checkMaybe (Just (HyperData a)) = a checkMaybe (Just (HyperData a)) = a
-}
listInfo :: Tuple String String -> ReactElement listInfo :: Tuple String String -> ReactElement
listInfo s = listElement $ infoRender s listInfo s = listElement $ infoRender s
......
module Gargantext.Pages.Annuaire.User.Contacts.Types module Gargantext.Pages.Annuaire.User.Contacts.Types where
(module Gargantext.Pages.Annuaire.User.Contacts.Types.Types,
module Gargantext.Pages.Annuaire.User.Contacts.Types.Lens,
module Gargantext.Pages.Annuaire.User.Contacts.Types.States,
brevetSpec,
projectSpec,
facets
)
where
import Prelude import Prelude
import Gargantext.Pages.Annuaire.User.Contacts.Types.Lens import Data.Argonaut (class DecodeJson, decodeJson, (.?))
import Gargantext.Pages.Annuaire.User.Contacts.Types.Types import Data.Either (Either(..))
import Gargantext.Pages.Annuaire.User.Contacts.Types.States import Data.Lens (Lens', Prism', lens, prism)
import Gargantext.Pages.Annuaire.User.Brevets as B import Data.Maybe (Maybe(..))
import Data.List (fromFoldable)
import Data.Tuple (Tuple(..)) import Gargantext.Components.Tab as Tab
import Gargantext.Components.Tab (tabs) import Gargantext.Utils.DecodeMaybe ((.?|))
import Thermite (Render, Spec, focus, noState, defaultPerformAction, simpleSpec)
newtype Contact = Contact
brevetSpec :: Spec State {} Action { id :: Int
brevetSpec = noState B.brevetsSpec , typename :: Maybe Int
, userId :: Int
projets :: Spec {} {} Void , parentId :: Int
projets = simpleSpec defaultPerformAction render , name :: String
where , date :: Maybe String
render :: Render {} {} Void , hyperdata :: HyperData
render dispatch _ state _ = }
[]
newtype HyperData =
projectSpec :: Spec State {} Action HyperData
projectSpec = noState projets { bureau :: Maybe String
, atel :: Maybe String
facets :: Spec State {} Action , fax :: Maybe String
facets = tabs _tablens _tabAction $ fromFoldable , aprecision :: Maybe String
[ Tuple "Publications (12)" publicationSpec , service :: Maybe String
, Tuple "Brevets (2)" brevetSpec , service2 :: Maybe String
, Tuple "Projets IMT (5)" projectSpec , 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
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
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
}
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
}
module Gargantext.Pages.Corpus where module Gargantext.Pages.Corpus where
import Data.Maybe (Maybe(..), maybe)
import Prelude hiding (div) import Data.Either (Either(..))
import Data.Argonaut (class DecodeJson, decodeJson, (.?)) import Data.Lens (Lens', Prism', lens, prism)
import Gargantext.Components.Charts.Options.ECharts (chart) import Data.Maybe (maybe)
import Gargantext.Pages.Corpus.Doc.Facets.Dashboard (globalPublis) import Effect.Aff (Aff)
import Gargantext.Pages.Corpus.Doc.Facets as Tab import React as React
import React (ReactClass, ReactElement)
import React.DOM (div, h3, hr, i, p, text) import React.DOM (div, h3, hr, i, p, text)
import React.DOM.Props (className, style) import React.DOM.Props (className, style)
import Thermite (Render, Spec, 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 :: State
initialState = { info : Nothing } initialState = { tabsView : Tabs.initialState
data Action = Load Int
newtype Node a = Node { id :: Int
, typename :: Int
, userId :: Int
, parentId :: Int
, name :: String
, date :: String
, hyperdata :: a
} }
newtype CorpusInfo = CorpusInfo { title :: String ------------------------------------------------------------------------
, desc :: String _tabsView :: forall a b. Lens' { tabsView :: a | b } a
, query :: String _tabsView = lens (\s -> s.tabsView) (\s ss -> s{tabsView = ss})
, 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}
instance decodeNode :: (DecodeJson a) => DecodeJson (Node a) where data Action
decodeJson json = do = TabsA Tabs.Action
obj <- decodeJson json
id <- obj .? "id"
typename <- obj .? "typename"
userId <- obj .? "userId"
parentId <- obj .? "parentId"
name <- obj .? "name"
date <- obj .? "date"
hyperdata <- obj .? "hyperdata" _tabsAction :: Prism' Action Tabs.Action
hyperdata' <- decodeJson hyperdata _tabsAction = prism TabsA \ action ->
case action of
TabsA taction -> Right taction
-- _-> Left action
pure $ Node { id : id ------------------------------------------------------------------------
, typename : typename layout :: Spec {} {nodeId :: Int} Void
, userId : userId layout = simpleSpec defaultPerformAction render
, parentId : parentId where
, name : name render :: Render {} {nodeId :: Int} Void
, date : date render _ {nodeId} _ _ =
, hyperdata: hyperdata' [ corpusLoader { path: nodeId
} , component: createClass "Layout" layout' initialState
} ]
layout :: Spec State {} Action layout' :: Spec State Props Action
layout = corpusSpec -- <> Tab.pureTab1 layout' = noState corpusHeaderSpec
<> focus _tabsView _tabsAction Tabs.statefulTabs
corpusSpec :: Spec State {} Action
corpusSpec = simpleSpec defaultPerformAction render corpusHeaderSpec :: Spec {} Props Void
corpusHeaderSpec = simpleSpec defaultPerformAction render
where where
render :: Render State {} Action render :: Render {} Props Void
render dispatch _ state _ = render dispatch {loaded} _ _ =
[ div [className "row"] [ 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 "col-md-9"] [ hr [style {height : "2px",backgroundColor : "black"}] ]
] ]
, div [className "row"] [ div [className "jumbotron1", style {padding : "12px 0px 20px 12px"}] , div [className "row"] [ div [className "jumbotron1", style {padding : "12px 0px 20px 12px"}]
[ div [ className "col-md-8 content"] [ div [ className "col-md-8 content"]
[ p [] [ i [className "fa fa-globe"] [] [ p [] [ i [className "fa fa-globe"] []
, text corpus.desc , text $ " " <> corpus.desc
] ]
, p [] [ i [className "fab fa-searchengin"] [] , p [] [ i [className "fab fa-searchengin"] []
, text corpus.query , text $ " " <> corpus.query
] ]
] ]
, div [ className "col-md-4 content"] , div [ className "col-md-4 content"]
[ p [] [ i [className "fa fa-calendar"] [] [ p [] [ i [className "fa fa-calendar"] []
, text corpus.date , text $ " " <> date'
] ]
, p [] [ i [className "fa fa-user"] [] , p [] [ i [className "fa fa-user"] []
, text corpus.authors , text $ " " <> corpus.authors
] ]
] ]
] ]
] ]
-- , chart globalPublis TODO add chart data in state
] ]
where where
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
module Gargantext.Pages.Corpus.Doc.Facets.Dashboard where module Gargantext.Pages.Corpus.Dashboard where
import Prelude hiding (div) import Prelude hiding (div)
......
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
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
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'
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})
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
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 Control.Monad.Cont.Trans (lift)
import Data.Argonaut (decodeJson, stringify)
import Data.Array (length, mapWithIndex, (!!)) import Data.Array (length, mapWithIndex, (!!))
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Int (toNumber) import Data.Int (toNumber)
import Data.Maybe (Maybe(..), fromJust) import Data.Maybe (Maybe(..), fromJust)
import Data.MediaType.Common (applicationJSON)
import Data.Newtype (class Newtype) import Data.Newtype (class Newtype)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Gargantext.Components.GraphExplorer.Sigmajs (Color(Color), SigmaEasing, SigmaGraphData(SigmaGraphData), SigmaNode, SigmaSettings, canvas, edgeShape, edgeShapes, forceAtlas2, sStyle, sigma, sigmaEasing, sigmaEdge, sigmaEnableWebGL, sigmaNode, sigmaSettings)
import Gargantext.Components.GraphExplorer.Types (Cluster(..), Edge(..), GraphData(..), Legend(..), Node(..), getLegendData)
import Gargantext.Utils (getter)
import Math (cos, sin) import Math (cos, sin)
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import React (ReactElement) import React (ReactElement)
...@@ -28,6 +15,13 @@ import React.DOM.Props (_id, _type, checked, className, href, name, onChange, pl ...@@ -28,6 +15,13 @@ import React.DOM.Props (_id, _type, checked, className, href, name, onChange, pl
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec) import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
import Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Prelude
import Gargantext.Config.REST (get)
import Gargantext.Components.GraphExplorer.Sigmajs (Color(Color), SigmaEasing, SigmaGraphData(SigmaGraphData), SigmaNode, SigmaSettings, canvas, edgeShape, edgeShapes, forceAtlas2, sStyle, sigma, sigmaEasing, sigmaEdge, sigmaEnableWebGL, sigmaNode, sigmaSettings)
import Gargantext.Components.GraphExplorer.Types (Cluster(..), Edge(..), GraphData(..), Legend(..), Node(..), getLegendData)
import Gargantext.Utils (getter)
data Action data Action
= LoadGraph String = LoadGraph String
| SelectNode SelectedNode | SelectNode SelectedNode
...@@ -59,18 +53,16 @@ graphSpec = simpleSpec performAction render ...@@ -59,18 +53,16 @@ graphSpec = simpleSpec performAction render
performAction :: PerformAction State {} Action performAction :: PerformAction State {} Action
performAction (LoadGraph fp) _ _ = void do performAction (LoadGraph fp) _ _ = void do
_ <- liftEffect $ log fp _ <- logs fp
case fp of case fp of
"" -> do "" -> do
modifyState \(State s) -> State s {filePath = fp, graphData = GraphData {nodes : [], edges : []}, sigmaGraphData = Nothing} modifyState \(State s) -> State s {filePath = fp, graphData = GraphData {nodes : [], edges : []}, sigmaGraphData = Nothing}
_ -> do _ -> do
_ <- modifyState \(State s) -> State s {filePath = fp, sigmaGraphData = Nothing} _ <- modifyState \(State s) -> State s {filePath = fp, sigmaGraphData = Nothing}
gd <- lift $ getGraphData fp gd <- lift $ getGraphData fp
case gd of -- TODO: here one might `catchError getGraphData` to visually empty the
Left err -> do -- graph.
modifyState \(State s) -> State s {filePath = fp, graphData = GraphData {nodes : [], edges : []}} modifyState \(State s) -> State s {filePath = fp, graphData = gd, sigmaGraphData = Just $ convert gd, legendData = getLegendData gd}
Right gd' -> do
modifyState \(State s) -> State s {filePath = fp, graphData = gd', sigmaGraphData = Just $ convert gd', legendData = getLegendData gd'}
performAction (SelectNode node) _ _ = void do performAction (SelectNode node) _ _ = void do
modifyState $ \(State s) -> State s {selectedNode = pure node} modifyState $ \(State s) -> State s {selectedNode = pure node}
...@@ -117,7 +109,7 @@ render d p (State s) c = ...@@ -117,7 +109,7 @@ render d p (State s) c =
, settings : mySettings , settings : mySettings
, style : sStyle { height : "95%"} , style : sStyle { height : "95%"}
-- , onClickNode : \e -> do -- , onClickNode : \e -> do
-- log $ unsafeCoerce e -- logs $ unsafeCoerce e
-- d $ SelectNode $ SelectedNode {id : (unsafeCoerce e).data.node.id, label : (unsafeCoerce e).data.node.label} -- d $ SelectNode $ SelectedNode {id : (unsafeCoerce e).data.node.id, label : (unsafeCoerce e).data.node.label}
-- pure unit -- pure unit
-- TODO: fix this! -- TODO: fix this!
...@@ -221,27 +213,8 @@ mySettings = sigmaSettings { verbose : true ...@@ -221,27 +213,8 @@ mySettings = sigmaSettings { verbose : true
-- loadJSON {path : "http://localhost:2015/examples/sites_coords.json"} -- loadJSON {path : "http://localhost:2015/examples/sites_coords.json"}
getGraphData :: String -> Aff (Either String GraphData) getGraphData :: String -> Aff GraphData
getGraphData fp = do getGraphData fp = get $ "http://localhost:2015/examples/" <> fp
resp <- request defaultRequest
{ url =("http://localhost:2015/examples/" <> fp)
, method = Left GET
, responseFormat = ResponseFormat.json
, headers =
[ ContentType applicationJSON
, Accept applicationJSON
]
}
case resp.body of
Left err -> do
liftEffect $ log $ printResponseFormatError err
pure $ Left $ printResponseFormatError err
Right json -> do
liftEffect $ log $ stringify json
let gd = decodeJson json
pure gd
defaultPalette :: Array Color defaultPalette :: Array Color
defaultPalette = map Color defaultPalette' defaultPalette = map Color defaultPalette'
...@@ -392,7 +365,7 @@ specOld = simpleSpec performAction render' ...@@ -392,7 +365,7 @@ specOld = simpleSpec performAction render'
, settings : mySettings , settings : mySettings
, style : sStyle { height : "95%"} , style : sStyle { height : "95%"}
-- , onClickNode : \e -> do -- , onClickNode : \e -> do
-- log $ unsafeCoerce e -- logs $ unsafeCoerce e
-- d $ SelectNode $ SelectedNode {id : (unsafeCoerce e).data.node.id, label : (unsafeCoerce e).data.node.label} -- d $ SelectNode $ SelectedNode {id : (unsafeCoerce e).data.node.id, label : (unsafeCoerce e).data.node.label}
-- pure unit -- pure unit
} }
......
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
module Gargantext.Pages.Corpus.Doc.Facets.Actions where module Gargantext.Pages.Corpus.Tabs.Actions where
import Data.Lens (Prism', prism) import Data.Lens (Prism', prism)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV import Gargantext.Pages.Corpus.Tabs.Documents as DV
import Gargantext.Pages.Corpus.Doc.Facets.Sources as SV import Gargantext.Pages.Corpus.Tabs.Sources as SV
import Gargantext.Pages.Corpus.Doc.Facets.Authors as AV import Gargantext.Pages.Corpus.Tabs.Authors as AV
import Gargantext.Pages.Corpus.Doc.Facets.Terms as TV import Gargantext.Pages.Corpus.Tabs.Terms as TV
import Gargantext.Components.Tab as Tab import Gargantext.Components.Tab as Tab
data Action data Action
...@@ -46,6 +46,3 @@ _tabAction = prism TabViewA \ action -> ...@@ -46,6 +46,3 @@ _tabAction = prism TabViewA \ action ->
case action of case action of
TabViewA laction -> Right laction TabViewA laction -> Right laction
_-> Left action _-> Left action
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 Prelude hiding (div)
import React.DOM (h3, text) import React.DOM (h3, text)
import Thermite (PerformAction, Render, Spec, defaultPerformAction, simpleSpec) import Thermite (PerformAction, Render, Spec, defaultPerformAction, simpleSpec)
type State = D.State type State = {}
initialState :: State initialState :: State
initialState = D.tdata initialState = {}
type Action = D.Action type Action = Void
authorSpec :: Spec State {} Action authorSpec :: Spec State {} Action
authorSpec = simpleSpec defaultPerformAction render authorSpec = simpleSpec defaultPerformAction render
...@@ -20,6 +18,3 @@ authorSpec = simpleSpec defaultPerformAction render ...@@ -20,6 +18,3 @@ authorSpec = simpleSpec defaultPerformAction render
render :: Render State {} Action render :: Render State {} Action
render dispatch _ state _ = render dispatch _ state _ =
[ h3 [] [text "AuthorView"]] [ h3 [] [text "AuthorView"]]
authorspec' :: Spec State {} Action
authorspec' = fold [authorSpec, D.layoutDocview]
module Gargantext.Pages.Corpus.Doc.Facets.Documents where module Gargantext.Pages.Corpus.Tabs.Documents where
import Prelude hiding (div) import Data.Array (take, drop)
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.?), (:=), (~>)) import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.?), (:=), (~>))
import Data.Array (filter)
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Show (genericShow) import Data.Generic.Rep.Show (genericShow)
import Data.HTTP.Method (Method(..)) import Data.Maybe (maybe)
import Data.Tuple (Tuple(..)) import Data.Tuple (Tuple(..))
import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect) import React.DOM (a, br', div, input, p, text)
import Effect.Console (log) import React.DOM.Props (_type, className, href)
import Thermite (Render, Spec, defaultPerformAction, simpleSpec)
import Gargantext.Config (NodeType(..), toUrl, End(..)) ------------------------------------------------------------------------
import Gargantext.Config.REST (get) import Gargantext.Prelude
import Gargantext.Config (NodeType(..), TabType(..), toUrl, End(..))
import Gargantext.Config.REST (get, post)
import Gargantext.Utils.DecodeMaybe ((.|)) import Gargantext.Utils.DecodeMaybe ((.|))
import Gargantext.Components.Charts.Options.ECharts (chart)
import React (ReactElement) import Gargantext.Components.Table as T
import React.DOM (a, b, b', br', div, input, option, select, span, table, tbody, td, text, th, thead, tr, p) import Gargantext.Components.Node (NodePoly(..))
import React.DOM.Props (_type, className, href, onChange, onClick, scope, selected, value) import Gargantext.Pages.Corpus.Tabs.Types
import Thermite (PerformAction, Render, Spec, modifyState, defaultPerformAction, simpleSpec) import Gargantext.Pages.Corpus.Dashboard (globalPublis)
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
--
-- TODO: Pagination Details are not available from the BackEnd -- 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: Search is pending
-- TODO: Fav is pending -- TODO: Fav is pending
-- TODO: Sort is Pending -- TODO: Sort is Pending
-- TODO: Filter is Pending -- TODO: Filter is Pending
-- TODO: When a pagination link is clicked, reload data. -- TODO: When a pagination link is clicked, reload data.
-- Right now it doesn't make sense to reload mock data.
data Action type State = {}
= LoadData Int
| ChangePageSize PageSizes
| ChangePage Int
type State = CorpusTableData type Action = Void
type CorpusTableData = TableData CorpusView newtype DocumentsView
= DocumentsView
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
{ _id :: Int { _id :: Int
, url :: String , url :: String
, date :: String , date :: String
...@@ -78,9 +45,9 @@ newtype CorpusView ...@@ -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 show = genericShow
...@@ -143,283 +110,100 @@ filterSpec = simpleSpec defaultPerformAction render ...@@ -143,283 +110,100 @@ filterSpec = simpleSpec defaultPerformAction render
, input [] , input []
]] ]]
layoutDocview :: Spec State {} Action -- | Main layout of the Documents Tab of a Corpus
layoutDocview = simpleSpec performAction render layoutDocview :: Spec State Props Action
layoutDocview = simpleSpec absurd render
where where
render :: Render State {} Action render :: Render State Props Action
render dispatch _ state@(TableData d) _ = render dispatch {path, loaded} _ _ =
[ div [className "container1"] [ div [className "container1"]
[ div [className "row"] [ div [className "row"]
[ [ chart globalPublis
div [className "col-md-12"] , div [className "col-md-12"]
[ p [] [] [ p [] []
, div [] [ text " Filter ", input []] , div [] [ text " Filter ", input []]
, br' , br'
, div [className "row"] , T.tableElt
[ div [className "col-md-1"] [b [] [text d.title]] { loadRows
, div [className "col-md-2"] [sizeDD d.pageSize dispatch] , title: "Documents"
, div [className "col-md-3"] [textDescription d.currentPage d.pageSize d.totalRecords] , colNames:
, div [className "col-md-3"] [pagination dispatch d.totalPages d.currentPage] [ ""
] , "Date"
, table [ className "table"] , "Title"
[thead [ className "thead-dark"] , "Source"
[tr [] [ th [scope "col"] [ b' [text ""] ] , "Delete"
, th [scope "col"] [ b' [text "Date"]] ]
, th [scope "col"] [ b' [text "Title"] ] , totalRecords: maybe 47361 -- TODO
, th [scope "col"] [ b' [text "Delete"] ] identity
] ((\(NodePoly n) -> n.hyperdata)
] >>>
, tbody [] $ map showRow d.rows (\(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 where
res2corpus :: Array Response -> Array CorpusView loadRows {offset, limit} = do
res2corpus rs = map (\(Response r) -> _ <- logs "loading documents page"
CorpusView { _id : r.cid 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 : "" , url : ""
, date : r.created , date : r.created
, title : (\(Hyperdata hr) -> hr.title) r.hyperdata , title : (\(Hyperdata hr) -> hr.title) r.hyperdata
, source : (\(Hyperdata hr) -> hr.source) r.hyperdata , source : (\(Hyperdata hr) -> hr.source) r.hyperdata
, fav : r.favorite , fav : r.favorite
, ngramCount : r.ngramCount , 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 = 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 :: 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"] 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"]
initialState :: State
data' :: Array CorpusView -> Array {row :: CorpusView, delete :: Boolean} initialState = {}
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
newtype SearchQuery = SearchQuery newtype SearchQuery = SearchQuery
{ {
...@@ -436,21 +220,6 @@ instance encodeJsonSQuery :: EncodeJson SearchQuery where ...@@ -436,21 +220,6 @@ instance encodeJsonSQuery :: EncodeJson SearchQuery where
searchResults :: SearchQuery -> Aff (Either String (Int)) searchResults :: SearchQuery -> Aff Int
searchResults squery = do searchResults squery = post "http://localhost:8008/count" unit
res <- request $ defaultRequest -- TODO
{ 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
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 Prelude hiding (div)
import React.DOM (h3, text) import React.DOM (h3, text)
import Thermite (Render, Spec, defaultPerformAction, simpleSpec) import Thermite (Render, Spec, defaultPerformAction, simpleSpec)
type State = D.State type State = {}
initialState :: State
initialState = {}
initialState :: D.State type Action = Void
initialState = D.tdata
type Action = D.Action
sourceSpec :: Spec State {} Action sourceSpec :: Spec State {} Action
sourceSpec = simpleSpec defaultPerformAction render sourceSpec = simpleSpec defaultPerformAction render
...@@ -22,6 +18,3 @@ sourceSpec = simpleSpec defaultPerformAction render ...@@ -22,6 +18,3 @@ sourceSpec = simpleSpec defaultPerformAction render
render :: Render State {} Action render :: Render State {} Action
render dispatch _ state _ = render dispatch _ state _ =
[ h3 [] [text "Source view"]] [ h3 [] [text "Source view"]]
sourcespec' :: Spec State {} Action
sourcespec' = fold [sourceSpec, D.layoutDocview]
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
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})
module Gargantext.Pages.Corpus.Doc.Facets.Terms where module Gargantext.Pages.Corpus.Tabs.Terms where
import Data.Array (fold) import Data.Array (fold)
import Gargantext.Pages.Corpus.Doc.Facets.Documents as D
import Prelude hiding (div) import Prelude hiding (div)
import React.DOM (h3, text) import React.DOM (h3, text)
import Thermite (PerformAction, Render, Spec, defaultPerformAction, simpleSpec) import Thermite (PerformAction, Render, Spec, defaultPerformAction, simpleSpec)
type State = {}
type State = D.State initialState :: State
initialState = {}
initialState :: D.State
initialState = D.tdata
type Action = D.Action
type Action = Void
termsSpec :: Spec State {} Action termsSpec :: Spec State {} Action
termsSpec = simpleSpec defaultPerformAction render termsSpec = simpleSpec defaultPerformAction render
...@@ -23,6 +19,3 @@ termsSpec = simpleSpec defaultPerformAction render ...@@ -23,6 +19,3 @@ termsSpec = simpleSpec defaultPerformAction render
render :: Render State {} Action render :: Render State {} Action
render dispatch _ state _ = render dispatch _ state _ =
[ h3 [] [text "Terms view"]] [ h3 [] [text "Terms view"]]
termSpec' :: Spec State {} Action
termSpec' = fold [termsSpec, D.layoutDocview]
module Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsItem where module Gargantext.Pages.Corpus.Tabs.Terms.NgramsItem where
import Prelude import Prelude
...@@ -8,7 +8,7 @@ import Data.Lens.Iso.Newtype (_Newtype) ...@@ -8,7 +8,7 @@ import Data.Lens.Iso.Newtype (_Newtype)
import React (ReactElement) import React (ReactElement)
import React.DOM (input, span, td, text, tr) import React.DOM (input, span, td, text, tr)
import React.DOM.Props (_type, checked, className, onChange, style, title) import React.DOM.Props (_type, checked, className, onChange, style, title)
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec, hide, focusState) import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec, hideState, focusState)
import Gargantext.Utils (getter, setter) import Gargantext.Utils (getter, setter)
newtype State = State newtype State = State
...@@ -37,18 +37,18 @@ data Action ...@@ -37,18 +37,18 @@ data Action
= SetMap Boolean = SetMap Boolean
| SetStop Boolean | SetStop Boolean
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 :: Spec {} {} Void
ngramsItemSpec = hide (unwrap initialState) $ ngramsItemSpec = hideState (unwrap initialState) $
focusState (re _Newtype) $ focusState (re _Newtype) $
simpleSpec performAction render simpleSpec performAction render
where 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 :: Render State {} Action
render dispatch _ (State state) _ = render dispatch _ (State state) _ =
[ [
......
module Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsTable where module Gargantext.Pages.Corpus.Tabs.Terms.NgramsTable where
import Data.Array (filter, toUnfoldable) import Data.Array (filter, toUnfoldable)
...@@ -12,12 +12,12 @@ import Data.Tuple (Tuple(..), uncurry) ...@@ -12,12 +12,12 @@ import Data.Tuple (Tuple(..), uncurry)
import Data.Void (Void) import Data.Void (Void)
import Data.Unit (Unit) import Data.Unit (Unit)
import Effect (Effect) import Effect (Effect)
import Gargantext.Pages.Corpus.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 Prelude (class Eq, class Ord, class Show, map, show, void, ($), (*), (+), (-), (/), (<), (<>), (==), (>), (>=), pure, unit)
import React (ReactElement) import React (ReactElement)
import React.DOM hiding (style, map) import React.DOM hiding (style, map)
import React.DOM.Props (_id, _type, className, href, name, onChange, onClick, onInput, placeholder, scope, selected, style, value) import React.DOM.Props (_id, _type, className, href, name, onChange, onClick, onInput, placeholder, scope, selected, style, value)
import Thermite (PerformAction, Spec, _render, focus, foreach, modifyState, focusState, hide) import Thermite (PerformAction, Spec, _render, focus, foreach, modifyState, focusState, hideState)
import Unsafe.Coerce (unsafeCoerce) import Unsafe.Coerce (unsafeCoerce)
newtype State = State newtype State = State
...@@ -60,6 +60,7 @@ _ItemAction = prism (uncurry ItemAction) \ta -> ...@@ -60,6 +60,7 @@ _ItemAction = prism (uncurry ItemAction) \ta ->
type Dispatch = Action -> Effect Unit type Dispatch = Action -> Effect Unit
{-
performAction :: PerformAction State {} Action performAction :: PerformAction State {} Action
performAction (ChangePageSize ps) _ _ = void $ modifyState $ changePageSize ps performAction (ChangePageSize ps) _ _ = void $ modifyState $ changePageSize ps
...@@ -77,6 +78,7 @@ performAction (SetInput s) _ _ = void do ...@@ -77,6 +78,7 @@ performAction (SetInput s) _ _ = void do
modifyState \(State state) -> State $ state { search = s } modifyState \(State state) -> State $ state { search = s }
performAction _ _ _ = pure unit performAction _ _ _ = pure unit
-}
tableSpec :: Spec State {} Action -> Spec State {} Action tableSpec :: Spec State {} Action -> Spec State {} Action
tableSpec = over _render \render dispatch p (State s) c -> tableSpec = over _render \render dispatch p (State s) c ->
...@@ -157,7 +159,7 @@ 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 :: Spec {} {} Void
ngramsTableSpec = ngramsTableSpec =
hide (unwrap initialState) $ hideState (unwrap initialState) $
focusState (re _Newtype) $ focusState (re _Newtype) $
container $ container $
tableSpec $ tableSpec $
...@@ -314,8 +316,8 @@ pagination d tp cp ...@@ -314,8 +316,8 @@ pagination d tp cp
text " ... " text " ... "
else else
text "" text ""
lnums = map (\i -> fnmid d i) $ filter (lessthan 1) [cp - 2, cp - 1] lnums = map (\i -> fnmid d i) $ filter (1 < _) [cp - 2, cp - 1]
rnums = map (\i -> fnmid d i) $ filter (greaterthan tp) [cp + 1, cp + 2] rnums = map (\i -> fnmid d i) $ filter (tp > _) [cp + 1, cp + 2]
fnmid :: Dispatch -> Int -> ReactElement fnmid :: Dispatch -> Int -> ReactElement
fnmid d i fnmid d i
...@@ -326,10 +328,3 @@ fnmid d i ...@@ -326,10 +328,3 @@ fnmid d i
] [text $ show i] ] [text $ show i]
, text " " , text " "
] ]
lessthan :: forall t28. Ord t28 => t28 -> t28 -> Boolean
lessthan x y = x < y
greaterthan :: forall t28. Ord t28 => t28 -> t28 -> Boolean
greaterthan x y = x > y
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
...@@ -16,7 +16,7 @@ import Gargantext.Pages.Home.Actions (Action, performAction) ...@@ -16,7 +16,7 @@ import Gargantext.Pages.Home.Actions (Action, performAction)
import React (ReactElement) import React (ReactElement)
import React.DOM (a, div, h3, i, img, p, span, text) import React.DOM (a, div, h3, i, img, p, span, text)
import React.DOM.Props (Props, _id, aria, className, href, src, target, title) import React.DOM.Props (Props, _id, aria, className, href, src, target, title)
import Thermite (Render, Spec, simpleSpec, hide, focusState) import Thermite (Render, Spec, simpleSpec, hideState, focusState)
-- Layout | -- Layout |
...@@ -26,7 +26,7 @@ landingData FR = Fr.landingData ...@@ -26,7 +26,7 @@ landingData FR = Fr.landingData
landingData EN = En.landingData landingData EN = En.landingData
layoutLanding :: Lang -> Spec {} {} Void layoutLanding :: Lang -> Spec {} {} Void
layoutLanding = hide (unwrap initialState) layoutLanding = hideState (unwrap initialState)
<<< focusState (re _Newtype) <<< focusState (re _Newtype)
<<< layoutLanding' <<< landingData <<< layoutLanding' <<< landingData
......
...@@ -4,13 +4,11 @@ import Prelude hiding (div) ...@@ -4,13 +4,11 @@ import Prelude hiding (div)
-- import Gargantext.Components.Login as LN -- import Gargantext.Components.Login as LN
import Gargantext.Pages.Layout.Actions (Action(..)) import Gargantext.Pages.Layout.Actions (Action(..))
import Gargantext.Pages.Layout.Specs.AddCorpus as AC import Gargantext.Pages.Layout.Specs.AddCorpus as AC
-- import Gargantext.Pages.Corpus.Doc.Facets as TV -- import Gargantext.Pages.Corpus.Tabs as TV
-- import Gargantext.Pages.Corpus.Doc.Annotation as D
import Gargantext.Pages.Corpus as Corpus import Gargantext.Pages.Corpus.Document as Document
import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV import Gargantext.Pages.Corpus.Graph as GE
import Gargantext.Pages.Corpus.Doc.Facets.Graph as GE -- import Gargantext.Pages.Corpus.Tabs.Terms.NgramsTable as NG
-- import Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsTable as NG
import Gargantext.Pages.Annuaire.User.Contacts as C import Gargantext.Pages.Annuaire.User.Contacts as C
import Gargantext.Pages.Annuaire as Annuaire import Gargantext.Pages.Annuaire as Annuaire
...@@ -36,13 +34,8 @@ dispatchAction dispatcher _ AddCorpus = do ...@@ -36,13 +34,8 @@ dispatchAction dispatcher _ AddCorpus = do
dispatcher $ SetRoute AddCorpus dispatcher $ SetRoute AddCorpus
dispatcher $ AddCorpusA AC.LoadDatabaseDetails dispatcher $ AddCorpusA AC.LoadDatabaseDetails
dispatchAction dispatcher _ (DocView n) = do
dispatcher $ SetRoute (DocView n)
dispatcher $ DocViewA $ DV.LoadData n
dispatchAction dispatcher _ (Corpus n) = do dispatchAction dispatcher _ (Corpus n) = do
dispatcher $ SetRoute $ Corpus n dispatcher $ SetRoute $ Corpus n
dispatcher $ CorpusAction $ Corpus.Load n
dispatchAction dispatcher _ SearchView = do dispatchAction dispatcher _ SearchView = do
dispatcher $ SetRoute SearchView dispatcher $ SetRoute SearchView
...@@ -60,13 +53,9 @@ dispatchAction dispatcher _ (Annuaire id) = do ...@@ -60,13 +53,9 @@ dispatchAction dispatcher _ (Annuaire id) = do
dispatchAction dispatcher _ (Folder id) = do dispatchAction dispatcher _ (Folder id) = do
dispatcher $ SetRoute $ Folder id dispatcher $ SetRoute $ Folder id
dispatchAction dispatcher _ (DocAnnotation i) = do dispatchAction dispatcher _ (Document n) = do
dispatcher $ SetRoute $ DocAnnotation i dispatcher $ SetRoute $ Document n
-- dispatcher $ DocAnnotationViewA TODO dispatcher $ DocumentViewA $ Document.Load n
dispatchAction dispatcher _ Tabview = do
dispatcher $ SetRoute Tabview
-- dispatcher $ TabViewA TODO
dispatchAction dispatcher _ PGraphExplorer = do dispatchAction dispatcher _ PGraphExplorer = do
dispatcher $ SetRoute PGraphExplorer dispatcher $ SetRoute PGraphExplorer
......
...@@ -2,28 +2,24 @@ ...@@ -2,28 +2,24 @@
module Gargantext.Pages.Layout.Actions where module Gargantext.Pages.Layout.Actions where
import Prelude hiding (div)
import Control.Monad.Cont.Trans (lift) import Control.Monad.Cont.Trans (lift)
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Lens (Prism', prism) import Data.Lens (Prism', prism)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Console (log) import Thermite (PerformAction, modifyState)
import Gargantext.Components.Login as LN import Gargantext.Components.Login as LN
import Gargantext.Components.Modals.Modal (modalShow) import Gargantext.Components.Modals.Modal (modalShow)
import Gargantext.Components.Tree as Tree import Gargantext.Components.Tree as Tree
import Gargantext.Pages.Corpus as Corpus
import Gargantext.Pages.Corpus.Doc.Annotation as D
import Gargantext.Pages.Corpus.Doc.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 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.AddCorpus as AC
import Gargantext.Pages.Layout.Specs.Search as S import Gargantext.Pages.Layout.Specs.Search as S
import Gargantext.Pages.Layout.States (AppState) import Gargantext.Pages.Layout.States (AppState)
import Gargantext.Prelude
import Gargantext.Router (Routes) import Gargantext.Router (Routes)
import Thermite (PerformAction, modifyState)
------------------------------------------------------------------------ ------------------------------------------------------------------------
...@@ -31,14 +27,12 @@ data Action ...@@ -31,14 +27,12 @@ data Action
= Initialize = Initialize
| LoginA LN.Action | LoginA LN.Action
| SetRoute Routes | SetRoute Routes
| AddCorpusA AC.Action | TreeViewA Tree.Action
| DocViewA DV.Action
| SearchA S.Action | SearchA S.Action
| Search String | Search String
| TreeViewA Tree.Action | AddCorpusA AC.Action
| CorpusAction Corpus.Action
| GraphExplorerA GE.Action | GraphExplorerA GE.Action
| DocAnnotationViewA D.Action | DocumentViewA D.Action
| AnnuaireAction Annuaire.Action | AnnuaireAction Annuaire.Action
| UserPageA C.Action | UserPageA C.Action
| Go | Go
...@@ -70,40 +64,19 @@ performAction Go _ _ = void do ...@@ -70,40 +64,19 @@ performAction Go _ _ = void do
--------------------------------------------------------- ---------------------------------------------------------
performAction Initialize _ state = void do performAction Initialize _ state = void do
_ <- liftEffect $ log "loading Initial nodes" _ <- logs "loading Initial nodes"
case state.initialized of case state.initialized of
false -> do false -> do
lnodes <- lift $ Tree.loadDefaultNode lnodes <- lift $ Tree.loadDefaultNode
case lnodes of void $ modifyState $ _ { initialized = true, ntreeState = lnodes }
Left err -> do
pure unit
Right d -> do
_ <- modifyState $ _ { initialized = true, ntreeState = d}
pure unit
-- page <- lift $ DV.loadPage
-- case page of
-- Left err -> do
-- pure unit
-- Right docs -> void do
-- modifyState $ _ { initialized = true
-- , ntreeState = d
-- -- if length d > 0
-- -- then Tree.exampleTree
-- -- --then fnTransform $ unsafePartial $ fromJust $ head d
-- -- else Tree.initialState
--
-- , docViewState = docs
-- }
_ -> do _ -> do
pure unit pure unit
performAction (LoginA _) _ _ = pure unit performAction (LoginA _) _ _ = pure unit
performAction (AddCorpusA _) _ _ = pure unit performAction (AddCorpusA _) _ _ = pure unit
performAction (CorpusAction _) _ _ = pure unit
performAction (DocViewA _) _ _ = pure unit
performAction (SearchA _) _ _ = pure unit performAction (SearchA _) _ _ = pure unit
performAction (UserPageA _) _ _ = pure unit performAction (UserPageA _) _ _ = pure unit
performAction (DocAnnotationViewA _) _ _ = pure unit performAction (DocumentViewA _) _ _ = pure unit
performAction (TreeViewA _) _ _ = pure unit performAction (TreeViewA _) _ _ = pure unit
performAction (GraphExplorerA _) _ _ = pure unit performAction (GraphExplorerA _) _ _ = pure unit
performAction (AnnuaireAction _) _ _ = pure unit performAction (AnnuaireAction _) _ _ = pure unit
...@@ -122,18 +95,6 @@ _addCorpusAction = prism AddCorpusA \action -> ...@@ -122,18 +95,6 @@ _addCorpusAction = prism AddCorpusA \action ->
AddCorpusA caction -> Right caction AddCorpusA caction -> Right caction
_-> Left action _-> Left action
_corpusAction :: Prism' Action Corpus.Action
_corpusAction = prism CorpusAction \action ->
case action of
CorpusAction caction -> Right caction
_-> Left action
_docViewAction :: Prism' Action DV.Action
_docViewAction = prism DocViewA \action ->
case action of
DocViewA caction -> Right caction
_-> Left action
_searchAction :: Prism' Action S.Action _searchAction :: Prism' Action S.Action
_searchAction = prism SearchA \action -> _searchAction = prism SearchA \action ->
case action of case action of
...@@ -152,10 +113,10 @@ _annuaireAction = prism AnnuaireAction \action -> ...@@ -152,10 +113,10 @@ _annuaireAction = prism AnnuaireAction \action ->
AnnuaireAction a -> Right a AnnuaireAction a -> Right a
_ -> Left action _ -> Left action
_docAnnotationViewAction :: Prism' Action D.Action _documentViewAction :: Prism' Action D.Action
_docAnnotationViewAction = prism DocAnnotationViewA \action -> _documentViewAction = prism DocumentViewA \action ->
case action of case action of
DocAnnotationViewA caction -> Right caction DocumentViewA caction -> Right caction
_-> Left action _-> Left action
_treeAction :: Prism' Action Tree.Action _treeAction :: Prism' Action Tree.Action
......
module Gargantext.Pages.Layout.Specs where module Gargantext.Pages.Layout.Specs where
import Prelude hiding (div)
import Data.Foldable (fold, intercalate) import Data.Foldable (fold, intercalate)
import Data.Lens (over) import Data.Lens (over)
import Data.Maybe (Maybe(Nothing, Just)) import Data.Maybe (Maybe(Nothing, Just))
import Effect (Effect) import Effect (Effect)
import React (ReactElement)
import React.DOM (a, button, div, footer, hr', img, input, li, p, span, text, ul)
import React.DOM.Props (_data, _id, _type, aria, className, href, onChange, onClick, placeholder, role, src, style, tabIndex, target, title)
import Thermite (Render, Spec, _render, defaultPerformAction, defaultRender, focus, simpleSpec, withState, noState, cmapProps)
import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Prelude
import Gargantext.Components.Data.Lang (Lang(..)) import Gargantext.Components.Data.Lang (Lang(..))
import Gargantext.Components.Login as LN import Gargantext.Components.Login as LN
import Gargantext.Components.Tree as Tree import Gargantext.Components.Tree as Tree
import Gargantext.Pages.Annuaire as A
import Gargantext.Folder as F import Gargantext.Folder as F
import Gargantext.Pages.Corpus as Corpus import Gargantext.Pages.Annuaire as A
import Gargantext.Pages.Corpus.Doc.Annotation as Annotation
import Gargantext.Pages.Corpus.Doc.Facets as TV
import Gargantext.Pages.Corpus.Doc.Facets.Dashboard as Dsh
import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV
import Gargantext.Pages.Corpus.Doc.Facets.Graph as GE
import Gargantext.Pages.Corpus.Doc.Facets.Terms.NgramsTable as NG
import Gargantext.Pages.Annuaire.User.Contacts as C import Gargantext.Pages.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.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.AddCorpus as AC
import Gargantext.Pages.Layout.Specs.Search as S import Gargantext.Pages.Layout.Specs.Search as S
import Gargantext.Pages.Layout.States (AppState, _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 Gargantext.Router (Routes(..))
import React (ReactElement)
import React.DOM (a, button, div, footer, hr', img, input, li, p, span, text, ul)
import React.DOM.Props (_data, _id, _type, aria, className, href, onChange, onClick, placeholder, role, src, style, tabIndex, target, title)
import Thermite (Render, Spec, _render, defaultPerformAction, defaultRender, focus, simpleSpec, withState, noState)
import Unsafe.Coerce (unsafeCoerce)
layoutSpec :: Spec AppState {} Action layoutSpec :: Spec AppState {} Action
layoutSpec = layoutSpec =
...@@ -48,28 +46,26 @@ layoutSpec = ...@@ -48,28 +46,26 @@ layoutSpec =
(render d p s c) (render d p s c)
pagesComponent :: AppState -> Spec AppState {} Action pagesComponent :: AppState -> Spec AppState {} Action
pagesComponent s = pagesComponent s = case s.currentRoute of
case s.currentRoute of
Just route -> selectSpec route 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 where
selectSpec :: Routes -> Spec AppState {} Action 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 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 AddCorpus = layout0 $ focus _addCorpusState _addCorpusAction AC.layoutAddcorpus
selectSpec (DocView i) = layout0 $ focus _docViewState _docViewAction DV.layoutDocview
selectSpec (UserPage i) = layout0 $ focus _userPageState _userPageAction C.layoutUser
selectSpec (DocAnnotation i) = layout0 $ focus _docAnnotationViewState
_docAnnotationViewAction Annotation.docview
-- To be removed
selectSpec Tabview = layout0 $ noState TV.pureTab1
selectSpec SearchView = layout0 $ focus _searchState _searchAction S.searchSpec selectSpec SearchView = layout0 $ focus _searchState _searchAction S.searchSpec
selectSpec NGramsTable = layout0 $ noState NG.ngramsTableSpec selectSpec (Document i) = layout0 $ focus _documentViewState _documentViewAction Annotation.docview
selectSpec PGraphExplorer = focus _graphExplorerState _graphExplorerAction GE.specOld selectSpec PGraphExplorer = focus _graphExplorerState _graphExplorerAction GE.specOld
selectSpec Dashboard = layout0 $ noState Dsh.layoutDashboard selectSpec Dashboard = layout0 $ noState Dsh.layoutDashboard
selectSpec (Annuaire i) = layout0 $ focus _annuaireState _annuaireAction A.layoutAnnuaire selectSpec (Annuaire i) = layout0 $ focus _annuaireState _annuaireAction A.layoutAnnuaire
selectSpec (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 -- selectSpec _ = simpleSpec defaultPerformAction defaultRender
......
module Gargantext.Pages.Layout.Specs.AddCorpus.Actions where module Gargantext.Pages.Layout.Specs.AddCorpus.Actions where
import Prelude hiding (div)
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..))
import Affjax.RequestHeader (RequestHeader(..))
import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift) import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, stringify, (:=), (~>)) import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Maybe (Maybe(Just))
import Data.MediaType.Common (applicationJSON)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Console (log)
import Gargantext.Components.Modals.Modal (modalHide)
import Gargantext.Pages.Layout.Specs.AddCorpus.States (Response, State)
import Routing.Hash (setHash) import Routing.Hash (setHash)
import Thermite (PerformAction, modifyState) 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 data Action
= SelectDatabase Boolean = SelectDatabase Boolean
| UnselectDatabase Boolean | UnselectDatabase Boolean
...@@ -35,10 +27,7 @@ performAction (UnselectDatabase unselected) _ _ = void do ...@@ -35,10 +27,7 @@ performAction (UnselectDatabase unselected) _ _ = void do
performAction (LoadDatabaseDetails) _ _ = do performAction (LoadDatabaseDetails) _ _ = do
res <- lift $ getDatabaseDetails $ QueryString { query_query: "string",query_name: ["Pubmed"]} res <- lift $ getDatabaseDetails $ QueryString { query_query: "string",query_name: ["Pubmed"]}
case res of void $ modifyState $ _ {response = res}
Left err -> pure unit
Right resData -> do
void $ modifyState $ _ {response = resData}
performAction GO _ _ = do performAction GO _ _ = do
liftEffect $ setHash "/corpus" liftEffect $ setHash "/corpus"
...@@ -68,25 +57,7 @@ instance encodeJsonQueryString :: EncodeJson QueryString where ...@@ -68,25 +57,7 @@ instance encodeJsonQueryString :: EncodeJson QueryString where
~> "query_name" := obj.query_name ~> "query_name" := obj.query_name
~> jsonEmptyObject ~> jsonEmptyObject
getDatabaseDetails :: QueryString -> Aff (Either String (Array Response)) getDatabaseDetails :: QueryString -> Aff (Array Response)
getDatabaseDetails reqBody = do getDatabaseDetails reqBody = do
let token = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJleHAiOjE1MTk5OTg1ODMsInVzZXJfaWQiOjUsImVtYWlsIjoiYWxleGFuZHJlLmRlbGFub2VAaXNjcGlmLmZyIiwidXNlcm5hbWUiOiJkZXZlbG9wZXIifQ.Os-3wuFNSmRIxCZi98oFNBu2zqGc0McO-dgDayozHJg" -- TODO let token = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJleHAiOjE1MTk5OTg1ODMsInVzZXJfaWQiOjUsImVtYWlsIjoiYWxleGFuZHJlLmRlbGFub2VAaXNjcGlmLmZyIiwidXNlcm5hbWUiOiJkZXZlbG9wZXIifQ.Os-3wuFNSmRIxCZi98oFNBu2zqGc0McO-dgDayozHJg"
affResp <- request $ defaultRequest post "http://localhost:8009/count" reqBody
{ 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
module Gargantext.Pages.Layout.Specs.AddCorpus.Specs where module Gargantext.Pages.Layout.Specs.AddCorpus.Specs where
import Gargantext.Pages.Layout.Specs.AddCorpus.Actions
import Gargantext.Pages.Layout.Specs.AddCorpus.States
import Prelude hiding (div)
import Affjax (defaultRequest, printResponseFormatError, request)
import Affjax.RequestBody (RequestBody(..))
import Affjax.ResponseFormat as ResponseFormat
import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, (.?), (:=), (~>))
import Data.Either (Either(..))
import Data.HTTP.Method (Method(..))
import Data.Lens (over) import Data.Lens (over)
import Data.Maybe (Maybe(Just))
import Data.MediaType.Common (applicationJSON)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Effect.Console (log)
import Gargantext.Components.Modals.Modal (modalHide)
import React (ReactElement) import React (ReactElement)
import React.DOM (button, div, h3, h5, li, span, text, ul) import React.DOM (button, div, h3, h5, li, span, text, ul)
import React.DOM.Props (_data, _id, _type, aria, className, onClick, role) import React.DOM.Props (_data, _id, _type, aria, className, onClick, role)
import Thermite (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 :: Boolean -> String -> Spec State {} Action -> Spec State {} Action
modalSpec sm t = over _render \render d p s c -> modalSpec sm t = over _render \render d p s c ->
...@@ -125,22 +113,5 @@ layoutAddcorpus = simpleSpec performAction render ...@@ -125,22 +113,5 @@ layoutAddcorpus = simpleSpec performAction render
countResults :: Query -> Aff (Either String (Int)) countResults :: Query -> Aff Int
countResults query = do countResults = post "http://localhost:8008/count"
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
...@@ -27,20 +27,19 @@ data Action ...@@ -27,20 +27,19 @@ data Action
| SetQuery String | SetQuery String
performAction :: PerformAction State {} Action
performAction (SetQuery q) _ _ = void do
modifyState $ _ { query = q }
performAction GO _ _ = void do
liftEffect $ setHash "/addCorpus"
unsafeEventValue :: forall event. event -> String unsafeEventValue :: forall event. event -> String
unsafeEventValue e = (unsafeCoerce e).target.value unsafeEventValue e = (unsafeCoerce e).target.value
searchSpec :: Spec State {} Action searchSpec :: Spec State {} Action
searchSpec = simpleSpec performAction render searchSpec = simpleSpec performAction render
where where
performAction :: PerformAction State {} Action
performAction (SetQuery q) _ _ = void do
modifyState $ _ { query = q }
performAction GO _ _ = void do
liftEffect $ setHash "/addCorpus"
render :: Render State {} Action render :: Render State {} Action
render dispatch _ state _ = render dispatch _ state _ =
[ div [className "container1"] [] [ div [className "container1"] []
......
...@@ -7,11 +7,10 @@ import Data.Maybe (Maybe(Just)) ...@@ -7,11 +7,10 @@ import Data.Maybe (Maybe(Just))
import Gargantext.Components.Login as LN import Gargantext.Components.Login as LN
import Gargantext.Components.Tree as Tree import Gargantext.Components.Tree as Tree
import Gargantext.Pages.Corpus as Corpus import Gargantext.Pages.Corpus.Document as D
import Gargantext.Pages.Corpus.Doc.Annotation as D
import Gargantext.Pages.Annuaire as Annuaire import Gargantext.Pages.Annuaire as Annuaire
import Gargantext.Pages.Corpus.Doc.Facets.Documents as DV import Gargantext.Pages.Corpus.Tabs.Documents as DV
import Gargantext.Pages.Corpus.Doc.Facets.Graph as GE import Gargantext.Pages.Corpus.Graph as GE
import Gargantext.Pages.Annuaire.User.Contacts as C import Gargantext.Pages.Annuaire.User.Contacts as C
import Gargantext.Pages.Layout.Specs.AddCorpus as AC import Gargantext.Pages.Layout.Specs.AddCorpus as AC
import Gargantext.Pages.Layout.Specs.Search as S import Gargantext.Pages.Layout.Specs.Search as S
...@@ -20,12 +19,11 @@ import Gargantext.Router (Routes(..)) ...@@ -20,12 +19,11 @@ import Gargantext.Router (Routes(..))
type AppState = type AppState =
{ currentRoute :: Maybe Routes { currentRoute :: Maybe Routes
, loginState :: LN.State , loginState :: LN.State
, corpus :: Corpus.State
, addCorpusState :: AC.State , addCorpusState :: AC.State
, docViewState :: DV.State , docViewState :: DV.State
, searchState :: S.State , searchState :: S.State
, userPageState :: C.State , userPageState :: C.State
, docAnnotationState :: D.State , documentState :: D.State
, annuaireState :: Annuaire.State , annuaireState :: Annuaire.State
, ntreeState :: Tree.State , ntreeState :: Tree.State
, search :: String , search :: String
...@@ -38,13 +36,12 @@ type AppState = ...@@ -38,13 +36,12 @@ type AppState =
initAppState :: AppState initAppState :: AppState
initAppState = initAppState =
{ currentRoute : Just Home { currentRoute : Just Home
, corpus : Corpus.initialState
, loginState : LN.initialState , loginState : LN.initialState
, addCorpusState : AC.initialState , addCorpusState : AC.initialState
, docViewState : DV.tdata , docViewState : DV.initialState
, searchState : S.initialState , searchState : S.initialState
, userPageState : C.initialState , userPageState : C.initialState
, docAnnotationState : D.initialState , documentState : D.initialState
, ntreeState : Tree.exampleTree , ntreeState : Tree.exampleTree
, annuaireState : Annuaire.initialState , annuaireState : Annuaire.initialState
, search : "" , search : ""
...@@ -61,9 +58,6 @@ _loginState = lens (\s -> s.loginState) (\s ss -> s{loginState = ss}) ...@@ -61,9 +58,6 @@ _loginState = lens (\s -> s.loginState) (\s ss -> s{loginState = ss})
_addCorpusState :: Lens' AppState AC.State _addCorpusState :: Lens' AppState AC.State
_addCorpusState = lens (\s -> s.addCorpusState) (\s ss -> s{addCorpusState = ss}) _addCorpusState = lens (\s -> s.addCorpusState) (\s ss -> s{addCorpusState = ss})
_corpusState :: Lens' AppState Corpus.State
_corpusState = lens (\s -> s.corpus) (\s ss -> s{corpus = ss})
_docViewState :: Lens' AppState DV.State _docViewState :: Lens' AppState DV.State
_docViewState = lens (\s -> s.docViewState) (\s ss -> s{docViewState = ss}) _docViewState = lens (\s -> s.docViewState) (\s ss -> s{docViewState = ss})
...@@ -76,8 +70,8 @@ _userPageState = lens (\s -> s.userPageState) (\s ss -> s{userPageState = ss}) ...@@ -76,8 +70,8 @@ _userPageState = lens (\s -> s.userPageState) (\s ss -> s{userPageState = ss})
_annuaireState :: Lens' AppState Annuaire.State _annuaireState :: Lens' AppState Annuaire.State
_annuaireState = lens (\s -> s.annuaireState) (\s ss -> s{annuaireState = ss}) _annuaireState = lens (\s -> s.annuaireState) (\s ss -> s{annuaireState = ss})
_docAnnotationViewState :: Lens' AppState D.State _documentViewState :: Lens' AppState D.State
_docAnnotationViewState = lens (\s -> s.docAnnotationState) (\s ss -> s{docAnnotationState = ss}) _documentViewState = lens (\s -> s.documentState) (\s ss -> s{documentState = ss})
_treeState :: Lens' AppState Tree.State _treeState :: Lens' AppState Tree.State
_treeState = lens (\s -> s.ntreeState) (\s ss -> s {ntreeState = ss}) _treeState = lens (\s -> s.ntreeState) (\s ss -> s {ntreeState = ss})
......
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
module Gargantext.Router where module Gargantext.Router where
import Prelude import Gargantext.Prelude
import Control.Alt ((<|>)) import Control.Alt ((<|>))
import Data.Int (floor) import Data.Int (floor)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Effect (Effect) import Effect (Effect)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Console (log)
import Routing.Match (Match, lit, num) import Routing.Match (Match, lit, num)
import Web.HTML (window) import Web.HTML (window)
import Web.HTML.Window (localStorage) import Web.HTML.Window (localStorage)
...@@ -20,9 +19,7 @@ data Routes ...@@ -20,9 +19,7 @@ data Routes
| Folder Int | Folder Int
| Corpus Int | Corpus Int
| AddCorpus | AddCorpus
| Tabview | Document Int
| DocView Int
| DocAnnotation Int
| PGraphExplorer | PGraphExplorer
| NGramsTable | NGramsTable
| Dashboard | Dashboard
...@@ -36,10 +33,8 @@ routing = ...@@ -36,10 +33,8 @@ routing =
<|> AddCorpus <$ route "addCorpus" <|> AddCorpus <$ route "addCorpus"
<|> Folder <$> (route "folder" *> int) <|> Folder <$> (route "folder" *> int)
<|> Corpus <$> (route "corpus" *> int) <|> Corpus <$> (route "corpus" *> int)
<|> Tabview <$ route "tabview"
<|> DocView <$> (route "docView" *> int)
<|> NGramsTable <$ route "ngrams" <|> NGramsTable <$ route "ngrams"
<|> DocAnnotation <$> (route "document" *> int) <|> Document <$> (route "document" *> int)
<|> Dashboard <$ route "dashboard" <|> Dashboard <$ route "dashboard"
<|> PGraphExplorer <$ route "graph" <|> PGraphExplorer <$ route "graph"
<|> Annuaire <$> (route "annuaire" *> int) <|> Annuaire <$> (route "annuaire" *> int)
...@@ -57,10 +52,8 @@ instance showRoutes :: Show Routes where ...@@ -57,10 +52,8 @@ instance showRoutes :: Show Routes where
show AddCorpus = "AddCorpus" show AddCorpus = "AddCorpus"
show SearchView = "Search" show SearchView = "Search"
show (UserPage i) = "User" <> show i show (UserPage i) = "User" <> show i
show (DocAnnotation i)= "Document" show (Document i)= "Document"
show (Corpus i) = "Corpus" <> show i show (Corpus i) = "Corpus" <> show i
show Tabview = "Tabview"
show (DocView i) = "DocView"
show NGramsTable = "NGramsTable" show NGramsTable = "NGramsTable"
show (Annuaire i) = "Annuaire" <> show i show (Annuaire i) = "Annuaire" <> show i
show (Folder i) = "Folder" <> show i show (Folder i) = "Folder" <> show i
...@@ -72,19 +65,19 @@ instance showRoutes :: Show Routes where ...@@ -72,19 +65,19 @@ instance showRoutes :: Show Routes where
routeHandler :: (Maybe Routes -> Routes -> Effect Unit) routeHandler :: (Maybe Routes -> Routes -> Effect Unit)
-> Maybe Routes -> Routes -> Effect Unit -> Maybe Routes -> Routes -> Effect Unit
routeHandler dispatchAction old new = do routeHandler dispatchAction old new = do
liftEffect $ log $ "change route : " <> show new logs $ "change route : " <> show new
w <- window w <- window
ls <- localStorage w ls <- localStorage w
token <- getItem "accessToken" ls token <- getItem "accessToken" ls
let tkn = token let tkn = token
liftEffect $ log $ "JWToken : " <> show tkn logs $ "JWToken : " <> show tkn
case tkn of case tkn of
Nothing -> do Nothing -> do
dispatchAction old new dispatchAction old new
liftEffect $ log $ "called SignIn Route :" logs $ "called SignIn Route :"
Just t -> do Just t -> do
dispatchAction old new dispatchAction old new
liftEffect $ log $ "called Route : " <> show new logs $ "called Route : " <> show new
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