abb4bc0 · elk · git.iko.soy

git.iko.soy/elk

on master help sign in

Fix up many libraries

abb4bc0Evan Czaplicki13 years ago

libraries/Dict.elm+36−35

compare with master

unifiedsplit

@@ -8,8 +8,9 @@ module Dict (empty,singleton,insert

8 ,toList,fromList

9 ) where

11−import Maybe as Maybe

11+import open Basics

12+import open Maybe

12−import Native.Error as Error

13+import Native.Error

13import List as List

14import List as List

14import Native.Utils (compare)

15import Native.Utils (compare)

@@ -18,7 +19,7 @@ data NColor = Red | Black

18data Dict k v = RBNode NColor k v (Dict k v) (Dict k v) | RBEmpty

19data Dict k v = RBNode NColor k v (Dict k v) (Dict k v) | RBEmpty

20-- Create an empty dictionary.

21-- Create an empty dictionary.

21−empty : Dict (Comparable k) v

22+empty : Dict comparable v

22empty = RBEmpty

23empty = RBEmpty

24{-- Helpers for checking invariants

25{-- Helpers for checking invariants

@@ -104,31 +105,31 @@ min t =

104 case t of

105 case t of

105 RBNode _ k v RBEmpty _ -> (k,v)

106 RBNode _ k v RBEmpty _ -> (k,v)

106 RBNode _ _ _ l _ -> min l

107 RBNode _ _ _ l _ -> min l

107− RBEmpty -> Error.raise "(min Empty) is not defined"

108+ RBEmpty -> Native.Error.raise "(min Empty) is not defined"

108

109

109{--

110{--

110max t =

111max t =

111 case t of

112 case t of

112 { RBNode _ k v _ RBEmpty -> (k,v)

113 { RBNode _ k v _ RBEmpty -> (k,v)

113 ; RBNode _ _ _ _ r -> max r

114 ; RBNode _ _ _ _ r -> max r

114− ; RBEmpty -> Error.raise "(max Empty) is not defined"

115+ ; RBEmpty -> Native.Error.raise "(max Empty) is not defined"

115 }

116 }

116--}

117--}

117

118

118-- Lookup the value associated with a key.

119-- Lookup the value associated with a key.

119−lookup : Comparable k -> Dict (Comparable k) v -> Maybe v

120+lookup : comparable -> Dict comparable v -> Maybe v

120lookup k t =

121lookup k t =

121 case t of

122 case t of

122− RBEmpty -> Maybe.Nothing

123+ RBEmpty -> Nothing

123 RBNode _ k' v l r ->

124 RBNode _ k' v l r ->

124 case compare k k' of

125 case compare k k' of

125 LT -> lookup k l

126 LT -> lookup k l

126− EQ -> Maybe.Just v

127+ EQ -> Just v

127 GT -> lookup k r

128 GT -> lookup k r

128

129

129-- Find the value associated with a key. If the key is not found,

130-- Find the value associated with a key. If the key is not found,

130-- return the default value.

131-- return the default value.

131−findWithDefault : v -> Comparable k -> Dict (Comparable k) v -> v

132+findWithDefault : v -> comparable -> Dict comparable v -> v

132findWithDefault base k t =

133findWithDefault base k t =

133 case t of

134 case t of

134 RBEmpty -> base

135 RBEmpty -> base

@@ -142,7 +143,7 @@ findWithDefault base k t =

142-- Find the value associated with a key. If the key is not found, there will be a runtime error.

143-- Find the value associated with a key. If the key is not found, there will be a runtime error.

143find k t =

144find k t =

144 case t of

145 case t of

145− { RBEmpty -> Error.raise "Key was not found in dictionary!"

146+ { RBEmpty -> Native.Error.raise "Key was not found in dictionary!"

146 ; RBNode _ k' v l r ->

147 ; RBNode _ k' v l r ->

147 case compare k k' of

148 case compare k k' of

148 { LT -> find k l

149 { LT -> find k l

@@ -152,15 +153,15 @@ find k t =

152--}

153--}

153

154

154-- Determine if a key is in a dictionary.

155-- Determine if a key is in a dictionary.

155−member : Comparable k -> Dict (Comparable k) v -> Bool

156+member : comparable -> Dict comparable v -> Bool

156-- Does t contain k?

157-- Does t contain k?

157−member k t = Maybe.isJust $ lookup k t

158+member k t = isJust <| lookup k t

158

159

159rotateLeft : Dict k v -> Dict k v

160rotateLeft : Dict k v -> Dict k v

160rotateLeft t =

161rotateLeft t =

161 case t of

162 case t of

162 RBNode cy ky vy a (RBNode cz kz vz b c) -> RBNode cy kz vz (RBNode Red ky vy a b) c

163 RBNode cy ky vy a (RBNode cz kz vz b c) -> RBNode cy kz vz (RBNode Red ky vy a b) c

163− _ -> Error.raise "rotateLeft of a node without enough children"

164+ _ -> Native.Error.raise "rotateLeft of a node without enough children"

164

165

165-- rotateRight -- the reverse, and

166-- rotateRight -- the reverse, and

166-- makes Y have Z's color, and makes Z Red.

167-- makes Y have Z's color, and makes Z Red.

@@ -168,7 +169,7 @@ rotateRight : Dict k v -> Dict k v

168rotateRight t =

169rotateRight t =

169 case t of

170 case t of

170 RBNode cz kz vz (RBNode cy ky vy a b) c -> RBNode cz ky vy a (RBNode Red kz vz b c)

171 RBNode cz kz vz (RBNode cy ky vy a b) c -> RBNode cz ky vy a (RBNode Red kz vz b c)

171− _ -> Error.raise "rotateRight of a node without enough children"

172+ _ -> Native.Error.raise "rotateRight of a node without enough children"

172

173

173rotateLeftIfNeeded : Dict k v -> Dict k v

174rotateLeftIfNeeded : Dict k v -> Dict k v

174rotateLeftIfNeeded t =

175rotateLeftIfNeeded t =

@@ -191,7 +192,7 @@ color_flip t =

191 RBNode (otherColor c1) bk bv

192 RBNode (otherColor c1) bk bv

192 (RBNode (otherColor c2) ak av la ra)

193 (RBNode (otherColor c2) ak av la ra)

193 (RBNode (otherColor c3) ck cv lc rc)

194 (RBNode (otherColor c3) ck cv lc rc)

194− _ -> Error.raise "color_flip called on a Empty or Node with a Empty child"

195+ _ -> Native.Error.raise "color_flip called on a Empty or Node with a Empty child"

195

196

196color_flipIfNeeded : Dict k v -> Dict k v

197color_flipIfNeeded : Dict k v -> Dict k v

197color_flipIfNeeded t =

198color_flipIfNeeded t =

@@ -209,7 +210,7 @@ ensureBlackRoot t =

209

210

210-- Insert a key-value pair into a dictionary. Replaces value when there is

211-- Insert a key-value pair into a dictionary. Replaces value when there is

211-- a collision.

212-- a collision.

212−insert : Comparable k -> v -> Dict (Comparable k) v -> Dict (Comparable k) v

213+insert : comparable -> v -> Dict comparable v -> Dict comparable v

213insert k v t = -- Invariant: t is a valid left-leaning rb tree

214insert k v t = -- Invariant: t is a valid left-leaning rb tree

214 let ins t =

215 let ins t =

215 case t of

216 case t of

@@ -223,15 +224,15 @@ insert k v t = -- Invariant: t is a valid left-leaning rb tree

223 in ensureBlackRoot (ins t)

224 in ensureBlackRoot (ins t)

224{--

225{--

225 if not (invariants_hold t) then

226 if not (invariants_hold t) then

226− Error.raise "invariants broken before insert"

227+ Native.Error.raise "invariants broken before insert"

227 else (let new_t = ensureBlackRoot (ins t) in

228 else (let new_t = ensureBlackRoot (ins t) in

228 if not (invariants_hold new_t) then

229 if not (invariants_hold new_t) then

229− Error.raise "invariants broken after insert"

230+ Native.Error.raise "invariants broken after insert"

230 else new_t)

231 else new_t)

231--}

232--}

232

233

233-- Create a dictionary with one key-value pair.

234-- Create a dictionary with one key-value pair.

234−singleton : Comparable k -> v -> Dict (Comparable k) v

235+singleton : comparable -> v -> Dict comparable v

235singleton k v = insert k v RBEmpty

236singleton k v = insert k v RBEmpty

236

237

237isRed : Dict k v -> Bool

238isRed : Dict k v -> Bool

@@ -313,21 +314,21 @@ deleteMax t =

313

314

314-- Remove a key-value pair from a dictionary. If the key is not found,

315-- Remove a key-value pair from a dictionary. If the key is not found,

315-- no changes are made.

316-- no changes are made.

316−remove : Comparable k -> Dict (Comparable k) v -> Dict (Comparable k) v

317+remove : comparable -> Dict comparable v -> Dict comparable v

317remove k t =

318remove k t =

318 let eq_and_noRightNode t =

319 let eq_and_noRightNode t =

319 case t of { RBNode _ k' _ _ RBEmpty -> k == k' ; _ -> False }

320 case t of { RBNode _ k' _ _ RBEmpty -> k == k' ; _ -> False }

320 eq t = case t of { RBNode _ k' _ _ _ -> k == k' ; _ -> False }

321 eq t = case t of { RBNode _ k' _ _ _ -> k == k' ; _ -> False }

321 delLT t = case moveRedLeftIfNeeded t of

322 delLT t = case moveRedLeftIfNeeded t of

322 RBNode c k' v l r -> fixUp (RBNode c k' v (del l) r)

323 RBNode c k' v l r -> fixUp (RBNode c k' v (del l) r)

323− RBEmpty -> Error.raise "delLT on Empty"

324+ RBEmpty -> Native.Error.raise "delLT on Empty"

324 delEQ t = case t of -- Replace with successor

325 delEQ t = case t of -- Replace with successor

325 RBNode c _ _ l r -> let (k',v') = min r in

326 RBNode c _ _ l r -> let (k',v') = min r in

326 fixUp (RBNode c k' v' l (deleteMin r))

327 fixUp (RBNode c k' v' l (deleteMin r))

327− RBEmpty -> Error.raise "delEQ called on a Empty"

328+ RBEmpty -> Native.Error.raise "delEQ called on a Empty"

328 delGT t = case t of

329 delGT t = case t of

329 RBNode c k' v l r -> fixUp (RBNode c k' v l (del r))

330 RBNode c k' v l r -> fixUp (RBNode c k' v l (del r))

