@@ -18,161 +18,165 @@ import Flame.Html.Element as HE
1818import Flame.Types (NodeData )
1919import Web.DOM.ParentNode (QuerySelector (..))
2020
21- data Message =
22- Create Int |
23- DisplayCreated (Array Row ) |
24- AppendOneThousand |
25- DisplayAppended (Array Row ) |
26- UpdateEveryTenth |
27- Clear |
28- Swap |
29- Remove Int |
30- Select Int
31-
32- type Model = {
33- rows :: Array Row ,
34- lastID :: Int
35- }
36-
37- type Row = {
38- id :: Int ,
39- label :: String ,
40- selected :: Boolean
41- }
42-
43- type Button = {
44- id :: String ,
45- label :: String ,
46- message :: Message
47- }
48-
49- foreign import createRandomNRows_ :: EffectFn2 Int Int (Array Row )
50-
51- createRandomNRows :: Int -> Int -> Aff (Array Row )
21+ data Message
22+ = Create Int
23+ | DisplayCreated (Array Row )
24+ | AppendOneThousand
25+ | DisplayAppended (Array Row )
26+ | UpdateEveryTenth
27+ | Clear
28+ | Swap
29+ | Remove Int
30+ | Select Int
31+
32+ type Model =
33+ { rows ∷ Array Row
34+ , lastID ∷ Int
35+ }
36+
37+ type Row =
38+ { id ∷ Int
39+ , label ∷ String
40+ , selected ∷ Boolean
41+ }
42+
43+ type Button =
44+ { id ∷ String
45+ , label ∷ String
46+ , message ∷ Message
47+ }
48+
49+ foreign import createRandomNRows_ ∷ EffectFn2 Int Int (Array Row )
50+
51+ createRandomNRows ∷ Int → Int → Aff (Array Row )
5252createRandomNRows n lastID = liftEffect (EU .runEffectFn2 createRandomNRows_ n lastID)
5353
54- main :: Effect Unit
55- main = F .mount_ (QuerySelector " body" ) {
56- model: model,
57- subscribe: [] ,
58- view,
59- update
60- }
61-
62- model :: Model
63- model = {
64- rows: [] ,
65- lastID: 0
66- }
67-
68- view :: Model -> Html Message
69- view model = HE .div [HA .class' " container" ] [
70- jumbotron,
71- HE .table [HA .class' " table table-hover table-striped test-data" ] [
72- HE .tbody_ (map renderLazyRow model.rows)
73- ],
74- footer
75- ]
76-
77- jumbotron :: Html Message
78- jumbotron = HE .div [ HA .class' " jumbotron" ] [
79- HE .div [ HA .class' " row" ] [
80- HE .div [ HA .class' " col-md-6" ] [
81- HE .h1_ [ HE .text " Flame 1.0.0 (keyed)" ]
82- ],
83- HE .div [ HA .class' " col-md-6" ] [
84- map renderActionButton buttons
85- ]
86- ]
87- ]
88-
89- renderActionButton :: Button -> Html Message
90- renderActionButton button = HE .div [ HA .class' " col-sm-6 smallpad" ] [
91- HE .button [
92- HA .class' " btn btn-primary btn-block" ,
93- HA .id button.id,
94- HA .createAttribute " ref" " text" ,
95- HA .onClick button.message
96- ] [ HE .text button.label ]
97- ]
98-
99- buttons :: Array Button
100- buttons = [
101- { id: " run" , label: " Create 1,000 rows" , message: Create 1000 },
102- { id: " runlots" , label: " Create 10,000 rows" , message: Create 10000 },
103- { id: " add" , label: " Append 1,000 rows" , message: AppendOneThousand },
104- { id: " update" , label: " Update every 10th row" , message: UpdateEveryTenth },
105- { id: " clear" , label: " Clear" , message: Clear },
106- { id: " swaprows" , label: " Swap Rows" , message: Swap }
107- ]
108-
109- renderLazyRow :: Row -> Html Message
54+ main ∷ Effect Unit
55+ main = F .mount_ (QuerySelector " body" )
56+ { model: model
57+ , subscribe: []
58+ , view
59+ , update
60+ }
61+
62+ model ∷ Model
63+ model =
64+ { rows: []
65+ , lastID: 0
66+ }
67+
68+ view ∷ Model → Html Message
69+ view model = HE .div [ HA .class' " container" ]
70+ [ jumbotron
71+ , HE .table [ HA .class' " table table-hover table-striped test-data" ]
72+ [ HE .tbody_ (map renderLazyRow model.rows)
73+ ]
74+ , footer
75+ ]
76+
77+ jumbotron ∷ Html Message
78+ jumbotron = HE .div [ HA .class' " jumbotron" ]
79+ [ HE .div [ HA .class' " row" ]
80+ [ HE .div [ HA .class' " col-md-6" ]
81+ [ HE .h1_ [ HE .text " Flame 1.0.0 (keyed)" ]
82+ ]
83+ , HE .div [ HA .class' " col-md-6" ]
84+ [ map renderActionButton buttons
85+ ]
86+ ]
87+ ]
88+
89+ renderActionButton ∷ Button → Html Message
90+ renderActionButton button = HE .div [ HA .class' " col-sm-6 smallpad" ]
91+ [ HE .button
92+ [ HA .class' " btn btn-primary btn-block"
93+ , HA .id button.id
94+ , HA .createAttribute " ref" " text"
95+ , HA .onClick button.message
96+ ]
97+ [ HE .text button.label ]
98+ ]
99+
100+ buttons ∷ Array Button
101+ buttons =
102+ [ { id: " run" , label: " Create 1,000 rows" , message: Create 1000 }
103+ , { id: " runlots" , label: " Create 10,000 rows" , message: Create 10000 }
104+ , { id: " add" , label: " Append 1,000 rows" , message: AppendOneThousand }
105+ , { id: " update" , label: " Update every 10th row" , message: UpdateEveryTenth }
106+ , { id: " clear" , label: " Clear" , message: Clear }
107+ , { id: " swaprows" , label: " Swap Rows" , message: Swap }
108+ ]
109+
110+ renderLazyRow ∷ Row → Html Message
110111renderLazyRow row = HE .lazy (Just (show row.id)) renderRow row
111112
112- renderRow :: Row -> Html Message
113- renderRow row = HE .tr [ HA .class' { " danger" : row.selected }, HA .key (show row.id)] [
114- HE .td colMd1 [ HE .text (show row.id) ],
115- HE .td colMd4 [ HE .a [ HA .onClick (Select row.id) ] [ HE .text row.label ] ],
116- HE .td colMd1 [ HE .a [ HA .onClick (Remove row.id) ] removeIcon ],
117- spacer
118- ]
113+ renderRow ∷ Row → Html Message
114+ renderRow row = HE .tr [ HA .class' { " danger" : row.selected }, HA .key (show row.id) ]
115+ [ HE .td colMd1 [ HE .text (show row.id) ]
116+ , HE .td colMd4 [ HE .a [ HA .onClick (Select row.id) ] [ HE .text row.label ] ]
117+ , HE .td colMd1 [ HE .a [ HA .onClick (Remove row.id) ] removeIcon ]
118+ , spacer
119+ ]
119120
120- removeIcon :: Array (Html Message )
121- removeIcon = [
122- HE .span' [ HA .class' " glyphicon glyphicon-remove" , HA .createAttribute " aria-hidden" " true" ]
123- ]
121+ removeIcon ∷ Array (Html Message )
122+ removeIcon =
123+ [ HE .span' [ HA .class' " glyphicon glyphicon-remove" , HA .createAttribute " aria-hidden" " true" ]
124+ ]
124125
125- colMd1 :: Array (NodeData Message )
126+ colMd1 ∷ Array (NodeData Message )
126127colMd1 = [ HA .class' " col-md-1" ]
127128
128- colMd4 :: Array (NodeData Message )
129+ colMd4 ∷ Array (NodeData Message )
129130colMd4 = [ HA .class' " col-md-4" ]
130131
131- spacer :: Html Message
132+ spacer ∷ Html Message
132133spacer = HE .td' [ HA .class' " col-md-6" ]
133134
134- footer :: Html Message
135+ footer ∷ Html Message
135136footer = HE .span' [ HA .class' " preloadicon glyphicon glyphicon-remove" , HA .createAttribute " aria-hidden" " true" ]
136137
137- update :: Update Model Message
138+ update ∷ Update Model Message
138139update model =
139- case _ of
140- Create amount -> model /\ [map (\rows -> Just (DisplayCreated rows)) (createRandomNRows amount model.lastID)]
141- DisplayCreated rows -> F .noMessages (model { lastID = model.lastID + DA .length rows, rows = rows })
140+ case _ of
141+ Create amount → model /\ [ map (\rows → Just (DisplayCreated rows)) (createRandomNRows amount model.lastID) ]
142+ DisplayCreated rows → F .noMessages (model { lastID = model.lastID + DA .length rows, rows = rows })
142143
143- AppendOneThousand ->
144- let amount = 1000
145- in model /\ [map (\rows -> Just (DisplayAppended rows)) (createRandomNRows amount model.lastID)]
146- DisplayAppended newRows -> F .noMessages (model { lastID = model.lastID + DA .length newRows, rows = model.rows <> newRows })
144+ AppendOneThousand →
145+ let
146+ amount = 1000
147+ in
148+ model /\ [ map (\rows → Just (DisplayAppended rows)) (createRandomNRows amount model.lastID) ]
149+ DisplayAppended newRows → F .noMessages (model { lastID = model.lastID + DA .length newRows, rows = model.rows <> newRows })
147150
148- UpdateEveryTenth -> F .noMessages model { rows = DA .mapWithIndex updateLabel model.rows }
151+ UpdateEveryTenth → F .noMessages model { rows = DA .mapWithIndex updateLabel model.rows }
149152
150- Clear -> F .noMessages (model { rows = [] })
153+ Clear → F .noMessages (model { rows = [] })
151154
152- Swap ->
153- F .noMessages
154- (case swapRows model.rows 1 998 of
155- Nothing -> model
156- Just swappedRows -> model { rows = swappedRows })
155+ Swap →
156+ F .noMessages
157+ ( case swapRows model.rows 1 998 of
158+ Nothing → model
159+ Just swappedRows → model { rows = swappedRows }
160+ )
157161
158- Remove id -> F .noMessages (model { rows = DA .filter (\r -> r.id /= id) model.rows })
162+ Remove id → F .noMessages (model { rows = DA .filter (\r → r.id /= id) model.rows })
159163
160- Select id -> F .noMessages (model { rows = map (select id) model.rows })
164+ Select id → F .noMessages (model { rows = map (select id) model.rows })
161165
162166updateLabel index row =
163- if index `mod` 10 == 0 then
164- row { label = row.label <> " !!!" }
165- else
166- row
167+ if index `mod` 10 == 0 then
168+ row { label = row.label <> " !!!" }
169+ else
170+ row
167171
168172swapRows arr index otherIndex = do
169- rowA <- arr !! index
170- rowB <- arr !! otherIndex
171- arrA <- DA .updateAt index rowB arr
172- arrB <- DA .updateAt otherIndex rowA arrA
173- pure arrB
173+ rowA ← arr !! index
174+ rowB ← arr !! otherIndex
175+ arrA ← DA .updateAt index rowB arr
176+ arrB ← DA .updateAt otherIndex rowA arrA
177+ pure arrB
174178
175179select id row
176- | row.id == id = row { selected = true }
177- | row.selected = row { selected = false }
178- | otherwise = row
180+ | row.id == id = row { selected = true }
181+ | row.selected = row { selected = false }
182+ | otherwise = row
0 commit comments