a1b890a · elk · git.iko.soy

Build.hs+10−9

compare with master

unifiedsplit

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

1-- This file compiles all library and runtime code

2−-- into elm-runtime.js. Run it with following command:

2+-- into compiler/elm-runtime.js. It then rebuilds the compiler.

3−--

4−-- runHaskell Build.hs

3+-- Run it with the command "runHaskell Build.hs".

5−--

6−-- Note: This does NOT compile the compiler! Run `cabal install`

7−-- from the compiler/ directory to do that.

8

4

9import System.Cmd

5import System.Cmd

10import System.Directory

6import System.Directory

@@ -13,6 +9,8 @@ import System.FilePath

13import System.IO

9import System.IO

14import Language.Elm

10import Language.Elm

15

11

12+rts = "compiler" </> "elm-runtime.js"

13+

16getFiles ext dir = do

14getFiles ext dir = do

17 contents <- map (dir </>) `fmap` getDirectoryContents dir

15 contents <- map (dir </>) `fmap` getDirectoryContents dir

18 let files = filter (\f -> takeExtension f == ext) contents

16 let files = filter (\f -> takeExtension f == ext) contents

@@ -24,7 +22,7 @@ appendJS file = do

24 putStrLn (dropExtension file)

22 putStrLn (dropExtension file)

25 str <- readFile file

23 str <- readFile file

26 length str `seq` return ()

24 length str `seq` return ()

27− appendFile "elm-runtime.js" str

25+ appendFile rts str

28

26

29appendElm file = do

27appendElm file = do

30 system ("elm --only-js " ++ file)

28 system ("elm --only-js " ++ file)

@@ -33,9 +31,12 @@ appendElm file = do

33 removeFile jsFile

31 removeFile jsFile

34

32

35main = do

33main = do

36− writeFile "elm-runtime.js" "Elm = {}; Elm.Native = {}; Elm.Native.Graphics = {}; Elm.Graphics = {};\n"

34+ writeFile rts "Elm = {}; Elm.Native = {}; Elm.Native.Graphics = {}; Elm.Graphics = {};\n"

37 mapM_ appendJS =<< getFiles ".js" "libraries"

35 mapM_ appendJS =<< getFiles ".js" "libraries"

38 mapM_ appendElm =<< getFiles ".elm" "libraries"

36 mapM_ appendElm =<< getFiles ".elm" "libraries"

39 mapM_ appendJS =<< getFiles ".js" "runtime"

37 mapM_ appendJS =<< getFiles ".js" "runtime"

38+ putStrLn "\n+------------------------------------------+\

40− putStrLn "Success building runtime and libraries!"

39+ \\n| Success building runtime and libraries! |\

40+ \\n+------------------------------------------+\n"

41+ system ("cabal install compiler" </> "Elm.cabal")

41 exitSuccess

42 exitSuccess

compiler/Elm.cabal+2−2

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

1

2Name: Elm

3−Version: 0.7.2

3+Version: 0.8

4Synopsis: The Elm language module.

5Description: Elm aims to make client-side web-development more pleasant.

6 It is a statically/strongly typed, functional reactive

@@ -22,7 +22,7 @@ Category: Compiler, Language

22Build-type: Simple

23

24Extra-source-files: changelog.txt

25−Data-files: elm-runtime-0.7.2.js

25+Data-files: elm-runtime.js

26Cabal-version: >=1.8

27

28source-repository head

compiler/src/Compiler.hs+1−1