330− RBEmpty -> Error.raise "delGT called on a Empty"

331+ RBEmpty -> Native.Error.raise "delGT called on a Empty"

331 del t = case t of

332 del t = case t of

332 RBEmpty -> RBEmpty

333 RBEmpty -> RBEmpty

333 RBNode _ k' _ _ _ ->

334 RBNode _ k' _ _ _ ->

@@ -339,14 +340,14 @@ remove k t =

339 in if member k t then ensureBlackRoot (del t) else t

340 in if member k t then ensureBlackRoot (del t) else t

340{--

341{--

341 if not (invariants_hold t) then

342 if not (invariants_hold t) then

342− Error.raise "invariants broken before remove"

343+ Native.Error.raise "invariants broken before remove"

343 else (let t' = ensureBlackRoot (del t) in

344 else (let t' = ensureBlackRoot (del t) in

344 if invariants_hold t' then t' else

345 if invariants_hold t' then t' else

345− Error.raise "invariants broken after remove")

346+ Native.Error.raise "invariants broken after remove")

346--}

347--}

347

348

348-- Apply a function to all values in a dictionary.

349-- Apply a function to all values in a dictionary.

349−map : (a -> b) -> Dict (Comparable k) a -> Dict (Comparable k) b

350+map : (a -> b) -> Dict comparable a -> Dict comparable b

