git.iko.soy/elk
on master help sign in
Merge branch 'dev'
9dfcb50Evan Czaplicki
CONTRIBUTING.mdnew file+35
compare with master
unifiedsplit
@@ -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
30 location: git://github.com/evancz/Elm.git
30 location: git://github.com/evancz/Elm.git
31
31
32Library
32Library
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
34 Hs-Source-Dirs: compiler
39 Hs-Source-Dirs: compiler
35 other-modules: SourceSyntax.Declaration,
40 other-modules: SourceSyntax.Declaration,
36 SourceSyntax.Expression,
41 SourceSyntax.Expression,
37− SourceSyntax.Everything,
38 SourceSyntax.Helpers,
42 SourceSyntax.Helpers,
39 SourceSyntax.Literal,
43 SourceSyntax.Literal,
40 SourceSyntax.Location,
44 SourceSyntax.Location,
@@ -49,11 +53,12 @@ Library
49 Generate.Cases,
53 Generate.Cases,
50 Transform.Canonicalize,
54 Transform.Canonicalize,
51 Transform.Check,
55 Transform.Check,
56+ Transform.SafeNames,
52 Transform.SortDefinitions,
57 Transform.SortDefinitions,
53 Transform.Substitute,
58 Transform.Substitute,
54 Transform.Optimize,
59 Transform.Optimize,
55 Metadata.Prelude,
60 Metadata.Prelude,
56− Initialize,
61+ InterfaceSerialization,
57 Parse.Binop,
62 Parse.Binop,
58 Parse.Declaration,
63 Parse.Declaration,
59 Parse.Expression,
64 Parse.Expression,
@@ -77,33 +82,41 @@ Library
77 Type.State,
82 Type.State,
78 Type.Type,
83 Type.Type,
79 Type.Unify,
84 Type.Unify,
85+ Build.Dependencies,
86+ Build.File,
87+ Build.Flags,
88+ Build.Print,
89+ Build.Source,
90+ Build.Utils,
80 Paths_Elm
91 Paths_Elm
81
92
82− Build-depends: base >=4.2 && <5,
93+ Build-depends: aeson,
94+ base >=4.2 && <5,
83− binary,
95+ binary >= 0.6.4.0,
84 blaze-html == 0.5.* || == 0.6.*,
96 blaze-html == 0.5.* || == 0.6.*,
85− blaze-markup == 0.5.1.*,
97+ blaze-markup,
86 bytestring,
98 bytestring,
87 cmdargs,
99 cmdargs,
88 containers >= 0.3,
100 containers >= 0.3,
89 directory,
101 directory,
90 filepath,
102 filepath,
91 indents,
103 indents,
92− language-ecmascript < 1,
104+ language-ecmascript >=0.15 && < 1.0,
93 mtl >= 2,
105 mtl >= 2,
94 pandoc >= 1.10,
106 pandoc >= 1.10,
95 parsec >= 3.1.1,
107 parsec >= 3.1.1,
96 pretty,
108 pretty,
109+ text,
97 transformers >= 0.2,
110 transformers >= 0.2,
98 union-find,
111 union-find,
99− uniplate
112+ unordered-containers
100
113
101Executable elm
114Executable elm
102 Main-is: Compiler.hs
115 Main-is: Compiler.hs
116+ ghc-options: -threaded -O2
103 Hs-Source-Dirs: compiler
117 Hs-Source-Dirs: compiler
104 other-modules: SourceSyntax.Declaration,
118 other-modules: SourceSyntax.Declaration,
105 SourceSyntax.Expression,
119 SourceSyntax.Expression,
106− SourceSyntax.Everything,
107 SourceSyntax.Helpers,
120 SourceSyntax.Helpers,
108 SourceSyntax.Literal,
121 SourceSyntax.Literal,
109 SourceSyntax.Location,
122 SourceSyntax.Location,
@@ -118,11 +131,12 @@ Executable elm
118 Generate.Cases,
131 Generate.Cases,
119 Transform.Canonicalize,
132 Transform.Canonicalize,
120 Transform.Check,
133 Transform.Check,
134+ Transform.SafeNames,
121 Transform.SortDefinitions,
135 Transform.SortDefinitions,
122 Transform.Substitute,
136 Transform.Substitute,
123 Transform.Optimize,
137 Transform.Optimize,
124 Metadata.Prelude,
138 Metadata.Prelude,
125− Initialize,
139+ InterfaceSerialization,
126 Parse.Binop,
140 Parse.Binop,
127 Parse.Declaration,
141 Parse.Declaration,
128 Parse.Expression,
142 Parse.Expression,
@@ -146,10 +160,17 @@ Executable elm
146 Type.State,
160 Type.State,
147 Type.Type,
161 Type.Type,
148 Type.Unify,
162 Type.Unify,
163+ Build.Dependencies,
164+ Build.File,
165+ Build.Flags,
166+ Build.Print,
167+ Build.Source,
168+ Build.Utils,
149 Paths_Elm
169 Paths_Elm
150
170
151− Build-depends: base >=4.2 && <5,
171+ Build-depends: aeson,
172+ base >=4.2 && <5,
152− binary,
173+ binary >= 0.6.4.0,
153 blaze-html == 0.5.* || == 0.6.*,
174 blaze-html == 0.5.* || == 0.6.*,
154 blaze-markup == 0.5.1.*,
175 blaze-markup == 0.5.1.*,
155 bytestring,
176 bytestring,
@@ -158,20 +179,20 @@ Executable elm
158 directory,
179 directory,
159 filepath,
180 filepath,
160 indents,
181 indents,
161− language-ecmascript < 1,
182+ language-ecmascript >=0.15 && < 1.0,
162 mtl >= 2,
183 mtl >= 2,
163 pandoc >= 1.10,
184 pandoc >= 1.10,
164 parsec >= 3.1.1,
185 parsec >= 3.1.1,
165 pretty,
186 pretty,
187+ text,
166 transformers >= 0.2,
188 transformers >= 0.2,
167 union-find,
189 union-find,
168− uniplate
190+ unordered-containers
169
191
170Executable elm-doc
192Executable elm-doc
171 Main-is: Docs.hs
193 Main-is: Docs.hs
172 Hs-Source-Dirs: compiler
194 Hs-Source-Dirs: compiler
173 other-modules: SourceSyntax.Declaration,
195 other-modules: SourceSyntax.Declaration,
174− SourceSyntax.Everything,
175 SourceSyntax.Expression,
196 SourceSyntax.Expression,
176 SourceSyntax.Helpers,
197 SourceSyntax.Helpers,
177 SourceSyntax.Literal,
198 SourceSyntax.Literal,
@@ -192,7 +213,7 @@ Executable elm-doc
192 Build-depends: aeson,
213 Build-depends: aeson,
193 aeson-pretty,
214 aeson-pretty,
194 base >=4.2 && <5,
215 base >=4.2 && <5,
195− binary,
216+ binary >= 0.6.4.0,
196 bytestring,
217 bytestring,
197 cmdargs,
218 cmdargs,
198 containers >= 0.3,
219 containers >= 0.3,
@@ -209,4 +230,4 @@ Test-Suite test-elm
209 Type: exitcode-stdio-1.0
230 Type: exitcode-stdio-1.0
210 Hs-Source-Dirs: tests
231 Hs-Source-Dirs: tests
211 Main-is: Main.hs
232 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 @@
1
1
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+
2−Release 0.9.1
26+## 0.9.1
3−=============
4
27
5 * Allow custom precedence and associativity for user-defined infix ops
28 * Allow custom precedence and associativity for user-defined infix ops
6 * Realias types before printing
29 * Realias types before printing
@@ -10,8 +33,7 @@ Release 0.9.1
10 * Fix miscellaneous bugs in type checker
33 * Fix miscellaneous bugs in type checker
11 * Switch name of Matrix2D to Transform2D
34 * Switch name of Matrix2D to Transform2D
12
35
13−Release 0.9
36+## 0.9
14−===========
15
37
16Build Improvements:
38Build Improvements:
17 * Major speed improvements to type-checker
39 * Major speed improvements to type-checker
@@ -62,8 +84,7 @@ Website:
62forgot to fill this in again...
84forgot to fill this in again...
63
85
64
86
65−Release 0.7.2
87+## 0.7.2
66−=============
67
88
68* Add a WebSockets library.
89* Add a WebSockets library.
69* Add support for the mathematical looking operator for function composition (U+2218).
90* Add support for the mathematical looking operator for function composition (U+2218).
@@ -72,8 +93,7 @@ Release 0.7.2
72forgot to fill this in for a while...
93forgot to fill this in for a while...
73
94
74
95
75−Release 0.5.0
96+## 0.5.0
76−=============
77
97
78* Add Dict, Set, and Automaton libraries!
98* Add Dict, Set, and Automaton libraries!
79
99
@@ -101,8 +121,7 @@ Release 0.5.0
101
121
102
122
103
123
104−Release 0.4.0
124+## 0.4.0
105−=============
106
125
107This version is all about graphics: nicer API with more features and major
126This version is all about graphics: nicer API with more features and major
108efficiency improvements. I am really excited about this release!
127efficiency improvements. I am really excited about this release!
@@ -132,8 +151,7 @@ efficiency improvements. I am really excited about this release!
132
151
133
152
134
153
135−Release 0.3.6
154+## 0.3.6
136−=============
137
155
138* Add JSON library.
156* Add JSON library.
139
157
@@ -165,8 +183,7 @@ Release 0.3.6
165
183
166
184
167
185
168−Release 0.3.5
186+## 0.3.5
169−=============
170
187
171* Add JavaScript event interface. Allows Elm to import and export JS values
188* Add JavaScript event interface. Allows Elm to import and export JS values
172 and events. This makes it possible to import and export Elements, so users
189 and events. This makes it possible to import and export Elements, so users
@@ -213,8 +230,7 @@ Release 0.3.5
213
230
214
231
215
232
216−Release 0.3.0
233+## 0.3.0
217−=============
218
234
219Major Changes (Read this part!)
235Major Changes (Read this part!)
220-------------------------------
236-------------------------------
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 #-}
2module Main where
1module Main where
3
2
4−import Control.Monad
3+import Control.Monad (foldM)
5import qualified Data.Map as Map
4import qualified Data.Map as Map
6−import qualified Data.List as List
5+import qualified Data.Maybe as Maybe
6+import Text.Blaze.Html.Renderer.String (renderHtml)
7−import qualified Data.Binary as Binary
7+import qualified Data.ByteString.Lazy.Char8 as BS
8−import Data.Version (showVersion)
9−import System.Console.CmdArgs hiding (program)
8+import qualified System.Console.CmdArgs as CmdArgs
10import System.Directory
9import System.Directory
11−import System.Exit
12import System.FilePath
10import System.FilePath
13−import System.IO
14import GHC.Conc
11import GHC.Conc
15
12
16−import Text.Blaze.Html.Renderer.Pretty (renderHtml)
13+import Build.Dependencies (getSortedDependencies)
17−import qualified Data.ByteString.Lazy.Char8 as BS
14+import qualified Generate.Html as Html
18−import qualified Data.ByteString.Lazy as L
19−
20import qualified Metadata.Prelude as Prelude
15import qualified Metadata.Prelude as Prelude
21−import qualified Transform.Canonicalize as Canonical
16+import qualified Build.Utils as Utils
22−import SourceSyntax.Module
17+import qualified Build.Flags as Flag
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
18+import qualified Build.File as File
32−import qualified Type.Alias as Alias
19+import qualified Elm.Internal.Paths as Path
33
20
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 ()
77main = do setNumCapabilities =<< getNumProcessors
22main = do setNumCapabilities =<< getNumProcessors
78− compileArgs =<< cmdArgs flags
23+ compileArgs =<< CmdArgs.cmdArgs Flag.flags
79
24
80−compileArgs :: Flags -> IO ()
25+compileArgs :: Flag.Flags -> IO ()
81compileArgs flags =
26compileArgs flags =
82− case files flags of
27+ case Flag.files flags of
83 [] -> putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
28 [] -> putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
84 fs -> mapM_ (build flags) fs
29 fs -> mapM_ (build flags) fs
85−
86
30
87−buildPath :: Flags -> FilePath -> String -> FilePath
31+build :: Flag.Flags -> FilePath -> IO ()
88−buildPath flags filePath ext = build_dir flags </> replaceExtension filePath ext
32+build flags rootFile =
33+ do let noPrelude = Flag.no_prelude flags
34+ builtIns <- if noPrelude then return Map.empty else Prelude.interfaces
89
35
90−cachePath :: Flags -> FilePath -> String -> FilePath
36+ files <- if Flag.make flags
91−cachePath flags filePath ext = cache_dir flags </> replaceExtension filePath ext
37+ then getSortedDependencies (Flag.src_dir flags) builtIns rootFile
38+ else return [rootFile]
92
39
93−elmo :: Flags -> FilePath -> FilePath
40+ (moduleName, interfaces) <-
94−elmo flags filePath = cachePath flags filePath "elmo"
41+ File.build flags (length files) builtIns "" files
95
42
96−elmi :: Flags -> FilePath -> FilePath
43+ js <- foldM appendToOutput BS.empty files
97−elmi flags filePath = cachePath flags filePath "elmi"
98
44
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)
99
51
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
52+ let targetFile = Utils.buildPath flags rootFile extension
196− createDirectoryIfMissing True (takeDirectory targetFile)
53+ createDirectoryIfMissing True (takeDirectory targetFile)
197− BS.writeFile targetFile code
54+ BS.writeFile targetFile code
198− putStrLn "Done"
55+ putStrLn "Done"
199
56
200 where
57 where
201 appendToOutput :: BS.ByteString -> FilePath -> IO BS.ByteString
58 appendToOutput :: BS.ByteString -> FilePath -> IO BS.ByteString
202− appendToOutput js filePath =
59+ appendToOutput js filePath = do
203− do src <- BS.readFile (elmo flags filePath)
60+ src <- BS.readFile (Utils.elmo flags filePath)
204− return (BS.append src js)
61+ return (BS.append src js)
205−
206− sources js = map Link (scripts flags) ++ [ Source js ]
207
62
63+ sources js = map Html.Link (Flag.scripts flags) ++ [ Html.Source js ]
208
64
209−buildFiles :: Flags -> Int -> Interfaces -> String -> [FilePath] -> IO (String, Interfaces)
65+ makeHtml js moduleName = ("html", BS.pack $ renderHtml html)
210−buildFiles _ _ interfaces moduleName [] = return (moduleName, interfaces)
66+ where
211−buildFiles flags numModules interfaces _ (filePath:rest) = do
67+ rtsPath = Maybe.fromMaybe Path.runtime (Flag.runtime flags)
212− (name,interface) <- buildFile flags (numModules - length rest) numModules interfaces filePath
68+ html = Html.generate rtsPath (takeBaseName rootFile) (sources js) moduleName ""
213− let interfaces' = Map.insert name interface interfaces
214− buildFiles flags numModules interfaces' name rest
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
2
2
3import Control.Applicative ((<$>),(<*>))
3import Control.Applicative ((<$>),(<*>))
4import Control.Arrow (first,second)
4import Control.Arrow (first,second)
@@ -21,7 +21,7 @@ toMatch patterns = do
21newVar :: State Int String
21newVar :: State Int String
22newVar = do n <- get
22newVar = do n <- get
23 modify (+1)
23 modify (+1)
24− return $ "_case" ++ show n
24+ return $ "_v" ++ show n
25
25
26data Match t v
26data Match t v
27 = Match String [Clause t v] (Match t v)
27 = Match String [Clause t v] (Match t v)
@@ -104,7 +104,11 @@ matchCon (v:vs) cs def = (flip (Match v) def) <$> mapM toClause css
104 (PData name _ : _, _) -> matchClause (Left name) (v:vs) cs Break
104 (PData name _ : _, _) -> matchClause (Left name) (v:vs) cs Break
105 (PLiteral lit : _, _) -> matchClause (Right lit) (v:vs) cs Break
105 (PLiteral lit : _, _) -> matchClause (Right lit) (v:vs) cs Break
106
106
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)
108matchClause c (v:vs) cs def =
112matchClause c (v:vs) cs def =
109 do vs' <- getVars
113 do vs' <- getVars
110 Clause c vs' <$> match (vs' ++ vs) (map flatten cs) def
114 Clause c vs' <$> match (vs' ++ vs) (map flatten cs) def
compiler/Generate/Html.hs+3−10
@@ -1,8 +1,5 @@
1{-# LANGUAGE OverloadedStrings #-}
1{-# LANGUAGE OverloadedStrings #-}
2−module Generate.Html
2+module Generate.Html (generate, JSSource(..)) where
3− (createHtml,
4− JSSource (..)
5− ) where
6
3
7import Text.Blaze (preEscapedToMarkup)
4import Text.Blaze (preEscapedToMarkup)
8import qualified Text.Blaze.Html5 as H
5import qualified Text.Blaze.Html5 as H
@@ -10,10 +7,6 @@ import Text.Blaze.Html5 ((!))
10import qualified Text.Blaze.Html5.Attributes as A
7import qualified Text.Blaze.Html5.Attributes as A
11import qualified Data.ByteString.Lazy.Char8 as BS
8import qualified Data.ByteString.Lazy.Char8 as BS
12
9
13−import Initialize (buildFromSource)
14−import Generate.JavaScript
15−import Generate.Noscript
16−
17data JSSource = Link String | Source BS.ByteString
10data JSSource = Link String | Source BS.ByteString
18
11
19makeScript :: JSSource -> H.Html
12makeScript :: JSSource -> H.Html
@@ -24,8 +17,8 @@ makeScript source =
24 H.script ! A.type_ "text/javascript" $
17 H.script ! A.type_ "text/javascript" $
25 preEscapedToMarkup $ BS.unpack src
18 preEscapedToMarkup $ BS.unpack src
26
19
27−createHtml :: FilePath -> String -> [JSSource] -> String -> String -> H.Html
20+generate :: FilePath -> String -> [JSSource] -> String -> String -> H.Html
28−createHtml libLoc title scripts moduleName noscript =
21+generate libLoc title scripts moduleName noscript =
29 H.docTypeHtml $ do
22 H.docTypeHtml $ do
30 H.head $ do
23 H.head $ do
31 H.meta ! A.charset "UTF-8"
24 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
2
2
3import Control.Arrow (first,(***))
3import Control.Arrow (first,(***))
4import Control.Applicative ((<$>),(<*>))
4import Control.Applicative ((<$>),(<*>))
@@ -9,30 +9,27 @@ import qualified Data.Set as Set
9
9
10import qualified Generate.Cases as Case
10import qualified Generate.Cases as Case
11import qualified Generate.Markdown as MD
11import qualified Generate.Markdown as MD
12+import qualified SourceSyntax.Helpers as Help
13+import SourceSyntax.Literal
12−import SourceSyntax.Everything
14+import SourceSyntax.Pattern
13import SourceSyntax.Location
15import SourceSyntax.Location
16+import SourceSyntax.Expression
17+import SourceSyntax.Module
14import qualified Transform.SortDefinitions as SD
18import qualified Transform.SortDefinitions as SD
15import Language.ECMAScript3.Syntax
19import Language.ECMAScript3.Syntax
16import Language.ECMAScript3.PrettyPrint
20import Language.ECMAScript3.PrettyPrint
17−import Parse.Helpers (jsReserveds)
21+import qualified Transform.SafeNames as MakeSafe
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
26
22
23+split :: String -> [String]
27split = go []
24split = go []
28 where
25 where
29 go vars str =
26 go vars str =
30 case break (=='.') str of
27 case break (=='.') str of
31− (x,'.':rest) | isOp x -> vars ++ [x ++ '.' : rest]
28+ (x,'.':rest) | Help.isOp x -> vars ++ [x ++ '.' : rest]
32 | otherwise -> go (vars ++ [x]) rest
29 | otherwise -> go (vars ++ [x]) rest
33 (x,[]) -> vars ++ [x]
30 (x,[]) -> vars ++ [x]
34
31
35−var name = Id () (makeSafe name)
32+var name = Id () name
36ref name = VarRef () (var name)
33ref name = VarRef () (var name)
37prop name = PropId () (var name)
34prop name = PropId () (var name)
38f <| x = CallExpr () f [x]
35f <| x = CallExpr () f [x]
@@ -44,11 +41,12 @@ string = StringLit ()
44dotSep (x:xs) = foldl (DotRef ()) (ref x) (map var xs)
41dotSep (x:xs) = foldl (DotRef ()) (ref x) (map var xs)
45obj = dotSep . split
42obj = dotSep . split
46
43
44+varDecl :: String -> Expression () -> VarDecl ()
47varDecl x expr =
45varDecl x expr =
48 VarDecl () (var x) (Just expr)
46 VarDecl () (var x) (Just expr)
49
47
50include alias moduleName =
48include alias moduleName =
51− varDecl alias (obj (moduleName ++ ".make") <| ref "elm")
49+ varDecl alias (obj (moduleName ++ ".make") <| ref "_elm")
52
50
53internalImports name =
51internalImports name =
54 VarDeclStmt ()
52 VarDeclStmt ()
@@ -60,6 +58,7 @@ internalImports name =
60 , varDecl "$moduleName" (string name)
58 , varDecl "$moduleName" (string name)
61 ]
59 ]
62
60
61+literal :: Literal -> Expression ()
63literal lit =
62literal lit =
64 case lit of
63 case lit of
65 Chr c -> obj "_N.chr" <| string [c]
64 Chr c -> obj "_N.chr" <| string [c]
@@ -114,18 +113,17 @@ expression (L span expr) =
114 Binop op e1 e2 -> binop span op e1 e2
113 Binop op e1 e2 -> binop span op e1 e2
115
114
116 Lambda p e@(L s _) ->
115 Lambda p e@(L s _) ->
116+ do (args, body) <- foldM depattern ([], innerBody) (reverse patterns)
117− do body' <- expression body
117+ body' <- expression body
118 return $ case length args < 2 || length args > 9 of
118 return $ case length args < 2 || length args > 9 of
119 True -> foldr (==>) body' (map (:[]) args)
119 True -> foldr (==>) body' (map (:[]) args)
120 False -> ref ("F" ++ show (length args)) <| (args ==> body')
120 False -> ref ("F" ++ show (length args)) <| (args ==> body')
121 where
121 where
122− (args, body) = foldr depattern ([], innerBody) (zip patterns [0..])
122+ depattern (args, body) pattern =
123−
124− depattern (pattern,n) (args, body) =
125 case pattern of
123 case pattern of
126− PVar x -> (args ++ [x], body)
124+ PVar x -> return (args ++ [x], body)
127− _ -> let arg = "arg" ++ show n
125+ _ -> do arg <- Case.newVar
128− in (args ++ [arg], L s (Case (L s (Var arg)) [(pattern, body)]))
126+ return (args ++ [arg], L s (Case (L s (Var arg)) [(pattern, body)]))
129
127
130 (patterns, innerBody) = collect [p] e
128 (patterns, innerBody) = collect [p] e
131
129
@@ -156,14 +154,15 @@ expression (L span expr) =
156 return $ function [] (stmts ++ [ ReturnStmt () (Just exp) ]) `call` []
154 return $ function [] (stmts ++ [ ReturnStmt () (Just exp) ]) `call` []
157
155
158 MultiIf branches ->
156 MultiIf branches ->
159− do branches' <- forM branches $ \(b,e) -> (,) <$> expression b <*> expression e
157+ do branches' <- forM branches $ \(b,e) -> (,) <$> expression b <*> expression e
160− return $ case last branches of
158+ return $ case last branches of
161− (L _ (Var "Basics.otherwise"), e) -> ifs (init branches') (snd (last branches'))
159+ (L _ (Var "Basics.otherwise"), _) -> safeIfs branches'
162− _ -> ifs branches'
160+ (L _ (Literal (Boolean True)), _) -> safeIfs branches'
163− (obj "_E.If" `call` [ ref "$moduleName", string (show span) ])
161+ _ -> ifs branches' (obj "_E.If" `call` [ ref "$moduleName", string (show span) ])
164− where
162+ where
163+ safeIfs branches = ifs (init branches) (snd (last branches))
165− ifs branches finally = foldr iff finally branches
164+ ifs branches finally = foldr iff finally branches
166− iff (if', then') else' = CondExpr () if' then' else'
165+ iff (if', then') else' = CondExpr () if' then' else'
167
166
168 Case e cases ->
167 Case e cases ->
169 do (tempVar,initialMatch) <- Case.toMatch cases
168 do (tempVar,initialMatch) <- Case.toMatch cases
@@ -183,11 +182,15 @@ expression (L span expr) =
183 do es' <- mapM expression es
182 do es' <- mapM expression es
184 return $ ObjectLit () (ctor : fields es')
183 return $ ObjectLit () (ctor : fields es')
185 where
184 where
186− ctor = (prop "ctor", string (makeSafe name))
185+ ctor = (prop "ctor", string name)
187 fields = zipWith (\n e -> (prop ("_" ++ show n), e)) [0..]
186 fields = zipWith (\n e -> (prop ("_" ++ show n), e)) [0..]
188
187
189− Markdown md _ -> return $ obj "Text.text" <| string (pad ++ MD.toHtml md ++ pad)
188+ Markdown uid doc es ->
189+ do es' <- mapM expression es
190+ return $ obj "Text.markdown" `call` (string md : string uid : es')
191+ where
190− where pad = "<div style=\"height:0;width:0;\">&nbsp;</div>"
192+ pad = "<div style=\"height:0;width:0;\">&nbsp;</div>"
193+ md = pad ++ MD.toHtml doc ++ pad
191
194
192definition :: Def () () -> State Int [Statement ()]
195definition :: Def () () -> State Int [Statement ()]
193definition def =
196definition def =
@@ -199,7 +202,7 @@ definition def =
199 let assign x = varDecl x expr'
202 let assign x = varDecl x expr'
200 case pattern of
203 case pattern of
201 PVar x
204 PVar x
202− | isOp x ->
205+ | Help.isOp x ->
203 let op = LBracket () (ref "_op") (string x) in
206 let op = LBracket () (ref "_op") (string x) in
204 return [ ExprStmt () $ AssignExpr () OpAssign op expr' ]
207 return [ ExprStmt () $ AssignExpr () OpAssign op expr' ]
205 | otherwise ->
208 | otherwise ->
@@ -222,11 +225,11 @@ definition def =
222
225
223 decl x n = varDecl x (dotSep ["$","_" ++ show n])
226 decl x n = varDecl x (dotSep ["$","_" ++ show n])
224 setup vars
227 setup vars
225− | isTuple name = assign "$" : vars
228+ | Help.isTuple name = assign "$" : vars
226− | otherwise = safeAssign : vars
229+ | otherwise = assign "$raw" : safeAssign : vars
227
230
228− safeAssign = varDecl "$" (CondExpr () if' expr' exception)
231+ safeAssign = varDecl "$" (CondExpr () if' (obj "$raw") exception)
229− if' = InfixExpr () OpStrictEq (obj "$.ctor") (string name)
232+ if' = InfixExpr () OpStrictEq (obj "$raw.ctor") (string name)
230 exception = obj "_E.Case" `call` [ref "$moduleName", string (show span)]
233 exception = obj "_E.Case" `call` [ref "$moduleName", string (show span)]
231
234
232 _ ->
235 _ ->
@@ -284,14 +287,15 @@ clause span variable (Case.Clause value vars mtch) =
284 is -> drop (last is + 1) name
287 is -> drop (last is + 1) name
285
288
286
289
287−jsModule :: MetadataModule () () -> String
290+generate :: MetadataModule () () -> String
288−jsModule modul =
291+generate unsafeModule =
289 show . prettyPrint $ setup (Just "Elm") (names modul ++ ["make"]) ++
292 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) ]
291 where
294 where
295+ modul = MakeSafe.metadataModule unsafeModule
292− thisModule = dotSep ("elm" : names modul ++ ["values"])
296+ thisModule = dotSep ("_elm" : names modul ++ ["values"])
293 programStmts =
297 programStmts =
294− concat [ setup (Just "elm") (names modul ++ ["values"])
298+ concat [ setup (Just "_elm") (names modul ++ ["values"])
295 , [ IfSingleStmt () thisModule (ReturnStmt () (Just thisModule)) ]
299 , [ IfSingleStmt () thisModule (ReturnStmt () (Just thisModule)) ]
296 , [ internalImports (List.intercalate "." (names modul)) ]
300 , [ internalImports (List.intercalate "." (names modul)) ]
297 , concatMap jsImport (imports modul)
301 , concatMap jsImport (imports modul)
@@ -303,9 +307,9 @@ jsModule modul =
303 , [ ReturnStmt () (Just thisModule) ]
307 , [ ReturnStmt () (Just thisModule) ]
304 ]
308 ]
305
309
306− jsExports = assign ("elm" : names modul ++ ["values"]) (ObjectLit () exs)
310+ jsExports = assign ("_elm" : names modul ++ ["values"]) (ObjectLit () exs)
307 where
311 where
308− exs = map entry . filter (not . isOp) $ "_op" : exports modul
312+ exs = map entry . filter (not . Help.isOp) $ "_op" : exports modul
309 entry x = (PropId () (var x), ref x)
313 entry x = (PropId () (var x), ref x)
310
314
311 assign path expr =
315 assign path expr =
@@ -317,7 +321,7 @@ jsModule modul =
317 jsImport (modul,_) = setup Nothing path ++ [ include ]
321 jsImport (modul,_) = setup Nothing path ++ [ include ]
318 where
322 where
319 path = split modul
323 path = split modul
320− include = assign path $ dotSep ("Elm" : path ++ ["make"]) <| ref "elm"
324+ include = assign path $ dotSep ("Elm" : path ++ ["make"]) <| ref "_elm"
321
325
322 setup namespace path = map create paths
326 setup namespace path = map create paths
323 where
327 where
@@ -326,15 +330,15 @@ jsModule modul =
326 Nothing -> tail . init $ List.inits path
330 Nothing -> tail . init $ List.inits path
327 Just nmspc -> drop 2 . init . List.inits $ nmspc : path
331 Just nmspc -> drop 2 . init . List.inits $ nmspc : path
328
332
329− addId js = InfixExpr () OpAdd (string (js++"_")) (obj "elm.id")
333+ addId js = InfixExpr () OpAdd (string (js++"_")) (obj "_elm.id")
330
334
331 importEvent (js,base,elm,_) =
335 importEvent (js,base,elm,_) =
332 [ VarDeclStmt () [ varDecl elm $ obj "Signal.constant" <| evalState (expression base) 0 ]
336 [ VarDeclStmt () [ varDecl elm $ obj "Signal.constant" <| evalState (expression base) 0 ]
333 , ExprStmt () $
337 , ExprStmt () $
334 obj "document.addEventListener" `call`
338 obj "document.addEventListener" `call`
335 [ addId js
339 [ addId js
336− , function ["e"]
340+ , function ["_e"]
337− [ ExprStmt () $ obj "elm.notify" `call` [dotSep [elm,"id"], obj "e.value"] ]
341+ [ ExprStmt () $ obj "_elm.notify" `call` [dotSep [elm,"id"], obj "_e.value"] ]
338 ]
342 ]
339 ]
343 ]
340
344
@@ -342,13 +346,13 @@ jsModule modul =
342 ExprStmt () $
346 ExprStmt () $
343 ref "A2" `call`
347 ref "A2" `call`
344 [ obj "Signal.lift"
348 [ obj "Signal.lift"
345− , function ["v"]
349+ , function ["_v"]
346− [ VarDeclStmt () [varDecl "e" $ obj "document.createEvent" <| string "Event"]
350+ [ VarDeclStmt () [varDecl "_e" $ obj "document.createEvent" <| string "Event"]
347 , ExprStmt () $
351 , ExprStmt () $
348− obj "e.initEvent" `call` [ addId js, BoolLit () True, BoolLit () True ]
352+ obj "_e.initEvent" `call` [ addId js, BoolLit () True, BoolLit () True ]
349− , ExprStmt () $ AssignExpr () OpAssign (LDot () (ref "e") "value") (ref "v")
353+ , ExprStmt () $ AssignExpr () OpAssign (LDot () (ref "_e") "value") (ref "_v")
350− , ExprStmt () $ obj "document.dispatchEvent" <| ref "e"
354+ , ExprStmt () $ obj "document.dispatchEvent" <| ref "_e"
351− , ReturnStmt () (Just $ ref "v")
355+ , ReturnStmt () (Just $ ref "_v")
352 ]
356 ]
353 , ref elm ]
357 , ref elm ]
354
358
@@ -381,7 +385,7 @@ binop span op e1 e2 =
381 js1 = expression e1
385 js1 = expression e1
382 js2 = expression e2
386 js2 = expression e2
383
387
384− func | isOp operator = BracketRef () (dotSep (init parts ++ ["_op"])) (string operator)
388+ func | Help.isOp operator = BracketRef () (dotSep (init parts ++ ["_op"])) (string operator)
385 | otherwise = dotSep parts
389 | otherwise = dotSep parts
386 where
390 where
387 parts = split op
391 parts = split op
compiler/Generate/Markdown.hs+34−1
@@ -1,6 +1,39 @@
1module Generate.Markdown where
1module Generate.Markdown where
2
2
3import Text.Pandoc
3import Text.Pandoc
4+import qualified Data.Set as Set
4
5
5toHtml :: String -> String
6toHtml :: 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 @@
1module Generate.Noscript (noscript) where
1module Generate.Noscript (noscript) where
2
2
3import Data.List (isInfixOf)
3import Data.List (isInfixOf)
4−import SourceSyntax.Everything
4+import SourceSyntax.Declaration (Declaration(..))
5+import SourceSyntax.Expression
6+import SourceSyntax.Literal
7+import SourceSyntax.Location
8+import SourceSyntax.Module
5import qualified Generate.Markdown as MD
9import qualified Generate.Markdown as MD
6
10
7noscript :: Module t v -> String
11noscript :: Module t v -> String
@@ -49,7 +53,7 @@ instance Extract (Expr t v) where
49 Case e cases -> concatMap (f . snd) cases
53 Case e cases -> concatMap (f . snd) cases
50 Data _ es -> concatMap f es
54 Data _ es -> concatMap f es
51 MultiIf es -> concatMap (f . snd) es
55 MultiIf es -> concatMap (f . snd) es
52− Markdown md _ -> [ MD.toHtml md ]
56+ Markdown _ md _ -> [ MD.toHtml md ]
53 _ -> []
57 _ -> []
54
58
55extractLink src txt =
59extractLink 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
7import System.Exit
7import System.Exit
8import System.FilePath
8import System.FilePath
9import System.IO
9import System.IO
10−import System.IO.Unsafe (unsafePerformIO)
11import SourceSyntax.Module
10import SourceSyntax.Module
12import qualified Data.Binary as Binary
11import qualified Data.Binary as Binary
13import qualified Data.ByteString.Lazy as BS
12import qualified Data.ByteString.Lazy as BS
14
13
14+import qualified InterfaceSerialization as IS
15
15
16add :: Module t v -> Module t v
16add :: Module t v -> Module t v
17add (Module name exs ims stmts) = Module name exs (customIms ++ ims) stmts
17add (Module name exs ims stmts) = Module name exs (customIms ++ ims) stmts
@@ -30,10 +30,8 @@ prelude = text ++ map (\n -> (n, Hiding [])) modules
30 modules = [ "Basics", "Signal", "List", "Maybe", "Time", "Prelude"
30 modules = [ "Basics", "Signal", "List", "Maybe", "Time", "Prelude"
31 , "Graphics.Element", "Color", "Graphics.Collage" ]
31 , "Graphics.Element", "Color", "Graphics.Collage" ]
32
32
33−{-# NOINLINE interfaces #-}
34−interfaces :: Interfaces
33+interfaces :: IO Interfaces
35−interfaces =
36− unsafePerformIO (safeReadDocs =<< Path.getDataFileName "interfaces.data")
34+interfaces = safeReadDocs =<< Path.getDataFileName "interfaces.data"
37
35
38safeReadDocs :: FilePath -> IO Interfaces
36safeReadDocs :: FilePath -> IO Interfaces
39safeReadDocs name =
37safeReadDocs name =
@@ -46,14 +44,27 @@ safeReadDocs name =
46 , " and specify your versions of Elm and your OS" ]
44 , " and specify your versions of Elm and your OS" ]
47 exitFailure
45 exitFailure
48
46
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+
49readDocs :: FilePath -> IO Interfaces
54readDocs :: FilePath -> IO Interfaces
50−readDocs name = do
55+readDocs filePath = do
51− exists <- doesFileExist name
56+ bytes <- IS.loadInterface filePath
52− case exists of
57+ let interfaces = IS.interfaceDecode filePath =<< bytes
53− False -> ioError . userError $ "File Not Found"
58+
54− True -> do
59+ -- Although every ModuleInterface that is deserialized in this collection
55− handle <- openBinaryFile name ReadMode
60+ -- contains the compiler version, we only check the first ModuleInterface
56− bits <- BS.hGetContents handle
61+ -- since it doesn't make sense that different modules in Prelude would
57− let ifaces = Map.fromList (Binary.decode bits)
62+ -- have been compiled by different compiler versions.
58− BS.length bits `seq` hClose handle
63+ isValid = IS.validVersion filePath =<< firstModuleInterface =<< interfaces
59− return ifaces
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
26 forcedWS
26 forcedWS
27 alias <- capVar
27 alias <- capVar
28 args <- spacePrefix lowVar
28 args <- spacePrefix lowVar
29− whitespace ; string "=" ; whitespace
29+ padded equals
30 tipe <- Type.expr
30 tipe <- Type.expr
31 return (TypeAlias alias args tipe)
31 return (TypeAlias alias args tipe)
32
32
@@ -36,7 +36,7 @@ datatype = do
36 forcedWS
36 forcedWS
37 name <- capVar <?> "name of data-type"
37 name <- capVar <?> "name of data-type"
38 args <- spacePrefix lowVar
38 args <- spacePrefix lowVar
39− whitespace ; string "=" ; whitespace
39+ padded equals
40 tcs <- pipeSep1 Type.constructor
40 tcs <- pipeSep1 Type.constructor
41 return $ Datatype name args tcs
41 return $ Datatype name args tcs
42
42
@@ -46,7 +46,7 @@ infixDecl = do
46 assoc <- choice [ reserved "infixl" >> return L
46 assoc <- choice [ reserved "infixl" >> return L
47 , reserved "infix" >> return N
47 , reserved "infix" >> return N
48 , reserved "infixr" >> return R ]
48 , reserved "infixr" >> return R ]
49− whitespace
49+ forcedWS
50 n <- digit
50 n <- digit
51 forcedWS
51 forcedWS
52 Fixity assoc (read [n]) <$> anyOp
52 Fixity assoc (read [n]) <$> anyOp
@@ -60,11 +60,11 @@ foreignDef = do
60
60
61exportEvent :: IParser (Declaration t v)
61exportEvent :: IParser (Declaration t v)
62exportEvent = do
62exportEvent = do
63− try (reserved "export") >> whitespace >> reserved "jsevent" >> whitespace
63+ try (reserved "export") >> padded (reserved "jsevent")
64 eventName <- jsVar
64 eventName <- jsVar
65 whitespace
65 whitespace
66 elmVar <- lowVar
66 elmVar <- lowVar
67− whitespace ; hasType ; whitespace
67+ padded hasType
68 tipe <- Type.expr
68 tipe <- Type.expr
69 case tipe of
69 case tipe of
70 T.Data "Signal" [t] ->
70 T.Data "Signal" [t] ->
@@ -75,13 +75,12 @@ exportEvent = do
75
75
76importEvent :: IParser (Declaration t v)
76importEvent :: IParser (Declaration t v)
77importEvent = do
77importEvent = do
78− try (reserved "import") >> whitespace >> reserved "jsevent" >> whitespace
78+ try (reserved "import") >> padded (reserved "jsevent")
79 eventName <- jsVar
79 eventName <- jsVar
80− whitespace
80+ baseValue <- padded Expr.term
81− baseValue <- Expr.term <?> "Base case for imported signal (signals cannot be undefined)"
81+ <?> "Base case for imported signal (signals cannot be undefined)"
82− whitespace
83 elmVar <- lowVar <?> "Name of imported signal"
82 elmVar <- lowVar <?> "Name of imported signal"
84− whitespace ; hasType ; whitespace
83+ padded hasType
85 tipe <- Type.expr
84 tipe <- Type.expr
86 case tipe of
85 case tipe of
87 T.Data "Signal" [t] ->
86 T.Data "Signal" [t] ->
compiler/Parse/Expression.hs+24−26
@@ -50,23 +50,23 @@ listTerm = markdown' <|> braces (try range <|> ExplicitList <$> commaSep expr)
50 where
50 where
51 range = do
51 range = do
52 lo <- expr
52 lo <- expr
53− whitespace >> string ".." >> whitespace
53+ padded (string "..")
54 Range lo <$> expr
54 Range lo <$> expr
55
55
56 markdown' = do
56 markdown' = do
57+ pos <- getPosition
58+ let uid = show (sourceLine pos) ++ ":" ++ show (sourceColumn pos)
57− (rawText, exprs) <- markdown interpolation
59+ (rawText, exprs) <- markdown (interpolation uid)
58− return (Markdown (filter (/='\r') rawText) exprs)
60+ return (Markdown uid (filter (/='\r') rawText) exprs)
59
61
60− span xs = "<span id=\"md" ++ show (length xs) ++
62+ span uid index =
61− "\" style=\"font-family:monospace;\">{{ ... }}</span>"
63+ "<span id=\"md-" ++ uid ++ "-" ++ show index ++ "\">{{ markdown interpolation is in the pipeline, but still needs more testing }}</span>"
62
64
63− interpolation md exprs = do
65+ interpolation uid md exprs = do
64 try (string "{{")
66 try (string "{{")
65− whitespace
66− e <- expr
67+ e <- padded expr
67− whitespace
68 string "}}"
68 string "}}"
69− return (md ++ span exprs, exprs ++ [e])
69+ return (md ++ span uid (length exprs), exprs ++ [e])
70
70
71parensTerm :: IParser (LExpr t v)
71parensTerm :: IParser (LExpr t v)
72parensTerm = try (parens opFn) <|> parens (tupleFn <|> parened)
72parensTerm = try (parens opFn) <|> parens (tupleFn <|> parened)
@@ -96,7 +96,7 @@ recordTerm = brackets $ choice [ misc, addLocation record ]
96 where field = do
96 where field = do
97 label <- rLabel
97 label <- rLabel
98 patterns <- spacePrefix Pattern.term
98 patterns <- spacePrefix Pattern.term
99− whitespace >> string "=" >> whitespace
99+ padded equals
100 body <- expr
100 body <- expr
101 return (label, makeFunction patterns body)
101 return (label, makeFunction patterns body)
102
102
@@ -104,24 +104,21 @@ recordTerm = brackets $ choice [ misc, addLocation record ]
104
104
105 change = do
105 change = do
106 lbl <- rLabel
106 lbl <- rLabel
107− whitespace >> string "<-" >> whitespace
107+ padded (string "<-")
108 (,) lbl <$> expr
108 (,) lbl <$> expr
109
109
110 remove r = addLocation (string "-" >> whitespace >> Remove r <$> rLabel)
110 remove r = addLocation (string "-" >> whitespace >> Remove r <$> rLabel)
111
111
112 insert r = addLocation $ do
112 insert r = addLocation $ do
113 string "|" >> whitespace
113 string "|" >> whitespace
114− Insert r <$> rLabel <*>
114+ Insert r <$> rLabel <*> (padded equals >> expr)
115− (whitespace >> string "=" >> whitespace >> expr)
116
115
117 modify r = addLocation
116 modify r = addLocation
118 (string "|" >> whitespace >> Modify r <$> commaSep1 change)
117 (string "|" >> whitespace >> Modify r <$> commaSep1 change)
119
118
120 misc = try $ do
119 misc = try $ do
121 record <- addLocation (Var <$> rLabel)
120 record <- addLocation (Var <$> rLabel)
122− whitespace
123− opt <- optionMaybe (remove record)
121+ opt <- padded (optionMaybe (remove record))
124− whitespace
125 case opt of
122 case opt of
126 Just e -> try (insert e) <|> return e
123 Just e -> try (insert e) <|> return e
127 Nothing -> try (insert record) <|> try (modify record)
124 Nothing -> try (insert record) <|> try (modify record)
@@ -155,22 +152,22 @@ ifExpr = reserved "if" >> whitespace >> (normal <|> multiIf)
155 where
152 where
156 normal = do
153 normal = do
157 bool <- expr
154 bool <- expr
158− whitespace ; reserved "then" ; whitespace
155+ padded (reserved "then")
159 thenBranch <- expr
156 thenBranch <- expr
160 whitespace <?> "an 'else' branch" ; reserved "else" <?> "an 'else' branch" ; whitespace
157 whitespace <?> "an 'else' branch" ; reserved "else" <?> "an 'else' branch" ; whitespace
161 elseBranch <- expr
158 elseBranch <- expr
162 return $ MultiIf [(bool, thenBranch),
159 return $ MultiIf [(bool, thenBranch),
163− (Location.sameAs elseBranch (Var "otherwise"), elseBranch)]
160+ (Location.sameAs elseBranch (Literal . Literal.Boolean $ True), elseBranch)]
164 multiIf = MultiIf <$> spaceSep1 iff
161 multiIf = MultiIf <$> spaceSep1 iff
165 where iff = do string "|" ; whitespace
162 where iff = do string "|" ; whitespace
166− b <- expr ; whitespace ; string "->" ; whitespace
163+ b <- expr ; padded arrow
167 (,) b <$> expr
164 (,) b <$> expr
168
165
169lambdaExpr :: IParser (LExpr t v)
166lambdaExpr :: IParser (LExpr t v)
170lambdaExpr = do char '\\' <|> char '\x03BB' <?> "anonymous function"
167lambdaExpr = do char '\\' <|> char '\x03BB' <?> "anonymous function"
171 whitespace
168 whitespace
172 args <- spaceSep1 Pattern.term
169 args <- spaceSep1 Pattern.term
173− whitespace ; arrow ; whitespace
170+ padded arrow
174 body <- expr
171 body <- expr
175 return (makeFunction args body)
172 return (makeFunction args body)
176
173
@@ -181,14 +178,15 @@ letExpr :: IParser (Expr t v)
181letExpr = do
178letExpr = do
182 reserved "let" ; whitespace
179 reserved "let" ; whitespace
183 defs <- defSet
180 defs <- defSet
184− whitespace ; reserved "in" ; whitespace
181+ padded (reserved "in")
185 Let defs <$> expr
182 Let defs <$> expr
186
183
187caseExpr :: IParser (Expr t v)
184caseExpr :: IParser (Expr t v)
188caseExpr = do
185caseExpr = do
189− reserved "case"; whitespace; e <- expr; whitespace; reserved "of"; whitespace
186+ reserved "case"; e <- padded expr; reserved "of"; whitespace
190 Case e <$> (with <|> without)
187 Case e <$> (with <|> without)
191− where case_ = do p <- Pattern.expr; whitespace; arrow; whitespace
188+ where case_ = do p <- Pattern.expr
189+ padded arrow
192 (,) p <$> expr
190 (,) p <$> expr
193 with = brackets (semiSep1 (case_ <?> "cases { x -> ... }"))
191 with = brackets (semiSep1 (case_ <?> "cases { x -> ... }"))
194 without = block (do c <- case_ ; whitespace ; return c)
192 without = block (do c <- case_ ; whitespace ; return c)
@@ -225,7 +223,7 @@ makeFunction args body@(L s _) =
225definition :: IParser (Def t v)
223definition :: IParser (Def t v)
226definition = withPos $ do
224definition = withPos $ do
227 (name:args) <- defStart
225 (name:args) <- defStart
228− whitespace >> string "=" >> whitespace
226+ padded equals
229 body <- expr
227 body <- expr
230 return . Def name $ makeFunction args body
228 return . Def name $ makeFunction args body
231
229
@@ -234,7 +232,7 @@ typeAnnotation = TypeAnnotation <$> try start <*> Type.expr
234 where
232 where
235 start = do
233 start = do
236 v <- lowVar <|> parens symOp
234 v <- lowVar <|> parens symOp
237− whitespace ; hasType ; whitespace
235+ padded hasType
238 return v
236 return v
239
237
240def :: IParser (Def t v)
238def :: IParser (Def t v)
compiler/Parse/Helpers.hs+57−7
@@ -21,7 +21,8 @@ reserveds = [ "if", "then", "else"
21 , "data", "type"
21 , "data", "type"
22 , "module", "where"
22 , "module", "where"
23 , "import", "as", "hiding", "open"
23 , "import", "as", "hiding", "open"
24− , "export", "foreign" ]
24+ , "export", "foreign"
25+ , "deriving" ]
25
26
26jsReserveds :: Set.Set String
27jsReserveds :: Set.Set String
27jsReserveds = Set.fromList
28jsReserveds = Set.fromList
@@ -35,6 +36,10 @@ jsReserveds = Set.fromList
35 , "const", "enum", "export", "extends", "import", "super", "implements"
36 , "const", "enum", "export", "extends", "import", "super", "implements"
36 , "interface", "let", "package", "private", "protected", "public"
37 , "interface", "let", "package", "private", "protected", "public"
37 , "static", "yield"
38 , "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"
38 ]
43 ]
39
44
40expecting = flip (<?>)
45expecting = flip (<?>)
@@ -49,9 +54,22 @@ iParseWithTable :: SourceName -> OpTable -> IParser a -> String -> Either ParseE
49iParseWithTable sourceName table aParser input =
54iParseWithTable sourceName table aParser input =
50 runIndent sourceName $ runParserT aParser table sourceName input
55 runIndent sourceName $ runParserT aParser table sourceName input
51
56
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+
52backslashed :: IParser Char
63backslashed :: IParser Char
53−backslashed = do { char '\\'; c <- anyChar
64+backslashed = do
65+ char '\\'
66+ c <- anyChar
67+ case readMaybe ['\'','\\',c,'\''] of
54− ; return . read $ ['\'','\\',c,'\''] }
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] ++ "\""
55
73
56var :: IParser String
74var :: IParser String
57var = makeVar (letter <|> char '_' <?> "variable")
75var = makeVar (letter <|> char '_' <?> "variable")
@@ -93,6 +111,15 @@ symOp = do op <- many1 (satisfy Help.isSymbol)
93 "\8728" -> return "."
111 "\8728" -> return "."
94 _ -> return op
112 _ -> return op
95
113
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+
96arrow :: IParser String
123arrow :: IParser String
97arrow = string "->" <|> string "\8594" <?> "arrow (->)"
124arrow = string "->" <|> string "\8594" <?> "arrow (->)"
98
125
@@ -106,7 +133,7 @@ commitIf check p = commit <|> try p
106spaceySepBy1 :: IParser b -> IParser a -> IParser [a]
133spaceySepBy1 :: IParser b -> IParser a -> IParser [a]
107spaceySepBy1 sep p = do
134spaceySepBy1 sep p = do
108 a <- p
135 a <- p
109− (a:) <$> many (commitIf (whitespace >> sep) (whitespace >> sep >> whitespace >> p))
136+ (a:) <$> many (commitIf (whitespace >> sep) (padded sep >> p))
110
137
111
138
112commaSep1 :: IParser a -> IParser [a]
139commaSep1 :: IParser a -> IParser [a]
@@ -154,7 +181,7 @@ betwixt a b c = do char a ; out <- c
154 char b <?> "closing '" ++ [b] ++ "'" ; return out
181 char b <?> "closing '" ++ [b] ++ "'" ; return out
155
182
156surround a z name p = do
183surround a z name p = do
157− char a ; whitespace ; v <- p ; whitespace
184+ char a ; v <- padded p
158 char z <?> unwords ["closing", name, show z]
185 char z <?> unwords ["closing", name, show z]
159 return v
186 return v
160
187
@@ -252,7 +279,8 @@ ignoreUntil :: IParser a -> IParser (Maybe a)
252ignoreUntil end = go
279ignoreUntil end = go
253 where
280 where
254 ignore p = const () <$> p
281 ignore p = const () <$> p
282+ filler = choice [ try (ignore chr) <|> ignore str
255− filler = choice [ ignore multiComment
283+ , ignore multiComment
256 , ignore (markdown (\_ _ -> mzero))
284 , ignore (markdown (\_ _ -> mzero))
257 , ignore anyChar
285 , ignore anyChar
258 ]
286 ]
@@ -295,4 +323,26 @@ markdown interpolation = try (string "[markdown|") >> closeMarkdown "" []
295 , uncurry closeMarkdown =<< interpolation md stuff
323 , uncurry closeMarkdown =<< interpolation md stuff
296 , do c <- anyChar
324 , do c <- anyChar
297 closeMarkdown (md ++ [c]) stuff
325 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
8import Parse.Helpers
8import Parse.Helpers
9import SourceSyntax.Literal
9import SourceSyntax.Literal
10
10
11−literal = num <|> str <|> chr
11+literal = num <|> (Str <$> str) <|> (Chr <$> chr)
12
12
13num :: IParser Literal
13num :: IParser Literal
14num = fmap toLit (preNum <?> "number")
14num = fmap toLit (preNum <?> "number")
@@ -20,27 +20,4 @@ num = fmap toLit (preNum <?> "number")
20 ('.':) <$> many1 digit
20 ('.':) <$> many1 digit
21 minus = try $ do string "-"
21 minus = try $ do string "-"
22 lookAhead digit
22 lookAhead digit
23− return "-"
23+ return "-"
24−
25−chr :: IParser Literal
26−chr = Chr <$> betwixt '\'' '\'' (backslashed <|> satisfy (/='\''))
27− <?> "character"
28−
29−str :: IParser Literal
30−str = choice [ quote >> str <$> manyTill (backslashed <|> anyChar) quote
31− , liftM Str . expecting "string" . betwixt '"' '"' . many $
32− backslashed <|> satisfy (/='"')
33− ]
34− where
35− quote = try (string "\"\"\"")
36− str = Str . dewindows
37−
38− -- Remove \r from strings to fix generated JavaScript
39− dewindows [] = []
40− dewindows cs =
41− let (pre, suf) = break (`elem` ['\r','\n']) cs
42− in pre ++ case suf of
43− ('\r':'\n':rest) -> '\n' : dewindows rest
44− ('\n':rest) -> '\n' : dewindows rest
45− ('\r':rest) -> '\n' : dewindows rest
46− _ -> []
compiler/Parse/Pattern.hs+2−2
@@ -11,9 +11,9 @@ import Text.Parsec.Indent
11
11
12import Parse.Helpers
12import Parse.Helpers
13import Parse.Literal
13import Parse.Literal
14+import SourceSyntax.Literal
15+import SourceSyntax.Pattern hiding (tuple, list)
14import qualified SourceSyntax.Pattern as Pattern
16import qualified SourceSyntax.Pattern as Pattern
15−import SourceSyntax.Everything hiding (tuple)
16−
17
17
18basic :: IParser Pattern
18basic :: IParser Pattern
19basic = choice
19basic = 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 #-}
2module SourceSyntax.Declaration where
1module SourceSyntax.Declaration where
3
2
4−import Data.Data
5import qualified SourceSyntax.Expression as Expr
3import qualified SourceSyntax.Expression as Expr
6import SourceSyntax.Type
4import SourceSyntax.Type
7import SourceSyntax.PrettyPrint
5import SourceSyntax.PrettyPrint
@@ -43,6 +41,7 @@ instance Pretty (Declaration t v) where
43 let alias = P.text name <+> P.hsep (map P.text tvars) in
41 let alias = P.text name <+> P.hsep (map P.text tvars) in
44 P.hang (P.text "type" <+> alias <+> P.equals) 4 (pretty tipe)
42 P.hang (P.text "type" <+> alias <+> P.equals) 4 (pretty tipe)
45
43
46− -- TODO: actually write out the other cases. They are currently unused, but
44+ -- TODO: Actually write out the contained data in these cases.
47− -- this is probably going to be a bug someday.
45+ ImportEvent _ _ _ _ -> P.text (show decl)
46+ ExportEvent _ _ _ -> P.text (show decl)
48− _ -> 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 #-}
2module SourceSyntax.Expression where
1module SourceSyntax.Expression where
3
2
4−import Data.Data
5import Data.List (intercalate)
3import Data.List (intercalate)
6import SourceSyntax.PrettyPrint
4import SourceSyntax.PrettyPrint
7import Text.PrettyPrint as P
5import Text.PrettyPrint as P
@@ -29,13 +27,13 @@ data Expr t v
29 | Insert (LExpr t v) String (LExpr t v)
27 | Insert (LExpr t v) String (LExpr t v)
30 | Modify (LExpr t v) [(String, LExpr t v)]
28 | Modify (LExpr t v) [(String, LExpr t v)]
31 | Record [(String, LExpr t v)]
29 | Record [(String, LExpr t v)]
32− | Markdown String [LExpr t v]
30+ | Markdown String String [LExpr t v]
33− deriving (Eq, Show, Data, Typeable)
31+ deriving (Eq)
34
32
35data Def tipe var
33data Def tipe var
36 = Def Pattern.Pattern (LExpr tipe var)
34 = Def Pattern.Pattern (LExpr tipe var)
37 | TypeAnnotation String Type.Type
35 | TypeAnnotation String Type.Type
38− deriving (Eq, Show, Data, Typeable)
36+ deriving (Eq, Show)
39
37
40tuple es = Data ("_Tuple" ++ show (length es)) es
38tuple es = Data ("_Tuple" ++ show (length es)) es
41
39
@@ -47,6 +45,9 @@ saveEnvName = "_save_the_environment!!!"
47dummyLet defs =
45dummyLet defs =
48 Location.none $ Let defs (Location.none $ Var saveEnvName)
46 Location.none $ Let defs (Location.none $ Var saveEnvName)
49
47
48+instance Show (Expr t v) where
49+ show = render . pretty
50+
50instance Pretty (Expr t v) where
51instance Pretty (Expr t v) where
51 pretty expr =
52 pretty expr =
52 case expr of
53 case expr of
@@ -95,7 +96,7 @@ instance Pretty (Expr t v) where
95 where
96 where
96 field (x,e) = variable x <+> P.text "=" <+> pretty e
97 field (x,e) = variable x <+> P.text "=" <+> pretty e
97
98
98− Markdown _ _ -> P.text "[markdown| ... |]"
99+ Markdown _ _ _ -> P.text "[markdown| ... |]"
99
100
100instance Pretty (Def t v) where
101instance Pretty (Def t v) where
101 pretty def =
102 pretty def =
compiler/SourceSyntax/Literal.hs+1−3
@@ -1,7 +1,5 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2module SourceSyntax.Literal where
1module SourceSyntax.Literal where
3
2
4−import Data.Data
5import SourceSyntax.PrettyPrint
3import SourceSyntax.PrettyPrint
6import qualified Text.PrettyPrint as PP
4import qualified Text.PrettyPrint as PP
7
5
@@ -10,7 +8,7 @@ data Literal = IntNum Int
10 | Chr Char
8 | Chr Char
11 | Str String
9 | Str String
12 | Boolean Bool
10 | Boolean Bool
13− deriving (Eq, Ord, Data, Typeable, Show)
11+ deriving (Eq, Ord, Show)
14
12
15instance Pretty Literal where
13instance Pretty Literal where
16 pretty literal =
14 pretty literal =
compiler/SourceSyntax/Location.hs+4−6
@@ -1,19 +1,17 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2module SourceSyntax.Location where
1module SourceSyntax.Location where
3
2
4−import Data.Data
5import Text.PrettyPrint
3import Text.PrettyPrint
6import SourceSyntax.PrettyPrint
4import SourceSyntax.PrettyPrint
7import qualified Text.Parsec.Pos as Parsec
5import qualified Text.Parsec.Pos as Parsec
8
6
9data SrcPos = Pos { line :: Int, column :: Int }
7data SrcPos = Pos { line :: Int, column :: Int }
10− deriving (Eq, Ord, Data, Typeable)
8+ deriving (Eq, Ord)
11
9
12data SrcSpan = Span SrcPos SrcPos String | NoSpan String
10data SrcSpan = Span SrcPos SrcPos String | NoSpan String
13− deriving (Eq, Ord, Data, Typeable)
11+ deriving (Eq, Ord)
14
12
15data Located e = L SrcSpan e
13data Located e = L SrcSpan e
16− deriving (Eq, Ord, Data, Typeable)
14+ deriving (Eq, Ord)
17
15
18none e = L (NoSpan (render $ pretty e)) e
16none e = L (NoSpan (render $ pretty e)) e
19noneNoDocs = L (NoSpan "")
17noneNoDocs = L (NoSpan "")
@@ -53,7 +51,7 @@ instance Show SrcSpan where
53 show (column start) ++ " to " ++ show (column end)
51 show (column start) ++ " to " ++ show (column end)
54
52
55instance Show e => Show (Located e) where
53instance Show e => Show (Located e) where
56− show (L s e) = "L (" ++ show s ++ ") (" ++ show e ++ ")"
54+ show (L _ e) = show e
57
55
58instance Pretty a => Pretty (Located a) where
56instance Pretty a => Pretty (Located a) where
59 pretty (L _ e) = pretty e
57 pretty (L _ e) = pretty e
compiler/SourceSyntax/Module.hs+42−6
@@ -1,7 +1,5 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2module SourceSyntax.Module where
1module SourceSyntax.Module where
3
2
4−import Data.Data
5import Data.Binary
3import Data.Binary
6import Data.List (intercalate)
4import Data.List (intercalate)
7import qualified Data.Map as Map
5import qualified Data.Map as Map
@@ -12,6 +10,9 @@ import SourceSyntax.Expression (LExpr)
12import SourceSyntax.Declaration
10import SourceSyntax.Declaration
13import SourceSyntax.Type
11import SourceSyntax.Type
14import System.FilePath (joinPath)
12import System.FilePath (joinPath)
13+import Control.Monad (liftM)
14+
15+import qualified Elm.Internal.Version as Version
15
16
16data Module tipe var =
17data Module tipe var =
17 Module [String] Exports Imports [Declaration tipe var]
18 Module [String] Exports Imports [Declaration tipe var]
@@ -21,7 +22,24 @@ type Exports = [String]
21
22
22type Imports = [(String, ImportMethod)]
23type Imports = [(String, ImportMethod)]
23data ImportMethod = As String | Importing [String] | Hiding [String]
24data 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"
25
43
26data MetadataModule t v = MetadataModule {
44data MetadataModule t v = MetadataModule {
27 names :: [String],
45 names :: [String],
@@ -35,22 +53,36 @@ data MetadataModule t v = MetadataModule {
35 datatypes :: [ (String, [String], [(String,[Type])]) ],
53 datatypes :: [ (String, [String], [(String,[Type])]) ],
36 foreignImports :: [(String, LExpr t v, String, Type)],
54 foreignImports :: [(String, LExpr t v, String, Type)],
37 foreignExports :: [(String, String, Type)]
55 foreignExports :: [(String, String, Type)]
38−}
56+} deriving Show
39
57
40type Interfaces = Map.Map String ModuleInterface
58type Interfaces = Map.Map String ModuleInterface
41type ADT = (String, [String], [(String,[Type])])
59type ADT = (String, [String], [(String,[Type])])
42
60
43data ModuleInterface = ModuleInterface {
61data ModuleInterface = ModuleInterface {
62+ iVersion :: Version.Version,
44 iTypes :: Map.Map String Type,
63 iTypes :: Map.Map String Type,
64+ iImports :: [(String, ImportMethod)],
45 iAdts :: [ADT],
65 iAdts :: [ADT],
46 iAliases :: [(String, [String], Type)],
66 iAliases :: [(String, [String], Type)],
47 iFixities :: [(Assoc, Int, String)]
67 iFixities :: [(Assoc, Int, String)]
48} deriving Show
68} deriving Show
49
69
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+
50instance Binary ModuleInterface where
80instance Binary ModuleInterface where
51− get = ModuleInterface <$> get <*> get <*> get <*> get
81+ get = ModuleInterface <$> get <*> get <*> get <*> get <*> get <*> get
52 put modul = do
82 put modul = do
83+ put (iVersion modul)
53 put (iTypes modul)
84 put (iTypes modul)
85+ put (iImports modul)
54 put (iAdts modul)
86 put (iAdts modul)
55 put (iAliases modul)
87 put (iAliases modul)
56 put (iFixities modul)
88 put (iFixities modul)
@@ -58,6 +90,10 @@ instance Binary ModuleInterface where
58
90
59instance Binary Assoc where
91instance Binary Assoc where
60 get = do n <- getWord8
92 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"
62
98
63 put assoc = putWord8 $ case assoc of { L -> 0 ; N -> 1 ; R -> 2 }
99 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 #-}
2module SourceSyntax.Pattern where
1module SourceSyntax.Pattern where
3
2
4import Data.List (intercalate)
3import Data.List (intercalate)
5−import Data.Data
6import SourceSyntax.Helpers as Help
4import SourceSyntax.Helpers as Help
7import SourceSyntax.PrettyPrint
5import SourceSyntax.PrettyPrint
8import Text.PrettyPrint as PP
6import Text.PrettyPrint as PP
@@ -14,7 +12,7 @@ data Pattern = PData String [Pattern]
14 | PVar String
12 | PVar String
15 | PAnything
13 | PAnything
16 | PLiteral Literal.Literal
14 | PLiteral Literal.Literal
17− deriving (Eq, Ord, Data, Typeable, Show)
15+ deriving (Eq, Ord, Show)
18
16
19cons h t = PData "::" [h,t]
17cons h t = PData "::" [h,t]
20nil = PData "[]" []
18nil = PData "[]" []
compiler/SourceSyntax/Type.hs+3−4
@@ -1,8 +1,6 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2module SourceSyntax.Type where
1module SourceSyntax.Type where
3
2
4import Data.Binary
3import Data.Binary
5−import Data.Data
6import qualified Data.Map as Map
4import qualified Data.Map as Map
7import qualified SourceSyntax.Helpers as Help
5import qualified SourceSyntax.Helpers as Help
8import Control.Applicative ((<$>), (<*>))
6import Control.Applicative ((<$>), (<*>))
@@ -14,7 +12,7 @@ data Type = Lambda Type Type
14 | Data String [Type]
12 | Data String [Type]
15 | EmptyRecord
13 | EmptyRecord
16 | Record [(String,Type)] Type
14 | Record [(String,Type)] Type
17− deriving (Eq, Show, Data, Typeable)
15+ deriving (Eq, Show)
18
16
19fieldMap :: [(String,a)] -> Map.Map String [a]
17fieldMap :: [(String,a)] -> Map.Map String [a]
20fieldMap fields =
18fieldMap fields =
@@ -93,4 +91,5 @@ instance Binary Type where
93 1 -> Var <$> get
91 1 -> Var <$> get
94 2 -> Data <$> get <*> get
92 2 -> Data <$> get <*> get
95 3 -> return EmptyRecord
93 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
15import qualified Transform.SortDefinitions as SD
15import qualified Transform.SortDefinitions as SD
16import Text.PrettyPrint as P
16import Text.PrettyPrint as P
17
17
18−
19interface :: String -> ModuleInterface -> ModuleInterface
18interface :: String -> ModuleInterface -> ModuleInterface
20interface moduleName iface =
19interface moduleName iface =
21 ModuleInterface
20 ModuleInterface
21+ { iVersion = iVersion iface
22− { iTypes = Map.mapKeys prefix (Map.map renameType' (iTypes iface))
22+ , iTypes = Map.mapKeys prefix (Map.map renameType' (iTypes iface))
23+ , iImports = iImports iface
23 , iAdts = map (both prefix renameCtors) (iAdts iface)
24 , iAdts = map (both prefix renameCtors) (iAdts iface)
24 , iAliases = map (both prefix renameType') (iAliases iface)
25 , iAliases = map (both prefix renameType') (iAliases iface)
25 , iFixities = iFixities iface -- cannot have canonicalized operators while parsing
26 , iFixities = iFixities iface -- cannot have canonicalized operators while parsing
@@ -94,7 +95,6 @@ metadataModule ifaces modul =
94 realImports = filter (not . List.isPrefixOf "Native." . fst) (imports modul)
95 realImports = filter (not . List.isPrefixOf "Native." . fst) (imports modul)
95 initialEnv = Map.fromList (concatMap canon realImports ++ localEnv ++ globalEnv)
96 initialEnv = Map.fromList (concatMap canon realImports ++ localEnv ++ globalEnv)
96
97
97−
98type Env = Map.Map String String
98type Env = Map.Map String String
99
99
100extend :: Env -> Pattern -> Env
100extend :: Env -> Pattern -> Env
@@ -173,7 +173,7 @@ rename env lexpr@(L s expr) =
173 branch (pattern,e) = (,) `liftM` format (renamePattern env pattern)
173 branch (pattern,e) = (,) `liftM` format (renamePattern env pattern)
174 `ap` rename (extend env pattern) e
174 `ap` rename (extend env pattern) e
175
175
176− Markdown md es -> Markdown md `liftM` mapM rnm es
176+ Markdown uid md es -> Markdown uid md `liftM` mapM rnm es
177
177
178
178
179renamePattern :: Env -> Pattern -> Either String Pattern
179renamePattern :: Env -> Pattern -> Either String Pattern
compiler/Transform/Check.hs+49−17
@@ -1,37 +1,64 @@
1module Transform.Check (mistakes) where
1module Transform.Check (mistakes) where
2
2
3import Transform.SortDefinitions (boundVars)
3import Transform.SortDefinitions (boundVars)
4−import SourceSyntax.Everything
4+import SourceSyntax.Declaration (Declaration(..))
5+import SourceSyntax.Expression
6+import SourceSyntax.Pattern
7+import SourceSyntax.Location
5import SourceSyntax.PrettyPrint
8import SourceSyntax.PrettyPrint
6import qualified SourceSyntax.Type as T
9import qualified SourceSyntax.Type as T
7import Data.List as List
10import Data.List as List
8import qualified Data.Map as Map
11import qualified Data.Map as Map
9import qualified Data.Maybe as Maybe
12import qualified Data.Maybe as Maybe
10import qualified Data.Set as Set
13import qualified Data.Set as Set
11−import Data.Data
12−import Data.Generics.Uniplate.Data
13import Text.PrettyPrint as P
14import Text.PrettyPrint as P
14
15
15
16
16−mistakes :: (Data t, Data v) => [Declaration t v] -> [Doc]
17+mistakes :: [Declaration t v] -> [Doc]
17mistakes decls =
18mistakes decls =
18 concat [ infiniteTypeAliases decls
19 concat [ infiniteTypeAliases decls
19 , illFormedTypes decls
20 , illFormedTypes decls
21+ , map P.text (duplicateConstructors decls)
20 , map P.text (concatMap findErrors (getLets decls)) ]
22 , map P.text (concatMap findErrors (getLets decls)) ]
21 where
23 where
22 findErrors defs = duplicates defs ++ badOrder defs
24 findErrors defs = duplicates defs ++ badOrder defs
23
25
24−
25−getLets :: (Data t, Data v) => [Declaration t v] -> [[Def t v]]
26+getLets :: [Declaration t v] -> [[Def t v]]
26−getLets decls = defs : concatMap getSubLets defs
27+getLets decls = defs : concatMap defLets defs
27 where
28 where
28− defs = concatMap (\d -> case d of Definition d -> [d] ; _ -> []) decls
29+ defs = [ d | Definition d <- decls ]
29
30
30− getSubLets def =
31+ defLets def =
31 case def of
32 case def of
32− Def pattern expr -> [ defs | Let defs _ <- universeBi expr ]
33 TypeAnnotation _ _ -> []
33 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 ++ "'."
35
62
36duplicates :: [Def t v] -> [String]
63duplicates :: [Def t v] -> [String]
37duplicates defs =
64duplicates defs =
@@ -39,13 +66,18 @@ duplicates defs =
39 where
66 where
40 annotations = List.sort [ name | TypeAnnotation name _ <- defs ]
67 annotations = List.sort [ name | TypeAnnotation name _ <- defs ]
41 definitions = List.sort $ concatMap Set.toList [ boundVars pattern | Def pattern _ <- defs ]
68 definitions = List.sort $ concatMap Set.toList [ boundVars pattern | Def pattern _ <- defs ]
69+ defMsg = dupErr "definition of"
70+ annMsg = dupErr "type annotation for"
42
71
43− dups = map head . filter ((>1) . length) . List.group
72+duplicateConstructors :: [Declaration t v] -> [String]
44−
73+duplicateConstructors decls =
45− msg = "Syntax Error: There can only be one "
74+ map typeMsg (dups typeCtors) ++ map dataMsg (dups dataCtors)
46− defMsg x = msg ++ "definition of '" ++ x ++ "'."
75+ where
47− annMsg x = msg ++ "type annotation for '" ++ x ++ "'."
76+ typeCtors = List.sort [ name | Datatype name _ _ <- decls ]
48−
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"
49
81
50badOrder :: [Def t v] -> [String]
82badOrder :: [Def t v] -> [String]
51badOrder defs = go defs
83badOrder defs = go defs
compiler/Transform/Optimize.hs+5−1
@@ -1,6 +1,10 @@
1module Transform.Optimize (optimize) where
1module Transform.Optimize (optimize) where
2
2
3−import SourceSyntax.Everything
3+import SourceSyntax.Declaration (Declaration(..))
4+import SourceSyntax.Expression
5+import SourceSyntax.Literal
6+import SourceSyntax.Location
7+import SourceSyntax.Module
4import Control.Arrow (second, (***))
8import Control.Arrow (second, (***))
5import Data.Char (isAlpha)
9import Data.Char (isAlpha)
6
10
compiler/Transform/SafeNames.hsnew file+78
@@ -0,0 +1,78 @@
1+{-# OPTIONS_GHC -Wall #-}
2+module Transform.SafeNames (metadataModule) where
3+
4+import Control.Arrow (first, (***))
5+import SourceSyntax.Expression
6+import SourceSyntax.Location
7+import SourceSyntax.Module
8+import SourceSyntax.Pattern
9+import qualified Data.Set as Set
10+import qualified Parse.Helpers as PHelp
11+
12+var :: String -> String
13+var = dereserve . deprime
14+ where
15+ deprime = map (\c -> if c == '\'' then '$' else c)
16+ dereserve x = case Set.member x PHelp.jsReserveds of
17+ False -> x
18+ True -> "$" ++ x
19+
20+pattern :: Pattern -> Pattern
21+pattern pat =
22+ case pat of
23+ PVar x -> PVar (var x)
24+ PLiteral _ -> pat
25+ PRecord fs -> PRecord (map var fs)
26+ PAnything -> pat
27+ PAlias x p -> PAlias (var x) (pattern p)
28+ PData name ps -> PData name (map pattern ps)
29+
30+expression :: LExpr t v -> LExpr t v
31+expression (L loc expr) =
32+ let f = expression in
33+ L loc $
34+ case expr of
35+ Literal _ -> expr
36+ Var x -> Var (var x)
37+ Range e1 e2 -> Range (f e1) (f e2)
38+ ExplicitList es -> ExplicitList (map f es)
39+ Binop op e1 e2 -> Binop op (f e1) (f e2)
40+ Lambda p e -> Lambda (pattern p) (f e)
41+ App e1 e2 -> App (f e1) (f e2)
42+ MultiIf ps -> MultiIf (map (f *** f) ps)
43+ Let defs body -> Let (map definition defs) (f body)
44+ Case e cases -> Case (f e) $ map (pattern *** f) cases
45+ Data name es -> Data name (map f es)
46+ Access e x -> Access (f e) (var x)
47+ Remove e x -> Remove (f e) (var x)
48+ Insert e x v -> Insert (f e) (var x) (f v)
49+ Modify r fs -> Modify (f r) (map (var *** f) fs)
50+ Record fs -> Record (map (var *** f) fs)
51+ Markdown uid md es -> Markdown uid md (map f es)
52+
53+definition :: Def t v -> Def t v
54+definition def =
55+ case def of
56+ Def p e -> Def (pattern p) (expression e)
57+ TypeAnnotation name t -> TypeAnnotation (var name) t
58+
59+metadataModule :: MetadataModule t v -> MetadataModule t v
60+metadataModule modul =
61+ modul
62+ { names = map var (names modul)
63+ , exports = map var (exports modul)
64+ , imports = map (first var) (imports modul)
65+ , program = expression (program modul)
66+ , aliases =
67+ let makeSafe (name, tvars, tipe) = (var name, tvars, tipe)
68+ in map makeSafe (aliases modul)
69+ , datatypes =
70+ let makeSafe (name,tvars,ctors) = (var name, tvars, map (first var) ctors)
71+ in map makeSafe (datatypes modul)
72+ , foreignImports =
73+ let makeSafe (js,expr,elm,tipe) = (js, expression expr, var elm, tipe)
74+ in map makeSafe (foreignImports modul)
75+ , foreignExports =
76+ let makeSafe (js,elm,tipe) = (js, var elm, tipe)
77+ in map makeSafe (foreignExports modul)
78+ }
compiler/Transform/SortDefinitions.hs+14−7
@@ -6,7 +6,9 @@ import Control.Applicative ((<$>))
6import qualified Data.Set as Set
6import qualified Data.Set as Set
7import qualified Data.Map as Map
7import qualified Data.Map as Map
8import qualified SourceSyntax.Type as ST
8import qualified SourceSyntax.Type as ST
9−import SourceSyntax.Everything
9+import SourceSyntax.Expression
10+import SourceSyntax.Location
11+import SourceSyntax.Pattern
10import qualified Data.Graph as Graph
12import qualified Data.Graph as Graph
11import qualified Data.Map as Map
13import qualified Data.Map as Map
12import qualified Data.Maybe as Maybe
14import qualified Data.Maybe as Maybe
@@ -97,7 +99,7 @@ reorder lexpr@(L s expr) =
97 Record fields ->
99 Record fields ->
98 Record `liftM` mapM reorderField fields
100 Record `liftM` mapM reorderField fields
99
101
100− Markdown md es -> Markdown md <$> mapM reorder es
102+ Markdown uid md es -> Markdown uid md <$> mapM reorder es
101
103
102 -- Actually do some reordering
104 -- Actually do some reordering
103 Let defs body ->
105 Let defs body ->
@@ -120,15 +122,20 @@ reorder lexpr@(L s expr) =
120 mapM free (ctors pattern)
122 mapM free (ctors pattern)
121
123
122 let addDefs ds bod = L s (Let (concatMap toDefs ds) bod)
124 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−
128 L _ let' = foldr addDefs body' defss
125 L _ let' = foldr addDefs body' defss
129
126
130 return let'
127 return let'
131
128
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." ]
132
139
133reorderField (label, expr) =
140reorderField (label, expr) =
134 (,) label `liftM` reorder expr
141 (,) label `liftM` reorder expr
compiler/Transform/Substitute.hs+1−1
@@ -40,4 +40,4 @@ subst old new expr =
40 Modify r fs -> Modify (f r) (map (second f) fs)
40 Modify r fs -> Modify (f r) (map (second f) fs)
41 Record fs -> Record (map (second f) fs)
41 Record fs -> Record (map (second f) fs)
42 Literal _ -> expr
42 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
11
11
12type Rules = ([(String,[String],Type)], Type -> Type)
12type Rules = ([(String,[String],Type)], Type -> Type)
13
13
14+rules interfaces moduleAliases moduleImports =
14−rules interfaces metaModule = (collect interfaces metaModule, localizer metaModule)
15+ (collect interfaces moduleAliases, localizer moduleImports)
15
16
17+collect interfaces moduleAliases =
16−collect interfaces metaModule = filter (not . isPrimitive) rawAliases
18+ filter (not . isPrimitive) rawAliases
17− where
19+ where
20+ rawAliases =
18− rawAliases = aliases metaModule ++ concatMap iAliases (Map.elems interfaces)
21+ moduleAliases ++ concatMap iAliases (Map.elems interfaces)
19
22
20− isPrimitive (_,_,tipe) =
23+ isPrimitive (_,_,tipe) =
21− case tipe of
24+ case tipe of
22 Data _ [] -> True
25 Data _ [] -> True
23 _ -> False
26 _ -> False
24
27
25−localizer metaModule = go
28+localizer moduleImports = go
26 where
29 where
27− go tipe =
30+ go tipe =
28 case tipe of
31 case tipe of
29 Var _ -> tipe
32 Var _ -> tipe
30 EmptyRecord -> tipe
33 EmptyRecord -> tipe
@@ -32,7 +35,8 @@ localizer metaModule = go
32 Data name ts -> Data (localize name) (map go ts)
35 Data name ts -> Data (localize name) (map go ts)
33 Record fs ext -> Record (map (second go) fs) (go ext)
36 Record fs ext -> Record (map (second go) fs) (go ext)
34
37
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
36
40
37 separate name =
41 separate name =
38 case List.elemIndices '.' name of
42 case List.elemIndices '.' name of
compiler/Type/Constrain/Declaration.hs+13−11
@@ -9,7 +9,9 @@ import qualified Type.Constrain.Expression as TcExpr
9import qualified Type.Environment as Env
9import qualified Type.Environment as Env
10
10
11import SourceSyntax.Declaration
11import SourceSyntax.Declaration
12−import qualified SourceSyntax.Everything as Src
12+import qualified SourceSyntax.Expression as Src
13+import qualified SourceSyntax.Location as L
14+import qualified SourceSyntax.Pattern as P
13import qualified SourceSyntax.Type as Type
15import qualified SourceSyntax.Type as Type
14
16
15toExpr :: [Declaration t v] -> [Src.Def t v]
17toExpr :: [Declaration t v] -> [Src.Def t v]
@@ -25,34 +27,34 @@ toDefs decl =
25 toDefs (ctor, tipes) =
27 toDefs (ctor, tipes) =
26 let vars = take (length tipes) arguments
28 let vars = take (length tipes) arguments
27 tbody = Type.Data name $ map Type.Var tvars
29 tbody = Type.Data name $ map Type.Var tvars
28− body = Src.none . Src.Data ctor $ map (Src.none . Src.Var) vars
30+ body = L.none . Src.Data ctor $ map (L.none . Src.Var) vars
29 in [ Src.TypeAnnotation ctor $ foldr Type.Lambda tbody tipes
31 in [ Src.TypeAnnotation ctor $ foldr Type.Lambda tbody tipes
30− , Src.Def (Src.PVar ctor) $ buildFunction body vars
32+ , Src.Def (P.PVar ctor) $ buildFunction body vars
31 ]
33 ]
32
34
33 TypeAlias name tvars tipe@(Type.Record fields ext) ->
35 TypeAlias name tvars tipe@(Type.Record fields ext) ->
34 [ Src.TypeAnnotation name $ foldr Type.Lambda tipe args
36 [ Src.TypeAnnotation name $ foldr Type.Lambda tipe args
35− , Src.Def (Src.PVar name) $ buildFunction record vars ]
37+ , Src.Def (P.PVar name) $ buildFunction record vars ]
36 where
38 where
37 args = case ext of
39 args = case ext of
38 Type.EmptyRecord -> map snd fields
40 Type.EmptyRecord -> map snd fields
39 _ -> map snd fields ++ [ext]
41 _ -> map snd fields ++ [ext]
40
42
41− var = Src.none . Src.Var
43+ var = L.none . Src.Var
42 vars = take (length args) arguments
44 vars = take (length args) arguments
43
45
44 efields = zip (map fst fields) (map var vars)
46 efields = zip (map fst fields) (map var vars)
45 record = case ext of
47 record = case ext of
46− Type.EmptyRecord -> Src.none $ Src.Record efields
48+ Type.EmptyRecord -> L.none $ Src.Record efields
47− _ -> foldl (\r (f,v) -> Src.none $ Src.Insert r f v) (var $ last vars) efields
49+ _ -> foldl (\r (f,v) -> L.none $ Src.Insert r f v) (var $ last vars) efields
48
50
49 -- Type aliases must be added to an extended equality dictionary,
51 -- Type aliases must be added to an extended equality dictionary,
50 -- but they do not require any basic constraints.
52 -- but they do not require any basic constraints.
51 TypeAlias _ _ _ -> []
53 TypeAlias _ _ _ -> []
52
54
53− ImportEvent _ expr@(Src.L s _) name tipe ->
55+ ImportEvent _ expr@(L.L s _) name tipe ->
54 [ Src.TypeAnnotation name tipe
56 [ Src.TypeAnnotation name tipe
55− , Src.Def (Src.PVar name) (Src.L s $ Src.App (Src.L s $ Src.Var "constant") expr) ]
57+ , Src.Def (P.PVar name) (L.L s $ Src.App (L.L s $ Src.Var "constant") expr) ]
56
58
57 ExportEvent _ name tipe ->
59 ExportEvent _ name tipe ->
58 [ Src.TypeAnnotation name tipe ]
60 [ Src.TypeAnnotation name tipe ]
@@ -64,5 +66,5 @@ toDefs decl =
64arguments :: [String]
66arguments :: [String]
65arguments = map (:[]) ['a'..'z'] ++ map (\n -> "_" ++ show n) [1..]
67arguments = map (:[]) ['a'..'z'] ++ map (\n -> "_" ++ show n) [1..]
66
68
67−buildFunction body@(Src.L s _) vars =
69+buildFunction body@(L.L s _) vars =
68− foldr (\p e -> Src.L s (Src.Lambda p e)) body (map Src.PVar vars)
70+ foldr (\p e -> L.L s (Src.Lambda p e)) body (map P.PVar vars)
compiler/Type/Constrain/Expression.hs+1−1
@@ -134,7 +134,7 @@ constrain env (L span expr) tipe =
134 recordType = record fields' (TermN EmptyRecord1)
134 recordType = record fields' (TermN EmptyRecord1)
135 return . ex vars . and $ tipe === recordType : cs
135 return . ex vars . and $ tipe === recordType : cs
136
136
137− Markdown _ es ->
137+ Markdown _ _ es ->
138 do vars <- forM es $ \_ -> liftIO (var Flexible)
138 do vars <- forM es $ \_ -> liftIO (var Flexible)
139 let tvars = map VarN vars
139 let tvars = map VarN vars
140 cs <- zipWithM (constrain env) es tvars
140 cs <- zipWithM (constrain env) es tvars
compiler/Type/Inference.hs+1−1
@@ -52,7 +52,7 @@ infer interfaces modul = unsafePerformIO $ do
52 Left err -> return $ Left err
52 Left err -> return $ Left err
53 Right (header, constraint) -> do
53 Right (header, constraint) -> do
54 state <- execStateT (Solve.solve constraint) TS.initialState
54 state <- execStateT (Solve.solve constraint) TS.initialState
55− let rules = Alias.rules interfaces modul
55+ let rules = Alias.rules interfaces (aliases modul) (imports modul)
56 case TS.sErrors state of
56 case TS.sErrors state of
57 errors@(_:_) -> Left `fmap` sequence (map ($ rules) (reverse errors))
57 errors@(_:_) -> Left `fmap` sequence (map ($ rules) (reverse errors))
58 [] -> extraChecks rules (Map.difference (TS.sSavedEnv state) header)
58 [] -> extraChecks rules (Map.difference (TS.sSavedEnv state) header)
compiler/Type/Solve.hs+3−3
@@ -174,11 +174,11 @@ allDistinct span vars = do
174 desc <- liftIO $ UF.descriptor var
174 desc <- liftIO $ UF.descriptor var
175 case structure desc of
175 case structure desc of
176 Just _ -> TS.addError span (Just msg) var var
176 Just _ -> TS.addError span (Just msg) var var
177− where msg = "Cannot generalize something that is not a type variable"
177+ where msg = "Cannot generalize something that is not a type variable."
178
178
179 Nothing -> do
179 Nothing -> do
180 if mark desc == seen
180 if mark desc == seen
181− then let msg = "Duplicate variable during generalization"
181+ then let msg = "Duplicate variable during generalization."
182 in TS.addError span (Just msg) var var
182 in TS.addError span (Just msg) var var
183 else return ()
183 else return ()
184 liftIO $ UF.setDescriptor var (desc { mark = seen })
184 liftIO $ UF.setDescriptor var (desc { mark = seen })
@@ -190,5 +190,5 @@ isGeneric span var = do
190 desc <- liftIO $ UF.descriptor var
190 desc <- liftIO $ UF.descriptor var
191 if rank desc == noRank
191 if rank desc == noRank
192 then return ()
192 then return ()
193− else let msg = "Unable to generalize a type variable. It is not unranked"
193+ else let msg = "Unable to generalize a type variable. It is not unranked."
194 in TS.addError span (Just msg) var var
194 in TS.addError span (Just msg) var var
compiler/Type/State.hs+7−12
@@ -56,13 +56,11 @@ addError span hint t1 t2 =
56 t1' <- prettiest <$> toSrcType t1
56 t1' <- prettiest <$> toSrcType t1
57 t2' <- prettiest <$> toSrcType t2
57 t2' <- prettiest <$> toSrcType t2
58 return . P.vcat $
58 return . P.vcat $
59+ [ P.text $ "Type error" ++ location ++ ":"
60+ , maybe P.empty P.text hint
59− [ display $ case span of { NoSpan msg -> msg ; Span _ _ msg -> msg }
61+ , display $ case span of { NoSpan msg -> msg ; Span _ _ msg -> msg }
60− , case hint of
62+ , P.text " Expected Type:" <+> t1'
61− Nothing -> P.text " Could not match the following types:"
62− Just msg -> P.text $ eightyCharLines 2 $
63− msg ++ ", so I could not match the following types:"
64− , P.text " " <> t1'
65− , P.text " " <> t2'
63+ , P.text " Actual Type:" <+> t2'
66 ]
64 ]
67
65
68 location = case span of
66 location = case span of
@@ -72,11 +70,8 @@ addError span hint t1 t2 =
72 else " between lines " ++ show (line p1) ++ " and " ++ show (line p2)
70 else " between lines " ++ show (line p1) ++ " and " ++ show (line p2)
73
71
74 display msg =
72 display msg =
75− case lines msg of
73+ P.vcat [ P.text $ concatMap ("\n "++) (lines msg)
76− [] -> P.text $ "Type error" ++ location ++ ":"
74+ , P.text " " ]
77− lines' ->
78− P.vcat [ P.text $ "Type error" ++ location ++ ", in or near this expression:"
79− , P.text $ " " ++ List.intercalate "\n " lines' ]
80
75
81
76
82switchToPool pool = modifyPool (\_ -> pool)
77switchToPool pool = modifyPool (\_ -> pool)
compiler/Type/Type.hs+1−3
@@ -370,13 +370,11 @@ toSrcType variable = do
370 case name desc of
370 case name desc of
371 Just x@(c:cs) | Char.isLower c -> return (Src.Var x)
371 Just x@(c:cs) | Char.isLower c -> return (Src.Var x)
372 | otherwise -> return (Src.Data x [])
372 | otherwise -> return (Src.Data x [])
373− Nothing ->
374− error $ concat
373+ _ -> error $ concat
375 [ "Problem converting the following type "
374 [ "Problem converting the following type "
376 , "from a type-checker type to a source-syntax type:"
375 , "from a type-checker type to a source-syntax type:"
377 , P.render (pretty Never variable) ]
376 , P.render (pretty Never variable) ]
378
377
379−
380data AppStructure = List Variable | Tuple [Variable] | Other
378data AppStructure = List Variable | Tuple [Variable] | Other
381
379
382collectApps :: Variable -> IO AppStructure
380collectApps :: Variable -> IO AppStructure
compiler/Type/Unify.hs+8−6
@@ -80,11 +80,11 @@ actuallyUnify span variable1 variable2 = do
80 unifyNumber svar name
80 unifyNumber svar name
81 | name `elem` ["Int","Float","number"] = flexAndUnify svar
81 | name `elem` ["Int","Float","number"] = flexAndUnify svar
82 | otherwise = TS.addError span (Just hint) variable1 variable2
82 | otherwise = TS.addError span (Just hint) variable1 variable2
83− where hint = "A number must be an Int or Float"
83+ where hint = "A number must be an Int or Float."
84
84
85 comparableError maybe =
85 comparableError maybe =
86 TS.addError span (Just $ Maybe.fromMaybe msg maybe) variable1 variable2
86 TS.addError span (Just $ Maybe.fromMaybe msg maybe) variable1 variable2
87− where msg = "A comparable must be an Int, Float, Char, String, list, or tuple"
87+ where msg = "A comparable must be an Int, Float, Char, String, list, or tuple."
88
88
89 unifyComparable var name
89 unifyComparable var name
90 | name `elem` ["Int","Float","Char","String","comparable"] = flexAndUnify var
90 | name `elem` ["Int","Float","Char","String","comparable"] = flexAndUnify var
@@ -98,7 +98,7 @@ actuallyUnify span variable1 variable2 = do
98 unify' v =<< liftIO (var $ Is Comparable)
98 unify' v =<< liftIO (var $ Is Comparable)
99 Tuple vs
99 Tuple vs
100 | length vs > 6 ->
100 | length vs > 6 ->
101− comparableError $ Just "Cannot compare a tuple with more than 6 elements"
101+ comparableError $ Just "Cannot compare a tuple with more than 6 elements."
102 | otherwise ->
102 | otherwise ->
103 do flexAndUnify varSuper
103 do flexAndUnify varSuper
104 cmpVars <- liftIO $ forM [1..length vs] $ \_ -> var (Is Comparable)
104 cmpVars <- liftIO $ forM [1..length vs] $ \_ -> var (Is Comparable)
@@ -111,9 +111,11 @@ actuallyUnify span variable1 variable2 = do
111 _ -> comparableError Nothing
111 _ -> comparableError Nothing
112
112
113 rigidError variable = TS.addError span (Just hint) variable1 variable2
113 rigidError variable = TS.addError span (Just hint) variable1 variable2
114− where hint = "There is a problem with the '" ++
114+ where
115− render (pretty Never variable) ++
115+ var = "'" ++ 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"
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."
117
119
118 superUnify =
120 superUnify =
119 case (flex desc1, flex desc2, name desc1, name desc2) of
121 case (flex desc1, flex desc2, name desc1, name desc2) of
libraries/Automaton.elm → libraries/Automaton.elm.hiddenrenamed

The content is the same.

libraries/Basics.elm+11−7
@@ -221,11 +221,15 @@ min = Native.Basics.min
221max : comparable -> comparable -> comparable
221max : comparable -> comparable -> comparable
222max = Native.Basics.max
222max = Native.Basics.max
223
223
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+-}
225(&&) : Bool -> Bool -> Bool
227(&&) : Bool -> Bool -> Bool
226(&&) = Native.Basics.and
228(&&) = Native.Basics.and
227
229
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+-}
229(||) : Bool -> Bool -> Bool
233(||) : Bool -> Bool -> Bool
230(||) = Native.Basics.or
234(||) = Native.Basics.or
231
235
@@ -311,11 +315,11 @@ id x = x
311
315
312{-| Given a 2-tuple, returns the first value. -}
316{-| Given a 2-tuple, returns the first value. -}
313fst : (a,b) -> a
317fst : (a,b) -> a
314−fst = Native.Basics.fst
318+fst (a,_) = a
315
319
316{-| Given a 2-tuple, returns the second value. -}
320{-| Given a 2-tuple, returns the second value. -}
317snd : (a,b) -> b
321snd : (a,b) -> b
318−snd = Native.Basics.snd
322+snd (_,b) = b
319
323
320{-| Flips the order of the first two arguments to a function. -}
324{-| Flips the order of the first two arguments to a function. -}
321flip : (a -> b -> c) -> (b -> a -> c)
325flip : (a -> b -> c) -> (b -> a -> c)
@@ -325,10 +329,10 @@ flip f b a = f a b
325This splits paired arguments into two separate arguments.
329This splits paired arguments into two separate arguments.
326-}
330-}
327curry : ((a,b) -> c) -> a -> b -> c
331curry : ((a,b) -> c) -> a -> b -> c
328−curry = Native.Basics.curry
332+curry f a b = f (a,b)
329
333
330{-| Change how arguments are passed to a function.
334{-| 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.
332-}
336-}
333uncurry : (a -> b -> c) -> (a,b) -> c
337uncurry : (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
2 ,lookup,findWithDefault
2 ,lookup,findWithDefault
3 ,remove,member
3 ,remove,member
4 ,foldl,foldr,map
4 ,foldl,foldr,map
@@ -14,7 +14,7 @@ lists of comparable types.
14Insert, remove, and query operations all take *O(log n)* time.
14Insert, remove, and query operations all take *O(log n)* time.
15
15
16# Build
16# Build
17−@docs empty, singleton, insert, remove
17+@docs empty, singleton, insert, update, remove
18
18
19# Query
19# Query
20@docs member, lookup, findWithDefault
20@docs member, lookup, findWithDefault
@@ -148,18 +148,44 @@ ensureBlackRoot t =
148{-| Insert a key-value pair into a dictionary. Replaces value when there is
148{-| Insert a key-value pair into a dictionary. Replaces value when there is
149a collision. -}
149a collision. -}
150insert : comparable -> v -> Dict comparable v -> Dict comparable v
150insert : comparable -> v -> Dict comparable v -> Dict comparable v
151−insert k v t = -- Invariant: t is a valid left-leaning rb tree
151+insert k v t = let u _ = Just v in
152− let ins t =
152+ update k u t
153− case t of
154− RBEmpty LBlack -> RBNode Red k v (RBEmpty LBlack) (RBEmpty LBlack)
155− RBNode c k' v' l r ->
156− let h = case Native.Utils.compare k k' of
157− LT -> RBNode c k' v' (ins l) r
158− EQ -> RBNode c k' v l r -- replace
159− GT -> RBNode c k' v' l (ins r)
160− in fixUp h
161− in ensureBlackRoot (ins t)
162
153
154+{-| Remove a key-value pair from a dictionary. If the key is not found,
155+no changes are made. -}
156+remove : comparable -> Dict comparable v -> Dict comparable v
157+remove k t = let u _ = Nothing in
158+ update k u t
159+
160+data Flag = Insert | Remove | Same
161+
162+{-| Update the value of a dictionary for a specific key with a given function. -}
163+update : comparable -> (Maybe v -> Maybe v) -> Dict comparable v -> Dict comparable v
164+update k u t =
165+ let up t = case t of
166+ RBEmpty LBlack -> case u Nothing of
167+ Nothing -> (Same, empty)
168+ Just v -> (Insert, RBNode Red k v empty empty)
169+ RBNode c k' v l r -> case Native.Utils.compare k k' of
170+ EQ -> case u (Just v) of
171+ Nothing -> (Remove, rem t)
172+ Just v' -> (Same, RBNode c k' v' l r)
173+ LT -> let (fl, l') = up l in
174+ case fl of
175+ Same -> (Same, RBNode c k' v l' r)
176+ Insert -> (Insert, fixUp <| RBNode c k' v l' r)
177+ Remove -> (Remove, bubble c k' v l' r)
178+ GT -> let (fl, r') = up r in
179+ case fl of
180+ Same -> (Same, RBNode c k' v l r')
181+ Insert -> (Insert, fixUp <| RBNode c k' v l r')
182+ Remove -> (Remove, bubble c k' v l r')
183+ (fl, t') = up t
184+ in case fl of
185+ Same -> t'
186+ Insert -> ensureBlackRoot t'
187+ Remove -> blacken t'
188+
163{-| Create a dictionary with one key-value pair. -}
189{-| Create a dictionary with one key-value pair. -}
164singleton : comparable -> v -> Dict comparable v
190singleton : comparable -> v -> Dict comparable v
165singleton k v = insert k v (RBEmpty LBlack)
191singleton k v = insert k v (RBEmpty LBlack)
@@ -198,15 +224,6 @@ lessBlackTree t = case t of
198 RBNode c k v l r -> RBNode (lessBlack c) k v l r
224 RBNode c k v l r -> RBNode (lessBlack c) k v l r
199 RBEmpty _ -> RBEmpty LBlack
225 RBEmpty _ -> RBEmpty LBlack
200
226
201−-- Finds and deletes k in t
202−del : comparable -> Dict comparable v -> Dict comparable v
203−del k t = case t of
204− RBEmpty _ -> t
205− RBNode c k' v l r -> case Native.Utils.compare k k' of
206− LT -> bubble c k' v (del k l) r
207− EQ -> rem t
208− GT -> bubble c k' v l (del k r)
209−
210-- Remove the top node from the tree, may leave behind BBlacks
227-- Remove the top node from the tree, may leave behind BBlacks
211rem : Dict k v -> Dict k v
228rem : Dict k v -> Dict k v
212rem t = case t of
229rem t = case t of
@@ -286,11 +303,6 @@ redden t = case t of
286 RBEmpty _ -> Native.Error.raise "can't make a Leaf red"
303 RBEmpty _ -> Native.Error.raise "can't make a Leaf red"
287 RBNode _ k v l r -> RBNode Red k v l r
304 RBNode _ k v l r -> RBNode Red k v l r
288
305
289−{-| Remove a key-value pair from a dictionary. If the key is not found,
290−no changes are made. -}
291−remove : comparable -> Dict comparable v -> Dict comparable v
292−remove k t = blacken <| del k t
293−
294{-| Apply a function to all values in a dictionary. -}
306{-| Apply a function to all values in a dictionary. -}
295map : (a -> b) -> Dict comparable a -> Dict comparable b
307map : (a -> b) -> Dict comparable a -> Dict comparable b
296map f t =
308map f t =
libraries/Graphics/Element.elm+13−6
@@ -22,7 +22,7 @@ with `flow` in specific cases:
22@docs layers, above, below, beside
22@docs layers, above, below, beside
23
23
24# Positioning
24# Positioning
25−@docs spacer, container
25+@docs empty, spacer, container
26
26
27## Specific Positions
27## Specific Positions
28
28
@@ -58,6 +58,13 @@ type Properties = {
58
58
59type Element = { props : Properties, element : ElementPrim }
59type Element = { props : Properties, element : ElementPrim }
60
60
61+{-| An Element that takes up no space. Good for things that appear conditionally:
62+
63+ flow down [ img1, if showMore then img2 else empty ]
64+-}
65+empty : Element
66+empty = spacer 0 0
67+
61{-| Get the width of an Element -}
68{-| Get the width of an Element -}
62widthOf : Element -> Int
69widthOf : Element -> Int
63widthOf e = e.props.width
70widthOf e = e.props.width
@@ -76,7 +83,7 @@ width nw e =
76 let p = e.props
83 let p = e.props
77 props = case e.element of
84 props = case e.element of
78 Image _ w h _ -> {p| height <- round (toFloat h / toFloat w * toFloat nw) }
85 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) }
80 _ -> p
87 _ -> p
81 in { element=e.element, props={ props | width <- nw } }
88 in { element=e.element, props={ props | width <- nw } }
82
89
@@ -108,7 +115,7 @@ color c e = let p = e.props in
108
115
109{-| Create an `Element` with a tag. This lets you link directly to it.
116{-| Create an `Element` with a tag. This lets you link directly to it.
110The element `(tag "all-about-badgers" thirdParagraph)` can be reached
117The 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`
112-}
119-}
113tag : String -> Element -> Element
120tag : String -> Element -> Element
114tag name e = let p = e.props in
121tag name e = let p = e.props in
@@ -128,7 +135,7 @@ data ElementPrim
128 | Container Position Element
135 | Container Position Element
129 | Flow Direction [Element]
136 | Flow Direction [Element]
130 | Spacer
137 | Spacer
131− | RawHtml JSString
138+ | RawHtml
132 | Custom -- for custom Elements implemented in JS, see collage for example
139 | Custom -- for custom Elements implemented in JS, see collage for example
133
140
134data ImageStyle = Plain | Fitted | Cropped (Int,Int) | Tiled
141data ImageStyle = Plain | Fitted | Cropped (Int,Int) | Tiled
@@ -195,7 +202,7 @@ flow dir es =
195 hs = List.map heightOf es
202 hs = List.map heightOf es
196 newFlow w h = newElement w h (Flow dir es)
203 newFlow w h = newElement w h (Flow dir es)
197 in
204 in
198− if es == [] then spacer 0 0 else
205+ if es == [] then empty else
199 case dir of
206 case dir of
200 DUp -> newFlow (List.maximum ws) (List.sum hs)
207 DUp -> newFlow (List.maximum ws) (List.sum hs)
201 DDown -> newFlow (List.maximum ws) (List.sum hs)
208 DDown -> newFlow (List.maximum ws) (List.sum hs)
@@ -302,4 +309,4 @@ inward : Direction
302inward = DIn
309inward = DIn
303
310
304outward : Direction
311outward : Direction
305−outward = DOut
312+outward = DOut
libraries/Graphics/Input.elm+1−1
@@ -113,7 +113,7 @@ hoverables : a -> { events : Signal a,
113 hoverable : (Bool -> a) -> Element -> Element }
113 hoverable : (Bool -> a) -> Element -> Element }
114hoverables = Native.Graphics.Input.hoverables
114hoverables = Native.Graphics.Input.hoverables
115
115
116−{-| Detect when the mouse is hovering over a specifici `Element`. -}
116+{-| Detect when the mouse is hovering over a specific `Element`. -}
117hoverable : Element -> (Element, Signal Bool)
117hoverable : Element -> (Element, Signal Bool)
118hoverable elem =
118hoverable elem =
119 let pool = hoverables False
119 let pool = hoverables False
libraries/JavaScript.elm+4
@@ -5,6 +5,10 @@ module JavaScript where
5the internal data structures of Elm to change and improve with no impact on JS
5the internal data structures of Elm to change and improve with no impact on JS
6integration.
6integration.
7
7
8+It is intended to be imported as `import JavaScript as JS`. That way functions
9+like `JS.toInt` convert JavaScript *to* Elm integers and functions like
10+`JS.fromString` gets JavaScript *from* Elm strings.
11+
8# Javascript to Elm
12# Javascript to Elm
9@docs toString, toInt, toFloat, toBool, toList
13@docs toString, toInt, toFloat, toBool, toList
10
14
libraries/Json.elm+3
@@ -3,6 +3,9 @@ module Json where
3
3
4{-| Library for working with [JSON](https://en.wikipedia.org/wiki/JSON) values.
4{-| Library for working with [JSON](https://en.wikipedia.org/wiki/JSON) values.
5
5
6+# Json Values
7+@docs JsonValue
8+
6# Strings
9# Strings
7@docs fromString, toString
10@docs fromString, toString
8
11
libraries/List.elm+42
@@ -20,6 +20,9 @@ list must have the same type.
20
20
21# Special Folds
21# Special Folds
22@docs sum, product, maximum, minimum, all, any, and, or
22@docs sum, product, maximum, minimum, all, any, and, or
23+
24+# Sorting
25+@docs sort, sortBy, sortWith
23-}
26-}
24
27
25import open Basics
28import open Basics
@@ -224,3 +227,42 @@ drop = Native.List.drop
224-}
227-}
225repeat : Int -> a -> [a]
228repeat : Int -> a -> [a]
226repeat = Native.List.repeat
229repeat = 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) {
22
22
23 function truncate(n) { return n|0; }
23 function truncate(n) { return n|0; }
24
24
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−
30 var basics = {
25 var basics = {
31 div:F2(div),
26 div:F2(div),
32 rem:F2(rem),
27 rem:F2(rem),
@@ -58,11 +53,6 @@ Elm.Native.Basics.make = function(elm) {
58 floor:Math.floor,
53 floor:Math.floor,
59 round:Math.round,
54 round:Math.round,
60 toFloat:function(x) { return x; },
55 toFloat:function(x) { return x; },
61−
62− curry:F3(curry),
63− uncurry:F2(uncurry),
64− fst:fst,
65− snd:snd
66 };
56 };
67
57
68 return elm.Native.Basics.values = basics;
58 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) {
41 var h = Math.ceil(style.getPropertyValue("height").slice(0,-2) - 0);
41 var h = Math.ceil(style.getPropertyValue("height").slice(0,-2) - 0);
42 elm.node.removeChild(t);
42 elm.node.removeChild(t);
43
43
44− console.log(w,h);
45 var element = A3(newElement, w, h, {
44 var element = A3(newElement, w, h, {
46 ctor: 'Custom',
45 ctor: 'Custom',
47 type: 'DropDown',
46 type: 'DropDown',
libraries/Native/List.js+33−8
@@ -53,8 +53,15 @@ Elm.Native.List.make = function(elm) {
53 }
53 }
54
54
55 function append(xs,ys) {
55 function append(xs,ys) {
56+ // append Text
57+ if (xs.text || ys.text) {
56− if (xs.isText) return Utils.txt(xs.concat(ys));
58+ return Utils.txt(Utils.makeText('',xs) + Utils.makeText('',ys));
59+ }
60+
61+ // append Strings
57− if (typeof xs === "string") return xs.concat(ys);
62+ if (typeof xs === "string") return xs + ys;
63+
64+ // append Lists
58 if (xs.ctor === '[]') { return ys; }
65 if (xs.ctor === '[]') { return ys; }
59 var root = Cons(xs._0, Nil);
66 var root = Cons(xs._0, Nil);
60 var curr = root;
67 var curr = root;
@@ -213,11 +220,20 @@ Elm.Native.List.make = function(elm) {
213 }
220 }
214
221
215 function sort(xs) {
222 function sort(xs) {
223+ return fromArray(toArray(xs).sort(Utils.cmp));
224+ }
225+
216− function cmp(a,b) {
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){
217− var ord = Utils.compare(a,b).ctor;
234+ var ord = f(a)(b).ctor;
218− return ord=== 'EQ' ? 0 : ord === 'LT' ? -1 : 1;
235+ return ord === 'EQ' ? 0 : ord === 'LT' ? -1 : 1;
219− }
236+ }));
220− return fromArray(toArray(xs).sort(cmp));
221 }
237 }
222
238
223 function nth(xs, n) {
239 function nth(xs, n) {
@@ -253,7 +269,14 @@ Elm.Native.List.make = function(elm) {
253 }
269 }
254
270
255 function join(sep, xss) {
271 function join(sep, xss) {
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+ }
256− if (sep.isText) return Utils.txt(toArray(xss).join(sep));
278+ return Utils.txt(xss.join(sep));
279+ }
257 if (typeof sep === 'string') return toArray(xss).join(sep);
280 if (typeof sep === 'string') return toArray(xss).join(sep);
258 if (xss.ctor === '[]') return Nil;
281 if (xss.ctor === '[]') return Nil;
259 var s = toArray(sep);
282 var s = toArray(sep);
@@ -298,6 +321,8 @@ Elm.Native.List.make = function(elm) {
298 zipWith:F3(zipWith),
321 zipWith:F3(zipWith),
299 zip:F2(zip),
322 zip:F2(zip),
300 sort:sort,
323 sort:sort,
324+ sortBy:F2(sortBy),
325+ sortWith:F2(sortWith),
301 nth:F2(nth),
326 nth:F2(nth),
302 take:F2(take),
327 take:F2(take),
303 drop:F2(drop),
328 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) {
53
53
54 function toText(str) { return Utils.txt(properEscape(JS.fromString(str))); }
54 function toText(str) { return Utils.txt(properEscape(JS.fromString(str))); }
55
55
56− function addTag(tag) {
56+ function height(px, text) {
57− return function(text) {
57+ return { style: 'font-size:' + px + 'px;', text: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>");
64 }
58 }
65−
66 function typeface(name, text) {
59 function typeface(name, text) {
67− return addStyle('font-family', JS.fromString(name), text);
60+ return { style: 'font-family:' + name + ';', text:text }
68 }
61 }
69 function monospace(text) {
62 function monospace(text) {
70− return addStyle('font-family', 'monospace', text);
63+ return { style: 'font-family:monospace;', text:text }
71 }
64 }
72− function size(px, text) { return addStyle('font-size', px + 'px', text) }
65+ function italic(text) {
73− var header = addTag('h1');
66+ return { style: 'font-style:italic;', text:text }
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 + ')';
81 }
67 }
82− function color(c, text) {
68+ function bold(text) {
83− return addStyle('color', extract(c), 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 };
84 }
79 }
85− function underline(text) { return addStyle('text-decoration', 'underline', text) }
86− function overline(text) { return addStyle('text-decoration', 'overline', text) }
87 function strikeThrough(text) {
80 function strikeThrough(text) {
88− return addStyle('text-decoration', 'line-through', text);
81+ return { line: ' line-through', text:text };
89 }
82 }
83+
90− function link(href, text) {
84+ function color(c, text) {
91− return Utils.txt("<a href='" + toText(href) + "'>" + text + "</a>");
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 };
92 }
89 }
93
90
94− function position(pos) {
91+ function position(align) {
95− return function(text) {
92+ function create(text) {
93+ var raw = {
96− var e = {ctor:'RawHtml',
94+ ctor:'RawHtml',
97− _0: '<div style="padding:0;margin:0;text-align:' +
95+ html: Utils.makeText('text-align:' + align + ';', text),
98− pos + '">' + text + '</div>'
96+ guid: null,
97+ args: [],
99− };
98+ };
100− var p = A2(Utils.htmlHeight, 0, text);
99+ var pos = A2(Utils.htmlHeight, 0, raw);
101− return A3(Element.newElement, p._0, p._1, e);
100+ return A3(Element.newElement, pos._0, pos._1, raw);
102 }
101 }
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);
103 }
114 }
104
115
116+ var text = position('left');
105 function asText(v) {
117 function asText(v) {
106− return position('left')(monospace(toText(show(v))));
118+ return text(monospace(toText(show(v))));
107 }
119 }
108
120
109 function plainText(v) {
121 function plainText(v) {
110− return position('left')(toText(v));
122+ return text(toText(v));
111 }
123 }
112
124
113 return elm.Native.Text.values = {
125 return elm.Native.Text.values = {
114 toText: toText,
126 toText: toText,
115
127
116− header : header,
117 height : F2(height),
128 height : F2(height),
118 italic : italic,
129 italic : italic,
119 bold : bold,
130 bold : bold,
@@ -128,9 +139,10 @@ Elm.Native.Text.make = function(elm) {
128 justified : position('justify'),
139 justified : position('justify'),
129 centered : position('center'),
140 centered : position('center'),
130 righted : position('right'),
141 righted : position('right'),
131− text : position('left'),
142+ text : text,
132 plainText : plainText,
143 plainText : plainText,
144+ markdown : markdown,
133
145
134− asText : asText
146+ asText : asText,
135 };
147 };
136};
148};
libraries/Native/Utils.js+51−3
@@ -25,7 +25,9 @@ Elm.Native.Utils.make = function(elm) {
25 function compare(x,y) { return { ctor: ord[cmp(x,y)+1] } }
25 function compare(x,y) { return { ctor: ord[cmp(x,y)+1] } }
26 function cmp(x,y) {
26 function cmp(x,y) {
27 var ord;
27 var ord;
28+ if (typeof x !== 'object' || x instanceof String){
28− if (typeof x !== 'object') return x === y ? EQ : x < y ? LT : GT;
29+ return x === y ? EQ : x < y ? LT : GT;
30+ }
29
31
30 if (x.ctor === "::" || x.ctor === "[]") {
32 if (x.ctor === "::" || x.ctor === "[]") {
31 while (true) {
33 while (true) {
@@ -68,10 +70,37 @@ Elm.Native.Utils.make = function(elm) {
68
70
69 function txt(str) {
71 function txt(str) {
70 var t = new String(str);
72 var t = new String(str);
71− t.isText = true;
73+ t.text = true;
72 return t;
74 return t;
73 }
75 }
74
76
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+
75 var count = 0;
104 var count = 0;
76 function guid(_) { return count++ }
105 function guid(_) { return count++ }
77
106
@@ -122,7 +151,9 @@ Elm.Native.Utils.make = function(elm) {
122 return m === b ? 0 : m;
151 return m === b ? 0 : m;
123 }
152 }
124
153
125− function htmlHeight(width, html) {
154+ function htmlHeight(width, rawHtml) {
155+ // create dummy node
156+ var html = rawHtml.html;
126 var t = document.createElement('div');
157 var t = document.createElement('div');
127 t.innerHTML = html;
158 t.innerHTML = html;
128 if (width > 0) { t.style.width = width + "px"; }
159 if (width > 0) { t.style.width = width + "px"; }
@@ -131,6 +162,22 @@ Elm.Native.Utils.make = function(elm) {
131 t.style.cssFloat = "left";
162 t.style.cssFloat = "left";
132
163
133 document.body.appendChild(t);
164 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
134 var style = window.getComputedStyle(t, null);
181 var style = window.getComputedStyle(t, null);
135 var w = Math.ceil(style.getPropertyValue("width").slice(0,-2) - 0);
182 var w = Math.ceil(style.getPropertyValue("width").slice(0,-2) - 0);
136 var h = Math.ceil(style.getPropertyValue("height").slice(0,-2) - 0);
183 var h = Math.ceil(style.getPropertyValue("height").slice(0,-2) - 0);
@@ -168,6 +215,7 @@ Elm.Native.Utils.make = function(elm) {
168 Tuple2:Tuple2,
215 Tuple2:Tuple2,
169 chr:chr,
216 chr:chr,
170 txt:txt,
217 txt:txt,
218+ makeText:makeText,
171 copy: copy,
219 copy: copy,
172 remove: remove,
220 remove: remove,
173 replace: replace,
221 replace: replace,
libraries/Prelude.elm+1−12
@@ -1,19 +1,8 @@
1module Prelude where
1module Prelude where
2{-| Everything that is automatically imported -}
2{-| Everything that is automatically imported -}
3
3
4−import Basics (String)
5−import Maybe (Maybe)
6−import Native.Prelude
7import Native.Show
4import Native.Show
8
5
9-- Convert almost any value to its string representation.
6-- Convert almost any value to its string representation.
10show : a -> String
7show : a -> String
11−show = Native.Show.show
8+show = Native.Show.show
12−
13−-- Read an integer from a string
14−readInt : String -> Maybe Int
15−readInt = Native.Prelude.readInt
16−
17−-- Read a float from a string.
18−readFloat : String -> Maybe Float
19−readFloat = Native.Prelude.readFloat
libraries/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` &mdash; the full string of the match.
58+ * `submatches` &mdash; 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`&rsquo;s or
63+ many `b`&rsquo;s, but never both.
64+ * `index` &mdash; the index of the match in the original string.
65+ * `number` &mdash; 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
3`lift8` and infix lift operators `<~` and `~`, combinations, filters, and
3`lift8` and infix lift operators `<~` and `~`, combinations, filters, and
4past-dependence.
4past-dependence.
5
5
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
7their input signals has an event. Signal events may be of the same value as the
7their input signals has an event. Signal events may be of the same value as the
8previous value of the signal. Such signals are useful for timing and
8previous value of the signal. Such signals are useful for timing and
9past-dependence.
9past-dependence.
@@ -95,11 +95,11 @@ combine = foldr (Native.Signal.lift2 (::)) (Native.Signal.constant [])
95 -- fold over non-homogeneous inputs.
95 -- fold over non-homogeneous inputs.
96 -- mergeEither : Signal a -> Signal b -> Signal (Either a b)
96 -- mergeEither : Signal a -> Signal b -> Signal (Either a b)
97
97
98−{-| Count the number of events that have occured. -}
98+{-| Count the number of events that have occurred. -}
99count : Signal a -> Signal Int
99count : Signal a -> Signal Int
100count = Native.Signal.count
100count = Native.Signal.count
101
101
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.
103-}
103-}
104countIf : (a -> Bool) -> Signal a -> Signal Int
104countIf : (a -> Bool) -> Signal a -> Signal Int
105countIf = Native.Signal.countIf
105countIf = Native.Signal.countIf
libraries/Text.elm+1−5
@@ -12,7 +12,7 @@ module Text where
12@docs color, typeface, height, link
12@docs color, typeface, height, link
13
13
14# Simple Formatting
14# Simple Formatting
15−@docs monospace, header, bold, italic, underline, overline, strikeThrough
15+@docs monospace, bold, italic, underline, overline, strikeThrough
16
16
17-}
17-}
18
18
@@ -43,10 +43,6 @@ typeface = Native.Text.typeface
43monospace : Text -> Text
43monospace : Text -> Text
44monospace = Native.Text.monospace
44monospace = Native.Text.monospace
45
45
46−{-| Make text big and noticable. -}
47−header : Text -> Text
48−header = Native.Text.header
49−
50{-| Create a link. -}
46{-| Create a link. -}
51link : String -> Text -> Text
47link : String -> Text -> Text
52link = Native.Text.link
48link = Native.Text.link
libraries/Transform2D.elm+17−15
@@ -1,14 +1,16 @@
1module Transform2D where
1module 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].
3It is used primarily with the `groupTransform` function from `Graphics.Collage` and
3It is used primarily with the `groupTransform` function from `Graphics.Collage` and
4allows you to do things like rotation, scaling, translation, shearing, and reflection.
4allows you to do things like rotation, scaling, translation, shearing, and reflection.
5
5
6Note that all the matrices in this library are 3x3 matrices of homogeneous
6Note 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
7+coordinates, used for [affine transformations][affine]. Since the bottom row as
8−1, we omit this below.
8+always `0 0 1` in these matrices, it is omitted in the diagrams below.
9
9
10+ [affine]: http://en.wikipedia.org/wiki/Transformation_matrix#Affine_transformations
11+
10−# Basic Transforms
12+# Transforms
11−@docs identity, matrix, rotation
13+@docs identity, matrix, rotation, translation, scale, scaleX, scaleY
12
14
13# Multiplication
15# Multiplication
14@docs multiply
16@docs multiply
@@ -31,12 +33,12 @@ identity = Native.Transform2D.identity
31{-| Creates a transformation matrix. This lets you create transforms
33{-| Creates a transformation matrix. This lets you create transforms
32such as scales, shears, reflections, and translations.
34such as scales, shears, reflections, and translations.
33
35
34− matrix a b c d dx dy
36+ matrix a b c d x y
35
37
36− / a b dx \
38+ / a b x \
37− \ c d dy /
39+ \ c d y /
38
40
39−Note that `dx` and `dy` are the translation values.
41+Note that `x` and `y` are the translation values.
40-}
42-}
41matrix : Float -> Float -> Float -> Float -> Float -> Float -> Transform2D
43matrix : Float -> Float -> Float -> Float -> Float -> Float -> Transform2D
42matrix = Native.Transform2D.matrix
44matrix = Native.Transform2D.matrix
@@ -55,8 +57,7 @@ rotation = Native.Transform2D.rotation
55 translation x y
57 translation x y
56
58
57 / 1 0 x \
59 / 1 0 x \
58− | 0 1 y |
60+ \ 0 1 y /
59− \ 0 0 1 /
60-}
61-}
61translation : Float -> Float -> Transform2D
62translation : Float -> Float -> Transform2D
62translation x y = matrix 1 0 0 1 x y
63translation x y = matrix 1 0 0 1 x y
@@ -77,14 +78,15 @@ scaleX x = matrix x 0 0 1 0 0
77
78
78{-| Creates a transformation for vertical scaling -}
79{-| Creates a transformation for vertical scaling -}
79scaleY : Float -> Transform2D
80scaleY : Float -> Transform2D
80−scaleY y = matrix y 0 0 1 0 0
81+scaleY y = matrix 1 0 0 y 0 0
81
82
82{-| Multiplies two transforms together:
83{-| Multiplies two transforms together:
83
84
84− multiply a b
85+ multiply m n
85
86
86− / a11 a12 \ . / b11 b12 \
87+ / ma mb mx \ / na nb nx \
87− \ a21 a22 / \ b21 b22 /
88+ | mc md my | . | nc nd ny |
89+ \ 0 0 1 / \ 0 0 1 /
88-}
90-}
89multiply : Transform2D -> Transform2D -> Transform2D
91multiply : Transform2D -> Transform2D -> Transform2D
90multiply = Native.Transform2D.multiply
92multiply = 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) {
158 signalGraph = Signal.constant(signalGraph);
158 signalGraph = Signal.constant(signalGraph);
159 }
159 }
160 var currentScene = signalGraph.value;
160 var currentScene = signalGraph.value;
161−
161+
162 // Add the currentScene to the DOM
162 // Add the currentScene to the DOM
163 var Render = ElmRuntime.use(ElmRuntime.Render.Element);
163 var Render = ElmRuntime.use(ElmRuntime.Render.Element);
164 elm.node.appendChild(Render.render(currentScene));
164 elm.node.appendChild(Render.render(currentScene));
165−
165+
166 // set up updates so that the DOM is adjusted as necessary.
166 // set up updates so that the DOM is adjusted as necessary.
167 function domUpdate(newScene, currentScene) {
167 function domUpdate(newScene, currentScene) {
168 ElmRuntime.draw(function(_) {
168 ElmRuntime.draw(function(_) {
@@ -180,4 +180,4 @@ function initGraphics(elm, Module) {
180 return renderer;
180 return renderer;
181}
181}
182
182
183−}());
183+}());
runtime/Render/Collage.js+46−59
@@ -144,13 +144,13 @@ function renderForm(redo, ctx, form) {
144 case 'FPath' : drawLine(ctx, f._0, f._1); break;
144 case 'FPath' : drawLine(ctx, f._0, f._1); break;
145 case 'FImage': drawImage(redo, ctx, f); break;
145 case 'FImage': drawImage(redo, ctx, f); break;
146 case 'FShape':
146 case 'FShape':
147− if (f._0.ctor === 'Left') {
147+ if (f._0.ctor === 'Left') {
148− f._1.closed = true;
148+ f._1.closed = true;
149− drawLine(ctx, f._0._0, f._1);
149+ drawLine(ctx, f._0._0, f._1);
150− } else {
150+ } else {
151− drawShape(redo, ctx, f._0._0, f._1);
151+ drawShape(redo, ctx, f._0._0, f._1);
152− }
152+ }
153− break;
153+ break;
154 }
154 }
155 ctx.restore();
155 ctx.restore();
156}
156}
@@ -173,16 +173,16 @@ function str(n) {
173
173
174function makeTransform(w, h, form, matrices) {
174function makeTransform(w, h, form, matrices) {
175 var props = form.form._0.props;
175 var props = form.form._0.props;
176− var m = A6( Transform.matrix, 1, 0, 0, 1,
176+ var m = A6( Transform.matrix, 1, 0, 0, -1,
177− (w - props.width)/2,
177+ (w - props.width ) / 2,
178− (h - props.height)/2 );
178+ (h - props.height) / 2 );
179 var len = matrices.length;
179 var len = matrices.length;
180 for (var i = 0; i < len; ++i) { m = A2( Transform.multiply, m, matrices[i] ); }
180 for (var i = 0; i < len; ++i) { m = A2( Transform.multiply, m, matrices[i] ); }
181 m = A2( Transform.multiply, m, formToMatrix(form) );
181 m = A2( Transform.multiply, m, formToMatrix(form) );
182
182
183− return 'matrix(' + str( m[0]) + ',' + str( m[3]) + ',' +
183+ return 'matrix(' + str( m[0]) + ', ' + str( m[3]) + ', ' +
184− str(-m[1]) + ',' + str(-m[4]) + ',' +
184+ str(-m[1]) + ', ' + str(-m[4]) + ', ' +
185− str( m[2]) + ',' + str( m[5]) + ')';
185+ str( m[2]) + ', ' + str( m[5]) + ')';
186}
186}
187
187
188function stepperHelp(list) {
188function stepperHelp(list) {
@@ -200,7 +200,7 @@ function stepperHelp(list) {
200 return { peekNext:peekNext, next:next };
200 return { peekNext:peekNext, next:next };
201}
201}
202
202
203−function stepper(forms) {
203+function formStepper(forms) {
204 var ps = [stepperHelp(forms)];
204 var ps = [stepperHelp(forms)];
205 var matrices = [];
205 var matrices = [];
206 var alphas = [];
206 var alphas = [];
@@ -253,11 +253,12 @@ function makeCanvas(w,h) {
253
253
254function render(model) {
254function render(model) {
255 var div = newElement('div');
255 var div = newElement('div');
256+ div.style.overflow = 'hidden';
256 update(div, model, model);
257 update(div, model, model);
257 return div;
258 return div;
258}
259}
259
260
260−function updateTracker(w,h,div) {
261+function nodeStepper(w,h,div) {
261 var kids = div.childNodes;
262 var kids = div.childNodes;
262 var i = 0;
263 var i = 0;
263 function transform(transforms, ctx) {
264 function transform(transforms, ctx) {
@@ -271,7 +272,7 @@ function updateTracker(w,h,div) {
271 }
272 }
272 return ctx;
273 return ctx;
273 }
274 }
274− function getContext(transforms) {
275+ function nextContext(transforms) {
275 while (i < kids.length) {
276 while (i < kids.length) {
276 var node = kids[i];
277 var node = kids[i];
277 if (node.getContext) {
278 if (node.getContext) {
@@ -290,75 +291,61 @@ function updateTracker(w,h,div) {
290 ++i;
291 ++i;
291 return transform(transforms, canvas.getContext('2d'));
292 return transform(transforms, canvas.getContext('2d'));
292 }
293 }
293− function element(matrices, alpha, form) {
294+ function addElement(matrices, alpha, form) {
294− var container = kids[i];
295+ var kid = kids[i];
295− if (!container || container.getContext) {
296+ var elem = form.form._0;
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;
307
297
308− container.style.width = w + 'px';
298+ var node = (!kid || kid.getContext)
309− container.style.height = h + 'px';
299+ ? Render.render(elem)
310− container.style.opacity = alpha * form.alpha;
300+ : (Render.update(kid, kid.oldElement, elem), kids[i]);
311
301
312− var elem = form.form._0;
302+ node.style.position = 'absolute';
313− var node = container.firstChild;
303+ node.style.opacity = alpha * form.alpha;
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;
322 addTransform(node.style, makeTransform(w, h, form, matrices));
304 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+ }
323 }
312 }
324 function clearRest() {
313 function clearRest() {
325 while (i < kids.length) {
314 while (i < kids.length) {
326 div.removeChild(kids[i]);
315 div.removeChild(kids[i]);
327 }
316 }
328 }
317 }
329− return { getContext:getContext, element:element, clearRest:clearRest };
318+ return { nextContext:nextContext, addElement:addElement, clearRest:clearRest };
330}
319}
331
320
332
321
333function update(div, _, model) {
322function update(div, _, model) {
334 var w = model.w;
323 var w = model.w;
335 var h = model.h;
324 var h = model.h;
336− div.style.width = w + 'px';
325+
337− div.style.height = h + 'px';
326+ var forms = formStepper(model.forms);
338− if (model.forms.ctor === 'Nil') {
327+ var nodes = nodeStepper(w,h,div);
339− while (div.hasChildNodes()) {
340− div.removeChild(div.lastChild);
341− }
342− }
343− var stpr = stepper(model.forms);
344− var tracker = updateTracker(w,h,div);
345 var ctx = null;
328 var ctx = null;
346 var formType = '';
329 var formType = '';
347
330
348− while (formType = stpr.peekNext()) {
331+ while (formType = forms.peekNext()) {
332+ // make sure we have context if we need it
349 if (ctx === null && formType !== 'FElement') {
333 if (ctx === null && formType !== 'FElement') {
350− ctx = tracker.getContext(stpr.transforms());
334+ ctx = nodes.nextContext(forms.transforms());
351− ctx.globalAlpha = stpr.alpha();
335+ ctx.globalAlpha = forms.alpha();
352 }
336 }
337+
353− var form = stpr.next(ctx);
338+ var form = forms.next(ctx);
339+ // if it is FGroup, all updates are made within formStepper when next is called.
354 if (formType === 'FElement') {
340 if (formType === 'FElement') {
341+ // update or insert an element, get a new context
355− tracker.element(stpr.transforms(), stpr.alpha(), form);
342+ nodes.addElement(forms.transforms(), forms.alpha(), form);
356 ctx = null;
343 ctx = null;
357 } else if (formType !== 'FGroup') {
344 } else if (formType !== 'FGroup') {
358 renderForm(function() { update(div, model, model); }, ctx, form);
345 renderForm(function() { update(div, model, model); }, ctx, form);
359 }
346 }
360 }
347 }
361− tracker.clearRest();
348+ nodes.clearRest();
362 return false;
349 return false;
363}
350}
364
351
runtime/Render/Element.js+58−8
@@ -154,10 +154,31 @@ function container(pos,elem) {
154 return div;
154 return div;
155}
155}
156
156
157−function rawHtml(html) {
157+function rawHtml(elem) {
158+ var html = elem.html;
159+ var args = elem.args;
160+ var guid = elem.guid;
161+
158− var e = newElement('div');
162+ var div = newElement('div');
159− e.innerHTML = html;
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';
160− return e;
181+ return div;
161}
182}
162
183
163function render(elem) { return setProps(elem.props, makeElement(elem)); }
184function render(elem) { return setProps(elem.props, makeElement(elem)); }
@@ -168,7 +189,7 @@ function makeElement(e) {
168 case 'Flow': return flow(elem._0, elem._1);
189 case 'Flow': return flow(elem._0, elem._1);
169 case 'Container': return container(elem._0, elem._1);
190 case 'Container': return container(elem._0, elem._1);
170 case 'Spacer': return newElement('div');
191 case 'Spacer': return newElement('div');
171− case 'RawHtml': return rawHtml(elem._0);
192+ case 'RawHtml': return rawHtml(elem);
172 case 'Custom': return elem.render(elem.model);
193 case 'Custom': return elem.render(elem.model);
173 }
194 }
174}
195}
@@ -184,7 +205,36 @@ function update(node, curr, next) {
184 switch(nextE.ctor) {
205 switch(nextE.ctor) {
185 case "Spacer": break;
206 case "Spacer": break;
186 case "RawHtml":
207 case "RawHtml":
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+ }
187− if (nextE._0 !== currE._0) node.innerHTML = nextE._0;
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+ }
188 break;
238 break;
189 case "Image":
239 case "Image":
190 if (nextE._0.ctor === 'Plain') {
240 if (nextE._0.ctor === 'Plain') {
@@ -222,7 +272,7 @@ function update(node, curr, next) {
222 }
272 }
223 break;
273 break;
224 case "Container":
274 case "Container":
225− update(node.firstChild, currE._1, nextE._1)
275+ update(node.firstChild, currE._1, nextE._1);
226 setPos(nextE._0, nextE._1.props.width, nextE._1.props.height, node.firstChild);
276 setPos(nextE._0, nextE._1.props.width, nextE._1.props.height, node.firstChild);
227 break;
277 break;
228 case "Custom":
278 case "Custom":
@@ -269,4 +319,4 @@ function updateProps(node, curr, next) {
269
319
270return { render:render, update:update };
320return { render:render, update:update };
271
321
272−};
322+};
runtime/Render/Utils.js+43−46
@@ -1,48 +1,45 @@
1−
2ElmRuntime.Render.Utils = function() {
1ElmRuntime.Render.Utils = function() {
3−
4−function newElement(elementType) {
2+ function newElement(elementType) {
5− var e = document.createElement(elementType);
3+ var e = document.createElement(elementType);
6− e.style.padding = "0";
4+ e.style.padding = "0";
7− e.style.margin = "0";
5+ e.style.margin = "0";
8− return e;
6+ return e;
9−}
7+ }
10−
8+
11−function addTo(container, elem) {
9+ function addTo(container, elem) {
12− container.appendChild(elem);
10+ container.appendChild(elem);
13−}
11+ }
14−
12+
15−function extract(c) {
13+ function extract(c) {
16− if (c._3 === 1) { return 'rgb(' + c._0 + ', ' + c._1 + ', ' + c._2 + ')'; }
14+ if (c._3 === 1) { return 'rgb(' + c._0 + ', ' + c._1 + ', ' + c._2 + ')'; }
17− return 'rgba(' + c._0 + ', ' + c._1 + ', ' + c._2 + ', ' + c._3 + ')';
15+ return 'rgba(' + c._0 + ', ' + c._1 + ', ' + c._2 + ', ' + c._3 + ')';
18−}
16+ }
19−
17+
20−function addTransform(style, trans) {
18+ function addTransform(style, trans) {
21− style.transform = trans;
19+ style.transform = trans;
22− style.msTransform = trans;
20+ style.msTransform = trans;
23− style.MozTransform = trans;
21+ style.MozTransform = trans;
24− style.webkitTransform = trans;
22+ style.webkitTransform = trans;
25− style.OTransform = trans;
23+ style.OTransform = trans;
26−}
24+ }
27−
25+
28−function removeTransform(style) {
26+ function removeTransform(style) {
29− style.transform = 'none';
27+ style.transform = 'none';
30− style.msTransform = 'none';
28+ style.msTransform = 'none';
31− style.MozTransform = 'none';
29+ style.MozTransform = 'none';
32− style.webkitTransform = 'none';
30+ style.webkitTransform = 'none';
33− style.OTransform = 'none';
31+ style.OTransform = 'none';
34−}
32+ }
35−
33+
36−var List = Elm.Native.List.make({});
34+ var List = Elm.Native.List.make({});
37−
35+
38−return {addTo:addTo,
36+ return {addTo:addTo,
39− newElement:newElement,
37+ newElement:newElement,
40− extract : extract,
38+ extract : extract,
41− fromList: List.toArray,
39+ fromList: List.toArray,
42− fromString: function(s) { return s; },
40+ fromString: function(s) { return s; },
43− toString: function(s) { return s; },
41+ toString: function(s) { return s; },
44− eq: Elm.Native.Utils.make({}).eq,
42+ eq: Elm.Native.Utils.make({}).eq,
45− addTransform: addTransform,
43+ addTransform: addTransform,
46− removeTransform: removeTransform
44+ removeTransform: removeTransform};
47− };
48};
45};
server/Server.hs+14−16
@@ -33,20 +33,23 @@ serve portNumber libLoc = do
33pageTitle :: String -> String
33pageTitle :: String -> String
34pageTitle = dropExtension . takeBaseName
34pageTitle = dropExtension . takeBaseName
35
35
36−defaultCacheDirectory = "elm-server-cache"
37−
38serveElm :: FilePath -> ServerPartT IO Response
36serveElm :: FilePath -> ServerPartT IO Response
39−serveElm fp = do
37+serveElm fp =
40− fileExists <- liftIO $ doesFileExist file
38+ do fileExists <- liftIO $ doesFileExist file
41− guard $ fileExists && takeExtension fp == ".elm"
39+ guard (fileExists && takeExtension fp == ".elm")
40+ onSuccess compile serve
41+ where
42+ file = tail fp
42
43
43− (_, stdout, _, handle) <- liftIO $ createProcess $
44− (proc "elm" args) { std_out = CreatePipe }
44+ compile = liftIO $ createProcess $ (proc "elm" args) { std_out = CreatePipe }
45− exitCode <- liftIO $ waitForProcess handle
45+ where args = [ "--make", "--runtime=" ++ runtime, file ]
46
46
47− dirExists <- liftIO $ doesDirectoryExist defaultCacheDirectory
47+ serve = serveFile (asContentType "text/html")
48− when dirExists $ liftIO $ removeDirectoryRecursive defaultCacheDirectory
48+ ("build" </> replaceExtension file "html")
49
49
50+onSuccess action success = do
51+ (_, stdout, _, handle) <- action
52+ exitCode <- liftIO $ waitForProcess handle
50 case (exitCode, stdout) of
53 case (exitCode, stdout) of
51 (ExitFailure 127, _) ->
54 (ExitFailure 127, _) ->
52 badRequest $ toResponse "Error: elm binary not found in your path."
55 badRequest $ toResponse "Error: elm binary not found in your path."
@@ -55,13 +58,8 @@ serveElm fp = do
55 badRequest $ toResponse str
58 badRequest $ toResponse str
56 (ExitFailure _, Nothing) ->
59 (ExitFailure _, Nothing) ->
57 badRequest $ toResponse "See command line for error message."
60 badRequest $ toResponse "See command line for error message."
58− (ExitSuccess, _) ->
61+ (ExitSuccess, _) -> success
59− serveFile
60− (asContentType "text/html") ("build" </> replaceExtension file "html")
61
62
62− where file = tail fp
63− args = [ "--make" ,"--runtime=" ++ runtime,
64− "--cache-dir=" ++ defaultCacheDirectory, file ]
65
63
66serveLib :: FilePath -> String -> ServerPartT IO Response
64serveLib :: FilePath -> String -> ServerPartT IO Response
67serveLib libLoc fp = do
65serveLib 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 "{-"