@@ -47,7 +47,7 @@ elm = ELM { make = False &= help "automatically compile dependencies."

47

48main = do

49 args <- cmdArgs elm

50− mini <- getDataFileName ("elm-runtime-" ++ showVersion version ++ ".js")

50+ mini <- getDataFileName "elm-runtime.js"

51 compileArgs mini args

52

53compileArgs mini (ELM _ [] _ _ _ _ _ _ _) =

compiler/src/Gen/CompileToJS.hs+14−21

@@ -28,7 +28,7 @@ indent = concatMap f

28

29internalImports =

30 [ ("N" , "Elm.Native"),

31− ("_" , "N.Utils(elm)"),

31+ ("_N", "N.Utils(elm)"),

32 ("_L", "N.List(elm)"),

33 ("_E", "N.Error(elm)"),

34 ("_str", "N.JavaScript(elm).toString")

@@ -53,7 +53,7 @@ globalAssign n e = "\n" ++ assign' n e ++ ";"

53assign' n e = n ++ " = " ++ e

54

55jsModule (Module names exports imports stmts) =

56− setup ++ globalAssign ("Elm." ++ modName) (jsFunc "elm" program)

56+ setup ("Elm":modNames) ++ globalAssign ("Elm." ++ modName) (jsFunc "elm" program)

57 where

58 modNames = if null names then ["Main"] else names

59 modName = intercalate "." modNames

@@ -61,12 +61,12 @@ jsModule (Module names exports imports stmts) =

61 body = stmtsToJS stmts

62 defs = assign "$op" "{}"

63 program = "\nvar " ++ usefulFuncs ++ ";" ++ defs ++ includes ++ body ++

64+ setup ("elm":"Native":modNames) ++

64− "\n_ = " ++ "elm.Native." ++ modName ++ " || {};" ++

65+ assign "_" ("elm.Native." ++ modName ++ " || {}") ++

65− getExports exports stmts ++

66+ getExports exports stmts ++ setup ("elm":modNames) ++

66 ret (assign' ("elm." ++ modName) "_") ++ "\n"

67 ret (assign' ("elm." ++ modName) "_") ++ "\n"

67− setup = concatMap (\n -> globalAssign n $ n ++ " || {}") .

68+ setup modNames = concatMap (\n -> globalAssign n $ n ++ " || {}") .

68− map (intercalate ".") . tail . inits $

69+ map (intercalate ".") . tail . inits $ init modNames

69− take (length modNames - 1) modNames

70 usefulFuncs = intercalate ", " (map (uncurry assign') internalImports)

71

72getExports names stmts = "\n"++ intercalate ";\n" (op : map fnPair fns)

@@ -157,14 +157,7 @@ instance ToJS Statement where

157 , "e.value = v;"

158 , "document.dispatchEvent(e); return v; })(", elm, ");" ]

159 TypeAnnotation _ _ -> return ""

160− TypeAlias n _ t ->

160+ TypeAlias n _ t -> return ""

161− case t of

162− RecordT kvs _ -> return $ "\nfunction" ++ args ++ brackets body

163− where fs = Map.keys kvs

164− args = parens (intercalate "," fs)

165− body = ret . brackets . intercalate "," $

166− map (\k -> k ++ ":" ++ k) fs

167− _ -> return ""

168

161

169toJS' :: CExpr -> GuidCounter String

162toJS' :: CExpr -> GuidCounter String

170toJS' (C txt span expr) =

163toJS' (C txt span expr) =

@@ -173,9 +166,9 @@ toJS' (C txt span expr) =

173 Case e cases -> caseToJS span e cases

166 Case e cases -> caseToJS span e cases

174 _ -> toJS expr

167 _ -> toJS expr

175

168

176−remove x e = "_.remove('" ++ x ++ "', " ++ e ++ ")"

169+remove x e = "_N.remove('" ++ x ++ "', " ++ e ++ ")"

177−addField x v e = "_.insert('" ++ x ++ "', " ++ v ++ ", " ++ e ++ ")"

170+addField x v e = "_N.insert('" ++ x ++ "', " ++ v ++ ", " ++ e ++ ")"

178−setField fs e = "_.replace(" ++ jsList (map f fs) ++ ", " ++ e ++ ")"

171+setField fs e = "_N.replace(" ++ jsList (map f fs) ++ ", " ++ e ++ ")"

179 where f (x,v) = "['" ++ x ++ "'," ++ v ++ "]"

172 where f (x,v) = "['" ++ x ++ "'," ++ v ++ "]"

180access x e = parens e ++ "." ++ x

173access x e = parens e ++ "." ++ x

181makeRecord kvs = record `liftM` collect kvs

174makeRecord kvs = record `liftM` collect kvs

@@ -305,7 +298,7 @@ clauseToJS span var (Clause name vars e) = do

305jsNil = "_L.Nil"

298jsNil = "_L.Nil"

306jsCons e1 e2 = "_L.Cons(" ++ e1 ++ "," ++ e2 ++ ")"

299jsCons e1 e2 = "_L.Cons(" ++ e1 ++ "," ++ e2 ++ ")"

307jsRange e1 e2 = "_L.range" ++ parens (e1 ++ "," ++ e2)

300jsRange e1 e2 = "_L.range" ++ parens (e1 ++ "," ++ e2)

308−jsCompare e1 e2 op = parens ("_.compare(" ++ e1 ++ "," ++ e2 ++ ").ctor" ++ op)

301+jsCompare e1 e2 op = parens ("_N.compare(" ++ e1 ++ "," ++ e2 ++ ").ctor" ++ op)

309

302

310binop (o:p) e1 e2

303binop (o:p) e1 e2

311 | isAlpha o || '_' == o = (o:p) ++ parens e1 ++ parens e2

304 | isAlpha o || '_' == o = (o:p) ++ parens e1 ++ parens e2

@@ -317,8 +310,8 @@ binop (o:p) e1 e2

317 "$" -> e1 ++ parens e2

310 "$" -> e1 ++ parens e2

318 "." -> jsFunc "x" . ret $ e1 ++ parens (e2 ++ parens "x")

311 "." -> jsFunc "x" . ret $ e1 ++ parens (e2 ++ parens "x")

319 "^" -> "Math.pow(" ++ e1 ++ "," ++ e2 ++ ")"

312 "^" -> "Math.pow(" ++ e1 ++ "," ++ e2 ++ ")"

320− "==" -> "_.eq(" ++ e1 ++ "," ++ e2 ++ ")"

313+ "==" -> "_N.eq(" ++ e1 ++ "," ++ e2 ++ ")"

321− "/=" -> "!_.eq(" ++ e1 ++ "," ++ e2 ++ ")"

314+ "/=" -> "!_N.eq(" ++ e1 ++ "," ++ e2 ++ ")"

322 "<" -> jsCompare e1 e2 "==='LT'"

315 "<" -> jsCompare e1 e2 "==='LT'"

323 ">" -> jsCompare e1 e2 "==='GT'"

316 ">" -> jsCompare e1 e2 "==='GT'"

324 "<=" -> jsCompare e1 e2 "!=='GT'"

317 "<=" -> jsCompare e1 e2 "!=='GT'"

compiler/src/Gen/GenerateHtml.hs+3−3

@@ -35,13 +35,13 @@ makeScript jsStyle (Right s) =

35-- Usage example:

36--

37-- > generateHtml "/elm-min.js" "Some title" [elmFile|elm-source/somePage.elm|]

38−generateHtml :: String -- ^ Location of elm-min.js as expected by the browser

38+generateHtml :: String -- ^ Location of elm-runtime.js as expected by the browser

39 -> String -- ^ The page title

40 -> String -- ^ The elm source code.

41 -> Html

42generateHtml libLoc title source =

43 case buildFromSource source of

44− Left err -> createHtml Readable libLoc title (Right $ showErr err) (H.noscript "")

44+ Left err -> createHtml Readable libLoc title (Right $ showErr err) (H.noscript "") "Elm.Main"

45 Right modul -> modulesToHtml Readable title libLoc [] True [modul]

46

47

@@ -69,5 +69,5 @@ createHtml jsStyle libLoc title js noscript moduleToLoad =

69 H.body $ do

70 makeScript Readable (Left libLoc)

71 makeScript jsStyle js

72− H.script ! A.type_ "text/javascript" $ "Elm.init(" ++ moduleToLoad ++ ")"

72+ H.script ! A.type_ "text/javascript" $ preEscapedToMarkup ("Elm.init(Elm." ++ moduleToLoad ++ ")" :: String)

73 H.noscript $ preEscapedToMarkup noscript

compiler/src/Parse/Parser.hs+2−2

@@ -14,8 +14,8 @@ import Parse.Modules

14import Parse.Foreign

15

16

17−statement = let defs = [ foreignDef, datatype, typeAlias, typeAnnotation ] in

18− (:[]) <$> choice defs <|> def <?> "datatype or variable definition"

17+statement = choice (typeAlias:defs) <|> def <?> "datatype or variable definition"

18+ where defs = map ((:[]) <$>) [ foreignDef, datatype, typeAnnotation ]

19

20freshDef = commitIf (freshLine >> (letter <|> char '_')) $ do

21 freshLine

compiler/src/Parse/Types.hs+16−2

@@ -9,6 +9,7 @@ import Data.List (lookup)

9import Text.Parsec

10import Text.Parsec.Indent

11

12+import Context

12import Parse.Library

13import Parse.Library

13import Types.Types hiding (string,parens)

14import Types.Types hiding (string,parens)

14import Guid

15import Guid

@@ -70,8 +71,9 @@ typeConstructor :: IParser (String, [ParseType])

70typeConstructor = (,) <$> (capVar <?> "another type constructor")

71typeConstructor = (,) <$> (capVar <?> "another type constructor")

71 <*> spacePrefix (typeSimple <|> typeUnambiguous)

72 <*> spacePrefix (typeSimple <|> typeUnambiguous)

72

73

73−typeAlias :: IParser Statement

74+typeAlias :: IParser [Statement]

74typeAlias = do

75typeAlias = do

76+ start <- getPosition

75 reserved "type" <?> "type alias (type Point = {x:Int, y:Int})"

77 reserved "type" <?> "type alias (type Point = {x:Int, y:Int})"

76 forcedWS

78 forcedWS

77 alias <- capVar

79 alias <- capVar

@@ -79,9 +81,21 @@ typeAlias = do

79 whitespace ; string "=" ; whitespace

81 whitespace ; string "=" ; whitespace

80 let n = length args

82 let n = length args

81 tipe <- typeExpr

83 tipe <- typeExpr

84+ end <- getPosition

82 case toTypeWith alias (zip args [1..n]) tipe of

85 case toTypeWith alias (zip args [1..n]) tipe of

83− Right t -> return (TypeAlias alias [1..n] t)

84 Left msg -> fail msg

86 Left msg -> fail msg

87+ Right t -> return (TypeAlias alias [1..n] t : ctor)

88+ where ctor = case tipe of

89+ RecordPT _ kvs -> [toConstructor start end alias kvs]

90+ _ -> []

91+

92+toConstructor start end alias kvs =

93+ Definition (FnDef alias args (ctxt (Record rec)))

94+ where

95+ ctxt = pos start end

96+ args = map fst kvs

97+ rec = map (\a -> (a, [], ctxt (Var a))) args

98+

85

99

86typeAnnotation :: IParser Statement

100typeAnnotation :: IParser Statement

87typeAnnotation = TypeAnnotation <$> try start <*> (toType <$> typeExpr)

101typeAnnotation = TypeAnnotation <$> try start <*> (toType <$> typeExpr)

libraries/Dict.elm+14−16

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

9 ) where

10

11import Maybe as Maybe

12−import JavaScript as JavaScript

12+import Native.Error as Error

13

14data NColor = Red | Black

15

@@ -18,8 +18,6 @@ data RBTree k v = RBNode NColor k v (RBTree k v) (RBTree k v) | RBEmpty

18empty : RBTree k v

19empty = RBEmpty

20

21−raise err = throw (JavaScript.castStringToJSString err)

22−

23{-- Helpers for checking invariants

21{-- Helpers for checking invariants

24

22

25-- Check that the tree has an equal number of black nodes on each path

23-- Check that the tree has an equal number of black nodes on each path

@@ -104,14 +102,14 @@ min t =

104 case t of

102 case t of

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

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

106 RBNode _ _ _ l _ -> min l

104 RBNode _ _ _ l _ -> min l

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

105+ RBEmpty -> Error.raise "(min RBEmpty) is not defined"

108

106

109{--

107{--

110max t =

108max t =

111 case t of

109 case t of

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

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

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

111 ; RBNode _ _ _ _ r -> max r

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

112+ ; RBEmpty -> Error.raise "(max RBEmpty) is not defined"

115 }

113 }

116--}

114--}

117

115

@@ -138,7 +136,7 @@ findWithDefault base k t =

138{--

136{--

139find k t =

137find k t =

140 case t of

138 case t of

141− { RBEmpty -> raise "Key was not found in dictionary!"

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

142 ; RBNode _ k' v l r ->

140 ; RBNode _ k' v l r ->

143 case compare k k' of

141 case compare k k' of

144 { LT -> find k l

142 { LT -> find k l

@@ -155,7 +153,7 @@ rotateLeft : RBTree k v -> RBTree k v

155rotateLeft t =

153rotateLeft t =

156 case t of

154 case t of

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

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

158− _ -> raise "rotateLeft of a node without enough children"

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

159

157

160-- rotateRight -- the reverse, and

158-- rotateRight -- the reverse, and

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

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

@@ -163,7 +161,7 @@ rotateRight : RBTree k v -> RBTree k v

163rotateRight t =

161rotateRight t =

164 case t of

162 case t of

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

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

166− _ -> raise "rotateRight of a node without enough children"

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

167

165

168rotateLeftIfNeeded : RBTree k v -> RBTree k v

166rotateLeftIfNeeded : RBTree k v -> RBTree k v

169rotateLeftIfNeeded t =

167rotateLeftIfNeeded t =

@@ -186,7 +184,7 @@ color_flip t =

186 RBNode (otherColor c1) bk bv

184 RBNode (otherColor c1) bk bv

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

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

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

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

189− _ -> raise "color_flip called on a RBEmpty or RBNode with a RBEmpty child"

187+ _ -> Error.raise "color_flip called on a RBEmpty or RBNode with a RBEmpty child"

190

188

191color_flipIfNeeded : RBTree k v -> RBTree k v

189color_flipIfNeeded : RBTree k v -> RBTree k v

192color_flipIfNeeded t =

190color_flipIfNeeded t =

@@ -217,10 +215,10 @@ insert k v t =

217 in ensureBlackRoot (ins t)

215 in ensureBlackRoot (ins t)

218{--

216{--

219 if not (invariants_hold t) then

217 if not (invariants_hold t) then

220− raise "invariants broken before insert"

218+ Error.raise "invariants broken before insert"

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

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

222 if not (invariants_hold new_t) then

220 if not (invariants_hold new_t) then

223− raise "invariants broken after insert"

221+ Error.raise "invariants broken after insert"

224 else new_t)

222 else new_t)

225--}

223--}

226

224

@@ -311,14 +309,14 @@ remove k t =

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

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

312 delLT t = case moveRedLeftIfNeeded t of

310 delLT t = case moveRedLeftIfNeeded t of

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

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

314− RBEmpty -> raise "delLT on RBEmpty"

312+ RBEmpty -> Error.raise "delLT on RBEmpty"

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

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

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

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

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

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

318− RBEmpty -> raise "delEQ called on a RBEmpty"

316+ RBEmpty -> Error.raise "delEQ called on a RBEmpty"

319 delGT t = case t of

317 delGT t = case t of

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

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

321− RBEmpty -> raise "delGT called on a RBEmpty"

319+ RBEmpty -> Error.raise "delGT called on a RBEmpty"

322 del t = case t of

320 del t = case t of

323 RBEmpty -> RBEmpty

321 RBEmpty -> RBEmpty

324 RBNode _ k' _ _ _ ->

322 RBNode _ k' _ _ _ ->

@@ -330,10 +328,10 @@ remove k t =

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

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

331{--

329{--

332 if not (invariants_hold t) then

330 if not (invariants_hold t) then

333− raise "invariants broken before remove"

331+ Error.raise "invariants broken before remove"

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

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

335 if invariants_hold t' then t' else

333 if invariants_hold t' then t' else

336− raise "invariants broken after remove")

334+ Error.raise "invariants broken after remove")

337--}

335--}

338

336

339map : (a -> b) -> RBTree k a -> RBTree k b

337map : (a -> b) -> RBTree k a -> RBTree k b

libraries/Graphics/Collage.elm+1−1

@@ -2,7 +2,7 @@

2module Graphics.Collage where

3

4import Either

5−import Graphics.LineStyle

5+import Graphics.LineStyle as LS

6import Geometry

7

8data Transform

libraries/Graphics/Color.elm−2

@@ -9,8 +9,6 @@ module Graphics.Color (rgba,rgb,hsva,hsv,

9 black,white,gray,grey,

10 linear,radial) where

11

12−import Native.Graphics.Color as C

13−

14data Color = Color Int Int Int Float

12data Color = Color Int Int Int Float

15

13

16rgba = Color

14rgba = Color

libraries/Graphics/Element.elm+19−17

@@ -1,21 +1,22 @@

1

2−module Grapics.Element (widthOf, heightOf, sizeOf,

2+module Graphics.Element (widthOf, heightOf, sizeOf,

3− width, height, opacity, color, tag, link,

3+ width, height, opacity, color, tag, link,

4− image, fittedImage, croppedImage,

4+ image, fittedImage, croppedImage,

5− flow, up, down, left, right, inward, outward,

5+ flow, up, down, left, right, inward, outward,

6− above, below, beside, layers,

6+ above, below, beside, layers,

7− container, absolute, relative,

7+ container, absolute, relative,

8− middle, topLeft, topRight, bottomLeft, bottomRight,

8+ middle, topLeft, topRight, bottomLeft, bottomRight,

9− midLeft, midRight, midTop, midBottom, middleAt,

9+ midLeft, midRight, midTop, midBottom, middleAt,

10− topLeftAt, topRightAt, bottomLeftAt, bottomRightAt,

10+ topLeftAt, topRightAt, bottomLeftAt, bottomRightAt,

11− midLeftAt, midRightAt, midTopAt, midBottomAt,

11+ midLeftAt, midRightAt, midTopAt, midBottomAt,

12− spacer

12+ spacer

13− ) where

13+ ) where

14

15import Native.Utils (guid)

16import JavaScript as JS

17import List as List

18−import Graphics.Color

18+import Graphics.Color as Color

19+import Maybe (Just, Nothing)

19

20

20type Properties = {

21type Properties = {

21 id : Int,

22 id : Int,

@@ -36,15 +37,16 @@ sizeOf e = (e.props.width, e.props.height)

36width w e = let p = e.props in { element=e.element, props={p| width <- w} }

37width w e = let p = e.props in { element=e.element, props={p| width <- w} }

37height h e = let p = e.props in { element=e.element, props={p| height <- h} }

38height h e = let p = e.props in { element=e.element, props={p| height <- h} }

38opacity o e = let p = e.props in { element=e.element, props={p| opacity <- o} }

39opacity o e = let p = e.props in { element=e.element, props={p| opacity <- o} }

40+color c e = let p = e.props in

39−color c e = let p = e.props in { element=e.element, props={p| color <- c} }

41+ { element=e.element, props={p| color <- Just c} }

40tag name e = let p = e.props in

42tag name e = let p = e.props in

41− { element=e.element, props={p| tag <- JS.fromString name} }

43+ { element=e.element, props={p| tag <- JS.fromString name} }

42link href e = let p = e.props in

44link href e = let p = e.props in

43− { element=e.element, props={p| href <- JS.fromString href} }

45+ { element=e.element, props={p| href <- JS.fromString href} }

44

46

45emptyStr = JS.fromString ""

47emptyStr = JS.fromString ""

46newElement w h e =

48newElement w h e =

47− { props = Properties (guid ()) w h 1 NoFill emptyStr emptyStr, element = e }

49+ { props = Properties (guid ()) w h 1 Nothing emptyStr emptyStr, element = e }

48

50

49data ElementPrim

51data ElementPrim

50 = Image ImageStyle Int Int JSString

52 = Image ImageStyle Int Int JSString

libraries/Graphics/LineStyle.elm+1−1

@@ -1,7 +1,7 @@

1

2module Graphics.LineStyle where

3

4−import Graphics.Color

4+import Graphics.Color as Color

5

6data LineCap = Butt | Round | Square

7data LineJoin = Soft | Sharp | Clip

libraries/List.elm+1

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

1

2module List where

3

4+import Native.Utils (min, max)

4import Native.List as L

5import Native.List as L

5

6

6head : [a] -> a

7head : [a] -> a

libraries/Native/Date.js+2−2

@@ -27,8 +27,8 @@ Elm.Native.Date = function(elm) {

27 hour : function(d) { return d.getHours(); },

28 minute : function(d) { return d.getMinutes(); },

29 second : function(d) { return d.getSeconds(); },

30− toTime : function(d) { return d.getTime(); }

30+ toTime : function(d) { return d.getTime(); },

31− dayOfWeek : function(d) { return { ctor:dayTable[d.getDay()] }; },

31+ dayOfWeek : function(d) { return { ctor:dayTable[d.getDay()] }; }

32 };

33

34};

libraries/Native/Error.js+5−1

@@ -4,6 +4,8 @@ Elm.Native.Error = function(elm) {

4 elm.Native = elm.Native || {};

5 if (elm.Native.Error) return elm.Native.Error;

6

7+ var fromString = Elm.Native.JavaScript(elm).fromString;

8+

7 function Case(span) {

9 function Case(span) {

8 var msg = 'Non-exhaustive pattern match in case expression'

10 var msg = 'Non-exhaustive pattern match in case expression'

9 throw new Error(msg + " (" + span + ")")

11 throw new Error(msg + " (" + span + ")")

@@ -14,5 +16,7 @@ Elm.Native.Error = function(elm) {

14 throw new Error(msg + " (" + span + ")")

16 throw new Error(msg + " (" + span + ")")

15 }

17 }

16

18

19+ function raise(str) { throw new Error(fromString(str)); }

20+

17− return elm.Native.Error = { Case: Case, If: If };

21+ return elm.Native.Error = { Case: Case, If: If, raise: raise };

18};

22};

libraries/Native/Graphics/Color.js+6−9

@@ -1,14 +1,12 @@

1

2+

2−Elm.Native.Color = function(elm) {

3+Elm.Native.Graphics.Color = function(elm) {

3 "use strict";

4 "use strict";

4

5

5 elm.Native = elm.Native || {};

6 elm.Native = elm.Native || {};

7+ elm.Native.Graphics = elm.Native.Graphics || {};

6− if (elm.Native.Color) return elm.Native.Color;

8+ if (elm.Native.Graphics.Color) return elm.Native.Graphics.Color;

7

9

8− function extract(c) {

9− if (c._3 === 1) { return 'rgb(' + c._0 + ',' + c._1 + ',' + c._2 + ')'; }

10− return 'rgba(' + c._0 + ',' + c._1 + ',' + c._2 + ',' + c._3 + ')';

11− }

12 function complement(rgb) {

10 function complement(rgb) {

13 var hsv = toHSV(rgb);

11 var hsv = toHSV(rgb);

14 hsv.hue = (hsv.hue + 180) % 360;

12 hsv.hue = (hsv.hue + 180) % 360;

@@ -59,11 +57,10 @@ Elm.Native.Color = function(elm) {

59 return { ctor:"Color", _0:norm(r+m), _1:norm(g+m), _2:norm(b+m), _3:1 };

57 return { ctor:"Color", _0:norm(r+m), _1:norm(g+m), _2:norm(b+m), _3:1 };

60 }

58 }

61

59

62− return elm.Native.Color = {

60+ return elm.Native.Graphics.Color = {

63 hsva:F4(hsva),

61 hsva:F4(hsva),

64 hsv:F3(hsv),

62 hsv:F3(hsv),

65− complement:complement,

63+ complement:complement

66− extract:extract

67 };

64 };

68

65

69};

66};

libraries/Native/List.js+1−1

@@ -5,7 +5,7 @@ Elm.Native.List = function(elm) {

5 elm.Native = elm.Native || {};

6 if (elm.Native.List) return elm.Native.List;

7

8− var Utils = elm.Native.Utils(elm);

8+ var Utils = Elm.Native.Utils(elm);

9

10 var Nil = { ctor:'Nil' };

11 function Cons(hd,tl) { return { ctor:"Cons", _0:hd, _1:tl }; }

libraries/Native/Prelude.jsnew file+7

@@ -0,0 +1,7 @@

1+

2+Elm.Prelude = function(elm) {

3+ 'use strict';

4+ if (elm.Prelude) return elm.Prelude;

5+

6+ return elm.Prelude = {};

7+};

libraries/Native/Show.js+3−2

@@ -2,6 +2,7 @@

2Elm.Native.Show = function(elm) {

3 'use strict';

4

5+ elm.Native = elm.Native || {};

5 if (elm.Native.Show) return elm.Native.Show;

6 if (elm.Native.Show) return elm.Native.Show;

6

7

7 var NList = Elm.Native.List(elm);

8 var NList = Elm.Native.List(elm);

@@ -73,8 +74,8 @@ Elm.Native.Show = function(elm) {

73 } else if (v.ctor === "Nil") {

74 } else if (v.ctor === "Nil") {

74 return "[]";

75 return "[]";

75 } else if (v.ctor === "RBNode" || v.ctor === "RBEmpty") {

76 } else if (v.ctor === "RBNode" || v.ctor === "RBEmpty") {

76− function cons(k){ return function(v) { return function(acc) { return NList.Cons(Tuple2(k,v),acc); }; }; }

77+ var cons = F3(function(k,v,acc){return NList.Cons(Tuple2(k,v),acc)});

77− var list = Dict.foldr(cons)(NList.Nil)(v);

78+ var list = A3(Dict.foldr, cons, NList.Nil, v);

78 var name = "Dict";

79 var name = "Dict";

79 if (list.ctor === "Cons" && list._0._1.ctor === "Tuple0") {

80 if (list.ctor === "Cons" && list._0._1.ctor === "Tuple0") {

80 name = "Set";

81 name = "Set";

libraries/Native/Signal/Signal.js+9−9

@@ -18,7 +18,7 @@ Elm.Native.Signal = function(elm) {

18 }

19

20 function Input(base) {

21− this.id = Guid.guid();

21+ this.id = Utils.guid();

22 this.value = base;

23 this.kids = [];

24 this.defaultNumberOfKids = 0;

@@ -28,11 +28,11 @@ Elm.Native.Signal = function(elm) {

28 send(this, timestep, changed);

29 return changed;

30 };

31− Dispatcher.inputs.push(this);

31+ elm.inputs.push(this);

32 }

33

34 function LiftN(update, args) {

35− this.id = Guid.guid();

35+ this.id = Utils.guid();

36 this.value = update();

37 this.kids = [];

38

@@ -92,7 +92,7 @@ Elm.Native.Signal = function(elm) {

92 }

93

94 function dropIf(pred,base,input) {

95− this.id = Guid.guid();

95+ this.id = Utils.guid();

96 this.value = pred(input.value) ? base : input.value;

97 this.kids = [];

98 this.recv = function(timestep, changed, parentID) {

@@ -104,7 +104,7 @@ Elm.Native.Signal = function(elm) {

104 }

105

106 function dropRepeats(input) {

107− this.id = Guid.guid();

107+ this.id = Utils.guid();

108 this.value = input.value;

109 this.kids = [];

110 this.recv = function(timestep, changed, parentID) {

@@ -127,7 +127,7 @@ Elm.Native.Signal = function(elm) {

127 }

128

129 function SampleOn(s1,s2) {

130− this.id = Guid.guid();

130+ this.id = Utils.guid();

131 this.value = s2.value;

132 this.kids = [];

133

@@ -155,14 +155,14 @@ Elm.Native.Signal = function(elm) {

155 var firstEvent = true;

156 function update(v) {

157 if (firstEvent) { firstEvent = false; return; }

158− setTimeout(function() { Dispatcher.notify(delayed.id, v) }, t);

158+ setTimeout(function() { elm.notify(delayed.id, v) }, t);

159 }

160 function first(a,b) { return a }

161 return new SampleOn(delayed, lift2(F2(first), delayed, lift(update,s)));

162 }

163

164 function Merge(s1,s2) {

165− this.id = Guid.guid();

165+ this.id = Utils.guid();

166 this.value = s1.value;

167 this.kids = [];

168

@@ -223,7 +223,7 @@ Elm.Native.Signal = function(elm) {

223 lift8 : F9(lift8),

224 foldp : F3(foldp),

225 delay : delay,

226− merge : F2(merge)

226+ merge : F2(merge),

227 merges : merges,

228 mergeEither : F2(mergeEither),

229 average : F2(average),

libraries/Native/Utils.js+12−4

@@ -2,6 +2,9 @@

2Elm.Native.Utils = function(elm) {

3 'use strict';

4

5+ elm.Native = elm.Native || {};

6+ if (elm.Native.Utils) return elm.Native.Utils;

7+

5 function eq(x,y) {

8 function eq(x,y) {

6 if (x === y) return true;

9 if (x === y) return true;

7 if (typeof x === "object") {

10 if (typeof x === "object") {

@@ -50,8 +53,8 @@ Elm.Native.Utils = function(elm) {

50 }

53 }

51

54

52

55

53− var Tuple0 = { ctor: "Tuple0" }

56+ var Tuple0 = { ctor: "Tuple0" };

54− function Tuple2(x,y) { return { ctor = "Tuple2", _0:x, _1:y } }

57+ function Tuple2(x,y) { return { ctor:"Tuple2", _0:x, _1:y } }

55

58

56 var count = 0;

59 var count = 0;

57 function guid(_) { return count++ }

60 function guid(_) { return count++ }

@@ -77,7 +80,7 @@ Elm.Native.Utils = function(elm) {

77 function replace(kvs,r) {

80 function replace(kvs,r) {

78 var o = copy(r);

81 var o = copy(r);

79 for (var i = kvs.length; i--; ) {

82 for (var i = kvs.length; i--; ) {

80− kvsi = kvs[i];

83+ var kvsi = kvs[i];

81 o[kvsi[0]] = kvsi[1];

84 o[kvsi[0]] = kvsi[1];

82 }

85 }

83 return o;

86 return o;

@@ -90,6 +93,9 @@ Elm.Native.Utils = function(elm) {

90 return o;

93 return o;

91 }

94 }

92

95

96+ function max(a,b) { return a > b ? a : b }

97+ function min(a,b) { return a < b ? a : b }

98+

93 return elm.Native.Utils = {

99 return elm.Native.Utils = {

94 eq:eq,

100 eq:eq,

95 compare:compare,

101 compare:compare,

@@ -99,6 +105,8 @@ Elm.Native.Utils = function(elm) {

99 remove: remove,

105 remove: remove,

100 replace: replace,

106 replace: replace,

101 insert: insert,

107 insert: insert,

102− guid: guid

108+ guid: guid,

109+ max : F2(max),

110+ min : F2(min)

103 };

111 };

104};

112};

libraries/Prelude.elmdeleted−8

@@ -1,8 +0,0 @@

1−

2−module Prelude where

3−

4−import List

5−import Signal

6−

7−fst (x,y) = x

8−snd (x,y) = y

libraries/Signal.elm+1−3

@@ -1,9 +1,7 @@

1

2module Signal where

3

4−import Either

5−import Time

6−import Native.Signal

4+import Native.Signal as Native

7

5

8constant : a -> Signal a

6constant : a -> Signal a

9

7

libraries/Time.elm−2

@@ -3,8 +3,6 @@

3

4module Time where

5

6−import Native.Time

7−

8type Time = Float

6type Time = Float

9

7

10-- Units of time, making it easier to specify things like a

8-- Units of time, making it easier to specify things like a

libraries/Touch.elm+1−1

@@ -3,7 +3,7 @@

3

4module Touch where

5

6−import Native.Touch

6+import Native.Touch as T

7

8type Touch = { x:Int, y:Int, id:Int, x0:Int, y0:Int, t0:Time }

9

libraries/WebSocket.elm+1−1

@@ -3,7 +3,7 @@

3

4module WebSocket where

5

6−import Native.WebSocket

6+import Native.WebSocket as WS

7

8-- Create a web-socket. The first argument is the URL of the desired

9-- web-socket server. The input signal holds the outgoing messages,

libraries/Window.elm−2

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

1

2module Window where

3

4−import Native.Window

5−

6-- The current dimensions of the window (i.e. the area viewable to the

4-- The current dimensions of the window (i.e. the area viewable to the

7-- user, not including scroll bars).

5-- user, not including scroll bars).

8dimensions : Signal (Int,Int)

6dimensions : Signal (Int,Int)

runtime/Init.js+2−3

@@ -22,7 +22,7 @@ Elm.init = function(module, baseNode) {

22 var Render = ElmRuntime.Render;

23 if (typeof baseNode === 'undefined') {

24 baseNode = Render.newElement('div');

25− document.appendChild(baseNode);

25+ document.body.appendChild(baseNode);

26 window.addEventListener('resize', function() {

27 console.log('resize the base node');

28 baseNode.style.width = document.documentElement.clientWidth + 'px';

@@ -35,11 +35,10 @@ Elm.init = function(module, baseNode) {

35 "body { font-family: calibri, helvetica, arial, sans-serif; }";

36 document.head.appendChild(style);

37 }

38− baseNode.style.overflow = 'scroll';

39

38

40 // create the actuall RTS. Any impure modules will attach themselves to this

39 // create the actuall RTS. Any impure modules will attach themselves to this

41 // object. This permits many Elm programs to be embedded per document.

40 // object. This permits many Elm programs to be embedded per document.

42− var elm = { notify: notify, node: baseNode, id: ElmRuntime.guid() };

41+ var elm = { notify: notify, node: baseNode, id: ElmRuntime.guid(), inputs: inputs };

43

42

44 // evaluate the given module and extract its 'main' value.

43 // evaluate the given module and extract its 'main' value.

45 signalGraph = module(elm).main;

44 signalGraph = module(elm).main;

runtime/Render.js+9−3

@@ -1,4 +1,5 @@

1+

1−ElmRuntime = ElmRuntime || {};

2+var ElmRuntime = ElmRuntime || {};

2ElmRuntime.Render = function() {

3ElmRuntime.Render = function() {

3'use strict';

4'use strict';

4

5

@@ -20,12 +21,17 @@ function makeText(pos,txt) {

20 return e;

21 return e;

21}

22}

22

23

24+function extract(c) {

25+ if (c._3 === 1) { return 'rgb(' + c._0 + ',' + c._1 + ',' + c._2 + ')'; }

26+ return 'rgba(' + c._0 + ',' + c._1 + ',' + c._2 + ',' + c._3 + ')';

27+}

28+

23function setProps(props, e) {

29function setProps(props, e) {

24 e.style.width = (props.width |0) + 'px';

30 e.style.width = (props.width |0) + 'px';

25 e.style.height = (props.height|0) + 'px';

31 e.style.height = (props.height|0) + 'px';

26 if (props.opacity !== 1) { e.style.opacity = props.opacity; }

32 if (props.opacity !== 1) { e.style.opacity = props.opacity; }

27 if (props.color.ctor === 'Just') {

33 if (props.color.ctor === 'Just') {

28− e.style.backgroundColor = Elm.Color.extract(props.color._0);

34+ e.style.backgroundColor = extract(props.color._0);

29 }

35 }

30 if (props.tag !== '') { e.id = props.tag; }

36 if (props.tag !== '') { e.id = props.tag; }

31 if (props.href !== '') {

37 if (props.href !== '') {

@@ -262,7 +268,7 @@ function update(node, curr, next) {

262 e.style.opacity = props.opacity;

268 e.style.opacity = props.opacity;

263 }

269 }

264 var nextColor = (props.color.ctor === 'Just' ?

270 var nextColor = (props.color.ctor === 'Just' ?

265− Elm.Color.extract(props.color._0) : 'transparent');

271+ extract(props.color._0) : 'transparent');

266 if (e.style.backgroundColor !== nextColor) e.style.backgroundColor = nextColor;

272 if (e.style.backgroundColor !== nextColor) e.style.backgroundColor = nextColor;

267 if (props.tag !== currP.tag) { e.id = props.tag; }

273 if (props.tag !== currP.tag) { e.id = props.tag; }

268 if (props.href !== currP.href) {

274 if (props.href !== currP.href) {