350map f t =

351map f t =

351 case t of

352 case t of

352 RBEmpty -> RBEmpty

353 RBEmpty -> RBEmpty

@@ -354,7 +355,7 @@ map f t =

354

355

355-- Fold over the key-value pairs in a dictionary, in order from lowest

356-- Fold over the key-value pairs in a dictionary, in order from lowest

356-- key to highest key.

357-- key to highest key.

357−foldl : (Comparable k -> v -> b -> b) -> b -> Dict (Comparable k) v -> b

358+foldl : (comparable -> v -> b -> b) -> b -> Dict comparable v -> b

358foldl f acc t =

359foldl f acc t =

359 case t of

360 case t of

360 RBEmpty -> acc

361 RBEmpty -> acc

@@ -362,7 +363,7 @@ foldl f acc t =

362

363

363-- Fold over the key-value pairs in a dictionary, in order from highest

364-- Fold over the key-value pairs in a dictionary, in order from highest

364-- key to lowest key.

365-- key to lowest key.

365−foldr : (Comparable k -> v -> b -> b) -> b -> Dict (Comparable k) v -> b

366+foldr : (comparable -> v -> b -> b) -> b -> Dict comparable v -> b

366foldr f acc t =

367foldr f acc t =

367 case t of

368 case t of

368 RBEmpty -> acc

