Commit f061407f authored by Nicolas Pouillard's avatar Nicolas Pouillard Committed by Alexandre Delanoë

[NGRAMS] Fix issue 84

parent a77c292a
...@@ -169,9 +169,10 @@ tableContainer { pageParams ...@@ -169,9 +169,10 @@ tableContainer { pageParams
ngramsClick {depth: 1, ngrams: child} = ngramsClick {depth: 1, ngrams: child} =
Just $ dispatch $ ToggleChild false child Just $ dispatch $ ToggleChild false child
ngramsClick _ = Nothing ngramsClick _ = Nothing
ngramsEdit _ = Nothing
in in
[ p[] [text $ "Editing " <> ngrams] [ p[] [text $ "Editing " <> ngrams]
, renderNgramsTree { ngramsTable, ngrams, ngramsStyle: [], ngramsClick } , renderNgramsTree { ngramsTable, ngrams, ngramsStyle: [], ngramsClick, ngramsEdit }
, button [className "btn btn-primary", onClick $ const $ dispatch $ AddTermChildren] [text "Save"] , button [className "btn btn-primary", onClick $ const $ dispatch $ AddTermChildren] [text "Save"]
, button [className "btn btn-secondary", onClick $ const $ dispatch $ SetParentResetChildren Nothing] [text "Cancel"] , button [className "btn btn-secondary", onClick $ const $ dispatch $ SetParentResetChildren Nothing] [text "Cancel"]
]) ngramsParent) ]) ngramsParent)
...@@ -315,14 +316,16 @@ type NgramsClick = NgramsDepth -> Maybe (Effect Unit) ...@@ -315,14 +316,16 @@ type NgramsClick = NgramsDepth -> Maybe (Effect Unit)
tree :: { ngramsTable :: NgramsTable tree :: { ngramsTable :: NgramsTable
, ngramsStyle :: Array DOM.Props , ngramsStyle :: Array DOM.Props
, ngramsEdit :: NgramsClick
, ngramsClick :: NgramsClick , ngramsClick :: NgramsClick
} -> NgramsDepth -> ReactElement } -> NgramsDepth -> ReactElement
tree params@{ngramsTable, ngramsStyle, ngramsClick} nd@{ngrams} = tree params@{ngramsTable, ngramsStyle, ngramsEdit, ngramsClick} nd@{ngrams} =
li [ style {width : "100%"} ] li [ style {width : "100%"} ]
[ i icon [] ([ i icon []
, tag [text $ " " <> ngrams] , tag [text $ " " <> ngrams]
, forest cs ] <> maybe [] edit (ngramsEdit nd) <>
] [ forest cs
])
where where
tag = tag =
case ngramsClick nd of case ngramsClick nd of
...@@ -330,6 +333,9 @@ tree params@{ngramsTable, ngramsStyle, ngramsClick} nd@{ngrams} = ...@@ -330,6 +333,9 @@ tree params@{ngramsTable, ngramsStyle, ngramsClick} nd@{ngrams} =
a (ngramsStyle <> [onClick $ const effect]) a (ngramsStyle <> [onClick $ const effect])
Nothing -> Nothing ->
span ngramsStyle span ngramsStyle
edit effect = [ text " "
, i [ className "glyphicon glyphicon-pencil"
, onClick $ const effect ] [] ]
leaf = List.null cs leaf = List.null cs
icon = gray <> [className $ "fas fa-caret-" <> if open then "down" else "right"] icon = gray <> [className $ "fas fa-caret-" <> if open then "down" else "right"]
open = not leaf || false {- TODO -} open = not leaf || false {- TODO -}
...@@ -352,10 +358,11 @@ renderNgramsTree :: { ngrams :: NgramsTerm ...@@ -352,10 +358,11 @@ renderNgramsTree :: { ngrams :: NgramsTerm
, ngramsTable :: NgramsTable , ngramsTable :: NgramsTable
, ngramsStyle :: Array DOM.Props , ngramsStyle :: Array DOM.Props
, ngramsClick :: NgramsClick , ngramsClick :: NgramsClick
, ngramsEdit :: NgramsClick
} -> ReactElement } -> ReactElement
renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick } = renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit } =
ul [] [ ul [] [
span [className "tree"] [tree {ngramsTable, ngramsStyle, ngramsClick} {ngrams, depth: 0}] span [className "tree"] [tree {ngramsTable, ngramsStyle, ngramsClick, ngramsEdit} {ngrams, depth: 0}]
] ]
renderNgramsItem :: { ngrams :: NgramsTerm renderNgramsItem :: { ngrams :: NgramsTerm
...@@ -368,7 +375,7 @@ renderNgramsItem { ngramsTable, ngrams, ngramsElement, ngramsParent, dispatch } ...@@ -368,7 +375,7 @@ renderNgramsItem { ngramsTable, ngrams, ngramsElement, ngramsParent, dispatch }
[ checkbox GraphTerm [ checkbox GraphTerm
, checkbox StopTerm , checkbox StopTerm
, if ngramsParent == Nothing , if ngramsParent == Nothing
then renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick } then renderNgramsTree { ngramsTable, ngrams, ngramsStyle, ngramsClick, ngramsEdit }
else else
a [onClick $ const $ dispatch $ ToggleChild true ngrams] a [onClick $ const $ dispatch $ ToggleChild true ngrams]
[ i [className "fas fa-plus"] [] [ i [className "fas fa-plus"] []
...@@ -379,7 +386,8 @@ renderNgramsItem { ngramsTable, ngrams, ngramsElement, ngramsParent, dispatch } ...@@ -379,7 +386,8 @@ renderNgramsItem { ngramsTable, ngrams, ngramsElement, ngramsParent, dispatch }
where where
termList = ngramsElement ^. _NgramsElement <<< _list termList = ngramsElement ^. _NgramsElement <<< _list
ngramsStyle = [termStyle termList] ngramsStyle = [termStyle termList]
ngramsClick = Just <<< dispatch <<< SetParentResetChildren <<< Just <<< view _ngrams ngramsEdit = Just <<< dispatch <<< SetParentResetChildren <<< Just <<< view _ngrams
ngramsClick = Just <<< cycleTermListItem <<< view _ngrams
checkbox termList' = checkbox termList' =
let chkd = termList == termList' let chkd = termList == termList'
termList'' = if chkd then CandidateTerm else termList' termList'' = if chkd then CandidateTerm else termList'
...@@ -389,17 +397,24 @@ renderNgramsItem { ngramsTable, ngrams, ngramsElement, ngramsParent, dispatch } ...@@ -389,17 +397,24 @@ renderNgramsItem { ngramsTable, ngrams, ngramsElement, ngramsParent, dispatch }
, className "checkbox" , className "checkbox"
, checked chkd , checked chkd
-- , title "Mark as completed" -- , title "Mark as completed"
, onChange $ const $ setTermList (replace termList termList'') , onChange $ const $ setTermList (replace termList termList'') ngrams
] ]
setTermList Keep = pure unit setTermList Keep _ = pure unit
setTermList rep@(Replace {old,new}) = dispatch $ SetTermListItem ngrams rep setTermList rep@(Replace {old,new}) n = dispatch $ SetTermListItem n rep
cycleTermListItem = setTermList (replace termList (nextTermList termList))
termStyle :: TermList -> DOM.Props termStyle :: TermList -> DOM.Props
termStyle GraphTerm = style {color: "green"} termStyle GraphTerm = style {color: "green"}
termStyle StopTerm = style {color: "red", textDecoration : "line-through"} termStyle StopTerm = style {color: "red", textDecoration : "line-through"}
termStyle CandidateTerm = style {color: "black"} termStyle CandidateTerm = style {color: "black"}
nextTermList :: TermList -> TermList
nextTermList GraphTerm = StopTerm
nextTermList StopTerm = CandidateTerm
nextTermList CandidateTerm = GraphTerm
optps1 :: forall a. Show a => { desc :: String, mval :: Maybe a } -> ReactElement optps1 :: forall a. Show a => { desc :: String, mval :: Maybe a } -> ReactElement
optps1 { desc, mval } = option [value val] [text desc] optps1 { desc, mval } = option [value val] [text desc]
where where
......
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