cf016ea · elk · git.iko.soy

.gitignore+1

compare with master

unifiedsplit

@@ -12,3 +12,4 @@ data

12.DS_Store

13build

14cache

15+*~

CONTRIBUTE.md → CONTRIBUTING.mdrenamed

The content is the same.

Elm.cabal+39−7

@@ -39,7 +39,6 @@ Library

39 Hs-Source-Dirs: compiler

40 other-modules: SourceSyntax.Declaration,

41 SourceSyntax.Expression,

42− SourceSyntax.Everything,

43 SourceSyntax.Helpers,

42 SourceSyntax.Helpers,

44 SourceSyntax.Literal,

43 SourceSyntax.Literal,

45 SourceSyntax.Location,

44 SourceSyntax.Location,

@@ -55,6 +54,7 @@ Library

55 Generate.Markdown,

54 Generate.Markdown,

56 Transform.Canonicalize,

55 Transform.Canonicalize,

57 Transform.Check,

56 Transform.Check,

57+ Transform.SafeNames,

58 Transform.SortDefinitions,

59 Transform.Substitute,

60 Transform.Optimize,

@@ -111,7 +111,6 @@ Library

111 text,

112 transformers >= 0.2,

113 union-find,

114− uniplate,

115 unordered-containers

114 unordered-containers

116

115

117Executable elm

116Executable elm

@@ -120,7 +119,6 @@ Executable elm

120 Hs-Source-Dirs: compiler

119 Hs-Source-Dirs: compiler

121 other-modules: SourceSyntax.Declaration,

120 other-modules: SourceSyntax.Declaration,

122 SourceSyntax.Expression,

121 SourceSyntax.Expression,

123− SourceSyntax.Everything,

124 SourceSyntax.Helpers,

122 SourceSyntax.Helpers,

125 SourceSyntax.Literal,

123 SourceSyntax.Literal,

126 SourceSyntax.Location,

124 SourceSyntax.Location,

@@ -135,6 +133,7 @@ Executable elm

135 Generate.Cases,

133 Generate.Cases,

136 Transform.Canonicalize,

134 Transform.Canonicalize,

137 Transform.Check,

135 Transform.Check,

136+ Transform.SafeNames,

138 Transform.SortDefinitions,

137 Transform.SortDefinitions,

139 Transform.Substitute,

138 Transform.Substitute,

140 Transform.Optimize,

139 Transform.Optimize,

@@ -191,14 +190,12 @@ Executable elm

191 text,

190 text,

192 transformers >= 0.2,

191 transformers >= 0.2,

193 union-find,

192 union-find,

194− uniplate,

195 unordered-containers

193 unordered-containers

196

194

197Executable elm-doc

195Executable elm-doc

198 Main-is: Docs.hs

196 Main-is: Docs.hs

199 Hs-Source-Dirs: compiler

197 Hs-Source-Dirs: compiler

200 other-modules: SourceSyntax.Declaration,

198 other-modules: SourceSyntax.Declaration,

201− SourceSyntax.Everything,

202 SourceSyntax.Expression,

199 SourceSyntax.Expression,

203 SourceSyntax.Helpers,

200 SourceSyntax.Helpers,

204 SourceSyntax.Literal,

201 SourceSyntax.Literal,

@@ -235,6 +232,41 @@ Executable elm-doc

235

232

236Test-Suite test-elm

233Test-Suite test-elm

237 Type: exitcode-stdio-1.0

234 Type: exitcode-stdio-1.0

238− Hs-Source-Dirs: tests

235+ Hs-Source-Dirs: tests, compiler

239 Main-is: Main.hs

236 Main-is: Main.hs

237+ other-modules: Tests.Compiler

238+ Tests.Property

239+ Tests.Property.Arbitrary

240+ SourceSyntax.Helpers

241+ SourceSyntax.Literal

242+ SourceSyntax.PrettyPrint

240− build-depends: base, directory, HTF

243+ build-depends: base,

244+ directory,

245+ Elm,

246+ test-framework,

247+ test-framework-hunit,

248+ test-framework-quickcheck2,

249+ HUnit,

250+ pretty,

251+ QuickCheck >= 2 && < 3,

252+ filemanip,

253+ aeson,

254+ base >=4.2 && <5,

255+ binary >= 0.6.4.0,

256+ blaze-html == 0.5.* || == 0.6.*,

257+ blaze-markup == 0.5.1.*,

258+ bytestring,

259+ cmdargs,

260+ containers >= 0.3,

261+ directory,

262+ filepath,

263+ indents,

264+ language-ecmascript >=0.15 && < 1.0,

265+ mtl >= 2,

266+ pandoc >= 1.10,

267+ parsec >= 3.1.1,

268+ pretty,

269+ text,

270+ transformers >= 0.2,

271+ union-find,

272+ unordered-containers

How to Request Features.mdnew file+93

@@ -0,0 +1,93 @@

1+# How to make a Feature Request

2+

3+Adding features is hard work and has long term implications for Elm.

4+If you think your particular feature is important, help make it happen

5+by doing some of the background work that goes into actually adding it.

6+

7+### Before making a Request / Formatting:

8+

9+ - Make sure your feature has not already been requested. Look through the

10+ email list to find similar requests.

11+ - Submit feature requests by emailing the list. This allows the broadest

12+ discussion and does not clutter up the GitHub repository with speculative

13+ issues. I'd prefer to use the GitHub issue tracker for bug tracking and

14+ issues with the existing code base.

15+ - Label all feature requests with a subject like "Request: _____". For

16+ example, if you want to be the umpteenth person to request type classes,

17+ you would use the subject "Request: Type Classes".

18+

19+### Body of the Request:

20+

21+Your request should address all of the following issues:

22+

23+**General Problem:** Clearly define the purpose of adding the feature.

24+What general problem do you want to solve? Why is that problem important?

25+Why is it important for a functional GUI language?

26+

27+**Specific Use-Cases:** What are the specific cases when the general problem

28+is actually an issue? How often does this case come up? Why are these cases

29+important to easily designing graphical user interfaces? Why are existing

30+solutions in Elm unsuitable?

31+

32+**Background Materials:** Are there relevant papers on the topic? Are there

33+languages or libraries that already have this feature? Organize this material

34+and provide a concise and helpful overview.

35+

36+**Alternatives:** What are all the ways to address the general problem or a

37+closely related problem? For example, the semantic flexibility of type classes

38+can be largely replicated with a module system in the style of ML.

39+What are the strengths and weakness of each of the alternative solutions?

40+

41+**Suggested Approach:** Outline your specific approach. How does it address

42+the general problem? How does it work? How hard is it going to be to add?

43+What other language features does it depend on that need to be added first?

44+Try to take a look at the relevant code to see if it would require significant

45+changes. If you are suggesting an API or library changes, include an interface

46+(a list of type signatures) for the functions you would like to add (perhaps

47+multiple interfaces if there are many good approaches).

48+

49+**Known Issues:** Search for issues that people have already found. Think of

50+any other possible downside and list them too. For example, one downside of

51+typeclasses is that they are globally defined for each type, so you cannot

52+have multiple `Ord` instances for Strings. This can lead to namespace pollution

53+within a project. In general you can only implement an "interface" once per

54+type, so it is very tricky to get the flexibility of ML's module functors.

55+

56+**Justification:** Why is the added complexity of your feature worth it? Discuss

57+both implementation complexity in the compiler, and conceptual complexity that

58+users must deal with. Why is your feature better than the alternative solutions?

59+Why is it okay to ignore the known issues? Is there any way to overcome the known

60+issues? Will it be difficult or confusing for users coming from JavaScript?

61+

62+### Some final notes:

63+

64+If for some reason you cannot provide details for some of these categories,

65+explain why the category is not applicable.

66+

67+Re-read before posting. Is your request constructive? Is it well organized?

68+Are there any details you forgot? Can anything be clarified or trimmed down?

69+Considering a request takes time, so be considerate about how much work a

70+reader has to do to take it seriously.

71+

72+A feature request is not an opportunity to be sassy or glib. Try to present

73+the information and argument clearly, concisely, thoroughly, and in an unbiased

74+manner.

75+

76+This is likely to be an iterative process. People will have comments and

77+questions. Everyone please be kind. Commenters, if you think you have a

78+concern, raise it as a question: "But what happens when you do blah?" instead

79+of "This will break when you do blah". Assume you have misunderstood their

80+proposal or only have a shallow understanding of it. Seek clarification, not victory.

81+

82+Comments are not a place for flame wars. Discuss specific issues. Vague

83+complaining and unsupported claims should either be forgotten or developed

84+into specific and well-supported concerns.

85+

86+I am always working hard to add cool stuff to Elm, and it is a lot of work.

87+I must prioritize issues to focus on the things that have the highest impact

88+for improving the quality of Elm, addressing the concerns of current users,

89+and making Elm more appealing for new users. I do not have infinite time,

90+so some things must receive more attention than others. I apologize in advance.

91+

92+And to summarize, just be cool! I want Elm to be really fun and easy to use,

93+and I want your projects to be amazing!

compiler/Build/Dependencies.hs+3−3

@@ -18,7 +18,7 @@ import System.FilePath as FP

18import System.IO

19import Text.PrettyPrint (Doc)

20

21−import SourceSyntax.Everything

21+import qualified SourceSyntax.Module as Module

22import qualified SourceSyntax.Type as Type

23import qualified Parse.Parse as Parse

24import qualified Metadata.Prelude as Prelude

@@ -32,7 +32,7 @@ import qualified Elm.Internal.Name as N

32import qualified Elm.Internal.Version as V

33import qualified Elm.Internal.Dependencies as Deps

34

35−getSortedDependencies :: [FilePath] -> Interfaces -> FilePath -> IO [String]

35+getSortedDependencies :: [FilePath] -> Module.Interfaces -> FilePath -> IO [String]