369 RBEmpty -> acc

@@ -370,33 +371,33 @@ foldr f acc t =

370

371

371-- Combine two dictionaries. If there is a collision, preference is given

372-- Combine two dictionaries. If there is a collision, preference is given

372-- to the first dictionary.

373-- to the first dictionary.

373−union : Dict (Comparable k) v -> Dict (Comparable k) v -> Dict (Comparable k) v

374+union : Dict comparable v -> Dict comparable v -> Dict comparable v

374union t1 t2 = foldl insert t2 t1

375union t1 t2 = foldl insert t2 t1

375

376

376-- Keep a key-value pair when its key appears in the second dictionary.

377-- Keep a key-value pair when its key appears in the second dictionary.

377-- Preference is given to values in the first dictionary.

378-- Preference is given to values in the first dictionary.

378−intersect : Dict (Comparable k) v -> Dict (Comparable k) v -> Dict (Comparable k) v

379+intersect : Dict comparable v -> Dict comparable v -> Dict comparable v

379intersect t1 t2 =

380intersect t1 t2 =

380 let combine k v t = if k `member` t2 then insert k v t else t

381 let combine k v t = if k `member` t2 then insert k v t else t

381 in foldl combine empty t1

382 in foldl combine empty t1

382

383

383-- Keep a key-value pair when its key does not appear in the second dictionary.

384-- Keep a key-value pair when its key does not appear in the second dictionary.

384-- Preference is given to the first dictionary.

385-- Preference is given to the first dictionary.

385−diff : Dict (Comparable k) v -> Dict (Comparable k) v -> Dict (Comparable k) v

386+diff : Dict comparable v -> Dict comparable v -> Dict comparable v

386diff t1 t2 = foldl (\k v t -> remove k t) t1 t2

387diff t1 t2 = foldl (\k v t -> remove k t) t1 t2

387

388

388-- Get all of the keys in a dictionary.

389-- Get all of the keys in a dictionary.

389−keys : Dict (Comparable k) v -> [Comparable k]

390+keys : Dict comparable v -> [comparable]

390keys t = foldr (\k v acc -> k :: acc) [] t

391keys t = foldr (\k v acc -> k :: acc) [] t

391

392

