Skip to content

Commit 85a0222

Browse files
krausestkrausest
committed
Merge branch 'dmjio-miso-1.3'
2 parents ed8d9a8 + 42e165a commit 85a0222

File tree

9 files changed

+1899
-1846
lines changed

9 files changed

+1899
-1846
lines changed

‎frameworks/keyed/miso/default.nix

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
with (import (builtins.fetchTarball {
2-
url = "https://github.com/dmjio/miso/archive/5647cfd.tar.gz";
3-
sha256 = "177d99m4q4ab35xr0kdpczxncbx187bwk54z7cr3khp5w9gcq27g";
2+
url = "https://github.com/dmjio/miso/archive/485b91f.tar.gz";
3+
sha256 = "1kfr1f6bwfqnvxlfzf1vv0v07xrlg8ashjiasrps85l1dmja6s4b";
44
}) {});
55
with pkgs.haskell.packages;
66
let

‎frameworks/keyed/miso/dist-bundle/all.min.js

Lines changed: 849 additions & 843 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎frameworks/keyed/miso/dist-bundle/index.html

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,9 @@
44
<meta charset="utf-8" />
55
<title>Miso v1.1.0.0</title>
66
<link href="/css/currentStyle.css" rel="stylesheet"/>
7+
<script>
8+
window.saveGCFromClosureOverwriting = window['gc'];
9+
</script>
710
</head>
811
<body>
912
<script src="all.min.js"></script>

‎frameworks/keyed/miso/src/Main.hs

