Skip to content

Commit 545106c

Browse files
benjamin-thomasbenjamin-thomas
committed
Almost done.
- need to fix CSS on edit input - need to add a link to go back to the previous page
1 parent fa42e84 commit 545106c

File tree

3 files changed

+152
-43
lines changed

3 files changed

+152
-43
lines changed

‎examples/Example/Page/Todos/Shared.hs

+13-1
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,11 @@
11
{-# LANGUAGE LambdaCase #-}
22
{-# LANGUAGE UndecidableInstances #-}
33

4-
module Example.Page.Todos.Shared where
4+
module Example.Page.Todos.Shared
5+
( pluralize
6+
, FilterTodo (..)
7+
, TodoForm (..)
8+
) where
59

610
import Data.Text (Text)
711
import Web.Hyperbole
@@ -16,3 +20,11 @@ data TodoForm f = TodoForm
1620
{ task :: Field f Text
1721
}
1822
deriving (Generic, FromFormF, GenFields FieldName)
23+
24+
pluralize :: Int -> Text -> Text -> Text
25+
pluralize n singular plural =
26+
if n == 1
27+
then
28+
singular
29+
else
30+
plural

‎examples/Example/Page/Todos/Todo.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@ import Example.AppRoute qualified as Route
1111
import Example.Colors
1212
import Example.Effects.Todos (Todo (..), TodoId, Todos)
1313
import Example.Effects.Todos qualified as Todos
14-
import Example.Page.Todos.Shared
14+
import Example.Page.Todos.Shared (FilterTodo (..), TodoForm (..))
1515
import Example.Style qualified as Style
1616
import Example.View.Icon qualified as Icon
1717
import Example.View.Inputs (toggleCheckbox)

‎examples/Example/Page/Todos/TodoCSS.hs

+138-41
Original file line numberDiff line numberDiff line change
@@ -1,29 +1,43 @@
1-
{-# LANGUAGE DerivingVia #-}
21
{-# LANGUAGE LambdaCase #-}
32
{-# LANGUAGE UndecidableInstances #-}
43

54
module Example.Page.Todos.TodoCSS (page) where
65

76
import Control.Monad (forM_)
7+
import Data.Bool (bool)
88
import Data.Text qualified as T
9-
import Effectful
10-
import Example.Colors (AppColor (..))
9+
1110
import Example.Effects.Todos (Todo, TodoId, Todos)
1211
import Example.Effects.Todos qualified as Todos
13-
import Example.Page.Todos.Shared
14-
import Example.Style qualified as Style
15-
import Example.View.Icon qualified as Icon
16-
import Example.View.Inputs (toggleCheckbox)
12+
import Example.Page.Todos.Shared (FilterTodo (..), TodoForm (..), pluralize)
1713
import Web.Hyperbole as Hyperbole
14+
import Web.Hyperbole.View.Forms (Input (Input))
15+
import Web.View.Style (extClass)
16+
import Web.View.Types (AttValue)
17+
18+
{-
19+
20+
To make the CSS version work and overcome the default CSS reset, we tweaked the output slightly via a few style tags here and there:
21+
22+
only need to add one manual rule to the footer, to override the CSS reset
23+
24+
- main title
25+
- override its absolute positioning
26+
- footer
27+
- add bottom padding
28+
29+
-}
1830

1931
page :: (Todos :> es) => Eff es (Page '[TodosView, TodoView])
2032
page = do
2133
todos <- Todos.loadAll
22-
pure $ tag "div" id $ do
23-
tag "h1" id $ text "Todos CSS"
24-
tag "p" id $
25-
text ("Count:" <> T.pack (show $ length todos))
26-
hyper MkTodosView $ todosView FilterAll todos
34+
pure $ do
35+
div' (style' "_margin-top: 50px") $ do
36+
stylesheet "https://cdn.jsdelivr.net/npm/[email protected]/index.min.css"
37+
section (extClass "todoapp") $ do
38+
header (extClass "header") $ do
39+
h1 (style' "top:-80px") $ text "todos"
40+
hyper MkTodosView $ todosView FilterAll todos
2741

2842
--- TodosView ----------------------------------------------------------------------------
2943

@@ -73,41 +87,77 @@ instance (Todos :> es) => HyperView TodosView es where
7387

7488
todosView :: FilterTodo -> [Todo] -> View TodosView ()
7589
todosView filt todos = do
76-
todoForm filt
77-
col id $ do
90+
todoForm
91+
main' (extClass "main") $ do
92+
div' (extClass "toggle-all-container") $ do
93+
input'
94+
( extClass "toggle-all"
95+
. att "id" "toggle-all"
96+
. att "type" "checkbox"
97+
)
98+
label'
99+
( extClass "toggle-all-label"
100+
. att "for" "toggle-all"
101+
. onClick (ToggleAll filt)
102+
)
103+
(text "Mark all as complete")
104+
ul' (extClass "todo-list") $ do
78105
forM_ todos $ \todo -> do
79106
hyper (MkTodoView todo.id) $ todoView filt todo
80107
statusBar filt todos
81108

82-
todoForm :: FilterTodo -> View TodosView ()
83-
todoForm filt = do
109+
todoForm :: View TodosView ()
110+
todoForm = do
84111
let f :: TodoForm FieldName = fieldNames
85-
tag "div" id $ do
86-
tag "span" id $ do
87-
button (ToggleAll filt) (width 32 . hover (color Primary)) Icon.chevronDown
88-
form SubmitTodo grow $ do
89-
field f.task id $ do
90-
input TextInput (pad 12 . placeholder "What needs to be done?" . value "")
112+
form SubmitTodo grow $ do
113+
field f.task id $ do
114+
Input (FieldName nm) <- context
115+
input' -- we use a custom input field, because the Hyperbole one overrides autocomplete
116+
( extClass "new-todo"
117+
{-
118+
-- . autofocus
119+
FIXME: turning off autofocus, that "steals" the focus on item click.
120+
FIXME: to solve this, we could either store the "initially focused" state and track that boolean, or use buttons
121+
FIXME: but since this example is meant to match as close as possible to the original CSS version
122+
FIXME: and not diverge too much from the other todo example, I'm leaving as-is.
123+
-}
124+
. att "autocomplete" "off"
125+
. placeholder "What needs to be done?"
126+
. value ""
127+
. name nm -- because we use a custom field, we must provide this param for the library
128+
)
91129

92130
statusBar :: FilterTodo -> [Todo] -> View TodosView ()
93131
statusBar filt todos = do
94-
tag "div" id $ do
132+
footer (extClass "footer" . style' "padding-bottom: 30px") $ do
95133
let numLeft = length $ filter (\t -> not t.completed) todos
96-
el_ $ do
97-
text $ T.pack (show numLeft)
98-
text " items left!"
134+
span' (extClass "todo-count") $ do
135+
text $
136+
mconcat
137+
[ T.pack $ show numLeft
138+
, " "
139+
, pluralize numLeft "item" "items"
140+
, " "
141+
, "left!"
142+
]
99143
space
100-
tag "div" id $ do
101-
filterButton FilterAll "All"
102-
filterButton Active "Active"
103-
filterButton Completed "Completed"
144+
ul' (extClass "filters") $ do
145+
filterLi FilterAll "All"
146+
filterLi Active "Active"
147+
filterLi Completed "Completed"
104148
space
105-
button ClearCompleted (hover (color Primary)) "Clear completed"
149+
button ClearCompleted (extClass "clear-completed") "Clear completed"
106150
where
107-
filterButton f =
108-
button (Filter f) (selectedFilter f . pad (XY 4 0) . rounded 2)
151+
filterLi f str =
152+
li' (extClass "filter" . selectedFilter f) $ do
153+
tag
154+
"a"
155+
( onClick (Filter f)
156+
. att "href" "" -- harmless empty href is for the CSS
157+
)
158+
(text str)
109159
selectedFilter f =
110-
if f == filt then border 1 else id
160+
if f == filt then extClass "selected" else id
111161

112162
--- TodoView ----------------------------------------------------------------------------
113163

@@ -131,17 +181,64 @@ instance (Todos :> es) => HyperView TodoView es where
131181

132182
todoView :: FilterTodo -> Todo -> View TodoView ()
133183
todoView filt todo = do
134-
tag "div" id $ do
135-
target MkTodosView $ do
136-
toggleCheckbox (SetCompleted filt todo) todo.completed
137-
tag "span" (completed . pad (XY 18 4) . onDblClick (Edit filt todo)) $ text todo.task
138-
where
139-
completed = if todo.completed then Style.strikethrough else id
184+
li'
185+
( onDblClick (Edit filt todo)
186+
. bool id (extClass "completed") todo.completed
187+
)
188+
$ do
189+
div' (extClass "view") $ do
190+
target MkTodosView $ do
191+
input'
192+
( extClass "toggle"
193+
. att "type" "checkbox"
194+
. onClick (SetCompleted filt todo $ not todo.completed)
195+
. checked todo.completed
196+
)
197+
label' (extClass "label") $ do
198+
text todo.task
140199

141200
todoEditView :: FilterTodo -> Todo -> View TodoView ()
142201
todoEditView filt todo = do
143202
let f = fieldNames @TodoForm
144-
tag "div" id $ do
203+
div' id $ do
145204
form (SubmitEdit filt todo) (pad (TRBL 0 0 0 46)) $ do
146205
field f.task id $ do
147206
input TextInput (pad 4 . value todo.task . autofocus)
207+
208+
--- Helpers ----------------------------------------------------------------------------
209+
210+
div' :: Mod c -> View c () -> View c ()
211+
div' = tag "div"
212+
213+
span' :: Mod c -> View c () -> View c ()
214+
span' = tag "span"
215+
216+
section :: Mod c -> View c () -> View c ()
217+
section = tag "section"
218+
219+
header :: Mod c -> View c () -> View c ()
220+
header = tag "header"
221+
222+
main' :: Mod c -> View c () -> View c ()
223+
main' = tag "main"
224+
225+
h1 :: Mod c -> View c () -> View c ()
226+
h1 = tag "h1"
227+
228+
label' :: Mod c -> View c () -> View c ()
229+
label' = tag "label"
230+
231+
input' :: Mod c -> View c ()
232+
input' m = tag "input" m ""
233+
234+
ul' :: Mod c -> View c () -> View c ()
235+
ul' = tag "ul"
236+
237+
li' :: Mod c -> View c () -> View c ()
238+
li' = tag "li"
239+
240+
footer :: Mod c -> View c () -> View c ()
241+
footer = tag "footer"
242+
243+
style' :: AttValue -> Mod c
244+
style' = att "style"

0 commit comments

Comments
 (0)