9dfcb50 · elk · git.iko.soy

CONTRIBUTING.mdnew file+35

@@ -0,0 +1,35 @@

1+# Contributing to Elm

2+

3+Thanks helping with the development of Elm! This document

4+describes the basic standards for opening pull requests:

5+

6+## Branches

7+

8+ * The master branch of Elm is for tagging previous releases

9+ and non-breaking changes, like bug fixes. This branch is

10+ handy for folks who want to build the most recent public

11+ release from source.

12+

13+ * The dev branch is where the most active development occurs.

14+ It is the home of the next release of the compiler so new

15+ features and improvements get merged there.

16+

17+## Opening a pull request

18+

19+**Please open PRs against the [dev branch of

20+Elm](http://github.com/evancz/elm/tree/dev) whenever possible.** Changes that

21+are compatible with the API of master will be merged to master as soon as

22+possible. Changes that affect Elm's API will be merged to master with a future

23+release of the compiler.

24+

25+Note that changes in the master branch of [Elm](https://github.com/evancz/Elm/)

26+are able to be compiled against the master branch of the [elm-lang.org

27+repo](https://github.com/evancz/elm-lang.org), and the dev branch of

28+[Elm](https://github.com/evancz/Elm/) is able to be built with the dev branch of

29+the [elm-lang.org repo](https://github.com/evancz/elm-lang.org). Please make

30+sure that your changes maintain this compatibility.

31+

32+## Licensing

33+

34+You should sign the [contributor agreement](ContributorAgreement.pdf)

35+and send it to <info@elm-lang.org> before opening your pull request.

Contributor Agreement.docxdeleted

Binary file not shown.

ContributorAgreement.pdfnew file

Binary file not shown.

Elm.cabal+38−17

@@ -30,11 +30,15 @@ source-repository head

3030 location: git://github.com/evancz/Elm.git

3131

3232Library

33− exposed-modules: Language.Elm

33+ exposed-modules: Elm.Internal.Dependencies,

34+ Elm.Internal.Documentation,

35+ Elm.Internal.Name,

36+ Elm.Internal.Paths,

37+ Elm.Internal.Utils,

38+ Elm.Internal.Version

3439 Hs-Source-Dirs: compiler

3540 other-modules: SourceSyntax.Declaration,

3641 SourceSyntax.Expression,

37− SourceSyntax.Everything,

3842 SourceSyntax.Helpers,

3943 SourceSyntax.Literal,

4044 SourceSyntax.Location,

@@ -49,11 +53,12 @@ Library

4953 Generate.Cases,

5054 Transform.Canonicalize,

5155 Transform.Check,

56+ Transform.SafeNames,

5257 Transform.SortDefinitions,

5358 Transform.Substitute,

5459 Transform.Optimize,

5560 Metadata.Prelude,

56− Initialize,

61+ InterfaceSerialization,

5762 Parse.Binop,

5863 Parse.Declaration,

5964 Parse.Expression,

@@ -77,33 +82,41 @@ Library

7782 Type.State,

7883 Type.Type,

7984 Type.Unify,

85+ Build.Dependencies,

86+ Build.File,

87+ Build.Flags,

88+ Build.Print,

89+ Build.Source,

90+ Build.Utils,

8091 Paths_Elm

8192

82− Build-depends: base >=4.2 && <5,

83− binary,

93+ Build-depends: aeson,

94+ base >=4.2 && <5,

95+ binary >= 0.6.4.0,

8496 blaze-html == 0.5.* || == 0.6.*,

85− blaze-markup == 0.5.1.*,

97+ blaze-markup,

8698 bytestring,

8799 cmdargs,

88100 containers >= 0.3,

89101 directory,

90102 filepath,

91103 indents,

92− language-ecmascript < 1,

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

93105 mtl >= 2,

94106 pandoc >= 1.10,

95107 parsec >= 3.1.1,

96108 pretty,

109+ text,

97110 transformers >= 0.2,

98111 union-find,

99− uniplate

112+ unordered-containers

100113

101114Executable elm

102115 Main-is: Compiler.hs

116+ ghc-options: -threaded -O2

103117 Hs-Source-Dirs: compiler

104118 other-modules: SourceSyntax.Declaration,

105119 SourceSyntax.Expression,

106− SourceSyntax.Everything,

107120 SourceSyntax.Helpers,

108121 SourceSyntax.Literal,

109122 SourceSyntax.Location,

@@ -118,11 +131,12 @@ Executable elm

118131 Generate.Cases,

119132 Transform.Canonicalize,

120133 Transform.Check,

134+ Transform.SafeNames,

121135 Transform.SortDefinitions,

122136 Transform.Substitute,

123137 Transform.Optimize,

124138 Metadata.Prelude,

125− Initialize,

139+ InterfaceSerialization,

126140 Parse.Binop,

127141 Parse.Declaration,

128142 Parse.Expression,

@@ -146,10 +160,17 @@ Executable elm

146160 Type.State,

147161 Type.Type,

148162 Type.Unify,

163+ Build.Dependencies,

164+ Build.File,

165+ Build.Flags,

166+ Build.Print,

167+ Build.Source,

168+ Build.Utils,

149169 Paths_Elm

150170

151− Build-depends: base >=4.2 && <5,

152− binary,

171+ Build-depends: aeson,

172+ base >=4.2 && <5,

173+ binary >= 0.6.4.0,

153174 blaze-html == 0.5.* || == 0.6.*,

154175 blaze-markup == 0.5.1.*,

155176 bytestring,

@@ -158,20 +179,20 @@ Executable elm

158179 directory,

159180 filepath,

160181 indents,

161− language-ecmascript < 1,

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

162183 mtl >= 2,

163184 pandoc >= 1.10,

164185 parsec >= 3.1.1,

165186 pretty,

187+ text,

166188 transformers >= 0.2,

167189 union-find,

168− uniplate

190+ unordered-containers

169191

170192Executable elm-doc

171193 Main-is: Docs.hs

172194 Hs-Source-Dirs: compiler

173195 other-modules: SourceSyntax.Declaration,

174− SourceSyntax.Everything,

175196 SourceSyntax.Expression,

176197 SourceSyntax.Helpers,

177198 SourceSyntax.Literal,

@@ -192,7 +213,7 @@ Executable elm-doc

192213 Build-depends: aeson,

193214 aeson-pretty,

194215 base >=4.2 && <5,

195− binary,

216+ binary >= 0.6.4.0,

196217 bytestring,

197218 cmdargs,

198219 containers >= 0.3,

@@ -209,4 +230,4 @@ Test-Suite test-elm

209230 Type: exitcode-stdio-1.0

210231 Hs-Source-Dirs: tests

211232 Main-is: Main.hs

212− build-depends: base, directory, HTF

233+ build-depends: base, directory, HTF

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!

changelog.txt+32−16

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

11

2−Release 0.9.1

3−=============

2+## 0.11

3+

4+ * Lazy and Lazy.Stream (thanks to Max New)

5+ * sortBy, sortWith (thanks to Max Goldstein)

6+ * elm-repl

7+ * Markdown interpolation

8+ * Bitwise library

9+ * Regex library

10+ * Improve Transform2D library (thanks to Michael Søndergaard)

11+

12+## 0.10

13+

14+ * Native strings

15+ * Tango colors

16+ * custom precedence and associativity for infix operators

17+ * elm-doc released with new documentation format

18+ * Realiasing in type errors

19+ * Rename Matrix2D => Transform2D

20+ * Add Random.floatList (thank you Max GoldStein)

21+ * Fix remove function in Dict (thank you Max New)

22+ * Start using language-ecmascript for JS generation

23+ * Make compatable with cabal-1.18 (thank you Justin Leitgeb)

24+ * All functions with 10+ arguments (thanks to Max New)

25+

26+## 0.9.1

427

528 * Allow custom precedence and associativity for user-defined infix ops

629 * Realias types before printing

@@ -10,8 +33,7 @@ Release 0.9.1

1033 * Fix miscellaneous bugs in type checker

1134 * Switch name of Matrix2D to Transform2D

1235

13−Release 0.9

14−===========

36+## 0.9

1537

1638Build Improvements:

1739 * Major speed improvements to type-checker

@@ -62,8 +84,7 @@ Website:

6284forgot to fill this in again...

6385

6486

65−Release 0.7.2

66−=============

87+## 0.7.2

6788

6889* Add a WebSockets library.

6990* Add support for the mathematical looking operator for function composition (U+2218).

@@ -72,8 +93,7 @@ Release 0.7.2

7293forgot to fill this in for a while...

7394

7495

75−Release 0.5.0

76−=============

96+## 0.5.0

7797

7898* Add Dict, Set, and Automaton libraries!

7999

@@ -101,8 +121,7 @@ Release 0.5.0

101121

102122

103123

104−Release 0.4.0

105−=============

124+## 0.4.0

106125

107126This version is all about graphics: nicer API with more features and major

108127efficiency improvements. I am really excited about this release!

@@ -132,8 +151,7 @@ efficiency improvements. I am really excited about this release!

132151

133152

134153

135−Release 0.3.6

136−=============

154+## 0.3.6

137155

138156* Add JSON library.

139157

@@ -165,8 +183,7 @@ Release 0.3.6

165183

166184

167185

168−Release 0.3.5

169−=============

186+## 0.3.5

170187

171188* Add JavaScript event interface. Allows Elm to import and export JS values

172189 and events. This makes it possible to import and export Elements, so users

@@ -213,8 +230,7 @@ Release 0.3.5

213230

214231

215232

216−Release 0.3.0

217−=============

233+## 0.3.0

218234

219235Major Changes (Read this part!)

220236-------------------------------

compiler/Build/Dependencies.hsnew file+131

@@ -0,0 +1,131 @@

1+module Build.Dependencies (getSortedDependencies) where

2+

3+import Data.Data

4+import Control.Applicative

5+import Control.Monad.Error

6+import qualified Control.Monad.State as State

7+import qualified Data.Aeson as Json

8+import qualified Data.ByteString.Lazy.Char8 as BSC

9+import qualified Data.Char as Char

10+import qualified Data.Graph as Graph

11+import qualified Data.List as List

12+import qualified Data.Map as Map

13+import qualified Data.Maybe as Maybe

14+import qualified Data.Set as Set

15+import System.Directory

16+import System.Exit

17+import System.FilePath as FP

18+import System.IO

19+import Text.PrettyPrint (Doc)

20+

21+import qualified SourceSyntax.Module as Module

22+import qualified SourceSyntax.Type as Type

23+import qualified Parse.Parse as Parse

24+import qualified Metadata.Prelude as Prelude

25+import qualified Transform.Check as Check

26+import qualified Transform.SortDefinitions as SD

27+import qualified Type.Inference as TI

28+import qualified Type.Constrain.Declaration as TcDecl

29+import qualified Transform.Canonicalize as Canonical

30+import qualified Elm.Internal.Paths as Path

31+import qualified Elm.Internal.Name as N

32+import qualified Elm.Internal.Version as V

33+import qualified Elm.Internal.Dependencies as Deps

34+

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

36+getSortedDependencies srcDirs builtIns root =

37+ do extras <- extraDependencies

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

39+ result <- runErrorT $ readDeps allSrcDirs builtIns root

40+ case result of

41+ Right deps -> sortDeps deps

42+ Left err -> failure $ err ++ if Maybe.isJust extras then "" else msg

43+ where msg = "\nYou may need to create a " ++

44+ Path.dependencyFile ++

45+ " file if you\nare trying to use a 3rd party library."

46+

47+failure msg = hPutStrLn stderr msg >> exitFailure

48+

49+extraDependencies :: IO (Maybe [FilePath])

50+extraDependencies =

51+ do exists <- doesFileExist Path.dependencyFile

52+ if not exists then return Nothing else Just <$> getPaths

53+ where

54+ getPaths = do

55+ raw <- BSC.readFile Path.dependencyFile

56+ case Json.eitherDecode raw of

57+ Right (Deps.Mini deps) -> mapM validate deps

58+ Left err ->

59+ failure $ "Error reading the " ++ Path.dependencyFile ++ " file:\n" ++ err

60+

61+ validate (name,version) = do

62+ let path = Path.dependencyDirectory </> toPath name version

63+ exists <- doesDirectoryExist path

64+ if exists then return path else failure (notFound name version)

65+

66+ toPath name version = N.toFilePath name </> show version

67+

68+ notFound name version =

69+ unlines

70+ [ "Your " ++ Path.dependencyFile ++ " file says you depend on library"

71+ , show name ++ " " ++ show version ++ " but it was not found."

72+ , "You may need to install it with:"

73+ , ""

74+ , " elm-get install " ++ show name ++ " " ++ show version ]

75+

76+type Deps = (FilePath, String, [String])

77+

78+sortDeps :: [Deps] -> IO [String]

79+sortDeps depends =

80+ if null mistakes

81+ then return (concat sccs)

82+ else failure $ msg ++ unlines (map show mistakes)

83+ where

84+ sccs = map Graph.flattenSCC $ Graph.stronglyConnComp depends

85+

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

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

88+

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

90+readDeps srcDirs builtIns root = do

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

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

93+ where

94+ go :: Set.Set String -> FilePath -> State.StateT (Set.Set String) (ErrorT String IO) [Deps]

95+ go builtIns root = do

96+ (root', txt) <- lift $ getFile srcDirs root

97+ case Parse.dependencies txt of

98+ Left err -> throwError $ msg ++ show err

99+ where msg = "Error resolving dependencies in " ++ root' ++ ":\n"

100+

101+ Right (name,deps) ->

102+ do seen <- State.get

103+ let realDeps = Set.difference (Set.fromList deps) builtIns

104+ newDeps = Set.difference (Set.filter (not . isNative) realDeps) seen

105+ State.put (Set.insert name (Set.union newDeps seen))

106+ rest <- mapM (go builtIns . toFilePath) (Set.toList newDeps)

107+ return ((makeRelative "." root', name, Set.toList realDeps) : concat rest)

108+

109+getFile :: [FilePath] -> FilePath -> ErrorT String IO (FilePath,String)

110+getFile [] path =

111+ throwError $ unlines

112+ [ "Could not find file: " ++ path

113+ , " If it is not in the root directory of your project, use"

114+ , " --src-dir to declare additional locations for source files."

115+ , " If it is part of a 3rd party library, it needs to be declared"

116+ , " as a dependency in the " ++ Path.dependencyFile ++ " file." ]

117+

118+getFile (dir:dirs) path = do

119+ let path' = dir </> path

120+ exists <- liftIO $ doesFileExist path'

121+ case exists of

122+ True -> (,) path' `fmap` liftIO (readFile path')

123+ False -> getFile dirs path

124+

125+isNative name = List.isPrefixOf "Native." name

126+

127+toFilePath :: String -> FilePath

128+toFilePath name = map swapDots name ++ ext

129+ where swapDots '.' = '/'

130+ swapDots c = c

131+ ext = if isNative name then ".js" else ".elm"

compiler/Build/File.hsnew file+106

@@ -0,0 +1,106 @@

1+module Build.File (build) where

2+

3+import Control.Monad (when)

4+import qualified Data.Binary as Binary

5+import qualified Data.List as List

6+import qualified Data.Map as Map

7+import System.Directory

8+import System.Exit

9+import System.FilePath

10+import System.IO

11+

12+import qualified Transform.Canonicalize as Canonical

13+

14+import qualified Data.ByteString.Lazy as L

15+

16+import qualified Build.Utils as Utils

17+import qualified Build.Flags as Flag

18+import qualified Build.Source as Source

19+import qualified Build.Print as Print

20+import qualified Generate.JavaScript as JS

21+import qualified InterfaceSerialization as IS

22+import qualified Parse.Module as Parser

23+import qualified SourceSyntax.Module as M

24+

25+build :: Flag.Flags -> Int -> M.Interfaces -> String -> [FilePath]

26+ -> IO (String, M.Interfaces)

27+build _ _ interfaces moduleName [] =

28+ return (moduleName, interfaces)

29+build flags numModules interfaces _ (filePath:rest) =

30+ do (name,interface) <-

31+ build1 flags (numModules - length rest) numModules interfaces filePath

32+ let interfaces' = Map.insert name interface interfaces

33+ build flags numModules interfaces' name rest

34+

35+

36+build1 :: Flag.Flags -> Int -> Int -> M.Interfaces -> FilePath

37+ -> IO (String, M.ModuleInterface)

38+build1 flags moduleNum numModules interfaces filePath =

39+ do compiled <- alreadyCompiled flags filePath

40+ case compiled of

41+ False -> compile flags number interfaces filePath

42+ True -> retrieve flags interfaces filePath

43+ where

44+ number = "[" ++ show moduleNum ++ " of " ++ show numModules ++ "]"

45+

46+

47+alreadyCompiled :: Flag.Flags -> FilePath -> IO Bool

48+alreadyCompiled flags filePath = do

49+ existsi <- doesFileExist (Utils.elmi flags filePath)

50+ existso <- doesFileExist (Utils.elmo flags filePath)

51+ if not existsi || not existso

52+ then return False

53+ else do tsrc <- getModificationTime filePath

54+ tint <- getModificationTime (Utils.elmo flags filePath)

55+ return (tsrc <= tint)

56+

57+retrieve :: Flag.Flags -> Map.Map String M.ModuleInterface -> FilePath

58+ -> IO (String, M.ModuleInterface)

59+retrieve flags interfaces filePath = do

60+ bytes <- IS.loadInterface (Utils.elmi flags filePath)

61+ let binary = IS.interfaceDecode (Utils.elmi flags filePath) =<< bytes

62+ case IS.validVersion filePath =<< binary of

63+ Right (name, interface) ->

64+ do when (Flag.print_types flags) (Print.interfaceTypes interfaces interface)

65+ return (name, interface)

66+ Left err ->

67+ do hPutStrLn stderr err

68+ exitFailure

69+

70+compile :: Flag.Flags -> String -> M.Interfaces -> FilePath

71+ -> IO (String, M.ModuleInterface)

72+compile flags number interfaces filePath =

73+ do source <- readFile filePath

74+ let name = getName source

75+ printStatus name

76+

77+ createDirectoryIfMissing True (Flag.cache_dir flags)

78+ createDirectoryIfMissing True (Flag.build_dir flags)

79+

80+ metaModule <-

81+ case Source.build (Flag.no_prelude flags) interfaces source of

82+ Right modul -> return modul

83+ Left errors -> do Print.errors errors

84+ exitFailure

85+

86+ when (Flag.print_types flags) $ Print.metaTypes interfaces metaModule

87+

88+ let intermediate = (name, Canonical.interface name $ M.metaToInterface metaModule)

89+ generateCache intermediate metaModule

90+ return intermediate

91+

92+ where

93+ getName source = case Parser.getModuleName source of

94+ Just n -> n

95+ Nothing -> "Main"

96+

97+ printStatus name =

98+ hPutStrLn stdout $ concat [ number, " Compiling ", name

99+ , replicate (max 1 (20 - length name)) ' '

100+ , "( " ++ filePath ++ " )" ]

101+

102+ generateCache intermediate metaModule = do

103+ createDirectoryIfMissing True . dropFileName $ Utils.elmi flags filePath

104+ writeFile (Utils.elmo flags filePath) (JS.generate metaModule)

105+ withBinaryFile (Utils.elmi flags filePath) WriteMode $ \handle ->

106+ L.hPut handle (Binary.encode intermediate)

compiler/Build/Flags.hsnew file+44

@@ -0,0 +1,44 @@

1+{-# LANGUAGE DeriveDataTypeable #-}

2+module Build.Flags where

3+

4+import qualified Elm.Internal.Version as Version

5+import System.Console.CmdArgs

6+

7+data Flags = Flags

8+ { make :: Bool

9+ , files :: [FilePath]

10+ , runtime :: Maybe FilePath

11+ , only_js :: Bool

12+ , print_types :: Bool

13+ , scripts :: [FilePath]

14+ , no_prelude :: Bool

15+ , cache_dir :: FilePath

16+ , build_dir :: FilePath

17+ , src_dir :: [FilePath]

18+ }

19+ deriving (Data,Typeable,Show,Eq)

20+

21+flags = Flags

22+ { files = def &= args &= typ "FILES"

23+ , make = False

24+ &= help "automatically compile dependencies."

25+ , only_js = False

26+ &= help "Compile only to JavaScript."

27+ , no_prelude = False

28+ &= help "Do not import Prelude by default, used only when compiling standard libraries."

29+ , scripts = [] &= typFile

30+ &= help "Load JavaScript files in generated HTML. Files will be included in the given order."

31+ , runtime = Nothing &= typFile

32+ &= help "Specify a custom location for Elm's runtime system."

33+ , cache_dir = "cache" &= typFile

34+ &= help "Directory for files cached to make builds faster. Defaults to cache/ directory."

35+ , build_dir = "build" &= typFile

36+ &= help "Directory for generated HTML and JS files. Defaults to build/ directory."

37+ , src_dir = ["."] &= typFile

38+ &= help "Additional source directories besides project root. Searched when using --make"

39+ , print_types = False

40+ &= help "Print out infered types of top-level definitions."

41+ } &= help "Compile Elm programs to HTML, CSS, and JavaScript."

42+ &= helpArg [explicit, name "help", name "h"]

43+ &= versionArg [explicit, name "version", name "v", summary (show Version.elmVersion)]

44+ &= summary ("The Elm Compiler " ++ show Version.elmVersion ++ ", (c) Evan Czaplicki 2011-2013")

compiler/Build/Print.hsnew file+32

@@ -0,0 +1,32 @@

1+module Build.Print where

2+

3+import qualified Data.Map as Map

4+import qualified Data.List as List

5+import qualified SourceSyntax.Module as M

6+import qualified SourceSyntax.PrettyPrint as Pretty

7+import qualified Type.Alias as Alias

8+import qualified Text.PrettyPrint as P

9+

10+metaTypes :: Map.Map String M.ModuleInterface -> M.MetadataModule () () -> IO ()

11+metaTypes interfaces meta =

12+ types interfaces (M.types meta) (M.aliases meta) (M.imports meta)

13+

14+interfaceTypes :: Map.Map String M.ModuleInterface -> M.ModuleInterface -> IO ()

15+interfaceTypes interfaces iface =

16+ types interfaces (M.iTypes iface) (M.iAliases iface) (M.iImports iface)

17+

18+types interfaces types' aliases imports =

19+ do putStrLn ""

20+ mapM_ printType (Map.toList types')

21+ putStrLn ""

22+ where

23+ rules = Alias.rules interfaces aliases imports

24+

25+ printType (n,t) = do

26+ print $ P.hsep [ Pretty.variable n

27+ , P.text ":"

28+ , Pretty.pretty (Alias.realias rules t) ]

29+

30+errors :: [P.Doc] -> IO ()

31+errors errs =

32+ mapM_ print (List.intersperse (P.text " ") errs)

compiler/Build/Source.hsnew file+65

@@ -0,0 +1,65 @@

1+module Build.Source (build) where

2+

3+import Data.Data

4+import Control.Monad.State

5+import qualified Data.Graph as Graph

6+import qualified Data.List as List

7+import qualified Data.Map as Map

8+import qualified Data.Set as Set

9+import System.Directory

10+import System.Exit

11+import System.FilePath as FP

12+import Text.PrettyPrint (Doc)

13+

14+import SourceSyntax.Declaration

15+import SourceSyntax.Module

16+import qualified SourceSyntax.Expression as Expr

17+import qualified SourceSyntax.Type as Type

18+import qualified Parse.Parse as Parse

19+import qualified Metadata.Prelude as Prelude

20+import qualified Transform.Check as Check

21+import qualified Transform.SortDefinitions as SD

22+import qualified Type.Inference as TI

23+import qualified Type.Constrain.Declaration as TcDecl

24+import qualified Transform.Canonicalize as Canonical

25+

26+build :: Bool -> Interfaces -> String -> Either [Doc] (MetadataModule () ())

27+build noPrelude interfaces source =

28+ do let add = if noPrelude then id else Prelude.add

29+ infixes = Map.fromList . map (\(assoc,lvl,op) -> (op,(lvl,assoc)))

30+ . concatMap iFixities $ Map.elems interfaces

31+

32+ modul@(Module _ _ _ decls') <- add `fmap` Parse.program infixes source

33+

34+ -- check for structural errors

35+ Module names exs ims decls <-

36+ case Check.mistakes decls' of

37+ [] -> return modul

38+ ms -> Left ms

39+

40+ let exports'

41+ | null exs =

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

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

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

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

46+ | otherwise = exs

47+

48+ metaModule <- Canonical.metadataModule interfaces $ MetadataModule {

49+ names = names,

50+ path = FP.joinPath names,

51+ exports = exports',

52+ imports = ims,

53+ -- reorder AST into strongly connected components

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

55+ types = Map.empty,

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

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

58+ aliases = [ (name,tvs,tipe) | TypeAlias name tvs tipe <- decls ],

59+ foreignImports = [ (evt,v,name,typ) | ImportEvent evt v name typ <- decls ],

60+ foreignExports = [ (evt,name,typ) | ExportEvent evt name typ <- decls ]

61+ }

62+

63+ types <- TI.infer interfaces metaModule

64+

65+ return $ metaModule { types = types }

compiler/Build/Utils.hsnew file+20

@@ -0,0 +1,20 @@

1+module Build.Utils where

2+

3+import System.FilePath ((</>), replaceExtension)

4+import qualified Build.Flags as Flag

5+

6+buildPath :: Flag.Flags -> FilePath -> String -> FilePath

7+buildPath flags filePath ext =

8+ Flag.build_dir flags </> replaceExtension filePath ext

9+

10+cachePath :: Flag.Flags -> FilePath -> String -> FilePath

11+cachePath flags filePath ext =

12+ Flag.cache_dir flags </> replaceExtension filePath ext

13+

14+elmo :: Flag.Flags -> FilePath -> FilePath

15+elmo flags filePath =

16+ cachePath flags filePath "elmo"

17+

18+elmi :: Flag.Flags -> FilePath -> FilePath

19+elmi flags filePath =

20+ cachePath flags filePath "elmi"

compiler/Compiler.hs+43−189

@@ -1,214 +1,68 @@

1−{-# LANGUAGE DeriveDataTypeable #-}

21module Main where

32

4−import Control.Monad

3+import Control.Monad (foldM)

54import qualified Data.Map as Map

6−import qualified Data.List as List

7−import qualified Data.Binary as Binary

8−import Data.Version (showVersion)

9−import System.Console.CmdArgs hiding (program)

5+import qualified Data.Maybe as Maybe

6+import Text.Blaze.Html.Renderer.String (renderHtml)

7+import qualified Data.ByteString.Lazy.Char8 as BS

8+import qualified System.Console.CmdArgs as CmdArgs

109import System.Directory

11−import System.Exit

1210import System.FilePath

13−import System.IO

1411import GHC.Conc

1512

16−import Text.Blaze.Html.Renderer.Pretty (renderHtml)

17−import qualified Data.ByteString.Lazy.Char8 as BS

18−import qualified Data.ByteString.Lazy as L

19−

13+import Build.Dependencies (getSortedDependencies)

14+import qualified Generate.Html as Html

2015import qualified Metadata.Prelude as Prelude

21−import qualified Transform.Canonicalize as Canonical

22−import SourceSyntax.Module

23−import Parse.Module (getModuleName)

24−import Initialize (buildFromSource, getSortedDependencies)

25−import Generate.JavaScript (jsModule)

26−import Generate.Html (createHtml, JSSource(..))

27−import Paths_Elm

28−

29−import SourceSyntax.PrettyPrint (pretty, variable)

30−import Text.PrettyPrint as P

31−import qualified Type.Type as Type

32−import qualified Type.Alias as Alias

16+import qualified Build.Utils as Utils

17+import qualified Build.Flags as Flag

18+import qualified Build.File as File

19+import qualified Elm.Internal.Paths as Path

3320

34−data Flags =

35− Flags { make :: Bool

36− , files :: [FilePath]

37− , runtime :: Maybe FilePath

38− , only_js :: Bool

39− , print_types :: Bool

40− , print_program :: Bool

41− , scripts :: [FilePath]

42− , no_prelude :: Bool

43− , cache_dir :: FilePath

44− , build_dir :: FilePath

45− , src_dir :: [FilePath]

46− }

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

48−

49−flags = Flags

50− { files = def &= args &= typ "FILES"

51− , make = False

52− &= help "automatically compile dependencies."

53− , only_js = False

54− &= help "Compile only to JavaScript."

55− , no_prelude = False

56− &= help "Do not import Prelude by default, used only when compiling standard libraries."

57− , scripts = [] &= typFile

58− &= help "Load JavaScript files in generated HTML. Files will be included in the given order."

59− , runtime = Nothing &= typFile

60− &= help "Specify a custom location for Elm's runtime system."

61− , cache_dir = "cache" &= typFile

62− &= help "Directory for files cached to make builds faster. Defaults to cache/ directory."

63− , build_dir = "build" &= typFile

64− &= help "Directory for generated HTML and JS files. Defaults to build/ directory."

65− , src_dir = ["."] &= typFile

66− &= help "Additional source directories besides project root. Searched when using --make"

67− , print_types = False

68− &= help "Print out infered types of top-level definitions."

69− , print_program = False

70− &= help "Print out an internal representation of a program."

71− } &= help "Compile Elm programs to HTML, CSS, and JavaScript."

72− &= helpArg [explicit, name "help", name "h"]

73− &= versionArg [explicit, name "version", name "v", summary (showVersion version)]

74− &= summary ("The Elm Compiler " ++ showVersion version ++ ", (c) Evan Czaplicki 2011-2013")

75−

76−main :: IO ()

21+main :: IO ()

7722main = do setNumCapabilities =<< getNumProcessors

78− compileArgs =<< cmdArgs flags

23+ compileArgs =<< CmdArgs.cmdArgs Flag.flags

7924

80−compileArgs :: Flags -> IO ()

25+compileArgs :: Flag.Flags -> IO ()

8126compileArgs flags =

82− case files flags of

27+ case Flag.files flags of

8328 [] -> putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"

8429 fs -> mapM_ (build flags) fs

85−

8630

87−buildPath :: Flags -> FilePath -> String -> FilePath

88−buildPath flags filePath ext = build_dir flags </> replaceExtension filePath ext

31+build :: Flag.Flags -> FilePath -> IO ()

32+build flags rootFile =

33+ do let noPrelude = Flag.no_prelude flags

34+ builtIns <- if noPrelude then return Map.empty else Prelude.interfaces

8935

90−cachePath :: Flags -> FilePath -> String -> FilePath

91−cachePath flags filePath ext = cache_dir flags </> replaceExtension filePath ext

36+ files <- if Flag.make flags

37+ then getSortedDependencies (Flag.src_dir flags) builtIns rootFile

38+ else return [rootFile]

9239

93−elmo :: Flags -> FilePath -> FilePath

94−elmo flags filePath = cachePath flags filePath "elmo"

40+ (moduleName, interfaces) <-

41+ File.build flags (length files) builtIns "" files

9542

96−elmi :: Flags -> FilePath -> FilePath

97−elmi flags filePath = cachePath flags filePath "elmi"

43+ js <- foldM appendToOutput BS.empty files

9844

45+ (extension, code) <-

46+ if Flag.only_js flags

47+ then do putStr "Generating JavaScript ... "

48+ return ("js", js)

49+ else do putStr "Generating HTML ... "

50+ return (makeHtml js moduleName)

9951

100−buildFile :: Flags -> Int -> Int -> Interfaces -> FilePath -> IO (String,ModuleInterface)

101−buildFile flags moduleNum numModules interfaces filePath =

102− do compiled <- alreadyCompiled

103− case compiled of

104− False -> compile

105− True -> do

106− handle <- openBinaryFile (elmi flags filePath) ReadMode

107− bits <- L.hGetContents handle

108− let info :: (String, ModuleInterface)

109− info = Binary.decode bits

110− L.length bits `seq` hClose handle

111− return info

112− where

113− alreadyCompiled :: IO Bool

114− alreadyCompiled = do

115− existsi <- doesFileExist (elmi flags filePath)

116− existso <- doesFileExist (elmo flags filePath)

117− if not existsi || not existso

118− then return False

119− else do tsrc <- getModificationTime filePath

120− tint <- getModificationTime (elmo flags filePath)

121− return (tsrc <= tint)

122−

123− number :: String

124− number = "[" ++ show moduleNum ++ " of " ++ show numModules ++ "]"

125−

126− compile :: IO (String,ModuleInterface)

127− compile = do

128− source <- readFile filePath

129− let name = case getModuleName source of

130− Just n -> n

131− Nothing -> "Main"

132− putStrLn $ concat [ number, " Compiling ", name

133− , replicate (max 1 (20 - length name)) ' '

134− , "( " ++ filePath ++ " )" ]

135−

136− createDirectoryIfMissing True (cache_dir flags)

137− createDirectoryIfMissing True (build_dir flags)

138− metaModule <-

139− case buildFromSource (no_prelude flags) interfaces source of

140− Left errors -> do

141− mapM print (List.intersperse (P.text " ") errors)

142− exitFailure

143− Right modul -> do

144− case print_program flags of

145− False -> return ()

146− True -> print . pretty $ program modul

147− return modul

148−

149− when (print_types flags) (printTypes interfaces metaModule)

150− let interface = Canonical.interface name $ ModuleInterface {

151− iTypes = types metaModule,

152− iAdts = datatypes metaModule,

153− iAliases = aliases metaModule,

154− iFixities = fixities metaModule

155− }

156− createDirectoryIfMissing True . dropFileName $ elmi flags filePath

157− handle <- openBinaryFile (elmi flags filePath) WriteMode

158− L.hPut handle (Binary.encode (name,interface))

159− hClose handle

160− writeFile (elmo flags filePath) (jsModule metaModule)

161− return (name,interface)

162−

163−printTypes interfaces metaModule = do

164− putStrLn ""

165− let rules = Alias.rules interfaces metaModule

166− forM_ (Map.toList $ types metaModule) $ \(n,t) -> do

167− print $ variable n <+> P.text ":" <+> pretty (Alias.realias rules t)

168− putStrLn ""

169−

170−getRuntime :: Flags -> IO FilePath

171−getRuntime flags =

172− case runtime flags of

173− Just fp -> return fp

174− Nothing -> getDataFileName "elm-runtime.js"

175−

176−build :: Flags -> FilePath -> IO ()

177−build flags rootFile = do

178− let noPrelude = no_prelude flags

179− files <- if make flags then getSortedDependencies (src_dir flags) noPrelude rootFile

180− else return [rootFile]

181− let ifaces = if noPrelude then Map.empty else Prelude.interfaces

182− (moduleName, interfaces) <- buildFiles flags (length files) ifaces "" files

183− js <- foldM appendToOutput BS.empty files

184−

185− (extension, code) <- case only_js flags of

186− True -> do

187− putStr "Generating JavaScript ... "

188− return ("js", js)

189− False -> do

190− putStr "Generating HTML ... "

191− rtsPath <- getRuntime flags

192− return ("html", BS.pack . renderHtml $

193− createHtml rtsPath (takeBaseName rootFile) (sources js) moduleName "")

194−

195− let targetFile = buildPath flags rootFile extension

196− createDirectoryIfMissing True (takeDirectory targetFile)

197− BS.writeFile targetFile code

198− putStrLn "Done"

52+ let targetFile = Utils.buildPath flags rootFile extension

53+ createDirectoryIfMissing True (takeDirectory targetFile)

54+ BS.writeFile targetFile code

55+ putStrLn "Done"

19956

20057 where

20158 appendToOutput :: BS.ByteString -> FilePath -> IO BS.ByteString

202− appendToOutput js filePath =

203− do src <- BS.readFile (elmo flags filePath)

204− return (BS.append src js)

205−

206− sources js = map Link (scripts flags) ++ [ Source js ]

59+ appendToOutput js filePath = do

60+ src <- BS.readFile (Utils.elmo flags filePath)

61+ return (BS.append src js)

20762

63+ sources js = map Html.Link (Flag.scripts flags) ++ [ Html.Source js ]

20864

209−buildFiles :: Flags -> Int -> Interfaces -> String -> [FilePath] -> IO (String, Interfaces)

210−buildFiles _ _ interfaces moduleName [] = return (moduleName, interfaces)

211−buildFiles flags numModules interfaces _ (filePath:rest) = do

212− (name,interface) <- buildFile flags (numModules - length rest) numModules interfaces filePath

213− let interfaces' = Map.insert name interface interfaces

214− buildFiles flags numModules interfaces' name rest

65+ makeHtml js moduleName = ("html", BS.pack $ renderHtml html)

66+ where

67+ rtsPath = Maybe.fromMaybe Path.runtime (Flag.runtime flags)

68+ html = Html.generate rtsPath (takeBaseName rootFile) (sources js) moduleName ""

compiler/Elm/Internal/Dependencies.hsnew file+117

@@ -0,0 +1,117 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+module Elm.Internal.Dependencies where

3+

4+import Control.Applicative

5+import Control.Monad.Error

6+import qualified Control.Exception as E

7+import Data.Aeson

8+import qualified Data.List as List

9+import qualified Data.ByteString.Lazy as BS

10+import qualified Data.HashMap.Strict as Map

11+import qualified Elm.Internal.Name as N

12+import qualified Elm.Internal.Version as V

13+import qualified Elm.Internal.Paths as Path

14+

15+data Deps = Deps

16+ { name :: N.Name

17+ , version :: V.Version

18+ , summary :: String

19+ , description :: String

20+ , license :: String

21+ , repo :: String

22+ , exposed :: [String]

23+ , elmVersion :: V.Version

24+ , dependencies :: [(N.Name,V.Version)]

25+ } deriving Show

26+

27+data MiniDeps = Mini [(N.Name,V.Version)]

28+

29+instance FromJSON MiniDeps where

30+ parseJSON (Object obj) = Mini <$> getDependencies obj

31+ parseJSON _ = mzero

32+

33+instance FromJSON Deps where

34+ parseJSON (Object obj) =

35+ do version <- get obj "version" "your projects version number"

36+

37+ summary <- get obj "summary" "a short summary of your project"

38+ when (length summary >= 80) $

39+ fail "'summary' must be less than 80 characters"

40+

41+ desc <- get obj "description" "an extended description of your project \

42+ \and how to get started with it."

43+ license <- get obj "license" "license information (BSD3 is recommended)"

44+

45+ repo <- get obj "repository" "a link to the project's GitHub repo"

46+ name <- case repoToName repo of

47+ Left err -> fail err

48+ Right nm -> return nm

49+

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

51+

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

53+

54+ deps <- getDependencies obj

55+

56+ return $ Deps name version summary desc license repo exposed elmVersion deps

57+

58+ parseJSON _ = mzero

59+

60+getDependencies obj =

61+ toDeps =<< get obj "dependencies" "a listing of your project's dependencies"

62+ where

63+ toDeps deps =

64+ forM (Map.toList deps) $ \(f,v) ->

65+ case (N.fromString f, V.fromString v) of

66+ (Just name, Just version) -> return (name,version)

67+ (Nothing, _) -> fail $ N.errorMsg f

68+ (_, Nothing) -> fail $ "invalid version number " ++ v

69+

70+

71+get obj field desc =

72+ do maybe <- obj .:? field

73+ case maybe of

74+ Just value -> return value

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

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

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

78+

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

80+repoToName repo

81+ | not (end `List.isSuffixOf` repo) = Left msg

82+ | otherwise =

83+ do path <- getPath

84+ let raw = take (length path - length end) path

85+ case N.fromString raw of

86+ Nothing -> Left msg

87+ Just name -> Right name

88+ where

89+ getPath | http `List.isPrefixOf` repo = Right $ drop (length http ) repo

90+ | https `List.isPrefixOf` repo = Right $ drop (length https) repo

91+ | otherwise = Left msg

92+ http = "http://github.com/"

93+ https = "https://github.com/"

94+ end = ".git"

95+ msg = "the 'repository' field must point to a GitHub project for now, something\n\

96+ \like <https://github.com/USER/PROJECT.git> where USER is your GitHub name\n\

97+ \and PROJECT is the repo you want to upload."

98+

99+withDeps :: (Deps -> a) -> FilePath -> ErrorT String IO a

100+withDeps handle path =

101+ do json <- readPath

102+ case eitherDecode json of

103+ Left err -> throwError $ "Error reading file " ++ path ++ ":\n " ++ err

104+ Right ds -> return (handle ds)

105+ where

106+ readPath :: ErrorT String IO BS.ByteString

107+ readPath = do

108+ result <- liftIO $ E.catch (Right <$> BS.readFile path)

109+ (\err -> return $ Left (err :: IOError))

110+ case result of

111+ Right bytes -> return bytes

112+ Left _ -> throwError $

113+ "could not find file " ++ path ++

114+ "\n You may need to create a dependency file for your project."

115+

116+depsAt :: FilePath -> ErrorT String IO Deps

117+depsAt = withDeps id

compiler/Elm/Internal/Documentation.hsnew file+41

@@ -0,0 +1,41 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+module Elm.Internal.Documentation where

3+

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

5+import Control.Monad

6+import Data.Aeson

7+

8+data Document = Doc

9+ { moduleName :: String

10+ , structure :: String

11+ , entries :: [Entry]

12+ } deriving (Show)

13+

14+data Entry = Entry

15+ { name :: String

16+ , comment :: String

17+ , raw :: String

18+ , assocPrec :: Maybe (String,Int)

19+ } deriving (Show)

20+

21+instance FromJSON Document where

22+ parseJSON (Object v) =

23+ Doc <$> v .: "name"

24+ <*> v .: "document"

25+ <*> (concat <$> sequence [ v .: "aliases", v .: "datatypes", v .: "values" ])

26+

27+ parseJSON _ = fail "Conversion to Document was expecting an object"

28+

29+instance FromJSON Entry where

30+ parseJSON (Object v) =

31+ Entry <$> v .: "name"

32+ <*> v .: "comment"

33+ <*> v .: "raw"

34+ <*> (liftM2 (,) <$> v .:? "associativity"

35+ <*> v .:? "precedence")

36+

37+ parseJSON _ = fail "Conversion to Entry was expecting an object"

38+

39+data Content = Markdown String | Value String

40+ deriving Show

41+

compiler/Elm/Internal/Name.hsnew file+51

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

1+{-# LANGUAGE DeriveDataTypeable #-}

2+module Elm.Internal.Name where

3+

4+import Control.Applicative

5+import Control.Monad.Error

6+import Data.Aeson

7+import Data.Binary

8+import qualified Data.Text as T

9+import qualified Data.Maybe as Maybe

10+import Data.Typeable

11+

12+data Name = Name { user :: String, project :: String }

13+ deriving (Typeable,Eq)

14+

15+instance Binary Name where

16+ get = Name <$> get <*> get

17+ put (Name user project) =

18+ put user >> put project

19+

20+instance Show Name where

21+ show name = user name ++ "/" ++ project name

22+

23+toFilePath :: Name -> FilePath

24+toFilePath name = user name ++ "-" ++ project name

25+

26+fromString :: String -> Maybe Name

27+fromString string =

28+ case break (=='/') string of

29+ ( user@(_:_), '/' : project@(_:_) )

30+ | all (/='/') project -> Just (Name user project)

31+ _ -> Nothing

32+

33+fromString' :: String -> ErrorT String IO Name

34+fromString' string =

35+ Maybe.maybe (throwError $ errorMsg string) return (fromString string)

36+

37+instance FromJSON Name where

38+ parseJSON (String text) =

39+ let string = T.unpack text in

40+ Maybe.maybe (fail $ errorMsg string) return (fromString string)

41+

42+ parseJSON _ = fail "Project name must be a string."

43+

44+instance ToJSON Name where

45+ toJSON name = toJSON (show name)

46+

47+errorMsg string =

48+ unlines

49+ [ "Dependency file has an invalid name: " ++ string

50+ , "Must have format user/project and match a public github project."

51+ ]

compiler/Elm/Internal/Paths.hsnew file+23

@@ -0,0 +1,23 @@

1+module Elm.Internal.Paths where

2+

3+import System.IO.Unsafe

4+import qualified Paths_Elm as This

5+

6+-- |Name of directory for all of a project's dependencies.

7+dependencyDirectory :: FilePath

8+dependencyDirectory = "elm_dependencies"

9+

10+-- |Name of the dependency file, specifying dependencies and

11+-- other metadata for building and sharing projects.

12+dependencyFile :: FilePath

13+dependencyFile = "elm_dependencies.json"

14+

15+{-# NOINLINE runtime #-}

16+-- |The absolute path to Elm's runtime system.

17+runtime :: FilePath

18+runtime = unsafePerformIO $ This.getDataFileName "elm-runtime.js"

19+

20+{-# NOINLINE docs #-}

21+-- |The absolute path to Elm's core library documentation.

22+docs :: FilePath

23+docs = unsafePerformIO $ This.getDataFileName "docs.json"

compiler/Elm/Internal/Utils.hsnew file+28

@@ -0,0 +1,28 @@

1+{- | This module exports functions for compiling Elm to JS.

2+-}

3+module Elm.Internal.Utils (compile, moduleName) where

4+

5+import qualified Data.List as List

6+import qualified Generate.JavaScript as JS

7+import qualified Build.Source as Source

8+import qualified Parse.Module as Parser

9+import qualified SourceSyntax.Module as M

10+import qualified Text.PrettyPrint as P

11+import qualified Metadata.Prelude as Prelude

12+import System.IO.Unsafe

13+

14+-- |This function compiles Elm code to JavaScript. It will return either

15+-- an error message or the compiled JS code.

16+compile :: String -> Either String String

17+compile source =

18+ case Source.build False interfaces source of

19+ Left docs -> Left . unlines . List.intersperse "" $ map P.render docs

20+ Right modul -> Right $ JS.generate modul

21+

22+{-# NOINLINE interfaces #-}

23+interfaces :: M.Interfaces

24+interfaces = unsafePerformIO $ Prelude.interfaces

25+

26+-- |This function extracts the module name of a given source program.

27+moduleName :: String -> Maybe String

28+moduleName = Parser.getModuleName

compiler/Elm/Internal/Version.hsnew file+73

@@ -0,0 +1,73 @@

1+{-# LANGUAGE DeriveDataTypeable, TemplateHaskell #-}

2+module Elm.Internal.Version where

3+

4+import Control.Applicative

5+import Data.Aeson

6+import Data.Binary

7+import Data.Char (isDigit)

8+import qualified Data.List as List

9+import Data.Typeable

10+import qualified Data.Text as T

11+import qualified Paths_Elm as This

12+import qualified Data.Version as Version

13+

14+elmVersion :: Version

15+elmVersion = V ns ""

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

17+

18+-- Data representation

19+

20+data Version = V [Int] String

21+ deriving (Typeable,Eq)

22+

23+instance Ord Version where

24+ compare (V ns tag) (V ns' tag') =

25+ case compare ns ns' of

26+ EQ -> compare tag' tag -- reverse comparison to favor ""

27+ cmp -> cmp

28+

29+instance Show Version where

30+ show (V ns tag) =

31+ List.intercalate "." (map show ns) ++ if null tag then "" else "-" ++ tag

32+

33+instance Binary Version where

34+ get = V <$> get <*> get

35+ put (V ns tag) = do put ns

36+ put tag

37+

38+tagless :: Version -> Bool

39+tagless (V _ tag) = null tag

40+

41+fromString :: String -> Maybe Version

42+fromString version = V <$> splitNumbers possibleNumbers <*> tag

43+ where

44+ (possibleNumbers, possibleTag) = break (=='-') version

45+

46+ tag = case possibleTag of

47+ "" -> Just ""

48+ '-':rest -> Just rest

49+ _ -> Nothing

50+

51+ splitNumbers :: String -> Maybe [Int]

52+ splitNumbers ns =

53+ case span isDigit ns of

54+ ("", _) -> Nothing

55+ (number, []) -> Just [read number]

56+ (number, '.':rest) -> (read number :) <$> splitNumbers rest

57+ _ -> Nothing

58+

59+instance FromJSON Version where

60+ parseJSON (String text) =

61+ let string = T.unpack text in

62+ case fromString string of

63+ Just v -> return v

64+ Nothing -> fail $ unlines

65+ [ "Dependency file has an invalid version number: " ++ string

66+ , "Must have format 0.1.2 or 0.1.2-tag"

67+ ]

68+

69+ parseJSON _ = fail "Version number must be stored as a string."

70+

71+instance ToJSON Version where

72+ toJSON version = toJSON (show version)

73+

compiler/Generate/Cases.hs+7−3

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

1−module Generate.Cases (toMatch, Match (..), Clause (..), matchSubst) where

1+module Generate.Cases (toMatch, Match (..), Clause (..), matchSubst, newVar) where

22

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

44import Control.Arrow (first,second)

@@ -21,7 +21,7 @@ toMatch patterns = do

2121newVar :: State Int String

2222newVar = do n <- get

2323 modify (+1)

24− return $ "_case" ++ show n

24+ return $ "_v" ++ show n

2525

2626data Match t v

2727 = Match String [Clause t v] (Match t v)

@@ -104,7 +104,11 @@ matchCon (v:vs) cs def = (flip (Match v) def) <$> mapM toClause css

104104 (PData name _ : _, _) -> matchClause (Left name) (v:vs) cs Break

105105 (PLiteral lit : _, _) -> matchClause (Right lit) (v:vs) cs Break

106106

107−--matchClause :: Either String Literal -> [String] -> [([Pattern],LExpr t v)] -> Match t v -> State Int (Clause a)

107+matchClause :: Either String Literal

108+ -> [String]

109+ -> [([Pattern],LExpr t v)]

110+ -> Match t v

111+ -> State Int (Clause t v)

108112matchClause c (v:vs) cs def =

109113 do vs' <- getVars

110114 Clause c vs' <$> match (vs' ++ vs) (map flatten cs) def

compiler/Generate/Html.hs+3−10

@@ -1,8 +1,5 @@

11{-# LANGUAGE OverloadedStrings #-}

2−module Generate.Html

3− (createHtml,

4− JSSource (..)

5− ) where

2+module Generate.Html (generate, JSSource(..)) where

63

74import Text.Blaze (preEscapedToMarkup)

85import qualified Text.Blaze.Html5 as H

@@ -10,10 +7,6 @@ import Text.Blaze.Html5 ((!))

107import qualified Text.Blaze.Html5.Attributes as A

118import qualified Data.ByteString.Lazy.Char8 as BS

129

13−import Initialize (buildFromSource)

14−import Generate.JavaScript

15−import Generate.Noscript

16−

1710data JSSource = Link String | Source BS.ByteString

1811

1912makeScript :: JSSource -> H.Html

@@ -24,8 +17,8 @@ makeScript source =

2417 H.script ! A.type_ "text/javascript" $

2518 preEscapedToMarkup $ BS.unpack src

2619

27−createHtml :: FilePath -> String -> [JSSource] -> String -> String -> H.Html

28−createHtml libLoc title scripts moduleName noscript =

20+generate :: FilePath -> String -> [JSSource] -> String -> String -> H.Html

21+generate libLoc title scripts moduleName noscript =

2922 H.docTypeHtml $ do

3023 H.head $ do

3124 H.meta ! A.charset "UTF-8"

compiler/Generate/JavaScript.hs+59−55

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

1−module Generate.JavaScript where

1+module Generate.JavaScript (generate) where

22

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

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

@@ -9,30 +9,27 @@ import qualified Data.Set as Set

99

1010import qualified Generate.Cases as Case

1111import qualified Generate.Markdown as MD

12−import SourceSyntax.Everything

12+import qualified SourceSyntax.Helpers as Help

13+import SourceSyntax.Literal

14+import SourceSyntax.Pattern

1315import SourceSyntax.Location

16+import SourceSyntax.Expression

17+import SourceSyntax.Module

1418import qualified Transform.SortDefinitions as SD

1519import Language.ECMAScript3.Syntax

1620import Language.ECMAScript3.PrettyPrint

17−import Parse.Helpers (jsReserveds)

18−

19−makeSafe :: String -> String

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

21− where

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

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

24− False -> x

25− True -> "$" ++ x

21+import qualified Transform.SafeNames as MakeSafe

2622

23+split :: String -> [String]

2724split = go []

2825 where

2926 go vars str =

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

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

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

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

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

3431

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

32+var name = Id () name

3633ref name = VarRef () (var name)

3734prop name = PropId () (var name)

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

@@ -44,11 +41,12 @@ string = StringLit ()

4441dotSep (x:xs) = foldl (DotRef ()) (ref x) (map var xs)

4542obj = dotSep . split

4643

44+varDecl :: String -> Expression () -> VarDecl ()

4745varDecl x expr =

4846 VarDecl () (var x) (Just expr)

4947

5048include alias moduleName =

51− varDecl alias (obj (moduleName ++ ".make") <| ref "elm")

49+ varDecl alias (obj (moduleName ++ ".make") <| ref "_elm")

5250

5351internalImports name =

5452 VarDeclStmt ()

@@ -60,6 +58,7 @@ internalImports name =

6058 , varDecl "$moduleName" (string name)

6159 ]

6260

61+literal :: Literal -> Expression ()

6362literal lit =

6463 case lit of

6564 Chr c -> obj "_N.chr" <| string [c]

@@ -114,18 +113,17 @@ expression (L span expr) =

114113 Binop op e1 e2 -> binop span op e1 e2

115114

116115 Lambda p e@(L s _) ->

117− do body' <- expression body

116+ do (args, body) <- foldM depattern ([], innerBody) (reverse patterns)

117+ body' <- expression body

118118 return $ case length args < 2 || length args > 9 of

119119 True -> foldr (==>) body' (map (:[]) args)

120120 False -> ref ("F" ++ show (length args)) <| (args ==> body')

121121 where

122− (args, body) = foldr depattern ([], innerBody) (zip patterns [0..])

123−

124− depattern (pattern,n) (args, body) =

122+ depattern (args, body) pattern =

125123 case pattern of

126− PVar x -> (args ++ [x], body)

127− _ -> let arg = "arg" ++ show n

128− in (args ++ [arg], L s (Case (L s (Var arg)) [(pattern, body)]))

124+ PVar x -> return (args ++ [x], body)

125+ _ -> do arg <- Case.newVar

126+ return (args ++ [arg], L s (Case (L s (Var arg)) [(pattern, body)]))

129127

130128 (patterns, innerBody) = collect [p] e

131129

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

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

157155

158156 MultiIf branches ->

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

160− return $ case last branches of

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

162− _ -> ifs branches'

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

164− where

165− ifs branches finally = foldr iff finally branches

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

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

158+ return $ case last branches of

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

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

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

162+ where

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

164+ ifs branches finally = foldr iff finally branches

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

167166

168167 Case e cases ->

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

@@ -183,11 +182,15 @@ expression (L span expr) =

183182 do es' <- mapM expression es

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

185184 where

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

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

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

188187

189− Markdown md _ -> return $ obj "Text.text" <| string (pad ++ MD.toHtml md ++ pad)

190− where pad = "<div style=\"height:0;width:0;\"> </div>"

188+ Markdown uid doc es ->

189+ do es' <- mapM expression es

190+ return $ obj "Text.markdown" `call` (string md : string uid : es')

191+ where

192+ pad = "<div style=\"height:0;width:0;\"> </div>"

193+ md = pad ++ MD.toHtml doc ++ pad

191194

192195definition :: Def () () -> State Int [Statement ()]

193196definition def =

@@ -199,7 +202,7 @@ definition def =

199202 let assign x = varDecl x expr'

200203 case pattern of

201204 PVar x

202− | isOp x ->

205+ | Help.isOp x ->

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

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

205208 | otherwise ->

@@ -222,11 +225,11 @@ definition def =

222225

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

224227 setup vars

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

226− | otherwise = safeAssign : vars

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

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

227230

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

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

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

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

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

231234

232235 _ ->

@@ -284,14 +287,15 @@ clause span variable (Case.Clause value vars mtch) =

284287 is -> drop (last is + 1) name

285288

286289

287−jsModule :: MetadataModule () () -> String

288−jsModule modul =

290+generate :: MetadataModule () () -> String

291+generate unsafeModule =

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

290− [ assign ("Elm" : names modul ++ ["make"]) (function ["elm"] programStmts) ]

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

291294 where

292− thisModule = dotSep ("elm" : names modul ++ ["values"])

295+ modul = MakeSafe.metadataModule unsafeModule

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

293297 programStmts =

294− concat [ setup (Just "elm") (names modul ++ ["values"])

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

295299 , [ IfSingleStmt () thisModule (ReturnStmt () (Just thisModule)) ]

296300 , [ internalImports (List.intercalate "." (names modul)) ]

297301 , concatMap jsImport (imports modul)

@@ -303,9 +307,9 @@ jsModule modul =

303307 , [ ReturnStmt () (Just thisModule) ]

304308 ]

305309

306− jsExports = assign ("elm" : names modul ++ ["values"]) (ObjectLit () exs)

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

307311 where

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

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

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

310314

311315 assign path expr =

@@ -317,7 +321,7 @@ jsModule modul =

317321 jsImport (modul,_) = setup Nothing path ++ [ include ]

318322 where

319323 path = split modul

320− include = assign path $ dotSep ("Elm" : path ++ ["make"]) <| ref "elm"

324+ include = assign path $ dotSep ("Elm" : path ++ ["make"]) <| ref "_elm"

321325

322326 setup namespace path = map create paths

323327 where

@@ -326,15 +330,15 @@ jsModule modul =

326330 Nothing -> tail . init $ List.inits path

327331 Just nmspc -> drop 2 . init . List.inits $ nmspc : path

328332

329− addId js = InfixExpr () OpAdd (string (js++"_")) (obj "elm.id")

333+ addId js = InfixExpr () OpAdd (string (js++"_")) (obj "_elm.id")

330334

331335 importEvent (js,base,elm,_) =

332336 [ VarDeclStmt () [ varDecl elm $ obj "Signal.constant" <| evalState (expression base) 0 ]

333337 , ExprStmt () $

334338 obj "document.addEventListener" `call`

335339 [ addId js

336− , function ["e"]

337− [ ExprStmt () $ obj "elm.notify" `call` [dotSep [elm,"id"], obj "e.value"] ]

340+ , function ["_e"]

341+ [ ExprStmt () $ obj "_elm.notify" `call` [dotSep [elm,"id"], obj "_e.value"] ]

338342 ]

339343 ]

340344

@@ -342,13 +346,13 @@ jsModule modul =

342346 ExprStmt () $

343347 ref "A2" `call`

344348 [ obj "Signal.lift"

345− , function ["v"]

346− [ VarDeclStmt () [varDecl "e" $ obj "document.createEvent" <| string "Event"]

349+ , function ["_v"]

350+ [ VarDeclStmt () [varDecl "_e" $ obj "document.createEvent" <| string "Event"]

347351 , ExprStmt () $

348− obj "e.initEvent" `call` [ addId js, BoolLit () True, BoolLit () True ]

349− , ExprStmt () $ AssignExpr () OpAssign (LDot () (ref "e") "value") (ref "v")

350− , ExprStmt () $ obj "document.dispatchEvent" <| ref "e"

351− , ReturnStmt () (Just $ ref "v")

352+ obj "_e.initEvent" `call` [ addId js, BoolLit () True, BoolLit () True ]

353+ , ExprStmt () $ AssignExpr () OpAssign (LDot () (ref "_e") "value") (ref "_v")

354+ , ExprStmt () $ obj "document.dispatchEvent" <| ref "_e"

355+ , ReturnStmt () (Just $ ref "_v")

352356 ]

353357 , ref elm ]

354358

@@ -381,7 +385,7 @@ binop span op e1 e2 =

381385 js1 = expression e1

382386 js2 = expression e2

383387

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

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

385389 | otherwise = dotSep parts

386390 where

387391 parts = split op

compiler/Generate/Markdown.hs+34−1

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

11module Generate.Markdown where

22

33import Text.Pandoc

4+import qualified Data.Set as Set

45

56toHtml :: String -> String

6−toHtml = writeHtmlString def . readMarkdown def

7+toHtml = writeHtmlString writeOptions . readMarkdown readOptions

8+

9+readOptions =

10+ def { readerExtensions = elmExtensions

11+ , readerApplyMacros = False

12+ }

13+

14+writeOptions =

15+ def { writerExtensions = elmExtensions

16+ , writerHighlight = True

17+ }

18+

19+elmExtensions :: Set.Set Extension

20+elmExtensions = Set.fromList

21+ [ Ext_raw_html

22+ , Ext_fenced_code_blocks

23+ , Ext_fenced_code_attributes

24+ , Ext_backtick_code_blocks

25+ , Ext_inline_code_attributes

26+ , Ext_markdown_in_html_blocks

27+ , Ext_escaped_line_breaks

28+ , Ext_fancy_lists

29+ , Ext_startnum

30+ , Ext_definition_lists

31+ , Ext_example_lists

32+ , Ext_all_symbols_escapable

33+ , Ext_intraword_underscores

34+ , Ext_blank_before_blockquote

35+ , Ext_blank_before_header

36+ , Ext_auto_identifiers

37+ , Ext_header_attributes

38+ , Ext_implicit_header_references

39+ ]

compiler/Generate/Noscript.hs+6−2

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

11module Generate.Noscript (noscript) where

22

33import 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

59import qualified Generate.Markdown as MD

610

711noscript :: Module t v -> String

@@ -49,7 +53,7 @@ instance Extract (Expr t v) where

4953 Case e cases -> concatMap (f . snd) cases

5054 Data _ es -> concatMap f es

5155 MultiIf es -> concatMap (f . snd) es

52− Markdown md _ -> [ MD.toHtml md ]

56+ Markdown _ md _ -> [ MD.toHtml md ]

5357 _ -> []

5458

5559extractLink src txt =

compiler/Initialize.hsdeleted−124

@@ -1,124 +0,0 @@

1−module Initialize (buildFromSource, getSortedDependencies) where

2−

3−import Data.Data

4−import Control.Monad.State

5−import qualified Data.Graph as Graph

6−import qualified Data.List as List

7−import qualified Data.Map as Map

8−import qualified Data.Set as Set

9−import System.Directory

10−import System.Exit

11−import System.FilePath as FP

12−import Text.PrettyPrint (Doc)

13−

14−import SourceSyntax.Everything

15−import qualified SourceSyntax.Type as Type

16−import qualified Parse.Parse as Parse

17−import qualified Metadata.Prelude as Prelude

18−import qualified Transform.Check as Check

19−import qualified Transform.SortDefinitions as SD

20−import qualified Type.Inference as TI

21−import qualified Type.Constrain.Declaration as TcDecl

22−import qualified Transform.Canonicalize as Canonical

23−

24−buildFromSource :: Bool -> Interfaces -> String -> Either [Doc] (MetadataModule () ())

25−buildFromSource noPrelude interfaces source =

26− do let add = if noPrelude then id else Prelude.add

27− infixes = Map.fromList . map (\(assoc,lvl,op) -> (op,(lvl,assoc)))

28− . concatMap iFixities $ Map.elems interfaces

29−

30− modul@(Module _ _ _ decls') <- add `fmap` Parse.program infixes source

31−

32− -- check for structural errors

33− Module names exs ims decls <-

34− case Check.mistakes decls' of

35− [] -> return modul

36− ms -> Left ms

37−

38− let exports'

39− | null exs =

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

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

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

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

44− | otherwise = exs

45−

46− metaModule <- Canonical.metadataModule interfaces $ MetadataModule {

47− names = names,

48− path = FP.joinPath names,

49− exports = exports',

50− imports = ims,

51− -- reorder AST into strongly connected components

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

53− types = Map.empty,

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

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

56− aliases = [ (name,tvs,tipe) | TypeAlias name tvs tipe <- decls ],

57− foreignImports = [ (evt,v,name,typ) | ImportEvent evt v name typ <- decls ],

58− foreignExports = [ (evt,name,typ) | ExportEvent evt name typ <- decls ]

59− }

60−

61− types <- TI.infer interfaces metaModule

62−

63− return $ metaModule { types = types }

64−

65−

66−getSortedDependencies :: [FilePath] -> Bool -> FilePath -> IO [String]

67−getSortedDependencies srcDirs noPrelude root =

68− sortDeps =<< readDeps srcDirs noPrelude root

69−

70−type Deps = (FilePath, String, [String])

71−

72−sortDeps :: [Deps] -> IO [String]

73−sortDeps depends =

74− if null mistakes

75− then return (concat sccs)

76− else print msg >> mapM print mistakes >> exitFailure

77− where

78− sccs = map Graph.flattenSCC $ Graph.stronglyConnComp depends

79−

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

81− msg = "A cyclical module dependency or was detected in: "

82−

83−readDeps :: [FilePath] -> Bool -> FilePath -> IO [Deps]

84−readDeps srcDirs noPrelude root = evalStateT (go root) Set.empty

85− where

86− builtIns = if noPrelude then Set.empty

87− else Set.fromList (Map.keys Prelude.interfaces)

88−

89− go :: FilePath -> StateT (Set.Set String) IO [Deps]

90− go root = do

91− (root', txt) <- liftIO $ getFile srcDirs root

92− case Parse.dependencies txt of

93− Left err -> liftIO (putStrLn msg >> print err >> exitFailure)

94− where msg = "Error resolving dependencies in " ++ root' ++ ":"

95−

96− Right (name,deps) ->

97− do seen <- get

98− let realDeps = Set.difference (Set.fromList deps) builtIns

99− newDeps = Set.difference (Set.filter (not . isNative) realDeps) seen

100− put (Set.insert name (Set.union newDeps seen))

101− rest <- mapM (go . toFilePath) (Set.toList newDeps)

102− return ((makeRelative "." root', name, Set.toList realDeps) : concat rest)

103−

104−getFile :: [FilePath] -> FilePath -> IO (FilePath,String)

105−getFile [] path = do

106− putStrLn $ unlines [ "Could not find file: " ++ path

107− , " If it is not in the root directory of your project, use"

108− , " --src-dir to declare additional locations for source files." ]

109− exitFailure

110−

111−getFile (dir:dirs) path = do

112− let path' = dir </> path

113− exists <- doesFileExist path'

114− case exists of

115− True -> (,) path' `fmap` readFile path'

116− False -> getFile dirs path

117−

118−isNative name = List.isPrefixOf "Native." name

119−

120−toFilePath :: String -> FilePath

121−toFilePath name = map swapDots name ++ ext

122− where swapDots '.' = '/'

123− swapDots c = c

124− ext = if isNative name then ".js" else ".elm"

compiler/InterfaceSerialization.hsnew file+52

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

1+module InterfaceSerialization ( loadInterface

2+ , interfaceDecode

3+ , validVersion

4+ ) where

5+

6+import qualified Data.ByteString.Lazy as L

7+import qualified Data.Binary as Binary

8+

9+import qualified Elm.Internal.Version as Version

10+import System.Directory (doesFileExist)

11+import System.IO (hPutStrLn, stderr)

12+import System.Exit (exitFailure)

13+

14+import SourceSyntax.Module

15+

16+loadInterface :: FilePath -> IO (Either String L.ByteString)

17+loadInterface filePath = do

18+ exists <- doesFileExist filePath

19+ if exists

20+ then do

21+ byteString <- L.readFile filePath

22+ return $ Right byteString

23+

24+ else

25+ return $ Left $ "Unable to find file " ++ filePath ++

26+ " for deserialization!"

27+

28+interfaceDecode :: Binary.Binary a =>

29+ FilePath -> L.ByteString -> Either String a

30+interfaceDecode filePath bytes = do

31+ case Binary.decodeOrFail bytes of

32+ Right (_, _, binaryInfo) -> Right binaryInfo

33+

34+ Left (_, offset, err) ->

35+ Left $ concat [ "Error reading build artifact: ", filePath, "\n"

36+ , " The exact error was '", err, "' at offset ", show offset, ".\n"

37+ , " The file was generated by a previous build and may be outdated or corrupt.\n"

38+ , " Please remove the file and try again."

39+ ]

40+

41+validVersion :: FilePath -> (String, ModuleInterface) ->

42+ Either String (String, ModuleInterface)

43+validVersion filePath (name, interface) =

44+ if iVersion interface == Version.elmVersion then

45+ Right (name, interface)

46+ else

47+ Left $ concat

48+ [ "Error reading build artifact: ", filePath, "\n"

49+ , " It was generated by a different version of the compiler: "

50+ , show (iVersion interface), "\n"

51+ , " Please remove the file and try again.\n"

52+ ]

compiler/Language/Elm.hsdeleted−40

@@ -1,40 +0,0 @@

1−{- | This module exports the functions necessary for compiling Elm to JS,

2− and some utilities for making it easier to find some Elm-related files.

3−

4− The documentation for the Elm language is available at

5− <http://elm-lang.org/Documentation.elm>, and many interactive examples are

6− available at <http://elm-lang.org/Examples.elm>

7−-}

8−module Language.Elm (compile, moduleName, runtime, docs) where

9−

10−import qualified Data.List as List

11−import qualified Data.Map as Map

12−import Data.Version (showVersion)

13−import Generate.JavaScript (jsModule)

14−import Initialize (buildFromSource)

15−import Parse.Module (getModuleName)

16−import SourceSyntax.Module

17−import Text.Blaze.Html (Html)

18−import qualified Text.PrettyPrint as P

19−import qualified Metadata.Prelude as Prelude

20−import Paths_Elm

21−

22−-- |This function compiles Elm code to JavaScript. It will return either

23−-- an error message or the compiled JS code.

24−compile :: String -> Either String String

25−compile source =

26− case buildFromSource False Prelude.interfaces source of

27− Left docs -> Left . unlines . List.intersperse "" $ map P.render docs

28− Right modul -> Right $ jsModule (modul :: MetadataModule () ())

29−

30−-- |This function extracts the module name of a given source program.

31−moduleName :: String -> Maybe String

32−moduleName = getModuleName

33−

34−-- |The absolute path to Elm's runtime system.

35−runtime :: IO FilePath

36−runtime = getDataFileName "elm-runtime.js"

37−

38−-- |The absolute path to Elm's core library documentation.

39−docs :: IO FilePath

40−docs = getDataFileName "docs.json"

compiler/Metadata/Prelude.hs+26−15

@@ -7,11 +7,11 @@ import System.Directory

77import System.Exit

88import System.FilePath

99import System.IO

10−import System.IO.Unsafe (unsafePerformIO)

1110import SourceSyntax.Module

1211import qualified Data.Binary as Binary

1312import qualified Data.ByteString.Lazy as BS

1413

14+import qualified InterfaceSerialization as IS

1515

1616add :: Module t v -> Module t v

1717add (Module name exs ims stmts) = Module name exs (customIms ++ ims) stmts

@@ -30,10 +30,8 @@ prelude = text ++ map (\n -> (n, Hiding [])) modules

3030 modules = [ "Basics", "Signal", "List", "Maybe", "Time", "Prelude"

3131 , "Graphics.Element", "Color", "Graphics.Collage" ]

3232

33−{-# NOINLINE interfaces #-}

34−interfaces :: Interfaces

35−interfaces =

36− unsafePerformIO (safeReadDocs =<< Path.getDataFileName "interfaces.data")

33+interfaces :: IO Interfaces

34+interfaces = safeReadDocs =<< Path.getDataFileName "interfaces.data"

3735

3836safeReadDocs :: FilePath -> IO Interfaces

3937safeReadDocs name =

@@ -46,14 +44,27 @@ safeReadDocs name =

4644 , " and specify your versions of Elm and your OS" ]

4745 exitFailure

4846

47+firstModuleInterface :: [(String, ModuleInterface)] ->

48+ Either String (String, ModuleInterface)

49+firstModuleInterface interfaces =

50+ case interfaces of

51+ [] -> Left "No interfaces found in serialized Prelude!"

52+ iface:_ -> Right iface

53+

4954readDocs :: FilePath -> IO Interfaces

50−readDocs name = do

51− exists <- doesFileExist name

52− case exists of

53− False -> ioError . userError $ "File Not Found"

54− True -> do

55− handle <- openBinaryFile name ReadMode

56− bits <- BS.hGetContents handle

57− let ifaces = Map.fromList (Binary.decode bits)

58− BS.length bits `seq` hClose handle

59− return ifaces

55+readDocs filePath = do

56+ bytes <- IS.loadInterface filePath

57+ let interfaces = IS.interfaceDecode filePath =<< bytes

58+

59+ -- Although every ModuleInterface that is deserialized in this collection

60+ -- contains the compiler version, we only check the first ModuleInterface

61+ -- since it doesn't make sense that different modules in Prelude would

62+ -- have been compiled by different compiler versions.

63+ isValid = IS.validVersion filePath =<< firstModuleInterface =<< interfaces

64+

65+ case (interfaces, isValid) of

66+ (_, Left err) -> do

67+ hPutStrLn stderr err

68+ exitFailure

69+

70+ (Right ifaces, _) -> return $ Map.fromList ifaces

compiler/Parse/Declaration.hs+9−10

@@ -26,7 +26,7 @@ alias = do

2626 forcedWS

2727 alias <- capVar

2828 args <- spacePrefix lowVar

29− whitespace ; string "=" ; whitespace

29+ padded equals

3030 tipe <- Type.expr

3131 return (TypeAlias alias args tipe)

3232

@@ -36,7 +36,7 @@ datatype = do

3636 forcedWS

3737 name <- capVar <?> "name of data-type"

3838 args <- spacePrefix lowVar

39− whitespace ; string "=" ; whitespace

39+ padded equals

4040 tcs <- pipeSep1 Type.constructor

4141 return $ Datatype name args tcs

4242

@@ -46,7 +46,7 @@ infixDecl = do

4646 assoc <- choice [ reserved "infixl" >> return L

4747 , reserved "infix" >> return N

4848 , reserved "infixr" >> return R ]

49− whitespace

49+ forcedWS

5050 n <- digit

5151 forcedWS

5252 Fixity assoc (read [n]) <$> anyOp

@@ -60,11 +60,11 @@ foreignDef = do

6060

6161exportEvent :: IParser (Declaration t v)

6262exportEvent = do

63− try (reserved "export") >> whitespace >> reserved "jsevent" >> whitespace

63+ try (reserved "export") >> padded (reserved "jsevent")

6464 eventName <- jsVar

6565 whitespace

6666 elmVar <- lowVar

67− whitespace ; hasType ; whitespace

67+ padded hasType

6868 tipe <- Type.expr

6969 case tipe of

7070 T.Data "Signal" [t] ->

@@ -75,13 +75,12 @@ exportEvent = do

7575

7676importEvent :: IParser (Declaration t v)

7777importEvent = do

78− try (reserved "import") >> whitespace >> reserved "jsevent" >> whitespace

78+ try (reserved "import") >> padded (reserved "jsevent")

7979 eventName <- jsVar

80− whitespace

81− baseValue <- Expr.term <?> "Base case for imported signal (signals cannot be undefined)"

82− whitespace

80+ baseValue <- padded Expr.term

81+ <?> "Base case for imported signal (signals cannot be undefined)"

8382 elmVar <- lowVar <?> "Name of imported signal"

84− whitespace ; hasType ; whitespace

83+ padded hasType

8584 tipe <- Type.expr

8685 case tipe of

8786 T.Data "Signal" [t] ->

compiler/Parse/Expression.hs+24−26

@@ -50,23 +50,23 @@ listTerm = markdown' <|> braces (try range <|> ExplicitList <$> commaSep expr)

5050 where

5151 range = do

5252 lo <- expr

53− whitespace >> string ".." >> whitespace

53+ padded (string "..")

5454 Range lo <$> expr

5555

5656 markdown' = do

57− (rawText, exprs) <- markdown interpolation

58− return (Markdown (filter (/='\r') rawText) exprs)

57+ pos <- getPosition

58+ let uid = show (sourceLine pos) ++ ":" ++ show (sourceColumn pos)

59+ (rawText, exprs) <- markdown (interpolation uid)

60+ return (Markdown uid (filter (/='\r') rawText) exprs)

5961

60− span xs = "<span id=\"md" ++ show (length xs) ++

61− "\" style=\"font-family:monospace;\">{{ ... }}</span>"

62+ span uid index =

63+ "<span id=\"md-" ++ uid ++ "-" ++ show index ++ "\">{{ markdown interpolation is in the pipeline, but still needs more testing }}</span>"

6264

63− interpolation md exprs = do

65+ interpolation uid md exprs = do

6466 try (string "{{")

65− whitespace

66− e <- expr

67− whitespace

67+ e <- padded expr

6868 string "}}"

69− return (md ++ span exprs, exprs ++ [e])

69+ return (md ++ span uid (length exprs), exprs ++ [e])

7070

7171parensTerm :: IParser (LExpr t v)

7272parensTerm = try (parens opFn) <|> parens (tupleFn <|> parened)

@@ -96,7 +96,7 @@ recordTerm = brackets $ choice [ misc, addLocation record ]

9696 where field = do

9797 label <- rLabel

9898 patterns <- spacePrefix Pattern.term

99− whitespace >> string "=" >> whitespace

99+ padded equals

100100 body <- expr

101101 return (label, makeFunction patterns body)

102102

@@ -104,24 +104,21 @@ recordTerm = brackets $ choice [ misc, addLocation record ]

104104

105105 change = do

106106 lbl <- rLabel

107− whitespace >> string "<-" >> whitespace

107+ padded (string "<-")

108108 (,) lbl <$> expr

109109

110110 remove r = addLocation (string "-" >> whitespace >> Remove r <$> rLabel)

111111

112112 insert r = addLocation $ do

113113 string "|" >> whitespace

114− Insert r <$> rLabel <*>

115− (whitespace >> string "=" >> whitespace >> expr)

114+ Insert r <$> rLabel <*> (padded equals >> expr)

116115

117116 modify r = addLocation

118117 (string "|" >> whitespace >> Modify r <$> commaSep1 change)

119118

120119 misc = try $ do

121120 record <- addLocation (Var <$> rLabel)

122− whitespace

123− opt <- optionMaybe (remove record)

124− whitespace

121+ opt <- padded (optionMaybe (remove record))

125122 case opt of

126123 Just e -> try (insert e) <|> return e

127124 Nothing -> try (insert record) <|> try (modify record)

@@ -155,22 +152,22 @@ ifExpr = reserved "if" >> whitespace >> (normal <|> multiIf)

155152 where

156153 normal = do

157154 bool <- expr

158− whitespace ; reserved "then" ; whitespace

155+ padded (reserved "then")

159156 thenBranch <- expr

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

161158 elseBranch <- expr

162159 return $ MultiIf [(bool, thenBranch),

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

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

164161 multiIf = MultiIf <$> spaceSep1 iff

165162 where iff = do string "|" ; whitespace

166− b <- expr ; whitespace ; string "->" ; whitespace

163+ b <- expr ; padded arrow

167164 (,) b <$> expr

168165

169166lambdaExpr :: IParser (LExpr t v)

170167lambdaExpr = do char '\\' <|> char '\x03BB' <?> "anonymous function"

171168 whitespace

172169 args <- spaceSep1 Pattern.term

173− whitespace ; arrow ; whitespace

170+ padded arrow

174171 body <- expr

175172 return (makeFunction args body)

176173

@@ -181,14 +178,15 @@ letExpr :: IParser (Expr t v)

181178letExpr = do

182179 reserved "let" ; whitespace

183180 defs <- defSet

184− whitespace ; reserved "in" ; whitespace

181+ padded (reserved "in")

185182 Let defs <$> expr

186183

187184caseExpr :: IParser (Expr t v)

188185caseExpr = do

189− reserved "case"; whitespace; e <- expr; whitespace; reserved "of"; whitespace

186+ reserved "case"; e <- padded expr; reserved "of"; whitespace

190187 Case e <$> (with <|> without)

191− where case_ = do p <- Pattern.expr; whitespace; arrow; whitespace

188+ where case_ = do p <- Pattern.expr

189+ padded arrow

192190 (,) p <$> expr

193191 with = brackets (semiSep1 (case_ <?> "cases { x -> ... }"))

194192 without = block (do c <- case_ ; whitespace ; return c)

@@ -225,7 +223,7 @@ makeFunction args body@(L s _) =

225223definition :: IParser (Def t v)

226224definition = withPos $ do

227225 (name:args) <- defStart

228− whitespace >> string "=" >> whitespace

226+ padded equals

229227 body <- expr

230228 return . Def name $ makeFunction args body

231229

@@ -234,7 +232,7 @@ typeAnnotation = TypeAnnotation <$> try start <*> Type.expr

234232 where

235233 start = do

236234 v <- lowVar <|> parens symOp

237− whitespace ; hasType ; whitespace

235+ padded hasType

238236 return v

239237

240238def :: IParser (Def t v)

compiler/Parse/Helpers.hs+57−7

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

2121 , "data", "type"

2222 , "module", "where"

2323 , "import", "as", "hiding", "open"

24− , "export", "foreign" ]

24+ , "export", "foreign"

25+ , "deriving" ]

2526

2627jsReserveds :: Set.Set String

2728jsReserveds = Set.fromList

@@ -35,6 +36,10 @@ jsReserveds = Set.fromList

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

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

3738 , "static", "yield"

39+ -- reserved by the Elm runtime system

40+ , "Elm", "ElmRuntime"

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

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

3843 ]

3944

4045expecting = flip (<?>)

@@ -49,9 +54,22 @@ iParseWithTable :: SourceName -> OpTable -> IParser a -> String -> Either ParseE

4954iParseWithTable sourceName table aParser input =

5055 runIndent sourceName $ runParserT aParser table sourceName input

5156

57+readMaybe :: Read a => String -> Maybe a

58+readMaybe s =

59+ case [ x | (x,t) <- reads s, ("","") <- lex t ] of

60+ [x] -> Just x

61+ _ -> Nothing

62+

5263backslashed :: IParser Char

53−backslashed = do { char '\\'; c <- anyChar

54− ; return . read $ ['\'','\\',c,'\''] }

64+backslashed = do

65+ char '\\'

66+ c <- anyChar

67+ case readMaybe ['\'','\\',c,'\''] of

68+ Just chr -> return chr

69+ Nothing ->

70+ fail $ "Did not recognize character '\\" ++ [c] ++

71+ "'. If the backslash is meant to be a character of its own, " ++

72+ "it should be escaped like this: \"\\\\" ++ [c] ++ "\""

5573

5674var :: IParser String

5775var = makeVar (letter <|> char '_' <?> "variable")

@@ -93,6 +111,15 @@ symOp = do op <- many1 (satisfy Help.isSymbol)

93111 "\8728" -> return "."

94112 _ -> return op

95113

114+padded :: IParser a -> IParser a

115+padded p = do whitespace

116+ out <- p

117+ whitespace

118+ return out

119+

120+equals :: IParser String

121+equals = string "="

122+

96123arrow :: IParser String

97124arrow = string "->" <|> string "\8594" <?> "arrow (->)"

98125

@@ -106,7 +133,7 @@ commitIf check p = commit <|> try p

106133spaceySepBy1 :: IParser b -> IParser a -> IParser [a]

107134spaceySepBy1 sep p = do

108135 a <- p

109− (a:) <$> many (commitIf (whitespace >> sep) (whitespace >> sep >> whitespace >> p))

136+ (a:) <$> many (commitIf (whitespace >> sep) (padded sep >> p))

110137

111138

112139commaSep1 :: IParser a -> IParser [a]

@@ -154,7 +181,7 @@ betwixt a b c = do char a ; out <- c

154181 char b <?> "closing '" ++ [b] ++ "'" ; return out

155182

156183surround a z name p = do

157− char a ; whitespace ; v <- p ; whitespace

184+ char a ; v <- padded p

158185 char z <?> unwords ["closing", name, show z]

159186 return v

160187

@@ -252,7 +279,8 @@ ignoreUntil :: IParser a -> IParser (Maybe a)

252279ignoreUntil end = go

253280 where

254281 ignore p = const () <$> p

255− filler = choice [ ignore multiComment

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

283+ , ignore multiComment

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

257285 , ignore anyChar

258286 ]

@@ -295,4 +323,26 @@ markdown interpolation = try (string "[markdown|") >> closeMarkdown "" []

295323 , uncurry closeMarkdown =<< interpolation md stuff

296324 , do c <- anyChar

297325 closeMarkdown (md ++ [c]) stuff

298− ]

326+ ]

327+

328+str :: IParser String

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

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

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

332+ ]

333+ where

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

335+

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

337+ dewindows [] = []

338+ dewindows cs =

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

340+ in pre ++ case suf of

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

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

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

344+ _ -> []

345+

346+chr :: IParser Char

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

348+ <?> "character"

compiler/Parse/Literal.hs+2−25

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

88import Parse.Helpers

99import SourceSyntax.Literal

1010

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

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

1212

1313num :: IParser Literal

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

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

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

2121 minus = try $ do string "-"

2222 lookAhead digit

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− _ -> []

23+ return "-"

compiler/Parse/Pattern.hs+2−2

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

1111

1212import Parse.Helpers

1313import Parse.Literal

14+import SourceSyntax.Literal

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

1416import qualified SourceSyntax.Pattern as Pattern

15−import SourceSyntax.Everything hiding (tuple)

16−

1717

1818basic :: IParser Pattern

1919basic = choice

compiler/Paths_El.hs → compiler/Paths_Elm.hrenamed

The content is the same.

compiler/SourceSyntax/Declaration.hs+4−5

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

1−{-# LANGUAGE DeriveDataTypeable #-}

21module SourceSyntax.Declaration where

32

4−import Data.Data

53import qualified SourceSyntax.Expression as Expr

64import SourceSyntax.Type

75import SourceSyntax.PrettyPrint

@@ -43,6 +41,7 @@ instance Pretty (Declaration t v) where

4341 let alias = P.text name <+> P.hsep (map P.text tvars) in

4442 P.hang (P.text "type" <+> alias <+> P.equals) 4 (pretty tipe)

4543

46− -- TODO: actually write out the other cases. They are currently unused, but

47− -- this is probably going to be a bug someday.

48− _ -> P.text (show decl)

44+ -- TODO: Actually write out the contained data in these cases.

45+ ImportEvent _ _ _ _ -> P.text (show decl)

46+ ExportEvent _ _ _ -> P.text (show decl)

47+ Fixity _ _ _ -> P.text (show decl)

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+7−6

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

1−{-# LANGUAGE DeriveDataTypeable #-}

21module SourceSyntax.Expression where

32

4−import Data.Data

53import Data.List (intercalate)

64import SourceSyntax.PrettyPrint

75import Text.PrettyPrint as P

@@ -29,13 +27,13 @@ data Expr t v

2927 | Insert (LExpr t v) String (LExpr t v)

3028 | Modify (LExpr t v) [(String, LExpr t v)]

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

32− | Markdown String [LExpr t v]

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

30+ | Markdown String String [LExpr t v]

31+ deriving (Eq)

3432

3533data Def tipe var

3634 = Def Pattern.Pattern (LExpr tipe var)

3735 | TypeAnnotation String Type.Type

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

36+ deriving (Eq, Show)

3937

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

4139

@@ -47,6 +45,9 @@ saveEnvName = "_save_the_environment!!!"

4745dummyLet defs =

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

4947

48+instance Show (Expr t v) where

49+ show = render . pretty

50+

5051instance Pretty (Expr t v) where

5152 pretty expr =

5253 case expr of

@@ -95,7 +96,7 @@ instance Pretty (Expr t v) where

9596 where

9697 field (x,e) = variable x <+> P.text "=" <+> pretty e

9798

98− Markdown _ _ -> P.text "[markdown| ... |]"

99+ Markdown _ _ _ -> P.text "[markdown| ... |]"

99100

100101instance Pretty (Def t v) where

101102 pretty def =

compiler/SourceSyntax/Literal.hs+1−3

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

1−{-# LANGUAGE DeriveDataTypeable #-}

21module SourceSyntax.Literal where

32

4−import Data.Data

53import SourceSyntax.PrettyPrint

64import qualified Text.PrettyPrint as PP

75

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

108 | Chr Char

119 | Str String

1210 | Boolean Bool

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

11+ deriving (Eq, Ord, Show)

1412

1513instance Pretty Literal where

1614 pretty literal =

compiler/SourceSyntax/Location.hs+4−6

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

1−{-# LANGUAGE DeriveDataTypeable #-}

21module SourceSyntax.Location where

32

4−import Data.Data

53import Text.PrettyPrint

64import SourceSyntax.PrettyPrint

75import qualified Text.Parsec.Pos as Parsec

86

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

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

8+ deriving (Eq, Ord)

119

1210data SrcSpan = Span SrcPos SrcPos String | NoSpan String

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

11+ deriving (Eq, Ord)

1412

1513data Located e = L SrcSpan e

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

14+ deriving (Eq, Ord)

1715

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

1917noneNoDocs = L (NoSpan "")

@@ -53,7 +51,7 @@ instance Show SrcSpan where

5351 show (column start) ++ " to " ++ show (column end)

5452

5553instance Show e => Show (Located e) where

56− show (L s e) = "L (" ++ show s ++ ") (" ++ show e ++ ")"

54+ show (L _ e) = show e

5755

5856instance Pretty a => Pretty (Located a) where

5957 pretty (L _ e) = pretty e

compiler/SourceSyntax/Module.hs+42−6

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

1−{-# LANGUAGE DeriveDataTypeable #-}

21module SourceSyntax.Module where

32

4−import Data.Data

53import Data.Binary

64import Data.List (intercalate)

75import qualified Data.Map as Map

@@ -12,6 +10,9 @@ import SourceSyntax.Expression (LExpr)

1210import SourceSyntax.Declaration

1311import SourceSyntax.Type

1412import System.FilePath (joinPath)

13+import Control.Monad (liftM)

14+

15+import qualified Elm.Internal.Version as Version

1516

1617data Module tipe var =

1718 Module [String] Exports Imports [Declaration tipe var]

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

2122

2223type Imports = [(String, ImportMethod)]

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

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

25+ deriving (Eq, Ord, Show)

26+

27+instance Binary ImportMethod where

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

29+ put s

30+

31+ put (Importing ss) = do put (1 :: Word8)

32+ put ss

33+

34+ put (Hiding ss) = do put (2 :: Word8)

35+ put ss

36+

37+ get = do tag <- getWord8

38+ case tag of

39+ 0 -> liftM As get

40+ 1 -> liftM Importing get

41+ 2 -> liftM Hiding get

42+ _ -> error "Error reading valid ImportMethod type from serialized string"

2543

2644data MetadataModule t v = MetadataModule {

2745 names :: [String],

@@ -35,22 +53,36 @@ data MetadataModule t v = MetadataModule {

3553 datatypes :: [ (String, [String], [(String,[Type])]) ],

3654 foreignImports :: [(String, LExpr t v, String, Type)],

3755 foreignExports :: [(String, String, Type)]

38−}

56+} deriving Show

3957

4058type Interfaces = Map.Map String ModuleInterface

4159type ADT = (String, [String], [(String,[Type])])

4260

4361data ModuleInterface = ModuleInterface {

62+ iVersion :: Version.Version,

4463 iTypes :: Map.Map String Type,

64+ iImports :: [(String, ImportMethod)],

4565 iAdts :: [ADT],

4666 iAliases :: [(String, [String], Type)],

4767 iFixities :: [(Assoc, Int, String)]

4868} deriving Show

4969

70+metaToInterface metaModule =

71+ ModuleInterface

72+ { iVersion = Version.elmVersion

73+ , iTypes = types metaModule

74+ , iImports = imports metaModule

75+ , iAdts = datatypes metaModule

76+ , iAliases = aliases metaModule

77+ , iFixities = fixities metaModule

78+ }

79+

5080instance Binary ModuleInterface where

51− get = ModuleInterface <$> get <*> get <*> get <*> get

81+ get = ModuleInterface <$> get <*> get <*> get <*> get <*> get <*> get

5282 put modul = do

83+ put (iVersion modul)

5384 put (iTypes modul)

85+ put (iImports modul)

5486 put (iAdts modul)

5587 put (iAliases modul)

5688 put (iFixities modul)

@@ -58,6 +90,10 @@ instance Binary ModuleInterface where

5890

5991instance Binary Assoc where

6092 get = do n <- getWord8

61− return $ case n of { 0 -> L ; 1 -> N ; 2 -> R }

93+ return $ case n of

94+ 0 -> L

95+ 1 -> N

96+ 2 -> R

97+ _ -> error "Error reading valid associativity from serialized string"

6298

6399 put assoc = putWord8 $ case assoc of { L -> 0 ; N -> 1 ; R -> 2 }

compiler/SourceSyntax/Pattern.hs+1−3

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

1−{-# LANGUAGE DeriveDataTypeable #-}

21module SourceSyntax.Pattern where

32

43import Data.List (intercalate)

5−import Data.Data

64import SourceSyntax.Helpers as Help

75import SourceSyntax.PrettyPrint

86import Text.PrettyPrint as PP

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

1412 | PVar String

1513 | PAnything

1614 | PLiteral Literal.Literal

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

15+ deriving (Eq, Ord, Show)

1816

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

2018nil = PData "[]" []

compiler/SourceSyntax/Type.hs+3−4

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

1−{-# LANGUAGE DeriveDataTypeable #-}

21module SourceSyntax.Type where

32

43import Data.Binary

5−import Data.Data

64import qualified Data.Map as Map

75import qualified SourceSyntax.Helpers as Help

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

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

1412 | Data String [Type]

1513 | EmptyRecord

1614 | Record [(String,Type)] Type

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

15+ deriving (Eq, Show)

1816

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

2018fieldMap fields =

@@ -93,4 +91,5 @@ instance Binary Type where

9391 1 -> Var <$> get

9492 2 -> Data <$> get <*> get

9593 3 -> return EmptyRecord

96− 4 -> Record <$> get <*> get

94+ 4 -> Record <$> get <*> get

95+ _ -> error "Error reading a valid type from serialized string"

compiler/Transform/Canonicalize.hs+4−4

@@ -15,11 +15,12 @@ import qualified SourceSyntax.Type as Type

1515import qualified Transform.SortDefinitions as SD

1616import Text.PrettyPrint as P

1717

18−

1918interface :: String -> ModuleInterface -> ModuleInterface

2019interface moduleName iface =

2120 ModuleInterface

22− { iTypes = Map.mapKeys prefix (Map.map renameType' (iTypes iface))

21+ { iVersion = iVersion iface

22+ , iTypes = Map.mapKeys prefix (Map.map renameType' (iTypes iface))

23+ , iImports = iImports iface

2324 , iAdts = map (both prefix renameCtors) (iAdts iface)

2425 , iAliases = map (both prefix renameType') (iAliases iface)

2526 , iFixities = iFixities iface -- cannot have canonicalized operators while parsing

@@ -94,7 +95,6 @@ metadataModule ifaces modul =

9495 realImports = filter (not . List.isPrefixOf "Native." . fst) (imports modul)

9596 initialEnv = Map.fromList (concatMap canon realImports ++ localEnv ++ globalEnv)

9697

97−

9898type Env = Map.Map String String

9999

100100extend :: Env -> Pattern -> Env

@@ -173,7 +173,7 @@ rename env lexpr@(L s expr) =

173173 branch (pattern,e) = (,) `liftM` format (renamePattern env pattern)

174174 `ap` rename (extend env pattern) e

175175

176− Markdown md es -> Markdown md `liftM` mapM rnm es

176+ Markdown uid md es -> Markdown uid md `liftM` mapM rnm es

177177

178178

179179renamePattern :: Env -> Pattern -> Either String Pattern

compiler/Transform/Check.hs+49−17

@@ -1,37 +1,64 @@

11module Transform.Check (mistakes) where

22

33import Transform.SortDefinitions (boundVars)

4−import SourceSyntax.Everything

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

5+import SourceSyntax.Expression

6+import SourceSyntax.Pattern

7+import SourceSyntax.Location

58import SourceSyntax.PrettyPrint

69import qualified SourceSyntax.Type as T

710import Data.List as List

811import qualified Data.Map as Map

912import qualified Data.Maybe as Maybe

1013import qualified Data.Set as Set

11−import Data.Data

12−import Data.Generics.Uniplate.Data

1314import Text.PrettyPrint as P

1415

1516

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

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

1718mistakes decls =

1819 concat [ infiniteTypeAliases decls

1920 , illFormedTypes decls

21+ , map P.text (duplicateConstructors decls)

2022 , map P.text (concatMap findErrors (getLets decls)) ]

2123 where

2224 findErrors defs = duplicates defs ++ badOrder defs

2325

24−

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

26−getLets decls = defs : concatMap getSubLets defs

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

27+getLets decls = defs : concatMap defLets defs

2728 where

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

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

2930

30− getSubLets def =

31+ defLets def =

3132 case def of

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

3333 TypeAnnotation _ _ -> []

34−

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

55+

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

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

58+

59+dupErr :: String -> String -> String

60+dupErr err x =

61+ "Syntax Error: There can only be one " ++ err ++ " '" ++ x ++ "'."

3562

3663duplicates :: [Def t v] -> [String]

3764duplicates defs =

@@ -39,13 +66,18 @@ duplicates defs =

3966 where

4067 annotations = List.sort [ name | TypeAnnotation name _ <- defs ]

4168 definitions = List.sort $ concatMap Set.toList [ boundVars pattern | Def pattern _ <- defs ]

69+ defMsg = dupErr "definition of"

70+ annMsg = dupErr "type annotation for"

4271

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

44−

45− msg = "Syntax Error: There can only be one "

46− defMsg x = msg ++ "definition of '" ++ x ++ "'."

47− annMsg x = msg ++ "type annotation for '" ++ x ++ "'."

48−

72+duplicateConstructors :: [Declaration t v] -> [String]

73+duplicateConstructors decls =

74+ map typeMsg (dups typeCtors) ++ map dataMsg (dups dataCtors)

75+ where

76+ typeCtors = List.sort [ name | Datatype name _ _ <- decls ]

77+ dataCtors = List.sort . concat $

78+ [ map fst patterns | Datatype _ _ patterns <- decls ]

79+ dataMsg = dupErr "definition of data constructor"

80+ typeMsg = dupErr "definition of type constructor"

4981

5082badOrder :: [Def t v] -> [String]

5183badOrder defs = go defs

compiler/Transform/Optimize.hs+5−1

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

11module Transform.Optimize (optimize) where

22

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

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

59import Data.Char (isAlpha)

610

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+14−7

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

66import qualified Data.Set as Set

77import qualified Data.Map as Map

88import qualified SourceSyntax.Type as ST

9−import SourceSyntax.Everything

9+import SourceSyntax.Expression

10+import SourceSyntax.Location

11+import SourceSyntax.Pattern

1012import qualified Data.Graph as Graph

1113import qualified Data.Map as Map

1214import qualified Data.Maybe as Maybe

@@ -97,7 +99,7 @@ reorder lexpr@(L s expr) =

9799 Record fields ->

98100 Record `liftM` mapM reorderField fields

99101

100− Markdown md es -> Markdown md <$> mapM reorder es

102+ Markdown uid md es -> Markdown uid md <$> mapM reorder es

101103

102104 -- Actually do some reordering

103105 Let defs body ->

@@ -120,15 +122,20 @@ reorder lexpr@(L s expr) =

120122 mapM free (ctors pattern)

121123

122124 let addDefs ds bod = L s (Let (concatMap toDefs ds) bod)

123− where

124− toDefs (pattern, expr, Nothing) = [ Def pattern expr ]

125− toDefs (PVar name, expr, Just tipe) =

126− [ TypeAnnotation name tipe, Def (PVar name) expr ]

127−

128125 L _ let' = foldr addDefs body' defss

129126

130127 return let'

131128

129+ where

130+ toDefs def =

131+ case def of

132+ (pattern, expr, Nothing) -> [ Def pattern expr ]

133+ (PVar name, expr, Just tipe) ->

134+ [ TypeAnnotation name tipe, Def (PVar name) expr ]

135+ _ -> error $ unlines

136+ [ "The impossible occurred."

137+ , "Please report an issue at <https://github.com/evancz/Elm/issues>."

138+ , "Be very descriptive because something quite weird probably happened." ]

132139

133140reorderField (label, expr) =

134141 (,) label `liftM` reorder expr

compiler/Transform/Substitute.hs+1−1

@@ -40,4 +40,4 @@ subst old new expr =

4040 Modify r fs -> Modify (f r) (map (second f) fs)

4141 Record fs -> Record (map (second f) fs)

4242 Literal _ -> expr

43− Markdown md es -> Markdown md (map f es)

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

compiler/Type/Alias.hs+13−9

@@ -11,20 +11,23 @@ import SourceSyntax.Module

1111

1212type Rules = ([(String,[String],Type)], Type -> Type)

1313

14−rules interfaces metaModule = (collect interfaces metaModule, localizer metaModule)

14+rules interfaces moduleAliases moduleImports =

15+ (collect interfaces moduleAliases, localizer moduleImports)

1516

16−collect interfaces metaModule = filter (not . isPrimitive) rawAliases

17− where

18− rawAliases = aliases metaModule ++ concatMap iAliases (Map.elems interfaces)

17+collect interfaces moduleAliases =

18+ filter (not . isPrimitive) rawAliases

19+ where

20+ rawAliases =

21+ moduleAliases ++ concatMap iAliases (Map.elems interfaces)

1922

20− isPrimitive (_,_,tipe) =

21− case tipe of

23+ isPrimitive (_,_,tipe) =

24+ case tipe of

2225 Data _ [] -> True

2326 _ -> False

2427

25−localizer metaModule = go

28+localizer moduleImports = go

2629 where

27− go tipe =

30+ go tipe =

2831 case tipe of

2932 Var _ -> tipe

3033 EmptyRecord -> tipe

@@ -32,7 +35,8 @@ localizer metaModule = go

3235 Data name ts -> Data (localize name) (map go ts)

3336 Record fs ext -> Record (map (second go) fs) (go ext)

3437

35− byMethod = foldr (\(n,m) d -> Map.insertWith (++) n [m] d) Map.empty (imports metaModule)

38+ byMethod = foldr (\(n,m) d -> Map.insertWith (++) n [m] d)

39+ Map.empty moduleImports

3640

3741 separate name =

3842 case List.elemIndices '.' name of

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

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

99import qualified Type.Environment as Env

1010

1111import 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

1315import qualified SourceSyntax.Type as Type

1416

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

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

2527 toDefs (ctor, tipes) =

2628 let vars = take (length tipes) arguments

2729 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

2931 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

3133 ]

3234

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

3436 [ 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 ]

3638 where

3739 args = case ext of

3840 Type.EmptyRecord -> map snd fields

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

4042

41− var = Src.none . Src.Var

43+ var = L.none . Src.Var

4244 vars = take (length args) arguments

4345

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

4547 record = case ext of

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

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

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

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

4850

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

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

5153 TypeAlias _ _ _ -> []

5254

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

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

5456 [ 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) ]

5658

5759 ExportEvent _ name tipe ->

5860 [ Src.TypeAnnotation name tipe ]

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

6466arguments :: [String]

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

6668

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

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

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

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

compiler/Type/Constrain/Expression.hs+1−1

@@ -134,7 +134,7 @@ constrain env (L span expr) tipe =

134134 recordType = record fields' (TermN EmptyRecord1)

135135 return . ex vars . and $ tipe === recordType : cs

136136

137− Markdown _ es ->

137+ Markdown _ _ es ->

138138 do vars <- forM es $ \_ -> liftIO (var Flexible)

139139 let tvars = map VarN vars

140140 cs <- zipWithM (constrain env) es tvars

compiler/Type/Inference.hs+1−1

@@ -52,7 +52,7 @@ infer interfaces modul = unsafePerformIO $ do

5252 Left err -> return $ Left err

5353 Right (header, constraint) -> do

5454 state <- execStateT (Solve.solve constraint) TS.initialState

55− let rules = Alias.rules interfaces modul

55+ let rules = Alias.rules interfaces (aliases modul) (imports modul)

5656 case TS.sErrors state of

5757 errors@(_:_) -> Left `fmap` sequence (map ($ rules) (reverse errors))

5858 [] -> extraChecks rules (Map.difference (TS.sSavedEnv state) header)

compiler/Type/Solve.hs+3−3

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

174174 desc <- liftIO $ UF.descriptor var

175175 case structure desc of

176176 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."

178178

179179 Nothing -> do

180180 if mark desc == seen

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

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

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

183183 else return ()

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

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

190190 desc <- liftIO $ UF.descriptor var

191191 if rank desc == noRank

192192 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."

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

compiler/Type/State.hs+7−12

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

5656 t1' <- prettiest <$> toSrcType t1

5757 t2' <- prettiest <$> toSrcType t2

5858 return . P.vcat $

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

60− , case hint of

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'

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

60+ , maybe P.empty P.text hint

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

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

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

6664 ]

6765

6866 location = case span of

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

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

7371

7472 display msg =

75− case lines msg of

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

77− lines' ->

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

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

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

74+ , P.text " " ]

8075

8176

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

compiler/Type/Type.hs+1−3

@@ -370,13 +370,11 @@ toSrcType variable = do

370370 case name desc of

371371 Just x@(c:cs) | Char.isLower c -> return (Src.Var x)

372372 | otherwise -> return (Src.Data x [])

373− Nothing ->

374− error $ concat

373+ _ -> error $ concat

375374 [ "Problem converting the following type "

376375 , "from a type-checker type to a source-syntax type:"

377376 , P.render (pretty Never variable) ]

378377

379−

380378data AppStructure = List Variable | Tuple [Variable] | Other

381379

382380collectApps :: Variable -> IO AppStructure

compiler/Type/Unify.hs+8−6

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

8080 unifyNumber svar name

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

8282 | 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."

8484

8585 comparableError maybe =

8686 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."

8888

8989 unifyComparable var name

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

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

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

9999 Tuple vs

100100 | 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."

102102 | otherwise ->

103103 do flexAndUnify varSuper

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

@@ -111,9 +111,11 @@ actuallyUnify span variable1 variable2 = do

111111 _ -> comparableError Nothing

112112

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

114− where hint = "There is a problem with the '" ++

115− render (pretty Never variable) ++

116− "' in the type signature. It currently is not possible to unify type variables that appear in top-level declarations and again in subexpressions"

114+ where

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

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

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

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

117119

118120 superUnify =

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

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

The content is the same.

libraries/Basics.elm+11−7

@@ -221,11 +221,15 @@ min = Native.Basics.min

221221max : comparable -> comparable -> comparable

222222max = Native.Basics.max

223223

224−{-| The and operator. True if both inputs are True. -}

224+{-| The and operator. True if both inputs are True.

225+This operator short-circuits if the first argument is False.

226+-}

225227(&&) : Bool -> Bool -> Bool

226228(&&) = Native.Basics.and

227229

228−{-| The or operator. True if one or both inputs are True. -}

230+{-| The or operator. True if one or both inputs are True.

231+This operator short-circuits if the first argument is True.

232+-}

229233(||) : Bool -> Bool -> Bool

230234(||) = Native.Basics.or

231235

@@ -311,11 +315,11 @@ id x = x

311315

312316{-| Given a 2-tuple, returns the first value. -}

313317fst : (a,b) -> a

314−fst = Native.Basics.fst

318+fst (a,_) = a

315319

316320{-| Given a 2-tuple, returns the second value. -}

317321snd : (a,b) -> b

318−snd = Native.Basics.snd

322+snd (_,b) = b

319323

320324{-| Flips the order of the first two arguments to a function. -}

321325flip : (a -> b -> c) -> (b -> a -> c)

@@ -325,10 +329,10 @@ flip f b a = f a b

325329This splits paired arguments into two separate arguments.

326330-}

327331curry : ((a,b) -> c) -> a -> b -> c

328−curry = Native.Basics.curry

332+curry f a b = f (a,b)

329333

330334{-| Change how arguments are passed to a function.

331−This combines two arguments into a sigle pair.

335+This combines two arguments into a single pair.

332336-}

333337uncurry : (a -> b -> c) -> (a,b) -> c

334−uncurry = Native.Basics.uncurry

338+uncurry f (a,b) = f a b

libraries/Bitwise.elmnew file+74

@@ -0,0 +1,74 @@

1+module Bitwise where

2+

3+{-| Library for [bitwise operations](http://en.wikipedia.org/wiki/Bitwise_operation).

4+

5+# Basic Operations

6+

7+@docs and, or, xor, complement

8+

9+# Bit Shifts

10+

11+@docs shiftLeft, shiftRight, shiftRightLogical

12+-}

13+

14+import Native.Bitwise

15+

16+{-| Bitwise AND

17+-}

18+and : Int -> Int -> Int

19+and = Native.Bitwise.and

20+

21+{-| Bitwise OR

22+-}

23+or : Int -> Int -> Int

24+or = Native.Bitwise.or

25+

26+{-| Bitwise XOR

27+-}

28+xor : Int -> Int -> Int

29+xor = Native.Bitwise.xor

30+

31+{-| Flip each bit individually, often called bitwise NOT

32+-}

33+complement : Int -> Int

34+complement = Native.Bitwise.complement

35+

36+{-| Shift bits to the left by a given offset, filling new bits with zeros.

37+This can be used to multiply numbers by powers of two.

38+

39+ 8 `shiftLeft` 1 == 16

40+ 8 `shiftLeft` 2 == 32

41+-}

42+shiftLeft : Int -> Int -> Int

43+shiftLeft = Native.Bitwise.shiftLeft

44+

45+{-| Shift bits to the right by a given offset, filling new bits with

46+whatever is the topmost bit. This can be used to divide numbers by powers of two.

47+

48+ 32 `shiftRight` 1 == 16

49+ 32 `shiftRight` 2 == 8

50+ -32 `shiftRight` 1 == -16

51+

52+This is called an [arithmatic right

53+shift](http://en.wikipedia.org/wiki/Bitwise_operation#Arithmetic_shift),

54+often written (>>), and sometimes called a sign-propagating

55+right shift because it fills empty spots with copies of the highest bit.

56+-}

57+shiftRight : Int -> Int -> Int

58+shiftRight = Native.Bitwise.shiftRightArithmatic

59+

60+{-| Shift bits to the right by a given offset, filling new bits with

61+zeros.

62+

63+ 32 `shiftRightLogical` 1 == 16

64+ 32 `shiftRightLogical` 2 == 8

65+ -32 `shiftRightLogical` 1 == 2147483632

66+

67+This is called an [logical right

68+shift](http://en.wikipedia.org/wiki/Bitwise_operation#Logical_shift), often written (>>>),

69+and sometimes called a zero-fill right shift because it fills empty spots

70+with zeros.

71+-}

72+shiftRightLogical : Int -> Int -> Int

73+shiftRightLogical = Native.Bitwise.shiftRightLogical

74+

libraries/Dict.elm+39−27

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

1−module Dict (empty,singleton,insert

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

22 ,lookup,findWithDefault

33 ,remove,member

44 ,foldl,foldr,map

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

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

1515

1616# Build

17−@docs empty, singleton, insert, remove

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

1818

1919# Query

2020@docs member, lookup, findWithDefault

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

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

149149a collision. -}

150150insert : comparable -> v -> Dict comparable v -> Dict comparable v

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

152− let ins 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)

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

152+ update k u t

162153

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+

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

164190singleton : comparable -> v -> Dict comparable v

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

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

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

199225 RBEmpty _ -> RBEmpty LBlack

200226

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−

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

211228rem : Dict k v -> Dict k v

212229rem t = case t of

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

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

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

288305

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−

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

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

296308map f t =

libraries/Graphics/Element.elm+13−6

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

2222@docs layers, above, below, beside

2323

2424# Positioning

25−@docs spacer, container

25+@docs empty, spacer, container

2626

2727## Specific Positions

2828

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

5858

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

6060

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+

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

6269widthOf : Element -> Int

6370widthOf e = e.props.width

@@ -76,7 +83,7 @@ width nw e =

7683 let p = e.props

7784 props = case e.element of

7885 Image _ w h _ -> {p| height <- round (toFloat h / toFloat w * toFloat nw) }

79− RawHtml html -> {p| height <- snd (Native.Utils.htmlHeight nw html)}

86+ RawHtml -> {p| height <- snd (Native.Utils.htmlHeight nw e.element) }

8087 _ -> p

8188 in { element=e.element, props={ props | width <- nw } }

8289

@@ -108,7 +115,7 @@ color c e = let p = e.props in

108115

109116{-| Create an `Element` with a tag. This lets you link directly to it.

110117The element `(tag "all-about-badgers" thirdParagraph)` can be reached

111−with a link lik this: `/facts-about-animals.elm#all-about-badgers`

118+with a link like this: `/facts-about-animals.elm#all-about-badgers`

112119-}

113120tag : String -> Element -> Element

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

@@ -128,7 +135,7 @@ data ElementPrim

128135 | Container Position Element

129136 | Flow Direction [Element]

130137 | Spacer

131− | RawHtml JSString

138+ | RawHtml

132139 | Custom -- for custom Elements implemented in JS, see collage for example

133140

134141data ImageStyle = Plain | Fitted | Cropped (Int,Int) | Tiled

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

195202 hs = List.map heightOf es

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

197204 in

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

205+ if es == [] then empty else

199206 case dir of

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

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

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

302309inward = DIn

303310

304311outward : Direction

305−outward = DOut

312+outward = DOut

libraries/Graphics/Input.elm+1−1

@@ -113,7 +113,7 @@ hoverables : a -> { events : Signal a,

113113 hoverable : (Bool -> a) -> Element -> Element }

114114hoverables = Native.Graphics.Input.hoverables

115115

116−{-| Detect when the mouse is hovering over a specifici `Element`. -}

116+{-| Detect when the mouse is hovering over a specific `Element`. -}

117117hoverable : Element -> (Element, Signal Bool)

118118hoverable elem =

119119 let pool = hoverables False

libraries/JavaScript.elm+4

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

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

66integration.

77

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+

812# Javascript to Elm

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

1014

libraries/Json.elm+3

@@ -3,6 +3,9 @@ module Json where

33

44{-| Library for working with [JSON](https://en.wikipedia.org/wiki/JSON) values.

55

6+# Json Values

7+@docs JsonValue

8+

69# Strings

710@docs fromString, toString

811

libraries/List.elm+42

@@ -20,6 +20,9 @@ list must have the same type.

2020

2121# Special Folds

2222@docs sum, product, maximum, minimum, all, any, and, or

23+

24+# Sorting

25+@docs sort, sortBy, sortWith

2326-}

2427

2528import open Basics

@@ -224,3 +227,42 @@ drop = Native.List.drop

224227-}

225228repeat : Int -> a -> [a]

226229repeat = Native.List.repeat

230+

231+{-| Sort values from lowest to highest: `sort [3,1,5] == [1,3,5]`

232+-}

233+sort : [comparable] -> [comparable]

234+sort = Native.List.sort

235+

236+{-| Sort values by a derived property.

237+

238+```haskell

239+alice = { name="Alice", height=1.62 }

240+bob = { name="Bob" , height=1.85 }

241+chuck = { name="Chuck", height=1.76 }

242+

243+sortBy .name [chuck,alice,bob] == [alice,bob,chuck]

244+sortBy .height [chuck,alice,bob] == [alice,chuck,bob]

245+

246+sortBy String.length ["mouse","cat"] == ["cat","mouse"]

247+```

248+-}

249+sortBy : (a -> comparable) -> [a] -> [a]

250+sortBy = Native.List.sortBy

251+

252+{-| Sort values with a custom comparison function.

253+

254+```haskell

255+sortWith flippedComparison [1..5] == [5,4,3,2,1]

256+

257+flippedComparison a b =

258+ case compare a b of

259+ LT -> GT

260+ EQ -> EQ

261+ GT -> LT

262+```

263+

264+This is also the most general sort function, allowing you

265+to define any other: `sort == sortWith compare`

266+-}

267+sortWith : (a -> a -> Order) -> [a] -> [a]

268+sortWith = Native.List.sortWith

libraries/Native/Basics.js−10

@@ -22,11 +22,6 @@ Elm.Native.Basics.make = function(elm) {

2222

2323 function truncate(n) { return n|0; }

2424

25− function curry(f,a,b) { return f(Utils.Tuple2(a,b)); }

26− function uncurry(f,v) { return A2(f,v._0,v._1); }

27− function fst(t) { return t._0; }

28− function snd(t) { return t._1; }

29−

3025 var basics = {

3126 div:F2(div),

3227 rem:F2(rem),

@@ -58,11 +53,6 @@ Elm.Native.Basics.make = function(elm) {

5853 floor:Math.floor,

5954 round:Math.round,

6055 toFloat:function(x) { return x; },

61−

62− curry:F3(curry),

63− uncurry:F2(uncurry),

64− fst:fst,

65− snd:snd

6656 };

6757

6858 return elm.Native.Basics.values = basics;

libraries/Native/Bitwise.jsnew file+25

@@ -0,0 +1,25 @@

1+Elm.Native.Bitwise = {};

2+Elm.Native.Bitwise.make = function(elm) {

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

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

5+ if (elm.Native.Bitwise.values) return elm.Native.Bitwise.values;

6+

7+ function and(a,b) { return a & b; }

8+ function or (a,b) { return a | b; }

9+ function xor(a,b) { return a ^ b; }

10+ function not(a) { return ~a; }

11+ function sll(a,offset) { return a << offset; }

12+ function sra(a,offset) { return a >> offset; }

13+ function srl(a,offset) { return a >>> offset; }

14+

15+ return elm.Native.Bitwise.values = {

16+ and: A2(and),

17+ or : A2(or ),

18+ xor: A2(xor),

19+ complement: not,

20+ shiftLeft : A2(sll),

21+ shiftRightArithmatic: A2(sra),

22+ shiftRightLogical : A2(srl),

23+ };

24+

25+};

libraries/Native/Graphics/Input.js−1

@@ -41,7 +41,6 @@ Elm.Native.Graphics.Input.make = function(elm) {

4141 var h = Math.ceil(style.getPropertyValue("height").slice(0,-2) - 0);

4242 elm.node.removeChild(t);

4343

44− console.log(w,h);

4544 var element = A3(newElement, w, h, {

4645 ctor: 'Custom',

4746 type: 'DropDown',

libraries/Native/List.js+33−8

@@ -53,8 +53,15 @@ Elm.Native.List.make = function(elm) {

5353 }

5454

5555 function append(xs,ys) {

56− if (xs.isText) return Utils.txt(xs.concat(ys));

57− if (typeof xs === "string") return xs.concat(ys);

56+ // append Text

57+ if (xs.text || ys.text) {

58+ return Utils.txt(Utils.makeText('',xs) + Utils.makeText('',ys));

59+ }

60+

61+ // append Strings

62+ if (typeof xs === "string") return xs + ys;

63+

64+ // append Lists

5865 if (xs.ctor === '[]') { return ys; }

5966 var root = Cons(xs._0, Nil);

6067 var curr = root;

@@ -213,11 +220,20 @@ Elm.Native.List.make = function(elm) {

213220 }

214221

215222 function sort(xs) {

216− function cmp(a,b) {

217− var ord = Utils.compare(a,b).ctor;

218− return ord=== 'EQ' ? 0 : ord === 'LT' ? -1 : 1;

219− }

220− return fromArray(toArray(xs).sort(cmp));

223+ return fromArray(toArray(xs).sort(Utils.cmp));

224+ }

225+

226+ function sortBy(f, xs) {

227+ return fromArray(toArray(xs).sort(function(a,b){

228+ return Utils.cmp(f(a), f(b));

229+ }));

230+ }

231+

232+ function sortWith(f, xs) {

233+ return fromArray(toArray(xs).sort(function(a,b){

234+ var ord = f(a)(b).ctor;

235+ return ord === 'EQ' ? 0 : ord === 'LT' ? -1 : 1;

236+ }));

221237 }

222238

223239 function nth(xs, n) {

@@ -253,7 +269,14 @@ Elm.Native.List.make = function(elm) {

253269 }

254270

255271 function join(sep, xss) {

256− if (sep.isText) return Utils.txt(toArray(xss).join(sep));

272+ if (sep.text) {

273+ sep = Utils.makeText('',sep);

274+ xss = toArray(xss);

275+ for (var i = xss.length; i--; ) {

276+ xss[i] = Utils.makeText('',xss[i]);

277+ }

278+ return Utils.txt(xss.join(sep));

279+ }

257280 if (typeof sep === 'string') return toArray(xss).join(sep);

258281 if (xss.ctor === '[]') return Nil;

259282 var s = toArray(sep);

@@ -298,6 +321,8 @@ Elm.Native.List.make = function(elm) {

298321 zipWith:F3(zipWith),

299322 zip:F2(zip),

300323 sort:sort,

324+ sortBy:F2(sortBy),

325+ sortWith:F2(sortWith),

301326 nth:F2(nth),

302327 take:F2(take),

303328 drop:F2(drop),

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/Regex.jsnew file+112

@@ -0,0 +1,112 @@

1+Elm.Native.Regex = {};

2+Elm.Native.Regex.make = function(elm) {

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

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

5+ if (elm.Native.Regex.values) return elm.Native.Regex.values;

6+ if ('values' in Elm.Native.Regex)

7+ return elm.Native.Regex.values = Elm.Native.Regex.values;

8+

9+ var Maybe = Elm.Maybe.make(elm);

10+ var JS = Elm.JavaScript.make(elm);

11+

12+ function escape(str) {

13+ return str.replace(/[-\/\\^$*+?.()|[\]{}]/g, '\\$&');

14+ }

15+ function caseInsensitive(re) {

16+ return new RegExp(re.source, 'gi');

17+ }

18+ function pattern(raw) {

19+ return new RegExp(raw, 'g');

20+ }

21+

22+ function contains(re, string) {

23+ return re.test(JS.fromString(string));

24+ }

25+

26+ function findAll(re, string) {

27+ return find(Infinity, re, string);

28+ }

29+ function find(n, re, str) {

30+ var out = [];

31+ var number = 0;

32+ var string = JS.fromString(str);

33+ var result;

34+ while (number++ < n && (result = re.exec(string))) {

35+ var i = result.length - 1;

36+ var subs = new Array(i);

37+ while (i > 0) {

38+ var submatch = result[i];

39+ subs[--i] = submatch === undefined

40+ ? Maybe.Nothing

41+ : Maybe.Just(JS.toString(submatch));

42+ }

43+ out.push({

44+ _:{},

45+ match: JS.toString(result[0]),

46+ submatches: JS.toList(subs),

47+ index: result.index,

48+ number: number,

49+ });

50+ }

51+ return JS.toList(out);

52+ }

53+

54+ function replaceAll(re, replacer, string) {

55+ return replace(Infinity, re, replacer, string);

56+ }

57+ function replace(n, re, replacer, string) {

58+ var count = 0;

59+ function jsReplacer(match) {

60+ if (count++ > n) return match;

61+ var i = arguments.length-3;

62+ var submatches = new Array(i);

63+ while (i > 0) {

64+ var submatch = arguments[i];

65+ submatches[--i] = submatch === undefined

66+ ? Maybe.Nothing

67+ : Maybe.Just(JS.toString(submatch));

68+ }

69+ return JS.fromString(replacer({

70+ _:{},

71+ match:match,

72+ submatches:JS.toList(submatches),

73+ index:arguments[i-1],

74+ number:count

75+ }));

76+ }

77+ return string.replace(re, jsReplacer);

78+ }

79+

80+ function split(re, string) {

81+ return JS.toList(JS.fromString(string).split(re));

82+ }

83+ function splitN(n, re, str) {

84+ var string = JS.fromString(str);

85+ var result;

86+ var out = [];

87+ var start = re.lastIndex;

88+ while (n--) {

89+ if (!(result = re.exec(string))) break;

90+ out.push(string.slice(start, result.index));

91+ start = re.lastIndex;

92+ }

93+ out.push(string.slice(start));

94+ return JS.toList(out);

95+ }

96+

97+ return Elm.Native.Regex.values = {

98+ pattern: pattern,

99+ caseInsensitive: caseInsensitive,

100+ escape: escape,

101+

102+ contains: F2(contains),

103+ findAll: F2(findAll),

104+ find: F3(find),

105+

106+ replaceAll: F3(replaceAll),

107+ replace: F4(replace),

108+

109+ split: F2(split),

110+ splitN: F3(splitN),

111+ };

112+};

libraries/Native/Text.js+52−40

@@ -53,67 +53,78 @@ Elm.Native.Text.make = function(elm) {

5353

5454 function toText(str) { return Utils.txt(properEscape(JS.fromString(str))); }

5555

56− function addTag(tag) {

57− return function(text) {

58− return Utils.txt('<' + tag + '>' + text + '</' + tag + '>');

59− }

60− }

61−

62− function addStyle(style, value, text) {

63− return Utils.txt("<span style='" + style + ":" + value + "'>" + text + "</span>");

56+ function height(px, text) {

57+ return { style: 'font-size:' + px + 'px;', text:text }

6458 }

65−

6659 function typeface(name, text) {

67− return addStyle('font-family', JS.fromString(name), text);

60+ return { style: 'font-family:' + name + ';', text:text }

6861 }

6962 function monospace(text) {

70− return addStyle('font-family', 'monospace', text);

63+ return { style: 'font-family:monospace;', text:text }

7164 }

72− function size(px, text) { return addStyle('font-size', px + 'px', text) }

73− var header = addTag('h1');

74− function height(h, text) { return addStyle('font-size', h+'px', text) }

75− function italic(text) { return addStyle('font-style', 'italic', text) }

76− var bold = addTag('b');

77−

78− function extract(c) {

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

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

65+ function italic(text) {

66+ return { style: 'font-style:italic;', text:text }

8167 }

82− function color(c, text) {

83− return addStyle('color', extract(c), text);

68+ function bold(text) {

69+ return { style: 'font-weight:bold;', text:text }

70+ }

71+ function link(href, text) {

72+ return { href: toText(href), text:text };

73+ }

74+ function underline(text) {

75+ return { line: ' underline', text:text };

76+ }

77+ function overline(text) {

78+ return { line: ' overline', text:text };

8479 }

85− function underline(text) { return addStyle('text-decoration', 'underline', text) }

86− function overline(text) { return addStyle('text-decoration', 'overline', text) }

8780 function strikeThrough(text) {

88− return addStyle('text-decoration', 'line-through', text);

81+ return { line: ' line-through', text:text };

8982 }

90− function link(href, text) {

91− return Utils.txt("<a href='" + toText(href) + "'>" + text + "</a>");

83+

84+ function color(c, text) {

85+ var color = (c._3 === 1)

86+ ? ('rgb(' + c._0 + ', ' + c._1 + ', ' + c._2 + ')')

87+ : ('rgba(' + c._0 + ', ' + c._1 + ', ' + c._2 + ', ' + c._3 + ')');

88+ return { style: 'color:' + color + ';', text:text };

9289 }

9390

94− function position(pos) {

95− return function(text) {

96− var e = {ctor:'RawHtml',

97− _0: '<div style="padding:0;margin:0;text-align:' +

98− pos + '">' + text + '</div>'

99− };

100− var p = A2(Utils.htmlHeight, 0, text);

101− return A3(Element.newElement, p._0, p._1, e);

91+ function position(align) {

92+ function create(text) {

93+ var raw = {

94+ ctor:'RawHtml',

95+ html: Utils.makeText('text-align:' + align + ';', text),

96+ guid: null,

97+ args: [],

98+ };

99+ var pos = A2(Utils.htmlHeight, 0, raw);

100+ return A3(Element.newElement, pos._0, pos._1, raw);

102101 }

102+ return create;

103+ }

104+

105+ function markdown(text, guid) {

106+ var raw = {

107+ ctor:'RawHtml',

108+ html: text,

109+ guid: guid,

110+ args: [],

111+ };

112+ var pos = A2(Utils.htmlHeight, 0, raw);

113+ return A3(Element.newElement, pos._0, pos._1, raw);

103114 }

104115

116+ var text = position('left');

105117 function asText(v) {

106− return position('left')(monospace(toText(show(v))));

118+ return text(monospace(toText(show(v))));

107119 }

108120

109121 function plainText(v) {

110− return position('left')(toText(v));

122+ return text(toText(v));

111123 }

112124

113125 return elm.Native.Text.values = {

114126 toText: toText,

115127

116− header : header,

117128 height : F2(height),

118129 italic : italic,

119130 bold : bold,

@@ -128,9 +139,10 @@ Elm.Native.Text.make = function(elm) {

128139 justified : position('justify'),

129140 centered : position('center'),

130141 righted : position('right'),

131− text : position('left'),

142+ text : text,

132143 plainText : plainText,

144+ markdown : markdown,

133145

134− asText : asText

146+ asText : asText,

135147 };

136148};

libraries/Native/Utils.js+51−3

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

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

2626 function cmp(x,y) {

2727 var ord;

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

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

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

30+ }

2931

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

3133 while (true) {

@@ -68,10 +70,37 @@ Elm.Native.Utils.make = function(elm) {

6870

6971 function txt(str) {

7072 var t = new String(str);

71− t.isText = true;

73+ t.text = true;

7274 return t;

7375 }

7476

77+ function makeText(style, text) {

78+ var style = style;

79+ var line = '';

80+ var href = '';

81+ while (true) {

82+ if (text.line) {

83+ line += text.line;

84+ text = text.text;

85+ continue;

86+ }

87+ if (text.style) {

88+ style += text.style;

89+ text = text.text;

90+ continue;

91+ }

92+ if (text.href) {

93+ href = text.href;

94+ text = text.text;

95+ continue;

96+ }

97+ if (href) text = '<a href="' + href + '">' + text + '</a>';

98+ if (line) style += 'text-decoration:' + line + ';';

99+ if (style) text = '<span style="' + style + '">' + text + '</span>';

100+ return text;

101+ }

102+ }

103+

75104 var count = 0;

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

77106

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

122151 return m === b ? 0 : m;

123152 }

124153

125− function htmlHeight(width, html) {

154+ function htmlHeight(width, rawHtml) {

155+ // create dummy node

156+ var html = rawHtml.html;

126157 var t = document.createElement('div');

127158 t.innerHTML = html;

128159 if (width > 0) { t.style.width = width + "px"; }

@@ -131,6 +162,22 @@ Elm.Native.Utils.make = function(elm) {

131162 t.style.cssFloat = "left";

132163

133164 document.body.appendChild(t);

165+

166+ // insert interpolated values

167+ var args = rawHtml.args;

168+ var guid = rawHtml.guid;

169+ for (var i = args.length; i--; ) {

170+ var arg = args[i];

171+ var span = document.getElementById('md-' + guid + '-' + i);

172+ if (arg.isElement) {

173+ span.style.width = arg.props.width + 'px';

174+ span.style.height = arg.props.height + 'px';

175+ } else {

176+ span.innerHTML = arg;

177+ }

178+ }

179+

180+ // get dimensions

134181 var style = window.getComputedStyle(t, null);

135182 var w = Math.ceil(style.getPropertyValue("width").slice(0,-2) - 0);

136183 var h = Math.ceil(style.getPropertyValue("height").slice(0,-2) - 0);

@@ -168,6 +215,7 @@ Elm.Native.Utils.make = function(elm) {

168215 Tuple2:Tuple2,

169216 chr:chr,

170217 txt:txt,

218+ makeText:makeText,

171219 copy: copy,

172220 remove: remove,

173221 replace: replace,

libraries/Prelude.elm+1−12

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

11module Prelude where

22{-| Everything that is automatically imported -}

33

4−import Basics (String)

5−import Maybe (Maybe)

6−import Native.Prelude

74import Native.Show

85

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

107show : a -> String

11−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

8+show = Native.Show.show

libraries/Regex.elmnew file+133

@@ -0,0 +1,133 @@

1+module Regex where

2+{-| A library for working with regular expressions. It uses [the

3+same kind of regular expressions accepted by JavaScript](https://developer.mozilla.org/en/docs/Web/JavaScript/Guide/Regular_Expressions).

4+

5+# Create

6+@docs pattern, caseInsensitive, escape

7+

8+# Match

9+@docs Match

10+

11+# Find and Replace

12+@docs contains, find, findAll, replace, replaceAll

13+

14+# Split

15+@docs split, splitN

16+

17+-}

18+

19+import Maybe (Maybe)

20+import Native.Regex

21+

22+data Regex = Regex

23+

24+{-| Escape all special characters. So `pattern (escape "$$$")`

25+will match exactly `"$$$"` even though `$` is a special character.

26+-}

27+escape : String -> String

28+escape = Native.Regex.escape

29+

30+{-| Create a Regex that matches patterns [as specified in JavaScript](https://developer.mozilla.org/en/docs/Web/JavaScript/Guide/Regular_Expressions#Writing_a_Regular_Expression_Pattern).

31+Be careful to escape backslashes properly!

32+-}

33+pattern : String -> Regex

34+pattern = Native.Regex.pattern

35+

36+

37+{-| Make a pattern case insensitive -}

38+caseInsensitive : Regex -> Regex

39+caseInsensitive = Native.Regex.caseInsensitive

40+

41+{-| Check to see if a Regex is contained in a string.

42+

43+```haskell

44+ contains (pattern "123") "12345" == True

45+ contains (pattern "b+") "aabbcc" == True

46+

47+ contains (pattern "789") "12345" == False

48+ contains (pattern "z+") "aabbcc" == False

49+```

50+-}

51+contains : Regex -> String -> Bool

52+contains = Native.Regex.contains

53+

54+{-| A `Match` represents all of the details about a particular match in a string.

55+Here are details on each field:

56+

57+ * `match` — the full string of the match.

58+ * `submatches` — a pattern might have [subpatterns, surrounded by

59+ parentheses](https://developer.mozilla.org/en/docs/Web/JavaScript/Guide/Regular_Expressions#Using_Parenthesized_Substring_Matches).

60+ If there are N subpatterns, there will be N elements in the `submatches` list.

61+ Each submatch in this list is a `Maybe` because not all subpatterns may trigger.

62+ For example, `(pattern "(a+)|(b+)")` will either match many `a`’s or

63+ many `b`’s, but never both.

64+ * `index` — the index of the match in the original string.

65+ * `number` — if you find many matches, you can think of each one

66+ as being labeled with a `number` starting at one. So the first time you

67+ find a match, that is match `number` one. Second time is match `number` two.

68+ This is useful when paired with `replaceAll` if replacement is dependent on how

69+ many times a pattern has appeared before.

70+-}

71+type Match = { match : String, submatches : [Maybe String], index : Int, number : Int }

72+

73+{-| Find all of the matches in a string:

74+

75+```haskell

76+ words = findAll (pattern "\\w+") "hello world"

77+

78+ map .match words == ["hello","world"]

79+ map .index words == [0,6]

80+

81+ places = findAll (pattern "[oi]n a (\\w+)") "I am on a boat in a lake."

82+

83+ map .match places== ["on a boat", "in a lake"]

84+ map .submatches places == [ [Just "boat"], [Just "lake"] ]

85+```

86+-}

87+findAll : Regex -> String -> [Match]

88+findAll = Native.Regex.findAll

89+

90+{-| Same as `findAll`, but `find` will quit searching after the *n<sup>th</sup>* match.

91+That means the resulting list has maximum length N, but *it can be shorter*

92+if there are not that many matches in the given string.

93+-}

94+find : Int -> Regex -> String -> [Match]

95+find = Native.Regex.find

96+

97+{-| Replace all matches. The function from `Match` to `String` lets

98+you use the details of a specific match when making replacements.

99+

100+```haskell

101+ devowel = replaceAll (pattern "[aeiou]") (\_ -> "")

102+

103+ devowel "The quick brown fox" == "Th qck brwn fx"

104+

105+ reverseWords = replaceAll (pattern "\\w+") (\{match} -> String.reverse match)

106+

107+ reverseWords "deliver mined parts" == "reviled denim strap"

108+```

109+-}

110+replaceAll : Regex -> (Match -> String) -> String -> String

111+replaceAll = Native.Regex.replaceAll

112+

113+{-| Same as `replaceAll`, but `replace` will quit after the *n<sup>th</sup>* match.-}

114+replace : Int -> Regex -> (Match -> String) -> String -> String

115+replace = Native.Regex.replace

116+

117+{-| Split a string, using the regex as the separator.

118+

119+```haskell

120+ split (pattern " *, *") "a ,b, c,d" == ["a","b","c","d"]

121+```

122+-}

123+split : Regex -> String -> [String]

124+split = Native.Regex.split

125+

126+{-| Same as `split` but stops after the *n<sup>th</sup>* match.

127+

128+```haskell

129+ splitN 1 (pattern ": *") "tom: 99,90,85" == ["tom","99,90,85"]

130+```

131+-}

132+splitN : Int -> Regex -> String -> [String]

133+splitN = Native.Regex.splitN

libraries/Signal.elm+3−3

@@ -3,7 +3,7 @@ module Signal where

33`lift8` and infix lift operators `<~` and `~`, combinations, filters, and

44past-dependence.

55

6−Signals are time-varying values. Lifted functions are reevaluated whenver any of

6+Signals are time-varying values. Lifted functions are reevaluated whenever any of

77their input signals has an event. Signal events may be of the same value as the

88previous value of the signal. Such signals are useful for timing and

99past-dependence.

@@ -95,11 +95,11 @@ combine = foldr (Native.Signal.lift2 (::)) (Native.Signal.constant [])

9595 -- fold over non-homogeneous inputs.

9696 -- mergeEither : Signal a -> Signal b -> Signal (Either a b)

9797

98−{-| Count the number of events that have occured. -}

98+{-| Count the number of events that have occurred. -}

9999count : Signal a -> Signal Int

100100count = Native.Signal.count

101101

102−{-| Count the number of events that have occured that satisfy a given predicate.

102+{-| Count the number of events that have occurred that satisfy a given predicate.

103103-}

104104countIf : (a -> Bool) -> Signal a -> Signal Int

105105countIf = Native.Signal.countIf

libraries/Text.elm+1−5

@@ -12,7 +12,7 @@ module Text where

1212@docs color, typeface, height, link

1313

1414# Simple Formatting

15−@docs monospace, header, bold, italic, underline, overline, strikeThrough

15+@docs monospace, bold, italic, underline, overline, strikeThrough

1616

1717-}

1818

@@ -43,10 +43,6 @@ typeface = Native.Text.typeface

4343monospace : Text -> Text

4444monospace = Native.Text.monospace

4545

46−{-| Make text big and noticable. -}

47−header : Text -> Text

48−header = Native.Text.header

49−

5046{-| Create a link. -}

5147link : String -> Text -> Text

5248link = Native.Text.link

libraries/Transform2D.elm+17−15

@@ -1,14 +1,16 @@

11module Transform2D where

2−{-| A library for performing [2D matrix transformations](http://en.wikipedia.org/wiki/Transformation_matrix#Affine_transformations).

2+{-| A library for performing [2D matrix transformations][affine].

33It is used primarily with the `groupTransform` function from `Graphics.Collage` and

44allows you to do things like rotation, scaling, translation, shearing, and reflection.

55

66Note that all the matrices in this library are 3x3 matrices of homogeneous

7−coordinates, used for affine transformations. Since the third row as always 0 0

8−1, we omit this below.

7+coordinates, used for [affine transformations][affine]. Since the bottom row as

8+always `0 0 1` in these matrices, it is omitted in the diagrams below.

99

10−# Basic Transforms

11−@docs identity, matrix, rotation

10+ [affine]: http://en.wikipedia.org/wiki/Transformation_matrix#Affine_transformations

11+

12+# Transforms

13+@docs identity, matrix, rotation, translation, scale, scaleX, scaleY

1214

1315# Multiplication

1416@docs multiply

@@ -31,12 +33,12 @@ identity = Native.Transform2D.identity

3133{-| Creates a transformation matrix. This lets you create transforms

3234such as scales, shears, reflections, and translations.

3335

34− matrix a b c d dx dy

36+ matrix a b c d x y

3537

36− / a b dx \

37− \ c d dy /

38+ / a b x \

39+ \ c d y /

3840

39−Note that `dx` and `dy` are the translation values.

41+Note that `x` and `y` are the translation values.

4042-}

4143matrix : Float -> Float -> Float -> Float -> Float -> Float -> Transform2D

4244matrix = Native.Transform2D.matrix

@@ -55,8 +57,7 @@ rotation = Native.Transform2D.rotation

5557 translation x y

5658

5759 / 1 0 x \

58− | 0 1 y |

59− \ 0 0 1 /

60+ \ 0 1 y /

6061-}

6162translation : Float -> Float -> Transform2D

6263translation x y = matrix 1 0 0 1 x y

@@ -77,14 +78,15 @@ scaleX x = matrix x 0 0 1 0 0

7778

7879{-| Creates a transformation for vertical scaling -}

7980scaleY : Float -> Transform2D

80−scaleY y = matrix y 0 0 1 0 0

81+scaleY y = matrix 1 0 0 y 0 0

8182

8283{-| Multiplies two transforms together:

8384

84− multiply a b

85+ multiply m n

8586

86− / a11 a12 \ . / b11 b12 \

87− \ a21 a22 / \ b21 b22 /

87+ / ma mb mx \ / na nb nx \

88+ | mc md my | . | nc nd ny |

89+ \ 0 0 1 / \ 0 0 1 /

8890-}

8991multiply : Transform2D -> Transform2D -> Transform2D

9092multiply = Native.Transform2D.multiply

libraries/elm_dependencies.jsonnew file+39

@@ -0,0 +1,39 @@

1+{ "version": "0.10.0.2"

2+, "summary": "Elm's standard libraries"

3+, "description": "The full set of standard libraries for Elm. This library is pegged to the version number of the compiler, so if you are using Elm 0.11, you should be using version 0.11 of the standard libraries."

4+, "license": "BSD3"

5+, "repository": "http://github.com/evancz/Elm.git"

6+, "elm-version": "0.10.0.2"

7+, "dependencies": {}

8+, "exposed-modules":

9+ [ "Basics"

10+ , "Bitwise"

11+ , "Char"

12+ , "Color"

13+ , "Date"

14+ , "Dict"

15+ , "Either"

16+ , "Graphics.Element"

17+ , "Graphics.Collage"

18+ , "Graphics.Input"

19+ , "Http"

20+ , "JavaScript"

21+ , "JavaScript.Experimental"

22+ , "Json"

23+ , "Keyboard"

24+ , "List"

25+ , "Maybe"

26+ , "Mouse"

27+ , "Random"

28+ , "Regex"

29+ , "Set"

30+ , "Signal"

31+ , "String"

32+ , "Text"

33+ , "Time"

34+ , "Touch"

35+ , "Transform2D"

36+ , "WebSocket"

37+ , "Window"

38+ ]

39+}

runtime/Init.js+3−3

@@ -158,11 +158,11 @@ function initGraphics(elm, Module) {

158158 signalGraph = Signal.constant(signalGraph);

159159 }

160160 var currentScene = signalGraph.value;

161−

161+

162162 // Add the currentScene to the DOM

163163 var Render = ElmRuntime.use(ElmRuntime.Render.Element);

164164 elm.node.appendChild(Render.render(currentScene));

165−

165+

166166 // set up updates so that the DOM is adjusted as necessary.

167167 function domUpdate(newScene, currentScene) {

168168 ElmRuntime.draw(function(_) {

@@ -180,4 +180,4 @@ function initGraphics(elm, Module) {

180180 return renderer;

181181}

182182

183−}());

183+}());

runtime/Render/Collage.js+46−59

@@ -144,13 +144,13 @@ function renderForm(redo, ctx, form) {

144144 case 'FPath' : drawLine(ctx, f._0, f._1); break;

145145 case 'FImage': drawImage(redo, ctx, f); break;

146146 case 'FShape':

147− if (f._0.ctor === 'Left') {

148− f._1.closed = true;

149− drawLine(ctx, f._0._0, f._1);

150− } else {

151− drawShape(redo, ctx, f._0._0, f._1);

152− }

153− break;

147+ if (f._0.ctor === 'Left') {

148+ f._1.closed = true;

149+ drawLine(ctx, f._0._0, f._1);

150+ } else {

151+ drawShape(redo, ctx, f._0._0, f._1);

152+ }

153+ break;

154154 }

155155 ctx.restore();

156156}

@@ -173,16 +173,16 @@ function str(n) {

173173

174174function makeTransform(w, h, form, matrices) {

175175 var props = form.form._0.props;

176− var m = A6( Transform.matrix, 1, 0, 0, 1,

177− (w - props.width)/2,

178− (h - props.height)/2 );

176+ var m = A6( Transform.matrix, 1, 0, 0, -1,

177+ (w - props.width ) / 2,

178+ (h - props.height) / 2 );

179179 var len = matrices.length;

180180 for (var i = 0; i < len; ++i) { m = A2( Transform.multiply, m, matrices[i] ); }

181181 m = A2( Transform.multiply, m, formToMatrix(form) );

182182

183− return 'matrix(' + str( m[0]) + ',' + str( m[3]) + ',' +

184− str(-m[1]) + ',' + str(-m[4]) + ',' +

185− str( m[2]) + ',' + str( m[5]) + ')';

183+ return 'matrix(' + str( m[0]) + ', ' + str( m[3]) + ', ' +

184+ str(-m[1]) + ', ' + str(-m[4]) + ', ' +

185+ str( m[2]) + ', ' + str( m[5]) + ')';

186186}

187187

188188function stepperHelp(list) {

@@ -200,7 +200,7 @@ function stepperHelp(list) {

200200 return { peekNext:peekNext, next:next };

201201}

202202

203−function stepper(forms) {

203+function formStepper(forms) {

204204 var ps = [stepperHelp(forms)];

205205 var matrices = [];

206206 var alphas = [];

@@ -253,11 +253,12 @@ function makeCanvas(w,h) {

253253

254254function render(model) {

255255 var div = newElement('div');

256+ div.style.overflow = 'hidden';

256257 update(div, model, model);

257258 return div;

258259}

259260

260−function updateTracker(w,h,div) {

261+function nodeStepper(w,h,div) {

261262 var kids = div.childNodes;

262263 var i = 0;

263264 function transform(transforms, ctx) {

@@ -271,7 +272,7 @@ function updateTracker(w,h,div) {

271272 }

272273 return ctx;

273274 }

274− function getContext(transforms) {

275+ function nextContext(transforms) {

275276 while (i < kids.length) {

276277 var node = kids[i];

277278 if (node.getContext) {

@@ -290,75 +291,61 @@ function updateTracker(w,h,div) {

290291 ++i;

291292 return transform(transforms, canvas.getContext('2d'));

292293 }

293− function element(matrices, alpha, form) {

294− var container = kids[i];

295− if (!container || container.getContext) {

296− container = newElement('div');

297− container.style.overflow = 'hidden';

298− container.style.position = 'absolute';

299− addTransform(container.style, 'scaleY(-1)');

300−

301− var kid = kids[i];

302− kid ? div.insertBefore(container, kid)

303− : div.appendChild(container);

304− }

305− // we have added a new node, so we must step our position

306− ++i;

294+ function addElement(matrices, alpha, form) {

295+ var kid = kids[i];

296+ var elem = form.form._0;

307297

308− container.style.width = w + 'px';

309− container.style.height = h + 'px';

310− container.style.opacity = alpha * form.alpha;

298+ var node = (!kid || kid.getContext)

299+ ? Render.render(elem)

300+ : (Render.update(kid, kid.oldElement, elem), kids[i]);

311301

312− var elem = form.form._0;

313− var node = container.firstChild;

314− if (node) {

315− Render.update(node, node.oldElement, elem);

316− node = container.firstChild;

317− } else {

318− node = Render.render(elem);

319− container.appendChild(node);

320− }

321− node.oldElement = elem;

302+ node.style.position = 'absolute';

303+ node.style.opacity = alpha * form.alpha;

322304 addTransform(node.style, makeTransform(w, h, form, matrices));

305+ node.oldElement = elem;

306+ ++i;

307+ if (!kid) {

308+ div.appendChild(node);

309+ } else if (kid.getContext) {

310+ div.insertBefore(node, kid);

311+ }

323312 }

324313 function clearRest() {

325314 while (i < kids.length) {

326315 div.removeChild(kids[i]);

327316 }

328317 }

329− return { getContext:getContext, element:element, clearRest:clearRest };

318+ return { nextContext:nextContext, addElement:addElement, clearRest:clearRest };

330319}

331320

332321

333322function update(div, _, model) {

334323 var w = model.w;

335324 var h = model.h;

336− div.style.width = w + 'px';

337− div.style.height = h + 'px';

338− if (model.forms.ctor === 'Nil') {

339− while (div.hasChildNodes()) {

340− div.removeChild(div.lastChild);

341− }

342− }

343− var stpr = stepper(model.forms);

344− var tracker = updateTracker(w,h,div);

325+

326+ var forms = formStepper(model.forms);

327+ var nodes = nodeStepper(w,h,div);

345328 var ctx = null;

346329 var formType = '';

347330

348− while (formType = stpr.peekNext()) {

331+ while (formType = forms.peekNext()) {

332+ // make sure we have context if we need it

349333 if (ctx === null && formType !== 'FElement') {

350− ctx = tracker.getContext(stpr.transforms());

351− ctx.globalAlpha = stpr.alpha();

334+ ctx = nodes.nextContext(forms.transforms());

335+ ctx.globalAlpha = forms.alpha();

352336 }

353− var form = stpr.next(ctx);

337+

338+ var form = forms.next(ctx);

339+ // if it is FGroup, all updates are made within formStepper when next is called.

354340 if (formType === 'FElement') {

355− tracker.element(stpr.transforms(), stpr.alpha(), form);

341+ // update or insert an element, get a new context

342+ nodes.addElement(forms.transforms(), forms.alpha(), form);

356343 ctx = null;

357344 } else if (formType !== 'FGroup') {

358345 renderForm(function() { update(div, model, model); }, ctx, form);

359346 }

360347 }

361− tracker.clearRest();

348+ nodes.clearRest();

362349 return false;

363350}

364351

runtime/Render/Element.js+58−8

@@ -154,10 +154,31 @@ function container(pos,elem) {

154154 return div;

155155}

156156

157−function rawHtml(html) {

158− var e = newElement('div');

159− e.innerHTML = html;

160− return e;

157+function rawHtml(elem) {

158+ var html = elem.html;

159+ var args = elem.args;

160+ var guid = elem.guid;

161+

162+ var div = newElement('div');

163+ div.innerHTML = html;

164+ div.style.visibility = "hidden";

165+ document.body.appendChild(div);

166+

167+ for (var i = args.length; i--; ) {

168+ var arg = args[i];

169+ var span = document.getElementById('md-' + guid + '-' + i);

170+ if (arg.isText) {

171+ span.innerHTML = arg;

172+ } else {

173+ span.style.display = 'block';

174+ span.style.width = arg.props.width + 'px';

175+ span.style.height = arg.props.height + 'px';

176+ span.appendChild(render(arg));

177+ }

178+ }

179+ document.body.removeChild(div);

180+ div.style.visibility = 'visible';

181+ return div;

161182}

162183

163184function render(elem) { return setProps(elem.props, makeElement(elem)); }

@@ -168,7 +189,7 @@ function makeElement(e) {

168189 case 'Flow': return flow(elem._0, elem._1);

169190 case 'Container': return container(elem._0, elem._1);

170191 case 'Spacer': return newElement('div');

171− case 'RawHtml': return rawHtml(elem._0);

192+ case 'RawHtml': return rawHtml(elem);

172193 case 'Custom': return elem.render(elem.model);

173194 }

174195}

@@ -184,7 +205,36 @@ function update(node, curr, next) {

184205 switch(nextE.ctor) {

185206 case "Spacer": break;

186207 case "RawHtml":

187− if (nextE._0 !== currE._0) node.innerHTML = nextE._0;

208+ // only markdown blocks have guids, so this must be a text block

209+ if (nextE.guid === null) {

210+ node.innerHTML = nextE.html;

211+ break;

212+ }

213+ if (nextE.guid !== currE.guid) {

214+ node.parentNode.replaceChild(render(next),node);

215+ return true;

216+ }

217+ var nargs = nextE.args;

218+ var cargs = currE.args;

219+ for (var i = nargs.length; i--; ) {

220+ var narg = nargs[i];

221+ var carg = cargs[i]

222+ if (narg == carg) continue;

223+ var span = document.getElementById('md-' + currE.guid + '-' + i);

224+ if (narg.isElement) {

225+ if (carg.isElement) {

226+ update(span, carg, narg);

227+ } else {

228+ span.style.display = 'block';

229+ var e = render(narg);

230+ span.innerHTML = '';

231+ span.appendChild(e);

232+ }

233+ } else {

234+ span.style.display = 'inline';

235+ span.innerHTML = narg;

236+ }

237+ }

188238 break;

189239 case "Image":

190240 if (nextE._0.ctor === 'Plain') {

@@ -222,7 +272,7 @@ function update(node, curr, next) {

222272 }

223273 break;

224274 case "Container":

225− update(node.firstChild, currE._1, nextE._1)

275+ update(node.firstChild, currE._1, nextE._1);

226276 setPos(nextE._0, nextE._1.props.width, nextE._1.props.height, node.firstChild);

227277 break;

228278 case "Custom":

@@ -269,4 +319,4 @@ function updateProps(node, curr, next) {

269319

270320return { render:render, update:update };

271321

272−};

322+};

runtime/Render/Utils.js+43−46

@@ -1,48 +1,45 @@

1−

21ElmRuntime.Render.Utils = function() {

3−

4−function newElement(elementType) {

5− var e = document.createElement(elementType);

6− e.style.padding = "0";

7− e.style.margin = "0";

8− return e;

9−}

10−

11−function addTo(container, elem) {

12− container.appendChild(elem);

13−}

14−

15−function extract(c) {

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

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

18−}

19−

20−function addTransform(style, trans) {

21− style.transform = trans;

22− style.msTransform = trans;

23− style.MozTransform = trans;

24− style.webkitTransform = trans;

25− style.OTransform = trans;

26−}

27−

28−function removeTransform(style) {

29− style.transform = 'none';

30− style.msTransform = 'none';

31− style.MozTransform = 'none';

32− style.webkitTransform = 'none';

33− style.OTransform = 'none';

34−}

35−

36−var List = Elm.Native.List.make({});

37−

38−return {addTo:addTo,

39− newElement:newElement,

40− extract : extract,

41− fromList: List.toArray,

42− fromString: function(s) { return s; },

43− toString: function(s) { return s; },

44− eq: Elm.Native.Utils.make({}).eq,

45− addTransform: addTransform,

46− removeTransform: removeTransform

47− };

2+ function newElement(elementType) {

3+ var e = document.createElement(elementType);

4+ e.style.padding = "0";

5+ e.style.margin = "0";

6+ return e;

7+ }

8+

9+ function addTo(container, elem) {

10+ container.appendChild(elem);

11+ }

12+

13+ function extract(c) {

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

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

16+ }

17+

18+ function addTransform(style, trans) {

19+ style.transform = trans;

20+ style.msTransform = trans;

21+ style.MozTransform = trans;

22+ style.webkitTransform = trans;

23+ style.OTransform = trans;

24+ }

25+

26+ function removeTransform(style) {

27+ style.transform = 'none';

28+ style.msTransform = 'none';

29+ style.MozTransform = 'none';

30+ style.webkitTransform = 'none';

31+ style.OTransform = 'none';

32+ }

33+

34+ var List = Elm.Native.List.make({});

35+

36+ return {addTo:addTo,

37+ newElement:newElement,

38+ extract : extract,

39+ fromList: List.toArray,

40+ fromString: function(s) { return s; },

41+ toString: function(s) { return s; },

42+ eq: Elm.Native.Utils.make({}).eq,

43+ addTransform: addTransform,

44+ removeTransform: removeTransform};

4845};

server/Server.hs+14−16

@@ -33,20 +33,23 @@ serve portNumber libLoc = do

3333pageTitle :: String -> String

3434pageTitle = dropExtension . takeBaseName

3535

36−defaultCacheDirectory = "elm-server-cache"

37−

3836serveElm :: FilePath -> ServerPartT IO Response

39−serveElm fp = do

40− fileExists <- liftIO $ doesFileExist file

41− guard $ fileExists && takeExtension fp == ".elm"

37+serveElm fp =

38+ do fileExists <- liftIO $ doesFileExist file

39+ guard (fileExists && takeExtension fp == ".elm")

40+ onSuccess compile serve

41+ where

42+ file = tail fp

4243

43− (_, stdout, _, handle) <- liftIO $ createProcess $

44− (proc "elm" args) { std_out = CreatePipe }

45− exitCode <- liftIO $ waitForProcess handle

44+ compile = liftIO $ createProcess $ (proc "elm" args) { std_out = CreatePipe }

45+ where args = [ "--make", "--runtime=" ++ runtime, file ]

4646

47− dirExists <- liftIO $ doesDirectoryExist defaultCacheDirectory

48− when dirExists $ liftIO $ removeDirectoryRecursive defaultCacheDirectory

47+ serve = serveFile (asContentType "text/html")

48+ ("build" </> replaceExtension file "html")

4949

50+onSuccess action success = do

51+ (_, stdout, _, handle) <- action

52+ exitCode <- liftIO $ waitForProcess handle

5053 case (exitCode, stdout) of

5154 (ExitFailure 127, _) ->

5255 badRequest $ toResponse "Error: elm binary not found in your path."

@@ -55,13 +58,8 @@ serveElm fp = do

5558 badRequest $ toResponse str

5659 (ExitFailure _, Nothing) ->

5760 badRequest $ toResponse "See command line for error message."

58− (ExitSuccess, _) ->

59− serveFile

60− (asContentType "text/html") ("build" </> replaceExtension file "html")

61+ (ExitSuccess, _) -> success

6162

62− where file = tail fp

63− args = [ "--make" ,"--runtime=" ++ runtime,

64− "--cache-dir=" ++ defaultCacheDirectory, file ]

6563

6664serveLib :: FilePath -> String -> ServerPartT IO Response

6765serveLib libLoc fp = do

tests/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/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 "{-"