Commit fafd5a21 authored by Przemyslaw Kaminski's avatar Przemyslaw Kaminski

Merge branch 'dev-search-removal' into dev-backend-connection

parents d179d061 a00f9694
......@@ -10,7 +10,6 @@ import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson
import Data.Array (drop, take, (:), filter)
import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.HTTP.Method (Method(..))
import Data.Lens
......@@ -22,15 +21,17 @@ import Data.Set (Set)
import Data.Set as Set
import Data.Int (fromString)
import Data.Symbol (SProxy(..))
import Data.Tuple (Tuple(..))
import Data.Tuple (Tuple(..), fst)
import Data.Tuple.Nested ((/\))
import DOM.Simple.Event as DE
import Effect (Effect)
import Effect.Aff (Aff, launchAff)
import Effect.Class (liftEffect)
import Effect.Uncurried (mkEffectFn1)
import Effect.Uncurried (EffectFn1, mkEffectFn1)
import React as React
import React (ReactClass, ReactElement, Children)
import Reactix as R
import Reactix.SyntheticEvent as RE
import Reactix.DOM.HTML as H
import Unsafe.Coerce (unsafeCoerce)
------------------------------------------------------------------------
......@@ -39,6 +40,7 @@ import Gargantext.Config (End(..), NodeType(..), OrderBy(..), Path(..), TabType,
import Gargantext.Config.REST (get, put, post, deleteWithBody, delete)
import Gargantext.Components.Loader2 (useLoader)
import Gargantext.Components.Node (NodePoly(..))
import Gargantext.Components.Search.Types (Category(..), CategoryQuery(..), favCategory, trashCategory, decodeCategory, putCategories)
import Gargantext.Components.Table as T
import Gargantext.Utils.DecodeMaybe ((.|))
import Gargantext.Utils.Reactix as R2
......@@ -48,26 +50,6 @@ import Thermite (PerformAction, Render, Spec, defaultPerformAction, modifyState_
type NodeID = Int
type TotalRecords = Int
data Category = Trash | Normal | Favorite
derive instance genericFavorite :: Generic Category _
instance showCategory :: Show Category where
show = genericShow
instance eqCategory :: Eq Category where
eq = genericEq
instance encodeJsonCategory :: EncodeJson Category where
encodeJson Trash = encodeJson 0
encodeJson Normal = encodeJson 1
encodeJson Favorite = encodeJson 2
favCategory :: Category -> Category
favCategory Normal = Favorite
favCategory Trash = Favorite
favCategory Favorite = Normal
trashCategory :: Category -> Category
trashCategory Normal = Trash
trashCategory Trash = Normal
trashCategory Favorite = Trash
type Props =
{ nodeId :: Int
......@@ -76,6 +58,7 @@ type Props =
, tabType :: TabType
, listId :: Int
, corpusId :: Maybe Int
, showSearch :: Boolean
-- ^ tabType is not ideal here since it is too much entangled with tabs and
-- ngramtable. Let's see how this evolves.
}
......@@ -89,7 +72,6 @@ type PageLoaderProps =
, query :: Query
}
type DocumentIdsDeleted = Set Int
type LocalCategories = Map Int Category
type Query = String
......@@ -141,12 +123,6 @@ instance decodeHyperdata :: DecodeJson Hyperdata where
pub_year <- obj .? "publication_year"
pure $ Hyperdata { title,source, pub_year}
decodeCategory :: Int -> Category
decodeCategory 0 = Trash
decodeCategory 1 = Normal
decodeCategory 2 = Favorite
decodeCategory _ = Normal
instance decodeResponse :: DecodeJson Response where
decodeJson json = do
obj <- decodeJson json
......@@ -162,30 +138,23 @@ docViewSpec p = R.createElement el p []
where
el = R.hooksComponent "DocView" cpt
cpt p _children = do
documentIdsDeleted <- R.useState' (mempty :: DocumentIdsDeleted)
localCategories <- R.useState' (mempty :: LocalCategories)
query <- R.useState' ("" :: Query)
tableParams <- R.useState' T.initialParams
pure $ layoutDocview documentIdsDeleted localCategories query tableParams p
pure $ layoutDocview query tableParams p
-- | Main layout of the Documents Tab of a Corpus
layoutDocview :: R.State DocumentIdsDeleted -> R.State LocalCategories -> R.State Query -> R.State T.Params -> Props -> R.Element
layoutDocview documentIdsDeleted@(_ /\ setDocumentIdsDeleted) localCategories (query /\ setQuery) tableParams@(params /\ _) p = R.createElement el p []
layoutDocview :: R.State Query -> R.State T.Params -> Props -> R.Element
layoutDocview query tableParams@(params /\ _) p = R.createElement el p []
where
el = R.hooksComponent "LayoutDocView" cpt
cpt {nodeId, tabType, listId, corpusId, totalRecords, chart} _children = do
cpt {nodeId, tabType, listId, corpusId, totalRecords, chart, showSearch} _children = do
pure $ H.div {className: "container1"}
[ H.div {className: "row"}
[ chart
, H.div {}
[ H.input { type: "text"
, onChange: onChangeQuery
, placeholder: query}
]
, if showSearch then searchBar query else H.div {} []
, H.div {className: "col-md-12"}
[ pageLoader localCategories tableParams {nodeId, totalRecords, tabType, listId, corpusId, query}
]
[ pageLoader tableParams {nodeId, totalRecords, tabType, listId, corpusId, query: fst query} ]
, H.div {className: "col-md-1 col-md-offset-11"}
[ H.button { className: "btn"
, style: {backgroundColor: "peru", color : "white", border : "white"}
......@@ -197,12 +166,52 @@ layoutDocview documentIdsDeleted@(_ /\ setDocumentIdsDeleted) localCategories (q
]
]
]
onChangeQuery = mkEffectFn1 $ \e -> do
setQuery $ const $ unsafeEventValue e
onClickTrashAll nodeId = mkEffectFn1 $ \_ -> do
launchAff $ deleteAllDocuments nodeId
-- TODO
-- setDocumentIdsDeleted $ \dids -> Set.union dids (Set.fromFoldable ids)
searchBar :: R.State Query -> R.Element
searchBar (query /\ setQuery) = R.createElement el {} []
where
el = R.hooksComponent "SearchBar" cpt
cpt {} _children = do
queryText <- R.useState' query
pure $ H.div {className: "row"}
[ H.div {className: "col col-md-3 form-group"}
[ H.input { type: "text"
, className: "form-control"
, on: {change: onSearchChange queryText, keyUp: onSearchKeyup queryText}
, placeholder: query
, defaultValue: query}
]
, H.div {className: "col col-md-1"}
[ searchButton queryText
, if query /= "" then clearButton else H.div {} []
]
]
onSearchChange :: forall e. R.State Query -> e -> Effect Unit
onSearchChange (_ /\ setQueryText) = \e ->
setQueryText $ const $ R2.unsafeEventValue e
onSearchKeyup :: R.State Query -> DE.KeyboardEvent -> Effect Unit
onSearchKeyup (queryText /\ _) = \e ->
if DE.key e == "Enter" then
setQuery $ const queryText
else
pure $ unit
searchButton (queryText /\ _) =
H.button { type: "submit"
, className: "btn btn-default"
, on: {click: \e -> setQuery $ const queryText}}
[ H.span {className: "glyphicon glyphicon-search"} [] ]
clearButton =
H.button { className: "btn btn-danger"
, on: {click: \e -> setQuery $ const ""}}
[ H.span {className: "glyphicon glyphicon-remove"} [] ]
mock :: Boolean
mock = false
......@@ -250,8 +259,8 @@ loadPage {nodeId, tabType, query, listId, corpusId, params: {limit, offset, orde
convOrderBy _ = DateAsc -- TODO
renderPage :: R.State LocalCategories -> R.State T.Params -> PageLoaderProps -> Array DocumentsView -> R.Element
renderPage (localCategories /\ setLocalCategories) (_ /\ setTableParams) p res = R.createElement el p []
renderPage :: R.State T.Params -> PageLoaderProps -> Array DocumentsView -> R.Element
renderPage (_ /\ setTableParams) p res = R.createElement el p []
where
el = R.hooksComponent "RenderPage" cpt
......@@ -259,13 +268,14 @@ renderPage (localCategories /\ setLocalCategories) (_ /\ setTableParams) p res =
gi _ = "glyphicon glyphicon-star-empty"
trashStyle Trash = {textDecoration: "line-through"}
trashStyle _ = {textDecoration: "none"}
getCategory {_id, category} = maybe category identity (localCategories ^. at _id)
corpusDocument (Just corpusId) = Router.CorpusDocument corpusId
corpusDocument _ = Router.Document
cpt {nodeId, corpusId, listId} _children = do
cpt {nodeId, corpusId, listId, totalRecords} _children = do
localCategories <- R.useState' (mempty :: LocalCategories)
pure $ R2.buff $ T.tableElt
{ rows
{ rows: rows localCategories
-- , setParams: \params -> liftEffect $ loaderDispatch (Loader.SetPath {nodeId, tabType, listId, corpusId, params, query})
, setParams: \params -> setTableParams $ const params
, container: T.defaultContainer { title: "Documents" }
......@@ -277,23 +287,23 @@ renderPage (localCategories /\ setLocalCategories) (_ /\ setTableParams) p res =
, "Title"
, "Source"
]
-- , totalRecords
, totalRecords: 1000 -- TODO
, totalRecords
}
where
rows = (\(DocumentsView r) ->
let cat = getCategory r
getCategory (localCategories /\ _) {_id, category} = maybe category identity (localCategories ^. at _id)
rows localCategories = (\(DocumentsView r) ->
let cat = getCategory localCategories r
isDel = Trash == cat in
{ row: map R2.scuff $ [
H.div {}
[ H.a { className: gi cat
, style: trashStyle cat
, onClick: onClick Favorite r._id cat
, on: {click: onClick localCategories Favorite r._id cat}
} []
]
, H.input { type: "checkbox"
, checked: isDel
, onClick: onClick Trash r._id cat
, on: {click: onClick localCategories Trash r._id cat}
}
-- TODO show date: Year-Month-Day only
, H.div { style: trashStyle cat } [ H.text (show r.date) ]
......@@ -305,18 +315,18 @@ renderPage (localCategories /\ setLocalCategories) (_ /\ setTableParams) p res =
]
, delete: true
}) <$> res
onClick catType nid cat = mkEffectFn1 $ \_-> do
onClick (_ /\ setLocalCategories) catType nid cat = \_-> do
let newCat = if (catType == Favorite) then (favCategory cat) else (trashCategory cat)
setLocalCategories $ insert nid newCat
void $ launchAff $ putCategories nodeId $ CategoryQuery {nodeIds: [nid], category: newCat}
pageLoader :: R.State LocalCategories -> R.State T.Params -> PageLoaderProps -> R.Element
pageLoader localCategories tableParams@(pageParams /\ _) p = R.createElement el p []
pageLoader :: R.State T.Params -> PageLoaderProps -> R.Element
pageLoader tableParams@(pageParams /\ _) p = R.createElement el p []
where
el = R.hooksComponent "PageLoader" cpt
cpt p@{nodeId, listId, corpusId, tabType, query} _children = do
useLoader {nodeId, listId, corpusId, tabType, query, params: pageParams} loadPage $ \{loaded} ->
renderPage localCategories tableParams p loaded
renderPage tableParams p loaded
---------------------------------------------------------
sampleData' :: DocumentsView
......@@ -360,24 +370,6 @@ searchResults :: SearchQuery -> Aff Int
searchResults squery = post "http://localhost:8008/count" unit
-- TODO
newtype CategoryQuery = CategoryQuery {
nodeIds :: Array Int
, category :: Category
}
instance encodeJsonCategoryQuery :: EncodeJson CategoryQuery where
encodeJson (CategoryQuery post) =
"ntc_nodesId" := post.nodeIds
~> "ntc_category" := encodeJson post.category
~> jsonEmptyObject
categoryUrl :: Int -> String
categoryUrl nodeId = toUrl endConfigStateful Back Node (Just nodeId) <> "/category"
putCategories :: Int -> CategoryQuery -> Aff (Array Int)
putCategories nodeId = put $ categoryUrl nodeId
documentsUrl :: Int -> String
documentsUrl nodeId = toUrl endConfigStateful Back Node (Just nodeId) <> "/documents"
......@@ -389,6 +381,3 @@ toggleSet :: forall a. Ord a => a -> Set a -> Set a
toggleSet a s
| Set.member a s = Set.delete a s
| otherwise = Set.insert a s
unsafeEventValue :: forall event. event -> String
unsafeEventValue e = (unsafeCoerce e).target.value
......@@ -26,10 +26,12 @@ import React as React
import React (ReactClass, ReactElement, Children)
------------------------------------------------------------------------
import Gargantext.Prelude
import Gargantext.Config (End(..), NodeType(..), OrderBy(..), Path(..), TabType, toUrl, endConfigStateful)
import Gargantext.Config (End(..), NodeType(..), OrderBy(..), Path(..), TabType, toUrl, toLink, endConfigStateful)
import Gargantext.Config.REST (put, post, deleteWithBody)
import Gargantext.Components.Loader as Loader
import Gargantext.Components.Search.Types (Category(..), CategoryQuery(..), favCategory, trashCategory, decodeCategory, putCategories)
import Gargantext.Components.Table as T
import Gargantext.Router as Router
import Gargantext.Utils (toggleSet)
import Gargantext.Utils.DecodeMaybe ((.|))
import React.DOM (a, br', button, div, i, input, p, text, span)
......@@ -83,9 +85,9 @@ initialState =
}
data Action
= MarkFavorites (Array Int)
= MarkCategory Category (Array Int)
| ToggleDocumentToDelete Int
| Trash
| TrashDocuments
newtype Pair = Pair
{ id :: Int
......@@ -106,9 +108,9 @@ newtype DocumentsView
, score :: Int
, pairs :: Array Pair
, delete :: Boolean
, category :: Category
}
derive instance genericDocumentsView :: Generic DocumentsView _
instance showDocumentsView :: Show DocumentsView where
......@@ -118,7 +120,7 @@ newtype Response = Response
{ id :: Int
, created :: String
, hyperdata :: Hyperdata
, favorite :: Boolean
, category :: Category
, ngramCount :: Int
-- , date :: String
-- , score :: Int
......@@ -174,7 +176,7 @@ instance decodeResponse :: DecodeJson Response where
hyperdata <- obj .? "hyperdata"
favorite <- obj .? "favorite"
ngramCount <- obj .? "ngramCount"
pure $ Response { id, created, hyperdata, favorite, ngramCount }
pure $ Response { id, created, hyperdata, category: decodeCategory favorite, ngramCount }
-- | Filter
-- TODO: unused
......@@ -194,12 +196,12 @@ layoutDocview :: Spec State Props Action
layoutDocview = simpleSpec performAction render
where
performAction :: PerformAction State Props Action
performAction (MarkFavorites nids) {nodeId} _ =
void $ lift $ putFavorites nodeId (FavoriteQuery {favorites: nids})
performAction (MarkCategory category nids) {nodeId} _ =
void $ lift $ putCategories nodeId $ CategoryQuery {nodeIds: nids, category: favCategory category}
--TODO add array of delete rows here
performAction (ToggleDocumentToDelete nid) _ _ =
modifyState_ \state -> state {documentIdsToDelete = toggleSet nid state.documentIdsToDelete}
performAction Trash {nodeId} {documentIdsToDelete} = do
performAction TrashDocuments {nodeId} {documentIdsToDelete} = do
void $ lift $ deleteDocuments nodeId (DeleteDocumentQuery {documents: Set.toUnfoldable documentIdsToDelete})
modifyState_ \{documentIdsToDelete, documentIdsDeleted} ->
{ documentIdsToDelete: mempty
......@@ -229,7 +231,7 @@ layoutDocview = simpleSpec performAction render
]
, div [className "col-md-12"]
[ button [ style {backgroundColor: "peru", padding : "9px", color : "white", border : "white", float: "right"}
, onClick $ (\_ -> dispatch Trash)
, onClick $ (\_ -> dispatch TrashDocuments)
]
[ i [className "glyphitem glyphicon glyphicon-trash", style {marginRight : "9px"}] []
, text "Trash it !"
......@@ -245,12 +247,12 @@ layoutDocviewGraph :: Spec State Props Action
layoutDocviewGraph = simpleSpec performAction render
where
performAction :: PerformAction State Props Action
performAction (MarkFavorites nids) {nodeId} _ =
void $ lift $ putFavorites nodeId (FavoriteQuery {favorites: nids})
performAction (MarkCategory category nids) {nodeId} _ =
void $ lift $ putCategories nodeId $ CategoryQuery {nodeIds: nids, category: favCategory category}
--TODO add array of delete rows here
performAction (ToggleDocumentToDelete nid) _ _ =
modifyState_ \state -> state {documentIdsToDelete = toggleSet nid state.documentIdsToDelete}
performAction Trash {nodeId} {documentIdsToDelete} = do
performAction TrashDocuments {nodeId} {documentIdsToDelete} = do
void $ lift $ deleteDocuments nodeId (DeleteDocumentQuery {documents: Set.toUnfoldable documentIdsToDelete})
modifyState_ \{documentIdsToDelete, documentIdsDeleted} ->
{ documentIdsToDelete: mempty
......@@ -275,7 +277,7 @@ layoutDocviewGraph = simpleSpec performAction render
, container
}
, button [ style {backgroundColor: "peru", padding : "9px", color : "white", border : "white", float: "right"}
, onClick $ (\_ -> dispatch Trash)
, onClick $ (\_ -> dispatch TrashDocuments)
]
[ i [className "glyphitem glyphicon glyphicon-trash", style {marginRight : "9px"}] []
, text "Trash it !"
......@@ -303,7 +305,7 @@ loadPage {nodeId, listId, query, params: {limit, offset, orderBy}} = do
res2corpus :: Response -> DocumentsView
res2corpus (Response { id, created: date, ngramCount: score
, hyperdata: Hyperdata {title, source}
-- favorite TODO
, category
}) =
DocumentsView
{ id
......@@ -313,6 +315,7 @@ loadPage {nodeId, listId, query, params: {limit, offset, orderBy}} = do
, score
, pairs: []
, delete: false
, category
}
convOrderBy (T.ASC (T.ColumnName "Date")) = DateAsc
convOrderBy (T.DESC (T.ColumnName "Date")) = DateDesc
......@@ -363,7 +366,7 @@ renderPage loaderDispatch { totalRecords, dispatch, container
]
where
-- TODO: how to interprete other scores?
gi 0 = "glyphicon glyphicon-star-empty"
gi Favorite = "glyphicon glyphicon-star-empty"
gi _ = "glyphicon glyphicon-star"
isChecked id = Set.member id documentIdsToDelete
isDeleted (DocumentsView {id}) = Set.member id documentIdsDeleted
......@@ -371,7 +374,7 @@ renderPage loaderDispatch { totalRecords, dispatch, container
| id > 1 = [a [href (toUrl endConfigStateful Front NodeContact (Just id)), target "blank"] [text label]]
| otherwise = [text label]
comma = span [] [text ", "]
rows = (\(DocumentsView {id,score,title,source,date,pairs,delete}) ->
rows = (\(DocumentsView {id,score,title,source,date,pairs,delete,category}) ->
let
strikeIfDeleted
| delete = [style {textDecoration : "line-through"}]
......@@ -379,13 +382,13 @@ renderPage loaderDispatch { totalRecords, dispatch, container
in
{ row:
[ div []
[ a [ className $ gi score
, onClick $ const $ dispatch $ MarkFavorites [id]
[ a [ className $ gi category
, onClick $ const $ dispatch $ MarkCategory category [id]
] []
]
-- TODO show date: Year-Month-Day only
, div strikeIfDeleted [text date]
, a (strikeIfDeleted <> [ href (toUrl endConfigStateful Front (ListDocument (Just listId)) (Just id))
, a (strikeIfDeleted <> [ href $ toLink $ endConfigStateful Router.Document listId id
, target "blank"])
[ text title ]
, div strikeIfDeleted [text source]
......@@ -405,15 +408,6 @@ pageLoader props = React.createElement pageLoaderClass props []
---------------------------------------------------------
newtype FavoriteQuery = FavoriteQuery
{ favorites :: Array Int
}
instance encodeJsonFQuery :: EncodeJson FavoriteQuery where
encodeJson (FavoriteQuery post)
= "favorites" := post.favorites
~> jsonEmptyObject
newtype DeleteDocumentQuery = DeleteDocumentQuery
{
documents :: Array Int
......@@ -425,11 +419,5 @@ instance encodeJsonDDQuery :: EncodeJson DeleteDocumentQuery where
= "documents" := post.documents
~> jsonEmptyObject
putFavorites :: Int -> FavoriteQuery -> Aff (Array Int)
putFavorites nodeId = put (toUrl endConfigStateful Back Node (Just nodeId) <> "/favorites")
deleteFavorites :: Int -> FavoriteQuery -> Aff (Array Int)
deleteFavorites nodeId = deleteWithBody (toUrl endConfigStateful Back Node (Just nodeId) <> "/favorites")
deleteDocuments :: Int -> DeleteDocumentQuery -> Aff (Array Int)
deleteDocuments nodeId = deleteWithBody (toUrl endConfigStateful Back Node (Just nodeId) <> "/documents")
......@@ -2,16 +2,17 @@ module Gargantext.Components.Login where
import Control.Monad.Cont.Trans (lift)
import Data.Int as Int
import Data.Lens (over, view)
import Data.Lens (over)
import Data.Maybe (Maybe(..))
import Data.Traversable (traverse_)
import Data.Tuple.Nested((/\))
import Effect.Class (liftEffect)
import Effect (Effect)
import Effect.Aff (Aff)
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 Reactix as R
import Reactix.DOM.HTML as H
import React.DOM (button, div, h5, span, text)
import React.DOM.Props (_data, _id, _type, aria, className, role)
import Thermite (PerformAction, Render, Spec, _render, modifyState_, simpleSpec)
import Unsafe.Coerce (unsafeCoerce)
import Web.HTML (window)
import Web.HTML.Window (localStorage)
import Web.Storage.Storage (getItem, setItem, removeItem)
......@@ -22,6 +23,7 @@ import Gargantext.Config (toUrl, endConfigStateful, Path(..), End(..))
import Gargantext.Config.REST (post)
import Gargantext.Components.Modals.Modal (modalHide)
import Gargantext.Components.Login.Types
import Gargantext.Utils.Reactix as R2
-- TODO: ask for login (modal) or account creation after 15 mn when user
-- is not logged and has made one search at least
......@@ -46,8 +48,7 @@ initialState = do
data Action
= PostAuth
| SetUserName String
| SetPassword String
| SetCredentials String String
modalSpec :: forall props. Boolean -> String -> Spec State props Action -> Spec State props Action
......@@ -80,115 +81,145 @@ modalSpec sm t = over _render \render d p s c ->
spec' :: Spec State {} Action
spec' = modalSpec true "Login" renderSpec
performAction :: PerformAction State {} Action
performAction (SetCredentials usr pwd) _ _ = do
modifyState_ $ _ { username = usr, password = pwd }
performAction PostAuth _ {username, password} = do
res <- lift $ postAuthRequest $ AuthRequest {username, password}
case res of
AuthResponse {inval: Just (AuthInvalid {message})} ->
modifyState_ $ _ { errorMessage = message }
AuthResponse {valid} -> do
liftEffect $ setAuthData valid
modifyState_ $ _ {authData = valid, errorMessage = ""}
liftEffect $ modalHide "loginModal"
renderSpec :: Spec State {} Action
renderSpec = simpleSpec performAction render
where
performAction :: PerformAction State {} Action
render :: Render State {} Action
render dispatch _ state _ =
[R2.scuff $ renderCpt dispatch state]
performAction (SetUserName usr) _ _ =
modifyState_ $ _ { username = usr }
performAction (SetPassword pwd) _ _ =
modifyState_ $ _ { password = pwd }
renderCpt :: (Action -> Effect Unit) -> State -> R.Element
renderCpt d s = R.createElement el {} []
where
el = R.hooksComponent "RenderComponent" cpt
cpt {} _children = do
(state /\ setState) <- R.useState' s
performAction PostAuth _ {username, password} = do
res <- lift $ postAuthRequest $ AuthRequest {username, password}
case res of
AuthResponse {inval: Just (AuthInvalid {message})} ->
modifyState_ $ _ { errorMessage = message }
AuthResponse {valid} -> do
liftEffect $ setAuthData valid
modifyState_ $ _ {authData = valid, errorMessage = ""}
liftEffect $ modalHide "loginModal"
R.useEffect $
if (state /= s) then do
_ <- d $ SetCredentials state.username state.password
pure $ d $ PostAuth
else
pure $ pure $ unit
render :: Render State {} Action
render dispatch _ state _ =
[ div [className "row"]
[ div [className "col-md-10 col-md-push-1"]
[ h2 [className "text-primary center m-a-2"]
[ i [className "material-icons md-36"] [text "control_point"]
, span [className "icon-text"] [text "Gargantext"]
]
, div [className "card-group"]
[ div [className "card"]
[ div [className "card-block"]
[ div [className "center"]
[ h4 [className "m-b-0"]
[ span [className "icon-text"] [ text "Welcome :)"] ]
, p [className "text-muted"]
[ text $ "Login to your account or",
a [ target "blank",href "https://iscpif.fr/services/applyforourservices/"] [text " ask to get an access"]
]
pure $ renderLogin (state /\ setState)
renderLogin :: R.State State -> R.Element
renderLogin (state /\ setState) = R.createElement el {} []
where
el = R.hooksComponent "RenderLogin" cpt
cpt {} _children = do
username <- R.useState' state.username
password <- R.useState' state.password
pure $ H.div {className: "row"}
[ gargLogo
, H.div {className: "card-group"}
[ H.div {className: "card"}
[ H.div {className: "card-block"}
[ H.div {className: "center"}
[ H.h4 {className: "m-b-0"}
[ H.span {className: "icon-text"}
[ H.text "Welcome :)"]
]
, div []
[ input [_type "hidden",
name "csrfmiddlewaretoken",
-- TODO hard-coded CSRF token
value "Wy52D2nor8kC1r1Y4GrsrSIxQ2eqW8UwkdiQQshMoRwobzU4uldknRUhP0j4WcEM" ]
, div [className "form-group"]
[ p [] [text state.errorMessage]
, input [className "form-control", _id "id_username",maxLength "254", name "username", placeholder "username", _type "text",value state.username, onInput \e -> dispatch (SetUserName (unsafeEventValue e))]
]
, div [className "form-group"]
[ input [className "form-control", _id "id_password", name "password", placeholder "password", _type "password",value state.password,onInput \e -> dispatch (SetPassword (unsafeEventValue e))]
, div [className "clearfix"] []
]
, div [className "center"]
[ label []
[ div [className "checkbox"]
[ input [_id "terms-accept", _type "checkbox", value "", className "checkbox"]
, text "I accept the terms of uses ",
a [href "http://gitlab.iscpif.fr/humanities/tofu/tree/master"] [text " [ Read the terms of use ] "]
]
, button [_id "login-button",className "btn btn-primary btn-rounded", _type "submit", onClick \_ -> dispatch $ PostAuth] [text "Login"]
, H.p {className: "text-muted"}
[ H.text $ "Login to your account or",
H.a { target: "blank"
, href: "https://iscpif.fr/services/applyforourservices/"
}
[H.text " ask to get an access"]
]
]
, H.div {}
[ H.input { type: "hidden"
, name: "csrfmiddlewaretoken"
-- TODO hard-coded CSRF token
, value: "Wy52D2nor8kC1r1Y4GrsrSIxQ2eqW8UwkdiQQshMoRwobzU4uldknRUhP0j4WcEM"
}
, H.div {className: "form-group"}
[ H.p {} [H.text state.errorMessage]
, usernameInput username
]
, H.div {className: "form-group"}
[ passwordInput password
, H.div {className: "clearfix"} []
]
, H.div {className: "center"}
[ H.label {}
[ H.div {className: "checkbox"}
[ H.input { id: "terms-accept"
, type: "checkbox"
, value: ""
, className: "checkbox"
}
, H.text "I accept the terms of uses "
, H.a {href: "http://gitlab.iscpif.fr/humanities/tofu/tree/master"}
[ H.text " [ Read the terms of use ] "]
]
]
, H.button { id: "login-button"
, className: "btn btn-primary btn-rounded"
, type: "submit"
-- TODO
--, on: {click: \_ -> dispatch $ PostAuth}
, on: {click: onClick username password}
}
[H.text "Login"]
]
]
]
]
]
]
gargLogo =
H.div {className: "col-md-10 col-md-push-1"}
[ H.h2 {className: "text-primary center m-a-2"}
[ H.i {className: "material-icons md-36"}
[H.text "control_point"]
, H.span {className: "icon-text"}
[H.text "Gargantext"]
]
]
usernameInput (username /\ setUsername) =
H.input { className: "form-control"
, id: "id_username"
, maxLength: "254"
, name: "username"
, placeholder: "username"
, type: "text"
, defaultValue: username
--, on: {input: \e -> dispatch (SetUserName $ R2.unsafeEventValue e)}
, on: {change: \e -> setUsername $ const $ R2.unsafeEventValue e}
}
passwordInput (password /\ setPassword) =
H.input { className: "form-control"
, id: "id_password"
, name: "password"
, placeholder: "password"
, type: "password"
, defaultValue: password
--, on: {input: \e -> dispatch (SetPassword $ R2.unsafeEventValue e)}
, on: {change: \e -> setPassword $ const $ R2.unsafeEventValue e}
}
onClick (username /\ _) (password /\ _) = \e -> do
setState $ \st -> st {username = username, password = password}
-- div [ className "modal fade myModal"
-- , role "dialog"
-- , _data {show : true}
-- ][ div [ className "modal-dialog"
-- , role "document"
-- ] [ div [ className "modal-content"]
-- [ div [ className "modal-header"]
-- [ h5 [ className "modal-title"
-- ]
-- [ text "CorpusView"
-- ]
-- , button [ _type "button"
-- , className "close"
-- , _data { dismiss : "modal"}
-- ] [ span [ aria {hidden : true}]
-- [ text "X"]
-- ]
-- ]
-- , div [ className "modal-body"]
-- [ ul [ className "list-group"] ( map fn1 state.authData ) ]
-- , div [className "modal-footer"]
-- [ button [ _type "button"
-- , className "btn btn-secondary"
-- , _data {dismiss : "modal"}
-- ] [ text "GO"]
-- ]
-- ]
-- ]
-- ]
-- ]
unsafeEventValue :: forall event. event -> String
unsafeEventValue e = (unsafeCoerce e).target.value
getAuthData :: Effect (Maybe AuthData)
getAuthData = do
......
module Gargantext.Components.Login.Types where
import Prelude
import Data.Lens (Iso', iso)
import Data.Argonaut ( class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject
, (.?), (.??), (:=), (~>)
)
, (.?), (.??), (:=), (~>)
)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Lens (Iso', iso)
import Data.Maybe (Maybe)
type Username = String
......@@ -30,6 +32,12 @@ newtype AuthData = AuthData
, tree_id :: TreeId
}
derive instance genericAuthData :: Generic AuthData _
instance eqAuthData :: Eq AuthData where
eq = genericEq
_AuthData :: Iso' AuthData { token :: Token, tree_id :: TreeId }
_AuthData = iso (\(AuthData v) -> v) AuthData
......
......@@ -40,6 +40,7 @@ import Gargantext.Components.Table as T
import Gargantext.Prelude
import Gargantext.Components.Loader as Loader
import Gargantext.Components.NgramsTable.Core
import Gargantext.Utils.Reactix as R2
type State =
CoreState
......@@ -119,7 +120,7 @@ tableContainer { pageParams
, name "search", placeholder "Search"
, _type "value"
, value pageParams.searchQuery
, onInput \e -> setSearchQuery (unsafeEventValue e)
, onInput \e -> setSearchQuery (R2.unsafeEventValue e)
]
, div [] (
if A.null props.tableBody && pageParams.searchQuery /= "" then [
......@@ -134,7 +135,7 @@ tableContainer { pageParams
[ select [ _id "picklistmenu"
, className "form-control custom-select"
, value (maybe "" show pageParams.termListFilter)
, onChange (\e -> setTermListFilter $ readTermList $ unsafeEventValue e)
, onChange (\e -> setTermListFilter $ readTermList $ R2.unsafeEventValue e)
] $ map optps1 termLists
]
]
......@@ -143,7 +144,7 @@ tableContainer { pageParams
[ select [ _id "picktermtype"
, className "form-control custom-select"
, value (maybe "" show pageParams.termSizeFilter)
, onChange (\e -> setTermSizeFilter $ readTermSize $ unsafeEventValue e)
, onChange (\e -> setTermSizeFilter $ readTermSize $ R2.unsafeEventValue e)
] $ map optps1 termSizes
]
]
......@@ -420,6 +421,3 @@ optps1 :: forall a. Show a => { desc :: String, mval :: Maybe a } -> ReactElemen
optps1 { desc, mval } = option [value val] [text desc]
where
val = maybe "" show mval
unsafeEventValue :: forall event. event -> String
unsafeEventValue e = (unsafeCoerce e).target.value
......@@ -2,8 +2,11 @@ module Gargantext.Components.Search.Types where
import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>), encodeJson)
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Array (head)
import Data.Generic.Rep (class Generic)
import Data.Generic.Rep.Eq (genericEq)
import Data.Generic.Rep.Show (genericShow)
import Data.Maybe (Maybe(..), fromMaybe, maybe)
import Data.Newtype (class Newtype)
import Data.Tuple (Tuple)
import Data.Tuple.Nested ((/\))
......@@ -14,9 +17,9 @@ import Thermite (PerformAction, modifyState)
import Gargantext.Prelude
import Gargantext.Types (class ToQuery)
import Gargantext.Config.REST (post)
import Gargantext.Config (End(..), NodeType(..), Path(..), toUrl)
import Gargantext.Config.REST (post, put)
import Gargantext.Components.Modals.Modal (modalHide)
import Gargantext.Pages.Layout.Specs.AddCorpus.States (Response, State)
import Gargantext.Utils (id)
import URI.Extra.QueryPairs as QP
......@@ -96,3 +99,51 @@ instance encodeJsonSearchQuery :: EncodeJson SearchQuery where
~> "corpus_id" := fromMaybe 0 corpus_id
~> "files_id" := files_id
~> jsonEmptyObject
data Category = Trash | Normal | Favorite
derive instance genericFavorite :: Generic Category _
instance showCategory :: Show Category where
show = genericShow
instance eqCategory :: Eq Category where
eq = genericEq
instance encodeJsonCategory :: EncodeJson Category where
encodeJson Trash = encodeJson 0
encodeJson Normal = encodeJson 1
encodeJson Favorite = encodeJson 2
favCategory :: Category -> Category
favCategory Normal = Favorite
favCategory Trash = Favorite
favCategory Favorite = Normal
trashCategory :: Category -> Category
trashCategory Normal = Trash
trashCategory Trash = Normal
trashCategory Favorite = Trash
decodeCategory :: Int -> Category
decodeCategory 0 = Trash
decodeCategory 1 = Normal
decodeCategory 2 = Favorite
decodeCategory _ = Normal
newtype CategoryQuery = CategoryQuery {
nodeIds :: Array Int
, category :: Category
}
instance encodeJsonCategoryQuery :: EncodeJson CategoryQuery where
encodeJson (CategoryQuery post) =
"ntc_nodesId" := post.nodeIds
~> "ntc_category" := encodeJson post.category
~> jsonEmptyObject
categoryUrl :: Int -> String
categoryUrl nodeId = toUrl Back Node (Just nodeId) <> "/category"
putCategories :: Int -> CategoryQuery -> Aff (Array Int)
putCategories nodeId = put $ categoryUrl nodeId
......@@ -14,6 +14,7 @@ import Thermite (PerformAction, Render, Spec, modifyState_, simpleSpec, StateCoT
import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2
type TableContainerProps =
{ pageSizeControl :: ReactElement
......@@ -218,7 +219,7 @@ sizeDD :: PageSizes -> (Action -> Effect Unit) -> ReactElement
sizeDD ps d
= span []
[ select [ className "form-control"
, onChange (\e -> d (ChangePageSize $ string2PageSize $ (unsafeCoerce e).target.value))
, onChange (\e -> d (ChangePageSize $ string2PageSize $ R2.unsafeEventValue e))
] $ map (optps ps) aryPS
]
......
......@@ -699,6 +699,3 @@ uploadFile id fileType (UploadFileContents fileContents) = postWwwUrlencoded url
fnTransform :: LNode -> FTree
fnTransform n = NTree n []
unsafeEventValue :: forall event. event -> String
unsafeEventValue e = (unsafeCoerce e).target.value
......@@ -146,7 +146,7 @@ showTabType' (TabPairing t) = show t
data TabPostQuery = TabPostQuery {
offset :: Int
, limit :: Int
, orderBy :: Maybe OrderBy
, orderBy :: OrderBy
, tabType :: TabType
, query :: String
}
......@@ -225,10 +225,8 @@ pathUrl c (Chart {chartType, tabType}) i =
routesPath :: R.Routes -> String
routesPath R.Home = ""
routesPath R.Login = "login"
routesPath R.SearchView = "search"
routesPath (R.Folder i) = "folder/" <> show i
routesPath (R.Corpus i) = "corpus/" <> show i
routesPath R.AddCorpus = "addCorpus"
routesPath (R.CorpusDocument c l i) = "corpus/" <> show c <> "/list/" <> show l <> "/document/" <> show i
routesPath (R.Document l i) = "list/" <> show l <> "/document/" <> show i
routesPath (R.PGraphExplorer i) = "#/"
......
......@@ -78,7 +78,9 @@ statefulTabs =
, tabType: TabPairing TabDocs
, totalRecords: 4736
, listId: defaultListId
, corpusId: Nothing}
, corpusId: Nothing
, showSearch: true
}
ngramsViewSpec :: {mode :: Mode} -> Spec Tab.State Props Tab.Action
ngramsViewSpec {mode} =
......
......@@ -419,8 +419,9 @@ specOld = fold [treespec treeSpec, graphspec $ simpleSpec performAction render']
Nothing ->
simpleSpec defaultPerformAction defaultRender
Just treeId ->
--cmapProps (const {root: treeId, mCurrentRoute: Nothing}) $ noState $ Tree.treeview
-- TODO
simpleSpec defaultPerformAction defaultRender
--cmapProps (const {root: treeId, mCurrentRoute: Nothing}) (noState $ Tree.treeview Config.endConfigStateful)
render' :: Render State {} Action
......
......@@ -4,7 +4,6 @@ import Prelude hiding (div)
import Data.Lens (view)
import Data.List (fromFoldable)
import Data.Tuple (Tuple(..))
import Gargantext.Config (TabType(..), TabSubType(..))
import Gargantext.Components.GraphExplorer.Types (GraphSideCorpus(..))
import Gargantext.Components.FacetsTable (TextQuery, docViewSpec)
import Gargantext.Components.Table as T
......
......@@ -10,14 +10,15 @@ import Gargantext.Components.Lang.Landing.EnUS as En
import Gargantext.Components.Lang.Landing.FrFR as Fr
import Gargantext.Components.Data.Landing (BlockText(..), BlockTexts(..), Button(..), LandingData(..))
import Gargantext.Components.Data.Lang (Lang(..))
import Gargantext.Pages.Home.States (State, initialState)
import Gargantext.Pages.Home.Actions (Action, performAction)
import Reactix as R
import Reactix.DOM.HTML as H
import React (ReactElement)
import React.DOM (a, div, h3, i, img, p, span, text)
import React.DOM.Props (Props, _id, aria, className, href, src, target, title, height, width)
import Thermite (Render, Spec, simpleSpec, hideState, focusState)
import React.DOM.Props (Props)
import Thermite (Spec, hideState, focusState, Render, simpleSpec)
import Gargantext.Utils.Reactix as R2
-- Layout |
......@@ -26,80 +27,82 @@ landingData FR = Fr.landingData
landingData EN = En.landingData
layoutLanding :: Lang -> Spec {} {} Void
layoutLanding = hideState (const $ unwrap initialState)
<<< focusState (re _Newtype)
<<< layoutLanding' <<< landingData
layoutLanding = layoutLanding' <<< landingData
------------------------------------------------------------------------
layoutLanding' :: LandingData -> Spec State {} Action
layoutLanding' hd = simpleSpec performAction render
layoutLanding' :: LandingData -> Spec {} {} Void
layoutLanding' hd = R2.elSpec $ R.hooksComponent "LayoutLanding" cpt
where
render :: Render State {} Action
render dispatch _ state _ =
[ div [ className "container1" ] [ jumboTitle hd false ]
, div [ className "container1" ] [] -- TODO put research form
, div [ className "container1" ] [ blocksRandomText' hd ]
]
cpt {} _children = do
pure $ H.span {} [
H.div { className: "container1" }
[ jumboTitle hd false ]
, H.div { className: "container1" } [] -- TODO put research form
, H.div { className: "container1" } [ blocksRandomText' hd ]
]
------------------------------------------------------------------------
blocksRandomText' :: LandingData -> ReactElement
blocksRandomText' :: LandingData -> R.Element
blocksRandomText' (LandingData hd) = blocksRandomText hd.blockTexts
blocksRandomText :: BlockTexts -> ReactElement
blocksRandomText :: BlockTexts -> R.Element
blocksRandomText (BlockTexts bt) =
div [ className "row" ] ( map showBlock bt.blocks )
H.div { className: "row" } ( map showBlock bt.blocks )
where
showBlock :: BlockText -> ReactElement
showBlock :: BlockText -> R.Element
showBlock (BlockText b) =
div [ className "col-md-4 content" ]
[ h3 [] [ a [ href b.href, title b.title]
[ i [className b.icon] []
, text (" " <> b.titleText)
]
]
, p [] [ text b.text ]
, p [] [ docButton b.docButton ]
]
docButton :: Button -> ReactElement
docButton (Button b) = a [ className "btn btn-outline-primary btn-sm spacing-class"
, href b.href
, target "blank"
, title b.title
] [ span [ aria {hidden : true}
, className "glyphicon glyphicon-hand-right"
] []
, text b.text
]
jumboTitle :: LandingData -> Boolean -> ReactElement
jumboTitle (LandingData hd) b = div jumbo
[ div [className "row" ]
[ div [ className "col-md-12 content"]
[ div [ className "center" ]
[ div [_id "logo-designed" ]
[ img [ src "images/logo.png"
, title hd.logoTitle
]
]
]
]
]
]
where
jumbo = case b of
true -> [className "jumbotron"]
false -> []
imageEnter :: LandingData -> Props -> ReactElement
imageEnter (LandingData hd) action = div [className "row"]
[ div [className "col-md-offset-5 col-md-6 content"]
[ img [ src "images/Gargantextuel-212x300.jpg"
, _id "funnyimg"
, title hd.imageTitle
, action
]
]
]
H.div { className: "col-md-4 content" }
[ H.h3 {} [ H.a { href: b.href, title: b.title}
[ H.i {className: b.icon} []
, H.text (" " <> b.titleText)
]
]
, H.p {} [ H.text b.text ]
, H.p {} [ docButton b.docButton ]
]
docButton :: Button -> R.Element
docButton (Button b) =
H.a { className: "btn btn-outline-primary btn-sm spacing-class"
, href: b.href
, target: "blank"
, title: b.title
} [ H.span { aria: {hidden : true}
, className: "glyphicon glyphicon-hand-right"
} []
, H.text b.text
]
jumboTitle :: LandingData -> Boolean -> R.Element
jumboTitle (LandingData hd) b =
H.div {className: jumbo}
[ H.div { className: "row" }
[ H.div { className: "col-md-12 content" }
[ H.div { className: "center" }
[ H.div { id: "logo-designed" }
[ H.img { src: "images/logo.png"
, title: hd.logoTitle
}
]
]
]
]
]
where
jumbo = case b of
true -> "jumbotron"
false -> ""
imageEnter :: LandingData -> Props -> R.Element
imageEnter (LandingData hd) action =
H.div {className: "row"}
[ H.div {className: "col-md-offset-5 col-md-6 content"}
[ H.img { src: "images/Gargantextuel-212x300.jpg"
, id: "funnyimg"
, title: hd.imageTitle
, action
}
]
]
......@@ -3,14 +3,12 @@ module Gargantext.Pages.Layout where
import Prelude hiding (div)
-- import Gargantext.Components.Login as LN
import Gargantext.Pages.Layout.Actions (Action(..))
import Gargantext.Pages.Layout.Specs.AddCorpus as AC
-- import Gargantext.Pages.Corpus.Tabs as TV
import Gargantext.Pages.Corpus.Graph as GE
-- import Gargantext.Pages.Corpus.Tabs.Terms.NgramsTable as NG
-- import Gargantext.Pages.Home as L
-- import Gargantext.Pages.Layout.Specs.Search as S
import Gargantext.Router (Routes(..))
dispatchAction :: forall ignored m.
......@@ -25,17 +23,9 @@ dispatchAction dispatcher _ Login = do
dispatcher $ SetRoute Login
-- dispatcher $ LoginA TODO
dispatchAction dispatcher _ AddCorpus = do
dispatcher $ SetRoute AddCorpus
dispatcher $ AddCorpusA AC.LoadDatabaseDetails
dispatchAction dispatcher _ (Corpus n) = do
dispatcher $ SetRoute $ Corpus n
dispatchAction dispatcher _ SearchView = do
dispatcher $ SetRoute SearchView
-- dispatcher $ SearchA TODO
dispatchAction dispatcher _ (UserPage id) = do
dispatcher $ SetRoute $ UserPage id
......
......@@ -13,8 +13,6 @@ import Gargantext.Components.Login as LN
import Gargantext.Components.Modals.Modal (modalShow)
import Gargantext.Pages.Annuaire as Annuaire
import Gargantext.Pages.Corpus.Graph as GE
import Gargantext.Pages.Layout.Specs.AddCorpus as AC
import Gargantext.Pages.Layout.Specs.Search as S
import Gargantext.Pages.Layout.States (AppState)
import Gargantext.Prelude
import Gargantext.Router (Routes)
......@@ -24,8 +22,6 @@ import Gargantext.Router (Routes)
data Action
= LoginA LN.Action
| SetRoute Routes
| SearchA S.Action
| AddCorpusA AC.Action
| GraphExplorerA GE.Action
| AnnuaireAction Annuaire.Action
| ShowLogin
......@@ -61,8 +57,6 @@ performAction ShowAddCorpus _ _ = void do
---------------------------------------------------------
performAction (LoginA _) _ _ = pure unit
performAction (AddCorpusA _) _ _ = pure unit
performAction (SearchA _) _ _ = pure unit
performAction (GraphExplorerA _) _ _ = pure unit
performAction (AnnuaireAction _) _ _ = pure unit
-- liftEffect $ modalShow "addCorpus"
......@@ -76,18 +70,6 @@ _loginAction = prism LoginA \action ->
LoginA caction -> Right caction
_-> Left action
_addCorpusAction :: Prism' Action AC.Action
_addCorpusAction = prism AddCorpusA \action ->
case action of
AddCorpusA caction -> Right caction
_-> Left action
_searchAction :: Prism' Action S.Action
_searchAction = prism SearchA \action ->
case action of
SearchA caction -> Right caction
_-> Left action
_annuaireAction :: Prism' Action Annuaire.Action
_annuaireAction = prism AnnuaireAction \action ->
case action of
......
......@@ -4,10 +4,11 @@ import Data.Foldable (fold, intercalate)
import Data.Lens (over)
import Data.Maybe (Maybe(Nothing, Just))
import Effect (Effect)
import React (ReactElement)
import React.DOM (a, button, div, footer, hr', img, li, p, span, text, ul)
import React.DOM.Props (_data, _id, aria, className, href, onClick, role, src, style, tabIndex, target, title, height, width)
import Thermite (Render, Spec, _render, defaultPerformAction, defaultRender, focus, simpleSpec, withState, noState, cmapProps)
import React.DOM (button, div, text)
import React.DOM.Props (_id, className, onClick, role, style)
import Reactix as R
import Reactix.DOM.HTML as H
import Thermite (Spec, _render, defaultPerformAction, defaultRender, focus, simpleSpec, withState, noState, cmapProps)
-- import Unsafe.Coerce (unsafeCoerce)
import Gargantext.Prelude
......@@ -25,13 +26,11 @@ import Gargantext.Pages.Corpus.Graph as GE
import Gargantext.Pages.Lists as Lists
import Gargantext.Pages.Texts as Texts
import Gargantext.Pages.Home as L
import Gargantext.Pages.Layout.Actions (Action(..), _addCorpusAction, _graphExplorerAction, _loginAction, _searchAction, performAction)
import Gargantext.Pages.Layout.Specs.AddCorpus as AC
import Gargantext.Pages.Layout.Specs.Search as S
import Gargantext.Pages.Layout.Actions (Action(..), _graphExplorerAction, _loginAction, performAction)
import Gargantext.Pages.Layout.Specs.SearchBar as SB
import Gargantext.Pages.Layout.States (AppState, _graphExplorerState, _searchState, _loginState, _addCorpusState)
import Gargantext.Pages.Layout.States (AppState, _graphExplorerState, _loginState)
import Gargantext.Router (Routes(..))
import Gargantext.Utils.Reactix (scuff)
import Gargantext.Utils.Reactix as R2
-- TODO
-- rewrite layoutSpec to use state (with EndConfig)
......@@ -44,7 +43,6 @@ layoutSpec =
, container $ withState pagesComponent
, withState \st ->
fold [ focus _loginState _loginAction (LN.modalSpec st.showLogin "Login" LN.renderSpec)
, focus _addCorpusState _addCorpusAction (AC.modalSpec st.showCorpus "Search Results" AC.layoutAddcorpus)
]
]
where
......@@ -59,13 +57,11 @@ pagesComponent s = case s.currentRoute of
Nothing -> selectSpec Home -- TODO add Error page here: url requested does not exist (with funny Garg image)
where
selectSpec :: Routes -> Spec AppState {} Action
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 SearchView = layout0 $ focus _searchState _searchAction S.searchSpec
selectSpec (CorpusDocument c l i) = layout0 $ cmapProps (const {nodeId: i, listId: l, corpusId: Just c}) $ noState Annotation.layout
selectSpec (Document l i) = layout0 $ cmapProps (const {nodeId: i, listId: l, corpusId: Nothing}) $ noState Annotation.layout
selectSpec (PGraphExplorer i)= layout1 $ focus _graphExplorerState _graphExplorerAction GE.specOld
......@@ -87,7 +83,7 @@ layout0 layout =
fold
[ searchBar
, outerLayout
, layoutFooter
, noState layoutFooter
]
where
outerLayout1 = simpleSpec defaultPerformAction defaultRender
......@@ -115,8 +111,6 @@ layout0 layout =
] (render d p s c) ]
cont = over _render \render d p s c -> [ div [className "row" ] (render d p s c) ]
--as = noState Tree.treeview
bs = innerLayout $ layout
innerLayout :: Spec AppState {} Action
......@@ -136,7 +130,7 @@ layout1 layout =
[ searchBar
, layout
-- , outerLayout
, layoutFooter
, noState layoutFooter
]
where
outerLayout1 = simpleSpec defaultPerformAction defaultRender
......@@ -182,29 +176,29 @@ searchBar = simpleSpec defaultPerformAction render
] [ div [className "container-fluid"
]
[ div [ className "navbar-inner" ]
[ divLogo
[ R2.scuff divLogo
, div [ className "collapse navbar-collapse"
]
$ [ divDropdownLeft ]
<> [ scuff (SB.searchBar SB.defaultProps) ]
<> [ divDropdownRight d s ]
$ [ R2.scuff divDropdownLeft ]
<> [ R2.scuff (SB.searchBar SB.defaultProps) ]
<> [ R2.scuff $ divDropdownRight d s ]
]
]
]
]
divLogo :: ReactElement
divLogo = a [ className "navbar-brand logoSmall"
, href "#/"
] [ img [ src "images/logoSmall.png"
, title "Back to home."
, width "30"
, height "28"
]
]
divLogo :: R.Element
divLogo = H.a { className: "navbar-brand logoSmall"
, href: "#/"
} [ H.img { src: "images/logoSmall.png"
, title: "Back to home."
, width: "30"
, height: "28"
}
]
divDropdownLeft :: ReactElement
divDropdownLeft :: R.Element
divDropdownLeft = divDropdownLeft' (LiNav { title : "About Gargantext"
, href : "#"
, icon : "glyphicon glyphicon-info-sign"
......@@ -212,32 +206,33 @@ divDropdownLeft = divDropdownLeft' (LiNav { title : "About Gargantext"
}
)
divDropdownLeft' :: LiNav -> ReactElement
divDropdownLeft' mb = ul [className "nav navbar-nav"]
[ ul [className "nav navbar-nav pull-left"]
[ li [className "dropdown"]
[ menuButton mb
, menuElements'
]
]
]
divDropdownLeft' :: LiNav -> R.Element
divDropdownLeft' mb = H.ul {className: "nav navbar-nav"}
[ H.ul {className: "nav navbar-nav pull-left"}
[ H.li {className: "dropdown"}
[ menuButton mb
, menuElements'
]
]
]
menuButton :: LiNav -> ReactElement
menuButton :: LiNav -> R.Element
menuButton (LiNav { title : title'
, href : href'
, icon : icon'
, text : text'
}) = a [ className "dropdown-toggle navbar-text"
, _data {toggle: "dropdown"}
, href href', role "button"
, title title'
][ span [ aria {hidden : true}
, className icon'
] []
, text (" " <> text')
]
menuElements' :: ReactElement
}) = H.a { className: "dropdown-toggle navbar-text"
, data: {toggle: "dropdown"}
, href: href'
, role: "button"
, title: title'
} [ H.span { aria: {hidden : true}
, className: icon'
} []
, H.text (" " <> text')
]
menuElements' :: R.Element
menuElements' = menuElements-- title, icon, text
[ -- ===========================================================
[ LiNav { title : "Quick start, tutorials and methodology"
......@@ -273,14 +268,14 @@ menuElements' = menuElements-- title, icon, text
] -- ===========================================================
-- | Menu in the sidebar, syntactic sugar
menuElements :: Array (Array LiNav) -> ReactElement
menuElements :: Array (Array LiNav) -> R.Element
menuElements ns = dropDown $ intercalate divider $ map (map liNav) ns
where
dropDown :: Array ReactElement -> ReactElement
dropDown = ul [className "dropdown-menu"]
dropDown :: Array R.Element -> R.Element
dropDown = H.ul {className: "dropdown-menu"}
divider :: Array ReactElement
divider = [li [className "divider"] []]
divider :: Array R.Element
divider = [H.li {className: "divider"} []]
-- | surgar for target : "blank"
--data LiNav_ = LiNav_ { title :: String
......@@ -296,77 +291,78 @@ data LiNav = LiNav { title :: String
, text :: String
}
liNav :: LiNav -> ReactElement
liNav :: LiNav -> R.Element
liNav (LiNav { title : title'
, href : href'
, icon : icon'
, text : text'
}
) = li [] [ a [ tabIndex (-1)
, target "blank"
, title title'
, href href'
] [ span [ className icon' ] []
, text $ " " <> text'
]
]
) = H.li {} [ H.a { tabIndex: (-1)
, target: "blank"
, title: title'
, href: href'
} [ H.span { className: icon' } []
, H.text $ " " <> text'
]
]
logLinks :: (Action -> Effect Unit) -> AppState -> ReactElement
logLinks :: (Action -> Effect Unit) -> AppState -> R.Element
logLinks d s = case s.loginState.authData of
Nothing -> loginLink
Just _ -> logoutLink
where
loginLink =
a [ aria {hidden : true}
, className "glyphicon glyphicon-log-in"
, onClick $ \e -> d ShowLogin
, style {color:"white"}
, title "Log in and save your time"
-- TODO hover: bold
]
[text " Login / Signup"]
H.a { aria: {hidden : true}
, className: "glyphicon glyphicon-log-in"
, on: {click: \e -> d ShowLogin}
, style: {color:"white"}
, title: "Log in and save your time"
-- TODO hover: bold
}
[H.text " Login / Signup"]
-- TODO dropdown to logout
logoutLink =
a [ aria {hidden : true}
, className "glyphicon glyphicon-log-out"
, onClick $ \e -> d Logout
, style {color:"white"}
, title "Log out" -- TODO
-- TODO hover: bold
]
[text " Logout"]
H.a { aria: {hidden : true}
, className: "glyphicon glyphicon-log-out"
, on: {click: \e -> d Logout}
, style: {color:"white"}
, title: "Log out" -- TODO
-- TODO hover: bold
}
[H.text " Logout"]
divDropdownRight :: (Action -> Effect Unit) -> AppState -> ReactElement
divDropdownRight :: (Action -> Effect Unit) -> AppState -> R.Element
divDropdownRight d s =
ul [className "nav navbar-nav pull-right"]
[ li [className "dropdown"]
[ logLinks d s ]
]
H.ul {className: "nav navbar-nav pull-right"}
[ H.li {className: "dropdown"}
[ logLinks d s ]
]
layoutFooter :: Spec AppState {} Action
layoutFooter = simpleSpec performAction render
layoutFooter :: Spec {} {} Void
layoutFooter = R2.elSpec $ R.hooksComponent "LayoutFooter" cpt
where
render :: Render AppState {} Action
render dispatch _ state _ = [div [ className "container" ] [ hr', footerLegalInfo']]
where
footerLegalInfo' = footer [] [ p [] [ text "Gargantext "
, span [className "glyphicon glyphicon-registration-mark" ] []
, text ", version 4.0"
, a [ href "http://www.cnrs.fr"
, target "blank"
, title "Project hosted by CNRS."
]
[ text ", Copyrights "
, span [ className "glyphicon glyphicon-copyright-mark" ] []
, text " CNRS 2017-Present"
]
, a [ href "http://gitlab.iscpif.fr/humanities/gargantext/blob/stable/LICENSE"
, target "blank"
, title "Legal instructions of the project."
]
[ text ", Licences aGPLV3 and CECILL variant Affero compliant" ]
, text "."
]
]
cpt {} _children = do
pure $ H.div { className: "container" } [ H.hr {}, footerLegalInfo']
footerLegalInfo' = H.footer {}
[ H.p {} [ H.text "Gargantext "
, H.span {className: "glyphicon glyphicon-registration-mark"} []
, H.text ", version 4.0"
, H.a { href: "http://www.cnrs.fr"
, target: "blank"
, title: "Project hosted by CNRS."
}
[ H.text ", Copyrights "
, H.span { className: "glyphicon glyphicon-copyright-mark" } []
, H.text " CNRS 2017-Present"
]
, H.a { href: "http://gitlab.iscpif.fr/humanities/gargantext/blob/stable/LICENSE"
, target: "blank"
, title: "Legal instructions of the project."
}
[ H.text ", Licences aGPLV3 and CECILL variant Affero compliant" ]
, H.text "."
]
]
module Gargantext.Pages.Layout.Specs.AddCorpus
( module Gargantext.Pages.Layout.Specs.AddCorpus.States
, module Gargantext.Pages.Layout.Specs.AddCorpus.Actions
, module Gargantext.Pages.Layout.Specs.AddCorpus.Specs
) where
import Gargantext.Pages.Layout.Specs.AddCorpus.States
import Gargantext.Pages.Layout.Specs.AddCorpus.Actions
import Gargantext.Pages.Layout.Specs.AddCorpus.Specs
module Gargantext.Pages.Layout.Specs.AddCorpus.Actions where
import Control.Monad.Cont.Trans (lift)
import Data.Argonaut (class EncodeJson, jsonEmptyObject, (:=), (~>))
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Routing.Hash (setHash)
import Thermite (PerformAction, modifyState)
import Gargantext.Prelude
import Gargantext.Config.REST (post)
import Gargantext.Components.Modals.Modal (modalHide)
import Gargantext.Pages.Layout.Specs.AddCorpus.States (Response, State)
data Action
= SelectDatabase Boolean
| UnselectDatabase Boolean
| LoadDatabaseDetails
| GO
performAction :: PerformAction State {} Action
performAction (SelectDatabase selected) _ _ = void do
modifyState $ _ { select_database = selected }
performAction (UnselectDatabase unselected) _ _ = void do
modifyState $ _ { unselect_database = unselected }
performAction (LoadDatabaseDetails) _ _ = do
res <- lift $ getDatabaseDetails $ QueryString { query_query: "string",query_name: ["Pubmed"]}
void $ modifyState $ _ {response = res}
performAction GO _ _ = do
liftEffect $ setHash "/corpus"
liftEffect $ modalHide "addCorpus"
pure unit
newtype QueryString = QueryString
{
query_query :: String
, query_name :: Array String
}
queryString :: QueryString
queryString = QueryString
{
query_query: "string",
query_name: [
"Pubmed"
]
}
instance encodeJsonQueryString :: EncodeJson QueryString where
encodeJson (QueryString obj) =
"query_query" := obj.query_query
~> "query_name" := obj.query_name
~> jsonEmptyObject
getDatabaseDetails :: QueryString -> Aff (Array Response)
getDatabaseDetails reqBody = do
-- TODO let token = "eyJ0eXAiOiJKV1QiLCJhbGciOiJIUzI1NiJ9.eyJleHAiOjE1MTk5OTg1ODMsInVzZXJfaWQiOjUsImVtYWlsIjoiYWxleGFuZHJlLmRlbGFub2VAaXNjcGlmLmZyIiwidXNlcm5hbWUiOiJkZXZlbG9wZXIifQ.Os-3wuFNSmRIxCZi98oFNBu2zqGc0McO-dgDayozHJg"
post "http://localhost:8009/count" reqBody
module Gargantext.Pages.Layout.Specs.AddCorpus.Specs where
import Data.Lens (over)
import Effect.Aff (Aff)
import React (ReactElement)
import React.DOM (button, div, h3, h5, li, span, text, ul)
import React.DOM.Props (_data, _id, _type, aria, className, onClick, role)
import Thermite (Render, Spec, _render, simpleSpec)
import Gargantext.Prelude
import Gargantext.Config.REST (post)
import Gargantext.Pages.Layout.Specs.AddCorpus.Actions (Action(..), performAction)
import Gargantext.Pages.Layout.Specs.AddCorpus.States (Query, Response(..), State)
modalSpec :: Boolean -> String -> Spec State {} Action -> Spec State {} Action
modalSpec sm t = over _render \render d p s c ->
[ div [ _id "addCorpus", className $ "modal myModal" <> if sm then "" else " fade"
, role "dialog"
, _data {show : true}
][ div [ className "modal-dialog", role "document"]
[ div [ className "modal-content"]
[ div [ className "modal-header"]
[ h5 [ className "modal-title" ] [ text $ t ]
, button [ _type "button"
, className "close"
, _data { dismiss : "modal"}
] [ span [ aria {hidden : true}] [ text "X"] ]
]
, div [ className "modal-body"] (render d p s c)
]
]
]
]
spec' :: Spec State {} Action
spec' = modalSpec true "Search Results" layoutAddcorpus
layoutModal :: forall e. { response :: Array Response | e} -> Array ReactElement
layoutModal state =
[button [ _type "button"
, _data { "toggle" : "modal"
, "target" : ".myModal"
}
][text "Launch modal"]
, div [ className "modal fade myModal"
, role "dialog"
, _data {show : true}
][ div [ className "modal-dialog"
, role "document"
] [ div [ className "modal-content"]
[ div [ className "modal-header"]
[ h5 [className "modal-title"]
[text "CorpusView" ]
, button [ _type "button"
, className "close"
, _data { dismiss : "modal"}
] [ span [ aria {hidden : true}]
[ text "X"]
]
]
, div [ className "modal-body"]
[ ul [ className "list-group"] ( map fn1 state.response ) ]
, div [className "modal-footer"]
[ button [ _type "button"
, className "btn btn-secondary"
, _data {dismiss : "modal"}
] [ text "GO"]
]
]
]
]
]
where
fn1 (Response o) =
li [className "list-group-item justify-content-between"]
[
span [] [text o.name]
, span [className "badge badge-default badge-pill"] [ text $ show o.count]
]
layoutAddcorpus :: Spec State {} Action
layoutAddcorpus = simpleSpec performAction render
where
render :: Render State {} Action
render dispatch _ state _ =
[ div [className "container1"] []
, div [className "container1"]
[ div [className "jumbotron"]
[ div [className "row"]
[ div [className "col-md-6"] (layoutModal state)
, div [className "col-md-6"]
[ h3 [] [text "Corpusview"]
, ul [className "list-group"] $ map fn1 state.response
, button [onClick \_ -> dispatch GO] [text "GO"]
]
]
]
]
]
where
fn1 (Response o) =
li [className "list-group-item justify-content-between"]
[
span [] [text o.name]
, span [className "badge badge-default badge-pill"] [ text $ show o.count]
]
countResults :: Query -> Aff Int
countResults = post "http://localhost:8008/count"
module Gargantext.Pages.Layout.Specs.AddCorpus.States where
import Prelude hiding (div)
import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson, jsonEmptyObject, (.?), (:=), (~>))
type State =
{ select_database :: Boolean
, unselect_database :: Boolean -- dummy state
, response :: Array Response
}
newtype Response = Response
{
count :: Int
, name :: String
}
newtype Query = Query
{
query_query :: String
, query_name :: Array String
}
instance encodeJsonQuery :: EncodeJson Query where
encodeJson (Query post)
= "query_query" := post.query_query
~> "query_name" := post.query_name
~> jsonEmptyObject
instance decodeJsonresponse :: DecodeJson Response where
decodeJson json = do
obj <- decodeJson json
count <- obj .? "count"
name <- obj .? "name"
pure $ Response {count,name }
initialState :: State
initialState =
{
select_database : true
, unselect_database : true
, response : []
}
module Gargantext.Pages.Layout.Specs.Search where
import Prelude hiding (div)
import Effect.Class (liftEffect)
import React.DOM (br', button, div, input, text)
import React.DOM.Props (_id, _type, className, name, onClick, onInput, placeholder, value)
import Routing.Hash (setHash)
import Thermite (PerformAction, Render, Spec, modifyState, simpleSpec)
import Unsafe.Coerce (unsafeCoerce)
type State =
{
query :: String
}
initialState :: State
initialState =
{
query : "empty query"
}
data Action
= GO
| SetQuery String
unsafeEventValue :: forall event. event -> String
unsafeEventValue e = (unsafeCoerce e).target.value
searchSpec :: Spec State {} Action
searchSpec = simpleSpec performAction render
where
performAction :: PerformAction State {} Action
performAction (SetQuery q) _ _ = void do
modifyState $ _ { query = q }
performAction GO _ _ = void do
liftEffect $ setHash "/addCorpus"
render :: Render State {} Action
render dispatch _ state _ =
[ div [className "container1"] []
, div [className "container1"]
[ div [className "jumbotron" ]
[ div [className "row" ]
[ div [className "col-md-10" ]
[ br'
, br'
, div [ className "form-group"][]
{-[ input [ className "form-control"
, _id "id_password"
, name "query"
, placeholder "Query, URL or FILE (works best with Firefox or Chromium browsers)"
, _type "text"
, value state.query
, onInput \e -> dispatch (SetQuery (unsafeEventValue e))
]
, br'
]
-}
]
, div [ className "col-md-2"]
[ br'
, br'
, button [onClick \_ -> dispatch GO] [text "GO"]
]
, br'
]
]
]
]
......@@ -9,15 +9,11 @@ import Gargantext.Components.Login as LN
import Gargantext.Config (EndConfig, endConfigStateful)
import Gargantext.Pages.Corpus.Graph as GE
import Gargantext.Pages.Layout.Specs.AddCorpus as AC
import Gargantext.Pages.Layout.Specs.Search as S
import Gargantext.Router (Routes(..))
type AppState =
{ currentRoute :: Maybe Routes
, loginState :: LN.State
, addCorpusState :: AC.State
, searchState :: S.State
, showLogin :: Boolean
, showCorpus :: Boolean
, graphExplorerState :: GE.State
......@@ -31,8 +27,6 @@ initAppState = do
pure
{ currentRoute : Just Home
, loginState
, addCorpusState : AC.initialState
, searchState : S.initialState
, showLogin : false
, showCorpus : false
, graphExplorerState : GE.initialState
......@@ -46,12 +40,6 @@ initAppState = do
_loginState :: Lens' AppState LN.State
_loginState = lens (\s -> s.loginState) (\s ss -> s{loginState = ss})
_addCorpusState :: Lens' AppState AC.State
_addCorpusState = lens (\s -> s.addCorpusState) (\s ss -> s{addCorpusState = ss})
_searchState :: Lens' AppState S.State
_searchState = lens (\s -> s.searchState) (\s ss -> s{searchState = ss})
_graphExplorerState :: Lens' AppState GE.State
_graphExplorerState = lens (\s -> s.graphExplorerState) (\s ss -> s{graphExplorerState = ss})
......@@ -89,6 +89,7 @@ docViewSpec tst = R2.elSpec $ R.hooksComponent "DocViewSpecWithCorpus" cpt
, totalRecords: 4737
, listId: defaultListId
, corpusId: Just corpusId
, showSearch: true
}
params TabMoreLikeFav = {
nodeId: corpusId
......@@ -98,6 +99,7 @@ docViewSpec tst = R2.elSpec $ R.hooksComponent "DocViewSpecWithCorpus" cpt
, totalRecords: 4737
, listId: defaultListId
, corpusId: Just corpusId
, showSearch: false
}
params TabMoreLikeTrash = {
nodeId: corpusId
......@@ -107,6 +109,7 @@ docViewSpec tst = R2.elSpec $ R.hooksComponent "DocViewSpecWithCorpus" cpt
, totalRecords: 4737
, listId: defaultListId
, corpusId: Just corpusId
, showSearch: false
}
params TabTrash = {
nodeId: corpusId
......@@ -116,6 +119,7 @@ docViewSpec tst = R2.elSpec $ R.hooksComponent "DocViewSpecWithCorpus" cpt
, totalRecords: 4737
, listId: defaultListId
, corpusId: Nothing
, showSearch: true
}
-- DUMMY
params _ = {
......@@ -126,4 +130,5 @@ docViewSpec tst = R2.elSpec $ R.hooksComponent "DocViewSpecWithCorpus" cpt
, totalRecords: 4737
, listId: defaultListId
, corpusId: Nothing
, showSearch: true
}
......@@ -16,10 +16,8 @@ import Web.Storage.Storage (getItem)
data Routes
= Home
| Login
| SearchView
| Folder Int
| Corpus Int
| AddCorpus
| Document Int Int
| CorpusDocument Int Int Int
| PGraphExplorer Int
......@@ -33,8 +31,6 @@ data Routes
routing :: Match Routes
routing = oneOf
[ Login <$ route "login"
, SearchView <$ route "search"
, AddCorpus <$ route "addCorpus"
, Folder <$> (route "folder" *> int)
, CorpusDocument <$> (route "corpus" *> int) <*> (lit "list" *> int) <*> (lit "document" *> int)
, Corpus <$> (route "corpus" *> int)
......@@ -57,8 +53,6 @@ routing = oneOf
instance showRoutes :: Show Routes where
show Login = "Login"
show AddCorpus = "AddCorpus"
show SearchView = "Search"
show (UserPage i) = "User" <> show i
show (ContactPage i) = "Contact" <> show i
show (CorpusDocument _ _ i) = "Document" <> show i
......
......@@ -89,3 +89,7 @@ select = createDOMElement "select"
effToggler :: forall e. R.State Boolean -> EffectFn1 e Unit
effToggler (value /\ setValue) = mkEffectFn1 $ \e -> setValue $ const $ not value
unsafeEventValue :: forall event. event -> String
unsafeEventValue e = (unsafeCoerce e).target.value
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