36getSortedDependencies srcDirs builtIns root =

37 do extras <- extraDependencies

38 let allSrcDirs = srcDirs ++ Maybe.fromMaybe [] extras

@@ -86,7 +86,7 @@ sortDeps depends =

86 mistakes = filter (\scc -> length scc > 1) sccs

87 msg = "A cyclical module dependency or was detected in:\n"

88

89−readDeps :: [FilePath] -> Interfaces -> FilePath -> ErrorT String IO [Deps]

89+readDeps :: [FilePath] -> Module.Interfaces -> FilePath -> ErrorT String IO [Deps]

90readDeps srcDirs builtIns root = do

91 let ifaces = (Set.fromList . Map.keys) builtIns

92 State.evalStateT (go ifaces root) Set.empty

compiler/Build/Source.hs+5−3

@@ -11,7 +11,9 @@ import System.Exit

11import System.FilePath as FP

12import Text.PrettyPrint (Doc)

13

14−import SourceSyntax.Everything

14+import SourceSyntax.Declaration

15+import SourceSyntax.Module

16+import qualified SourceSyntax.Expression as Expr

15import qualified SourceSyntax.Type as Type

17import qualified SourceSyntax.Type as Type

16import qualified Parse.Parse as Parse

18import qualified Parse.Parse as Parse

17import qualified Metadata.Prelude as Prelude

19import qualified Metadata.Prelude as Prelude

@@ -38,7 +40,7 @@ build noPrelude interfaces source =

38 let exports'

40 let exports'

39 | null exs =

41 | null exs =

40 let get = Set.toList . SD.boundVars in

42 let get = Set.toList . SD.boundVars in

41− concat [ get pattern | Definition (Def pattern _) <- decls ] ++

43+ concat [ get pattern | Definition (Expr.Def pattern _) <- decls ] ++

42 concat [ map fst ctors | Datatype _ _ ctors <- decls ] ++

44 concat [ map fst ctors | Datatype _ _ ctors <- decls ] ++

43 [ name | TypeAlias name _ (Type.Record _ _) <- decls ]

45 [ name | TypeAlias name _ (Type.Record _ _) <- decls ]

44 | otherwise = exs

46 | otherwise = exs

@@ -49,7 +51,7 @@ build noPrelude interfaces source =

49 exports = exports',

51 exports = exports',

50 imports = ims,

52 imports = ims,

51 -- reorder AST into strongly connected components

53 -- reorder AST into strongly connected components

52− program = SD.sortDefs . dummyLet $ TcDecl.toExpr decls,

54+ program = SD.sortDefs . Expr.dummyLet $ TcDecl.toExpr decls,

53 types = Map.empty,

55 types = Map.empty,

54 datatypes = [ (name,vars,ctors) | Datatype name vars ctors <- decls ],

56 datatypes = [ (name,vars,ctors) | Datatype name vars ctors <- decls ],

55 fixities = [ (assoc,level,op) | Fixity assoc level op <- decls ],

57 fixities = [ (assoc,level,op) | Fixity assoc level op <- decls ],

compiler/Elm/Internal/Dependencies.hs+3−5

@@ -10,6 +10,7 @@ import qualified Data.ByteString.Lazy as BS

10import qualified Data.HashMap.Strict as Map

11import qualified Elm.Internal.Name as N

12import qualified Elm.Internal.Version as V

13+import qualified Elm.Internal.Paths as Path

13

14

14data Deps = Deps

15data Deps = Deps