392-- Get all of the values in a dictionary.

393-- Get all of the values in a dictionary.

393−values : Dict (Comparable k) v -> [v]

394+values : Dict comparable v -> [v]

394values t = foldr (\k v acc -> v :: acc) [] t

395values t = foldr (\k v acc -> v :: acc) [] t

395

396

396-- Convert a dictionary into an association list of key-value pairs.

397-- Convert a dictionary into an association list of key-value pairs.

397−toList : Dict (Comparable k) v -> [(Comparable k,v)]

398+toList : Dict comparable v -> [(comparable,v)]

398toList t = foldr (\k v acc -> (k,v) :: acc) [] t

399toList t = foldr (\k v acc -> (k,v) :: acc) [] t

399

400

400-- Convert an association list into a dictionary.

401-- Convert an association list into a dictionary.

401−fromList : [(Comparable k,v)] -> Dict (Comparable k) v

402+fromList : [(comparable,v)] -> Dict comparable v

402fromList assocs = List.foldl (\(k,v) d -> insert k v d) empty assocs

403fromList assocs = List.foldl (\(k,v) d -> insert k v d) empty assocs

libraries/JavaScript.elm+1

@@ -8,6 +8,7 @@ data JSBool = JSBool

8data JSString = JSString

9data JSArray a = JSArray a

10data JSDomNode = JSDomNode

11+data JSObject = JSObject

12-- Requires that the input array be uniform (all members have the same type)

13-- Requires that the input array be uniform (all members have the same type)

13toList : JSArray a -> [a]

14toList : JSArray a -> [a]

libraries/Json.elm+7

@@ -3,9 +3,12 @@

4module Json where

6+import Dict (Dict)

6import Dict as Dict

7import Dict as Dict

8+import Maybe (Maybe)

7import JavaScript as JS

9import JavaScript as JS

8import Native.Json as Native

10import Native.Json as Native

11+import JavaScript (JSObject, JSString)

10-- This datatype can represent all valid values that can be held in a JSON

13-- This datatype can represent all valid values that can be held in a JSON

11-- object. In Elm, a proper JSON object is represented as a (Dict String JsonValue)

14-- object. In Elm, a proper JSON object is represented as a (Dict String JsonValue)

@@ -31,6 +34,7 @@ toString sep v = JS.toString (Native.toJSString sep v)

31-- Note that the type JSString seen here is not the same as the type constructor

34-- Note that the type JSString seen here is not the same as the type constructor

32-- JsonString used elsewhere in this module.

35-- JsonString used elsewhere in this module.

33toJSString : String -> JsonValue -> JSString

36toJSString : String -> JsonValue -> JSString

37+toJSString = Native.toJSString

35-- Parse a string representation of a proper JSON object into

39-- Parse a string representation of a proper JSON object into

36-- its Elm representation.

40-- its Elm representation.

@@ -40,9 +44,11 @@ fromString s = Native.fromJSString (JS.fromString s)

40-- Parse a JavaScript string representation of a proper JSON object into

44-- Parse a JavaScript string representation of a proper JSON object into

41-- its Elm representation.

45-- its Elm representation.

42fromJSString : JSString -> Maybe JsonValue

46fromJSString : JSString -> Maybe JsonValue

47+fromJSString = Native.fromJSString

44-- Convert a JS object into a `JsonValue`.

49-- Convert a JS object into a `JsonValue`.

45fromJSObject : JSObject -> JsonValue

50fromJSObject : JSObject -> JsonValue

51+fromJSObject = Native.fromJSObject

47-- Convert a `JsonValue` into a `JSObject`. Paired with the

53-- Convert a `JsonValue` into a `JSObject`. Paired with the

48-- [`JavaScript.Experimental` library](/docs/JavaScript/Experimental.elm),

54-- [`JavaScript.Experimental` library](/docs/JavaScript/Experimental.elm),

@@ -55,6 +61,7 @@ fromJSObject : JSObject -> JsonValue

