Commit 6be8993a authored by Alexandre Delanoë's avatar Alexandre Delanoë

[FIX] merge with testing changes

parents 349f7110 53cfbca3
...@@ -46,8 +46,8 @@ class Doc a where ...@@ -46,8 +46,8 @@ class Doc a where
dataFields :: Array DataField dataFields :: Array DataField
dataFields = [ Gargantext dataFields = [ Gargantext
, Web
, External Nothing , External Nothing
, Web
-- , Files -- , Files
] ]
...@@ -59,8 +59,8 @@ data DataField = Gargantext ...@@ -59,8 +59,8 @@ data DataField = Gargantext
instance showDataField :: Show DataField where instance showDataField :: Show DataField where
show Gargantext = "Gargantext" show Gargantext = "Gargantext"
show (External _) = "Others" -- <> show x show (External _) = "Databases (APIs)" -- <> show x
show Web = "Web" show Web = "Soon: web"
show Files = "Files" show Files = "Files"
instance docDataField :: Doc DataField where instance docDataField :: Doc DataField where
......
...@@ -115,7 +115,7 @@ renderNgramsTree p = R.createElement renderNgramsTreeCpt p [] ...@@ -115,7 +115,7 @@ renderNgramsTree p = R.createElement renderNgramsTreeCpt p []
renderNgramsTreeCpt :: R.Component RenderNgramsTree renderNgramsTreeCpt :: R.Component RenderNgramsTree
renderNgramsTreeCpt = R.hooksComponentWithModule thisModule "renderNgramsTree" cpt renderNgramsTreeCpt = R.hooksComponentWithModule thisModule "renderNgramsTree" cpt
where where
cpt { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit } _ = cpt { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit} _ =
pure $ H.ul {} [ pure $ H.ul {} [
H.span { className: "tree" } [ H.span { className: "tree" } [
H.span { className: "righthanded" } [ H.span { className: "righthanded" } [
...@@ -133,12 +133,26 @@ renderNgramsTreeCpt = R.hooksComponentWithModule thisModule "renderNgramsTree" c ...@@ -133,12 +133,26 @@ renderNgramsTreeCpt = R.hooksComponentWithModule thisModule "renderNgramsTree" c
type NgramsDepth = {ngrams :: NgramsTerm, depth :: Int} type NgramsDepth = {ngrams :: NgramsTerm, depth :: Int}
type NgramsClick = NgramsDepth -> Maybe (Effect Unit) type NgramsClick = NgramsDepth -> Maybe (Effect Unit)
type TreeProps = type TagProps =
( ngramsClick :: NgramsClick ( ngramsClick :: NgramsClick
, ngramsDepth :: NgramsDepth , ngramsDepth :: NgramsDepth
, ngramsEdit :: NgramsClick
, ngramsStyle :: Array DOM.Props , ngramsStyle :: Array DOM.Props
)
{- TODO refactor here
-- tag :: TagProps -> Array R.Element -> R.Element
tag tagProps =
case tagProps.ngramsClick tagProps.ngramsDepth of
Just effect ->
a (tagProps.ngramsStyle <> [DOM.onClick $ const effect])
Nothing ->
span tagProps.ngramsStyle
-}
type TreeProps =
( ngramsEdit :: NgramsClick
, ngramsTable :: NgramsTable , ngramsTable :: NgramsTable
| TagProps
) )
tree :: Record TreeProps -> R.Element tree :: Record TreeProps -> R.Element
...@@ -153,7 +167,8 @@ treeCpt = R.hooksComponentWithModule thisModule "tree" cpt ...@@ -153,7 +167,8 @@ treeCpt = R.hooksComponentWithModule thisModule "tree" cpt
([ H.i { className, style } [] ] ([ H.i { className, style } [] ]
<> [ R2.buff $ tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ] ] <> [ R2.buff $ tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ] ]
<> maybe [] edit (ngramsEdit ngramsDepth) <> maybe [] edit (ngramsEdit ngramsDepth)
<> [ forest cs ]) <> [ forest cs ]
)
where where
tag = tag =
case ngramsClick ngramsDepth of case ngramsClick ngramsDepth of
...@@ -214,18 +229,23 @@ renderNgramsItemCpt = R.hooksComponentWithModule thisModule "renderNgramsItem" c ...@@ -214,18 +229,23 @@ renderNgramsItemCpt = R.hooksComponentWithModule thisModule "renderNgramsItem" c
, selected , selected
, checkbox T.MapTerm , checkbox T.MapTerm
, checkbox T.StopTerm , checkbox T.StopTerm
, H.div {} [ , H.div {} ( if ngramsParent == Nothing
if ngramsParent == Nothing then [renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit }]
then renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit } else [H.a { on: { click: const $ dispatch $ ToggleChild true ngrams } }
else [ H.i { className: "glyphicon glyphicon-plus" } []]
H.a { on: { click: const $ dispatch $ ToggleChild true ngrams } } [ , R2.buff $ tag [ text $ " " <> ngramsTermText ngramsDepth.ngrams ]
H.i { className: "fa fa-plus" } [] ]
, (R2.buff $ span ngramsStyle [text $ " " <> ngramsTermText ngrams]) )
]
]
, H.text $ show (ngramsElement ^. _NgramsElement <<< _occurrences) , H.text $ show (ngramsElement ^. _NgramsElement <<< _occurrences)
] ]
where where
ngramsDepth= {ngrams, depth: 0 }
tag =
case ngramsClick ngramsDepth of
Just effect ->
a (ngramsStyle <> [DOM.onClick $ const effect])
Nothing ->
span ngramsStyle
onClick _ = do onClick _ = do
R2.callTrigger toggleSidePanel unit R2.callTrigger toggleSidePanel unit
termList = ngramsElement ^. _NgramsElement <<< _list termList = ngramsElement ^. _NgramsElement <<< _list
......
...@@ -313,7 +313,7 @@ renameableTextCpt = R.hooksComponentWithModule thisModule "renameableTextCpt" cp ...@@ -313,7 +313,7 @@ renameableTextCpt = R.hooksComponentWithModule thisModule "renameableTextCpt" cp
cpt {isEditing: (true /\ setIsEditing), onRename, state: (text /\ setText)} _ = do cpt {isEditing: (true /\ setIsEditing), onRename, state: (text /\ setText)} _ = do
pure $ H.div { className: "input-group" } [ pure $ H.div { className: "input-group" } [
inputWithEnter { inputWithEnter {
autoFocus: false autoFocus: false
, autoSave: false , autoSave: false
, className: "form-control text" , className: "form-control text"
, defaultValue: text , defaultValue: text
......
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