15 { name :: N.Name

16 { name :: N.Name

@@ -47,10 +48,6 @@ instance FromJSON Deps where

47 Right nm -> return nm

48 Right nm -> return nm

48

49

49 exposed <- get obj "exposed-modules" "a list of modules exposed to users"

50 exposed <- get obj "exposed-modules" "a list of modules exposed to users"

50− when (null exposed) $

51− fail "there are no 'exposed-modules'.\n\

52− \At least one module must be exposed \

53− \for anyone to use this library!"

54

51

55 elmVersion <- get obj "elm-version" "the version of the Elm compiler you are using"

52 elmVersion <- get obj "elm-version" "the version of the Elm compiler you are using"

56

53

@@ -76,7 +73,8 @@ get obj field desc =

76 case maybe of

73 case maybe of

77 Just value -> return value

74 Just value -> return value

78 Nothing -> fail $ "Missing field " ++ show field ++ ", " ++ desc ++ ".\n" ++

75 Nothing -> fail $ "Missing field " ++ show field ++ ", " ++ desc ++ ".\n" ++

76+ " Check out an example " ++ Path.dependencyFile ++ " file here:" ++

79− " <https://github.com/evancz/rainbow-palette/blob/master/elm_dependencies.json>"

77+ " <https://github.com/evancz/automaton/blob/master/elm_dependencies.json>"

80

78

81repoToName :: String -> Either String N.Name

79repoToName :: String -> Either String N.Name

82repoToName repo

80repoToName repo

compiler/Elm/Internal/Version.hs+1−1

@@ -13,7 +13,7 @@ import qualified Data.Version as Version

13

14elmVersion :: Version

15elmVersion = V ns ""

16− where (Version.Version ns _) =This.version

16+ where (Version.Version ns _) = This.version

17

18-- Data representation

19

compiler/Generate/JavaScript.hs+28−30

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

1{-# OPTIONS -Wall #-}

2

3−module Generate.JavaScript where

3+module Generate.JavaScript (generate) where

4

5import Control.Arrow (first,(***))

6import Control.Applicative ((<$>),(<*>))

@@ -11,31 +11,27 @@ import qualified Data.Set as Set

11

12import qualified Generate.Cases as Case

13import qualified Generate.Markdown as MD

14+import qualified SourceSyntax.Helpers as Help

15+import SourceSyntax.Literal

14−import SourceSyntax.Everything

16+import SourceSyntax.Pattern

15import SourceSyntax.Location

17import SourceSyntax.Location

18+import SourceSyntax.Expression

19+import SourceSyntax.Module

16import qualified Transform.SortDefinitions as SD

20import qualified Transform.SortDefinitions as SD

17import Language.ECMAScript3.Syntax

21import Language.ECMAScript3.Syntax

18import Language.ECMAScript3.PrettyPrint

22import Language.ECMAScript3.PrettyPrint

19−import Parse.Helpers (jsReserveds)

23+import qualified Transform.SafeNames as MakeSafe

20−

21−makeSafe :: String -> String

22−makeSafe = List.intercalate "." . map dereserve . split . deprime

23− where

24− deprime = map (\c -> if c == '\'' then '$' else c)

25− dereserve x = case Set.member x jsReserveds of

26− False -> x

27− True -> "$" ++ x

28

24

29split :: String -> [String]

25split :: String -> [String]

30split = go []

26split = go []

31 where

27 where

32 go vars str =

28 go vars str =

33 case break (=='.') str of

29 case break (=='.') str of

34− (x,'.':rest) | isOp x -> vars ++ [x ++ '.' : rest]

30+ (x,'.':rest) | Help.isOp x -> vars ++ [x ++ '.' : rest]

35 | otherwise -> go (vars ++ [x]) rest

31 | otherwise -> go (vars ++ [x]) rest

36 (x,[]) -> vars ++ [x]

32 (x,[]) -> vars ++ [x]

37

33

38−var name = Id () (makeSafe name)

34+var name = Id () name

39ref name = VarRef () (var name)

35ref name = VarRef () (var name)

40prop name = PropId () (var name)

36prop name = PropId () (var name)

41f <| x = CallExpr () f [x]

37f <| x = CallExpr () f [x]

@@ -160,14 +156,15 @@ expression (L span expr) =

160 return $ function [] (stmts ++ [ ReturnStmt () (Just exp) ]) `call` []

156 return $ function [] (stmts ++ [ ReturnStmt () (Just exp) ]) `call` []

161

157

162 MultiIf branches ->

158 MultiIf branches ->

163− do branches' <- forM branches $ \(b,e) -> (,) <$> expression b <*> expression e

159+ do branches' <- forM branches $ \(b,e) -> (,) <$> expression b <*> expression e

164− return $ case last branches of

160+ return $ case last branches of

165− (L _ (Var "Basics.otherwise"), e) -> ifs (init branches') (snd (last branches'))

161+ (L _ (Var "Basics.otherwise"), _) -> safeIfs branches'

166− _ -> ifs branches'

162+ (L _ (Literal (Boolean True)), _) -> safeIfs branches'

167− (obj "_E.If" `call` [ ref "$moduleName", string (show span) ])

163+ _ -> ifs branches' (obj "_E.If" `call` [ ref "$moduleName", string (show span) ])

168− where

164+ where

165+ safeIfs branches = ifs (init branches) (snd (last branches))

169− ifs branches finally = foldr iff finally branches

166+ ifs branches finally = foldr iff finally branches

170− iff (if', then') else' = CondExpr () if' then' else'

167+ iff (if', then') else' = CondExpr () if' then' else'

171

168

172 Case e cases ->

169 Case e cases ->

173 do (tempVar,initialMatch) <- Case.toMatch cases

170 do (tempVar,initialMatch) <- Case.toMatch cases

@@ -187,7 +184,7 @@ expression (L span expr) =

187 do es' <- mapM expression es

184 do es' <- mapM expression es

188 return $ ObjectLit () (ctor : fields es')

185 return $ ObjectLit () (ctor : fields es')

189 where

186 where

190− ctor = (prop "ctor", string (makeSafe name))

187+ ctor = (prop "ctor", string name)

191 fields = zipWith (\n e -> (prop ("_" ++ show n), e)) [0..]

188 fields = zipWith (\n e -> (prop ("_" ++ show n), e)) [0..]

192

189

193 Markdown uid doc es ->

190 Markdown uid doc es ->

@@ -211,7 +208,7 @@ definition def =

211 let assign x = varDecl x expr'

208 let assign x = varDecl x expr'

212 case pattern of

209 case pattern of

213 PVar x

210 PVar x

214− | isOp x ->

211+ | Help.isOp x ->

215 let op = LBracket () (ref "_op") (string x) in

212 let op = LBracket () (ref "_op") (string x) in

216 return [ ExprStmt () $ AssignExpr () OpAssign op expr' ]

213 return [ ExprStmt () $ AssignExpr () OpAssign op expr' ]

217 | otherwise ->

214 | otherwise ->

@@ -234,11 +231,11 @@ definition def =

234

231

235 decl x n = varDecl x (dotSep ["$","_" ++ show n])

232 decl x n = varDecl x (dotSep ["$","_" ++ show n])

236 setup vars

233 setup vars

237− | isTuple name = assign "$" : vars

234+ | Help.isTuple name = assign "$" : vars

238− | otherwise = safeAssign : vars

235+ | otherwise = assign "$raw" : safeAssign : vars

239

236

240− safeAssign = varDecl "$" (CondExpr () if' expr' exception)

237+ safeAssign = varDecl "$" (CondExpr () if' (obj "$raw") exception)

241− if' = InfixExpr () OpStrictEq (obj "$.ctor") (string name)

238+ if' = InfixExpr () OpStrictEq (obj "$raw.ctor") (string name)

242 exception = obj "_E.Case" `call` [ref "$moduleName", string (show span)]

239 exception = obj "_E.Case" `call` [ref "$moduleName", string (show span)]

243

240

244 _ ->

241 _ ->

@@ -297,10 +294,11 @@ clause span variable (Case.Clause value vars mtch) =

297

294

298

295

299generate :: MetadataModule () () -> String

296generate :: MetadataModule () () -> String

300−generate modul =

297+generate unsafeModule =

301 show . prettyPrint $ setup (Just "Elm") (names modul ++ ["make"]) ++

298 show . prettyPrint $ setup (Just "Elm") (names modul ++ ["make"]) ++

302 [ assign ("Elm" : names modul ++ ["make"]) (function ["_elm"] programStmts) ]

299 [ assign ("Elm" : names modul ++ ["make"]) (function ["_elm"] programStmts) ]

303 where

300 where

301+ modul = MakeSafe.metadataModule unsafeModule

304 thisModule = dotSep ("_elm" : names modul ++ ["values"])

302 thisModule = dotSep ("_elm" : names modul ++ ["values"])

305 programStmts =

303 programStmts =

306 concat [ setup (Just "_elm") (names modul ++ ["values"])

304 concat [ setup (Just "_elm") (names modul ++ ["values"])

@@ -317,7 +315,7 @@ generate modul =

317

315

318 jsExports = assign ("_elm" : names modul ++ ["values"]) (ObjectLit () exs)

316 jsExports = assign ("_elm" : names modul ++ ["values"]) (ObjectLit () exs)

319 where

317 where

320− exs = map entry . filter (not . isOp) $ "_op" : exports modul

318+ exs = map entry . filter (not . Help.isOp) $ "_op" : exports modul

321 entry x = (PropId () (var x), ref x)

319 entry x = (PropId () (var x), ref x)

322

320

323 assign path expr =

321 assign path expr =

@@ -393,7 +391,7 @@ binop span op e1 e2 =

393 js1 = expression e1

391 js1 = expression e1

394 js2 = expression e2

392 js2 = expression e2

395

393

396− func | isOp operator = BracketRef () (dotSep (init parts ++ ["_op"])) (string operator)

394+ func | Help.isOp operator = BracketRef () (dotSep (init parts ++ ["_op"])) (string operator)

397 | otherwise = dotSep parts

395 | otherwise = dotSep parts

398 where

396 where

399 parts = split op

397 parts = split op

compiler/Generate/Noscript.hs+5−1

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

1module Generate.Noscript (noscript) where

2

3import Data.List (isInfixOf)

4−import SourceSyntax.Everything

4+import SourceSyntax.Declaration (Declaration(..))

5+import SourceSyntax.Expression

6+import SourceSyntax.Literal

7+import SourceSyntax.Location

8+import SourceSyntax.Module

5import qualified Generate.Markdown as MD

9import qualified Generate.Markdown as MD

6

10

7noscript :: Module t v -> String

11noscript :: Module t v -> String

compiler/Parse/Expression.hs+1−1

@@ -163,7 +163,7 @@ ifExpr = reserved "if" >> whitespace >> (normal <|> multiIf)

163 whitespace <?> "an 'else' branch" ; reserved "else" <?> "an 'else' branch" ; whitespace

164 elseBranch <- expr

165 return $ MultiIf [(bool, thenBranch),

166− (Location.sameAs elseBranch (Var "otherwise"), elseBranch)]

166+ (Location.sameAs elseBranch (Literal . Literal.Boolean $ True), elseBranch)]

167 multiIf = MultiIf <$> spaceSep1 iff

168 where iff = do string "|" ; whitespace

169 b <- expr ; padded arrow

compiler/Parse/Helpers.hs+30−2

@@ -24,7 +24,8 @@ reserveds = [ "if", "then", "else"

24 , "data", "type"

25 , "module", "where"

26 , "import", "as", "hiding", "open"

27− , "export", "foreign" ]

27+ , "export", "foreign"

28+ , "deriving" ]

28

29

29jsReserveds :: Set.Set String

30jsReserveds :: Set.Set String

30jsReserveds = Set.fromList

31jsReserveds = Set.fromList

@@ -38,6 +39,10 @@ jsReserveds = Set.fromList

38 , "const", "enum", "export", "extends", "import", "super", "implements"

39 , "const", "enum", "export", "extends", "import", "super", "implements"

39 , "interface", "let", "package", "private", "protected", "public"

40 , "interface", "let", "package", "private", "protected", "public"

40 , "static", "yield"

41 , "static", "yield"

42+ -- reserved by the Elm runtime system

43+ , "Elm", "ElmRuntime"

44+ , "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9"

45+ , "A2", "A3", "A4", "A5", "A6", "A7", "A8", "A9"

41 ]

46 ]

42

47

43expecting = flip (<?>)

48expecting = flip (<?>)

@@ -277,7 +282,8 @@ ignoreUntil :: IParser a -> IParser (Maybe a)

277ignoreUntil end = go

282ignoreUntil end = go

278 where

283 where

279 ignore p = const () <$> p

284 ignore p = const () <$> p

285+ filler = choice [ try (ignore chr) <|> ignore str

280− filler = choice [ ignore multiComment

286+ , ignore multiComment

281 , ignore (markdown (\_ _ -> mzero))

287 , ignore (markdown (\_ _ -> mzero))

282 , ignore anyChar

288 , ignore anyChar

283 ]

289 ]

@@ -368,3 +374,25 @@ glSource src =

368 _ -> []

374 _ -> []

369 else []

375 else []

370 _ -> []

376 _ -> []

377+

378+str :: IParser String

379+str = choice [ quote >> dewindows <$> manyTill (backslashed <|> anyChar) quote

380+ , liftM dewindows . expecting "string" . betwixt '"' '"' . many $

381+ backslashed <|> satisfy (/='"')

382+ ]

383+ where

384+ quote = try (string "\"\"\"")

385+

386+ -- Remove \r from strings to fix generated JavaScript

387+ dewindows [] = []

388+ dewindows cs =

389+ let (pre, suf) = break (`elem` ['\r','\n']) cs

390+ in pre ++ case suf of

391+ ('\r':'\n':rest) -> '\n' : dewindows rest

392+ ('\n':rest) -> '\n' : dewindows rest

393+ ('\r':rest) -> '\n' : dewindows rest

394+ _ -> []

395+

396+chr :: IParser Char

397+chr = betwixt '\'' '\'' (backslashed <|> satisfy (/='\''))

398+ <?> "character"

compiler/Parse/Literal.hs+2−25

@@ -8,7 +8,7 @@ import Text.Parsec.Indent

8import Parse.Helpers

9import SourceSyntax.Literal

10

11−literal = num <|> str <|> chr

11+literal = num <|> (Str <$> str) <|> (Chr <$> chr)

12

13num :: IParser Literal

14num = fmap toLit (preNum <?> "number")

@@ -20,27 +20,4 @@ num = fmap toLit (preNum <?> "number")

20 ('.':) <$> many1 digit

21 minus = try $ do string "-"

22 lookAhead digit

23− return "-"

23+ return "-"

24−

25−chr :: IParser Literal

26−chr = Chr <$> betwixt '\'' '\'' (backslashed <|> satisfy (/='\''))

27− <?> "character"

28−

29−str :: IParser Literal

30−str = choice [ quote >> str <$> manyTill (backslashed <|> anyChar) quote

31− , liftM Str . expecting "string" . betwixt '"' '"' . many $

32− backslashed <|> satisfy (/='"')

33− ]

34− where

35− quote = try (string "\"\"\"")

36− str = Str . dewindows

37−

38− -- Remove \r from strings to fix generated JavaScript

39− dewindows [] = []

40− dewindows cs =

41− let (pre, suf) = break (`elem` ['\r','\n']) cs

42− in pre ++ case suf of

43− ('\r':'\n':rest) -> '\n' : dewindows rest

44− ('\n':rest) -> '\n' : dewindows rest

45− ('\r':rest) -> '\n' : dewindows rest

46− _ -> []

compiler/Parse/Pattern.hs+2−2

@@ -11,9 +11,9 @@ import Text.Parsec.Indent

11

12import Parse.Helpers

13import Parse.Literal

14+import SourceSyntax.Literal

15+import SourceSyntax.Pattern hiding (tuple, list)

14import qualified SourceSyntax.Pattern as Pattern

16import qualified SourceSyntax.Pattern as Pattern

15−import SourceSyntax.Everything hiding (tuple)

16−

17

18basic :: IParser Pattern

19basic = choice

compiler/SourceSyntax/Declaration.hs−2

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

1−{-# LANGUAGE DeriveDataTypeable #-}

2module SourceSyntax.Declaration where

1module SourceSyntax.Declaration where

3

2

4−import Data.Data

5import qualified SourceSyntax.Expression as Expr

3import qualified SourceSyntax.Expression as Expr

6import SourceSyntax.Type

4import SourceSyntax.Type

7import SourceSyntax.PrettyPrint

5import SourceSyntax.PrettyPrint

compiler/SourceSyntax/Everything.hsdeleted−17

@@ -1,17 +0,0 @@

1−module SourceSyntax.Everything

2− (module SourceSyntax.Helpers,

3− module SourceSyntax.Location,

4− module SourceSyntax.Literal,

5− module SourceSyntax.Pattern,

6− module SourceSyntax.Expression,

7− module SourceSyntax.Declaration,

8− module SourceSyntax.Module

9− ) where

10−

11−import SourceSyntax.Helpers

12−import SourceSyntax.Location

13−import SourceSyntax.Literal

14−import SourceSyntax.Pattern hiding (tuple, list, cons, nil, prettyParens)

15−import SourceSyntax.Expression

16−import SourceSyntax.Declaration hiding (Assoc(..))

17−import SourceSyntax.Module

compiler/SourceSyntax/Expression.hs+5−4

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

1−{-# LANGUAGE DeriveDataTypeable #-}

2module SourceSyntax.Expression where

1module SourceSyntax.Expression where

3

2

4−import Data.Data

5import Data.List (intercalate)

3import Data.List (intercalate)

6import SourceSyntax.PrettyPrint

4import SourceSyntax.PrettyPrint

7import Text.PrettyPrint as P

5import Text.PrettyPrint as P

@@ -31,12 +29,12 @@ data Expr t v

31 | Record [(String, LExpr t v)]

29 | Record [(String, LExpr t v)]

32 | Markdown String String [LExpr t v]

30 | Markdown String String [LExpr t v]

33 | GLShader String String

31 | GLShader String String

34− deriving (Eq, Show, Data, Typeable)

32+ deriving (Eq)

35

33

36data Def tipe var

34data Def tipe var

37 = Def Pattern.Pattern (LExpr tipe var)

35 = Def Pattern.Pattern (LExpr tipe var)

38 | TypeAnnotation String Type.Type

36 | TypeAnnotation String Type.Type

39− deriving (Eq, Show, Data, Typeable)

37+ deriving (Eq, Show)

40

38

41tuple es = Data ("_Tuple" ++ show (length es)) es

39tuple es = Data ("_Tuple" ++ show (length es)) es

42

40

@@ -48,6 +46,9 @@ saveEnvName = "_save_the_environment!!!"

48dummyLet defs =

46dummyLet defs =

49 Location.none $ Let defs (Location.none $ Var saveEnvName)

47 Location.none $ Let defs (Location.none $ Var saveEnvName)

50

48

49+instance Show (Expr t v) where

50+ show = render . pretty

51+

51instance Pretty (Expr t v) where

52instance Pretty (Expr t v) where

52 pretty expr =

53 pretty expr =

53 case expr of

54 case expr of

compiler/SourceSyntax/Literal.hs+2−4

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

1−{-# LANGUAGE DeriveDataTypeable #-}

2module SourceSyntax.Literal where

1module SourceSyntax.Literal where

3

2

4−import Data.Data

5import SourceSyntax.PrettyPrint

3import SourceSyntax.PrettyPrint

6import qualified Text.PrettyPrint as PP

4import qualified Text.PrettyPrint as PP

7

5

@@ -10,7 +8,7 @@ data Literal = IntNum Int

10 | Chr Char

8 | Chr Char

11 | Str String

9 | Str String

12 | Boolean Bool

10 | Boolean Bool

13− deriving (Eq, Ord, Data, Typeable, Show)

11+ deriving (Eq, Ord, Show)

14

12

15instance Pretty Literal where

13instance Pretty Literal where

16 pretty literal =

14 pretty literal =

@@ -19,4 +17,4 @@ instance Pretty Literal where

19 FloatNum n -> PP.double n

17 FloatNum n -> PP.double n

20 Chr c -> PP.quotes (PP.char c)

18 Chr c -> PP.quotes (PP.char c)

21 Str s -> PP.text (show s)

19 Str s -> PP.text (show s)

22− Boolean bool -> PP.text (show bool)

20+ Boolean bool -> PP.text (show bool)

compiler/SourceSyntax/Location.hs+3−5

@@ -1,19 +1,17 @@

1−{-# LANGUAGE DeriveDataTypeable #-}

2module SourceSyntax.Location where

1module SourceSyntax.Location where

3

2

4−import Data.Data

5import Text.PrettyPrint

3import Text.PrettyPrint

6import SourceSyntax.PrettyPrint

4import SourceSyntax.PrettyPrint

7import qualified Text.Parsec.Pos as Parsec

5import qualified Text.Parsec.Pos as Parsec

8

6

9data SrcPos = Pos { line :: Int, column :: Int }

7data SrcPos = Pos { line :: Int, column :: Int }

10− deriving (Eq, Ord, Data, Typeable)

8+ deriving (Eq, Ord)

11

9

12data SrcSpan = Span SrcPos SrcPos String | NoSpan String

10data SrcSpan = Span SrcPos SrcPos String | NoSpan String

13− deriving (Eq, Ord, Data, Typeable)

11+ deriving (Eq, Ord)

14

12

15data Located e = L SrcSpan e

13data Located e = L SrcSpan e

16− deriving (Eq, Ord, Data, Typeable)

14+ deriving (Eq, Ord)

17

15

18none e = L (NoSpan (render $ pretty e)) e

16none e = L (NoSpan (render $ pretty e)) e

19noneNoDocs = L (NoSpan "")

17noneNoDocs = L (NoSpan "")

compiler/SourceSyntax/Module.hs+1−3

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

1−{-# LANGUAGE DeriveDataTypeable #-}

2module SourceSyntax.Module where

1module SourceSyntax.Module where

3

2

4−import Data.Data

5import Data.Binary

3import Data.Binary

6import Data.List (intercalate)

4import Data.List (intercalate)

7import qualified Data.Map as Map

5import qualified Data.Map as Map

@@ -24,7 +22,7 @@ type Exports = [String]

24

22

25type Imports = [(String, ImportMethod)]

23type Imports = [(String, ImportMethod)]

26data ImportMethod = As String | Importing [String] | Hiding [String]

24data ImportMethod = As String | Importing [String] | Hiding [String]

27− deriving (Eq, Ord, Show, Data, Typeable)

25+ deriving (Eq, Ord, Show)

28

26

29instance Binary ImportMethod where

27instance Binary ImportMethod where

30 put (As s) = do put (0 :: Word8)

28 put (As s) = do put (0 :: Word8)

compiler/SourceSyntax/Pattern.hs+3−5

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

1−{-# LANGUAGE DeriveDataTypeable #-}

2module SourceSyntax.Pattern where

1module SourceSyntax.Pattern where

3

2

4import Data.List (intercalate)

3import Data.List (intercalate)

5−import Data.Data

6import SourceSyntax.Helpers as Help

4import SourceSyntax.Helpers as Help

7import SourceSyntax.PrettyPrint

5import SourceSyntax.PrettyPrint

8import Text.PrettyPrint as PP

6import Text.PrettyPrint as PP

@@ -14,7 +12,7 @@ data Pattern = PData String [Pattern]

14 | PVar String

12 | PVar String

15 | PAnything

13 | PAnything

16 | PLiteral Literal.Literal

14 | PLiteral Literal.Literal

17− deriving (Eq, Ord, Data, Typeable, Show)

15+ deriving (Eq, Ord, Show)

18

16

19cons h t = PData "::" [h,t]

17cons h t = PData "::" [h,t]

20nil = PData "[]" []

18nil = PData "[]" []

@@ -37,7 +35,7 @@ instance Pretty Pattern where

37 PData name ps ->

35 PData name ps ->

38 if isTuple name then

36 if isTuple name then

39 PP.parens . commaCat $ map pretty ps

37 PP.parens . commaCat $ map pretty ps

40− else sep (PP.text name : map prettyParens ps)

38+ else hsep (PP.text name : map prettyParens ps)

41

39

42prettyParens pattern = parensIf needsThem (pretty pattern)

40prettyParens pattern = parensIf needsThem (pretty pattern)

43 where

41 where

@@ -45,4 +43,4 @@ prettyParens pattern = parensIf needsThem (pretty pattern)

45 case pattern of

43 case pattern of

46 PData name (_:_) | not (isTuple name) -> True

44 PData name (_:_) | not (isTuple name) -> True

47 PAlias _ _ -> True

45 PAlias _ _ -> True

48− _ -> False

46+ _ -> False

compiler/SourceSyntax/Type.hs+1−3

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

1−{-# LANGUAGE DeriveDataTypeable #-}

2module SourceSyntax.Type where

1module SourceSyntax.Type where

3

2

4import Data.Binary

3import Data.Binary

5−import Data.Data

6import qualified Data.Map as Map

4import qualified Data.Map as Map

7import qualified SourceSyntax.Helpers as Help

5import qualified SourceSyntax.Helpers as Help

8import Control.Applicative ((<$>), (<*>))

6import Control.Applicative ((<$>), (<*>))

@@ -14,7 +12,7 @@ data Type = Lambda Type Type

14 | Data String [Type]

12 | Data String [Type]

15 | EmptyRecord

13 | EmptyRecord

16 | Record [(String,Type)] Type

14 | Record [(String,Type)] Type

17− deriving (Eq, Show, Data, Typeable)

15+ deriving (Eq, Show)

18

16

19fieldMap :: [(String,a)] -> Map.Map String [a]

17fieldMap :: [(String,a)] -> Map.Map String [a]

20fieldMap fields =

18fieldMap fields =

compiler/Transform/Check.hs+30−9

@@ -1,19 +1,20 @@

1module Transform.Check (mistakes) where

2

3import Transform.SortDefinitions (boundVars)

4−import SourceSyntax.Everything

4+import SourceSyntax.Declaration (Declaration(..))

5+import SourceSyntax.Expression

6+import SourceSyntax.Pattern

7+import SourceSyntax.Location

5import SourceSyntax.PrettyPrint

8import SourceSyntax.PrettyPrint

6import qualified SourceSyntax.Type as T

9import qualified SourceSyntax.Type as T

7import Data.List as List

10import Data.List as List

8import qualified Data.Map as Map

11import qualified Data.Map as Map

9import qualified Data.Maybe as Maybe

12import qualified Data.Maybe as Maybe

10import qualified Data.Set as Set

13import qualified Data.Set as Set

11−import Data.Data

12−import Data.Generics.Uniplate.Data

13import Text.PrettyPrint as P

14import Text.PrettyPrint as P

14

15

16

16−mistakes :: (Data t, Data v) => [Declaration t v] -> [Doc]

17+mistakes :: [Declaration t v] -> [Doc]

17mistakes decls =

18mistakes decls =

18 concat [ infiniteTypeAliases decls

19 concat [ infiniteTypeAliases decls

19 , illFormedTypes decls

20 , illFormedTypes decls

@@ -22,15 +23,35 @@ mistakes decls =

22 where

23 where

23 findErrors defs = duplicates defs ++ badOrder defs

24 findErrors defs = duplicates defs ++ badOrder defs

24

25

25−getLets :: (Data t, Data v) => [Declaration t v] -> [[Def t v]]

26+getLets :: [Declaration t v] -> [[Def t v]]

26−getLets decls = defs : concatMap getSubLets defs

27+getLets decls = defs : concatMap defLets defs

27 where

28 where

28− defs = concatMap (\d -> case d of Definition d -> [d] ; _ -> []) decls

29+ defs = [ d | Definition d <- decls ]

29

30

30− getSubLets def =

31+ defLets def =

31 case def of

32 case def of

32− Def pattern expr -> [ defs | Let defs _ <- universeBi expr ]

33 TypeAnnotation _ _ -> []

34+ Def _ expr -> exprLets expr

35+

36+ exprLets (L _ expr) =

37+ case expr of

38+ Var _ -> []

39+ Lambda p e -> exprLets e

40+ Binop op e1 e2 -> exprLets e1 ++ exprLets e2

41+ Case e cases -> exprLets e ++ concatMap (exprLets . snd) cases

42+ Data name es -> concatMap exprLets es

43+ Literal _ -> []

44+ Range e1 e2 -> exprLets e1 ++ exprLets e2

45+ ExplicitList es -> concatMap exprLets es

46+ App e1 e2 -> exprLets e1 ++ exprLets e2

47+ MultiIf branches -> concatMap (\(b,e) -> exprLets b ++ exprLets e) branches

48+ Access e lbl -> exprLets e

49+ Remove e lbl -> exprLets e

50+ Insert e lbl v -> exprLets e ++ exprLets v

51+ Modify e fields -> exprLets e ++ concatMap (exprLets . snd) fields

52+ Record fields -> concatMap (exprLets . snd) fields

53+ Markdown uid md es -> []

54+ Let defs body -> [defs] ++ exprLets body

34

55

35dups :: Eq a => [a] -> [a]

56dups :: Eq a => [a] -> [a]

36dups = map head . filter ((>1) . length) . List.group

57dups = map head . filter ((>1) . length) . List.group

compiler/Transform/Optimize.hs+5−1

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

1module Transform.Optimize (optimize) where

2

3−import SourceSyntax.Everything

3+import SourceSyntax.Declaration (Declaration(..))

4+import SourceSyntax.Expression

5+import SourceSyntax.Literal

6+import SourceSyntax.Location

7+import SourceSyntax.Module

4import Control.Arrow (second, (***))

8import Control.Arrow (second, (***))

5import Data.Char (isAlpha)

9import Data.Char (isAlpha)

6

10

compiler/Transform/SafeNames.hsnew file+78

@@ -0,0 +1,78 @@

1+{-# OPTIONS_GHC -Wall #-}

2+module Transform.SafeNames (metadataModule) where

3+

4+import Control.Arrow (first, (***))

5+import SourceSyntax.Expression

6+import SourceSyntax.Location

7+import SourceSyntax.Module

8+import SourceSyntax.Pattern

9+import qualified Data.Set as Set

10+import qualified Parse.Helpers as PHelp

11+

12+var :: String -> String

13+var = dereserve . deprime

14+ where

15+ deprime = map (\c -> if c == '\'' then '$' else c)

16+ dereserve x = case Set.member x PHelp.jsReserveds of

17+ False -> x

18+ True -> "$" ++ x

19+

20+pattern :: Pattern -> Pattern

21+pattern pat =

22+ case pat of

23+ PVar x -> PVar (var x)

24+ PLiteral _ -> pat

25+ PRecord fs -> PRecord (map var fs)

26+ PAnything -> pat

27+ PAlias x p -> PAlias (var x) (pattern p)

28+ PData name ps -> PData name (map pattern ps)

29+

30+expression :: LExpr t v -> LExpr t v

31+expression (L loc expr) =

32+ let f = expression in

33+ L loc $

34+ case expr of

35+ Literal _ -> expr

36+ Var x -> Var (var x)

37+ Range e1 e2 -> Range (f e1) (f e2)

38+ ExplicitList es -> ExplicitList (map f es)

39+ Binop op e1 e2 -> Binop op (f e1) (f e2)

40+ Lambda p e -> Lambda (pattern p) (f e)

41+ App e1 e2 -> App (f e1) (f e2)

42+ MultiIf ps -> MultiIf (map (f *** f) ps)

43+ Let defs body -> Let (map definition defs) (f body)

44+ Case e cases -> Case (f e) $ map (pattern *** f) cases

45+ Data name es -> Data name (map f es)

46+ Access e x -> Access (f e) (var x)

47+ Remove e x -> Remove (f e) (var x)

48+ Insert e x v -> Insert (f e) (var x) (f v)

49+ Modify r fs -> Modify (f r) (map (var *** f) fs)

50+ Record fs -> Record (map (var *** f) fs)

51+ Markdown uid md es -> Markdown uid md (map f es)

52+

53+definition :: Def t v -> Def t v

54+definition def =

55+ case def of

56+ Def p e -> Def (pattern p) (expression e)

57+ TypeAnnotation name t -> TypeAnnotation (var name) t

58+

59+metadataModule :: MetadataModule t v -> MetadataModule t v

60+metadataModule modul =

61+ modul

62+ { names = map var (names modul)

63+ , exports = map var (exports modul)

64+ , imports = map (first var) (imports modul)

65+ , program = expression (program modul)

66+ , aliases =

67+ let makeSafe (name, tvars, tipe) = (var name, tvars, tipe)

68+ in map makeSafe (aliases modul)

69+ , datatypes =

70+ let makeSafe (name,tvars,ctors) = (var name, tvars, map (first var) ctors)

71+ in map makeSafe (datatypes modul)

72+ , foreignImports =

73+ let makeSafe (js,expr,elm,tipe) = (js, expression expr, var elm, tipe)

74+ in map makeSafe (foreignImports modul)

75+ , foreignExports =

76+ let makeSafe (js,elm,tipe) = (js, var elm, tipe)

77+ in map makeSafe (foreignExports modul)

78+ }

compiler/Transform/SortDefinitions.hs+3−1

@@ -8,7 +8,9 @@ import Control.Applicative ((<$>))

8import qualified Data.Set as Set

9import qualified Data.Map as Map

10import qualified SourceSyntax.Type as ST

11−import SourceSyntax.Everything

11+import SourceSyntax.Expression

12+import SourceSyntax.Location

13+import SourceSyntax.Pattern

12import qualified Data.Graph as Graph

14import qualified Data.Graph as Graph

13import qualified Data.Map as Map

15import qualified Data.Map as Map

14import qualified Data.Maybe as Maybe

16import qualified Data.Maybe as Maybe

compiler/Type/Constrain/Declaration.hs+13−11

@@ -9,7 +9,9 @@ import qualified Type.Constrain.Expression as TcExpr

9import qualified Type.Environment as Env

10

11import SourceSyntax.Declaration

12−import qualified SourceSyntax.Everything as Src

12+import qualified SourceSyntax.Expression as Src

13+import qualified SourceSyntax.Location as L

14+import qualified SourceSyntax.Pattern as P

13import qualified SourceSyntax.Type as Type

15import qualified SourceSyntax.Type as Type

14

16

15toExpr :: [Declaration t v] -> [Src.Def t v]

17toExpr :: [Declaration t v] -> [Src.Def t v]

@@ -25,34 +27,34 @@ toDefs decl =

25 toDefs (ctor, tipes) =

27 toDefs (ctor, tipes) =

26 let vars = take (length tipes) arguments

28 let vars = take (length tipes) arguments

27 tbody = Type.Data name $ map Type.Var tvars

29 tbody = Type.Data name $ map Type.Var tvars

28− body = Src.none . Src.Data ctor $ map (Src.none . Src.Var) vars

30+ body = L.none . Src.Data ctor $ map (L.none . Src.Var) vars

29 in [ Src.TypeAnnotation ctor $ foldr Type.Lambda tbody tipes

31 in [ Src.TypeAnnotation ctor $ foldr Type.Lambda tbody tipes

30− , Src.Def (Src.PVar ctor) $ buildFunction body vars

32+ , Src.Def (P.PVar ctor) $ buildFunction body vars

31 ]

33 ]

32

34

33 TypeAlias name tvars tipe@(Type.Record fields ext) ->

35 TypeAlias name tvars tipe@(Type.Record fields ext) ->

34 [ Src.TypeAnnotation name $ foldr Type.Lambda tipe args

36 [ Src.TypeAnnotation name $ foldr Type.Lambda tipe args

35− , Src.Def (Src.PVar name) $ buildFunction record vars ]

37+ , Src.Def (P.PVar name) $ buildFunction record vars ]

36 where

38 where

37 args = case ext of

39 args = case ext of

38 Type.EmptyRecord -> map snd fields

40 Type.EmptyRecord -> map snd fields

39 _ -> map snd fields ++ [ext]

41 _ -> map snd fields ++ [ext]

40

42

41− var = Src.none . Src.Var

43+ var = L.none . Src.Var

42 vars = take (length args) arguments

44 vars = take (length args) arguments

43

45

44 efields = zip (map fst fields) (map var vars)

46 efields = zip (map fst fields) (map var vars)

45 record = case ext of

47 record = case ext of

46− Type.EmptyRecord -> Src.none $ Src.Record efields

48+ Type.EmptyRecord -> L.none $ Src.Record efields

47− _ -> foldl (\r (f,v) -> Src.none $ Src.Insert r f v) (var $ last vars) efields

49+ _ -> foldl (\r (f,v) -> L.none $ Src.Insert r f v) (var $ last vars) efields

48

50

49 -- Type aliases must be added to an extended equality dictionary,

51 -- Type aliases must be added to an extended equality dictionary,

50 -- but they do not require any basic constraints.

52 -- but they do not require any basic constraints.

51 TypeAlias _ _ _ -> []

53 TypeAlias _ _ _ -> []

52

54

53− ImportEvent _ expr@(Src.L s _) name tipe ->

55+ ImportEvent _ expr@(L.L s _) name tipe ->

54 [ Src.TypeAnnotation name tipe

56 [ Src.TypeAnnotation name tipe

55− , Src.Def (Src.PVar name) (Src.L s $ Src.App (Src.L s $ Src.Var "constant") expr) ]

57+ , Src.Def (P.PVar name) (L.L s $ Src.App (L.L s $ Src.Var "constant") expr) ]

56

58

57 ExportEvent _ name tipe ->

59 ExportEvent _ name tipe ->

58 [ Src.TypeAnnotation name tipe ]

60 [ Src.TypeAnnotation name tipe ]

@@ -64,5 +66,5 @@ toDefs decl =

64arguments :: [String]

66arguments :: [String]

65arguments = map (:[]) ['a'..'z'] ++ map (\n -> "_" ++ show n) [1..]

67arguments = map (:[]) ['a'..'z'] ++ map (\n -> "_" ++ show n) [1..]

66

68

67−buildFunction body@(Src.L s _) vars =

69+buildFunction body@(L.L s _) vars =

68− foldr (\p e -> Src.L s (Src.Lambda p e)) body (map Src.PVar vars)

70+ foldr (\p e -> L.L s (Src.Lambda p e)) body (map P.PVar vars)

compiler/Type/Solve.hs+3−3

@@ -174,11 +174,11 @@ allDistinct span vars = do

174 desc <- liftIO $ UF.descriptor var

175 case structure desc of

176 Just _ -> TS.addError span (Just msg) var var

177− where msg = "Cannot generalize something that is not a type variable"

177+ where msg = "Cannot generalize something that is not a type variable."

178

179 Nothing -> do

180 if mark desc == seen

181− then let msg = "Duplicate variable during generalization"

181+ then let msg = "Duplicate variable during generalization."

182 in TS.addError span (Just msg) var var

183 else return ()

184 liftIO $ UF.setDescriptor var (desc { mark = seen })

@@ -190,5 +190,5 @@ isGeneric span var = do

190 desc <- liftIO $ UF.descriptor var

191 if rank desc == noRank

192 then return ()

193− else let msg = "Unable to generalize a type variable. It is not unranked"

193+ else let msg = "Unable to generalize a type variable. It is not unranked."

194 in TS.addError span (Just msg) var var

compiler/Type/State.hs+7−12

@@ -56,13 +56,11 @@ addError span hint t1 t2 =

56 t1' <- prettiest <$> toSrcType t1

57 t2' <- prettiest <$> toSrcType t2

58 return . P.vcat $

59+ [ P.text $ "Type error" ++ location ++ ":"

60+ , maybe P.empty P.text hint

59− [ display $ case span of { NoSpan msg -> msg ; Span _ _ msg -> msg }

61+ , display $ case span of { NoSpan msg -> msg ; Span _ _ msg -> msg }

60− , case hint of

62+ , P.text " Expected Type:" <+> t1'

61− Nothing -> P.text " Could not match the following types:"

62− Just msg -> P.text $ eightyCharLines 2 $

63− msg ++ ", so I could not match the following types:"

64− , P.text " " <> t1'

65− , P.text " " <> t2'

63+ , P.text " Actual Type:" <+> t2'

66 ]

64 ]

67

65

68 location = case span of

66 location = case span of

@@ -72,11 +70,8 @@ addError span hint t1 t2 =

72 else " between lines " ++ show (line p1) ++ " and " ++ show (line p2)

70 else " between lines " ++ show (line p1) ++ " and " ++ show (line p2)

73

71

74 display msg =

72 display msg =

75− case lines msg of

73+ P.vcat [ P.text $ concatMap ("\n "++) (lines msg)

76− [] -> P.text $ "Type error" ++ location ++ ":"

74+ , P.text " " ]

77− lines' ->

78− P.vcat [ P.text $ "Type error" ++ location ++ ", in or near this expression:"

79− , P.text $ " " ++ List.intercalate "\n " lines' ]

80

75

81

76

82switchToPool pool = modifyPool (\_ -> pool)

77switchToPool pool = modifyPool (\_ -> pool)

compiler/Type/Unify.hs+6−10

@@ -80,11 +80,11 @@ actuallyUnify span variable1 variable2 = do

80 unifyNumber svar name

81 | name `elem` ["Int","Float","number"] = flexAndUnify svar

82 | otherwise = TS.addError span (Just hint) variable1 variable2

83− where hint = "A number must be an Int or Float"

83+ where hint = "A number must be an Int or Float."

84

85 comparableError maybe =

86 TS.addError span (Just $ Maybe.fromMaybe msg maybe) variable1 variable2

87− where msg = "A comparable must be an Int, Float, Char, String, list, or tuple"

87+ where msg = "A comparable must be an Int, Float, Char, String, list, or tuple."

88

89 unifyComparable var name

90 | name `elem` ["Int","Float","Char","String","comparable"] = flexAndUnify var

@@ -98,7 +98,7 @@ actuallyUnify span variable1 variable2 = do

98 unify' v =<< liftIO (var $ Is Comparable)

99 Tuple vs

100 | length vs > 6 ->

101− comparableError $ Just "Cannot compare a tuple with more than 6 elements"

101+ comparableError $ Just "Cannot compare a tuple with more than 6 elements."

102 | otherwise ->

103 do flexAndUnify varSuper

104 cmpVars <- liftIO $ forM [1..length vs] $ \_ -> var (Is Comparable)

@@ -113,13 +113,9 @@ actuallyUnify span variable1 variable2 = do

113 rigidError variable = TS.addError span (Just hint) variable1 variable2

114 where

115 var = "'" ++ render (pretty Never variable) ++ "'"

116− hint = concat

116+ hint = "Cannot unify rigid type variable " ++ var ++

117− [ "This probably relates to a type annotation. A type "

117+ ".\nThe problem probably relates to a type annotation. Note that rigid type\n\

118− , "annotation may say ", var, " but should be a more "

119− , "specific type. Also, type variables are not "

120− , "shared between type annotations, so ", var, " in one "

118+ \variables are not shared between a top-level and let-bound type annotations."

121− , "is not the same as " ++ var ++ " in another. "

122− , "Something like that happened" ]

123

119

124 superUnify =

120 superUnify =

125 case (flex desc1, flex desc2, name desc1, name desc2) of

121 case (flex desc1, flex desc2, name desc1, name desc2) of

libraries/Automaton.elm → libraries/Automaton.elm.hiddenrenamed

The content is the same.

libraries/Dict.elm+39−27

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

1−module Dict (empty,singleton,insert

1+module Dict (empty,singleton,insert,update

2 ,lookup,findWithDefault

3 ,remove,member

4 ,foldl,foldr,map

@@ -14,7 +14,7 @@ lists of comparable types.

14Insert, remove, and query operations all take *O(log n)* time.

15

16# Build

17−@docs empty, singleton, insert, remove

17+@docs empty, singleton, insert, update, remove

18

19# Query

20@docs member, lookup, findWithDefault

@@ -148,18 +148,44 @@ ensureBlackRoot t =

148{-| Insert a key-value pair into a dictionary. Replaces value when there is

149a collision. -}

150insert : comparable -> v -> Dict comparable v -> Dict comparable v

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

151+insert k v t = let u _ = Just v in

152− let ins t =

152+ update k u t

153− case t of

154− RBEmpty LBlack -> RBNode Red k v (RBEmpty LBlack) (RBEmpty LBlack)

155− RBNode c k' v' l r ->

156− let h = case Native.Utils.compare k k' of

157− LT -> RBNode c k' v' (ins l) r

158− EQ -> RBNode c k' v l r -- replace

159− GT -> RBNode c k' v' l (ins r)

160− in fixUp h

161− in ensureBlackRoot (ins t)

162

153

154+{-| Remove a key-value pair from a dictionary. If the key is not found,

155+no changes are made. -}

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

157+remove k t = let u _ = Nothing in

158+ update k u t

159+

160+data Flag = Insert | Remove | Same

161+

162+{-| Update the value of a dictionary for a specific key with a given function. -}

163+update : comparable -> (Maybe v -> Maybe v) -> Dict comparable v -> Dict comparable v

164+update k u t =

165+ let up t = case t of

166+ RBEmpty LBlack -> case u Nothing of

167+ Nothing -> (Same, empty)

168+ Just v -> (Insert, RBNode Red k v empty empty)

169+ RBNode c k' v l r -> case Native.Utils.compare k k' of

170+ EQ -> case u (Just v) of

171+ Nothing -> (Remove, rem t)

172+ Just v' -> (Same, RBNode c k' v' l r)

173+ LT -> let (fl, l') = up l in

174+ case fl of

175+ Same -> (Same, RBNode c k' v l' r)

176+ Insert -> (Insert, fixUp <| RBNode c k' v l' r)

177+ Remove -> (Remove, bubble c k' v l' r)

178+ GT -> let (fl, r') = up r in

179+ case fl of

180+ Same -> (Same, RBNode c k' v l r')

181+ Insert -> (Insert, fixUp <| RBNode c k' v l r')

182+ Remove -> (Remove, bubble c k' v l r')

183+ (fl, t') = up t

184+ in case fl of

185+ Same -> t'

186+ Insert -> ensureBlackRoot t'

187+ Remove -> blacken t'

188+

163{-| Create a dictionary with one key-value pair. -}

189{-| Create a dictionary with one key-value pair. -}

164singleton : comparable -> v -> Dict comparable v

190singleton : comparable -> v -> Dict comparable v

165singleton k v = insert k v (RBEmpty LBlack)

191singleton k v = insert k v (RBEmpty LBlack)

@@ -198,15 +224,6 @@ lessBlackTree t = case t of

198 RBNode c k v l r -> RBNode (lessBlack c) k v l r

224 RBNode c k v l r -> RBNode (lessBlack c) k v l r

199 RBEmpty _ -> RBEmpty LBlack

225 RBEmpty _ -> RBEmpty LBlack

200

226

201−-- Finds and deletes k in t

202−del : comparable -> Dict comparable v -> Dict comparable v

203−del k t = case t of

204− RBEmpty _ -> t

205− RBNode c k' v l r -> case Native.Utils.compare k k' of

206− LT -> bubble c k' v (del k l) r

207− EQ -> rem t

208− GT -> bubble c k' v l (del k r)

209−

210-- Remove the top node from the tree, may leave behind BBlacks

227-- Remove the top node from the tree, may leave behind BBlacks

211rem : Dict k v -> Dict k v

228rem : Dict k v -> Dict k v

212rem t = case t of

229rem t = case t of

@@ -286,11 +303,6 @@ redden t = case t of

286 RBEmpty _ -> Native.Error.raise "can't make a Leaf red"

303 RBEmpty _ -> Native.Error.raise "can't make a Leaf red"

287 RBNode _ k v l r -> RBNode Red k v l r

304 RBNode _ k v l r -> RBNode Red k v l r

288

305

289−{-| Remove a key-value pair from a dictionary. If the key is not found,

290−no changes are made. -}

291−remove : comparable -> Dict comparable v -> Dict comparable v

292−remove k t = blacken <| del k t

293−

294{-| Apply a function to all values in a dictionary. -}

306{-| Apply a function to all values in a dictionary. -}

295map : (a -> b) -> Dict comparable a -> Dict comparable b

307map : (a -> b) -> Dict comparable a -> Dict comparable b

296map f t =

308map f t =

libraries/Graphics/Element.elm+10−3

@@ -22,7 +22,7 @@ with `flow` in specific cases:

22@docs layers, above, below, beside

23

24# Positioning

25−@docs spacer, container

25+@docs empty, spacer, container

26

27## Specific Positions

28

@@ -58,6 +58,13 @@ type Properties = {

58

59type Element = { props : Properties, element : ElementPrim }

60

61+{-| An Element that takes up no space. Good for things that appear conditionally:

62+

63+ flow down [ img1, if showMore then img2 else empty ]

64+-}

65+empty : Element

66+empty = spacer 0 0

67+

61{-| Get the width of an Element -}

68{-| Get the width of an Element -}

62widthOf : Element -> Int

69widthOf : Element -> Int

63widthOf e = e.props.width

70widthOf e = e.props.width

@@ -195,7 +202,7 @@ flow dir es =

195 hs = List.map heightOf es

202 hs = List.map heightOf es

196 newFlow w h = newElement w h (Flow dir es)

203 newFlow w h = newElement w h (Flow dir es)

197 in

204 in

198− if es == [] then spacer 0 0 else

205+ if es == [] then empty else

199 case dir of

206 case dir of

200 DUp -> newFlow (List.maximum ws) (List.sum hs)

207 DUp -> newFlow (List.maximum ws) (List.sum hs)

201 DDown -> newFlow (List.maximum ws) (List.sum hs)

208 DDown -> newFlow (List.maximum ws) (List.sum hs)

@@ -302,4 +309,4 @@ inward : Direction

302inward = DIn

309inward = DIn

303

310

304outward : Direction

311outward : Direction

305−outward = DOut

312+outward = DOut

libraries/JavaScript.elm+4

@@ -5,6 +5,10 @@ module JavaScript where

5the internal data structures of Elm to change and improve with no impact on JS

6integration.

7

8+It is intended to be imported as `import JavaScript as JS`. That way functions

9+like `JS.toInt` convert JavaScript *to* Elm integers and functions like

10+`JS.fromString` gets JavaScript *from* Elm strings.

11+

8# Javascript to Elm

12# Javascript to Elm

9@docs toString, toInt, toFloat, toBool, toList

13@docs toString, toInt, toFloat, toBool, toList

10

14

libraries/Native/Prelude.jsdeleted−52

@@ -1,52 +0,0 @@

1−Elm.Native.Prelude = {};

2−Elm.Native.Prelude.make = function(elm) {

3− elm.Native = elm.Native || {};

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

5− if (elm.Native.Prelude.values) return elm.Native.Prelude.values;

6−

7− var JS = Elm.Native.JavaScript.make(elm);

8− var Maybe = Elm.Maybe.make(elm);

9− var Char = Elm.Char.make(elm);

10−

11− function readInt(str) {

12− var s = JS.fromString(str);

13− var len = s.length;

14− if (len === 0) { return Maybe.Nothing; }

15− var start = 0;

16− if (s[0] == '-') {

17− if (len === 1) { return Maybe.Nothing; }

18− start = 1;

19− }

20− for (var i = start; i < len; ++i) {

21− if (!Char.isDigit(s[i])) { return Maybe.Nothing; }

22− }

23− return Maybe.Just(parseInt(s, 10));

24− }

25−

26− function readFloat(str) {

27− var s = JS.fromString(str);

28− var len = s.length;

29− if (len === 0) { return Maybe.Nothing; }

30− var start = 0;

31− if (s[0] == '-') {

32− if (len === 1) { return Maybe.Nothing; }

33− start = 1;

34− }

35− var dotCount = 0;

36− for (var i = start; i < len; ++i) {

37− if (Char.isDigit(s[i])) { continue; }

38− if (s[i] === '.') {

39− dotCount += 1;

40− if (dotCount <= 1) { continue; }

41− }

42− return Maybe.Nothing;

43− }

44− return Maybe.Just(parseFloat(s));

45− }

46−

47− return elm.Native.Prelude.values = {

48− readInt:readInt,

49− readFloat:readFloat

50− };

51−

52−};

libraries/Native/Utils.js+3−1

@@ -25,7 +25,9 @@ Elm.Native.Utils.make = function(elm) {

25 function compare(x,y) { return { ctor: ord[cmp(x,y)+1] } }

26 function cmp(x,y) {

27 var ord;

28+ if (typeof x !== 'object' || x instanceof String){

28− if (typeof x !== 'object') return x === y ? EQ : x < y ? LT : GT;

29+ return x === y ? EQ : x < y ? LT : GT;

30+ }

29

31

30 if (x.ctor === "::" || x.ctor === "[]") {

32 if (x.ctor === "::" || x.ctor === "[]") {

31 while (true) {

33 while (true) {

libraries/Prelude.elm+1−12

@@ -1,19 +1,8 @@

1module Prelude where

2{-| Everything that is automatically imported -}

3

4−import Basics (String)

5−import Maybe (Maybe)

6−import Native.Prelude

7import Native.Show

4import Native.Show

8

5

9-- Convert almost any value to its string representation.

6-- Convert almost any value to its string representation.

10show : a -> String

7show : a -> String

11−show = Native.Show.show

8+show = Native.Show.show

12−

13−-- Read an integer from a string

14−readInt : String -> Maybe Int

15−readInt = Native.Prelude.readInt

16−

17−-- Read a float from a string.

18−readFloat : String -> Maybe Float

19−readFloat = Native.Prelude.readFloat

libraries/elm_dependencies.json+1−2

@@ -6,8 +6,7 @@

6, "elm-version": "0.10.0.2"

7, "dependencies": {}

8, "exposed-modules":

9− [ "Automaton"

10− , "Basics"

9+ [ "Basics"

11 , "Bitwise"

10 , "Bitwise"

12 , "Char"

11 , "Char"

13 , "Color"

12 , "Color"

tests/Main.hs+7−18

@@ -1,22 +1,11 @@

1module Main where

2

3−import System.Directory

4−import System.Exit (exitWith)

5−import System.Environment (getArgs)

6−import Test.Framework.TestManager

7−import Test.Framework.BlackBoxTest

3+import Test.Framework

8

4

9−main :: IO ()

5+import Tests.Compiler

10−main = do

6+import Tests.Property

11− args <- getArgs

12− tests <- blackBoxTests "tests" "dist/build/elm/elm" ".elm" bbtArgs

13− code <- runTestWithArgs args tests

14− removeDirectoryRecursive "cache"

15− removeDirectoryRecursive "build"

16− exitWith code

17−

18−bbtArgs = defaultBBTArgs { bbtArgs_stdoutDiff = ignoreDiff

19− , bbtArgs_stderrDiff = ignoreDiff }

20

7

21−ignoreDiff :: Diff

8+main :: IO ()

22−ignoreDiff _ _ = return Nothing

9+main = defaultMain [ compilerTests

10+ , propertyTests

11+ ]

tests/Tests/Compiler.hsnew file+38

@@ -0,0 +1,38 @@

1+module Tests.Compiler (compilerTests)

2+ where

3+

4+import Data.Functor ((<$>))

5+import Data.Traversable (traverse)

6+import System.FilePath ((</>))

7+import System.FilePath.Find (find, (==?), extension)

8+import Test.Framework

9+import Test.Framework.Providers.HUnit (testCase)

10+import Test.HUnit ((@=?), Assertion)

11+

12+import Elm.Internal.Utils as Elm

13+

14+compilerTests :: Test

15+compilerTests = buildTest $ do

16+ goods <- mkTests True =<< getElms "good"

17+ bads <- mkTests False =<< getElms "bad"

18+ return $ testGroup "Compile Tests"

19+ [

20+ testGroup "Good Tests" goods

21+ , testGroup "Bad Tests" bads

22+ ]

23+

24+ where getElms :: FilePath -> IO [FilePath]

25+ getElms fname = find (return True) (extension ==? ".elm") (testsDir </> fname)

26+

27+ mkTests :: Bool -> [FilePath] -> IO [Test]

28+ mkTests b = traverse setupTest

29+ where setupTest f = testCase f . mkCompileTest b <$> readFile f

30+

31+ testsDir = "tests" </> "data"

32+

33+mkCompileTest :: Bool -- ^ Expect success?

34+ -> String -- ^ File Contents

35+ -> Assertion

36+mkCompileTest succ modul = noCompileErr @=? succ

37+ where noCompileErr = either (const False) (const True) . Elm.compile $ modul

38+ expectation = "Compile " ++ if succ then "Success" else "Error"

tests/Tests/Property.hsnew file+51

@@ -0,0 +1,51 @@

1+module Tests.Property where

2+

3+import Control.Applicative ((<*))

4+import Test.Framework

5+import Test.Framework.Providers.HUnit

6+import Test.Framework.Providers.QuickCheck2

7+import Test.HUnit (assert)

8+import Test.QuickCheck

9+import Text.Parsec.Combinator (eof)

10+

11+import SourceSyntax.Literal as Lit

12+import SourceSyntax.Pattern as Pat

13+import SourceSyntax.PrettyPrint (Pretty, pretty)

14+import Parse.Helpers (IParser, iParse)

15+import Parse.Literal (literal)

16+import Parse.Pattern (expr)

17+import Tests.Property.Arbitrary

18+

19+propertyTests :: Test

20+propertyTests =

21+ testGroup "Parse/Print Agreement Tests"

22+ [

23+ testCase "Long Pattern test" $ assert (prop_parse_print expr longPat)

24+ , testProperty "Literal test" $ prop_parse_print literal

25+ , testProperty "Pattern test" $ prop_parse_print expr

26+ ]

27+

28+ where

29+ -- This test was autogenerated from the Pattern test and should be

30+ -- left in all its ugly glory.

31+ longPat = Pat.PData "I" [ Pat.PLiteral (Lit.Chr '+')

32+ , Pat.PRecord [

33+ "q7yclkcm7k_ikstrczv_"

34+ , "wQRv6gKsvvkjw4b5F"

35+ ,"c9'eFfhk9FTvsMnwF_D"

36+ ,"yqxhEkHvRFwZ"

37+ ,"o"

38+ ,"nbUlCn3y3NnkVoxhW"

39+ ,"iJ0MNy3KZ_lrs"

40+ ,"ug"

41+ ,"sHHsX"

42+ ,"mRKs9d"

43+ ,"o2KiCX5'ZRzHJfRi8" ]

44+ , Pat.PVar "su'BrrbPUK6I33Eq" ]

45+

46+prop_parse_print :: (Pretty a, Arbitrary a, Eq a) => IParser a -> a -> Bool

47+prop_parse_print p x =

48+ either (const False) (== x) . parse_print p $ x

49+

50+parse_print :: (Pretty a) => IParser a -> a -> Either String a

51+parse_print p = either (Left . show) (Right) . iParse (p <* eof) . show . pretty

tests/Tests/Property/Arbitrary.hsnew file+75

@@ -0,0 +1,75 @@

1+{-# OPTIONS_GHC -fno-warn-orphans #-}

2+module Tests.Property.Arbitrary where

3+

4+import Control.Applicative ((<$>), (<*>), pure)

5+import Test.QuickCheck.Arbitrary

6+import Test.QuickCheck.Gen

7+

8+import qualified Data.Set as Set

9+import qualified Parse.Helpers (reserveds)

10+

11+import SourceSyntax.Literal

12+import SourceSyntax.Pattern

13+

14+instance Arbitrary Literal where

15+ arbitrary = oneof [ IntNum <$> arbitrary

16+ , FloatNum <$> (arbitrary `suchThat` noE)

17+ , Chr <$> arbitrary

18+ -- This is too permissive

19+ , Str <$> arbitrary

20+ -- Booleans aren't actually source syntax

21+ -- , Boolean <$> arbitrary

22+ ]

23+ shrink l = case l of

24+ IntNum n -> IntNum <$> shrink n

25+ FloatNum f -> FloatNum <$> (filter noE . shrink $ f)

26+ Chr c -> Chr <$> shrink c

27+ Str s -> Str <$> shrink s

28+ Boolean b -> Boolean <$> shrink b

29+

30+noE :: Double -> Bool

31+noE = notElem 'e' . show

32+

33+

34+instance Arbitrary Pattern where

35+ arbitrary = sized pat

36+ where pat :: Int -> Gen Pattern

37+ pat n = oneof [ pure PAnything

38+ , PVar <$> lowVar

39+ , PRecord <$> (listOf1 lowVar)

40+ , PLiteral <$> arbitrary

41+ , PAlias <$> lowVar <*> pat (n-1)

42+ , PData <$> capVar <*> sizedPats

43+ ]

44+ where sizedPats = do

45+ len <- choose (0,n)

46+ let m = n `div` len in

47+ vectorOf len $ pat m

48+

49+ shrink pat = case pat of

50+ PAnything -> []

51+ PVar v -> PVar <$> shrinkWHead v

52+ PRecord fs -> PRecord <$> (filter (all $ not . null) . filter (not . null) $ shrink fs)

53+ PLiteral l -> PLiteral <$> shrink l

54+ PAlias s p -> p : (PAlias <$> shrinkWHead s <*> shrink p)

55+ PData s ps -> ps ++ (PData <$> shrinkWHead s <*> shrink ps)

56+ where shrinkWHead (x:xs) = (x:) <$> shrink xs

57+

58+lowVar :: Gen String

59+lowVar = notReserved $ (:) <$> lower <*> listOf varLetter

60+ where lower = elements ['a'..'z']

61+

62+capVar :: Gen String

63+capVar = notReserved $ (:) <$> upper <*> listOf varLetter

64+ where upper = elements ['A'..'Z']

65+

66+varLetter :: Gen Char

67+varLetter = elements $ ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ ['\'', '_']

68+

69+notReserved :: Gen String -> Gen String

70+notReserved = flip exceptFor Parse.Helpers.reserveds

71+

72+exceptFor :: (Ord a) => Gen a -> [a] -> Gen a

73+exceptFor g xs = g `suchThat` notAnX

74+ where notAnX = flip Set.notMember xset

75+ xset = Set.fromList xs

tests/bad/BBTArgs → tests/data/bad/BBTArgsrenamed

The content is the same.

tests/bad/InfiniteType.elm → tests/data/bad/InfiniteType.elmrenamed

The content is the same.

tests/bad/NonElementMain.elm → tests/data/bad/NonElementMain.elmrenamed

The content is the same.

tests/good/AliasSubstitution.elm → tests/data/good/AliasSubstitution.elmrenamed

The content is the same.

tests/good/NoExpressions.elm → tests/data/good/NoExpressions.elmrenamed

The content is the same.

tests/data/good/Otherwise.elmnew file+5

@@ -0,0 +1,5 @@

1+module Otherwise where

2+

3+otherwise = 3

4+

5+main = asText <| if False then "Yay" else "Boo"

tests/data/good/QuotesAndComments.elmnew file+12

@@ -0,0 +1,12 @@

1+f x =

2+ let

3+ x' = x+1

4+ in

5+ x'

6+

7+g = '\"'

8+

9+n = '\''

10+

11+{- this is an {- embeded comment -} -}

12+main = plainText "{-"

tests/good/Soundness/Apply.elm → tests/data/good/Soundness/Apply.elmrenamed

The content is the same.

tests/good/Soundness/ApplyAnnotated.elm → tests/data/good/Soundness/ApplyAnnotated.elmrenamed

The content is the same.

tests/good/Soundness/Id.elm → tests/data/good/Soundness/Id.elmrenamed

The content is the same.

tests/good/Soundness/IdAnnotated.elm → tests/data/good/Soundness/IdAnnotated.elmrenamed

The content is the same.

tests/good/Soundness/TrickyId.elm → tests/data/good/Soundness/TrickyId.elmrenamed

The content is the same.

tests/good/Soundness/TrickyIdAnnotated.elm → tests/data/good/Soundness/TrickyIdAnnotated.elmrenamed

The content is the same.

tests/good/Unify/LockedVars.elm → tests/data/good/Unify/LockedVars.elmrenamed

The content is the same.

tests/good/Unify/NonHomogeneousRecords.elm → tests/data/good/Unify/NonHomogeneousRecords.elmrenamed

The content is the same.