55-- Just jsonValue -> Just (JS.toRecord (toJSObject jsonValue))

61-- Just jsonValue -> Just (JS.toRecord (toJSObject jsonValue))

56-- Nothing -> Nothing

62-- Nothing -> Nothing

57toJSObject : JsonValue -> JSObject

63toJSObject : JsonValue -> JSObject

64+toJSObject = Native.toJSObject

59 {-- Extract Elm values from Json values

66 {-- Extract Elm values from Json values

libraries/Keyboard.elm+11−7

@@ -1,6 +1,6 @@

1module Keyboard where

3−import Native.Keyboard as N

3+import Native.Keyboard as Native

5-- Type alias to make it clearer what integers are supposed to represent

6-- in this library. Use [`Char.toCode`](docs/Char.elm#toCode) and

@@ -14,39 +14,43 @@ type KeyCode = Int

14-- `{ x = 1, y = 1 }` when pressing the up and right arrows.<br>

15-- `{ x = 0, y =-1 }` when pressing the down, left, and right arrows.

16arrows : Signal { x:Int, y:Int }

17−arrows = N.directions 38 40 37 39

17+arrows = Native.directions 38 40 37 39

19-- Just like the arrows signal, but this uses keys w, a, s, and d,

20-- which are common controls for many computer games.

21wasd : Signal { x:Int, y:Int }

22−wasd = N.directions 87 83 65 68

22+wasd = Native.directions 87 83 65 68

24-- Custom key directions so that you can support different locales.

25-- The plan is to have a locale independent version of this function

26-- that uses the physical location of keys, but I don't know how to do it.

27directions : KeyCode -> KeyCode -> KeyCode -> KeyCode -> Signal { x:Int, y:Int }

28+directions = Native.directions

29-- Whether an arbitrary key is pressed.

30-- Whether an arbitrary key is pressed.

30isDown : KeyCode -> Signal Bool

31isDown : KeyCode -> Signal Bool

32+isDown = Native.isDown

32-- Whether the shift key is pressed.

34-- Whether the shift key is pressed.

33shift : Signal Bool

35shift : Signal Bool

34−shift = N.isDown 16

36+shift = Native.isDown 16

36-- Whether the control key is pressed.

38-- Whether the control key is pressed.

37ctrl : Signal Bool

39ctrl : Signal Bool

38−ctrl = N.isDown 17

40+ctrl = Native.isDown 17

40-- Whether the space key is pressed.

42-- Whether the space key is pressed.

41space : Signal Bool

43space : Signal Bool

42−space = N.isDown 32

44+space = Native.isDown 32

44-- Whether the enter key is pressed.

46-- Whether the enter key is pressed.

45enter : Signal Bool

47enter : Signal Bool

46−enter = N.isDown 13

48+enter = Native.isDown 13

48-- List of keys that are currently down.

50-- List of keys that are currently down.

49keysDown : Signal [KeyCode]

51keysDown : Signal [KeyCode]

52+keysDown = Native.keysDown

51-- The latest key that has been pressed.

54-- The latest key that has been pressed.

52lastPressed : Signal KeyCode

55lastPressed : Signal KeyCode

56+lastPressed = Native.lastPressed

libraries/Random.elm+3−1

@@ -1,13 +1,15 @@

2module Random where

4−import Native.Random as R

4+import Native.Random as Native

6-- Given a range from low to high and a signal of values, this produces

7-- a new signal that changes whenever the input signal changes. The new

8-- values are random number between 'low' and 'high' inclusive.

9range : Int -> Int -> Signal a -> Signal Int

10+range = Native.range

11-- Produces a new signal that changes whenever the input signal changes.

12-- Produces a new signal that changes whenever the input signal changes.

12-- The new values are random numbers in [0..1).

13-- The new values are random numbers in [0..1).

13float : Signal a -> Signal Float

14float : Signal a -> Signal Float

15+float = Native.float