Lines changed: 95 additions & 77 deletions
Original file line numberDiff line numberDiff line change
@@ -1,39 +1,45 @@
1-
{-# LANGUAGE ScopedTypeVariables #-}
2-
{-# LANGUAGE BangPatterns #-}
1+
{-# LANGUAGE RecordWildCards #-}
2+
{-# LANGUAGE ScopedTypeVariables #-}
3+
{-# LANGUAGE BangPatterns #-}
34
{-# LANGUAGE OverloadedStrings #-}
4-
{-# LANGUAGE ExtendedDefaultRules #-}
5+
{-# LANGUAGE ExtendedDefaultRules #-}
56

67
module Main where
78

8-
import Data.Monoid ((<>))
9+
import Data.Monoid ((<>))
10+
11+
import Control.Arrow
12+
import Data.IntMap.Strict (IntMap)
13+
import qualified Data.IntMap.Strict as IM
14+
import qualified Data.Map as M
15+
import qualified Data.Vector as V
916

10-
import qualified Data.Map as M
11-
import qualified Data.Vector as V
12-
import qualified Data.Vector.Mutable as MV
1317
import Miso
14-
import Miso.String (MisoString)
15-
import qualified Miso.String as S
18+
import Miso.String (MisoString)
19+
import qualified Miso.String as S
1620
import System.Random
1721

1822
data Row = Row
19-
{ rowIdx :: !Int
23+
{ rowIdx :: !Int
2024
, rowTitle :: !MisoString
2125
} deriving (Eq)
2226

2327
data Model = Model
24-
{ rows :: !(V.Vector Row)
28+
{ rows :: !(IM.IntMap Row)
2529
, selectedId :: !(Maybe Int)
26-
, lastId :: !Int
30+
, lastId :: !Int
31+
, seed :: !StdGen
2732
} deriving (Eq)
2833

34+
instance Eq StdGen where _ == _ = True
35+
2936
data Action = Create !Int
3037
| Append !Int
3138
| Update !Int
3239
| Remove !Int
3340
| Clear
3441
| Swap
3542
| Select !Int
36-
| ChangeModel !Model
3743
| NoOp
3844

3945
adjectives :: V.Vector MisoString
@@ -95,84 +101,96 @@ nouns = V.fromList [ "table"
95101
]
96102

97103
main :: IO ()
98-
main = startApp App
99-
{ initialAction = NoOp
100-
, model = initialModel
101-
, update = updateModel
102-
, view = viewModel
103-
, events = M.singleton "click" True
104-
, subs = []
105-
, mountPoint = Nothing
106-
}
104+
main = do
105+
seed <- newStdGen
106+
startApp App
107+
{ initialAction = NoOp
108+
, model = initialModel seed
109+
, update = updateModel
110+
, view = viewModel
111+
, events = M.singleton "click" True
112+
, subs = []
113+
, mountPoint = Nothing
114+
}
107115

108-
initialModel :: Model
109-
initialModel = Model
110-
{ rows = V.empty
116+
initialModel :: StdGen -> Model
117+
initialModel seed = Model
118+
{ rows = mempty
111119
, selectedId = Nothing
112-
, lastId = 1
120+
, lastId = 0
121+
, seed = seed
113122
}
114123

115-
updateModel :: Action -> Model -> Effect Action Model
124+
createRows :: Int -> Int -> StdGen -> (StdGen, IntMap Row)
125+
createRows n lastIdx seed = go seed mempty [0..n]
126+
where
127+
go seed intMap [] = (seed, intMap)
128+
go s0 intMap (x:xs) = do
129+
let (adjIdx, s1) = randomR (0, V.length adjectives - 1) s0
130+
(colorIdx, s2) = randomR (0, V.length colours - 1) s1
131+
(nounIdx, s3) = randomR (0, V.length nouns - 1) s2
132+
title = S.intercalate " "
133+
[ adjectives V.! adjIdx
134+
, colours V.! colorIdx
135+
, nouns V.! nounIdx
136+
]
137+
go s3 (IM.insert (x + lastIdx) (Row (x + lastIdx) title) intMap) xs
116138

117-
updateModel (ChangeModel newModel) _ = noEff newModel
139+
updateModel :: Action -> Model -> Effect Action Model
140+
updateModel (Create n) model@Model{..} = noEff $
141+
let
142+
(newSeed, intMap) = createRows n lastId seed
143+
in
144+
model { lastId = lastId + n
145+
, rows = intMap
146+
, seed = newSeed
147+
}
118148

119-
updateModel (Create n) model@Model{lastId=lastIdx} =
120-
model <# do
121-
newRows <- generateRows n lastIdx
122-
pure $ ChangeModel model { rows = newRows
123-
, lastId = lastIdx + n
124-
}
149+
updateModel (Append n) model@Model{..} = noEff $ do
150+
let
151+
(newSeed, newRows) = createRows n lastId seed
152+
in
153+
model { lastId = lastId + n
154+
, rows = rows <> newRows
155+
, seed = newSeed
156+
}
125157

126-
updateModel (Append n) model@Model{rows=existingRows, lastId=lastIdx} =
127-
model <# do
128-
newRows <- generateRows n (lastId model)
129-
pure $ ChangeModel model { rows=existingRows V.++ newRows
130-
, lastId=lastIdx + n
131-
}
158+
updateModel Clear model = noEff model { rows = mempty }
132159

133-
updateModel Clear model = noEff model{ rows= V.empty }
160+
updateModel (Update n) model@Model{..} = noEff $
161+
let
162+
newRows =
163+
flip IM.mapWithKey rows $ \i row ->
164+
if i `mod` n == 0
165+
then row { rowTitle = rowTitle row <> " !!!" }
166+
else row
167+
in
168+
model { rows = newRows }
134169

135-
updateModel (Update n) model =
136-
noEff model{ rows = updatedRows }
170+
updateModel Swap model = noEff newModel
137171
where
138-
updatedRows = V.imap updateR (rows model)
139-
updateR i row = if mod i 10 == 0
140-
then row{ rowTitle = rowTitle row <> " !!!" }
141-
else row
172+
len = IM.size (rows model)
173+
newModel =
174+
if len > 998
175+
then model { rows = swappedRows }
176+
else model
177+
swappedRows =
178+
case fst $ IM.findMin (rows model) of
179+
minKey ->
180+
let
181+
x = rows model IM.! (minKey + 1)
182+
y = rows model IM.! (minKey + 998)
183+
in
184+
IM.insert (minKey + 1) y (IM.insert (minKey + 998) x (rows model))
142185

143-
updateModel Swap model =
144-
noEff newModel
145-
where
146-
currentRows = rows model
147-
from = V.indexed
148-
newModel = if V.length currentRows > 998
149-
then model { rows = swappedRows }
150-
else model
151-
swappedRows = V.modify (\v -> MV.swap v 1 998) currentRows
152186

153-
updateModel (Select idx) model = noEff model{selectedId=Just idx}
187+
updateModel (Select idx) model = noEff model { selectedId = Just idx }
154188

155-
updateModel (Remove idx) model@Model{rows=currentRows} =
156-
noEff model { rows = firstPart V.++ V.drop 1 remainingPart }
157-
where
158-
(firstPart, remainingPart) = V.splitAt idx currentRows
189+
updateModel (Remove idx) model@Model{ rows = currentRows } =
190+
noEff model { rows = IM.delete idx currentRows }
159191

160192
updateModel NoOp model = noEff model
161193

162-
generateRows :: Int -> Int -> IO (V.Vector Row)
163-
generateRows n lastIdx = V.generateM n $ \x -> do
164-
adjIdx <- randomRIO (0, V.length adjectives - 1)
165-
colorIdx <- randomRIO (0, V.length colours - 1)
166-
nounIdx <- randomRIO (0, V.length nouns - 1)
167-
pure Row
168-
{ rowIdx=lastIdx + x
169-
, rowTitle= (adjectives V.! adjIdx)
170-
<> S.pack " "
171-
<> (colours V.! colorIdx)
172-
<> S.pack " "
173-
<> (nouns V.! nounIdx)
174-
}
175-
176194
viewModel :: Model -> View Action
177195
viewModel m = div_ [id_ "main"]
178196
[ div_
@@ -190,15 +208,15 @@ viewTable m@Model{selectedId=idx} =
190208
[
191209
tbody_
192210
[id_ "tbody"]
193-
(V.toList $ V.imap viewRow (rows m))
211+
(IM.elems $ IM.mapWithKey viewRow (rows m))
194212
]
195213
where
196214
viewRow i r@Row{rowIdx=rId} =
197215
trKeyed_ (toKey rId)
198216
(conditionalDanger i)
199217
[ td_
200218
[ class_ "col-md-1" ]
201-
[ text (S.ms rId) ]
219+
[ text (S.ms (rId + 1)) ]
202220
, td_
203221
[ class_ "col-md-4" ]
204222
[ a_ [class_ "lbl", onClick (Select i)] [text (rowTitle r)]

‎frameworks/non-keyed/miso/default.nix

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
with (import (builtins.fetchTarball {
2-
url = "https://github.com/dmjio/miso/archive/5647cfd.tar.gz";
3-
sha256 = "177d99m4q4ab35xr0kdpczxncbx187bwk54z7cr3khp5w9gcq27g";
2+
url = "https://github.com/dmjio/miso/archive/485b91f.tar.gz";
3+
sha256 = "1kfr1f6bwfqnvxlfzf1vv0v07xrlg8ashjiasrps85l1dmja6s4b";
44
}) {});
55
with pkgs.haskell.packages;
66
let

0 commit comments

Comments
 (0)