Elm 0.7.1.1 → 0.8
raw patch · 67 files changed
+10500/−3752 lines, 67 filesdep +directorydep +jsondep ~blaze-htmlbuild-type:Customsetup-changednew-component:exe:elm-docPVP ok
version bump matches the API change (PVP)
Dependencies added: directory, json
Dependency ranges changed: blaze-html
API changes (from Hackage documentation)
- Language.Elm: class ElmSource a
- Language.Elm: instance ElmSource (t -> Elm)
- Language.Elm: instance ElmSource (t, t -> Elm)
- Language.Elm: instance ElmSource Elm
- Language.Elm: instance ElmSource String
- Language.Elm: instance ElmSource Text
- Language.Elm: runtimeLocation :: IO FilePath
- Language.Elm: toParts :: ElmSource a => a -> (Html, Html, String)
+ Language.Elm: compile :: String -> String
+ Language.Elm: docs :: IO FilePath
+ Language.Elm: moduleName :: String -> String
+ Language.Elm: runtime :: IO FilePath
- Language.Elm: toHtml :: ElmSource a => String -> String -> a -> Html
+ Language.Elm: toHtml :: String -> String -> String -> Html
Files
- Elm.cabal +43/−12
- LICENSE +30/−30
- Setup.hs +2/−2
- changelog.txt +186/−176
- compiler/Compiler.hs +91/−0
- compiler/Docs.hs +65/−0
- compiler/Gen/Cases.hs +87/−0
- compiler/Gen/CompileToJS.hs +338/−0
- compiler/Gen/ExtractNoscript.hs +59/−0
- compiler/Gen/GenerateHtml.hs +75/−0
- compiler/Initialize.hs +97/−0
- compiler/Language/Elm.hs +58/−0
- compiler/Language/Elm/Quasi.hs +93/−0
- compiler/Model/Ast.hs +153/−0
- compiler/Model/Context.hs +43/−0
- compiler/Model/Guid.hs +19/−0
- compiler/Model/Libraries.hs +59/−0
- compiler/Model/LoadLibraries.hs +34/−0
- compiler/Parse/Binops.hs +89/−0
- compiler/Parse/Expr.hs +216/−0
- compiler/Parse/Foreign.hs +61/−0
- compiler/Parse/Library.hs +183/−0
- compiler/Parse/Modules.hs +46/−0
- compiler/Parse/Parser.hs +52/−0
- compiler/Parse/Patterns.hs +105/−0
- compiler/Parse/Types.hs +167/−0
- compiler/Transform/Optimize.hs +136/−0
- compiler/Transform/Rename.hs +149/−0
- compiler/Transform/Substitute.hs +28/−0
- compiler/Types/Alias.hs +139/−0
- compiler/Types/Constrain.hs +318/−0
- compiler/Types/Hints.hs +31/−0
- compiler/Types/Solver.hs +211/−0
- compiler/Types/Substitutions.hs +136/−0
- compiler/Types/Types.hs +94/−0
- compiler/Types/Unify.hs +16/−0
- docs.json +1715/−0
- elm-runtime-0.7.1.1.js +0/−142
- elm-runtime.js +5076/−0
- src/Ast.hs +0/−148
- src/Compiler.hs +0/−112
- src/Context.hs +0/−43
- src/Gen/Cases.hs +0/−80
- src/Gen/CompileToJS.hs +0/−327
- src/Gen/ExtractNoscript.hs +0/−60
- src/Gen/GenerateHtml.hs +0/−89
- src/Guid.hs +0/−16
- src/Initialize.hs +0/−22
- src/Language/Elm.hs +0/−82
- src/Language/Elm/Quasi.hs +0/−93
- src/Optimize.hs +0/−134
- src/Parse/Binops.hs +0/−88
- src/Parse/Expr.hs +0/−214
- src/Parse/Foreign.hs +0/−61
- src/Parse/Library.hs +0/−180
- src/Parse/Modules.hs +0/−47
- src/Parse/Parser.hs +0/−41
- src/Parse/Patterns.hs +0/−104
- src/Parse/Types.hs +0/−113
- src/Rename.hs +0/−143
- src/Substitute.hs +0/−28
- src/Types/Constrain.hs +0/−295
- src/Types/Hints.hs +0/−443
- src/Types/Solver.hs +0/−199
- src/Types/Substitutions.hs +0/−88
- src/Types/Types.hs +0/−121
- src/Types/Unify.hs +0/−19
Elm.cabal view
@@ -1,6 +1,5 @@- Name: Elm-Version: 0.7.1.1+Version: 0.8 Synopsis: The Elm language module. Description: Elm aims to make client-side web-development more pleasant. It is a statically/strongly typed, functional reactive@@ -19,10 +18,10 @@ Category: Compiler, Language -Build-type: Simple+Build-type: Custom Extra-source-files: changelog.txt-Data-files: elm-runtime-0.7.1.1.js+Data-files: elm-runtime.js docs.json Cabal-version: >=1.8 source-repository head@@ -32,7 +31,7 @@ Library exposed-modules: Language.Elm, Language.Elm.Quasi- Hs-Source-Dirs: src, src/Gen+ Hs-Source-Dirs: compiler, compiler/Gen, compiler/Model, compiler/Transform other-modules: Ast, Context, CompileToJS,@@ -41,6 +40,8 @@ ExtractNoscript, GenerateHtml, Guid,+ Libraries,+ LoadLibraries, Optimize, Initialize, Rename,@@ -52,6 +53,7 @@ Parse.Parser, Parse.Patterns, Parse.Types,+ Types.Alias, Types.Types, Types.Constrain, Types.Hints,@@ -64,10 +66,10 @@ containers >= 0.3, transformers >= 0.2, mtl >= 2,+ deepseq, parsec >= 3.1.1,- blaze-html == 0.5.*,+ blaze-html == 0.5.* || == 0.6.*, blaze-markup == 0.5.1.*,- deepseq, text, template-haskell, shakespeare >= 1,@@ -75,11 +77,16 @@ bytestring, hjsmin, indents,- filepath+ filepath,+ template-haskell,+ json,+ directory Executable elm Main-is: Compiler.hs- Hs-Source-Dirs: src, src/Gen+ Hs-Source-Dirs: compiler, compiler/Gen, compiler/Model, compiler/Transform+ extensions: CPP+ cpp-options: -DELM_COMPILEDATADIR="dist/data" other-modules: Ast, Context, CompileToJS,@@ -88,6 +95,8 @@ ExtractNoscript, GenerateHtml, Guid,+ Libraries,+ LoadLibraries, Optimize, Initialize, Rename,@@ -99,6 +108,7 @@ Parse.Parser, Parse.Patterns, Parse.Types,+ Types.Alias, Types.Types, Types.Constrain, Types.Hints,@@ -111,13 +121,34 @@ containers >= 0.3, transformers >= 0.2, mtl >= 2,+ deepseq, parsec >= 3.1.1,- blaze-html == 0.5.*,+ blaze-html == 0.5.* || == 0.6.*, blaze-markup == 0.5.1.*,- deepseq, cmdargs, pandoc >= 1.10, bytestring, hjsmin, indents,- filepath+ filepath,+ template-haskell,+ json,+ directory++Executable elm-doc+ Main-is: Docs.hs+ Hs-Source-Dirs: compiler, compiler/Model, compiler/Transform+ other-modules: Ast,+ Context,+ Parse.Library,+ Parse.Modules,+ Rename++ Build-depends: base >=4.2 && <5,+ containers >= 0.3,+ transformers >= 0.2,+ mtl >= 2,+ parsec >= 3.1.1,+ pandoc >= 1.10,+ cmdargs,+ indents
LICENSE view
@@ -1,30 +1,30 @@-Copyright (c)2012, Evan Czaplicki - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of Evan Czaplicki nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +Copyright (c)2012, Evan Czaplicki++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Evan Czaplicki nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple -main = defaultMain +import Distribution.Simple+main = defaultMain
changelog.txt view
@@ -1,176 +1,186 @@- -Release 0.5.0 -============= - -* Add Dict, Set, and Automaton libraries! - -* Add (,,) notation for creating tuples. - -* Redo HTTP library, allowing any kind of request and more flexibility. - -* Remove the library prefixes `Data.`, `Graphics.`, and `Signal.` because - they were more confusing than helpful. - -* Better type error reporting for ambiguous uses of variables and for - variables in aliased modules. - -* Add `readInt` and `readFloat` functions. -* Add `complement` function to compute complementary colors. -* Ensure that `String` is treated as an alias of `[Char]`. - -* Fix bug in pattern parsing. `A B _ _` was parsed as `A (B _ _)`. -* Make pattern matching a bit more compact in generated code. -* Make generated JS more readable. - -* The Haskell API exports the absolute path to the Elm runtime - system (with the corresponding version number). This makes it easier - to run Elm programs with less setup. - - - -Release 0.4.0 -============= - -This version is all about graphics: nicer API with more features and major -efficiency improvements. I am really excited about this release! - -* Add native Markdown support. You can now embed markdown directly in .elm files - and it is used as an `Element`. Syntax is `[markdown| ... |]` where `...` is - formatted as described [here](http://daringfireball.net/projects/markdown/). - Content can span multiple lines too. - -* Drastically improve the `collage` interface. You can now move, rotate, and scale - the following forms: - - Elements (any Element you want can be turned into a Form with `toForm`) - - Images - - Shapes (shapes can be textured now too) - - Lines - This will make it way easier to make games in Elm. Games can now include text, - gifs, videos, and any other Element you can think of. - -* Add `--minify` flag, to minify JS code. - -* Significantly improve performance of pattern matching. - -* Compiler performs beta-reduction in some simple cases. - -* The rendering section of the Elm runtume-system (RTS) has been totally rewritten, - making screen refreshes use fewer cycles, less memory, and cause less garbage-collection. - - - -Release 0.3.6 -============= - -* Add JSON library. - -* Type-error messages improved. Gives better context for error, making them - easier to find. Better messages for runtime errors as well (errors that - the type checker cannot find yet). - -* Add Comparable super-type which allows the comparision of any values - of type {Int,Float,Char,String}. Now possible to make Set and Map libraries. - -* Parser now handles decimal numbers. - -* Added many new functions for manipulating numbers: - - truncate, round, floor, ceiling :: Float -> Int - - toFloat :: Int -> Float - - (^) :: Number -> Number -> Number - - e :: Float - -* Foreign import/export statements no longer have to preceed all other - variable and datatype definitions. They can be mixed in, making things - a bit more readable/natural. - -* Bug fixes: - - The `toText` function did not escape strings properly - - Correct `castJSTupleToTupleN` family of functions - - `foldr1` took the leftmost element as the base case instead of the rightmost - - Fix minor display issue in latest version of Chrome. - - Fix behavior of [ lo .. hi ] syntax (now [4..0] == [], not [0]). - - - -Release 0.3.5 -============= - -* Add JavaScript event interface. Allows Elm to import and export JS values - and events. This makes it possible to import and export Elements, so users - can use JS techniques and libraries if necessary. Conversion between JS - and Elm values happens with functions from here: - http://localhost:8000/docs/Foreign/JavaScript.elm - http://localhost:8000/docs/Foreign/JavaScript/Experimental.elm - -* Add new flags to help with JavaScript event interface. - -* Add three built-in event listeners (elm_title, elm_log, elm_redirect) that - make it possible to make some common/simple imperative actions without - having to worry about writing the JS yourself. For example: - foreign export jsevent "elm_title" - title :: Signal JSString - will update the page's title to the current value of the title signal. - Empty strings are ignored. "elm_redirect" and "elm_log" events work much - the same way, except that "elm_log" does not skip empty strings. - -* Add new Signal functions: - count :: Signal a -> Signal Int - keepIf :: (a -> Bool) -> a -> Signal a -> Signal a - dropIf :: (a -> Bool) -> a -> Signal a -> Signal a - keepWhen :: Signal Bool -> a -> Signal a -> Signal a - dropWhen :: Signal Bool -> a -> Signal a -> Signal a - dropRepeats :: Signal a -> Signal a - sampleOn :: Signal a -> Signal b -> Signal b - clicks :: Signal () - The keep and drop functions make it possible to filter events, which - was not possible in prior releases. More documentation: - http://elm-lang.org/docs/Signal/Signal.elm - -* Add examples of JS event interface and new signal functions: - https://github.com/evancz/Elm/tree/master/Examples/elm-js - -* Use more compressed format for strings. Should make strings 10-12 times - more space efficient than in previous releases. Anecdotal evidence: - Elm's home page is now 70% of its previous size. - -* Add new function to Data.List: - last :: [a] -> a - -* Fix parenthesization bug with binary operators. - - - -Release 0.3.0 -============= - -Major Changes (Read this part!) -------------------------------- - -* Add a basic module system. -* Elm's JavaScript runtime is now distributed with the elm package. - Previously it was available for download as an unversioned JavaScript - file (elm-mini.js). It is now installed with the elm compiler as - elm-runtime-0.3.0.js. Be sure to serve the Elm runtime system that matches - the version of the compiler used to generate JavaScript. When working - locally, the compiler will automatically use your local copy of this file. -* BREAKING CHANGE: rgb and rgba (in the color module) now take their red, - green, and blue components as integers between 0 and 255 inclusive. -* Improve error messages for parse errors and runtime errors. - - -New Functions and Other Additions ---------------------------------- - -* Add support for keyboard events: Keyboard.Raw -* Add buttons in Signal.Input: - button :: String -> (Element, Signal Bool) -* Add new basic element (an empty rectangle, good for adding spaces): - rectangle :: Int -> Int -> Element -* Add (an awkwardly named) way to display right justified text: rightedText -* Add two basic libraries: Data.Char and Data.Maybe -* Add some new colors: magenta, yellow, cyan, gray, grey -* Add functions to Data.List module: take, drop -* Add functions to Prelude (the default imports): - fst, snd, curry, uncurry, and a bunch of list functions -* Add --make, --separate-js, and --only-js flags to help compile - with the new module system. ++Release 0.7.2+=============++* Add a WebSockets library.+* Add support for the mathematical looking operator for function composition (U+2218).+++forgot to fill this in for a while...+++Release 0.5.0+=============++* Add Dict, Set, and Automaton libraries!++* Add (,,) notation for creating tuples.++* Redo HTTP library, allowing any kind of request and more flexibility.++* Remove the library prefixes `Data.`, `Graphics.`, and `Signal.` because+ they were more confusing than helpful.++* Better type error reporting for ambiguous uses of variables and for+ variables in aliased modules.++* Add `readInt` and `readFloat` functions.+* Add `complement` function to compute complementary colors.+* Ensure that `String` is treated as an alias of `[Char]`.++* Fix bug in pattern parsing. `A B _ _` was parsed as `A (B _ _)`.+* Make pattern matching a bit more compact in generated code.+* Make generated JS more readable.++* The Haskell API exports the absolute path to the Elm runtime+ system (with the corresponding version number). This makes it easier+ to run Elm programs with less setup.++++Release 0.4.0+=============++This version is all about graphics: nicer API with more features and major+efficiency improvements. I am really excited about this release!++* Add native Markdown support. You can now embed markdown directly in .elm files+ and it is used as an `Element`. Syntax is `[markdown| ... |]` where `...` is+ formatted as described [here](http://daringfireball.net/projects/markdown/).+ Content can span multiple lines too.++* Drastically improve the `collage` interface. You can now move, rotate, and scale+ the following forms:+ - Elements (any Element you want can be turned into a Form with `toForm`)+ - Images+ - Shapes (shapes can be textured now too)+ - Lines+ This will make it way easier to make games in Elm. Games can now include text,+ gifs, videos, and any other Element you can think of.++* Add `--minify` flag, to minify JS code.++* Significantly improve performance of pattern matching.++* Compiler performs beta-reduction in some simple cases.++* The rendering section of the Elm runtume-system (RTS) has been totally rewritten,+ making screen refreshes use fewer cycles, less memory, and cause less garbage-collection.++++Release 0.3.6+=============++* Add JSON library.++* Type-error messages improved. Gives better context for error, making them+ easier to find. Better messages for runtime errors as well (errors that+ the type checker cannot find yet).++* Add Comparable super-type which allows the comparision of any values+ of type {Int,Float,Char,String}. Now possible to make Set and Map libraries.++* Parser now handles decimal numbers.++* Added many new functions for manipulating numbers:+ - truncate, round, floor, ceiling :: Float -> Int+ - toFloat :: Int -> Float+ - (^) :: Number -> Number -> Number+ - e :: Float++* Foreign import/export statements no longer have to preceed all other+ variable and datatype definitions. They can be mixed in, making things+ a bit more readable/natural.++* Bug fixes:+ - The `toText` function did not escape strings properly+ - Correct `castJSTupleToTupleN` family of functions+ - `foldr1` took the leftmost element as the base case instead of the rightmost+ - Fix minor display issue in latest version of Chrome.+ - Fix behavior of [ lo .. hi ] syntax (now [4..0] == [], not [0]).++++Release 0.3.5+=============++* Add JavaScript event interface. Allows Elm to import and export JS values+ and events. This makes it possible to import and export Elements, so users+ can use JS techniques and libraries if necessary. Conversion between JS+ and Elm values happens with functions from here:+ http://localhost:8000/docs/Foreign/JavaScript.elm+ http://localhost:8000/docs/Foreign/JavaScript/Experimental.elm++* Add new flags to help with JavaScript event interface.++* Add three built-in event listeners (elm_title, elm_log, elm_redirect) that+ make it possible to make some common/simple imperative actions without+ having to worry about writing the JS yourself. For example:+ foreign export jsevent "elm_title"+ title :: Signal JSString+ will update the page's title to the current value of the title signal.+ Empty strings are ignored. "elm_redirect" and "elm_log" events work much+ the same way, except that "elm_log" does not skip empty strings.++* Add new Signal functions:+ count :: Signal a -> Signal Int+ keepIf :: (a -> Bool) -> a -> Signal a -> Signal a+ dropIf :: (a -> Bool) -> a -> Signal a -> Signal a+ keepWhen :: Signal Bool -> a -> Signal a -> Signal a+ dropWhen :: Signal Bool -> a -> Signal a -> Signal a+ dropRepeats :: Signal a -> Signal a+ sampleOn :: Signal a -> Signal b -> Signal b+ clicks :: Signal ()+ The keep and drop functions make it possible to filter events, which+ was not possible in prior releases. More documentation:+ http://elm-lang.org/docs/Signal/Signal.elm++* Add examples of JS event interface and new signal functions:+ https://github.com/evancz/Elm/tree/master/Examples/elm-js++* Use more compressed format for strings. Should make strings 10-12 times+ more space efficient than in previous releases. Anecdotal evidence:+ Elm's home page is now 70% of its previous size.++* Add new function to Data.List:+ last :: [a] -> a++* Fix parenthesization bug with binary operators.++++Release 0.3.0+=============++Major Changes (Read this part!)+-------------------------------++* Add a basic module system.+* Elm's JavaScript runtime is now distributed with the elm package.+ Previously it was available for download as an unversioned JavaScript+ file (elm-mini.js). It is now installed with the elm compiler as+ elm-runtime-0.3.0.js. Be sure to serve the Elm runtime system that matches+ the version of the compiler used to generate JavaScript. When working+ locally, the compiler will automatically use your local copy of this file.+* BREAKING CHANGE: rgb and rgba (in the color module) now take their red,+ green, and blue components as integers between 0 and 255 inclusive.+* Improve error messages for parse errors and runtime errors.+++New Functions and Other Additions+---------------------------------++* Add support for keyboard events: Keyboard.Raw+* Add buttons in Signal.Input:+ button :: String -> (Element, Signal Bool)+* Add new basic element (an empty rectangle, good for adding spaces):+ rectangle :: Int -> Int -> Element+* Add (an awkwardly named) way to display right justified text: rightedText+* Add two basic libraries: Data.Char and Data.Maybe+* Add some new colors: magenta, yellow, cyan, gray, grey+* Add functions to Data.List module: take, drop+* Add functions to Prelude (the default imports):+ fst, snd, curry, uncurry, and a bunch of list functions+* Add --make, --separate-js, and --only-js flags to help compile+ with the new module system.
+ compiler/Compiler.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE DeriveDataTypeable #-}+module Main where++import Data.Either (lefts, rights)+import Data.List (intersect, intercalate,lookup)+import Data.Maybe (fromMaybe)+import Data.Version (showVersion)+import System.Console.CmdArgs+import System.Exit+import System.FilePath+import Text.Blaze.Html.Renderer.String (renderHtml)++import qualified Text.Jasmine as JS+import qualified Data.ByteString.Lazy.Char8 as BS++import Ast+import Initialize+import CompileToJS+import GenerateHtml+import qualified Libraries as Libraries+import Paths_Elm++data ELM =+ ELM { make :: Bool+ , files :: [FilePath]+ , runtime :: Maybe FilePath+ , separate_js :: Bool+ , only_js :: Bool+ , import_js :: [FilePath]+ , no_prelude :: Bool+ , noscript :: Bool+ , minify :: Bool+ , output_directory :: Maybe FilePath+ }+ deriving (Data,Typeable,Show,Eq)++elm = ELM { make = False &= help "automatically compile dependencies."+ , files = def &= args &= typ "FILES"+ , runtime = Nothing &= typFile &=+ help "Specify a custom location for Elm's runtime system."+ , separate_js = False &= help "Compile to separate HTML and JS files."+ , only_js = False &= help "Compile only to JavaScript."+ , import_js = [] &= typFile &= help "Include a JavaScript file before the body of the Elm program. Can be used many times. Files will be included in the given order."+ , no_prelude = False &= help "Do not import Prelude by default, used only when compiling standard libraries."+ , noscript = True &= help "Add generated <noscript> tag to HTML output."+ , minify = False &= help "Minify generated JavaScript"+ , output_directory = Nothing &= typFile &= help "Output files to directory specified. Defaults to the location of original file."+ } &=+ help "Compile Elm programs to HTML, CSS, and JavaScript." &=+ summary ("The Elm Compiler " ++ showVersion version ++ ", (c) Evan Czaplicki")++main = do+ args <- cmdArgs elm+ mini <- getDataFileName "elm-runtime.js"+ compileArgs mini args++compileArgs mini flags =+ case files flags of+ [] -> putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"+ fs -> mapM_ (fileTo flags what loc) fs+ where loc = fromMaybe mini (runtime flags)+ what | only_js flags = JS+ | separate_js flags = Split+ | otherwise = HTML++data What = JS | HTML | Split++fileTo flags what rtLoc file = do+ let jsStyle = if minify flags then Minified else Readable+ formatJS = if minify flags then BS.unpack . JS.minify . BS.pack else id+ prelude = not (no_prelude flags)+ ems <- if make flags then build prelude file+ else do src <- readFile file+ return (fmap (:[]) (buildFromSource prelude src))+ jss <- concat `fmap` mapM readFile (import_js flags)+ case ems of+ Left err -> do putStrLn $ "Error while compiling " ++ file ++ ":\n" ++ err+ exitFailure+ Right ms' ->+ let path = fromMaybe "" (output_directory flags) </> file+ js = replaceExtension path ".js"+ html = replaceExtension path ".html"+ ms = if no_prelude flags then ms' else map Libraries.addPrelude ms'+ txt = jss ++ concatMap jsModule ms+ in case what of+ JS -> writeFile js (formatJS txt)+ HTML -> writeFile html . renderHtml $+ modulesToHtml jsStyle "" rtLoc jss (noscript flags) ms+ Split ->+ do writeFile html . renderHtml $ linkedHtml rtLoc js ms+ writeFile js (formatJS txt)
+ compiler/Docs.hs view
@@ -0,0 +1,65 @@++module Main where++import Ast+import Control.Applicative ((<$>), (<*>))+import Data.List (intercalate)+import Data.Maybe (catMaybes)+import Parse.Library+import Parse.Modules (moduleDef)+import Text.Parsec hiding (newline,spaces)+import System.Environment+import System.Exit+++main = do+ srcs <- mapM readFile =<< getArgs+ case mapM docParse srcs of+ Left err -> putStrLn err >> exitFailure+ Right ms -> putStrLn (toModules ms)++toModules ms = wrap (intercalate ",\n " (map toModule ms))+ where wrap s = "{ \"modules\" : [\n " ++ s ++ "\n ]\n}"++toModule (name, values) =+ "{ \"name\" : " ++ show name ++ ",\n " +++ "\"values\" : [\n " ++ vs ++ "\n ]\n }"+ where vs = intercalate ",\n " (map toValue values)++toValue (name, tipe, desc) =+ "{ \"name\" : " ++ show name +++ ",\n \"type\" : " ++ show tipe +++ ",\n \"desc\" : " ++ show desc ++ "\n }"++docParse :: String -> Either String (String, [(String, String, String)])+docParse = setupParser $ do+ optional freshLine+ (names, exports) <- option (["Main"],[]) moduleDef+ info <- many (annotation exports <|> try skip <|> end)+ return (intercalate "." names, catMaybes info)+ where+ skip = manyTill anyChar simpleNewline >> return Nothing+ end = many1 anyChar >> return Nothing++annotation :: [String] -> IParser (Maybe (String, String, String))+annotation exports =+ try ((\c n t -> export (n,t,c)) <$> comment <*> (try adt <|> name) <*> tipe)+ where+ comment = concatMap clip <$> many lineComment+ clip str = case str of { ' ':rest -> rest ; _ -> str } ++ "\n"++ name = do v <- lowVar <|> parens symOp+ whitespace ; hasType ; whitespace ; return v++ tipe = manyTill anyChar (try (simpleNewline >> notFollowedBy (string " ")))++ export info@(name,_,_) =+ if null exports || name `elem` exports then Just info else Nothing++ adt = lookAhead ((string "data" <|> string "type") >> whitespace >> capVar)+++setupParser p source =+ case iParse p "" source of+ Right result -> Right result+ Left err -> Left $ "Parse error at " ++ show err
+ compiler/Gen/Cases.hs view
@@ -0,0 +1,87 @@++module Cases (caseToMatch, Match (..), Clause (..), matchSubst) where++import Control.Arrow (first)+import Control.Monad (liftM,foldM)+import Data.List (groupBy,sortBy,lookup)+import Data.Maybe (fromMaybe)++import Ast+import Context+import Guid+import Substitute++caseToMatch patterns = do+ v <- newVar+ match [v] (map (first (:[])) patterns) Fail++newVar = do n <- guid+ return $ "case" ++ show n++data Match = Match String [Clause] Match+ | Break+ | Fail+ | Other CExpr+ | Seq [Match]+ deriving Show++data Clause = Clause String [String] Match+ deriving Show++matchSubst :: [(String,String)] -> Match -> Match+matchSubst _ Break = Break+matchSubst _ Fail = Fail+matchSubst pairs (Seq ms) = Seq (map (matchSubst pairs) ms)+matchSubst pairs (Other (C t s e)) =+ Other . C t s $ foldr ($) e $ map (\(x,y) -> subst x (Var y)) pairs+matchSubst pairs (Match n cs m) =+ Match (varSubst n) (map clauseSubst cs) (matchSubst pairs m)+ where varSubst v = fromMaybe v (lookup v pairs)+ clauseSubst (Clause c vs m) =+ Clause c (map varSubst vs) (matchSubst pairs m)++isCon (PData _ _ : _, _) = True+isCon _ = False++isVar p = not (isCon p)++match :: [String] -> [([Pattern],CExpr)] -> Match -> GuidCounter Match+match [] [] def = return def+match [] [([],e)] Fail = return $ Other e+match [] [([],e)] Break = return $ Other e+match [] cs def = return $ Seq (map (Other . snd) cs ++ [def])+match vs cs def+ | all isVar cs = matchVar vs cs def+ | all isCon cs = matchCon vs cs def+ | otherwise = matchMix vs cs def++matchVar :: [String] -> [([Pattern],CExpr)] -> Match -> GuidCounter Match+matchVar (v:vs) cs def = match vs (map subVar cs) def+ where+ subVar (p:ps, ce@(C t s e)) =+ let ctx = C t s in+ (ps, case p of+ PVar x -> C t s $ subst x (Var v) e+ PAnything -> ce+ PRecord fs ->+ ctx $ foldr (\x -> subst x (Access (ctx (Var v)) x)) e fs+ )++matchCon :: [String] -> [([Pattern],CExpr)] -> Match -> GuidCounter Match+matchCon (v:vs) cs def = (flip (Match v) def) `liftM` mapM toClause css+ where css = groupBy (withName (==)) $ sortBy (withName compare) cs+ withName f (PData n1 _:_,_) (PData n2 _:_,_) = f n1 n2+ toClause cs = let (PData name _ : _ , _) = head cs in+ matchClause name (v:vs) cs Break++matchClause :: String -> [String] -> [([Pattern],CExpr)] -> Match -> GuidCounter Clause+matchClause c (v:vs) cs def =+ do vs' <- getVars+ Clause c vs' `liftM` match (vs' ++ vs) (map flatten cs) def+ where flatten (PData _ ps' : ps, e) = (ps' ++ ps, e)+ getVars = let (PData _ ps : _, _) = head cs in+ mapM (\_ -> newVar) ps++matchMix :: [String] -> [([Pattern],CExpr)] -> Match -> GuidCounter Match+matchMix vs cs def = foldM (flip $ match vs) def (reverse css)+ where css = groupBy (\p1 p2 -> isCon p1 == isCon p2) cs
+ compiler/Gen/CompileToJS.hs view
@@ -0,0 +1,338 @@+module CompileToJS (showErr, jsModule) where++import Control.Arrow (first,second)+import Control.Monad (liftM,(<=<),join,ap)+import Data.Char (isAlpha,isDigit)+import Data.List (intercalate,sortBy,inits,foldl')+import qualified Data.Map as Map+import Data.Either (partitionEithers)+import qualified Text.Pandoc as Pan++import Ast+import Context+import Rename (derename)+import Cases+import Guid+import Rename (deprime)+import Types.Types ( Type(RecordT) )++showErr :: String -> String+showErr err = globalAssign "Elm.Main" (jsFunc "elm" body)+ where msg = show . concatMap (++"<br>") . lines $ err+ body = "var T = Elm.Text(elm);\n\+ \return { main : T.text(T.monospace(" ++ msg ++ ")) };"++indent = concatMap f+ where f '\n' = "\n "+ f c = [c]++internalImports =+ [ ("N" , "Elm.Native"),+ ("_N", "N.Utils(elm)"),+ ("_L", "N.List(elm)"),+ ("_E", "N.Error(elm)"),+ ("_str", "N.JavaScript(elm).toString")+ ]++parens s = "(" ++ s ++ ")"+brackets s = "{" ++ s ++ "}"+jsObj = brackets . intercalate ", "+jsList ss = "["++ intercalate "," ss ++"]"+jsFunc args body = "function(" ++ args ++ "){" ++ indent body ++ "}"+assign x e = "\nvar " ++ x ++ " = " ++ e ++ ";"+ret e = "\nreturn "++ e ++";"+iff a b c = a ++ "?" ++ b ++ ":" ++ c+quoted s = "'" ++ concatMap f s ++ "'"+ where f '\n' = "\\n"+ f '\'' = "\\'"+ f '\t' = "\\t"+ f '\"' = "\\\""+ f '\\' = "\\\\"+ f c = [c]++globalAssign n e = "\n" ++ assign' n e ++ ";"+assign' n e = n ++ " = " ++ e++jsModule (Module names exports imports stmts) =+ setup ("Elm":modNames) ++ globalAssign ("Elm." ++ modName) (jsFunc "elm" program)+ where+ modNames = if null names then ["Main"] else names+ modName = intercalate "." modNames+ includes = concatMap jsImport imports+ body = stmtsToJS stmts+ defs = assign "$op" "{}"+ program = "\nvar " ++ usefulFuncs ++ ";" ++ defs ++ includes ++ body +++ setup ("elm":"Native":modNames) +++ assign "_" ("elm.Native." ++ modName ++ "||{}") +++ getExports exports stmts ++ setup ("elm":modNames) +++ ret (assign' ("elm." ++ modName) "_") ++ "\n"+ setup modNames = concatMap (\n -> globalAssign n $ n ++ "||{}") .+ map (intercalate ".") . drop 2 . inits $ init modNames+ usefulFuncs = intercalate ", " (map (uncurry assign') internalImports)++getExports names stmts = "\n"++ intercalate ";\n" (op : map fnPair fns)+ where exNames n = either derename id n `elem` names+ exports | null names = concatMap get stmts+ | otherwise = filter exNames (concatMap get stmts)++ (fns,ops) = partitionEithers exports++ opPair op = "'" ++ op ++ "' : $op['" ++ op ++ "']"+ fnPair fn = let fn' = derename fn in "_." ++ fn' ++ " = " ++ fn++ op = ("_.$op = "++) . jsObj $ map opPair ops++ get' (FnDef x _ _) = Left x+ get' (OpDef op _ _ _) = Right op+ get s = case s of Definition d -> [ get' d ]+ Datatype _ _ tcs -> map (Left . fst) tcs+ ImportEvent _ _ x _ -> [ Left x ]+ ExportEvent _ _ _ -> []+ TypeAlias _ _ _ -> []+ TypeAnnotation _ _ -> []+++jsImport (modul, how) =+ case how of+ As name -> assign name ("Elm." ++ modul ++ parens "elm")+ Hiding vs -> include ++ " var hiding=" ++ (jsObj $ map (++":1") vs) +++ "; for(var k in _){if(k in hiding)continue;" +++ "eval('var '+k+'=_[\"'+k+'\"]')}"+ Importing vs -> include ++ named+ where + imprt v = assign' v ("_." ++ v)+ def (o:p) = imprt (if isOp o then "$op['" ++ o:p ++ "']" else deprime (o:p))+ named = if null vs then "" else "\nvar " ++ intercalate ", " (map def vs) ++ ";"+ where+ include = "\nvar _ = Elm." ++ modul ++ parens "elm" ++ ";" ++ setup modul+ setup moduleName = " var " ++ concatMap (++";") (defs ++ [assign' moduleName "_"])+ where+ defs = map (\n -> assign' n (n ++ "||{}")) (subnames moduleName)+ subnames = map (intercalate ".") . tail . inits . init . split+ split names = case go [] names of+ (name, []) -> [name]+ (name, ns) -> name : split ns+ go name str = case str of+ '.':rest -> (reverse name, rest)+ c:rest -> go (c:name) rest+ [] -> (reverse name, [])++++stmtsToJS :: [Statement] -> String+stmtsToJS stmts = run $ do program <- mapM toJS (sortBy cmpStmt stmts)+ return (concat program)+ where+ cmpStmt s1 s2 = compare (valueOf s1) (valueOf s2)+ valueOf s = case s of+ Datatype _ _ _ -> 1+ ImportEvent _ _ _ _ -> 2+ Definition (FnDef f [] _) ->+ if derename f == "main" then 5 else 4+ Definition _ -> 3+ ExportEvent _ _ _ -> 6+ TypeAlias _ _ _ -> 0+ TypeAnnotation _ _ -> 0++class ToJS a where+ toJS :: a -> GuidCounter String++instance ToJS Def where+ toJS (FnDef x [] e) = assign x `liftM` toJS' e+ toJS (FnDef f as e) = (assign f . wrapper . func) `liftM` toJS' e+ where+ func body = jsFunc (intercalate ", " as) (ret body)+ wrapper e | length as == 1 = e+ | otherwise = 'F' : show (length as) ++ parens e+ toJS (OpDef op a1 a2 e) =+ do body <- toJS' e + let func = "F2" ++ parens (jsFunc (a1 ++ ", " ++ a2) (ret body))+ return (globalAssign ("$op['" ++ op ++ "']") func)++instance ToJS Statement where+ toJS stmt =+ case stmt of+ Definition d -> toJS d+ Datatype _ _ tcs -> concat `liftM` mapM (toJS . toDef) tcs+ where toDef (name,args) =+ let vars = map (('a':) . show) [1..length args] in+ Definition . FnDef name vars . noContext $+ Data (derename name) (map (noContext . Var) vars)+ ImportEvent js base elm _ ->+ do v <- toJS' base+ return $ concat [ "\nvar " ++ elm ++ "=Elm.Signal(elm).constant(" ++ v ++ ");"+ , "\ndocument.addEventListener('", js+ , "_' + elm.id, function(e) { elm.notify(", elm+ , ".id, e.value); });" ]+ ExportEvent js elm _ ->+ return $ concat [ "\nlift(function(v) { "+ , "var e = document.createEvent('Event');"+ , "e.initEvent('", js, "_' + elm.id, true, true);"+ , "e.value = v;"+ , "document.dispatchEvent(e); return v; })(", elm, ");" ]+ TypeAnnotation _ _ -> return ""+ TypeAlias n _ t -> return ""++toJS' :: CExpr -> GuidCounter String+toJS' (C txt span expr) =+ case expr of+ MultiIf ps -> multiIfToJS span ps+ Case e cases -> caseToJS span e cases+ _ -> toJS expr++remove x e = "_N.remove('" ++ x ++ "', " ++ e ++ ")"+addField x v e = "_N.insert('" ++ x ++ "', " ++ v ++ ", " ++ e ++ ")"+setField fs e = "_N.replace(" ++ jsList (map f fs) ++ ", " ++ e ++ ")"+ where f (x,v) = "['" ++ x ++ "'," ++ v ++ "]"+access x e = e ++ "." ++ x+makeRecord kvs = record `liftM` collect kvs+ where+ combine r (k,v) = Map.insertWith (++) k v r+ collect = liftM (foldl' combine Map.empty) . mapM prep+ prep (k, as, e@(C t s _)) =+ do v <- toJS' (foldr (\x e -> C t s $ Lambda x e) e as)+ return (k,[v])+ fields fs =+ brackets ("\n "++intercalate ",\n " (map (\(k,v) -> k++":"++v) fs))+ hidden = fields . map (second jsList) .+ filter (not . null . snd) . Map.toList . Map.map tail+ record kvs = fields . (("_", hidden kvs) :) . Map.toList . Map.map head $ kvs+++instance ToJS Expr where+ toJS expr =+ case expr of+ Var x -> return $ x+ Chr c -> return $ quoted [c]+ Str s -> return $ "_str" ++ parens (quoted s)+ IntNum n -> return $ show n+ FloatNum n -> return $ show n+ Boolean b -> return $ if b then "true" else "false"+ Range lo hi -> jsRange `liftM` toJS' lo `ap` toJS' hi+ Access e x -> access x `liftM` toJS' e+ Remove e x -> remove x `liftM` toJS' e+ Insert e x v -> addField x `liftM` toJS' v `ap` toJS' e+ Modify e fs -> do fs' <- (mapM (\(x,v) -> (,) x `liftM` toJS' v) fs)+ setField fs' `liftM` toJS' e+ Record fs -> makeRecord fs+ Binop op e1 e2 -> binop op `liftM` toJS' e1 `ap` toJS' e2++ If eb et ef ->+ parens `liftM` (iff `liftM` toJS' eb `ap` toJS' et `ap` toJS' ef)++ Lambda v e -> liftM (jsFunc v . ret) (toJS' e)++ App e1 e2 -> jsApp e1 e2+ Let defs e -> jsLet defs e+ Data name es ->+ do fs <- mapM toJS' es+ return $ case name of+ "Nil" -> jsNil+ "Cons" -> jsCons (head fs) ((head . tail) fs)+ _ -> jsObj $ ("ctor:" ++ show name) : fields+ where fields = zipWith (\n e -> "_" ++ show n ++ ":" ++ e) [0..] fs++ Markdown doc -> return $ "text('" ++ pad ++ md ++ pad ++ "')"+ where pad = "<div style=\"height:0;width:0;\"> </div>"+ md = formatMarkdown $ Pan.writeHtmlString Pan.def doc++jsApp e1 e2 =+ do f <- toJS' func+ as <- mapM toJS' args+ return $ case as of+ [a] -> f ++ parens a+ _ -> "A" ++ show (length as) ++ parens (intercalate ", " (f:as))+ where+ (func, args) = go [e2] e1+ go args e =+ case e of+ (C _ _ (App e1 e2)) -> go (e2 : args) e1+ _ -> (e, args)++formatMarkdown = concatMap f+ where f '\'' = "\\'"+ f '\n' = "\\n"+ f '"' = "\""+ f c = [c]++multiIfToJS span ps =+ case last ps of+ (C _ _ (Var "otherwise"), e) -> toJS' e >>= \b -> format b (init ps)+ _ -> format ("_E.If" ++ parens (quoted (show span))) ps+ where+ format base ps =+ foldr (\c e -> parens $ c ++ " : " ++ e) base `liftM` mapM f ps+ f (b,e) = do b' <- toJS' b+ e' <- toJS' e+ return (b' ++ " ? " ++ e')++jsLet defs e' = do ds <- jsDefs defs+ e <- toJS' e'+ return $ jsFunc "" (concat ds ++ ret e) ++ "()"+ where + jsDefs defs = mapM toJS (sortBy f defs)+ f a b = compare (valueOf a) (valueOf b)+ valueOf (FnDef _ args _) = min 1 (length args)+ valueOf (OpDef _ _ _ _) = 1++caseToJS span e ps = do+ match <- caseToMatch ps+ e' <- toJS' e+ let (match',stmt) = case (match,e) of+ (Match name _ _, C _ _ (Var x)) -> (matchSubst [(name,x)] match, "")+ (Match name _ _, _) -> (match, assign name e')+ _ -> (match, "")+ matches <- matchToJS span match'+ return $ "function(){ " ++ stmt ++ matches ++ " }()"++matchToJS span match =+ case match of+ Match name clauses def ->+ do cases <- concat `liftM` mapM (clauseToJS span name) clauses+ finally <- matchToJS span def+ return $ concat [ "\nswitch (", name, ".ctor) {",+ indent cases, "\n}", finally ]+ Fail -> return ("_E.Case" ++ parens (quoted (show span)))+ Break -> return "break;"+ Other e -> ret `liftM` toJS' e+ Seq ms -> concat `liftM` mapM (matchToJS span) (dropEnd [] ms)+ where+ dropEnd acc [] = acc+ dropEnd acc (m:ms) =+ case m of+ Other _ -> acc ++ [m]+ _ -> dropEnd (acc ++ [m]) ms++clauseToJS span var (Clause name vars e) = do+ let vars' = map (\n -> var ++ "._" ++ show n) [0..]+ s <- matchToJS span $ matchSubst (zip vars vars') e+ return $ concat [ "\ncase ", quoted name, ":", indent s ]++jsNil = "_L.Nil"+jsCons e1 e2 = "_L.Cons(" ++ e1 ++ "," ++ e2 ++ ")"+jsRange e1 e2 = "_L.range" ++ parens (e1 ++ "," ++ e2)+jsCompare e1 e2 op = parens ("_N.cmp(" ++ e1 ++ "," ++ e2 ++ ").ctor" ++ op)++binop (o:p) e1 e2+ | isAlpha o || '_' == o = (o:p) ++ parens e1 ++ parens e2+ | otherwise =+ let ops = ["+","-","*","/","&&","||"] in+ case o:p of+ "::" -> jsCons e1 e2+ "++" -> "_L.append" ++ parens (e1 ++ "," ++ e2)+ "$" -> e1 ++ parens e2+ "<|" -> e1 ++ parens e2+ "|>" -> e2 ++ parens e1+ "." -> jsFunc "x" . ret $ e1 ++ parens (e2 ++ parens "x")+ "^" -> "Math.pow(" ++ e1 ++ "," ++ e2 ++ ")"+ "==" -> "_N.eq(" ++ e1 ++ "," ++ e2 ++ ")"+ "/=" -> "!_N.eq(" ++ e1 ++ "," ++ e2 ++ ")"+ "<" -> jsCompare e1 e2 "==='LT'"+ ">" -> jsCompare e1 e2 "==='GT'"+ "<=" -> jsCompare e1 e2 "!=='GT'"+ ">=" -> jsCompare e1 e2 "!=='LT'"+ "<~" -> "A2(lift," ++ e1 ++ "," ++ e2 ++ ")"+ "~" -> "A3(lift2,F2(function(f,x){return f(x)}),"++e1++","++e2++")"+ _ | elem (o:p) ops -> parens (e1 ++ (o:p) ++ e2)+ | otherwise -> concat [ "$op['", o:p, "']"+ , parens e1, parens e2 ]
+ compiler/Gen/ExtractNoscript.hs view
@@ -0,0 +1,59 @@++module ExtractNoscript (extractNoscript) where++import Ast+import Context+import qualified Text.Pandoc as Pan++extractNoscript :: Module -> String+extractNoscript modul = concat (extract modul)++class Extract a where+ extract :: a -> [String]++instance Extract Module where+ extract (Module _ _ _ stmts) =+ map (\s -> "<p>" ++ s ++ "</p>") (concatMap extract stmts)++instance Extract Statement where+ extract (Definition d) = extract d+ extract _ = []++instance Extract Def where+ extract (FnDef _ _ e) = extract e+ extract (OpDef _ _ _ e) = extract e++instance Extract e => Extract (Context e) where+ extract (C _ _ e) = extract e++instance Extract Expr where+ extract expr =+ let f = extract in+ case expr of+ Str s -> [s]+ Binop op e1 e2 -> case (op, f e1, f e2) of+ ("++", [s1], [s2]) -> [s1 ++ s2]+ (_ , ss1 , ss2 ) -> ss1 ++ ss2+ Lambda v e -> f e+ App (C _ _ (App (C _ _ (Var "link")) src)) txt -> linkExtract src txt+ App (C _ _ (App (C _ _ (Var "Text.link")) src)) txt -> linkExtract src txt+ App (C _ _ (Var "header")) e -> tag "h1" e+ App (C _ _ (Var "bold")) e -> tag "b" e+ App (C _ _ (Var "italic")) e -> tag "i" e+ App (C _ _ (Var "monospace")) e -> tag "code" e+ App e1 e2 -> f e1 ++ f e2+ If eb et ef -> f et ++ f ef+ Let defs e -> concatMap extract defs ++ f e+ Var _ -> []+ Case e cases -> concatMap (f . snd) cases+ Data _ es -> concatMap f es+ Markdown doc -> [ Pan.writeHtmlString Pan.def doc ]+ _ -> []++linkExtract src txt =+ case (extract src, extract txt) of+ ([s1],[s2]) -> [ "<a href=\"" ++ s1 ++ "\">" ++ s2 ++ "</a>" ]+ ( ss1, ss2) -> ss1 ++ ss2+++tag t e = map (\s -> concat [ "<", t, ">", s, "</", t, ">" ]) (extract e)
+ compiler/Gen/GenerateHtml.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE OverloadedStrings #-}+module GenerateHtml (generateHtml,+ modulesToHtml, linkedHtml,+ JSStyle (..)+ ) where++import Data.List (intercalate)+import Text.Blaze (preEscapedToMarkup)+import Text.Blaze.Html (Html)+import qualified Text.Blaze.Html5 as H+import Text.Blaze.Html5 ((!))+import qualified Text.Blaze.Html5.Attributes as A++import Text.Jasmine (minify)+import qualified Data.ByteString.Lazy.Char8 as BS++import Ast+import Initialize (buildFromSource)+import CompileToJS+import ExtractNoscript+import Libraries as Libraries++data JSStyle = Minified | Readable++makeScript :: JSStyle -> Either String String -> H.Html+makeScript _ (Left s) =+ H.script ! A.type_ "text/javascript" ! A.src (H.toValue s) $ ""+makeScript jsStyle (Right s) =+ H.script ! A.type_ "text/javascript" $ preEscapedToMarkup content+ where content = case jsStyle of + Minified -> BS.unpack . minify . BS.pack $ s+ Readable -> s++-- |This function compiles Elm code into simple HTML.+--+-- Usage example:+--+-- > generateHtml "/elm-min.js" "Some title" [elmFile|elm-source/somePage.elm|]+generateHtml :: String -- ^ Location of elm-runtime.js as expected by the browser+ -> String -- ^ The page title+ -> String -- ^ The elm source code.+ -> Html+generateHtml libLoc title source =+ case buildFromSource True source of+ Right modul -> modulesToHtml Readable title libLoc [] True [modul]+ Left err -> createHtml Readable libLoc title (Right $ showErr err)+ (H.noscript "") "Main"+++modulesToHtml jsStyle title libLoc jss nscrpt modules =+ createHtml jsStyle libLoc title' js noscript altTitle+ where+ js = Right $ jss ++ concatMap jsModule modules+ noscript = if nscrpt then extractNoscript $ last modules else ""+ title' = if null title then altTitle else title+ altTitle = intercalate "." names+ where Module names _ _ _ = last modules+ ++linkedHtml rtLoc jsLoc modules =+ createHtml Readable rtLoc title (Left jsLoc) (H.noscript "") title+ where+ title = (\(Module names _ _ _) -> intercalate "." names) (last modules)+++createHtml jsStyle libLoc title js noscript moduleToLoad =+ H.docTypeHtml $ do + H.head $ do+ H.meta ! A.charset "UTF-8"+ H.title . H.toHtml $ title+ makeScript Readable (Left libLoc)+ makeScript jsStyle js+ H.body $ do+ H.script ! A.type_ "text/javascript" $ preEscapedToMarkup ("Elm.fullscreen(Elm." ++ moduleToLoad ++ ")" :: String)+ H.noscript $ preEscapedToMarkup noscript
+ compiler/Initialize.hs view
@@ -0,0 +1,97 @@+module Initialize (build, buildFromSource) where++import Control.Applicative ((<$>))+import Control.Monad.Error+import Data.List (lookup,nub)+import qualified Data.Map as Map++import Ast+import Data.Either (lefts,rights)+import Data.List (intercalate,partition)+import Parse.Parser (parseProgram, preParse)+import Rename+import qualified Libraries as Libs+import Types.Types ((-:))+import Types.Hints (hints)+import Types.Unify+import Types.Alias (dealias, mistakes)+import Optimize+import CompileToJS (jsModule)++checkMistakes :: Module -> Either String Module+checkMistakes modul@(Module name ex im stmts) = + case mistakes stmts of+ m:ms -> Left (unlines (m:ms))+ [] -> return modul++checkTypes :: Module -> Either String Module+checkTypes modul =+ do subs <- unify hints modul+ subs `seq` return (optimize (renameModule modul))++check :: Module -> Either String Module+check = checkMistakes >=> checkTypes++buildFromSource :: Bool -> String -> Either String Module+buildFromSource withPrelude src = (check . add) =<< (parseProgram src)+ where add = if withPrelude then Libs.addPrelude else id++build :: Bool -> FilePath -> IO (Either String [Module])+build withPrelude root = do+ names <- getSortedModuleNames root+ case names of+ Left err -> return (Left err)+ Right ns -> do srcs <- zipWithM buildFile' [1..] ns+ return (sequence srcs)+ where+ buildFile' n name = putStrLn (msg n name) >> buildFile withPrelude name+ msg n name = "["++show n++" of "++show (length ns)++"] Compiling "++name++buildFile :: Bool -> String -> IO (Either String Module)+buildFile withPrelude moduleName =+ let filePath = toFilePath moduleName in+ case isNative moduleName of+ True -> return (Right $ Module [moduleName] [] [] [])+ --return (Left "Can't do that yet")+ --Right `liftM` readFile filePath+ False -> do txt <- readFile filePath+ return $ buildFromSource withPrelude txt+++getSortedModuleNames :: FilePath -> IO (Either String [String])+getSortedModuleNames root = do+ deps <- readDeps [] root+ return (sortDeps =<< deps)++type Deps = (String, [String])++sortDeps :: [Deps] -> Either String [String]+sortDeps deps = go [] (nub deps)+ where+ msg = "A cyclical or missing module dependency or was detected in: "++ go :: [String] -> [Deps] -> Either String [String]+ go sorted [] = Right sorted+ go sorted unsorted =+ case partition (all (`elem` sorted) . snd) unsorted of+ ([],m:ms) -> Left (msg ++ intercalate ", " (map fst (m:ms)) ++ show sorted ++ show unsorted)+ (srtd,unsrtd) -> go (sorted ++ map fst srtd) unsrtd++readDeps :: [FilePath] -> FilePath -> IO (Either String [Deps])+readDeps seen root = do+ txt <- readFile root+ case preParse txt of+ Left err -> return (Left err)+ Right (name,deps) -> do rest <- mapM (readDeps seen' . toFilePath) newDeps+ return $ do rs <- sequence rest+ return ((name, realDeps) : concat rs)+ where realDeps = filter (`notElem` builtIns) deps+ newDeps = filter (`notElem` seen) realDeps+ seen' = root : seen ++ newDeps+ builtIns = Map.keys Libs.libraries++isNative name = takeWhile (/='.') name == "Native"+toFilePath name = map swapDots name ++ ext+ where swapDots '.' = '/'+ swapDots c = c+ ext = if isNative name then ".js" else ".elm"
+ compiler/Language/Elm.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} +{- | This module exports the functions necessary for compiling Elm code into the + respective HTML, JS and CSS code. + + The type class @'ElmSource'@ requires an instance for all types that the Elm + compiler understands. The provided instances for String, Text and QuasiQuoted + Elm source code should be sufficient. + + The documentation for the Elm language is available at + <http://elm-lang.org/Documentation.elm>, and many interactive examples are + available at <http://elm-lang.org/Examples.elm> + + Example implementations using Yesod and Happstack are available + at <https://github.com/tazjin/Elm/tree/master/Examples> +-} +module Language.Elm ( + compile, toHtml, + moduleName, + runtime, docs + ) where + +import qualified Ast as Ast +import qualified Libraries as Libraries +import Data.List (intercalate) +import Data.Version (showVersion) +import CompileToJS (showErr, jsModule) +import ExtractNoscript +import GenerateHtml +import Initialize +import Text.Blaze.Html (Html) +import Paths_Elm + +-- |This function compiles Elm code to JavaScript. +compile :: String -> String +compile source = either showErr jsModule modul + where modul = buildFromSource True source + +-- |This function extracts the module name of a given source program. +moduleName :: String -> String +moduleName source = either (const "Main") getName modul + where modul = buildFromSource False source + getName (Ast.Module names _ _ _) = intercalate "." names + +-- |This function compiles Elm code into a full HTML page. +toHtml :: String -- ^ Location of elm-min.js as expected by the browser + -> String -- ^ The page title + -> String -- ^ The elm source code + -> Html +toHtml = generateHtml + +-- |The absolute path to Elm's runtime system. +runtime :: IO FilePath +runtime = getDataFileName "elm-runtime.js" + +-- |The absolute path to Elm's core library documentation. +docs :: IO FilePath +docs = getDataFileName "docs.json" +
+ compiler/Language/Elm/Quasi.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}++-- | This module contains Shakespearean (see "Text.Shakespeare") templates for Elm.+-- It introduces type-safe compile-time variable and URL interpolation. A typeclass+-- @'ToElm'@ is provided for interpolated variables.+--+-- Further reading on Shakespearean templates: <http://www.yesodweb.com/book/templates>+--+-- Further reading on Elm: <http://elm-lang.org> +module Language.Elm.Quasi+ ( -- * Functions+ -- ** Template-Reading Functions+ -- |These QuasiQuoters return functions of the type @(t -> 'Elm')@+ -- where @t@ is the URL rendering function if type-safe URLs are used.+ --+ -- A usage example for both type-safe (Yesod) and standard path segment (Happstack)+ -- URLs is provided in the Examples folder in the Git repository.+ elm+ , elmFile+ , elmFileReload++ -- * Datatypes+ , Elm (..)++ -- * Typeclass for interpolated variables+ , ToElm (..)++ -- ** Rendering Functions+ , renderElm++ ) where++import Language.Haskell.TH.Quote (QuasiQuoter (..))+import Language.Haskell.TH.Syntax+import Data.Text.Lazy.Builder (Builder, fromText, toLazyText, fromLazyText)+import Data.Monoid+import qualified Data.Text as TS+import qualified Data.Text.Lazy as TL+import Text.Shakespeare++-- | Render Elm to lazy Text.+renderElm :: Elm -> TL.Text+renderElm (Elm b) = toLazyText b++-- | Newtype wrapper of 'Builder'.+newtype Elm = Elm { unElm :: Builder }+ deriving Monoid++-- | A typeclass for types that can be interpolated in Elm templates.+class ToElm a where+ toElm :: a -> Builder+instance ToElm [Char] where toElm = fromLazyText . TL.pack+instance ToElm TS.Text where toElm = fromText+instance ToElm TL.Text where toElm = fromLazyText++elmSettings :: Q ShakespeareSettings+elmSettings = do+ toJExp <- [|toElm|]+ wrapExp <- [|Elm|]+ unWrapExp <- [|unElm|]+ return $ defaultShakespeareSettings { toBuilder = toJExp+ , wrap = wrapExp+ , unwrap = unWrapExp+ }++-- |QuasiQuoter for embedding Elm code inside of Haskell code.+--+-- Usage:+-- @[elm|main = plaintext \"Some elm code\"|]@+elm :: QuasiQuoter+elm = QuasiQuoter { quoteExp = \s -> do+ rs <- elmSettings+ quoteExp (shakespeare rs) s+ }++-- |A Template Haskell function for embedding Elm code from external+-- .elm files.+--+-- Usage:+-- @$(elmFile \"elm_source/index.elm\")@+elmFile :: FilePath -> Q Exp+elmFile fp = do+ rs <- elmSettings+ shakespeareFile rs fp++elmFileReload :: FilePath -> Q Exp+elmFileReload fp = do+ rs <- elmSettings+ shakespeareFileReload rs fp
+ compiler/Model/Ast.hs view
@@ -0,0 +1,153 @@++module Ast where++import Context+import Data.Char (isDigit, isSymbol)+import Data.List (intercalate)+import Types.Types+import qualified Text.Pandoc as Pandoc++data Module = Module [String] Exports Imports [Statement]++type Exports = [String]++type Imports = [(String, ImportMethod)]+data ImportMethod = As String | Importing [String] | Hiding [String]+ deriving (Eq, Ord, Show)+++data Pattern = PData String [Pattern]+ | PRecord [String]+ | PVar String+ | PAnything+ deriving (Eq)++type CExpr = Context Expr+data Expr = IntNum Int+ | FloatNum Float+ | Chr Char+ | Str String+ | Boolean Bool+ | Range CExpr CExpr+ | Access CExpr String+ | Remove CExpr String+ | Insert CExpr String CExpr+ | Modify CExpr [(String,CExpr)]+ | Record [(String,[String],CExpr)]+ | Binop String CExpr CExpr+ | Lambda String CExpr+ | App CExpr CExpr+ | If CExpr CExpr CExpr+ | MultiIf [(CExpr,CExpr)]+ | Let [Def] CExpr+ | Var String+ | Case CExpr [(Pattern,CExpr)]+ | Data String [CExpr]+ | Markdown Pandoc.Pandoc+ deriving (Eq)++data Def = FnDef String [String] CExpr+ | OpDef String String String CExpr+ deriving (Eq)++data Statement = Definition Def+ | Datatype String [X] [(String,[Type])]+ | TypeAlias String [X] Type+ | TypeAnnotation String Type+ | ImportEvent String CExpr String Type+ | ExportEvent String String Type+ deriving (Eq,Show)++cons h t = epos h t (Data "Cons" [h,t])+nil = C (Just "[]") NoSpan (Data "Nil" [])+list = foldr cons nil+tuple es = Data ("Tuple" ++ show (length es)) es++delist (C _ _ (Data "Cons" [h,t])) = h : delist t+delist _ = []+++pcons h t = PData "Cons" [h,t]+pnil = PData "Nil" []+plist = foldr pcons pnil+ptuple es = PData ("Tuple" ++ show (length es)) es++brkt s = "{ " ++ s ++ " }"+parensIf b s = if b then parens s else s+isOp c = isSymbol c || elem c "+-/*=.$<>:&|^?%#@~!"++instance Show Pattern where+ show p =+ case p of+ PRecord fs -> brkt (intercalate ", " fs)+ PVar x -> x+ PAnything -> "_"+ PData "Cons" [hd@(PData "Cons" _),tl] ->+ parens (show hd) ++ " :: " ++ show tl+ PData "Cons" [hd,tl] -> show hd ++ " : " ++ show tl+ PData "Nil" [] -> "[]"+ PData name ps ->+ if take 5 name == "Tuple" && all isDigit (drop 5 name) then+ parens . intercalate ", " $ map show ps+ else parensIf (not (null ps)) $ unwords (name : map show ps)++instance Show Expr where+ show e =+ let show' (C _ _ e) = parensIf (needsParens e) (show e) in+ case e of+ IntNum n -> show n+ FloatNum n -> show n+ Chr c -> show c+ Str s -> show s+ Boolean b -> show b+ Range e1 e2 -> "[" ++ show e1 ++ ".." ++ show e2 ++ "]"+ Access e x -> show' e ++ "." ++ x+ Remove e x -> brkt (show e ++ " - " ++ x)+ Insert (C _ _ (Remove e y)) x v ->+ brkt (show e ++ " - " ++ y ++ " | " ++ x ++ " = " ++ show v)+ Insert e x v -> brkt (show e ++ " | " ++ x ++ " = " ++ show v)+ Modify e fs -> brkt (show e ++" | "++ intercalate ", " (map field fs))+ where field (x,e) = x ++ " <- " ++ show e+ Record r -> brkt (intercalate ", " (map fields r))+ where fields (f,args,e) = f ++ concatMap (' ':) args ++ " = " ++ show e+ Binop op e1 e2 -> show' e1 ++ " " ++ op ++ " " ++ show' e2+ Lambda x e -> let (xs,e') = getLambdas (noContext $ Lambda x e) in+ concat [ "\\", intercalate " " xs, " -> ", show e' ]+ App e1 e2 -> show' e1 ++ " " ++ show' e2+ If e1 e2 e3 -> concat [ "if ", show e1, " then ", show e2, " else ", show e3 ]+ MultiIf (p:ps) -> concat [ "if | ", iff p, sep (map iff ps) ]+ where iff (b,e) = show b ++ " -> " ++ show e+ sep = concatMap ("\n | " ++)+ Let defs e -> "let { "++intercalate " ; " (map show defs)++" } in "++show e+ Var (c:cs) -> if isOp c then parens (c:cs) else c:cs+ Case e pats -> "case "++ show e ++" of " ++ brkt (intercalate " ; " pats')+ where pats' = map (\(p,e) -> show p ++ " -> " ++ show e) pats+ Data name es+ | name == "Cons" -> ("["++) . (++"]") . intercalate "," . map show $+ delist (noContext $ Data "Cons" es)+ | name == "Nil" -> "[]"+ | otherwise -> name ++ " " ++ intercalate " " (map show' es)+ Markdown _ -> "[markdown| ... |]"+++instance Show Def where+ show e =+ case e of+ FnDef v [] e -> v ++ " = " ++ show e+ FnDef f args e -> f ++ " " ++ intercalate " " args ++ " = " ++ show e+ OpDef op a1 a2 e -> intercalate " " [a1,op,a2] ++ " = " ++ show e++getLambdas (C _ _ (Lambda x e)) = (x:xs,e')+ where (xs,e') = getLambdas e+getLambdas e = ([],e)++needsParens e =+ case e of+ Binop _ _ _ -> True+ Lambda _ _ -> True+ App _ _ -> True+ If _ _ _ -> True+ Let _ _ -> True+ Case _ _ -> True+ Data name (x:xs) -> name /= "Cons"+ _ -> False
+ compiler/Model/Context.hs view
@@ -0,0 +1,43 @@++module Context where++import Text.Parsec.Pos+++data SrcPos = Pos Int Int+ deriving (Eq,Ord)++data SrcSpan = Span SrcPos SrcPos | NoSpan+ deriving (Eq,Ord)++data Context e = C (Maybe String) SrcSpan e deriving (Eq,Ord)+++instance Show SrcPos where+ show (Pos r c) = "Line " ++ show r ++ ", Column " ++ show c++instance Show SrcSpan where+ show span = + case span of+ Span start end -> show start+ NoSpan -> ""++instance Show e => Show (Context e) where+ show (C _ _ e) = show e++++noContext = C Nothing NoSpan++pos start end = C Nothing+ (Span (Pos (sourceLine start) (sourceColumn start))+ (Pos (sourceLine end ) (sourceColumn end )))++epos (C _ s1 _) (C _ s2 _) = C Nothing span+ where span = case (s1,s2) of+ (Span start _, Span _ end) -> Span start end+ (_, NoSpan) -> s1+ (NoSpan, _) -> s2++addCtx x (C Nothing span e) = C (Just (show x)) span e+addCtx x (C txt span e) = C txt span e
+ compiler/Model/Guid.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Guid (guid, set, run, runAt, GuidCounter) where++import Control.Monad.State (evalState, State, get, put)++-- Wrapper around State monad.+newtype GuidCounter a = GC { runGC :: State Int a }+ deriving (Monad)++-- Get the next GUID, incrementing the counter.+guid :: GuidCounter Int+guid = GC $ do n <- get+ put (n + 1)+ return n++set n = GC (put n)++run = runAt 0+runAt n x = evalState (runGC x) n
+ compiler/Model/Libraries.hs view
@@ -0,0 +1,59 @@+module Libraries (libraries, addPrelude) where++import Ast+import Control.Applicative ((<$>),(<*>))+import qualified Data.Map as Map+import Data.List (inits)+import Text.JSON+import LoadLibraries as Libs++addPrelude :: Module -> Module+addPrelude (Module name exs ims stmts) = Module name exs (customIms ++ ims) stmts+ where customIms = concatMap addModule prelude++ addModule (n, method) = case lookup n ims of+ Nothing -> [(n, method)]+ Just (As m) -> [(n, method)]+ Just _ -> []++prelude = text : map (\n -> (n, Hiding [])) modules+ where+ text = ("Text", Hiding ["link", "color", "height"])+ modules = [ "Prelude", "Signal", "List", "Maybe", "Time"+ , "Graphics.Element", "Color", "Graphics.Collage" ]++libraries :: Map.Map String (Map.Map String String)+libraries =+ case getLibs of+ Error err -> error err+ Ok libs -> Map.unionWith Map.union libs nilAndTuples+ where nilAndTuples = Map.singleton "Prelude" (Map.fromList pairs)+ pairs =+ [ ("Cons", "a -> [a] -> [a]")+ , ("Nil", "[a]")+ ] ++ map makeTuple (inits ['a'..'i'])+ + makeTuple cs = + let name = "Tuple" ++ show (length cs)+ in (name, concatMap (\c -> c : " -> ") cs +++ name ++ concatMap (\c -> [' ',c]) cs)++getLibs :: Result (Map.Map String (Map.Map String String))+getLibs = do+ obj <- decodeStrict Libs.docs :: Result (JSObject JSValue)+ modules <- valFromObj "modules" obj :: Result [JSObject JSValue]+ Map.fromList `fmap` mapM getValues modules+++get :: String -> JSObject JSValue -> Result String+get = valFromObj++getValue :: JSObject JSValue -> Result (String,String)+getValue obj = (,) <$> get "name" obj <*> get "type" obj++getValues :: JSObject JSValue -> Result (String, Map.Map String String)+getValues obj = do+ name <- get "name" obj+ vs <- valFromObj "values" obj+ vals <- mapM getValue vs+ return (name, Map.fromList vals)
+ compiler/Model/LoadLibraries.hs view
@@ -0,0 +1,34 @@+module LoadLibraries (docs) where++import Control.DeepSeq (force)+import qualified Control.Exception as E+import Paths_Elm+import System.Directory+import System.FilePath+import System.IO.Unsafe (unsafePerformIO)++-- See stackoverflow discussion for trade-off between using unsafeIO or TemplateHaskell:+-- http://stackoverflow.com/questions/12716215/load-pure-global-variable-from-file++-- Given the awkwardness of including a compile-time generated file+-- vs loading static data, then the unsafeIO seems better.++{-# NOINLINE docs #-}+docs :: String+docs = force $ unsafePerformIO (safeReadDocs =<< getDataFileName "docs.json")++safeReadDocs :: FilePath -> IO String+safeReadDocs name = E.catch (readDocs name) (emitError name)++readDocs :: FilePath -> IO String+readDocs name = do+ exists <- doesFileExist name+ if exists then readFile name+ else ioError . userError $ "File Not Found"+++emitError :: FilePath -> IOError -> IO String+emitError name err = do+ putStrLn $ "Error! Types for standard library not loaded properly!\n File should be here:" ++ name ++ "\n The file is created and copied by command: cabal install"+ putStrLn (show err)+ return "{\"modules\":[]}"
+ compiler/Parse/Binops.hs view
@@ -0,0 +1,89 @@+module Parse.Binops (binops) where++import Ast+import Context+import Control.Monad (liftM,guard)+import Control.Monad.Error+import Data.List (foldl',splitAt,elemIndices+ ,group,groupBy,sortBy,find,intercalate)+import qualified Data.Map as Map+import Data.Maybe (mapMaybe)++import Text.Parsec+import Parse.Library++data Assoc = L | N | R deriving (Eq,Show)++type OpTable = [(Int, Assoc, String)]++table :: OpTable+table = [ (9, R, ".")+ , (8, R, "^")+ , (7, L, "*"), (7, L, "/"), (7, L, "mod"), (7, L, "div"), (7, L, "rem")+ , (6, L, "+"), (6, L, "-")+ , (5, R, "::"), (5, R, "++")+ , (4, N, "<="), (4, N, ">="), (4, N, "<")+ , (4, N, "=="), (4, N, "/="), (4, N, ">")+ , (4, L, "~"), (4, L, "<~")+ , (3, R, "&&")+ , (2, R, "||")+ , (0, R, "$")+ , (0, R, "<|"), (0, L, "|>")+ ]++opLevel op = Map.findWithDefault 9 op dict+ where dict = Map.fromList (map (\(lvl,_,op) -> (op,lvl)) table)++opAssoc op = Map.findWithDefault R op dict+ where dict = Map.fromList (map (\(_,assoc,op) -> (op,assoc)) table)++hasLevel n (op,e) = opLevel op == n++sortOps :: OpTable -> OpTable+sortOps = sortBy (\(i,_,_) (j,_,_) -> compare i j)++binops :: IParser CExpr -> IParser String -> IParser CExpr+binops term anyOp = do+ e <- term+ split 0 e =<< many (commitIf (whitespace >> anyOp) $ do+ whitespace ; op <- anyOp+ whitespace ; e <- term+ return (op,e))++split :: Int -> CExpr -> [(String, CExpr)] -> IParser CExpr+split _ e [] = return e+split n e eops = do+ assoc <- getAssoc n eops+ es <- sequence (splitLevel n e eops)+ let ops = map fst (filter (hasLevel n) eops)+ case assoc of R -> joinR es ops+ _ -> joinL es ops++splitLevel :: Int -> CExpr -> [(String, CExpr)] -> [IParser CExpr]+splitLevel n e eops =+ case break (hasLevel n) eops of+ (lops, (op,e'):rops) -> split (n+1) e lops : splitLevel n e' rops+ (lops, []) -> [ split (n+1) e lops ]++joinL :: [CExpr] -> [String] -> IParser CExpr+joinL [e] [] = return e+joinL (a:b:es) (op:ops) = joinL (epos a b (Binop op a b) : es) ops+joinL _ _ = fail "Ill-formed binary expression. Report a compiler bug."++joinR :: [CExpr] -> [String] -> IParser CExpr+joinR [e] [] = return e+joinR (a:b:es) (op:ops) = do e <- joinR (b:es) ops+ return (epos a e (Binop op a e))+joinR _ _ = fail "Ill-formed binary expression. Report a compiler bug."++getAssoc :: Int -> [(String,CExpr)] -> IParser Assoc+getAssoc n eops | all (==L) assocs = return L+ | all (==R) assocs = return R + | all (==N) assocs = case assocs of [_] -> return N+ _ -> fail msg+ where levelOps = filter (hasLevel n) eops+ assocs = map (opAssoc . fst) levelOps+ msg = concat [ "Conflicting precedence for binary operators ("+ , intercalate ", " (map fst eops), "). "+ , "Consider adding parentheses to disambiguate." ]+
+ compiler/Parse/Expr.hs view
@@ -0,0 +1,216 @@+module Parse.Expr (def,term) where++import Ast+import Context+import Control.Applicative ((<$>), (<*>))+import Control.Monad+import Data.Char (isSymbol, isDigit)+import Data.List (foldl')+import Text.Parsec hiding (newline,spaces)+import Text.Parsec.Indent+import qualified Text.Pandoc as Pan++import Parse.Library+import Parse.Patterns+import Parse.Binops++import Guid+import Types.Types (Type (VarT), Scheme (Forall))++import System.IO.Unsafe+++-------- Basic Terms --------++numTerm :: IParser Expr+numTerm = toExpr <$> (preNum <?> "number")+ where toExpr n | '.' `elem` n = FloatNum (read n)+ | otherwise = IntNum (read n)+ preNum = (++) <$> many1 digit <*> option "" postNum+ postNum = do try $ lookAhead (string "." >> digit)+ string "."+ ('.':) <$> many1 digit++strTerm :: IParser Expr+strTerm = liftM Str . expecting "string" . betwixt '"' '"' . many $+ backslashed <|> satisfy (/='"')++varTerm :: IParser Expr+varTerm = toVar <$> var <?> "variable"++toVar v = case v of "True" -> Boolean True+ "False" -> Boolean False+ _ -> Var v++chrTerm :: IParser Expr+chrTerm = Chr <$> betwixt '\'' '\'' (backslashed <|> satisfy (/='\''))+ <?> "character"++accessor :: IParser Expr+accessor = do+ start <- getPosition+ lbl <- try (string "." >> rLabel)+ end <- getPosition+ let ctx e = addCtx ("." ++ lbl) (pos start end e)+ return (Lambda "_" (ctx $ Access (ctx $ Var "_") lbl))+++-------- Complex Terms --------++listTerm :: IParser Expr+listTerm =+ (do { try $ string "[markdown|"+ ; md <- filter (/='\r') <$> manyTill anyChar (try $ string "|]")+ ; return . Markdown $ Pan.readMarkdown Pan.def md })+ <|> (braces $ choice+ [ try $ do { lo <- expr; whitespace; string ".." ; whitespace+ ; Range lo <$> expr }+ , do (C _ _ e) <- list <$> commaSep expr+ return e+ ])++parensTerm :: IParser CExpr+parensTerm = parens $ choice+ [ do start <- getPosition+ op <- try anyOp+ end <- getPosition+ let ctxt = pos start end+ return . ctxt . Lambda "x" . ctxt . Lambda "y" . ctxt $+ Binop op (ctxt $ Var "x") (ctxt $ Var "y")+ , do start <- getPosition+ let comma = char ',' <?> "comma ','"+ commas <- comma >> many (whitespace >> comma)+ end <- getPosition+ let vars = map (('v':) . show) [ 0 .. length commas + 1 ]+ ctxt = pos start end+ return $ foldr (\x e -> ctxt $ Lambda x e)+ (ctxt . tuple $ map (ctxt . Var) vars) vars+ , do start <- getPosition+ es <- commaSep expr+ end <- getPosition+ return $ case es of [e] -> e+ _ -> pos start end (tuple es)+ ]++recordTerm :: IParser CExpr+recordTerm = brackets $ choice [ misc, addContext record ]+ where field = do+ fDefs <- (:) <$> (PVar <$> rLabel) <*> spacePrefix patternTerm+ whitespace+ e <- string "=" >> whitespace >> expr+ n <- sourceLine <$> getPosition+ runAt (1000 * n) $ flattenPatterns fDefs e+ extract [ FnDef f args exp ] = return (f,args,exp)+ extract _ = fail "Improperly formed record field."+ record = Record <$> (mapM extract =<< commaSep field)+ change = do+ lbl <- rLabel+ whitespace >> string "<-" >> whitespace+ (,) lbl <$> expr+ remove r = addContext (string "-" >> whitespace >> Remove r <$> rLabel)+ insert r = addContext $ do+ string "|" >> whitespace+ Insert r <$> rLabel <*>+ (whitespace >> string "=" >> whitespace >> expr)+ modify r = addContext+ (string "|" >> whitespace >> Modify r <$> commaSep1 change)+ misc = try $ do+ record <- addContext (Var <$> rLabel)+ whitespace+ opt <- optionMaybe (remove record)+ whitespace+ case opt of+ Just e -> try (insert e) <|> return e+ Nothing -> try (insert record) <|> try (modify record)+ ++term :: IParser CExpr+term = addContext (choice [ numTerm, strTerm, chrTerm, listTerm, accessor ])+ <|> accessible (addContext varTerm <|> parensTerm <|> recordTerm)+ <?> "basic term (4, x, 'c', etc.)"++-------- Applications --------++appExpr :: IParser CExpr+appExpr = do+ tlist <- spaceSep1 term+ return $ case tlist of+ t:[] -> t+ t:ts -> foldl' (\f x -> epos f x $ App f x) t ts++-------- Normal Expressions --------++binaryExpr :: IParser CExpr+binaryExpr = binops appExpr anyOp++ifExpr :: IParser Expr+ifExpr = reserved "if" >> whitespace >> (normal <|> multiIf)+ where normal = do e1 <- expr ; whitespace+ reserved "then" ; whitespace ; e2 <- expr+ whitespace <?> "an 'else' branch"+ reserved "else" <?> "an 'else' branch" ; whitespace+ If e1 e2 <$> expr+ multiIf = (MultiIf <$> spaceSep1 iff)+ where iff = do string "|" ; whitespace+ b <- expr ; whitespace ; string "->" ; whitespace+ (,) b <$> expr++lambdaExpr :: IParser CExpr+lambdaExpr = do char '\\' <|> char '\x03BB' <?> "anonymous function"+ whitespace+ pats <- spaceSep1 patternTerm+ whitespace ; arrow ; whitespace+ e <- expr+ return . run $ makeLambda pats e++defSet :: IParser [Def]+defSet = concat <$> block (do d <- assignExpr ; whitespace ; return d)++letExpr :: IParser Expr+letExpr = do+ reserved "let" ; whitespace+ defs <- defSet+ whitespace ; reserved "in" ; whitespace+ Let defs <$> expr++caseExpr :: IParser Expr+caseExpr = do+ reserved "case"; whitespace; e <- expr; whitespace; reserved "of"; whitespace+ Case e <$> (with <|> without)+ where case_ = do p <- patternExpr; whitespace; arrow; whitespace+ (,) p <$> expr+ with = brackets (semiSep1 (case_ <?> "cases { x -> ... }"))+ without = block (do c <- case_ ; whitespace ; return c)++expr = addContext (choice [ ifExpr, letExpr, caseExpr ])+ <|> lambdaExpr+ <|> binaryExpr + <?> "an expression"++funcDef = try (do p1 <- try patternTerm ; infics p1 <|> func p1)+ <|> ((:[]) <$> patternExpr)+ <?> "the definition of a variable (x = ...)"+ where func p@(PVar v) = (p:) <$> spacePrefix patternTerm+ func p = do try (lookAhead (whitespace >> string "="))+ return [p]+ infics p1 = do+ o:p <- try (whitespace >> anyOp)+ p2 <- (whitespace >> patternTerm)+ return $ if o == '`' then [ PVar $ takeWhile (/='`') p, p1, p2 ]+ else [ PVar (o:p), p1, p2 ]++assignExpr :: IParser [Def]+assignExpr = withPos $ do+ fDefs <- funcDef+ whitespace+ e <- string "=" >> whitespace >> expr+ n <- sourceLine <$> getPosition+ runAt (1000 * n) $ flattenPatterns fDefs e++def = map Definition <$> assignExpr+++parseDef str =+ case iParse def "" str of+ Right result -> Right result+ Left err -> Left $ "Parse error at " ++ show err
+ compiler/Parse/Foreign.hs view
@@ -0,0 +1,61 @@++module Parse.Foreign (foreignDef) where++import Control.Applicative ((<$>), (<*>))+import Data.Either (partitionEithers)+import Text.Parsec hiding (newline,spaces)++import Ast+import Parse.Library+import Parse.Expr (term)+import Parse.Types+import Types.Types (signalOf)+++foreignDef = do try (reserved "foreign") ; whitespace+ importEvent <|> exportEvent++exportEvent = do+ try (reserved "export" >> whitespace >> reserved "jsevent" >> whitespace)+ js <- jsVar ; whitespace+ elm <- lowVar ; whitespace+ hasType ; whitespace+ tipe <- typeExpr+ case tipe of+ ADTPT "Signal" [pt] ->+ either fail (return . ExportEvent js elm . signalOf) (toForeignType pt)+ _ -> fail "When exporting events, the exported value must be a Signal."++importEvent = do+ try (reserved "import" >> whitespace >> reserved "jsevent" >> whitespace)+ js <- jsVar ; whitespace+ base <- term <?> "Base case for imported signal (signals cannot be undefined)"+ whitespace+ elm <- lowVar <?> "Name of imported signal"+ whitespace ; hasType ; whitespace+ tipe <- typeExpr+ case tipe of+ ADTPT "Signal" [pt] ->+ either fail (return . ImportEvent js base elm . signalOf) (toForeignType pt)+ _ -> fail "When importing events, the imported value must be a Signal."+++jsVar :: (Monad m) => ParsecT [Char] u m String+jsVar = betwixt '"' '"' $ do+ v <- (:) <$> (letter <|> char '_') <*> many (alphaNum <|> char '_')+ if v `notElem` jsReserveds then return v else+ fail $ "'" ++ v +++ "' is not a good name for a importing or exporting JS values."++jsReserveds =+ [ "null", "undefined", "Nan", "Infinity", "true", "false", "eval"+ , "arguments", "int", "byte", "char", "goto", "long", "final", "float"+ , "short", "double", "native", "throws", "boolean", "abstract", "volatile"+ , "transient", "synchronized", "function", "break", "case", "catch"+ , "continue", "debugger", "default", "delete", "do", "else", "finally"+ , "for", "function", "if", "in", "instanceof", "new", "return", "switch"+ , "this", "throw", "try", "typeof", "var", "void", "while", "with", "class"+ , "const", "enum", "export", "extends", "import", "super", "implements"+ , "interface", "let", "package", "private", "protected", "public"+ , "static", "yield"+ ]
+ compiler/Parse/Library.hs view
@@ -0,0 +1,183 @@++module Parse.Library where++import Ast+import Context+import Control.Applicative ((<$>),(<*>))+import Control.Monad+import Control.Monad.State+import Data.Char (isUpper)+import Rename (deprime)+import Text.Parsec hiding (newline,spaces,State)+import Text.Parsec.Indent++reserveds = [ "if", "then", "else"+ , "case", "of"+ , "let", "in"+ , "data", "type"+ , "module", "where"+ , "import", "as", "hiding", "open"+ , "export", "foreign" ]++expecting = flip (<?>)++type IParser a = ParsecT String () (State SourcePos) a++iParse :: IParser a -> SourceName -> String -> Either ParseError a+iParse aParser source_name input =+ runIndent source_name $ runParserT aParser () source_name input++backslashed :: IParser Char+backslashed = do { char '\\'; c <- anyChar+ ; return . read $ ['\'','\\',c,'\''] }++var :: IParser String+var = makeVar (letter <|> char '_' <?> "variable")++lowVar :: IParser String+lowVar = makeVar (lower <?> "lower case variable")+capVar :: IParser String+capVar = makeVar (upper <?> "upper case variable")++rLabel :: IParser String+rLabel = deprime <$> lowVar++innerVarChar :: IParser Char+innerVarChar = alphaNum <|> char '_' <|> char '\'' <?> "" ++makeVar :: IParser Char -> IParser String+makeVar p = do v <- (:) <$> p <*> many innerVarChar+ guard (v `notElem` reserveds)+ return v++reserved :: String -> IParser String+reserved word =+ try (string word >> notFollowedBy innerVarChar) >> return word+ <?> "reserved word '" ++ word ++ "'"++anyOp :: IParser String+anyOp = betwixt '`' '`' var <|> symOp <?> "infix operator (e.g. +, *, ||)"++symOp :: IParser String+symOp = do op <- many1 (satisfy isOp)+ guard (op `notElem` [ "=", "..", "->", "--", "|", "\8594", ":" ])+ case op of+ "." -> notFollowedBy lower >> return op+ "\8728" -> return "."+ _ -> return op++arrow :: IParser String+arrow = string "->" <|> string "\8594" <?> "arrow (->)"++hasType :: IParser String+hasType = string ":" <?> "':' (a type annotation)'"+++commitIf check p = commit <|> try p+ where commit = do (try $ lookAhead check) >> p++spaceySepBy1 :: IParser b -> IParser a -> IParser [a]+spaceySepBy1 sep p = do+ a <- p+ (a:) <$> many (commitIf (whitespace >> sep) (whitespace >> sep >> whitespace >> p))+++commaSep1 :: IParser a -> IParser [a]+commaSep1 = spaceySepBy1 (char ',' <?> "comma ','")++commaSep :: IParser a -> IParser [a]+commaSep = option [] . commaSep1++semiSep1 :: IParser a -> IParser [a]+semiSep1 = spaceySepBy1 (char ';' <?> "semicolon ';'")++pipeSep1 :: IParser a -> IParser [a]+pipeSep1 = spaceySepBy1 (char '|' <?> "type divider '|'")++consSep1 :: IParser a -> IParser [a]+consSep1 = spaceySepBy1 (string "::" <?> "cons operator '::'")++dotSep1 :: IParser a -> IParser [a]+dotSep1 p = (:) <$> p <*> many (try (char '.') >> p)++spaceSep1 :: IParser a -> IParser [a]+spaceSep1 p = (:) <$> p <*> spacePrefix p++spacePrefix p = many (try (whitespace >> indented >> p))++followedBy a b = do x <- a ; b ; return x++betwixt a b c = do char a ; out <- c+ char b <?> "closing '" ++ [b] ++ "'" ; return out++surround a z name p = do+ char a ; whitespace ; v <- p ; whitespace+ char z <?> unwords ["closing", name, show z]+ return v++braces :: IParser a -> IParser a+braces = surround '[' ']' "brace"++parens :: IParser a -> IParser a+parens = surround '(' ')' "paren"++brackets :: IParser a -> IParser a+brackets = surround '{' '}' "bracket"++addContext :: IParser Expr -> IParser CExpr+addContext expr = do+ start <- getPosition+ e <- expr+ end <- getPosition+ return (pos start end e)++accessible :: IParser CExpr -> IParser CExpr+accessible expr = do+ start <- getPosition+ ce@(C s t e) <- expr+ let rest f = do+ let dot = char '.' >> notFollowedBy (char '.')+ access <- optionMaybe (try dot <?> "field access (e.g. List.map)")+ case access of+ Nothing -> return ce+ Just _ -> accessible $ do+ v <- var <?> "field access (e.g. List.map)"+ end <- getPosition+ return (pos start end (f v))+ case e of Var (c:cs) | isUpper c -> rest (\v -> Var (c:cs ++ '.':v))+ | otherwise -> rest (Access ce)+ _ -> rest (Access ce)+++spaces :: IParser String+spaces = many1 ((multiComment <|> string " " <?> "") >> return ' ') <?> "spaces"++forcedWS :: IParser [String]+forcedWS = try (do { spaces; many nl_space }) <|> try (many1 nl_space)+ where nl_space = try $ many1 newline >> spaces++whitespace :: IParser ()+whitespace = optional forcedWS <?> ""++freshLine :: IParser [[String]]+freshLine = try (many1 newline >> many space_nl) <|> try (many1 space_nl) <?> ""+ where space_nl = try $ spaces >> many1 newline++newline :: IParser String+newline = simpleNewline <|> lineComment <?> ""++simpleNewline :: IParser String+simpleNewline = try (string "\r\n") <|> string "\n"++lineComment :: IParser String+lineComment = do try (string "--")+ manyTill anyChar $ simpleNewline <|> (eof >> return "\n")++multiComment :: IParser String+multiComment = do { try (string "{-"); closeComment }++closeComment :: IParser String+closeComment = manyTill anyChar . choice $+ [ try (string "-}") <?> "close comment"+ , do { try $ string "{-"; closeComment; closeComment }+ ]
+ compiler/Parse/Modules.hs view
@@ -0,0 +1,46 @@++module Parse.Modules (moduleDef, imports) where++import Control.Applicative ((<$>), (<*>))+import Data.List (intercalate)+import Text.Parsec hiding (newline,spaces)++import Ast+import Parse.Library++varList :: IParser [String]+varList = parens $ commaSep1 (var <|> parens symOp)++moduleDef :: IParser ([String], [String])+moduleDef = do+ try (reserved "module")+ whitespace+ names <- dotSep1 capVar <?> "name of module"+ whitespace+ exports <- option [] varList+ whitespace <?> "reserved word 'where'"+ reserved "where"+ return (names, exports)++imports :: IParser Imports+imports = option [] ((:) <$> import' <*> many (try (freshLine >> import')))+++import' :: IParser (String, ImportMethod)+import' = do+ reserved "import"+ whitespace+ open <- optionMaybe (reserved "open")+ whitespace+ name <- intercalate "." <$> dotSep1 capVar+ case open of+ Just _ -> return (name, Hiding [])+ Nothing -> let how = try (whitespace >> (as' <|> importing'))+ in (,) name <$> option (Importing []) how+++as' :: IParser ImportMethod+as' = reserved "as" >> whitespace >> As <$> capVar <?> "alias for module"++importing' :: IParser ImportMethod+importing' = Importing <$> varList <?> "listing of imported values (x,y,z)"
+ compiler/Parse/Parser.hs view
@@ -0,0 +1,52 @@+module Parse.Parser (parseProgram, preParse) where++import Ast+import Control.Applicative ((<$>), (<*>))+import Control.Monad+import Data.Char (isSymbol, isDigit)+import Data.List (foldl',intercalate)+import Text.Parsec hiding (newline,spaces)++import Parse.Library+import Parse.Expr+import Parse.Types+import Parse.Modules+import Parse.Foreign+++statement = choice (typeAlias:defs) <|> def <?> "datatype or variable definition"+ where defs = map ((:[]) <$>) [ foreignDef, datatype, typeAnnotation ]++freshDef = commitIf (freshLine >> (letter <|> char '_')) $ do+ freshLine+ statement <?> "another datatype or variable definition"++defs1 = do d <- statement <?> "at least one datatype or variable definition"+ concat <$> (d:) <$> many freshDef++program = do+ optional freshLine+ (names,exports) <- option (["Main"],[]) (moduleDef `followedBy` freshLine)+ is <- (do try (lookAhead $ reserved "import")+ imports `followedBy` freshLine) <|> return []+ statements <- defs1+ optional freshLine ; optional spaces ; eof+ return $ Module names exports is statements++parseProgram = setupParser program++preParse :: String -> Either String (String, [String])+preParse = setupParser $ do+ optional skip+ (,) <$> option "Main" moduleName <*> option [] imprts+ where + skip = try (manyTill anyChar (try (string "/**")))+ imprts = fmap (map fst) imports `followedBy` freshLine+ getName = intercalate "." . fst+ moduleName = do optional freshLine + getName <$> moduleDef `followedBy` freshLine++setupParser p source =+ case iParse p "" source of+ Right result -> Right result+ Left err -> Left $ "Parse error at " ++ show err
+ compiler/Parse/Patterns.hs view
@@ -0,0 +1,105 @@++module Parse.Patterns (patternTerm, patternExpr, makeLambda, flattenPatterns) where++import Ast+import Context+import Control.Applicative ((<$>),(<*>))+import Control.Monad+import Control.Monad.State+import Data.Char (isUpper)+import Guid+import Text.Parsec hiding (newline,spaces,State)+import Text.Parsec.Indent+import Parse.Library++patternBasic :: IParser Pattern+patternBasic =+ choice [ char '_' >> return PAnything+ , do x@(c:_) <- var+ return $ if isUpper c then PData x [] else PVar x+ ]++patternRecord :: IParser Pattern+patternRecord = PRecord <$> brackets (commaSep1 lowVar)++patternTuple :: IParser Pattern+patternTuple = do ps <- parens (commaSep patternExpr)+ return $ case ps of { [p] -> p; _ -> ptuple ps }++patternList :: IParser Pattern+patternList = plist <$> braces (commaSep patternExpr)++patternTerm :: IParser Pattern+patternTerm = choice [ patternRecord, patternTuple, patternList, patternBasic ]+ <?> "pattern"++patternConstructor :: IParser Pattern+patternConstructor = PData <$> capVar <*> spacePrefix patternTerm++patternExpr :: IParser Pattern+patternExpr = foldr1 pcons <$> consSep1 (patternConstructor <|> patternTerm) <?> "pattern"++makeLambda :: [Pattern] -> CExpr -> GuidCounter CExpr+makeLambda pats body = go (reverse pats) body+ where go [] body = return body+ go (p:ps) body@(C t s _) = do+ (x,e) <- extract p body+ go ps (C t s $ Lambda x e)+ +extract :: Pattern -> CExpr -> GuidCounter (String, CExpr)+extract pattern body@(C t s _) =+ let ctx = C t s in+ let fn x e = (x,e) in+ case pattern of+ PAnything -> return $ fn "_" body+ PVar x -> return $ fn x body+ PData name ps -> do+ x <- guid+ let a = '_' : show x+ return . fn a . ctx $ Case (ctx (Var a)) [(pattern, body)]+ PRecord fs -> do+ x <- guid+ let a = '_' : show x+ toDef f = FnDef f [] (ctx $ Access (ctx $ Var a) f)+ return . fn a . ctx $ Let (map toDef fs) body++extracts :: [Pattern] -> CExpr -> GuidCounter ([String], CExpr)+extracts ps body = go [] (reverse ps) body+ where go args [] body = return (args, body)+ go args (p:ps) body = do (x,e) <- extract p body+ go (x:args) ps e++flattenPatterns :: [Pattern] -> CExpr -> GuidCounter (IParser [Def])+flattenPatterns patterns exp@(C t s _) =+ let ctx = C t s in+ case patterns of+ PVar f : args -> do+ (as,e) <- extracts args exp+ return . return $+ if isOp (head f) then let [a,b] = as in [ OpDef f a b e ]+ else [ FnDef f as e ]++ [p] -> return `liftM` matchSingle p exp p++ _ -> return . fail $ "Pattern (" ++ unwords (map show patterns) +++ ") cannot be used on the left-hand side of an assign statement."++matchSingle :: Pattern -> CExpr -> Pattern -> GuidCounter [Def]+matchSingle pat exp@(C t s _) p =+ let ctx = C t s in+ case p of+ PData _ ps -> do+ x <- guid+ let v = '_' : show x+ dss <- mapM (matchSingle pat . ctx $ Var v) ps+ return (FnDef v [] exp : concat dss)++ PVar x ->+ return [ FnDef x [] (ctx $ Case exp [(pat, ctx $ Var x)]) ]++ PRecord fs -> do+ a <- (\x -> '_' : show x) `liftM` guid+ let toDef f = FnDef f [] (ctx $ Access (ctx $ Var a) f)+ return (FnDef a [] exp : map toDef fs)++ PAnything -> return []
+ compiler/Parse/Types.hs view
@@ -0,0 +1,167 @@+module Parse.Types where++import Ast+import Control.Applicative ((<$>),(<*>))+import Control.Monad (liftM,mapM)+import Data.Char (isUpper,isLower)+import Data.Maybe (fromMaybe)+import Data.List (lookup)+import Text.Parsec+import Text.Parsec.Indent++import Context+import Parse.Library+import Types.Types hiding (parens,string)+import Guid++data ParseType = VarPT String+ | LambdaPT ParseType ParseType+ | ADTPT String [ParseType]+ | RecordPT (Maybe ParseType) [(String,ParseType)]++listPT t = ADTPT "List" [t]+tuplePT ts = ADTPT ("Tuple" ++ show (length ts)) ts++typeVar :: IParser ParseType+typeVar = VarPT <$> lowVar <?> "type variable"++typeList :: IParser ParseType+typeList = listPT <$> braces typeExpr++typeTuple :: IParser ParseType+typeTuple = do ts <- parens (commaSep typeExpr)+ return $ case ts of { [t] -> t ; _ -> tuplePT ts }++typeRecord :: IParser ParseType+typeRecord = brackets (RecordPT <$> extend <*> fields)+ where extend = optionMaybe . try $ do+ t <- typeVar+ whitespace >> string "|" >> whitespace+ return t+ fields = commaSep $ do+ lbl <- rLabel+ whitespace >> hasType >> whitespace+ (,) lbl <$> typeExpr++typeUnambiguous :: IParser ParseType+typeUnambiguous = typeList <|> typeTuple <|> typeRecord++typeSimple :: IParser ParseType+typeSimple = VarPT <$> var++typeApp :: IParser ParseType+typeApp = do name <- capVar <?> "type constructor"+ args <- spacePrefix (typeUnambiguous <|> typeSimple)+ return $ case args of+ [] -> VarPT name+ _ -> ADTPT name args++typeExpr :: IParser ParseType+typeExpr = do+ t1 <- typeVar <|> typeApp <|> typeUnambiguous+ whitespace ; arr <- optionMaybe arrow ; whitespace+ case arr of+ Just _ -> LambdaPT t1 <$> typeExpr+ Nothing -> return t1++typeConstructor :: IParser (String, [ParseType])+typeConstructor = (,) <$> (capVar <?> "another type constructor")+ <*> spacePrefix (typeSimple <|> typeUnambiguous)++typeAlias :: IParser [Statement]+typeAlias = do+ start <- getPosition+ reserved "type" <?> "type alias (type Point = {x:Int, y:Int})"+ forcedWS+ alias <- capVar+ args <- spacePrefix lowVar+ whitespace ; string "=" ; whitespace+ let n = length args+ tipe <- typeExpr+ end <- getPosition+ case toTypeWith alias (zip args [1..n]) tipe of+ Left msg -> fail msg+ Right t -> return (TypeAlias alias [1..n] t : ctor)+ where ctor = case tipe of+ RecordPT _ kvs -> [toConstructor start end alias kvs]+ _ -> []++toConstructor start end alias kvs =+ Definition (FnDef alias args (ctxt (Record rec)))+ where+ ctxt = pos start end+ args = map fst kvs+ rec = map (\a -> (a, [], ctxt (Var a))) args+++typeAnnotation :: IParser Statement+typeAnnotation = TypeAnnotation <$> try start <*> (toType <$> typeExpr)+ where start = do v <- lowVar <|> parens symOp+ whitespace ; hasType ; whitespace ; return v++datatype :: IParser Statement+datatype = do+ reserved "data" <?> "datatype definition (data T = A | B | ...)"+ forcedWS ; name <- capVar <?> "name of data-type" ; args <- spacePrefix lowVar+ whitespace ; string "=" ; whitespace+ tcs <- pipeSep1 typeConstructor+ case toDatatype name args tcs of+ Right dt -> return dt+ Left msg -> fail msg++beta = liftM VarT guid++toType :: ParseType -> Type+toType pt =+ let frees :: ParseType -> [String]+ frees pt = case pt of+ LambdaPT a b -> frees a ++ frees b+ ADTPT _ ts -> concatMap frees ts+ RecordPT t fs -> maybe [] frees t ++ concatMap (frees . snd) fs+ VarPT (c:cs) | isLower c -> [c:cs]+ | otherwise -> []+ in case toTypeWith "" (zip (frees pt) [1..]) pt of+ Right t -> t+ Left _ -> VarT 0++toTypeWith :: String -> [(String,X)] -> ParseType -> Either String Type+toTypeWith name tvarDict pt =+ let msg x = "Type variable '" ++ x ++ "' is unbound in type '" ++ name ++ "'."+ toT = toTypeWith name tvarDict+ in case pt of+ LambdaPT t1 t2 -> (==>) <$> toT t1 <*> toT t2+ ADTPT name args -> ADT name <$> mapM toT args+ RecordPT t fs -> do fs' <- mapM (\(x,pt) -> (,) x <$> toT pt) fs+ ext <- maybe (return EmptyRecord) toT t+ return (RecordT (recordT fs') ext)+ VarPT x@(c:_)+ | not (isLower c) -> return $ ADT x []+ | otherwise -> VarT <$> case lookup x tvarDict of+ Just v -> Right v+ Nothing -> Left (msg x)+++toDatatype name args tcs = Datatype name [1..n] <$> mapM toC tcs+ where n = length args+ toType = toTypeWith name (zip args [1..n])+ toC (name,pt) = (,) name <$> mapM toType pt+++toForeignType (LambdaPT t1 t2) =+ fail $ "Elm's JavaScript event interface does not yet handle functions. " +++ "Only simple values can be imported and exported in this release."+ --LambdaT <$> toForeignType t1 <*> toForeignType t2+toForeignType (ADTPT name args)+ | isJsStructure name = ADT name <$> mapM toForeignType args+ | otherwise =+ Left $ "'" ++ name ++ "' is not an exportable type " +++ "constructor. Only 'JSArray' and 'JSTupleN' are exportable."++toForeignType (VarPT x@(c:_))+ | isLower c =+ Left "All exported types must be concrete types (JSNumber, JSString, etc.)"+ | x `elem` ["JSString","JSNumber","JSElement","JSBool"] = Right (ADT x [])+ | otherwise = Left $ "'" ++ x ++ "' is not an exportable type. Only JSTypes are exportable."++isJsStructure name = name == "JSArray" || isTuple+ where isTuple = "JSTuple" == take 7 name && drop 7 name `elem` map show [2..5]
+ compiler/Transform/Optimize.hs view
@@ -0,0 +1,136 @@+module Optimize (optimize) where++import Ast+import Context+import Control.Arrow (second)+import Data.Char (isAlpha)+import Substitute++optimize (Module name ims exs stmts) =+ Module name ims exs (map optimizeStmt stmts)++optimizeStmt stmt = if stmt == stmt' then stmt' else optimizeStmt stmt'+ where stmt' = simp stmt++class Simplify a where+ simp :: a -> a++instance Simplify Statement where+ simp (Definition def) = Definition (simp def)+ simp (ImportEvent js b elm t) = ImportEvent js (simp b) elm t+ simp stmt = stmt++instance Simplify Def where+ simp (FnDef func args e) = FnDef func args (simp e)+ simp (OpDef op a1 a2 e) = OpDef op a1 a2 (simp e)++instance Simplify e => Simplify (Context e) where+ simp (C t s e) = C t s (simp e)++instance Simplify Expr where+ simp expr =+ let f = simp in+ case expr of+ Range e1 e2 -> Range (f e1) (f e2)+ Binop op e1 e2 -> simp_binop op (f e1) (f e2)+ Lambda x e -> Lambda x (f e)+ Record fs -> Record (map (\(f,as,e) -> (f, as, simp e)) fs)+ App (C t s (Lambda x e1)) e2 -> + if isValue e2' then subst x e2' e1' else App (C t s (Lambda x ce1')) ce2'+ where ce1'@(C _ _ e1') = f e1+ ce2'@(C _ _ e2') = f e2+ App e1 e2 -> App (f e1) (f e2)+ If e1 e2 e3 -> simp_if (f e1) (f e2) (f e3)+ Let defs e -> Let (map simp defs) (f e)+ Data name es -> Data name (map f es)+ Case e cases -> Case (f e) (map (second f) cases)+ _ -> expr++simp_if (C _ _ (Boolean b)) (C _ _ e2) (C _ _ e3) = if b then e2 else e3+simp_if a b c = If a b c++isValue e =+ case e of { IntNum _ -> True+ ; FloatNum _ -> True+ ; Chr _ -> True+ ; Str _ -> True+ ; Boolean _ -> True+ ; Var _ -> True+ ; Data _ _ -> True+ ; _ -> False }++simp_binop = binop++binop op ce1@(C t1 s1 e1) ce2@(C t2 s2 e2) =+ let c1 = C t1 s1 in+ let c2 = C t2 s2 in+ case (op, e1, e2) of+ (_, IntNum n, IntNum m) -> case op of+ { "+" -> IntNum $ (+) n m+ ; "-" -> IntNum $ (-) n m+ ; "*" -> IntNum $ (*) n m+ ; "^" -> IntNum $ n ^ m+ ; "div" -> IntNum $ div n m+ ; "mod" -> IntNum $ mod n m+ ; "<" -> Boolean $ n < m+ ; ">" -> Boolean $ n < m+ ; "<=" -> Boolean $ n <= m+ ; ">=" -> Boolean $ n >= m+ ; "==" -> Boolean $ n == m+ ; "/=" -> Boolean $ n /= m+ ; _ -> Binop op ce1 ce2 }++ -- flip order to move lone integers to the left+ ("+", _, IntNum n) -> binop "+" ce2 ce1+ ("*", _, IntNum n) -> binop "*" ce2 ce1++ ("+", IntNum 0, _) -> e2+ ("+", IntNum n, Binop "+" (C _ _ (IntNum m)) ce) ->+ binop "+" (c1 $ IntNum (n+m)) ce+ ("+", Binop "+" (C _ _ (IntNum n)) ce1'+ , Binop "+" (C _ _ (IntNum m)) ce2') ->+ binop "+" (noContext $ IntNum (n+m)) (noContext $ Binop "+" ce1' ce2')++ ("*", IntNum 0, _) -> e1+ ("*", IntNum 1, _) -> e2+ ("*", IntNum n, Binop "*" (C _ _ (IntNum m)) ce) ->+ binop "*" (noContext $ IntNum (n*m)) ce+ ("*", Binop "*" (C _ _ (IntNum n)) ce1'+ , Binop "*" (C _ _ (IntNum m)) ce2') ->+ binop "*" (noContext $ IntNum (n*m)) (noContext $ Binop "*" ce1' ce2')++ ("-", _, IntNum 0) -> e1+ ("/", _, IntNum 1) -> e1+ ("div", _, IntNum 1) -> e1++ (_, Boolean n, Boolean m) -> case op of "&&" -> Boolean $ n && m+ "||" -> Boolean $ n || m+ _ -> Binop op ce1 ce2++ ("&&", Boolean True, _) -> e2+ ("&&", Boolean False, _) -> Boolean False+ ("||", Boolean True, _) -> Boolean True+ ("||", Boolean False, _) -> e2++ ("::", _, _) -> let (C _ _ e) = cons ce1 ce2 in e++ ("++", Str s1, Str s2) -> Str $ s1 ++ s2+ ("++", Str s1, Binop "++" (C _ _ (Str s2)) ce) ->+ Binop "++" (c1 $ Str $ s1 ++ s2) ce+ ("++", Binop "++" e (C _ _ (Str s1)), Str s2) ->+ Binop "++" e (c1 $ Str $ s1 ++ s2)++ ("++", Data "Nil" [], _) -> e2+ ("++", _, Data "Nil" []) -> e1+ ("++", Data "Cons" [h,t], _) -> Data "Cons" [h, noContext $ binop "++" t ce2]++ ("|>", _, _) -> App ce2 ce1+ ("<|", _, _) -> App ce1 ce2+ ("$", _, _) -> App ce1 ce2+ (".", _, _) ->+ Lambda "x" (noContext $+ App ce1 (noContext $ App ce2 (noContext $ Var "x")))++ _ | isAlpha (head op) || '_' == head op ->+ App (noContext $ App (noContext $ Var op) ce1) ce2+ | otherwise -> Binop op ce1 ce2
+ compiler/Transform/Rename.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Rename (renameModule, derename, deprime) where++import Ast+import Context+import Control.Arrow (first)+import Control.Monad (ap, liftM, foldM, mapM, Monad, zipWithM)+import Control.Monad.State (evalState, State, get, put)+import Data.Char (isLower,isDigit)+import Guid++derename var+ | isDigit (last var) = reverse . tail . dropWhile isDigit $ reverse var+ | otherwise = var++renameModule :: Module -> Module+renameModule modul = run (rename deprime modul)++class Rename a where+ rename :: (String -> String) -> a -> GuidCounter a++instance Rename Module where + rename env (Module name ex im stmts) = do stmts' <- renameStmts env stmts+ return (Module name ex im stmts')++instance Rename Def where+ rename env (OpDef op a1 a2 e) =+ do env' <- extends env [a1,a2]+ OpDef op (env' a1) (env' a2) `liftM` rename env' e+ rename env (FnDef f args e) =+ do env' <- extends env args+ FnDef (env f) (map env' args) `liftM` rename env' e++instance Rename Statement where+ rename env stmt =+ case stmt of+ Definition def -> Definition `liftM` rename env def+ Datatype name args tcs ->+ return $ Datatype name args $ map (first env) tcs+ TypeAlias n xs t -> return (TypeAlias n xs t)+ TypeAnnotation n t -> return (TypeAnnotation (env n) t)+ ImportEvent js base elm tipe ->+ do base' <- rename env base+ return $ ImportEvent js base' (env elm) tipe+ ExportEvent js elm tipe ->+ return $ ExportEvent js (env elm) tipe++renameStmts env stmts = do env' <- extends env $ concatMap getNames stmts+ mapM (rename env') stmts+ where getNames stmt = case stmt of+ Definition (FnDef n _ _) -> [n]+ Datatype _ _ tcs -> map fst tcs+ ImportEvent _ _ n _ -> [n]+ _ -> []++instance Rename a => Rename (Context a) where+ rename env (C t s e) = C t s `liftM` rename env e+ +instance Rename Expr where+ rename env expr =+ let rnm = rename env in+ case expr of++ Range e1 e2 -> Range `liftM` rnm e1+ `ap` rnm e2+ + Access e x -> Access `liftM` rnm e+ `ap` return x++ Remove e x -> flip Remove x `liftM` rnm e++ Insert e x v -> flip Insert x `liftM` rnm e+ `ap` rnm v++ Modify e fs -> Modify `liftM` rnm e+ `ap` mapM (\(x,e) -> (,) x `liftM` rnm e) fs++ Record fs -> Record `liftM` mapM frnm fs+ where frnm (f,as,e) = do env' <- extends env as+ e' <- rename env' e+ return (f, map env' as, e') ++ Binop op@(h:_) e1 e2 ->+ let rop = if isLower h || '_' == h+ then env op+ else op+ in Binop rop `liftM` rnm e1+ `ap` rnm e2++ Lambda x e -> do+ (rx, env') <- extend env x+ Lambda rx `liftM` rename env' e++ App e1 e2 -> App `liftM` rnm e1+ `ap` rnm e2++ If e1 e2 e3 -> If `liftM` rnm e1+ `ap` rnm e2+ `ap` rnm e3++ MultiIf ps -> MultiIf `liftM` mapM grnm ps+ where grnm (b,e) = (,) `liftM` rnm b+ `ap` rnm e++ Let defs e -> renameLet env defs e++ Var x -> return . Var $ env x++ Data name es -> Data name `liftM` mapM rnm es++ Case e cases -> Case `liftM` rnm e+ `ap` mapM (patternRename env) cases++ _ -> return expr++deprime = map (\c -> if c == '\'' then '$' else c)++extend :: (String -> String) -> String -> GuidCounter (String, String -> String)+extend env x = do+ n <- guid+ let rx = deprime x ++ "_" ++ show n+ return (rx, \y -> if y == x then rx else env y)++extends :: (String -> String) -> [String] -> GuidCounter (String -> String)+extends env xs = foldM (\e x -> liftM snd $ extend e x) env xs++patternExtend :: Pattern -> (String -> String) -> GuidCounter (Pattern, String -> String)+patternExtend pattern env =+ case pattern of+ PAnything -> return (PAnything, env)+ PVar x -> first PVar `liftM` extend env x+ PData name ps ->+ first (PData name . reverse) `liftM` foldM f ([], env) ps+ where f (rps,env') p = do (rp,env'') <- patternExtend p env'+ return (rp:rps, env'')+ PRecord fs ->+ return (pattern, foldr (\f e n -> if n == f then f else env n) env fs)++patternRename :: (String -> String) -> (Pattern, CExpr) -> GuidCounter (Pattern, CExpr)+patternRename env (p,e) = do+ (rp,env') <- patternExtend p env+ re <- rename env' e+ return (rp,re)++renameLet env defs e = do env' <- extends env $ concatMap getNames defs+ defs' <- mapM (rename env') defs+ Let defs' `liftM` rename env' e+ where getNames (FnDef n _ _) = [n]+ getNames (OpDef _ _ _ _) = []
+ compiler/Transform/Substitute.hs view
@@ -0,0 +1,28 @@+module Substitute (subst) where++import Ast+import Context+import Control.Arrow (second, (***))++subst :: String -> Expr -> Expr -> Expr+subst old new expr =+ let f (C t s e) = C t s (subst old new e) in+ case expr of+ Range e1 e2 -> Range (f e1) (f e2)+ Access e x -> Access (f e) x+ Remove e x -> Remove (f e) x+ Insert e x v -> Insert (f e) x (f v)+ Modify r fs -> Modify (f r) (map (second f) fs)+ Record fs -> Record (map (\(lbl,as,e) -> (lbl,as,f e)) fs)+ Binop op e1 e2 -> Binop op (f e1) (f e2)+ Lambda x e -> if x == old then expr else Lambda x (f e)+ App e1 e2 -> App (f e1) (f e2)+ If e1 e2 e3 -> If (f e1) (f e2) (f e3)+ MultiIf ps -> MultiIf (map (f *** f) ps)+ Let defs e -> Let (map substDef defs) (f e)+ where substDef (FnDef name vs e) = FnDef name vs (f e)+ substDef (OpDef op a1 a2 e) = OpDef op a1 a2 (f e)+ Var x -> if x == old then new else expr+ Case e cases -> Case (f e) $ map (second f) cases+ Data name es -> Data name (map f es)+ _ -> expr
+ compiler/Types/Alias.hs view
@@ -0,0 +1,139 @@++module Types.Alias (dealias, get, mistakes) where++import Ast+import Control.Arrow (second)+import Data.List (group,sort)+import qualified Data.Map as Map+import qualified Data.Set as Set+import Types.Substitutions (subst)+import Types.Types++builtins :: [(String,([X],Type))]+builtins =+ let touch = ("t0", time) : map (flip (,) int) ["x","y","x0","y0","id"]+ state = [("string", string), ("selectionStart", int), ("selectionEnd", int)]+ line = [("color", tipe "Color"), ("width", float),+ ("cap", tipe "LineCap"), ("join", tipe "LineJoin"),+ ("miterLimit", float), ("dashing", listOf int),+ ("dashOffset", int)]+ makeRecord fields =+ RecordT (Map.fromList $ map (second (:[])) fields) EmptyRecord+ in [ ("String", ([], listOf char)),+ ("Time", ([], float)),+ ("KeyCode", ([], int)),+ ("Touch", ([], makeRecord touch)),+ ("FieldState", ([], makeRecord state)),+ ("LineStyle", ([], makeRecord line))+ ]++get :: [Statement] -> Map.Map String ([X],Type)+get stmts = Map.fromList (builtins ++ concatMap getAlias stmts)+ where getAlias stmt = case stmt of+ TypeAlias alias xs t -> [(alias, (xs,t))]+ _ -> []++dealias :: Map.Map String ([X],Type) -> Type -> Type+dealias aliases t =+ let f = dealias aliases in+ case t of+ ADT name ts -> case Map.lookup name aliases of+ Just (xs,t) -> f (subst (zip xs ts) t)+ Nothing -> ADT name (map f ts)+ LambdaT t u -> LambdaT (f t) (f u)+ RecordT r t -> RecordT (Map.map (map f) r) (f t)+ _ -> t++mistakes :: [Statement] -> [String]+mistakes stmts = badKinds stmts ++ dups stmts ++ badOrder stmts++badKinds :: [Statement] -> [String]+badKinds stmts = map msg (concatMap badS stmts)+ where+ msg x = "Type Error: Type alias '" ++ x +++ "' was given the wrong number of arguments."++ badT :: Type -> [String]+ badT t =+ case t of+ ADT name ts ->+ case Map.lookup name (get stmts) of+ Just (xs,t) | length xs == length ts -> []+ | otherwise -> [name]+ Nothing -> concatMap badT ts+ LambdaT t u -> badT t ++ badT u+ RecordT r t -> badT t ++ concatMap badT (concat (Map.elems r))+ _ -> []++ badS :: Statement -> [String]+ badS s =+ case s of+ Datatype _ _ tcs -> concatMap badT (concatMap snd tcs)+ ExportEvent _ _ tipe -> badT tipe+ ImportEvent _ _ _ tipe -> badT tipe+ TypeAnnotation _ tipe -> badT tipe+ TypeAlias _ _ tipe -> badT tipe+ Definition _ -> []++annotation :: Statement -> [String]+annotation s =+ case s of+ TypeAnnotation name _ -> [name]+ _ -> []++definition :: Statement -> [String]+definition s =+ case s of+ Definition d -> [defName d]+ _ -> []++defName :: Def -> String+defName d =+ case d of+ FnDef n _ _ -> n+ OpDef n _ _ _ -> n++dups :: [Statement] -> [String]+dups stmts = map defMsg (dup definition) ++ map annMsg (dup annotation)+ where+ dup :: (Statement -> [String]) -> [String]+ dup f = map head . filter ((>1) . length) . group . sort $ concatMap f stmts++ msg = "Syntax Error: There can only be one "+ defMsg x = msg ++ "top-level definition of '" ++ x ++ "'."+ annMsg x = msg ++ "type annotation for '" ++ x ++ "'."++badOrder :: [Statement] -> [String]+badOrder stmts = map msg $ missings (sort $ expectedPairs as ds) (sort $ actualPairs stmts)+ where+ msg x = "Syntax Error: The type annotation for '" ++ x +++ "' must be directly above its definition."+ as = sort $ concatMap annotation stmts+ ds = sort $ concatMap definition stmts++ expectedPairs :: [String] -> [String] -> [String]+ expectedPairs as ds =+ case (as,ds) of+ (x:xs, y:ys) -> case compare x y of+ LT -> expectedPairs xs (y:ys)+ EQ -> x : expectedPairs xs ys+ GT -> expectedPairs (x:xs) ys+ ( _ , _ ) -> []++ actualPairs :: [Statement] -> [String]+ actualPairs stmts = + case stmts of+ TypeAnnotation n _ : Definition d : rest ->+ (if n == defName d then [n] else []) ++ actualPairs rest+ t:s:rest -> actualPairs (s:rest)+ _ -> []++ missings :: [String] -> [String] -> [String]+ missings expected actual =+ case (expected, actual) of+ (e:es, a:as) -> case compare e a of+ LT -> e : missings es (a:as)+ EQ -> missings es as+ GT -> a : missings (e:es) as+ ( [] , _ ) -> actual+ ( _ , [] ) -> expected
+ compiler/Types/Constrain.hs view
@@ -0,0 +1,318 @@++module Types.Constrain (constrain) where++import Control.Arrow (second)+import Control.Monad (liftM,mapM,zipWithM,foldM)+import Control.Monad.State (evalState)+import Data.Char (isDigit)+import Data.List (foldl',sort,group,isPrefixOf,intercalate,isSuffixOf)+import qualified Data.Map as Map+import qualified Data.Set as Set++import Ast+import Context+import Guid++import Types.Types+import qualified Types.Substitutions as Subs++beta = VarT `liftM` guid+unionA = Map.unionWith (++)+unionsA = Map.unionsWith (++)++getAliases imports hints = concatMap aliasesFrom imports+ where aliasesFrom (name,method) =+ let values = concatMap (getValue name) hints+ in case method of+ As alias -> map (\(n,t) -> (alias ++ "." ++ n, t)) values+ Hiding vs -> filter (\(n,t) -> n `notElem` vs) values+ Importing vs -> filter (\(n,t) -> n `elem` vs) values+ getValue inModule (name,tipe) =+ case inModule `isPrefixOf` name of+ True -> [ (drop (length inModule + 1) name, tipe) ]+ False -> []++findAmbiguous hints assumptions continue =+ let potentialDups = map head . filter (\g -> length g > 1) . group . sort $+ filter (elem '.') hints+ dups = filter (\k -> Map.member k assumptions) potentialDups+ in case dups of+ n:_ -> return . Left $ "Error: Ambiguous occurrence of '" ++ n +++ "' could refer to " +++ intercalate ", " (filter (isSuffixOf n) hints)+ _ -> continue++mergeSchemes :: [Map.Map String Scheme]+ -> GuidCounter (TVarMap, ConstraintSet, Map.Map String Scheme)+mergeSchemes schmss = do (ass,css,sss) <- unzip3 `liftM` mapM split kvs+ return (Map.unions ass, Set.unions css, Map.unions sss)+ where+ kvs = Map.toList $ Map.unionsWith (++) (map (Map.map (:[])) schmss)+ split (k,vs) =+ let ps = zipWith (\s v -> (s++k,v)) (map (flip replicate '_') [0..]) vs+ eq t u = C (Just $ msg ++ k) NoSpan (VarT t :=: VarT u)+ msg = "the definition of "+ in do xs <- mapM (\_ -> guid) vs+ return ( Map.fromList $ zip (map fst ps) (map (:[]) xs)+ , case xs of+ t:ts -> Set.fromList $ zipWith eq (t:ts) ts+ [] -> Set.empty+ , Map.fromList ps )++constrain typeHints (Module _ _ imports stmts) = do+ (ass,css,schemess) <- unzip3 `liftM` mapM stmtGen stmts+ aliasHints <- getAliases imports `liftM` typeHints+ (as', cs', schemes) <- mergeSchemes schemess+ let constraints = Set.unions (cs':css)+ as = unionsA (as':ass)+ allHints = Map.union schemes (Map.fromList aliasHints)+ insert as n = do v <- guid; return $ Map.insertWith' (\_ x -> x) n [v] as+ assumptions <- foldM insert as (Map.keys schemes)+ findAmbiguous (map fst aliasHints) assumptions $ do+ let f k s vs = map (\v -> C (Just k) NoSpan $ v :<<: s) vs+ cs = concat . Map.elems $ Map.intersectionWithKey f allHints assumptions+ escapees = Map.keys $ Map.difference assumptions allHints+ return $ case escapees of+ _ -> Right (Set.toList constraints ++ cs)+ --_ -> Left ("Undefined variable(s): " ++ intercalate ", " escapees)++type TVarMap = Map.Map String [X]+type ConstraintSet = Set.Set (Context Constraint)++ctx e span = C (Just $ show e) span++gen :: CExpr -> GuidCounter (TVarMap, ConstraintSet, Type)+gen (C _ span expr) =+ let ctx' = C (Just $ show expr) span in+ case expr of+ Var x ->+ do b <- guid+ return (Map.singleton x [b], Set.empty, VarT b)++ App e1 e2 ->+ do (a1,c1,t1) <- gen e1+ (a2,c2,t2) <- gen e2+ b <- beta+ return ( unionA a1 a2+ , Set.unions [c1,c2+ ,Set.singleton . ctx' $ t1 :=: (LambdaT t2 b)]+ , b )++ Lambda x e ->+ do (a,c,t) <- gen e+ b <- beta+ v <- guid+ return ( Map.delete x a+ , Set.union c . Set.fromList .+ map (\x -> ctx' $ VarT x :=: b) $+ Map.findWithDefault [v] x a+ , LambdaT b t )++ Let defs e ->+ do (as,cs,t) <- gen e+ (ass, schemes) <- liftM unzip (mapM defScheme defs)+ let assumptions = unionsA (as:ass)+ getName d = case d of FnDef f _ _ -> f+ OpDef op _ _ _ -> op+ names = map getName defs+ genCs name s = do+ v <- guid+ let vs = Map.findWithDefault [v] name assumptions+ return $ map (\x -> ctx name span $ x :<<: s) vs+ cs' <- zipWithM genCs names schemes+ return ( foldr Map.delete assumptions names+ , Set.union (Set.fromList . concat $ cs') cs+ , t )++ Case e cases ->+ do (as,cs,t) <- gen e+ (ass,css,ts) <- liftM unzip3 $ mapM (caseGen t) cases+ return ( unionsA $ as:ass+ , let cases' = map snd cases+ ctxs = zipWith epos cases' (tail cases')+ csts = zipWith (:=:) ts (tail ts)+ cs' = Set.fromList (zipWith ($) ctxs csts)+ in Set.unions $ cs' : cs : css+ , head ts)++ If e1 e2 e3 ->+ do (a1,c1,t1) <- gen e1+ (a2,c2,t2) <- gen e2+ (a3,c3,t3) <- gen e3+ return ( unionsA [a1,a2,a3]+ , let c4 = Set.fromList [ ctx e1 span (t1 :=: bool)+ , ctx' (t2 :=: t3) ]+ in Set.unions [c1,c2,c3,c4]+ , t2 )++ Data name es ->+ gen $ foldl' (\f x -> epos f x $ App f x) (ctx' $ Var name) es++ Binop op e1 e2 ->+ gen $ ctx' (App (ctx' $ App (ctx' $ Var op) e1) e2)++ Access e label ->+ do (as,cs,rtype) <- gen e+ t <- beta+ rtype' <- beta+ let fs = Map.singleton label [t]+ c = (ctx' (RecordT fs rtype' :=: rtype))+ return (as, Set.insert c cs, t)++ Remove e x -> + do (as,cs,rtype) <- gen e+ t <- beta+ rtype' <- beta+ let c = (ctx' (RecordT (Map.singleton x [t]) rtype' :=: rtype))+ return (as, Set.insert c cs, rtype')++ Insert e x v -> + do (eas,ecs,etype) <- gen e+ (vas,vcs,vtype) <- gen v+ return ( unionA eas vas+ , Set.union ecs vcs+ , RecordT (Map.singleton x [vtype]) etype )++ Modify record fields ->+ do (ras,rcs,rtype) <- gen record+ (ass,css,newTs) <- unzip3 `liftM` mapM gen (map snd fields)+ oldTs <- mapM (\_ -> beta) fields+ rtype' <- beta+ let rT ts = RecordT (recordT (zip (map fst fields) ts)) rtype'+ c = Set.singleton (ctx' (rtype :=: rT oldTs))+ return ( unionsA (ras:ass), Set.unions (c : rcs : css), rT newTs )++ Record fields ->+ let insert label tipe = Map.insertWith (++) label [tipe]+ getScheme (f,args,e) = do+ (as, _, (label, Forall _ cs tipe)) <- defGenHelp f args e+ return (as, cs, insert label tipe)+ in do (ass, css, fs) <- unzip3 `liftM` mapM getScheme fields+ return ( unionsA ass+ , Set.fromList (concat css)+ , RecordT (foldr ($) Map.empty fs) EmptyRecord )++ Range e1@(C w1 s1 _) e2@(C w2 s2 _) ->+ do (a1,c1,t1) <- gen e1+ (a2,c2,t2) <- gen e2+ return ( unionsA [a1,a2]+ , Set.unions [ c1, c2, Set.fromList [ C w1 s1 (t1 :=: int)+ , C w1 s2 (t2 :=: int) ] ]+ , listOf int )++ MultiIf ps -> do (ass,css,t:ts) <- unzip3 `liftM` mapM genPair ps+ let cs = Set.fromList (map (ctx' . (t :=:)) ts)+ return (unionsA ass, Set.unions (cs:css), t)+ where genPair (b@(C t s _),e) = do + (a1,c1,t1) <- gen b+ (a2,c2,t2) <- gen e+ return ( unionsA [a1,a2]+ , Set.unions [ c1, c2+ , Set.singleton (C t s (t1 :=: bool)) ]+ , t2 )++ IntNum _ -> do t <- beta+ return (Map.empty, Set.singleton (ctx' $ t :<: number), t)++ FloatNum _ -> primitive float+ Chr _ -> primitive char+ Str _ -> primitive string+ Boolean _ -> primitive bool+ Markdown _ -> primitive element+++primitive :: Type -> GuidCounter (TVarMap, ConstraintSet, Type)+primitive t = return (Map.empty, Set.empty, t)++caseGen :: Type+ -> (Pattern, CExpr)+ -> GuidCounter (TVarMap, ConstraintSet, Type)+caseGen tipe (p, ce@(C _ span e)) = do+ (as ,cs ,t) <- gen ce+ (as',cs',_) <- patternGen (ctx p span) tipe as p+ return ( as', Set.union cs cs', t )++patternGen :: (Constraint -> Context Constraint)+ -> Type -- Type of e in `case e of ...`+ -> TVarMap+ -> Pattern+ -> GuidCounter (TVarMap, ConstraintSet, Type)+patternGen ctxt tipe as pattern =+ case pattern of+ PAnything -> do b <- beta ; return ( as, Set.empty, b )+ PVar v -> do+ b <- beta+ let cs = map (ctxt . (b :=:) . VarT) (Map.findWithDefault [] v as)+ return ( Map.delete v as, Set.fromList (ctxt (b :=: tipe) : cs), b )+ PData name ps -> do+ constr <- guid+ output <- beta+ let step (as,cs,tipe) p = do b <- beta+ (as',cs',t) <- patternGen ctxt b as p+ return (as', Set.union cs cs', t ==> tipe)+ (as',cs, t) <- foldM step (as,Set.empty,tipe) (reverse ps)+ return ( Map.insert name [constr] as'+ , Set.insert (ctxt (VarT constr :=: t)) cs+ , output )+ PRecord fs ->+ do pairs <- mapM (\f -> do b <- beta; return (f,b)) fs+ b <- beta+ let t = RecordT (Map.fromList $ map (second (:[])) pairs) b+ mkCs (name,tipe) = map (ctxt . (tipe :=:) . VarT)+ (Map.findWithDefault [] name as)+ return ( foldr Map.delete as fs+ , Set.fromList (ctxt (t :=: tipe) : concatMap mkCs pairs)+ , t )+++defScheme :: Def -> GuidCounter (Map.Map String [X], Scheme)+defScheme def = do (as,cs,hint) <- defGen def+ return ( as, snd hint )++defGen def = case def of+ FnDef f args e -> defGenHelp f args e+ OpDef op a1 a2 e -> defGenHelp op [a1,a2] e++defGenHelp name args e = do+ argDict <- mapM (\a -> liftM ((,) a) guid) args + (as,cs,t) <- gen e+ let as' = foldr Map.delete as args+ tipe = foldr (==>) t $ map (VarT . snd) argDict+ genCs (arg,x) = do+ v <- guid+ let as' = Map.findWithDefault [v] arg as+ return $ map (\y -> ctx arg NoSpan $ VarT x :=: VarT y) as'+ cs' <- concat `liftM` mapM genCs argDict+ scheme <- Subs.generalize (concat $ Map.elems as') $+ Forall (map snd argDict) (cs' ++ Set.toList cs) tipe+ return ( as', Set.empty, (name, scheme) )+++stmtGen :: Statement+ -> GuidCounter (TVarMap, ConstraintSet, Map.Map String Scheme)+stmtGen stmt =+ case stmt of+ Definition def -> do (as,cs,hint) <- defGen def+ return ( as, cs, uncurry Map.singleton hint )++ Datatype name xs tcs ->+ let toScheme ts = Forall xs [] (foldr (==>) (ADT name $ map VarT xs) ts)+ in return (Map.empty, Set.empty, Map.fromList (map (second toScheme) tcs))++ ExportEvent js elm tipe ->+ do x <- guid+ return ( Map.singleton elm [x]+ , Set.singleton . ctx elm NoSpan $ VarT x :=: tipe+ , Map.empty )++ ImportEvent js e@(C txt span base) elm tipe ->+ do (as,cs,t) <- gen e+ return ( as+ , Set.insert (C txt span (signalOf t :=: tipe)) cs+ , Map.singleton elm (Forall [] [] tipe) )++ TypeAnnotation name tipe ->+ do schm <- Subs.generalize [] =<< Subs.superize name tipe+ return (Map.empty, Set.empty, Map.singleton name schm)++ TypeAlias _ _ _ -> return (Map.empty, Set.empty, Map.empty)
+ compiler/Types/Hints.hs view
@@ -0,0 +1,31 @@+module Types.Hints (hints) where++import Control.Arrow (first)+import Control.Monad (liftM)+import Data.Maybe (catMaybes)+import qualified Data.Map as Map+import Guid+import qualified Libraries as Libs+import Parse.Library (iParse)+import Parse.Types+import qualified Types.Substitutions as Subs+import Types.Types++hints :: GuidCounter [(String, Scheme)]+hints = liftM catMaybes (mapM toScheme values)+ where+ values :: [(String, String)]+ values = addPrefixes (Map.toList (Map.map Map.toList Libs.libraries))++ addPrefixes :: [(String,[(String, String)])] -> [(String, String)]+ addPrefixes = concatMap (\(m,vs) -> map (first (\n -> m ++ "." ++ n)) vs)++ toScheme :: (String, String) -> GuidCounter (Maybe (String, Scheme))+ toScheme (name, 't':'y':'p':'e':' ':_) = return Nothing+ toScheme (name, 'd':'a':'t':'a':' ':_) = return Nothing+ toScheme (name, tipeString) =+ let err = "compiler error parsing type of " ++ name ++ ":\n" ++ tipeString in+ case iParse (fmap toType typeExpr) err tipeString of+ Left err -> error (show err)+ Right tipe -> do scheme <- Subs.generalize [] =<< Subs.superize name tipe+ return (Just (name, scheme))
+ compiler/Types/Solver.hs view
@@ -0,0 +1,211 @@++module Types.Solver (solver) where++import Context+import Control.Arrow (second)+import Control.Monad (liftM)+import Data.Either (lefts,rights)+import Data.List (foldl')+import Data.Maybe (isJust)+import qualified Data.Set as Set+import qualified Data.Map as Map+import Guid+import Types.Types+import Types.Constrain+import Types.Substitutions+import Types.Alias (dealias)++isSolved ss (C _ _ (t1 :=: t2)) = t1 == t2+isSolved ss (C _ _ (x :<<: _)) = isJust (lookup x ss)+isSolved ss c = False++type Aliases = Map.Map String ([X],Type)++crush :: Aliases -> Scheme -> GuidCounter (Either String Scheme)+crush aliases (Forall xs cs t) =+ do subs <- solver aliases Map.empty cs+ return $ do ss' <- subs+ let ss = Map.toList ss'+ cs' = filter (not . isSolved ss) (subst ss cs)+ return $ Forall xs cs' (subst ss t)++schemeSubHelp txt span x s t1 rltn t2 = do+ (t1',cs1) <- sub t1+ (t2',cs2) <- sub t2+ return (C txt span (rltn t1' t2') : cs1 ++ cs2)+ where sub t | not (occurs x t) = return (t, [])+ | otherwise = do (st, cs) <- concretize s+ return (subst [(x,st)] t, cs)++schemeSub aliases x s c =+ do s' <- crush aliases s+ case s' of+ Right s'' -> Right `liftM` schemeSub' x s'' c+ Left err -> return $ Left err++schemeSub' x s c@(C txt span constraint) =+ case constraint of+ (t1 :=: t2) -> schemeSubHelp txt span x s t1 (:=:) t2+ (t1 :<: t2) -> schemeSubHelp txt span x s t1 (:<:) t2+ (y :<<: Forall cxs ccs ctipe)+ | not (occurs x c) -> return [c]+ | otherwise ->+ do Forall xs cs tipe <- rescheme s+ let ss = [(x,tipe)]+ constraints = subst ss (cs ++ ccs)+ c' = y :<<: Forall (cxs ++ xs) constraints (subst ss ctipe)+ return [ C txt span c' ]++recordConstraints eq fs t fs' t' =+ liftM concat . sequence $+ [ constrain fs fs'+ , liftM concat . mapM (\(k,ts) -> zipper [] k ts []) . Map.toList $+ Map.difference fs fs'+ , liftM concat . mapM (\(k,ts) -> zipper [] k [] ts) . Map.toList $+ Map.difference fs' fs+ ]+ where constrain :: Map.Map String [Type] -> Map.Map String [Type]+ -> GuidCounter [Context Constraint]+ constrain as bs = liftM concat . sequence . Map.elems $+ Map.intersectionWithKey (zipper []) as bs+ zipper :: [Context Constraint] -> String -> [Type] -> [Type]+ -> GuidCounter [Context Constraint]+ zipper cs k xs ys =+ case (xs,ys) of+ (a:as, b:bs) -> zipper (eq a b : cs) k as bs+ ([],[]) -> return cs+ (as,[]) -> do x <- guid+ let tipe = RecordT (Map.singleton k as) (VarT x)+ return (cs ++ [eq t' tipe])+ ([],bs) -> do x <- guid+ let tipe = RecordT (Map.singleton k bs) (VarT x)+ return (cs ++ [eq t tipe])+ +solver :: Aliases+ -> Map.Map X Type+ -> [Context Constraint]+ -> GuidCounter (Either String (Map.Map X Type))+solver _ subs [] = return $ Right subs+solver aliases subs (C txt span c : cs) =+ let ctx = C txt span+ eq t1 t2 = ctx (t1 :=: t2)+ solv = solver aliases subs+ uniError' = uniError (\t1 t2 -> solv (eq t1 t2 : cs)) aliases txt span+ in case c of+ -- Destruct Type-constructors+ t1@(ADT n1 ts1) :=: t2@(ADT n2 ts2) ->+ if n1 == n2 then solv (zipWith eq ts1 ts2 ++ cs)+ else uniError' t1 t2++ LambdaT t1 t2 :=: LambdaT t1' t2' ->+ solv ([ eq t1 t1', eq t2 t2' ] ++ cs)++ RecordT fs t :=: RecordT fs' t' ->+ do cs' <- recordConstraints eq fs t fs' t'+ solv (cs' ++ cs)++ -- Type-equality+ VarT x :=: VarT y+ | x == y -> solv cs+ | otherwise ->+ case (Map.lookup x subs, Map.lookup y subs) of+ (Just (Super xts), Just (Super yts)) ->+ let ts = Set.intersection xts yts+ setXY t = Map.insert x t . Map.insert y t+ in case Set.toList ts of+ [] -> unionError txt span xts yts+ [t] -> let cs1 = subst [(x,t),(y,t)] cs in+ cs1 `seq` solver aliases (setXY t subs) cs1+ _ -> solver aliases (setXY (Super ts) subs) cs+ (Just (Super xts), _) ->+ let cs2 = subst [(y,VarT x)] cs in+ solver aliases (Map.insert y (VarT x) subs) cs2+ (_, _) ->+ let cs3 = subst [(x,VarT y)] cs in+ solver aliases (Map.insert x (VarT y) subs) cs3++ VarT x :=: t -> do+ if x `occurs` t then occursError txt span (VarT x) t else+ (case Map.lookup x subs of+ Nothing ->+ let cs4 = subst [(x,t)] cs+ subs' = Map.map (subst [(x,t)]) $ Map.insert x t subs+ in solver aliases subs' cs4+ Just (Super ts) ->+ let ts' = Set.intersection ts (Set.singleton t) in+ case Set.toList ts' of+ [] -> solv (ctx (t :<: Super ts) : cs)+ [t'] -> let cs5 = subst [(x,t)] cs in+ solver aliases (Map.insert x t' subs) cs5+ _ -> solver aliases (Map.insert x (Super ts') subs) cs+ Just t' -> solv (ctx (t' :=: t) : cs)+ )++ t :=: VarT x -> solv ((ctx (VarT x :=: t)) : cs)++ t1 :=: t2 | t1 == t2 -> solv cs+ | otherwise -> uniError' t1 t2++ -- subtypes+ VarT x :<: Super ts ->+ case Map.lookup x subs of+ Nothing -> solver aliases (Map.insert x (Super ts) subs) cs+ Just (Super ts') ->+ case Set.toList $ Set.intersection ts ts' of+ [] -> unionError txt span ts ts'+ [t] -> solver aliases (Map.insert x t subs) (subst [(x,t)] cs)+ ts'' -> solver aliases subs' cs+ where subs' = Map.insert x (Super $ Set.fromList ts'') subs++ ADT "List" [t] :<: Super ts+ | any f (Set.toList ts) -> solv cs+ | otherwise -> subtypeError txt span (ADT "List" [t]) (Super ts)+ where f (ADT "List" [VarT _]) = True+ f (ADT "List" [t']) = dealias aliases t == t'+ f _ = False++ t :<: Super ts+ | Set.member t ts -> solv cs+ | Set.member (dealias aliases t) ts -> solv cs+ | otherwise -> subtypeError txt span t (Super ts)++ x :<<: s+ | any (occurs x) cs ->+ do css <- mapM (schemeSub aliases x s) cs+ case lefts css of+ err : _ -> return $ Left err+ [] -> solv (concat (rights css))+ | otherwise ->+ do (t,cs7) <- concretize s+ solv (cs ++ ctx (VarT x :=: t) : cs7)++showMsg msg = case msg of+ Just str -> "\nIn context: " ++ str+ Nothing -> ""++occursError msg span t1 t2 =+ return . Left $ concat+ [ "Type error (" ++ show span ++ "):\n"+ , "Occurs check: cannot construct the infinite type:\n"+ , show t1, " = ", show t2, showMsg msg ]++uniError solveWith aliases msg span t1 t2 =+ let t1' = dealias aliases t1+ t2' = dealias aliases t2+ in if t1 /= t1' || t2 /= t2'+ then solveWith t1' t2'+ else return . Left $ concat+ [ "Type error (" ++ show span ++ "):\n"+ , show t1, " is not equal to ", show t2, showMsg msg ]++unionError msg span ts ts' =+ return . Left $ concat+ [ "Type error (" ++ show span ++ "):\n"+ , "There are no types in both "+ , show (Super ts), " and ", show (Super ts'), showMsg msg ]++subtypeError msg span t s =+ return . Left $ concat+ [ "Type error (" ++ show span ++ "):\n"+ , show t, " is not a ", show s, showMsg msg ]+
+ compiler/Types/Substitutions.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Types.Substitutions (subst,+ occurs,+ freeVars,+ concretize,+ rescheme,+ generalize,+ superize) where++import Ast+import Context+import Control.Monad (liftM, liftM2)+import Control.Monad.State (runState, State, get, put)+import Data.List (nub)+import qualified Data.Set as Set+import qualified Data.Map as Map+import Guid+import Types.Types++class Subst a where+ subst :: [(X,Type)] -> a -> a++instance Subst Type where+ subst ss t =+ case t of+ VarT x -> case lookup x ss of+ Nothing -> VarT x+ Just (Super _) -> VarT x+ Just t -> t+ LambdaT t1 t2 -> LambdaT (subst ss t1) (subst ss t2)+ ADT name ts -> ADT name (subst ss ts)+ RecordT fs t -> RecordT (Map.map (subst ss) fs) (subst ss t)+ EmptyRecord -> EmptyRecord+ Super ts -> Super ts++instance Subst Scheme where+ subst ss (Forall vs cs t) = Forall vs (subst ss cs) (subst ss t)++instance Subst Constraint where+ subst ss (t1 :=: t2) = subst ss t1 :=: subst ss t2+ subst ss (t :<: super) = subst ss t :<: super+ subst ss (x :<<: poly) = x :<<: subst ss poly++instance Subst a => Subst (Context a) where+ subst ss (C str span c) = C str span (subst ss c)++instance Subst a => Subst [a] where+ subst ss as = map (subst ss) as+++class FreeVars a where+ freeVars :: a -> [X]++instance FreeVars Type where+ freeVars t =+ case t of+ VarT v -> [v]+ LambdaT t1 t2 -> freeVars t1 ++ freeVars t2+ ADT _ ts -> concatMap freeVars ts+ RecordT fs t -> freeVars (concat $ Map.elems fs) ++ freeVars t+ EmptyRecord -> []+ Super _ -> []++instance FreeVars Constraint where+ freeVars (t1 :=: t2) = freeVars t1 ++ freeVars t2+ freeVars (t1 :<: t2) = freeVars t1 ++ freeVars t2+ freeVars (x :<<: Forall xs cs t) = filter (`notElem` xs) frees+ where frees = concatMap freeVars cs ++ freeVars t++instance FreeVars a => FreeVars (Context a) where+ freeVars (C _ _ c) = freeVars c ++instance FreeVars a => FreeVars [a] where+ freeVars = concatMap freeVars++occurs x t = x `elem` freeVars t++concretize :: Scheme -> GuidCounter (Type, [Context Constraint])+concretize (Forall xs cs t) = do+ ss <- zip xs `liftM` mapM (\_ -> liftM VarT guid) xs+ return (subst ss t, subst ss cs)++rescheme :: Scheme -> GuidCounter Scheme+rescheme (Forall xs cs t) = do+ xs' <- mapM (const guid) xs+ let ss = zip xs (map VarT xs')+ return $ Forall xs' (subst ss cs) (subst ss t)++generalize :: [X] -> Scheme -> GuidCounter Scheme+generalize exceptions (Forall xs cs t) = rescheme (Forall (xs ++ frees) cs t)+ where allFrees = Set.fromList $ freeVars t ++ concatMap freeVars cs+ frees = Set.toList $ Set.difference allFrees (Set.fromList exceptions)++newtype Superize a = S { runSuper :: State ([X], [X], [X]) a }+ deriving (Monad)++superize :: String -> Type -> GuidCounter Scheme+superize name tipe =+ do constraints <- liftM concat $+ sequence [ mapM (<: nmbr) (nub ns)+ , mapM (<: apnd) (nub as)+ , mapM (<: comp) (nub cs) ]+ return (Forall (concat [ns,as,cs]) constraints tipe')+ where+ (tipe', (ns,as,cs)) = runState (runSuper (go tipe)) ([],[],[])+ t <: super = do x <- guid+ return $ C (Just name) NoSpan (VarT t :<: super x)++ nmbr t = number+ apnd t = appendable t+ comp t = comparable t++ go :: Type -> Superize Type+ go t =+ case t of+ EmptyRecord -> return t+ Super _ -> return t+ VarT _ -> return t+ LambdaT t1 t2 -> liftM2 LambdaT (go t1) (go t2)+ ADT "Number" [VarT t] -> addNumber t+ ADT "Appendable" [VarT t] -> addAppendable t+ ADT "Comparable" [VarT t] -> addComparable t+ ADT name ts -> liftM (ADT name) (mapM go ts)+ RecordT fs t -> liftM2 RecordT fs' (go t)+ where pairs = Map.toList fs+ fs' = do ps <- mapM (\(f,t) -> liftM ((,) f) (mapM go t)) pairs+ return (Map.fromList ps)++ add :: (X -> ([X],[X],[X]) -> ([X],[X],[X])) -> X -> Superize Type+ add f v = S $ do (ns, as, cs) <- get+ put $ f v (ns, as, cs)+ return (VarT v)++ addNumber = add (\n (ns,as,cs) -> (n:ns,as,cs))+ addAppendable = add (\a (ns,as,cs) -> (ns,a:as,cs))+ addComparable = add (\c (ns,as,cs) -> (ns,as,c:cs))
+ compiler/Types/Types.hs view
@@ -0,0 +1,94 @@++module Types.Types where++import Context+import Data.Char (isDigit)+import Data.List (intercalate,isPrefixOf)+import qualified Data.Set as Set+import qualified Data.Map as Map++type X = Int++data Type = LambdaT Type Type+ | VarT X+ | ADT String [Type]+ | EmptyRecord+ | RecordT (Map.Map String [Type]) Type+ | Super (Set.Set Type)+ deriving (Eq, Ord)++data Scheme = Forall [X] [Context Constraint] Type deriving (Eq, Ord, Show)++data Constraint = Type :=: Type+ | Type :<: Type+ | X :<<: Scheme+ deriving (Eq, Ord, Show)++recordT :: [(String,Type)] -> Map.Map String [Type]+recordT fields =+ foldl (\r (x,t) -> Map.insertWith (++) x [t] r) Map.empty fields++recordOf :: [(String,Type)] -> Type+recordOf fields = RecordT (recordT fields) EmptyRecord++tipe t = ADT t []++int = tipe "Int"+float = tipe "Float"+time = tipe "Time"+date = tipe "Date"++char = tipe "Char"+bool = tipe "Bool"+text = tipe "Text"+order = tipe "Order"+string = tipe "String"++number = Super $ Set.fromList [ int, float, time ]+appendable t = Super $ Set.fromList [ string, text, listOf (VarT t) ]+comparable t = Super $ Set.fromList [ int, float, char, string, time, date ]++element = tipe "Element"++listOf t = ADT "List" [t]+signalOf t = ADT "Signal" [t]+tupleOf ts = ADT ("Tuple" ++ show (length ts)) ts+maybeOf t = ADT "Maybe" [t]+eitherOf a b = ADT "Either" [a,b]+pairOf t = tupleOf [t,t]+point = pairOf int++infixr ==>+t1 ==> t2 = LambdaT t1 t2++infix 8 -:+name -: tipe = (,) name $ Forall [] [] tipe++parens = ("("++) . (++")")++instance Show Type where+ show t =+ let addParens (c:cs) =+ if notElem ' ' cs || c == '(' then c:cs else parens (c:cs)+ in case t of+ LambdaT t1@(LambdaT _ _) t2 -> parens (show t1) ++ " -> " ++ show t2+ LambdaT t1 t2 -> show t1 ++ " -> " ++ show t2+ VarT x -> 't' : show x+ ADT "List" [ADT "Char" []] -> "String"+ ADT "List" [tipe] -> "[" ++ show tipe ++ "]"+ ADT name cs ->+ if isTupleString name+ then parens . intercalate "," $ map show cs+ else name ++ concatMap ((' ':) . addParens . show) cs+ Super ts -> "{" ++ (intercalate "," . map show $ Set.toList ts) ++ "}"+ EmptyRecord -> "{}"+ RecordT fs t ->+ start ++ intercalate ", " (concatMap fields $ Map.toList fs) ++ " }"+ where field n s = n ++ " : " ++ show s+ fields (n,ss) = map (field n) ss+ start = case t of+ EmptyRecord -> "{ "+ _ -> "{ " ++ show t ++ " | "+++isTupleString str = "Tuple" `isPrefixOf` str && all isDigit (drop 5 str)
+ compiler/Types/Unify.hs view
@@ -0,0 +1,16 @@++module Types.Unify (unify) where++import Control.Monad (liftM)+import qualified Data.Map as Map++import Ast+import Guid+import Types.Constrain+import Types.Solver+import Types.Alias as Alias++unify hints modul@(Module _ _ _ stmts) = run $ do+ constraints <- constrain hints modul+ either (return . Left) (solver (Alias.get stmts) Map.empty) constraints+
+ docs.json view
@@ -0,0 +1,1715 @@+{ "modules" : [ + { "name" : "Window", + "values" : [ + { "name" : "dimensions", + "type" : "Signal (Int,Int)", + "desc" : "The current dimensions of the window (i.e. the area viewable to the\nuser, not including scroll bars).\n" + }, + { "name" : "width", + "type" : "Signal Int", + "desc" : "The current width of the window.\n" + }, + { "name" : "height", + "type" : "Signal Int", + "desc" : "The current height of the window.\n" + } + ] + }, + { "name" : "WebSocket", + "values" : [ + { "name" : "connect", + "type" : "String -> Signal String -> Signal String", + "desc" : "Create a web-socket. The first argument is the URL of the desired\nweb-socket server. The input signal holds the outgoing messages,\nand the resulting signal contains the incoming ones.\n" + } + ] + }, + { "name" : "Touch", + "values" : [ + { "name" : "Touch", + "type" : "type Touch = { x:Int, y:Int, id:Int, x0:Int, y0:Int, t0:Time }", + "desc" : "Every `Touch` has `xy` coordinates. It also has an identifier `id` to\ndistinguish one touch from another.\n\nA touch also keeps info about the intial point and time of contact:\n`x0`, `y0`, and `t0`. This helps compute more complicated gestures\nlike taps, drags, and swipes which need to know about timing or direction.\n" + }, + { "name" : "touches", + "type" : "Signal [Touch]", + "desc" : "A list of ongoing touches.\n" + }, + { "name" : "taps", + "type" : "Signal { x:Int, y:Int }", + "desc" : "The last position that was tapped. Default value is `{x=0,y=0}`.\nUpdates whenever the user taps the screen.\n" + } + ] + }, + { "name" : "Time", + "values" : [ + { "name" : "Time", + "type" : "type Time = Float", + "desc" : "Type alias to make it clearer when you are working with time values.\nUsing the `Time` constants instead of raw numbers is very highly recommended.\n" + }, + { "name" : "millisecond", + "type" : "Time", + "desc" : "Units of time, making it easier to specify things like a\nhalf-second `(500 * milliseconds)` without remembering Elm’s\nunderlying units of time.\n" + }, + { "name" : "second", + "type" : "Time", + "desc" : "" + }, + { "name" : "minute", + "type" : "Time", + "desc" : "" + }, + { "name" : "hour", + "type" : "Time", + "desc" : "" + }, + { "name" : "inMilliseconds", + "type" : "Time -> Float", + "desc" : "" + }, + { "name" : "inSeconds", + "type" : "Time -> Float", + "desc" : "" + }, + { "name" : "inMinutes", + "type" : "Time -> Float", + "desc" : "" + }, + { "name" : "inHours", + "type" : "Time -> Float", + "desc" : "" + }, + { "name" : "fps", + "type" : "Number a -> Signal Time", + "desc" : "Takes desired number of frames per second (fps). The resulting signal\ngives a sequence of time deltas as quickly as possible until it reaches\nthe desired FPS. A time delta is the time between the last frame and the\ncurrent frame.\n" + }, + { "name" : "fpsWhen", + "type" : "Number a -> Signal Bool -> Signal Time", + "desc" : "Same as the fps function, but you can turn it on and off. Allows you\nto do brief animations based on user input without major inefficiencies.\nThe first time delta after a pause is always zero, no matter how long\nthe pause was. This way summing the deltas will actually give the amount\nof time that the output signal has been running.\n" + }, + { "name" : "every", + "type" : "Time -> Signal Time", + "desc" : "Takes a time interval t. The resulting signal is the current time,\nupdated every t.\n" + }, + { "name" : "since", + "type" : "Time -> Signal a -> Signal Bool", + "desc" : "Takes a time `t` and any signal. The resulting boolean signal\nis true for time `t` after every event on the input signal.\nSo ``(second `since` Mouse.clicks)`` would result in a signal\nthat is true for one second after each mouse click and false\notherwise.\n" + }, + { "name" : "timestamp", + "type" : "Signal a -> Signal (Time, a)", + "desc" : "Add a timestamp to any signal. Timestamps increase monotonically. Each\ntimestamp is related to a specfic event, so `Mouse.x` and `Mouse.y` will\nalways have the same timestamp because they both rely on the same\nunderlying event.\n" + }, + { "name" : "delay", + "type" : "Time -> Signal a -> Signal a", + "desc" : "Delay a signal by a certain amount of time. So `(delay second Mouse.clicks)`\nwill update one second later than any mouse click.\n" + } + ] + }, + { "name" : "Text", + "values" : [ + { "name" : "toText", + "type" : "String -> Text", + "desc" : "Convert a string into text which can be styled and displayed.\n" + }, + { "name" : "typeface", + "type" : "String -> Text -> Text", + "desc" : "Set the typeface of some text. The first argument should be a comma separated listing of the desired typefaces\n \"helvetica, arial, sans-serif\"\nWorks the same as the CSS font-family property.\n" + }, + { "name" : "monospace", + "type" : "Text -> Text", + "desc" : "Switch to a monospace typeface. Good for code snippets.\n" + }, + { "name" : "header", + "type" : "Text -> Text", + "desc" : "Make text big and noticable.\n" + }, + { "name" : "link", + "type" : "String -> Text -> Text", + "desc" : "Create a link.\n" + }, + { "name" : "height", + "type" : "Float -> Text -> Text", + "desc" : "Set the height of text in \\\"ems\\\". 1em is the normal height of text. 2ems is twice that height.\n" + }, + { "name" : "color", + "type" : "Color -> Text -> Text", + "desc" : "Set the color of a string.\n" + }, + { "name" : "bold", + "type" : "Text -> Text", + "desc" : "Make a string bold.\n" + }, + { "name" : "italic", + "type" : "Text -> Text", + "desc" : "Italicize a string.\n" + }, + { "name" : "overline", + "type" : "Text -> Text", + "desc" : "Draw a line above a string.\n" + }, + { "name" : "underline", + "type" : "Text -> Text", + "desc" : "Underline a string.\n" + }, + { "name" : "strikeThrough", + "type" : "Text -> Text", + "desc" : "Draw a line through a string.\n" + }, + { "name" : "justified", + "type" : "Text -> Element", + "desc" : "Display justified, styled text.\n" + }, + { "name" : "centered", + "type" : "Text -> Element", + "desc" : "Display centered, styled text.\n" + }, + { "name" : "righted", + "type" : "Text -> Element", + "desc" : "Display right justified, styled text.\n" + }, + { "name" : "text", + "type" : "Text -> Element", + "desc" : "Display styled text.\n" + }, + { "name" : "plainText", + "type" : "String -> Element", + "desc" : "Display a plain string.\n" + }, + { "name" : "asText", + "type" : "a -> Element", + "desc" : "Convert anything to it's textual representation and make it displayable in browser\n\n asText == text . monospace . show\n\nExcellent for debugging.\n" + } + ] + }, + { "name" : "Signal", + "values" : [ + { "name" : "constant", + "type" : "a -> Signal a", + "desc" : "Create a constant signal that never changes.\n" + }, + { "name" : "lift", + "type" : "(a -> b) -> Signal a -> Signal b", + "desc" : "Transform a signal with a given function.\n" + }, + { "name" : "lift2", + "type" : "(a -> b -> c) -> Signal a -> Signal b -> Signal c", + "desc" : "Combine two signals with a given function.\n" + }, + { "name" : "lift3", + "type" : "(a -> b -> c -> d) -> Signal a -> Signal b -> Signal c -> Signal d", + "desc" : "Combine three signals with a given function.\n" + }, + { "name" : "lift4", + "type" : "(a -> b -> c -> d -> e) -> Signal a -> Signal b -> Signal c -> Signal d -> Signal e", + "desc" : "" + }, + { "name" : "lift5", + "type" : "(a -> b -> c -> d -> e -> f) -> Signal a -> Signal b -> Signal c -> Signal d -> Signal e -> Signal f", + "desc" : "" + }, + { "name" : "lift6", + "type" : "(a -> b -> c -> d -> e -> f -> g)\n -> Signal a -> Signal b -> Signal c -> Signal d -> Signal e -> Signal f -> Signal g", + "desc" : "" + }, + { "name" : "lift7", + "type" : "(a -> b -> c -> d -> e -> f -> g -> h)\n -> Signal a -> Signal b -> Signal c -> Signal d -> Signal e -> Signal f -> Signal g -> Signal h", + "desc" : "" + }, + { "name" : "lift8", + "type" : "(a -> b -> c -> d -> e -> f -> g -> h -> i)\n -> Signal a -> Signal b -> Signal c -> Signal d -> Signal e -> Signal f -> Signal g -> Signal h -> Signal i", + "desc" : "" + }, + { "name" : "foldp", + "type" : "(a -> b -> b) -> b -> Signal a -> Signal b", + "desc" : "Create a past-dependent signal. Each value given on the input signal will\nbe accumulated, producing a new output value.\n\nFor instance, `(foldp (\\\\t acc -> acc + 1) 0 (Time.every second))` increments every second.\n" + }, + { "name" : "merge", + "type" : "Signal a -> Signal a -> Signal a", + "desc" : "Merge two signals into one, biased towards the first signal if both signals\nupdate at the same time.\n" + }, + { "name" : "merges", + "type" : "[Signal a] -> Signal a", + "desc" : "Merge many signals into one, biased towards the left-most signal if multiple\nsignals update simultaneously.\n" + }, + { "name" : "combine", + "type" : "[Signal a] -> Signal [a]", + "desc" : "Combine a list of signals into a signal of lists.\n" + }, + { "name" : "count", + "type" : "Signal a -> Signal Int", + "desc" : "Count the number of events that have occured.\n" + }, + { "name" : "countIf", + "type" : "(a -> Bool) -> Signal a -> Signal Int", + "desc" : "Count the number of events that have occured that satisfy a given predicate.\n" + }, + { "name" : "keepIf", + "type" : "(a -> Bool) -> a -> Signal a -> Signal a", + "desc" : "Keep only events that satisfy the given predicate. Elm does not allow\nundefined signals, so a base case must be provided in case the predicate is\nnever satisfied.\n" + }, + { "name" : "dropIf", + "type" : "(a -> Bool) -> a -> Signal a -> Signal a", + "desc" : "Drop events that satisfy the given predicate. Elm does not allow undefined\nsignals, so a base case must be provided in case the predicate is never\nsatisfied.\n" + }, + { "name" : "keepWhen", + "type" : "Signal Bool -> a -> Signal a -> Signal a", + "desc" : "Keep events only when the first signal is true. When the first signal becomes\ntrue, the most recent value of the second signal will be propagated. Until\nthe first signal becomes false again, all events will be propagated. Elm does\nnot allow undefined signals, so a base case must be provided in case the first\nsignal is never true.\n" + }, + { "name" : "dropWhen", + "type" : "Signal Bool -> a -> Signal a -> Signal a", + "desc" : "Drop events when the first signal is true. When the first signal becomes false,\nthe most recent value of the second signal will be propagated. Until the first\nsignal becomes true again, all events will be propagated. Elm does not allow\nundefined signals, so a base case must be provided in case the first signal is\nalways true.\n" + }, + { "name" : "dropRepeats", + "type" : "Signal a -> Signal a", + "desc" : "Drop sequential repeated values. For example, if a signal produces the\nsequence `[1,1,2,2,1]`, it becomes `[1,2,1]` by dropping the values that\nare the same as the previous value.\n" + }, + { "name" : "sampleOn", + "type" : "Signal a -> Signal b -> Signal b", + "desc" : "Sample from the second input every time an event occurs on the first input.\nFor example, `(sampleOn clicks (every second))` will give the approximate\ntime of the latest click.\n" + }, + { "name" : "<~", + "type" : "(a -> b) -> Signal a -> Signal b", + "desc" : "An alias for `lift`. A prettier way to apply a\nfunction to the current value of a signal.\n\n lift f signal == f <~ signal\n" + }, + { "name" : "~", + "type" : "Signal (a -> b) -> Signal a -> Signal b", + "desc" : "Signal application. This takes two signals, holding a function and\na value. It applies the current function to the current value.\n\nSo the following expressions are equivalent:\n\n scene <~ Window.dimensions ~ Mouse.position\n lift2 scene Window.dimensions Mouse.position\n" + } + ] + }, + { "name" : "Set", + "values" : [ + { "name" : "empty", + "type" : "Set (Comparable k)", + "desc" : "Create an empty set.\n" + }, + { "name" : "singleton", + "type" : "Comparable k -> Set (Comparable k)", + "desc" : "Create a set with one value.\n" + }, + { "name" : "insert", + "type" : "Comparable k -> Set (Comparable k) -> Set (Comparable k)", + "desc" : "Insert a value into a set.\n" + }, + { "name" : "remove", + "type" : "Comparable k -> Set (Comparable k) -> Set (Comparable k)", + "desc" : "Remove a value from a set. If the value is not found, no changes are made.\n" + }, + { "name" : "member", + "type" : "Comparable k -> Set (Comparable k) -> Bool", + "desc" : "Determine if a value is in a set.\n" + }, + { "name" : "union", + "type" : "Set (Comparable k) -> Set (Comparable k) -> Set (Comparable k)", + "desc" : "Get the union of two sets. Keep all values.\n" + }, + { "name" : "intersect", + "type" : "Set (Comparable k) -> Set (Comparable k) -> Set (Comparable k)", + "desc" : "Get the intersection of two sets. Keeps values that appear in both sets.\n" + }, + { "name" : "diff", + "type" : "Set (Comparable k) -> Set (Comparable k) -> Set (Comparable k)", + "desc" : "Get the difference between the first set and the second. Keeps values\nthat do not appear in the second set.\n" + }, + { "name" : "toList", + "type" : "Set (Comparable k) -> [Comparable k]", + "desc" : "Convert a set into a list.\n" + }, + { "name" : "fromList", + "type" : "[Comparable k] -> Set (Comparable k)", + "desc" : "Convert a list into a set, removing any duplicates.\n" + }, + { "name" : "foldl", + "type" : "(Comparable a -> b -> b) -> b -> Set (Comparable a) -> b", + "desc" : "Fold over the values in a set, in order from lowest to highest.\n" + }, + { "name" : "foldr", + "type" : "(Comparable a -> b -> b) -> b -> Set (Comparable a) -> b", + "desc" : "Fold over the values in a set, in order from highest to lowest.\n" + }, + { "name" : "map", + "type" : "(Comparable a -> Comparable b) -> Set (Comparable a) -> Set (Comparable b)", + "desc" : "Map a function onto a set, creating a new set with no duplicates.\n" + } + ] + }, + { "name" : "Random", + "values" : [ + { "name" : "range", + "type" : "Int -> Int -> Signal a -> Signal Int", + "desc" : "Given a range from low to high and a signal of values, this produces\na new signal that changes whenever the input signal changes. The new\nvalues are random number between 'low' and 'high' inclusive.\n" + }, + { "name" : "float", + "type" : "Signal a -> Signal Float", + "desc" : "Produces a new signal that changes whenever the input signal changes.\nThe new values are random numbers in [0..1).\n" + } + ] + }, + { "name" : "Prelude", + "values" : [ + { "name" : "radians", + "type" : "Float -> Float", + "desc" : "Convert radians to standard Elm angles (radians).\n" + }, + { "name" : "degrees", + "type" : "Float -> Float", + "desc" : "Convert degrees to standard Elm angles (radians).\n" + }, + { "name" : "turns", + "type" : "Float -> Float", + "desc" : "Convert turns to standard Elm angles (radians).\nOne turn is equal to 360°.\n" + }, + { "name" : "fromPolar", + "type" : "(Float,Float) -> (Float,Float)", + "desc" : "Start with polar coordinates (r,θ)\nand get out cartesian coordinates (x,y).\n" + }, + { "name" : "toPolar", + "type" : "(Float,Float) -> (Float,Float)", + "desc" : "Start with cartesian coordinates (x,y)\nand get out polar coordinates (r,θ).\n" + }, + { "name" : "+", + "type" : "Number a -> Number a -> Number a", + "desc" : "" + }, + { "name" : "-", + "type" : "Number a -> Number a -> Number a", + "desc" : "" + }, + { "name" : "*", + "type" : "Number a -> Number a -> Number a", + "desc" : "" + }, + { "name" : "/", + "type" : "Float -> Float -> Float", + "desc" : "Floating point division.\n" + }, + { "name" : "div", + "type" : "Int -> Int -> Int", + "desc" : "Integer division, remainder is discarded.\n" + }, + { "name" : "rem", + "type" : "Int -> Int -> Int", + "desc" : "Finds the remainder after dividing one number by another: ``4 `rem` 3 == 1``\n" + }, + { "name" : "mod", + "type" : "Int -> Int -> Int", + "desc" : "Perform modular arithmetic: ``7 `mod` 2 == 1``\n" + }, + { "name" : "^", + "type" : "Number a -> Number a -> Number a", + "desc" : "Exponentiation: `3^2 == 9`\n" + }, + { "name" : "cos", + "type" : "Float -> Float", + "desc" : "" + }, + { "name" : "sin", + "type" : "Float -> Float", + "desc" : "" + }, + { "name" : "tan", + "type" : "Float -> Float", + "desc" : "" + }, + { "name" : "acos", + "type" : "Float -> Float", + "desc" : "" + }, + { "name" : "asin", + "type" : "Float -> Float", + "desc" : "" + }, + { "name" : "atan", + "type" : "Float -> Float", + "desc" : "You probably do not want to use this. Because it takes `(y/x)` as the argument\nthere is no way to know where the negative signs come from so the resulting\nangle is always between π/2 and -π/2 (in quadrants I and IV).\n" + }, + { "name" : "atan2", + "type" : "Float -> Float -> Float", + "desc" : "This helps you find the angle of a cartesian coordinate.\nYou will almost certainly want to use this instead of `atan`.\nSo `atan2 y x` computes *atan(y/x)* but also keeps track of which\nquadrant the angle should really be in. The result will be between\nπ and -π, giving you the full range of angles.\n" + }, + { "name" : "sqrt", + "type" : "Number a -> Number a", + "desc" : "Take the square root of a number.\n" + }, + { "name" : "abs", + "type" : "Number a -> Number a", + "desc" : "Take the absolute value of a number.\n" + }, + { "name" : "logBase", + "type" : "Number a -> Number a -> Number a", + "desc" : "Calculate the logarithm of a number with a given base: `logBase 10 100 == 2`\n" + }, + { "name" : "min", + "type" : "Number a -> Number a -> Number a", + "desc" : "Given two numbers, returns the smaller one.\n" + }, + { "name" : "max", + "type" : "Number a -> Number a -> Number a", + "desc" : "Given two numbers, returns the larger one.\n" + }, + { "name" : "clamp", + "type" : "Number a -> Number a -> Number a -> Number a", + "desc" : "Clamps a number within a given range. With the expression `clamp 100 200 x`\nthe results are as follows:\n\n * `100 if x < 100`\n * ` x if 100 <= x < 200`\n * `200 if 200 <= x`\n" + }, + { "name" : "pi", + "type" : "Float", + "desc" : "An approximation of pi.\n" + }, + { "name" : "e", + "type" : "Float", + "desc" : "An approximation of e.\n" + }, + { "name" : "==", + "type" : "a -> a -> Bool", + "desc" : "Compare any two values for structural equality. Functions cannot be compared.\n" + }, + { "name" : "/=", + "type" : "a -> a -> Bool", + "desc" : "" + }, + { "name" : "<", + "type" : "Comparable a -> Comparable a -> Bool", + "desc" : "" + }, + { "name" : ">", + "type" : "Comparable a -> Comparable a -> Bool", + "desc" : "" + }, + { "name" : "<=", + "type" : "Comparable a -> Comparable a -> Bool", + "desc" : "" + }, + { "name" : ">=", + "type" : "Comparable a -> Comparable a -> Bool", + "desc" : "" + }, + { "name" : "compare", + "type" : "Comparable a -> Comparable a -> Order", + "desc" : "Compare any two comparable values. Comparable values include `String`, `Char`,\n`Int`, `Float`, `Time`, or a list or tuple containing comparable values.\nThese are also the only values that work as `Dict` keys or `Set` members.\n" + }, + { "name" : "Order", + "type" : "data Order = LT | EQ | GT", + "desc" : "Represents the relative ordering of two things.\nThe relations are less than, equal to, and greater than.\n" + }, + { "name" : "&&", + "type" : "Bool -> Bool -> Bool", + "desc" : "The and operator. True if both inputs are True.\n" + }, + { "name" : "||", + "type" : "Bool -> Bool -> Bool", + "desc" : "The or operator. True if one or both inputs are True.\n" + }, + { "name" : "xor", + "type" : "Bool -> Bool -> Bool", + "desc" : "The exclusive-or operator. True if exactly one input is True.\n" + }, + { "name" : "not", + "type" : "Bool -> Bool", + "desc" : "Negate a boolean value: `(not True == False)` and `(not False == True)`\n" + }, + { "name" : "otherwise", + "type" : "Bool", + "desc" : "Equal to true. Useful as the last case of a multi-way-if.\n" + }, + { "name" : "round", + "type" : "Float -> Int", + "desc" : "Round a number to the nearest integer.\n" + }, + { "name" : "truncate", + "type" : "Float -> Int", + "desc" : "Truncate a decimal number, rounding towards zero.\n" + }, + { "name" : "floor", + "type" : "Float -> Int", + "desc" : "Floor function, rounding down.\n" + }, + { "name" : "ceiling", + "type" : "Float -> Int", + "desc" : "Ceiling function, rounding up.\n" + }, + { "name" : "toFloat", + "type" : "Int -> Float", + "desc" : "Convert an integer into a float.\n" + }, + { "name" : "show", + "type" : "a -> String", + "desc" : "Convert almost any value to its string representation.\n" + }, + { "name" : "readInt", + "type" : "String -> Maybe Int", + "desc" : "Read an integer from a string\n" + }, + { "name" : "readFloat", + "type" : "String -> Maybe Float", + "desc" : "Read a float from a string.\n" + }, + { "name" : ".", + "type" : "(b -> c) -> (a -> b) -> (a -> c)", + "desc" : "Function composition: `(f . g == (\\\\x -> f (g x)))`\n" + }, + { "name" : "|>", + "type" : "a -> (a -> b) -> b", + "desc" : "Forward function application `x |> f == f x`. This function is useful\nfor avoiding parenthesis and writing code in a more natural way.\nConsider the following code to create a pentagon:\n\n scale 2 (move (10,10) (filled blue (ngon 5 30)))\n\nThis can also be written as:\n\n ngon 5 30 |> filled blue\n |> move (10,10)\n |> scale 2\n" + }, + { "name" : "<|", + "type" : "(a -> b) -> a -> b", + "desc" : "Function application `f <| x == f x`. This function is useful for avoiding\nparenthesis. Consider the following code to create a text element:\n\n text (monospace (toText \"code\"))\n\nThis can also be written as:\n\n text . monospace <| toText \"code\"\n" + }, + { "name" : "id", + "type" : "a -> a", + "desc" : "Given a value, returns exactly the same value.\n" + }, + { "name" : "fst", + "type" : "(a,b) -> a", + "desc" : "Given a 2-tuple, returns the first value.\n" + }, + { "name" : "snd", + "type" : "(a,b) -> b", + "desc" : "Given a 2-tuple, returns the second value.\n" + }, + { "name" : "flip", + "type" : "(a -> b -> c) -> (b -> a -> c)", + "desc" : "Flips the order of the first two arguments to a function.\n" + }, + { "name" : "curry", + "type" : "((a,b) -> c) -> a -> b -> c", + "desc" : "Change how arguments are passed to a function. This splits paired arguments\ninto two separate arguments.\n" + }, + { "name" : "uncurry", + "type" : "(a -> b -> c) -> (a,b) -> c", + "desc" : "Change how arguments are passed to a function. This combines two arguments\ninto a sigle pair.\n" + } + ] + }, + { "name" : "Mouse", + "values" : [ + { "name" : "position", + "type" : "Signal (Int,Int)", + "desc" : "The current mouse position.\n" + }, + { "name" : "x", + "type" : "Signal Int", + "desc" : "The current x-coordinate of the mouse.\n" + }, + { "name" : "y", + "type" : "Signal Int", + "desc" : "The current y-coordinate of the mouse.\n" + }, + { "name" : "isDown", + "type" : "Signal Bool", + "desc" : "The current state of the left mouse-button.\nTrue when the button is down, and false otherwise.\n" + }, + { "name" : "isClicked", + "type" : "Signal Bool", + "desc" : "True immediately after the left mouse-button has been clicked,\nand false otherwise.\n" + }, + { "name" : "clicks", + "type" : "Signal ()", + "desc" : "Always equal to unit. Event triggers on every mouse click.\n" + } + ] + }, + { "name" : "Maybe", + "values" : [ + { "name" : "Maybe", + "type" : "data Maybe a = Just a | Nothing", + "desc" : "The Maybe datatype. Useful when a computation may or may not\nresult in a value (e.g. logarithm is defined only for positive numbers).\n" + }, + { "name" : "maybe", + "type" : "b -> (a -> b) -> Maybe a -> b", + "desc" : "Apply a function to the contents of a `Maybe`.\nReturn default when given `Nothing`.\n" + }, + { "name" : "isJust", + "type" : "Maybe a -> Bool", + "desc" : "Check if constructed with `Just`.\n" + }, + { "name" : "isNothing", + "type" : "Maybe a -> Bool", + "desc" : "Check if constructed with `Nothing`.\n" + }, + { "name" : "cons", + "type" : "Maybe a -> [a] -> [a]", + "desc" : "If `Just`, adds the value to the front of the list.\nIf `Nothing`, list is unchanged.\n" + }, + { "name" : "justs", + "type" : "[Maybe a] -> [a]", + "desc" : "Filters out Nothings and extracts the remaining values.\n" + } + ] + }, + { "name" : "Matrix2D", + "values" : [ + { "name" : "identity", + "type" : "Matrix2D", + "desc" : "Create an identity matrix.\n\n / 1 0 \\\\\n \\\\ 0 1 /\n" + }, + { "name" : "matrix", + "type" : "Float -> Float -> Float -> Float -> Float -> Float -> Matrix2D", + "desc" : "Creates an arbitrary matrix. This lets you create scales, shears, reflections,\ntranslations, or any other 2D transform.\n\n matrix a b c d dx dy\n\n / a b \\\\\n \\\\ c d /\n\nAnd `dx` and `dy` are the translation values.\n" + }, + { "name" : "rotation", + "type" : "Float -> Matrix2D", + "desc" : "Creates a [rotation matrix](http://en.wikipedia.org/wiki/Rotation_matrix).\nGiven an angle t, it creates a counterclockwise rotation matrix:\n\n / cos t -sin t \\\\\n \\\\ sin t cos t /\n" + }, + { "name" : "multiply", + "type" : "Matrix2D -> Matrix2D -> Matrix2D", + "desc" : "Multiplies two matrices together:\n\n multiply a b\n\n / a11 a12 \\\\ . / b11 b12 \\\\\n \\\\ a21 a22 / \\\\ b21 b22 /\n" + } + ] + }, + { "name" : "List", + "values" : [ + { "name" : "::", + "type" : "a -> [a] -> [a]", + "desc" : "Add an element to the front of a list `(1 :: [2,3] == [1,2,3])`\n" + }, + { "name" : "++", + "type" : "Appendable a -> Appendable a -> Appendable a", + "desc" : "Puts two appendable things together:\n\n [1,1] ++ [2,3] == [1,1,2,3]\n \"abc\" ++ \"123\" == \"abc123\"\n" + }, + { "name" : "head", + "type" : "[a] -> a", + "desc" : "Extract the first element of a list. List must be non-empty.\n`(head [1,2,3] == 1)`\n" + }, + { "name" : "tail", + "type" : "[a] -> [a]", + "desc" : "Extract the elements after the head of the list. List must be non-empty.\n `(tail [1,2,3] == [2,3])`\n" + }, + { "name" : "last", + "type" : "[a] -> a", + "desc" : "Extract the last element of a list. List must be non-empty.\n`(last [1,2,3] == 3)`\n" + }, + { "name" : "map", + "type" : "(a -> b) -> [a] -> [b]", + "desc" : "Apply a function to every element of a list: `(map sqrt [1,4,9] == [1,2,3])`\n" + }, + { "name" : "foldl", + "type" : "(a -> b -> b) -> b -> [a] -> b", + "desc" : "Reduce a list from the left: `(foldl (::) [] \"gateman\" == \"nametag\")`\n" + }, + { "name" : "foldr", + "type" : "(a -> b -> b) -> b -> [a] -> b", + "desc" : "Reduce a list from the right: `(foldr (+) 0 [1,2,3] == 6)`\n" + }, + { "name" : "foldl1", + "type" : "(a -> a -> a) -> [a] -> a", + "desc" : "Reduce a list from the left without a base case. List must be non-empty.\n" + }, + { "name" : "foldr1", + "type" : "(a -> a -> a) -> [a] -> a", + "desc" : "Reduce a list from the right without a base case. List must be non-empty.\n" + }, + { "name" : "scanl", + "type" : "(a -> b -> b) -> b -> [a] -> [b]", + "desc" : "Reduce a list from the left, building up all of the intermediate results into a list.\n\n scanl (+) 0 [1,2,3,4] == [0,1,3,6,10]\n" + }, + { "name" : "scanl1", + "type" : "(a -> a -> a) -> [a] -> [a]", + "desc" : "Same as scanl but it doesn't require a base case. List must be non-empty.\n\n scanl1 (+) [1,2,3,4] == [1,3,6,10]\n" + }, + { "name" : "filter", + "type" : "(a -> Bool) -> [a] -> [a]", + "desc" : "Filter out elements which do not satisfy the predicate: `(filter isLower \"AaBbCc\" == \"abc\")`\n" + }, + { "name" : "length", + "type" : "[a] -> Int", + "desc" : "Determine the length of a list: `(length \"innumerable\" == 11)`\n" + }, + { "name" : "reverse", + "type" : "[a] -> [a]", + "desc" : "Reverse a list. `(reverse [1..4] == [4,3,2,1])`\n" + }, + { "name" : "all", + "type" : "(a -> Bool) -> [a] -> Bool", + "desc" : "Check to see if all elements satisfy the predicate.\n" + }, + { "name" : "any", + "type" : "(a -> Bool) -> [a] -> Bool", + "desc" : "Check to see if any elements satisfy the predicate.\n" + }, + { "name" : "and", + "type" : "[Bool] -> Bool", + "desc" : "Check to see if all elements are True.\n" + }, + { "name" : "or", + "type" : "[Bool] -> Bool", + "desc" : "Check to see if any elements are True.\n" + }, + { "name" : "concat", + "type" : "[Appendable a] -> Appendable a", + "desc" : "Concatenate a list of appendable things:\n\n concat [\"tree\",\"house\"] == \"treehouse\"\n" + }, + { "name" : "concatMap", + "type" : "(a -> Appendable b) -> [a] -> Appendable b", + "desc" : "Map a given function onto a list and flatten the resulting lists.\n\n concatMap f xs == concat (map f xs)\n" + }, + { "name" : "sum", + "type" : "[Number a] -> Number a", + "desc" : "Get the sum of the list elements. `(sum [1..4] == 10)`\n" + }, + { "name" : "product", + "type" : "[Number a] -> Number a", + "desc" : "Get the product of the list elements. `(product [1..4] == 24)`\n" + }, + { "name" : "maximum", + "type" : "[Number a] -> Number a", + "desc" : "Find the highest number in a non-empty list.\n" + }, + { "name" : "minimum", + "type" : "[Number a] -> Number a", + "desc" : "Find the lowest number in a non-empty list.\n" + }, + { "name" : "partition", + "type" : "(a -> Bool) -> [a] -> ([a],[a])", + "desc" : "Split a list based on the predicate.\n" + }, + { "name" : "zip", + "type" : "[a] -> [b] -> [(a,b)]", + "desc" : "Combine two lists, combining them into tuples pairwise.\nIf one list is longer, the extra elements are dropped.\n\n zip [1,2,3] [6,7] == [(1,6),(2,7)]\n zip == zipWith (,)\n" + }, + { "name" : "zipWith", + "type" : "(a -> b -> c) -> [a] -> [b] -> [c]", + "desc" : "Combine two lists, combining them with the given function.\nIf one list is longer, the extra elements are dropped.\n\n zipWith (+) [1,2,3] [1,2,3,4] == [2,4,6]\n" + }, + { "name" : "unzip", + "type" : "[(a,b)] -> ([a],[b])", + "desc" : "Decompose a list of tuples.\n" + }, + { "name" : "split", + "type" : "[a] -> [a] -> [[a]]", + "desc" : "Split a list with a given seperator.\n\n split \",\" \"hello,there,friend\" == [\"hello\", \"there\", \"friend\"]\n" + }, + { "name" : "join", + "type" : "Appendable a -> [Appendable a] -> Appendable a", + "desc" : "Places the given value between all of the lists in the second argument\nand concatenates the result. \n\n join \"a\" [\"H\",\"w\",\"ii\",\"n\"] == \"Hawaiian\"\n" + }, + { "name" : "intersperse", + "type" : "a -> [a] -> [a]", + "desc" : "Places the given value between all members of the given list.\n\n intersperse ' ' \"INCEPTION\" == \"I N C E P T I O N\"\n" + }, + { "name" : "take", + "type" : "Int -> [a] -> [a]", + "desc" : "Take the first n members of a list: `(take 2 [1,2,3,4] == [1,2])`\n" + }, + { "name" : "drop", + "type" : "Int -> [a] -> [a]", + "desc" : "Drop the first n members of a list: `(drop 2 [1,2,3,4] == [3,4])`\n" + } + ] + }, + { "name" : "Keyboard", + "values" : [ + { "name" : "KeyCode", + "type" : "type KeyCode = Int", + "desc" : "Type alias to make it clearer what integers are supposed to represent\nin this library. Use [`Char.toCode`](docs/Char.elm#toCode) and\n[`Char.fromCode`](/docs/Char.elm#fromCode) to convert key codes to characters.\n" + }, + { "name" : "arrows", + "type" : "Signal { x:Int, y:Int }", + "desc" : "A signal of records indicating which arrow keys are pressed.\n\n`{ x = 0, y = 0 }` when pressing no arrows.<br>\n`{ x =-1, y = 0 }` when pressing the left arrow.<br>\n`{ x = 1, y = 1 }` when pressing the up and right arrows.<br>\n`{ x = 0, y =-1 }` when pressing the down, left, and right arrows.\n" + }, + { "name" : "wasd", + "type" : "Signal { x:Int, y:Int }", + "desc" : "Just like the arrows signal, but this uses keys w, a, s, and d,\nwhich are common controls for many computer games.\n" + }, + { "name" : "directions", + "type" : "KeyCode -> KeyCode -> KeyCode -> KeyCode -> Signal { x:Int, y:Int }", + "desc" : "Custom key directions so that you can support different locales.\nThe plan is to have a locale independent version of this function\nthat uses the physical location of keys, but I don't know how to do it.\n" + }, + { "name" : "isDown", + "type" : "KeyCode -> Signal Bool", + "desc" : "Whether an arbitrary key is pressed.\n" + }, + { "name" : "shift", + "type" : "Signal Bool", + "desc" : "Whether the shift key is pressed.\n" + }, + { "name" : "ctrl", + "type" : "Signal Bool", + "desc" : "Whether the control key is pressed.\n" + }, + { "name" : "space", + "type" : "Signal Bool", + "desc" : "Whether the space key is pressed.\n" + }, + { "name" : "enter", + "type" : "Signal Bool", + "desc" : "Whether the enter key is pressed.\n" + }, + { "name" : "keysDown", + "type" : "Signal [KeyCode]", + "desc" : "List of keys that are currently down.\n" + }, + { "name" : "lastPressed", + "type" : "Signal KeyCode", + "desc" : "The latest key that has been pressed.\n" + } + ] + }, + { "name" : "Json", + "values" : [ + { "name" : "JsonValue", + "type" : "data JsonValue\n = String String\n | Number Float\n | Boolean Bool\n | Null\n | Array [JsonValue]\n | Object (Dict String JsonValue)", + "desc" : "This datatype can represent all valid values that can be held in a JSON\nobject. In Elm, a proper JSON object is represented as a (Dict String JsonValue)\nwhich is a mapping from strings to Json Values.\n" + }, + { "name" : "toString", + "type" : "String -> JsonValue -> String", + "desc" : "Convert a `JsonValue` into a prettified string.\nThe first argument is a separator token (e.g. \\\" \\\", \\\"\\\\n\\\", etc.) that will\nbe used for indentation in the prettified string version of the JSON.\n" + }, + { "name" : "toJSString", + "type" : "String -> JsonValue -> JSString", + "desc" : "Convert a proper JSON object into a JavaScript string.\nNote that the type JSString seen here is not the same as the type constructor\nJsonString used elsewhere in this module.\n" + }, + { "name" : "fromString", + "type" : "String -> Maybe JsonValue", + "desc" : "Parse a string representation of a proper JSON object into\nits Elm representation.\n" + }, + { "name" : "fromJSString", + "type" : "JSString -> Maybe JsonValue", + "desc" : "Parse a JavaScript string representation of a proper JSON object into\nits Elm representation.\n" + }, + { "name" : "fromJSObject", + "type" : "JSObject -> JsonValue", + "desc" : "Convert a JS object into a `JsonValue`.\n" + }, + { "name" : "toJSObject", + "type" : "JsonValue -> JSObject", + "desc" : "Convert a `JsonValue` into a `JSObject`. Paired with the\n[`JavaScript.Experimental` library](/docs/JavaScript/Experimental.elm),\nThis lets you convert strings into Elm records:\n\n import JavaScript.Experimental as JS\n\n stringToRecord str =\n case fromString str of\n Just jsonValue -> Just (JS.toRecord (toJSObject jsonValue))\n Nothing -> Nothing\n" + } + ] + }, + { "name" : "JavaScript", + "values" : [ + { "name" : "toList", + "type" : "JSArray a -> [a]", + "desc" : "Requires that the input array be uniform (all members have the same type)\n" + }, + { "name" : "toInt", + "type" : "JSNumber -> Int", + "desc" : "" + }, + { "name" : "toFloat", + "type" : "JSNumber -> Float", + "desc" : "" + }, + { "name" : "toBool", + "type" : "JSBool -> Bool", + "desc" : "" + }, + { "name" : "toString", + "type" : "JSString -> String", + "desc" : "" + }, + { "name" : "fromList", + "type" : "[a] -> JSArray a", + "desc" : "Produces a uniform JavaScript array with all members of the same type.\n" + }, + { "name" : "fromInt", + "type" : "Int -> JSNumber", + "desc" : "" + }, + { "name" : "fromFloat", + "type" : "Float -> JSNumber", + "desc" : "" + }, + { "name" : "fromBool", + "type" : "Bool -> JSBool", + "desc" : "" + }, + { "name" : "fromString", + "type" : "String -> JSString", + "desc" : "" + }, + { "name" : "fromElement", + "type" : "Element -> JSDomNode", + "desc" : "Turn an `Element` into a plain old DOM node.\n" + }, + { "name" : "toElement", + "type" : "Int -> Int -> JSDomNode -> Element", + "desc" : "Turn a DOM node into an `Element`. You can resize the node\nusing the normal `width` and `height` functions.\n" + } + ] + }, + { "name" : "Http", + "values" : [ + { "name" : "Response", + "type" : "data Response a = Success a | Waiting | Failure Int String", + "desc" : "The datatype for responses. Success contains only the returned message.\nFailures contain both an error code and an error message.\n" + }, + { "name" : "Request", + "type" : "type Request a = {\n verb : String,\n url : String,\n body : a,\n headers : [(String,String)]\n }", + "desc" : "" + }, + { "name" : "request", + "type" : "String -> String -> String -> [(String,String)] -> Request String", + "desc" : "Create a customized request. Arguments are request type (get, post, put,\ndelete, etc.), target url, data, and a list of additional headers.\n" + }, + { "name" : "get", + "type" : "String -> Request String", + "desc" : "Create a GET request to the given url.\n" + }, + { "name" : "post", + "type" : "String -> String -> Request String", + "desc" : "Create a POST request to the given url, carrying the given data.\n" + }, + { "name" : "send", + "type" : "Signal (Request a) -> Signal (Response String)", + "desc" : "Performs an HTTP request with the given requests. Produces a signal\nthat carries the responses.\n" + }, + { "name" : "sendGet", + "type" : "Signal String -> Signal (Response String)", + "desc" : "Performs an HTTP GET request with the given urls. Produces a signal\nthat carries the responses.\n" + } + ] + }, + { "name" : "Either", + "values" : [ + { "name" : "Either", + "type" : "data Either a b = Left a | Right b", + "desc" : "Represents any data that can take two different types.\n\nThis can also be used for error handling `(Either String a)` where error\nmessages are stored on the left, and the correct values (“right” values) are stored on the right.\n" + }, + { "name" : "either", + "type" : "(a -> c) -> (b -> c) -> Either a b -> c", + "desc" : "Apply the first function to a `Left` and the second function to a `Right`.\nThis allows the extraction of a value from an `Either`.\n" + }, + { "name" : "isLeft", + "type" : "Either a b -> Bool", + "desc" : "True if the value is a `Left`.\n" + }, + { "name" : "isRight", + "type" : "Either a b -> Bool", + "desc" : "True if the value is a `Right`.\n" + }, + { "name" : "lefts", + "type" : "[Either a b] -> [a]", + "desc" : "Keep only the values held in `Left` values.\n" + }, + { "name" : "rights", + "type" : "[Either a b] -> [b]", + "desc" : "Keep only the values held in `Right` values.\n" + }, + { "name" : "partition", + "type" : "[Either a b] -> ([a],[b])", + "desc" : "Split into two lists, lefts on the left and rights on the right. So we\nhave the equivalence: `(partition es == (lefts es, rights es))`\n" + } + ] + }, + { "name" : "Dict", + "values" : [ + { "name" : "empty", + "type" : "Dict (Comparable k) v", + "desc" : "Create an empty dictionary.\n" + }, + { "name" : "lookup", + "type" : "Comparable k -> Dict (Comparable k) v -> Maybe v", + "desc" : "Lookup the value associated with a key.\n" + }, + { "name" : "findWithDefault", + "type" : "v -> Comparable k -> Dict (Comparable k) v -> v", + "desc" : "Find the value associated with a key. If the key is not found,\nreturn the default value.\n" + }, + { "name" : "member", + "type" : "Comparable k -> Dict (Comparable k) v -> Bool", + "desc" : "Determine if a key is in a dictionary.\n" + }, + { "name" : "insert", + "type" : "Comparable k -> v -> Dict (Comparable k) v -> Dict (Comparable k) v", + "desc" : "Insert a key-value pair into a dictionary. Replaces value when there is\na collision.\n" + }, + { "name" : "singleton", + "type" : "Comparable k -> v -> Dict (Comparable k) v", + "desc" : "Create a dictionary with one key-value pair.\n" + }, + { "name" : "remove", + "type" : "Comparable k -> Dict (Comparable k) v -> Dict (Comparable k) v", + "desc" : "Remove a key-value pair from a dictionary. If the key is not found,\nno changes are made.\n" + }, + { "name" : "map", + "type" : "(a -> b) -> Dict (Comparable k) a -> Dict (Comparable k) b", + "desc" : "Apply a function to all values in a dictionary.\n" + }, + { "name" : "foldl", + "type" : "(Comparable k -> v -> b -> b) -> b -> Dict (Comparable k) v -> b", + "desc" : "Fold over the key-value pairs in a dictionary, in order from lowest\nkey to highest key.\n" + }, + { "name" : "foldr", + "type" : "(Comparable k -> v -> b -> b) -> b -> Dict (Comparable k) v -> b", + "desc" : "Fold over the key-value pairs in a dictionary, in order from highest\nkey to lowest key.\n" + }, + { "name" : "union", + "type" : "Dict (Comparable k) v -> Dict (Comparable k) v -> Dict (Comparable k) v", + "desc" : "Combine two dictionaries. If there is a collision, preference is given\nto the first dictionary.\n" + }, + { "name" : "intersect", + "type" : "Dict (Comparable k) v -> Dict (Comparable k) v -> Dict (Comparable k) v", + "desc" : "Keep a key-value pair when its key appears in the second dictionary.\nPreference is given to values in the first dictionary.\n" + }, + { "name" : "diff", + "type" : "Dict (Comparable k) v -> Dict (Comparable k) v -> Dict (Comparable k) v", + "desc" : "Keep a key-value pair when its key does not appear in the second dictionary.\nPreference is given to the first dictionary.\n" + }, + { "name" : "keys", + "type" : "Dict (Comparable k) v -> [Comparable k]", + "desc" : "Get all of the keys in a dictionary.\n" + }, + { "name" : "values", + "type" : "Dict (Comparable k) v -> [v]", + "desc" : "Get all of the values in a dictionary.\n" + }, + { "name" : "toList", + "type" : "Dict (Comparable k) v -> [(Comparable k,v)]", + "desc" : "Convert a dictionary into an association list of key-value pairs.\n" + }, + { "name" : "fromList", + "type" : "[(Comparable k,v)] -> Dict (Comparable k) v", + "desc" : "Convert an association list into a dictionary.\n" + } + ] + }, + { "name" : "Date", + "values" : [ + { "name" : "Day", + "type" : "data Day = Mon | Tue | Wed | Thu | Fri | Sat | Sun", + "desc" : "Represents the days of the week.\n" + }, + { "name" : "Month", + "type" : "data Month = Jan | Feb | Mar | Apr\n | May | Jun | Jul | Aug\n | Sep | Oct | Nov | Dec", + "desc" : "Represents the month of the year.\n" + }, + { "name" : "read", + "type" : "String -> Maybe Date", + "desc" : "Attempt to read a date from a string.\n" + }, + { "name" : "toTime", + "type" : "Date -> Time", + "desc" : "Convert a date into a time since midnight (UTC) of 1 January 1990 (i.e.\n[UNIX time](http://en.wikipedia.org/wiki/Unix_time)). Given the date 23 June\n1990 at 11:45AM this returns the corresponding time.\n" + }, + { "name" : "year", + "type" : "Date -> Int", + "desc" : "Extract the year of a given date. Given the date 23 June 1990 at 11:45AM\nthis returns the integer `1990`.\n" + }, + { "name" : "month", + "type" : "Date -> Month", + "desc" : "Extract the month of a given date. Given the date 23 June 1990 at 11:45AM\nthis returns the Month `Jun` as defined below.\n" + }, + { "name" : "day", + "type" : "Date -> Int", + "desc" : "Extract the day of a given date. Given the date 23 June 1990 at 11:45AM\nthis returns the integer `23`.\n" + }, + { "name" : "dayOfWeek", + "type" : "Date -> Day", + "desc" : "Extract the day of the week for a given date. Given the date 23 June\n1990 at 11:45AM this returns the Day `Thu` as defined below.\n" + }, + { "name" : "hour", + "type" : "Date -> Int", + "desc" : "Extract the hour of a given date. Given the date 23 June 1990 at 11:45AM\nthis returns the integer `11`.\n" + }, + { "name" : "minute", + "type" : "Date -> Int", + "desc" : "Extract the minute of a given date. Given the date 23 June 1990 at 11:45AM\nthis returns the integer `45`.\n" + }, + { "name" : "second", + "type" : "Date -> Int", + "desc" : "Extract the second of a given date. Given the date 23 June 1990 at 11:45AM\nthis returns the integer `0`.\n" + } + ] + }, + { "name" : "Color", + "values" : [ + { "name" : "Color", + "type" : "data Color = Color Int Int Int Float", + "desc" : "" + }, + { "name" : "rgba", + "type" : "Int -> Int -> Int -> Float -> Color", + "desc" : "Create RGB colors with an alpha component for transparency.\nThe alpha component is specified with numbers between 0 and 1.\n" + }, + { "name" : "rgb", + "type" : "Int -> Int -> Int -> Color", + "desc" : "Create RGB colors from numbers between 0 and 255 inclusive.\n" + }, + { "name" : "red", + "type" : "Color", + "desc" : "" + }, + { "name" : "lime", + "type" : "Color", + "desc" : "" + }, + { "name" : "blue", + "type" : "Color", + "desc" : "" + }, + { "name" : "yellow", + "type" : "Color", + "desc" : "" + }, + { "name" : "cyan", + "type" : "Color", + "desc" : "" + }, + { "name" : "magenta", + "type" : "Color", + "desc" : "" + }, + { "name" : "black", + "type" : "Color", + "desc" : "" + }, + { "name" : "white", + "type" : "Color", + "desc" : "" + }, + { "name" : "gray", + "type" : "Color", + "desc" : "" + }, + { "name" : "grey", + "type" : "Color", + "desc" : "" + }, + { "name" : "maroon", + "type" : "Color", + "desc" : "" + }, + { "name" : "navy", + "type" : "Color", + "desc" : "" + }, + { "name" : "green", + "type" : "Color", + "desc" : "" + }, + { "name" : "teal", + "type" : "Color", + "desc" : "" + }, + { "name" : "purple", + "type" : "Color", + "desc" : "" + }, + { "name" : "violet", + "type" : "Color", + "desc" : "" + }, + { "name" : "forestGreen", + "type" : "Color", + "desc" : "" + }, + { "name" : "complement", + "type" : "Color -> Color", + "desc" : "Produce a “complementary color”.\nThe two colors will accent each other.\n" + }, + { "name" : "hsva", + "type" : "Float -> Float -> Float -> Float -> Color", + "desc" : "Create [HSV colors](http://en.wikipedia.org/wiki/HSL_and_HSV)\nwith an alpha component for transparency.\n" + }, + { "name" : "hsv", + "type" : "Float -> Float -> Float -> Color", + "desc" : "Create [HSV colors](http://en.wikipedia.org/wiki/HSL_and_HSV).\nThis is very convenient for creating colors that cycle and shift.\n\n hsv (degrees 240) 1 1 == blue\n" + }, + { "name" : "Gradient", + "type" : "data Gradient\n = Linear (Float,Float) (Float,Float) [(Float,Color)]\n | Radial (Float,Float) Float (Float,Float) Float [(Float,Color)]", + "desc" : "" + }, + { "name" : "linear", + "type" : "(Number a, Number a) -> (Number a, Number a) -> [(Float,Color)] -> Gradient", + "desc" : "Create a linear gradient. Takes a start and end point and then a series\nof “color stops” that indicate how to interpolate between\nthe start and end points. See [this example](/edit/examples/Elements/LinearGradient.elm) for\na more visual explanation.\n" + }, + { "name" : "radial", + "type" : "(Number a,Number a) -> Number a -> (Number a,Number a) -> Number a -> [(Float,Color)] -> Gradient", + "desc" : "Create a radial gradient. First takes a start point and inner radius.\nThen takes an end point and outer radius. It then takes a series\nof “color stops” that indicate how to interpolate between\nthe inner and outer circles. See [this example](/edit/examples/Elements/RadialGradient.elm) for\na more visual explanation.\n" + } + ] + }, + { "name" : "Char", + "values" : [ + { "name" : "isUpper", + "type" : "Char -> Bool", + "desc" : "True for upper case letters.\n" + }, + { "name" : "isLower", + "type" : "Char -> Bool", + "desc" : "True for lower case letters.\n" + }, + { "name" : "isDigit", + "type" : "Char -> Bool", + "desc" : "True for ASCII digits (`0..9`).\n" + }, + { "name" : "isOctDigit", + "type" : "Char -> Bool", + "desc" : "True for ASCII octal digits (`0..7`).\n" + }, + { "name" : "isHexDigit", + "type" : "Char -> Bool", + "desc" : "True for ASCII hexadecimal digits (`0..9a..fA..F`).\n" + }, + { "name" : "toUpper", + "type" : "Char -> Char", + "desc" : "Convert to upper case.\n" + }, + { "name" : "toLower", + "type" : "Char -> Char", + "desc" : "Convert to lower case.\n" + }, + { "name" : "toLocaleUpper", + "type" : "Char -> Char", + "desc" : "Convert to upper case, according to any locale-specific case mappings.\n" + }, + { "name" : "toLocaleLower", + "type" : "Char -> Char", + "desc" : "Convert to lower case, according to any locale-specific case mappings.\n" + }, + { "name" : "toCode", + "type" : "Char -> KeyCode", + "desc" : "Convert to unicode.\n" + }, + { "name" : "fromCode", + "type" : "KeyCode -> Char", + "desc" : "Convert from unicode.\n" + } + ] + }, + { "name" : "Automaton", + "values" : [ + { "name" : "Automaton", + "type" : "data Automaton a b = Step (a -> (Automaton a b, b))", + "desc" : "" + }, + { "name" : "run", + "type" : "Automaton a b -> b -> Signal a -> Signal b", + "desc" : "Run an automaton on a given signal. The automaton steps forward\nwhenever the input signal updates.\n" + }, + { "name" : "step", + "type" : "a -> Automaton a b -> (Automaton a b, b)", + "desc" : "Step an automaton forward once with a given input.\n" + }, + { "name" : ">>>", + "type" : "Automaton a b -> Automaton b c -> Automaton a c", + "desc" : "Compose two automatons, chaining them together.\n" + }, + { "name" : "<<<", + "type" : "Automaton b c -> Automaton a b -> Automaton a c", + "desc" : "Compose two automatons, chaining them together.\n" + }, + { "name" : "combine", + "type" : "[Automaton a b] -> Automaton a [b]", + "desc" : "Combine a list of automatons into a single automaton that produces a list.\n" + }, + { "name" : "pure", + "type" : "(a -> b) -> Automaton a b", + "desc" : "Create an automaton with no memory. It just applies the given function to\nevery input.\n" + }, + { "name" : "state", + "type" : "b -> (a -> b -> b) -> Automaton a b", + "desc" : "Create an automaton with state. Requires an initial state and a step\nfunction to step the state forward. For example, an automaton that counted\nhow many steps it has taken would look like this:\n\n count = Automaton a Int\n count = state 0 (\\\\_ c -> c+1)\n\nIt is a stateful automaton. The initial state is zero, and the step function\nincrements the state on every step.\n" + }, + { "name" : "hiddenState", + "type" : "s -> (a -> s -> (s,b)) -> Automaton a b", + "desc" : "Create an automaton with hidden state. Requires an initial state and a\nstep function to step the state forward and produce an output.\n" + }, + { "name" : "count", + "type" : "Automaton a Int", + "desc" : "Count the number of steps taken.\n" + }, + { "name" : "Queue", + "type" : "type Queue t = ([t],[t])", + "desc" : "" + }, + { "name" : "average", + "type" : "Int -> Automaton Float Float", + "desc" : "Computes the running average of the last `n` inputs.\n" + } + ] + }, + { "name" : "JavaScript.Experimental", + "values" : [ + { "name" : "toRecord", + "type" : "JSObject -> a", + "desc" : "Turn arbitrary JavaScript objects into Elm records.\nArrays are converted into lists, nested objects are allowed.\nNo `null` values or non-homogeneous arrays.\n\n -- OK objects\n { student:\"Steve\", scores:[83,94,99,72] }\n { errorLevel:10, critical:true }\n\n -- BAD objects\n { answer:null }\n { info:[true,42,'what'] }\n" + }, + { "name" : "fromRecord", + "type" : "a -> JSObject", + "desc" : "Turn arbitrary Elm records into JavaScript objects.\nLists become arrays, nested records are allowed. No ADTs.\n\n -- OK records\n { student=\"Steve\", scores=[83,94,99,72] }\n { errorLevel=10, critical=True }\n\n -- BAD records\n { answer = Nothing }\n { result = Left \"An error occurred\" }\n" + } + ] + }, + { "name" : "Graphics.Input", + "values" : [ + { "name" : "buttons", + "type" : "a -> { events : Signal a,\n button : a -> String -> Element }", + "desc" : "Create a group of buttons.\n\n* The first argument is the default value of the `events` signal.\n* The `events` signal represents all of the activity in this group\n of buttons.\n* The `button` function creates a button\n with the given name, like “Submit” or “Cancel”.\n The `a` value is sent to `events` whenever the button is pressed.\n" + }, + { "name" : "button", + "type" : "String -> (Element, Signal ())", + "desc" : "Create a button with a given label. The result is an `Element` and\na signal of units. This signal triggers whenever the button is pressed.\n" + }, + { "name" : "customButtons", + "type" : "a -> { events : Signal a,\n customButton : a -> Element -> Element -> Element -> Element }", + "desc" : "Create a group of custom buttons.\n\n* The first argument is the default value of the `events` signal.\n* The `events` signal represents all of the activity in this group\n of custom buttons.\n* The `customButton` function creates a button with three different visual\n states, one for up, hovering, and down. The resulting button has dimensions\n large enough to fit all three possible `Elements`.\n The `a` value is sent to `events` whenever the button is pressed.\n" + }, + { "name" : "customButton", + "type" : "Element -> Element -> Element -> (Element, Signal ())", + "desc" : "Create a button with custom states for up, hovering, and down\n(given in that order). The result is an `Element` and\na signal of units. This signal triggers whenever the button is pressed.\n" + }, + { "name" : "checkboxes", + "type" : "a -> { events : Signal a,\n checkbox : (Bool -> a) -> Bool -> Element }", + "desc" : "Create a group of checkboxes.\n\n* The first argument is the default value of the `events` signal.\n* The `events` signal represents all of the activity in this group\n of checkboxes.\n* The `checkbox` function creates a\n checkbox with a given state. The `(Bool -> a)` function is used\n when the checkbox is modified. It takes the new state and turns\n it into a value that can be sent to `events`. For example, this\n lets you add an ID to distinguish between checkboxes.\n" + }, + { "name" : "checkbox", + "type" : "Bool -> (Signal Element, Signal Bool)", + "desc" : "Create a checkbox with a given start state. Unlike `button`, this result\nis a *signal* of elements. That is because a checkbox has state that\nupdates based on user input.\nThe boolean signal represents the current state of the checkbox.\n" + }, + { "name" : "FieldState", + "type" : "type FieldState = { string:String, selectionStart:Int, selectionEnd:Int }", + "desc" : "Represents the current state of a text field. The `string` represents the\ncharacters filling the text field. The `selectionStart` and `selectionEnd`\nvalues represent what the user has selected with their mouse or keyboard.\nFor example:\n\n { string=\"She sells sea shells\", selectionStart=3, selectionEnd=0 }\n\nThis means the user highlighted the substring `\"She\"` backwards.\n" + }, + { "name" : "fields", + "type" : "a -> { events : Signal a,\n field : (FieldState -> a) -> String -> FieldState -> Element }", + "desc" : "Create a group of text input fields.\n\n* The first argument is the default value of the `events` signal.\n* The `events` signal represents all of the activity in this group\n of text fields.\n* The `field` function creates a\n field with the given ghost text and initial field state.\n When the field is modified, the `(FieldState -> a)` function\n takes the new state and turns\n it into a value that can be sent to `events`. For example, this\n lets you add an ID to distinguish between input fields.\n" + }, + { "name" : "emptyFieldState", + "type" : "FieldState", + "desc" : "The empty field state:\n\n { string=\"\", selectionStart=0, selectionEnd=0 }\n" + }, + { "name" : "field", + "type" : "String -> (Signal Element, Signal String)", + "desc" : "Create a field with the given default text. The output is an element that\nupdates to match the user input and a signal of strings representing the\ncontent of the field.\n" + }, + { "name" : "password", + "type" : "String -> (Signal Element, Signal String)", + "desc" : "Same as `field` but the UI element blocks out each characters.\n" + }, + { "name" : "email", + "type" : "String -> (Signal Element, Signal String)", + "desc" : "Same as `field` but it adds an annotation that this field is for email\naddresses. This is helpful for auto-complete and for mobile users who may\nget a custom keyboard with an `@` and `.com` button.\n" + } + ] + }, + { "name" : "Graphics.Element", + "values" : [ + { "name" : "widthOf", + "type" : "Element -> Int", + "desc" : "Get the width of an Element\n" + }, + { "name" : "heightOf", + "type" : "Element -> Int", + "desc" : "Get the height of an Element\n" + }, + { "name" : "sizeOf", + "type" : "Element -> (Int,Int)", + "desc" : "Get the width and height of an Element\n" + }, + { "name" : "width", + "type" : "Int -> Element -> Element", + "desc" : "Create an `Element` with a given width.\n" + }, + { "name" : "height", + "type" : "Int -> Element -> Element", + "desc" : "Create an `Element` with a given height.\n" + }, + { "name" : "opacity", + "type" : "Float -> Element -> Element", + "desc" : "Create an `Element` with a given opacity. Opacity is a number between 0 and 1\nwhere 0 means totally clear.\n" + }, + { "name" : "color", + "type" : "Color -> Element -> Element", + "desc" : "Create an `Element` with a given background color.\n" + }, + { "name" : "tag", + "type" : "String -> Element -> Element", + "desc" : "Create an `Element` with a tag. This lets you link directly to it.\nThe element `(tag \"all-about-badgers\" thirdParagraph)` can be reached\nwith a link lik this: `/facts-about-animals.elm#all-about-badgers`\n" + }, + { "name" : "link", + "type" : "String -> Element -> Element", + "desc" : "Create an `Element` that is a hyper-link.\n" + }, + { "name" : "image", + "type" : "Int -> Int -> String -> Element", + "desc" : "Create an image given a width, height, and image source.\n" + }, + { "name" : "fittedImage", + "type" : "Int -> Int -> String -> Element", + "desc" : "Create a fitted image given a width, height, and image source.\nThis will crop the picture to best fill the given dimensions.\n" + }, + { "name" : "croppedImage", + "type" : "Int -> Int -> (Int,Int) -> String -> Element", + "desc" : "Create a cropped image. Take a rectangle out of the picture starting\nat the given top left coordinate. If you have a 140-by-140 image,\nthe following will cut a 100-by-100 square out of the middle of it.\n\n croppedImage 100 100 (20,20) \"yogi.jpg\"\n" + }, + { "name" : "container", + "type" : "Int -> Int -> Position -> Element -> Element", + "desc" : "Put an element in a container. This lets you position the element really\neasily, and there are tons of ways to set the `Position`.\nTo center `element` exactly in a 300-by-300 square you would say:\n\n container 300 300 middle element\n\nBy setting the color of the container, you can create borders.\n" + }, + { "name" : "spacer", + "type" : "Int -> Int -> Element", + "desc" : "Create an empty box. This is useful for getting your spacing right and\nfor making borders.\n" + }, + { "name" : "flow", + "type" : "Direction -> [Element] -> Element", + "desc" : "Have a list of elements flow in a particular direction.\nThe `Direction` starts from the first element in the list.\n\n flow right [a,b,c]\n\n +---+---+---+\n | a | b | c |\n +---+---+---+\n" + }, + { "name" : "above", + "type" : "Element -> Element -> Element", + "desc" : "Stack elements vertically. To put `a` above `b` you would say:\n\n a `above` b\n" + }, + { "name" : "below", + "type" : "Element -> Element -> Element", + "desc" : "Stack elements vertically. To put `a` below `b` you would say:\n\n a `below` b\n" + }, + { "name" : "beside", + "type" : "Element -> Element -> Element", + "desc" : "Put elements beside each other horizontally.\n" + }, + { "name" : "layers", + "type" : "[Element] -> Element", + "desc" : "Layer elements on top of each other, starting from the bottom.\n`(layers == flow outward)`\n" + }, + { "name" : "absolute", + "type" : "Int -> Pos", + "desc" : "" + }, + { "name" : "relative", + "type" : "Float -> Pos", + "desc" : "" + }, + { "name" : "middle", + "type" : "Position", + "desc" : "" + }, + { "name" : "topLeft", + "type" : "Position", + "desc" : "" + }, + { "name" : "topRight", + "type" : "Position", + "desc" : "" + }, + { "name" : "bottomLeft", + "type" : "Position", + "desc" : "" + }, + { "name" : "bottomRight", + "type" : "Position", + "desc" : "" + }, + { "name" : "midLeft", + "type" : "Position", + "desc" : "" + }, + { "name" : "midRight", + "type" : "Position", + "desc" : "" + }, + { "name" : "midTop", + "type" : "Position", + "desc" : "" + }, + { "name" : "midBottom", + "type" : "Position", + "desc" : "" + }, + { "name" : "middleAt", + "type" : "Pos -> Pos -> Position", + "desc" : "" + }, + { "name" : "topLeftAt", + "type" : "Pos -> Pos -> Position", + "desc" : "" + }, + { "name" : "topRightAt", + "type" : "Pos -> Pos -> Position", + "desc" : "" + }, + { "name" : "bottomLeftAt", + "type" : "Pos -> Pos -> Position", + "desc" : "" + }, + { "name" : "bottomRightAt", + "type" : "Pos -> Pos -> Position", + "desc" : "" + }, + { "name" : "midLeftAt", + "type" : "Pos -> Pos -> Position", + "desc" : "" + }, + { "name" : "midRightAt", + "type" : "Pos -> Pos -> Position", + "desc" : "" + }, + { "name" : "midTopAt", + "type" : "Pos -> Pos -> Position", + "desc" : "" + }, + { "name" : "midBottomAt", + "type" : "Pos -> Pos -> Position", + "desc" : "" + }, + { "name" : "up", + "type" : "Direction", + "desc" : "" + }, + { "name" : "down", + "type" : "Direction", + "desc" : "" + }, + { "name" : "left", + "type" : "Direction", + "desc" : "" + }, + { "name" : "right", + "type" : "Direction", + "desc" : "" + }, + { "name" : "inward", + "type" : "Direction", + "desc" : "" + }, + { "name" : "outward", + "type" : "Direction", + "desc" : "" + } + ] + }, + { "name" : "Graphics.Collage", + "values" : [ + { "name" : "Form", + "type" : "type Form = {\n theta : Float,\n scale : Float,\n x : Float,\n y : Float,\n form : BasicForm\n }", + "desc" : "" + }, + { "name" : "FillStyle", + "type" : "data FillStyle\n = Solid Color\n | Texture String\n | Gradient Gradient", + "desc" : "" + }, + { "name" : "LineCap", + "type" : "data LineCap = Flat | Round | Padded", + "desc" : "The shape of the ends of a line. \n" + }, + { "name" : "LineJoin", + "type" : "data LineJoin = Smooth | Sharp Float | Clipped", + "desc" : "The shape of the “joints” of a line, where each line segment\nmeets. `Sharp` takes an argument to limit the length of the joint. This\ndefaults to 10.\n" + }, + { "name" : "LineStyle", + "type" : "type LineStyle = {\n color : Color,\n width : Float,\n cap : LineCap,\n join : LineJoin,\n dashing : [Int],\n dashOffset : Int\n }", + "desc" : "All of the attributes of a line style. This lets you build up a line style\nhowever you want. You can also update existing line styles with record updates.\n" + }, + { "name" : "defaultLine", + "type" : "LineStyle", + "desc" : "The default line style, which is solid black with flat caps and sharp joints.\nYou can use record updates to build the line style you\nwant. For example, to make a thicker line, you could say:\n\n { defaultLine | width <- 10 }\n" + }, + { "name" : "solid", + "type" : "Color -> LineStyle", + "desc" : "Create a solid line style with a given color.\n" + }, + { "name" : "dashed", + "type" : "Color -> LineStyle", + "desc" : "Create a dashed line style with a given color. Dashing equals `[8,4]`.\n" + }, + { "name" : "dotted", + "type" : "Color -> LineStyle", + "desc" : "Create a dotted line style with a given color. Dashing equals `[3,3]`.\n" + }, + { "name" : "BasicForm", + "type" : "data BasicForm\n = FPath LineStyle Path\n | FShape (Either LineStyle FillStyle) Shape\n | FImage Int Int (Int,Int) String\n | FElement Element\n | FGroup Matrix2D [Form]", + "desc" : "" + }, + { "name" : "filled", + "type" : "Color -> Shape -> Form", + "desc" : "Create a filled in shape.\n" + }, + { "name" : "textured", + "type" : "String -> Shape -> Form", + "desc" : "Create a textured shape. The texture is described by some url and is\ntiled to fill the entire shape.\n" + }, + { "name" : "gradient", + "type" : "Gradient -> Shape -> Form", + "desc" : "Fill a shape with a [gradient](/docs/Color.elm#linear).\n" + }, + { "name" : "outlined", + "type" : "LineStyle -> Shape -> Form", + "desc" : "Outline a shape with a given line style.\n" + }, + { "name" : "traced", + "type" : "LineStyle -> Path -> Form", + "desc" : "Trace a path with a given line style.\n" + }, + { "name" : "sprite", + "type" : "Int -> Int -> (Int,Int) -> String -> Form", + "desc" : "Create a sprite from a sprite sheet. It cuts out a rectangle\nat a given position.\n" + }, + { "name" : "toForm", + "type" : "Element -> Form", + "desc" : "Turn any `Element` into a `Form`. This lets you use text, gifs, and video\nin your collage. This means you can move, rotate, and scale\nan `Element` however you want.\n" + }, + { "name" : "group", + "type" : "[Form] -> Form", + "desc" : "Flatten many forms into a single `Form`. This lets you move and rotate them\nas a single unit, making it possible to build small, modular components.\n" + }, + { "name" : "groupTransform", + "type" : "Matrix2D -> [Form] -> Form", + "desc" : "Flatten many forms into a single `Form` and then apply a matrix\ntransformation.\n" + }, + { "name" : "rotate", + "type" : "Float -> Form -> Form", + "desc" : "Rotate a form by a given angle. Rotate takes standard Elm angles (radians)\nand turns things counterclockwise. So to turn `form` 30° to the left\nyou would say, `(rotate (degrees 30) form)`.\n" + }, + { "name" : "scale", + "type" : "Float -> Form -> Form", + "desc" : "Scale a form by a given factor. Scaling by 2 doubles the size.\n" + }, + { "name" : "move", + "type" : "(Float,Float) -> Form -> Form", + "desc" : "Move a form by the given amount. This is a relative translation so\n`(move (10,10) form)` would move `form` ten pixels up and ten pixels to the\nright.\n" + }, + { "name" : "moveX", + "type" : "Float -> Form -> Form", + "desc" : "Move a shape in the x direction. This is relative so `(moveX 10 form)` moves\n`form` 10 pixels to the right.\n" + }, + { "name" : "moveY", + "type" : "Float -> Form -> Form", + "desc" : "Move a shape in the y direction. This is relative so `(moveY 10 form)` moves\n`form` upwards by 10 pixels.\n" + }, + { "name" : "collage", + "type" : "Int -> Int -> [Form] -> Element", + "desc" : "A collage is a collection of 2D forms. There are no strict positioning\nrelationships between forms, so you are free to do all kinds of 2D graphics.\n" + }, + { "name" : "Path", + "type" : "type Path = [(Float,Float)]", + "desc" : "" + }, + { "name" : "path", + "type" : "[(Number a,Number a)] -> Path", + "desc" : "Create a path that follows a sequence of points.\n" + }, + { "name" : "segment", + "type" : "(Number a,Number a) -> (Number a,Number a) -> Path", + "desc" : "Create a path along a given line segment.\n" + }, + { "name" : "Shape", + "type" : "type Shape = [(Float,Float)]", + "desc" : "" + }, + { "name" : "polygon", + "type" : "[(Number a,Number a)] -> Shape", + "desc" : "Create an arbitrary polygon by specifying its corners in order.\n`polygon` will automatically close all shapes, so the given list\nof points does not need to start and end with the same position.\n" + }, + { "name" : "rect", + "type" : "Number a -> Number a -> Shape", + "desc" : "A rectangle with a given width and height.\n" + }, + { "name" : "square", + "type" : "Number a -> Shape", + "desc" : "A square with a given edge length.\n" + }, + { "name" : "oval", + "type" : "Number a -> Number a -> Shape", + "desc" : "An oval with a given width and height.\n" + }, + { "name" : "circle", + "type" : "Number a -> Shape", + "desc" : "A circle with a given radius.\n" + }, + { "name" : "ngon", + "type" : "Int -> Number a -> Shape", + "desc" : "A regular polygon with N sides. The first argument specifies the number\nof sides and the second is the radius. So to create a pentagon with radius\n30 you would say:\n\n ngon 5 30\n" + } + ] + } + ] +}
− elm-runtime-0.7.1.1.js
@@ -1,142 +0,0 @@-Elm={};var Guid=function(){var d=0;return{guid:function(){return d+=1}}}();-Elm.JavaScript=function(){function d(b){for(var a=["Nil"],c=b.length;c--;)a=["Cons",b[c],a];return a}function f(b){for(var a=[];"Cons"===b[0];)a.push(b[1]),b=b[2];return a}function b(b){return b.slice(1)}function c(b){return["Tuple"+b.length].concat(b)}return{castJSBoolToBool:function(b){return b},castBoolToJSBool:function(b){return b},castJSNumberToFloat:function(b){return b},castFloatToJSNumber:function(b){return b},castJSNumberToInt:function(b){return~~b},castIntToJSNumber:function(b){return b},-Experimental:{castJSElementToElement:function(b){return function(a){return function(c){return["Element",Guid.guid(),["EExternalHtml",c],b,a,1,["Nothing"],["Nothing"]]}}},castElementToJSElement:function(b){return Render.render(b)}},castJSArrayToList:d,castListToJSArray:f,castJSStringToString:d,castStringToJSString:function(b){return"string"===typeof b?b:f(b).join("")},castTupleToJSTuple2:b,castTupleToJSTuple3:b,castTupleToJSTuple4:b,castTupleToJSTuple5:b,castJSTupleToTuple2:c,castJSTupleToTuple3:c,-castJSTupleToTuple4:c,castJSTupleToTuple5:c}}();var JSjson=window.JSON;-Elm.JSON=function(){function d(a,b){return function(j){return function(l){var g=c.castStringToJSString(j);return l[1].hasOwnProperty(g)&&(l=l[1][g],l[0]===a)?l[1]:b}}}function f(a){return function(b){function j(a){switch(a[0]){case "JsonNull":return null;case "JsonString":return c.castStringToJSString(a[1]);case "JsonObject":var g={};a=a[1][1];for(var e in a)g[e]=j(a[e]);return g;case "JsonArray":g=c.castListToJSArray(a[1]);for(e=g.length;e--;)g[e]=j(g[e]);return g;default:return a[1]}}return JSjson.stringify(j(["JsonObject",-b]),null,c.castStringToJSString(a))}}function b(a){function b(a){switch(typeof a){case "string":return["JsonString",c.castJSStringToString(a)];case "number":return["JsonNumber",c.castJSNumberToFloat(a)];case "boolean":return["JsonBool",c.castJSBoolToBool(a)];case "object":if(null===a)return["JsonNull"];for(var g in a)a[g]=b(a[g]);return a instanceof Array?["JsonArray",c.castJSArrayToList(a)]:["JsonObject",["JSON",a]]}}a=JSjson.parse(a);for(var j in a)a[j]=b(a[j]);return["JSON",a]}var c=Elm.JavaScript,-h=["JSON",{}];return{empty:h,singleton:function(a){return function(b){var j={};j[c.castStringToJSString(a)]=b;return["JSON",j]}},insert:function(a){return function(b){return function(j){j=j[1];var l={},g;for(g in j)l[g]=j[g];l[c.castStringToJSString(a)]=b;return["JSON",l]}}},lookup:function(a){return function(b){var j=c.castStringToJSString(a);return b[1].hasOwnProperty(j)?["Just",b[1][j]]:["Nothing"]}},findString:d("JsonString",["Nil"]),findObject:d("JsonObject",h),findArray:d("JsonArray",["Nil"]),-findWithDefault:function(a){return function(b){return function(j){var l=c.castStringToJSString(b);return j[1].hasOwnProperty(l)?j[1][l]:a}}},remove:function(a){return function(b){b=b[1];var j={},l;for(l in b)j[l]=b[l];delete j[c.castStringToJSString(a)];return["JSON",j]}},toPrettyJSString:f,toJSString:f(""),fromJSString:b,toPrettyString:function(a){return function(b){return c.castJSStringToString(f(a)(b))}},toString:function(a){return c.castJSStringToString(f("")(a))},fromString:function(a){return b(c.castStringToJSString(a))},-toList:function(a){a=a[1];var b=[],j;for(j in a)b.push(Value.Tuple(c.castJSStringToString(j),a[j]));return c.castJSArrayToList(b)},fromList:function(a){a=c.castListToJSArray(a);for(var b={},j=a.length;j--;)b[c.castStringToJSString(a[j][1])]=a[j][2];return["JSON",b]},JsonString:function(a){return["JsonString",a]},JsonNumber:function(a){return["JsonNumber",a]},JsonBool:function(a){return["JsonBool",a]},JsonNull:["JsonNull"],JsonArray:function(a){return["JsonArray",a]},JsonObject:function(a){return["JsonObject",-a]}}}();-var Value=function(){function d(a){if(0==a.length)return a;a=a.replace(/"/g,""").replace(/'/g,"'").replace(/</g,"<").replace(/>/g,">").replace(/\n/g,"<br/>");a=a.split("<br/>");for(var b=a.length;b--;){var c=a,l=b,g;g=a[b];if(0!=g.length){g=g.split("");" "==g[0]&&(g[0]=" ");for(var e=g.length;--e;)" "==g[e][0]&&" "==g[e-1]&&(g[e-1]+=g[e],g[e]="");for(e=g.length;e--;)if(1<g[e].length&&" "==g[e][0]){for(var k=g[e].split(""),f=k.length-2;0<=f;f-=2)k[f]=" ";g[e]=k.join("")}g=g.join("");-g=" "===g[g.length-1]?g.slice(0,-1)+" ":g}c[l]=g}return a.join("<br/>")}var f=function(a,b){if("object"===typeof a){if(a.hasOwnProperty("_")){for(var c in a)if(a[c]!=b[c])return!1;for(c in b)if(a[c]!=b[c])return!1;return!0}if(a===b)return!0;if(a.length!==b.length)return!1;for(c=a.length;c--;)if(!f(a[c],b[c]))return!1;return!0}return a===b},b=function(a){if("function"===typeof a)return"<function>";if("boolean"===typeof a)return a?"True":"False";if("number"!==typeof a){if("string"===typeof a&&-2>a.length)return"'"+a+"'";if("object"===typeof a&&a.hasOwnProperty("_")){var c=[],j;for(j in a)if("_"!=j)for(var l=a[j].length;l--;)c.push(j+" = "+b(a[j][l]));return 0===c.length?"{}":"{ "+c.join(", ")+" }"}if(a[0]){if("Tuple"===a[0].substring(0,5)){c=Array(a.length-1);for(l=a.length;--l;)c[l-1]=b(a[l]);return"("+c.join(",")+")"}if("Cons"===a[0]){j="string"===typeof a[1]?'"':"]";var l="string"===typeof a[1]?"":",",g="string"===typeof a[1]?function(a){return a}:b,c=("string"===typeof a[1]?'"':"[")+-g(a[1]);for(a=a[2];;)if("Cons"===a[0])c+=l+g(a[1]),a=a[2];else return c+j}else{if("Nil"===a[0])return"[]";if("JSON"===a[0])return"(JSON.fromList "+b(Elm.JSON.toList(a))+")";if("RBNode"===a[0]||"RBEmpty"===a[0])return a=Elm.Dict.foldr(function(a){return function(g){return function(b){return["Cons",["Tuple2",a,g],b]}}})(["Nil"])(a),c="Dict","Cons"===a[0]&&"Tuple0"===a[1][2][0]&&(c="Set",a=Elm.List.map(function(a){return a[1]})(a)),"("+c+".fromList "+b(a)+")";c="";for(l=a.length;--l;)c=" "+b(a[l])+c;-c=a[0]+c;return 1<a.length?"("+c+")":c}}}return a+""},c=function(a){for(var b=["Nil"],c=a.length;c--;)b=["Cons",a[c],b];return b},h;h=document.addEventListener?function(a,b,c){a.addEventListener(b,c,!1)}:function(a,b,c){a.attachEvent("on"+b,c)};return{eq:f,str:c,show:function(a){return c(b(a))},Tuple:function(){var a=arguments.length,b=Array(a+1);for(b[0]="Tuple"+arguments.length;a--;)b[a+1]=arguments[a];return b},append:function(a,b){if("string"===typeof a&&"string"===typeof b)return a.concat(b);-if("Nil"===a[0])return b;var c=["Cons",a[1],["Nil"]],l=c;for(a=a[2];"Cons"===a[0];)l[2]=["Cons",a[1],["Nil"]],a=a[2],l=l[2];l[2]=b;return c},listToArray:function(a){for(var b=[];"Cons"===a[0];)b.push(a[1]),a=a[2];return b},toText:function(a){if("string"===typeof a)return d(a);for(var b=[];"Cons"===a[0];)b.push(a[1]),a=a[2];return d(b.join(""))},properEscape:d,getTextSize:function(a,b,c){var l=document.createElement("div");l.innerHTML=c;l.style.textAlign="left";0<a&&(l.style.width=a+"px");l.style.visibility=-"hidden";l.style.styleFloat="left";l.style.cssFloat="left";document.body.appendChild(l);c=window.getComputedStyle(l,null);a=c.getPropertyValue("width").slice(0,-2)-0;c=c.getPropertyValue("height").slice(0,-2)-0;document.body.removeChild(l);return[Math.ceil(a),Math.ceil(Math.max(b,c))]},getSize:function(a){a=a.cloneNode(!0);a.style.visibility="hidden";a.style.styleFloat="left";a.style.cssFloat="left";document.body.appendChild(a);var b=a.offsetWidth,c=a.offsetHeight;document.body.removeChild(a);return[b,-c]},getExcess:function(a){a=a.cloneNode(!0);a.style.visibility="hidden";a.style.styleFloat="left";a.style.cssFloat="left";document.body.appendChild(a);var b=a.offsetWidth,c=a.offsetHeight,l=window.getComputedStyle(a,null),g=l.getPropertyValue("width").slice(0,-2)-0,l=l.getPropertyValue("height").slice(0,-2)-0;document.body.removeChild(a);return[b-g,c-l]},groupForms:function(a){a=Elm.JavaScript.castListToJSArray(a);for(var b=[],c=[],l=a.length;l--;){var g=a[l];switch(g[4][0]){case "FElement":0<c.length&&-(b.push(c),c=[]);b.push(g);break;default:c.push(g)}}0<c.length&&b.push(c);return b},wrap:function(b){var c=Value.getSize(b);return["Element",Guid.guid(),["EHtml",b],c[0],c[1],1,["Nothing"],["Nothing"]]},addListener:h}}();-Elm.List=function(){function d(b){return function(a){if("Nil"===a[0])return a;"Cons"!==a[0]&&g("map");var e=["Cons",b(a[1]),["Nil"]],c=e;for(a=a[2];"Cons"===a[0];)c[2]=["Cons",b(a[1]),["Nil"]],a=a[2],c=c[2];return e}}function f(a){return function(b){return function(e){var c=b;if("Nil"===e[0])return c;for("Cons"!==e[0]&&g("foldl");"Cons"===e[0];)c=a(e[1])(c),e=e[2];return c}}}function b(a){return function(b){return function(e){var c=b;if("Nil"===e[0])return c;"Cons"!==e[0]&&g("foldr");for(var k=[];"Cons"===-e[0];)k.push(e[1]),e=e[2];for(e=k.length;e--;)c=a(k[e])(c);return c}}}function c(a){return function(b){var g;"Cons"!==b[0]?g=void 0:(g=b[1],b=b[2],g=f(a)(g)(b));return g}}function h(b){return function(a){return function(e){if("Nil"===e[0])return["Cons",a,["Nil"]];"Cons"!==e[0]&&g("scanl");for(var c=[a];"Cons"===e[0];)a=b(e[1])(a),c.push(a),e=e[2];e=["Nil"];for(var k=c.length;k--;)e=["Cons",c[k],e];return e}}}function a(b){return function(e){a:{for(var g=[function(b){return"Nil"!==b[0]?void 0:["Tuple2",-["Nil"],["Nil"]]},function(e){if("Cons"===e[0]){var g=e[1];e=e[2];var c=a(b)(e);"Tuple2"!==c[0]?g=void 0:(e=c[1],c=c[2],g=b(g)?["Tuple2",["Cons",g,e],c]:["Tuple2",e,["Cons",g,c]]);return g}}],c=g.length;c--;){var k=g[c](e);if(void 0!==k){e=k;break a}}e=void 0}return e}}function m(b){a:{for(var a=[function(b){return"Nil"!==b[0]?void 0:["Tuple2",["Nil"],["Nil"]]},function(b){if("Cons"!==b[0])b=void 0;else if(b=["Tuple2",b[1],m(b[2])],"Tuple2"!==b[0]||"Tuple2"!==b[1][0])b=void 0;else{var a=b[1][1],e=-b[1][2];b="Tuple2"!==b[2][0]?void 0:["Tuple2",["Cons",a,b[2][1]],["Cons",e,b[2][2]]]}return b}],e=a.length;e--;){var g=a[e](b);if(void 0!==g){b=g;break a}}b=void 0}return b}function j(b){return function(a){a:{for(var e=[function(b){return"Nil"!==b[0]?void 0:["Nil"]},function(b){if("Cons"===b[0]){var a=b[1];return"Nil"!==b[2][0]?void 0:["Cons",a,["Nil"]]}},function(a){if("Cons"===a[0]){var e=a[1];if("Cons"===a[2][0]){var g=a[2][1];a=a[2][2];return["Cons",e,["Cons",b,j(b)(["Cons",g,a])]]}}}],g=e.length;g--;){var c=-e[g](a);if(void 0!==c){a=c;break a}}a=void 0}return a}}function l(b){return function(a){a:{for(var e=[function(b){return"Nil"!==b[0]?void 0:["Nil"]},function(b){if("Cons"===b[0]){var a=b[1];return"Nil"!==b[2][0]?void 0:a}},function(a){if("Cons"===a[0]){var e=a[1];if("Cons"===a[2][0]){var g=a[2][1];a=a[2][2];return Value.append(e,Value.append(b,l(b)(["Cons",g,a])))}}}],g=e.length;g--;){var c=e[g](a);if(void 0!==c){a=c;break a}}a=void 0}return a}}var g=function(b){throw"Function '"+b+"' expecting a list!";-},e=f(function(b){return function(a){return["Cons",b,a]}})(["Nil"]),k=b(function(b){return function(a){return Value.append(b,a)}})(["Nil"]),x=f(function(b){return function(a){return b&&a}})(!0),n=f(function(b){return function(a){return b||a}})(!1),p=f(function(b){return function(a){return b+a}})(0),s=f(function(b){return function(a){return b*a}})(1),v=c(function(b){return function(a){return Math.max(b,a)}}),t=c(function(b){return function(a){return Math.min(b,a)}});return{head:function(b){if("Cons"!==-b[0])throw"Error: 'head' only accepts lists of length greater than one.";return b[1]},tail:function(b){if("Cons"!==b[0])throw"Error: 'tail' only accepts lists of length greater than one.";return b[2]},last:function(b){if("Cons"!==b[0])throw"Error: 'last' only accepts lists of length greater than one.";for(var a=b[1];"Cons"===b[0];)a=b[1],b=b[2];return a},map:d,foldl:f,foldr:b,foldl1:c,foldr1:function(b){return function(a){if("Nil"===a[0])throw"'foldr1' requires an non-empty list.";"Cons"!==a[0]&&-g("foldr1");for(var e=[];"Cons"===a[0];)e.push(a[1]),a=a[2];a=e.pop();for(var c=e.length;c--;)a=b(e[c])(a);return a}},scanl:h,scanl1:function(b){return function(a){if("Cons"!==a[0])throw"Error: 'scanl1' requires a list of at least length 1.";return h(b)(a[1])(a[2])}},filter:function(b){return function(a){if("Nil"===a[0])return a;"Cons"!==a[0]&&g("filter");for(var e=[];"Cons"===a[0];)b(a[1])&&e.push(a[1]),a=a[2];a=["Nil"];for(var c=e.length;c--;)a=["Cons",e[c],a];return a}},length:function(b){for(var a=-0;"Cons"===b[0];)a+=1,b=b[2];return a},reverse:e,concat:k,concatMap:function(b){return function(a){return k(d(b)(a))}},and:x,or:n,all:function(b){return f(function(a){return function(e){return e&&b(a)}})(!0)},any:function(b){return f(function(a){return function(e){return e||b(a)}})(!1)},sum:p,product:s,maximum:v,minimum:t,partition:a,zipWith:function(b){return function(a){return function(e){if("Nil"===a[0]||"Nil"===e[0])return["Nil"];("Cons"!==a[0]||"Cons"!==e[0])&&g("zipWith");for(var c=[];"Cons"===-a[0]&&"Cons"===e[0];)c.push(b(a[1])(e[1])),a=a[2],e=e[2];e=["Nil"];for(var k=c.length;k--;)e=["Cons",c[k],e];return e}}},zip:function(a){return function(b){if("Nil"===a[0]||"Nil"===b[0])return["Nil"];("Cons"!==a[0]||"Cons"!==b[0])&&g("zip");for(var e=[];"Cons"===a[0]&&"Cons"===b[0];)e.push(["Tuple2",a[1],b[1]]),a=a[2],b=b[2];b=["Nil"];for(var c=e.length;c--;)b=["Cons",e[c],b];return b}},unzip:m,intersperse:j,intercalate:l,sort:function(a){if("Nil"===a[0])return a;"Cons"!==a[0]&&g("sort");for(var b=-[];"Cons"===a[0];)b.push(a[1]),a=a[2];b.sort(function(a,b){return a-b});a=["Nil"];for(var e=b.length;e--;)a=["Cons",b[e],a];return a},take:function(a){return function(b){if(0>=a)return["Nil"];if("Nil"===b[0])return b;"Cons"!==b[0]&&g("take");var e=["Cons",b[1],["Nil"]],c=e;b=b[2];for(--a;"Cons"===b[0]&&0<a;)c[2]=["Cons",b[1],["Nil"]],c=c[2],b=b[2],--a;return e}},drop:function(a){return function(b){if("Nil"===b[0])return b;for("Cons"!==b[0]&&g("drop");"Cons"===b[0]&&0<a;)b=b[2],--a;return b}}}}();-Elm.Maybe=function(){function d(f){return function(b){return"Just"===f[0]?["Cons",f[1],b]:b}}return{Just:function(f){return["Just",f]},Nothing:["Nothing"],justs:Elm.List.foldr(d)(["Nil"]),isJust:function(f){return"Just"===f[0]},isNothing:function(f){return"Nothing"===f[0]},cons:d,maybe:function(f){return function(b){return function(c){return"Just"===c[0]?b(c[1]):f}}}}}();-Elm.Either=function(){function d(b){return"Left"==b[0]}function f(b){return"Right"==b[0]}function b(b){return Elm.List.map(function(b){return b[1]})(b)}return{Left:function(b){return["Left",b]},Right:function(b){return["Right",b]},either:function(b){return function(f){return function(a){switch(a[0]){case "Left":return b(a[1]);case "Right":return f(a[1])}}}},isLeft:d,isRight:f,lefts:function(c){return b(Elm.List.filter(d)(c))},rights:function(c){return b(Elm.List.filter(f)(c))},partition:function(c){c=-Elm.List.partition(d)(c);c[1]=b(c[1]);c[2]=b(c[2]);return c}}}();-Elm.Char=function(){function d(b,a){return function(c){c=c.charCodeAt(0);return b<=c&&c<=a}}var f=d(48,57),b=d(97,102),c=d(65,70);return{fromCode:function(b){return String.fromCharCode(b)},toCode:function(b){return b.charCodeAt(0)},toUpper:function(b){return b.toUpperCase()},toLower:function(b){return b.toLowerCase()},toLocaleUpper:function(b){return b.toLocaleUpperCase()},toLocaleLower:function(b){return b.toLocaleLowerCase()},isLower:d(97,122),isUpper:d(65,90),isDigit:f,isOctDigit:d(48,55),isHexDigit:function(d){return f(d)||-b(d)||c(d)}}}();-Elm.Color=function(){function d(f){var b=f.value*f.saturation,c=f.hue/60,d=b*(1-Math.abs(c%2-1)),a=0,m=0,j=0;0<=c&&1>c?(a=b,m=d,j=0):1<=c&&2>c?(a=d,m=b,j=0):2<=c&&3>c?(a=0,m=b,j=d):3<=c&&4>c?(a=0,m=d,j=b):4<=c&&5>c?(a=d,m=0,j=b):5<=c&&6>c&&(a=b,m=0,j=d);f=f.value-b;return["Color",Math.round(255*(a+f)),Math.round(255*(m+f)),Math.round(255*(j+f)),1]}return{rgba:function(f){return function(b){return function(c){return function(d){return["Color",f,b,c,d]}}}},rgb:function(f){return function(b){return function(c){return["Color",f,-b,c,1]}}},hsva:function(f){return function(b){return function(c){return function(h){var a=d({hue:f,saturation:b,value:c});a[4]=h;return a}}}},hsv:function(f){return function(b){return function(c){return d({hue:f,saturation:b,value:c})}}},red:["Color",255,0,0,1],green:["Color",0,255,0,1],blue:["Color",0,0,255,1],yellow:["Color",255,255,0,1],cyan:["Color",0,255,255,1],magenta:["Color",255,0,255,1],black:["Color",0,0,0,1],white:["Color",255,255,255,1],gray:["Color",128,128,128,1],grey:["Color",128,128,-128,1],complement:function(f){var b;b=f[1]/255;var c=f[2]/255;f=f[3]/255;var h=Math.max(b,c,f),a=Math.min(b,c,f),a=h-a,m=0;0===a?m=0:h===b?m=(c-f)/a%6:h===c?m=(f-b)/a+2:h===f&&(m=(b-c)/a+4);b={value:h,hue:60*m,saturation:0===h?0:a/h};b.hue=(b.hue+180)%360;return d(b)},extract:function(f){return 1===f[4]?"rgb("+f[1]+","+f[2]+","+f[3]+")":"rgba("+f[1]+","+f[2]+","+f[3]+","+f[4]+")"}}}();-var Collage=function(){function d(b,a){var e=a.length-1;if(!(0>=e))for(b.moveTo(a[e][1],a[e][2]);e--;)b.lineTo(a[e][1],a[e][2])}function f(b,a,e,c){0===b.length&&(b=[8,4]);var f=c.length-1;if(!(0>=f)){var n=c[f][1],p=c[f][2],d=0,j=0,h=0,m=0,q=0,u=0,w=b.length,z=!0,y=b[0];for(a.moveTo(n,p);f--;){d=c[f][1];j=c[f][2];h=d-n;m=j-p;for(q=Math.sqrt(h*h+m*m);y<=q;)n+=h*y/q,p+=m*y/q,a[z?"lineTo":"moveTo"](n,p),h=d-n,m=j-p,q=Math.sqrt(h*h+m*m),z=!z,u=(u+1)%w,y=b[u];0<q&&(a[z?"lineTo":"moveTo"](d,j),y-=q);n=-d;p=j}}a.strokeStyle=Elm.Color.extract(e);a.stroke()}function b(b,a,e,c,x){a.clearRect(0,0,e,c);for(e=x.length;e--;){var n=x[e],p=b;c=a;var h=n[1],m=n[2],t=n[3][1],r=n[3][2],n=n[4];c.save();(0!==t||0!==r)&&c.translate(t,r);h!==~~h&&c.rotate(2*Math.PI*h);1!==m&&c.scale(m,m);c.beginPath();switch(n[0]){case "FLine":a:switch(p=c,h=n,n=h[3][1],h[1][0]){case "Solid":h=h[2];d(p,n);p.strokeStyle=Elm.Color.extract(h);p.stroke();break;case "Dotted":f([3,3],p,h[2],n);break a;case "Dashed":f([8,4],p,h[2],n);-break a;case "Custom":f(h[1][1],p,h[2],n)}break;case "FShape":a:switch(t=p,m=c,p=n[1],h=n[2],n=n[3][1],p[0]){case "Filled":p=m;d(p,n);p.fillStyle=Elm.Color.extract(h);p.fill();break a;case "Outlined":p=m;d(p,n);p.strokeStyle=Elm.Color.extract(h);p.stroke();break a;case "Textured":h=t;p=p[1];t=new Image;t.src=j.castStringToJSString(p);t.onload=h;d(m,n);m.fillStyle=m.createPattern(t,"repeat");m.fill();break a;case "CustomOutline":f(p[1],m,h,n)}break;case "FImage":h=c,m=n[1],t=n[2],n=n[3],r=new Image,-r.onload=p,r.src=j.castStringToJSString(n),h.drawImage(r,-m/2,-t/2,m,t)}c.restore()}}function c(a,c,e){var k=Render.newElement("canvas");a=~~a;c=~~c;k.style.width=a+"px";k.style.height=c+"px";k.style.display="block";k.width=a;k.height=c;if(k.getContext){var f=k.getContext("2d");b(function(){b(this,f,a,c,e)},f,a,c,e);return k}k.innerHTML="Your browser does not support the canvas element.";return k}function h(b,a,e,c,f,n,d){b="translate("+(e-f/2)+"px,"+(c-n/2)+"px) "+(1===a?"":"scale("+a+","+a+")")+-" "+(b===~~b?"":"rotate("+360*b+"deg)");d.style.transform=b;d.style.msTransform=b;d.style.MozTransform=b;d.style.webkitTransform=b;d.style.OTransform=b}function a(a,g,e){if(!Value.eq(e,g)){var k=a.style.width.slice(0,-2)-0,f=a.style.height.slice(0,-2)-0;if("object"===typeof e[0]){if("object"===typeof g[0]&&a.getContext){var n=a.getContext("2d");return b(function(){b(this,n,k,f,e)},n,k,f,e)}g=c(k,f,e);g.style.position="absolute";return a.parentNode.replaceChild(g,a)}a.style.width=~~k+"px";a.style.height=-~~f+"px";var d=e[4][1];Render.update(a.firstChild,g[4][1],d);h(e[1],e[2],e[3][1],e[3][2],d[3],d[4],a.firstChild)}}function m(b,a,e,c,f){var n=0,d,j=(b[1]-c[1])/e;b=(b[2]-c[2])/e;0!==a&&(a*=-2*Math.PI,e=j*Math.cos(a)-b*Math.sin(a),b=j*Math.sin(a)+b*Math.cos(a),j=e);if(0===f.length)return!1;d=f[0];for(e=f.length-1;e--;){a=f[e];c=d[1];d=d[2];var h=a[1],m=a[2];if(d<m)var r=d,q=m;else r=m,q=d;if(c<h)var u=c,w=h;else u=h,w=c;r<b&&b<=q&&j<=w&&(j<=u||j<=(b-d)*(h-c)/(m-d)+c)&&++n;d=a}return 1===n%2}var j=-Elm.JavaScript;return{collage:function(b,a,e){if(0===e.length)return c(b,a,[]);for(var k=Array(e.length),d=e.length;d--;){var f=e[d];if("string"===typeof f[0]){var j=k,m=d,v=b,t=a,r=f[1],q=f[2],u=f[3][1],w=f[3][2],z=f[4][1],f=Render.render(z);h(r,q,u,w,z[3],z[4],f);r=Render.newElement("div");Render.addTo(r,f);r.style.width=~~v+"px";r.style.height=~~t+"px";r.style.overflow="hidden";j[m]=r}else k[d]=c(b,a,f)}return 1===e.length?k[0]:Render.flowWith(Render.goIn,function(b){return b},k)},updateCollage:function(b,-c,e){if(1===e.length)return a(b,c[0],e[0]);b=b.childNodes;for(var k=b.length,f=k;f--;)a(b[k-f-1],c[f],e[f])},insideForm:function(b){return function(a){var e=b[1],c=b[2];if(6>a.length){var f=a[3][1],d=a[3][2],j=0,h=a[2];switch(a[4][0]){case "FShape":for(var v=a[4][3][1],t=v.length;--t;)var r=v[t],j=Math.max(j,r[1]*r[1]+r[2]*r[2]);j*=h*h;break;case "FImage":v=h*a[4][1]/2;h=h*a[4][2]/2;j=v*v+h*h;break;case "FElement":v=h*a[4][1][3]/2,h=h*a[4][1][4]/2,j=v*v+h*h}a.push(function(b,a){var e=b-f,c=a-d;return e*-e+c*c<j+1})}if(!a[5](e,c))return!1;var q,u;switch(a[4][0]){case "FShape":return m(b,a[1],a[2],a[3],a[4][3][1]);case "FLine":return!1;case "FImage":q=a[4][1]/2;u=a[4][2]/2;break;case "FElement":q=a[4][1][3]/2,u=a[4][1][4]/2}return m(b,a[1],a[2],a[3],[[null,q,u],[null,-q,u],[null,-q,-u],[null,q,-u],[null,q,u]])}}}}();-Elm.Graphics=function(){function d(b){return function(a){return["Position",b,a]}}function f(b){return function(a){return["EText",b,a]}}function b(b){return function(a){return["EFlow",b,s.castListToJSArray(a)]}}function c(b){return["Line",s.castListToJSArray(b)]}function h(b){return function(a){var e=s.castListToJSArray(b);0<e.length&&e.push(e[0]);return["Shape",e,a]}}function a(b){return function(a){return function(e){return function(c){return["Form",b,a,e,c]}}}}function m(b){return function(a){return function(e){return["FLine",-b,a,e]}}}function j(b){return function(a){return function(e){return["FShape",b,a,e]}}}function l(b,a,e,c,g,k){return["Element",Guid.guid(),b,a,e,c,g,k]}function g(b,a,e){return["Element",Guid.guid(),b,a,e,1,["Nothing"],["Nothing"]]}function e(b){return~~b[3]}function k(b){return~~b[4]}function x(b){return function(a){return function(e){return g(["EImage",s.castStringToJSString(e)],b,a)}}}function n(b){return function(a){return g(z,b,a)}}function p(b){return function(a){return function(e){var c=map(function(e){return["Tuple2",-b/2*Math.cos(2*(Math.PI/50)*e),a/2*Math.sin(2*(Math.PI/50)*e)]}),g=49,k=["Nil"];if(0<=g){do k=["Cons",g,k];while(0<g--)}return h(c(k))(e)}}}for(this.i in Elm.List)eval("var "+this.i+" = Elm.List[this.i];");var s=Elm.JavaScript,v=["DRight"],t=["DDown"],r=["DOut"],q=["Near"],u=["Mid"],w=["Far"],z=["EEmpty"],y=["Solid"],D=["Dotted"],F=["Dashed"],B=["Filled"],E=["Outlined"],A=d(q)(q),C=d(w)(q),G=d(q)(w),H=d(w)(w),I=d(q)(u),J=d(w)(u),q=d(u)(q),w=d(u)(w),u=d(u)(u);return{left:["DLeft"],right:v,down:t,up:["DUp"],-inward:["DIn"],outward:r,topLeft:A,topRight:C,bottomLeft:G,bottomRight:H,midLeft:I,midRight:J,midTop:q,midBottom:w,middle:u,middleAt:function(b){return function(a){return["PositionAt",b,a]}},topLeftAt:function(b){return function(a){return["PositionTL",b,a]}},topRightAt:function(b){return function(a){return["PositionTR",b,a]}},bottomLeftAt:function(b){return function(a){return["PositionBL",b,a]}},bottomRightAt:function(b){return function(a){return["PositionBR",b,a]}},absolute:function(b){return["Absolute",-b]},relative:function(b){return["Relative",b]},width:function(b){return function(a){var e=a[2];switch(e[0]){case "EImage":case "EVideo":return l(a[2],b,a[4]*b/a[3],a[5],a[6],a[7]);case "EText":return e=Value.getTextSize(b,a[4],e[2]),l(a[2],b,e[1],a[5],a[6],a[7])}return l(a[2],b,a[4],a[5],a[6],a[7])}},height:function(a){return function(b){switch(b[2][0]){case "EImage":case "EVideo":return l(b[2],b[3]*a/b[4],a,b[5],b[6],b[7])}return l(b[2],b[3],a,b[5],b[6],b[7])}},size:function(b){return function(a){return function(e){return l(e[2],-b,a,e[5],e[6],e[7])}}},opacity:function(b){return function(a){return l(a[2],a[3],a[4],b,a[6],a[7])}},color:function(b){return function(a){return l(a[2],a[3],a[4],a[5],["Just",b],a[7])}},link:function(b){return function(a){return l(a[2],a[3],a[4],a[5],a[6],["Just",s.castStringToJSString(b)])}},widthOf:e,heightOf:k,sizeOf:function(a){return["Tuple2",~~a[3],~~a[4]]},text:function(a){var b=Value.getTextSize(0,0,a);return g(f("left")(a),b[0],b[1])},asText:function(a){a=Elm.Text.monospace(Value.toText(Value.show(a)));-var b=Value.getTextSize(0,0,a);return g(f("left")(a),b[0],b[1])},plainText:function(a){a=Value.toText(a);var b=Value.getTextSize(0,0,a);return g(f("left")(a),b[0],b[1])},centeredText:function(a){var b=Value.getTextSize(0,0,a);return g(f("center")(a),b[0],b[1])},justifiedText:function(a){var b=Value.getTextSize(0,0,a);return g(f("justify")(a),b[0],b[1])},rightedText:function(a){var b=Value.getTextSize(0,0,a);return g(f("right")(a),b[0],b[1])},image:x,images:function(a){var b=Elm.Signal.constant(n(0)(0));-a=Elm.Signal.lift(function(a){a=s.castStringToJSString(a);var e=new Image;e.onload=function(){Dispatcher.notify(b.id,x(this.width)(this.height)(a))};e.src=a})(a);return Elm.Signal.lift2(function(a){return function(){return a}})(b)(a)},video:function(a){return function(b){return function(e){return g(["EVideo",s.castStringToJSString(e)],a,b)}}},fittedImage:function(a){return function(b){return function(e){return g(["EFittedImage",s.castStringToJSString(e)],a,b)}}},flow:function(a){return function(c){var f;-f=map(e)(c);a:{switch(a[0]){case "DLeft":f=sum(f);break a;case "DRight":f=sum(f);break a}f=maximum(f)}var d;d=map(k)(c);a:{switch(a[0]){case "DDown":d=sum(d);break a;case "DUp":d=sum(d);break a}d=maximum(d)}return g(b(a)(c),f,d)}},above:function(a){return function(e){return g(b(t)(["Cons",a,["Cons",e,["Nil"]]]),Math.max(~~a[3],~~e[3]),~~a[4]+~~e[4])}},below:function(a){return function(e){return g(b(t)(["Cons",e,["Cons",a,["Nil"]]]),Math.max(~~a[3],~~e[3]),~~a[4]+~~e[4])}},beside:function(a){return function(e){return g(b(v)(["Cons",-a,["Cons",e,["Nil"]]]),~~a[3]+~~e[3],Math.max(~~a[4],~~e[4]))}},layers:function(a){return g(b(r)(a),maximum(map(e)(a)),maximum(map(k)(a)))},collage:function(a){return function(b){return function(e){return g(["ECollage",a,b,Value.groupForms(e)],a,b)}}},spacer:n,container:function(a){return function(b){return function(e){return function(c){return g(["EContainer",e,c],a,b)}}}},line:c,segment:function(a){return function(b){return c(["Cons",a,["Cons",b,["Nil"]]])}},polygon:h,rect:function(a){return function(b){return function(e){return h(["Cons",-["Tuple2",0-a/2,0-b/2],["Cons",["Tuple2",0-a/2,b/2],["Cons",["Tuple2",a/2,b/2],["Cons",["Tuple2",a/2,0-b/2],["Nil"]]]]])(e)}}},oval:p,circle:function(a){return p(2*a)(2*a)},ngon:function(a){return function(b){return function(e){var c=map(function(e){return["Tuple2",b*Math.cos(2*(Math.PI/a)*e),b*Math.sin(2*(Math.PI/a)*e)]}),g=a-1,k=["Nil"];if(0<=g){do k=["Cons",g,k];while(0<g--)}return h(c(k))(e)}}},solid:function(b){return function(e){return a(0)(1)(["Tuple2",0,0])(m(y)(b)(e))}},dotted:function(b){return function(e){return a(0)(1)(["Tuple2",-0,0])(m(D)(b)(e))}},dashed:function(b){return function(e){return a(0)(1)(["Tuple2",0,0])(m(F)(b)(e))}},customLine:function(b){return function(e){return function(c){return a(0)(1)(["Tuple2",0,0])(m(["Custom",s.castListToJSArray(b)])(e)(c))}}},filled:function(b){return function(e){return a(0)(1)(e[2])(j(B)(b)(e))}},outlined:function(b){return function(e){return a(0)(1)(e[2])(j(E)(b)(e))}},customOutline:function(b){return function(e){return function(c){return a(0)(1)(c[2])(j(["CustomOutline",s.castListToJSArray(b)])(e)(c))}}},-textured:function(b){return function(e){return a(0)(1)(e[2])(j(["Textured",b])(null)(e))}},sprite:function(b){return function(e){return function(c){return function(g){return a(0)(1)(g)(["FImage",e,c,s.castStringToJSString(b)])}}}},toForm:function(b){return function(e){return a(0)(1)(b)(["FElement",e])}},rotate:function(b){return function(e){a:{switch(e[0]){case "Form":var c=e[2],g=e[3],k=e[4];e=a(b+e[1])(c)(g)(k);break a}throw"Non-exhaustive pattern match in case";}return e}},scale:function(b){return function(e){return a(e[1])(b*-e[2])(e[3])(e[4])}},move:function(b){return function(e){return function(c){var g;a:{switch(c[0]){case "Form":g=c[1];var k=c[2],f=c[3];c=c[4];switch(f[0]){case "Tuple2":var d=f[1],f=f[2];g=a(g)(k)(["Tuple2",b+d,e+f])(c);break a}}throw"Non-exhaustive pattern match in case";}return g}}},isWithin:Collage.insideForm}}();-Elm.Text=function(){function d(a){return Value.toText(a)}var f=function(a){return function(b){return"<"+a+' style="padding:0;margin:0">'+b+"</"+a+">"}},b=function(a,b){return function(c){return"<span style='"+a+":"+b+"'>"+c+"</span>"}},c=function(a){a=Elm.JavaScript.castStringToJSString(a);return b("font-family",a)},h=f("h1"),a=b("font-style","italic"),f=f("b"),m=b("text-decoration","underline"),j=b("text-decoration","overline"),l=b("text-decoration","line-through");return{fromString:d,toText:d,header:h,-height:function(a){return b("font-size",a+"em")},italic:a,bold:f,underline:m,overline:j,strikeThrough:l,monospace:c("monospace"),typeface:c,color:function(a){return b("color",Elm.Color.extract(a))},link:function(a){return function(b){return"<a href='"+d(a)+"'>"+b+"</a>"}}}}();-var Render=function(){function d(a){a=document.createElement(a);a.style.padding="0";a.style.margin="0";return a}function f(a){return a}function b(a){a.style.styleFloat="left";a.style.cssFloat="left";return a}function c(a){a.style.position="absolute";return a}function h(a,b,c){for(var f=d("div"),j=c.length;j--;){var h=a(b(c[j]));f.appendChild(h)}return f}function a(a){switch(a[0]){case "Absolute":return a[1]+"px";case "Relative":return 100*a[1]+"%"}}function m(b,e){e.style.position="absolute";e.style.margin=-"auto";switch(b[0]){case "Position":"Far"!==b[1][0]&&(e.style.left=0);"Near"!==b[1][0]&&(e.style.right=0);"Far"!==b[2][0]&&(e.style.top=0);"Near"!==b[2][0]&&(e.style.bottom=0);break;case "PositionAt":e.style.top=a(b[2]);e.style.left=a(b[1]);var c="translate("+~~(-e.style.width.slice(0,-2)/2)+"px,"+~~(-e.style.height.slice(0,-2)/2)+"px)";e.style.transform=c;e.style.msTransform=c;e.style.MozTransform=c;e.style.webkitTransform=c;e.style.OTransform=c;break;default:c=b[0].slice(-2),e.style["T"===c[0]?-"top":"bottom"]=a(b[2]),e.style["L"===c[1]?"left":"right"]=a(b[1])}}function j(a){var e={};switch(a[2][0]){case "EText":var e=a[2][1],k=a[2][2],l=d("div");l.innerHTML=k;l.style.textAlign=e;e=l;break;case "EImage":e=a[2][1];k=d("img");k.src=e;k.name=e;k.style.display="block";e=k;break;case "EVideo":l=a[2][1];e=d("video");e.controls="controls";k=d("source");k.src=l;l=l.split(".");k.type="video/"+l[l.length-1];e.appendChild(k);e.style.display="block";break;case "EFittedImage":var n=a[3],p=a[4],e=a[2][1],-k=d("div");k.style.width=n+"px";k.style.height=p+"px";k.style.position="relative";k.style.overflow="hidden";var s=d("img");s.onload=function(){s.style.position="absolute";s.style.margin="auto";var a=n,b=p;n/p>this.width/this.height?b=Math.round(this.height*n/this.width):a=Math.round(this.width*p/this.height);s.style.width=a+"px";s.style.height=b+"px";s.style.left=(n-a)/2+"px";s.style.top=(p-b)/2+"px"};s.src=e;s.name=e;k.appendChild(s);e=k;break;case "EFlow":a:{e=a[2][2];switch(a[2][1][0]){case "DDown":e=-e.slice(0).reverse();case "DUp":e=h(f,j,e);break a;case "DRight":e=e.slice(0).reverse();case "DLeft":e=h(b,j,e);break a;case "DOut":e=e.slice(0).reverse();case "DIn":e=h(c,j,e);break a}e=void 0}break;case "ECollage":e=Collage.collage(a[2][1],a[2][2],a[2][3]);break;case "EEmpty":e=d("div");break;case "EContainer":k=a[2][1];e=j(a[2][2]);m(k,e);k=d("div");k.style.position="relative";k.style.overflow="hidden";k.appendChild(e);e=k;break;case "EHtml":e=a[2][1];"button"!==e.type&&(k=Value.getExcess(e),a[3]-=-k[0],a[4]-=k[1]);break;case "EExternalHtml":e=d("div"),e.appendChild(a[2][1])}e.id=a[1];e.style.width=~~a[3]+"px";e.style.height=~~a[4]+"px";1!==a[5]&&(e.style.opacity=a[5]);"Just"===a[6][0]&&(e.style.backgroundColor=Elm.Color.extract(a[6][1]));return"Just"===a[7][0]?(k=d("a"),k.href=a[7][1],k.appendChild(e),k):e}function l(a,e,k){"A"===a.tagName&&(a=a.firstChild);if(e[1]!==k[1]){if(e[2][0]!==k[2][0])return a.parentNode.replaceChild(j(k),a);var d=k[2],n=e[2];switch(d[0]){case "EText":d[1]!==n[1]&&-(a.style.textAlign=d[1]);d[2]!==n[2]&&(a.innerHTML=d[2]);break;case "EImage":d[1]!==n[1]&&(a.src=d[1]);break;case "EVideo":case "EFittedImage":if(!Value.eq(d,n)||k[3]!==e[3]||k[4]!==e[4])return a.parentNode.replaceChild(j(k),a);break;case "ECollage":if(d[1]!==n[1]||d[2]!==n[2]||d[3].length!==n[3].length)return a.parentNode.replaceChild(j(k),a);Collage.updateCollage(a,n[3],d[3]);break;case "EFlow":if(d[1]!==n[1])return a.parentNode.replaceChild(j(k),a);var h=d[2],s=a.childNodes;if(h.length!==s.length)return a.parentNode.replaceChild(j(k),-a);var n=n[2],v=function(a){return a};switch(d[1][0]){case "DDown":case "DUp":v=f;break;case "DRight":case "DLeft":v=b;break;case "DOut":case "DIn":v=c}for(d=s.length;d--;)l(s[d],n[d],h[d]),v(s[d]);break;case "EContainer":l(a.childNodes[0],n[2],d[2]);m(d[1],a.childNodes[0]);break;case "EHtml":k[1]!==e[1]&&(h=j(k),a.parentNode.replaceChild(h,a),a=h);"button"!==h.type&&(d=Value.getExcess(a),k[3]-=d[0],k[4]-=d[1]);break;case "EExternalHtml":k[1]!==e[1]&&a.parentNode.replaceChild(j(k),a)}k[3]!==e[3]&&-(a.style.width=~~k[3]+"px");k[4]!==e[4]&&(a.style.height=~~k[4]+"px");k[5]!==e[5]&&(a.style.opacity=k[5]);2===k[6].length&&(d=Elm.Color.extract(k[6][1]),d!==a.style.backgroundColor&&(a.style.backgroundColor=d));if(2===k[7].length&&(1===e[7].length||k[7][1]!==e[7][1]))a.parentNode.href=k[7][1];k[1]=e[1]}}return{render:j,update:l,addTo:function(a,b){a.appendChild(b)},newElement:d,flowWith:h,goIn:c}}();-Elm.Signal=function(){function d(a){this.id=Guid.guid();this.value=a;this.kids=[];this.defaultNumberOfKids=0;this.recv=function(a,b,e){if(b=b===this.id)this.value=e;l(this,a,b);return b};Dispatcher.inputs.push(this)}function f(a,b){this.id=Guid.guid();this.value=null;this.kids=[];this.count=0;this.changed=!1;b.reverse();this.recalc=function(){for(var c=a,d=b.length;d--;)c=c(b[d].value);this.value=c};this.recalc();this.recv=function(a,e){this.count+=1;e&&(this.changed=!0);this.count==b.length&&(this.changed&&-this.recalc(),l(this,a,this.changed),this.changed=!1,this.count=0)};for(var c=b.length;c--;)b[c].kids.push(this)}function b(a,b,c,d){this.id=Guid.guid();this.value=c?b(d.value):b;this.kids=[];this.recv=function(b,c){c&&(this.value=a(d.value)(this.value));l(this,b,c)};d.kids.push(this)}function c(a,b,c){this.id=Guid.guid();this.value=a(c.value)?b:c.value;this.kids=[];this.recv=function(b,d){var f=d&&!a(c.value);f&&(this.value=c.value);l(this,b,f)};c.kids.push(this)}function h(a){this.id=Guid.guid();-this.value=a.value;this.kids=[];this.recv=function(b,c){var d=c&&!Value.eq(this.value,a.value);d&&(this.value=a.value);l(this,b,d)};a.kids.push(this)}function a(a,b){this.id=Guid.guid();var c=(new window.Date).getTime();this.value=a?Value.Tuple(c,b.value):c;this.kids=[];this.recv=function(c,d){d&&(this.value=a?Value.Tuple(c,b.value):c);l(this,c,d)};b.kids.push(this)}function m(a,b){this.id=Guid.guid();this.value=b.value;this.kids=[];this.count=0;this.changed=!1;this.recv=function(c,d,f){f===a.id&&-(this.changed=d);this.count+=1;2==this.count&&(this.changed&&(this.value=b.value),l(this,c,this.changed),this.count=0,this.changed=!1)};a.kids.push(this);b.kids.push(this)}function j(a,b){this.id=Guid.guid();this.value=a.value;this.kids=[];this.next=null;this.count=0;this.changed=!1;this.recv=function(c,d,f){this.count+=1;d&&(this.changed=!0,f==b.id&&null===this.next&&(this.next=b.value),f==a.id&&(this.next=a.value));2==this.count&&(this.changed&&(this.value=this.next,this.next=null),l(this,c,this.changed),-this.changed=!1,this.count=0)};a.kids.push(this);b.kids.push(this)}var l=function(a,b,c){for(var d=a.kids,f=d.length;f--;)d[f].recv(b,c,a.id)},g=function(a){return function(b){return function(d){d=new f(function(a){return function(b){return[a,b]}},[a,d]);d=new c(function(a){return a[0]},[!0,b],d);return new f(function(a){return a[1]},[d])}}};return{constant:function(a){return new d(a)},lift:function(a){return function(b){return new f(a,[b])}},lift2:function(a){return function(b){return function(c){return new f(a,-[b,c])}}},lift3:function(a){return function(b){return function(c){return function(d){return new f(a,[b,c,d])}}}},lift4:function(a){return function(b){return function(c){return function(d){return function(j){return new f(a,[b,c,d,j])}}}}},lift5:function(a){return function(b){return function(c){return function(d){return function(j){return function(g){return new f(a,[b,c,d,j,g])}}}}}},lift6:function(a){return function(b){return function(c){return function(d){return function(j){return function(g){return function(h){return new f(a,-[b,c,d,j,g,h])}}}}}}},lift7:function(a){return function(b){return function(c){return function(d){return function(j){return function(g){return function(h){return function(l){return new f(a,[b,c,d,j,g,h,l])}}}}}}}},lift8:function(a){return function(b){return function(c){return function(d){return function(j){return function(g){return function(h){return function(l){return function(m){return new f(a,[b,c,d,j,g,h,l,m])}}}}}}}}},foldp:function(a){return function(c){return function(d){return new b(a,c,!1,-d)}}},foldp$:function(a){return function(c){return function(d){return new b(a,c,!0,d)}}},foldp1:function(a){return function(c){return new b(a,function(a){return a},!0,c)}},delay:function(a){return function(b){var c=new d(b.value),j=!0;b=new m(c,new f(function(a){return function(){return a}},[c,new f(function(b){j||setTimeout(function(){Dispatcher.notify(c.id,b)},a)},[b])]));j=!1;return b}},merge:function(a){return function(b){return new j(a,b)}},merges:function(a){return Elm.List.foldl1(function(a){return function(b){return new j(a,-b)}})(a)},mergeEither:function(a){return function(b){function c(a){return function(b){return[a,b]}}return new j(new f(c("Left"),[a]),new f(c("Right"),[b]))}},average:function(a){return function(b){for(var c=Array(a),d=a;d--;)c[d]=0;var d=0,j=!1,g=0;return new f(function(b){g+=b-c[d];c[d]=b;b=g/Math.max(1,j?a:d);++d==a&&(j=!0,d=0);return b},[b])}},count:function(a){return new b(function(){return function(a){return a+1}},0,!1,a)},countIf:function(a){return function(c){return new b(function(b){return function(c){return a(b)?-c+1:c}},0,!1,c)}},keepIf:function(a){return function(b){return function(d){return new c(function(b){return!a(b)},b,d)}}},dropIf:function(a){return function(b){return function(d){return new c(a,b,d)}}},keepWhen:function(a){return g(new f(function(a){return!a},[a]))},dropWhen:g,dropRepeats:function(a){return new h(a)},sampleOn:function(a){return function(b){return new m(a,b)}},timestamp:function(b){return new a(!0,b)},timeOf:function(b){return new a(!1,b)}}}();-var Dispatcher=function(){function d(b){if(!b.hasOwnProperty("defaultNumberOfKids"))return!0;var a=b.kids.length;if(0==a)return!1;if(a>b.defaultNumberOfKids)return!0;for(var c=!1;a--;)c=c||d(b.kids[a]);return c}var f=null,b=[],c=null;return{initialize:function(){f=Elm.main();f.hasOwnProperty("recv")||(f=Elm.Signal.constant(f));c=f.value;for(var h=[],a=b.length;a--;)d(b[a])&&h.push(b[a]);b=h;document.getElementById("content").appendChild(Render.render(c));h=document.getElementById("widthChecker").offsetWidth;-h!==window.innerWidth&&Dispatcher.notify(Elm.Window.dimensions.id,Value.Tuple(h,window.innerHeight));f=Elm.Signal.lift(function(a){var b=document.getElementById("content");Render.update(b.firstChild,c,a);return c=a})(f)},notify:function(c,a){for(var d=(new window.Date).getTime(),f=!1,l=b.length;l--;)f=b[l].recv(d,c,a)||f;return f},inputs:b}}();-Elm.HTTP=function(){function d(b){return function(c){return function(d){return function(e){return{"0":"Request",length:1,verb:a.castStringToJSString(b),url:a.castStringToJSString(c),data:null===d?null:a.castStringToJSString(d),headers:e}}}}}function f(a){return d("GET")(a)(null)(["Nil"])}function b(b,d){return function(f){if(""!==f.url){var e={value:["Waiting"]};b.push(e);var h=null;window.ActiveXObject&&(h=new ActiveXObject("Microsoft.XMLHTTP"));window.XMLHttpRequest&&(h=new XMLHttpRequest);h.onreadystatechange=-function(){4===h.readyState&&(e.value=200===h.status?["Success",m(h.responseText)]:["Failure",h.status,m(h.statusText)],setTimeout(function(){c(b,d)},0))};h.open(f.verb,f.url,!0);Elm.List.map(function(b){h.setRequestHeader(a.castStringToJSString(b[1]),a.castStringToJSString(b[2]))})(f.headers);h.send(f.data)}}}function c(a,b){0<a.length&&(Dispatcher.notify(b.id,a[0].value),"Waiting"!==a[0].value[0]&&(a.shift(),setTimeout(function(){c(a,b)},0)))}function h(a){var c=Elm.Signal.constant(["Waiting"]);-a=Elm.Signal.lift(b([],c))(a);return Elm.Signal.lift2(function(a){return function(){return a}})(c)(a)}var a=Elm.JavaScript,m=Elm.JavaScript.castJSStringToString;return{get:f,post:function(a){return function(b){return d("POST")(a)(b)(["Nil"])}},request:d,send:h,sendGet:function(a){return h(Elm.Signal.lift(f)(a))}}}();-Elm.Input=function(){var d=Elm.JavaScript,f=Elm.JavaScript.castJSStringToString,b=function(a,b){a.placeholder=d.castStringToJSString(b);var c=Elm.Signal.constant(["Nil"]);Value.addListener(a,"keyup",function(){Dispatcher.notify(c.id,f(a.value));a.focus()});a.style.padding="1px";return Value.Tuple(Value.wrap(a),c)},c=function(a){a=document.createElement(a);a.style.padding="0";a.style.margin="0";return a},h=function(a){for(var b=c("select"),d=[];"Cons"===a[0];){var f=c("option"),h=Value.toText(a[1][1]);-f.value=h;f.innerHTML=h;b.appendChild(f);d.push(a[1][2]);a=a[2]}var e=Elm.Signal.constant(d[0]);Value.addListener(b,"change",function(){Dispatcher.notify(e.id,d[b.selectedIndex])});return Value.Tuple(Value.wrap(b),e)};return{textArea:function(a){return function(d){var f=c("textarea");f.rows=d;f.cols=a;return b(f,"")}},textField:function(a){var d=c("input");d.type="text";return b(d,a)},password:function(a){var d=c("input");d.type="password";return b(d,a)},checkbox:function(a){var b=c("input");b.type=-"checkbox";b.checked=a;var d=Elm.Signal.constant(a);Value.addListener(b,"change",function(){Dispatcher.notify(d.id,b.checked)});return Value.Tuple(Value.wrap(b),d)},dropDown:h,stringDropDown:function(a){return h(Elm.List.map(function(a){return Value.Tuple(a,a)})(a))},button:function(a){var b=c("input");b.type="button";b.value=d.castStringToJSString(a);var f=Elm.Signal.constant(!1);Value.addListener(b,"click",function(){Dispatcher.notify(f.id,!0);Dispatcher.notify(f.id,!1)});return Value.Tuple(Value.wrap(b),-f)}}}();-Elm.Keyboard={Raw:function(){function d(b,f){return"Nil"===f[0]?f:f[1]===b?f[2]:["Cons",f[1],d(b,f[2])]}var f=Elm.Signal.constant(["Nil"]),b=Elm.Signal.constant(["Nothing"]);Value.addListener(document,"keydown",function(b){var d;a:{for(d=f.value;"Nil"!==d[0];){if(d[1]===b.keyCode){d=!0;break a}d=d[2]}d=!1}d||Dispatcher.notify(f.id,["Cons",b.keyCode,f.value])||this.removeEventListener("keydown",arguments.callee,!1)});Value.addListener(document,"keyup",function(b){var h=d(b.keyCode,f.value);Dispatcher.notify(f.id,-h)||this.removeEventListener("keyup",arguments.callee,!1)});Value.addListener(window,"blur",function(b){Dispatcher.notify(f.id,["Nil"])||this.removeEventListener("blur",arguments.callee,!1)});Value.addListener(document,"keypress",function(c){var d=Dispatcher.notify(b.id,["Just",c.charCode||c.keyCode]);Dispatcher.notify(b.id,["Nothing"]);d||this.removeEventListener("keypress",arguments.callee,!1)});return{keysDown:f,charPressed:b}}()};-(function(){function d(b){b=Elm.Signal.lift(b)(Elm.Keyboard.Raw.keysDown);Elm.Keyboard.Raw.keysDown.defaultNumberOfKids+=1;b.defaultNumberOfKids=0;return b}function f(b,f,a,m){return d(function(d){for(var l=0,g=0;"Cons"==d[0];){switch(d[1]){case b:--l;break;case f:++l;break;case a:++g;break;case m:--g}d=d[2]}return{_:[!0],x:[l],y:[g]}})}function b(b){return d(function(d){for(;"Cons"==d[0];){if(b==d[1])return!0;d=d[2]}return!1})}Elm.Keyboard.arrows=f(37,39,38,40);Elm.Keyboard.wasd=f(65,68,87,83);Elm.Keyboard.shift=-b(16);Elm.Keyboard.ctrl=b(17);Elm.Keyboard.space=b(32)})();-Elm.Mouse=function(){function d(a){var b=0,c=0;a||(a=window.event);if(a.pageX||a.pageY)b=a.pageX,c=a.pageY;else if(a.clientX||a.clientY)b=a.clientX+document.body.scrollLeft+document.documentElement.scrollLeft,c=a.clientY+document.body.scrollTop+document.documentElement.scrollTop;return Value.Tuple(b,c)}var f=Elm.Signal.constant(Value.Tuple(0,0));f.defaultNumberOfKids=2;var b=Elm.Signal.lift(function(a){return a[1]})(f);b.defaultNumberOfKids=0;var c=Elm.Signal.lift(function(a){return a[2]})(f);c.defaultNumberOfKids=-0;var h=Elm.Signal.constant(!1),a=Elm.Signal.constant(!1),m=Elm.Signal.constant(Value.Tuple());Value.addListener(document,"click",function(b){var c=Dispatcher.notify(a.id,!0),d=Dispatcher.notify(m.id,Value.Tuple());Dispatcher.notify(a.id,!1);!c&&!d&&this.removeEventListener("click",arguments.callee,!1)});Value.addListener(document,"mousedown",function(a){Dispatcher.notify(h.id,!0)||this.removeEventListener("mousedown",arguments.callee,!1)});Value.addListener(document,"mouseup",function(a){Dispatcher.notify(h.id,-!1)||this.removeEventListener("mouseup",arguments.callee,!1)});Value.addListener(document,"mousemove",function(a){Dispatcher.notify(f.id,d(a))||this.removeEventListener("mousemove",arguments.callee,!1)});return{position:f,x:b,y:c,isClicked:a,isDown:h,clicks:m,isClickedOn:function(a){a=Render.render(a);var b=Elm.Signal.constant(!1);Value.addListener(a,"click",function(){Dispatcher.notify(b.id,!0);Dispatcher.notify(b.id,!1)});return Value.Tuple(Value.wrap(a),b)}}}();-Elm.Random=function(){return{inRange:function(d){return function(f){return Elm.Signal.constant(Math.floor(Math.random()*(f-d+1))+d)}},randomize:function(d){return function(f){return function(b){return Elm.Signal.lift(function(){return Math.floor(Math.random()*(f-d+1))+d})(b)}}}}}();-Elm.Time=function(){function d(){return(new window.Date).getTime()}function f(b){return function(c){var f=1E3/b,a=d(),m=a,j=0,l=!0,g=Elm.Signal.constant(j),e=0;return Elm.Signal.lift2(function(b){return function(c){if(b){var n=!l&&b;e=setTimeout(function(){m=d();j=n?0:m-a;a=m;Dispatcher.notify(g.id,j)},f)}else l&&clearTimeout(e);l=b;return c}})(c)(g)}}Elm.Signal.constant(!0);return{fpsWhen:f,fps:function(b){return f(b)(Elm.Signal.constant(!0))},every:function(b){var c=Elm.Signal.constant(d());setInterval(function(){Dispatcher.notify(c.id,-d())},b);return c},delay:Elm.Signal.delay,since:function(b){return function(c){var d=Elm.Signal.count(Elm.Signal.delay(b)(c));return Elm.Signal.lift2(function(a){return function(b){return!Value.eq(a,b)}})(Elm.Signal.count(c))(d)}},after:function(b){b*=1E3;var c=Elm.Signal.constant(!1);setTimeout(function(){Dispatcher.notify(c.id,!0)},b);return c},before:function(b){b*=1E3;var c=Elm.Signal.constant(!0);setTimeout(function(){Dispatcher.notify(c.id,!1)},b);return c},hour:36E5,minute:6E4,second:1E3,ms:1,-inHours:function(b){return b/36E5},inMinutes:function(b){return b/6E4},inSeconds:function(b){return b/1E3},inMss:function(b){return b},toDate:function(b){return new window.Date(b)},read:function(b){b=window.Date.parse(b);return isNaN(b)?["Nothing"]:["Just",b]}}}();-Elm.Window=function(){var d=Elm.Signal.constant(Value.Tuple(window.innerWidth,window.innerHeight));d.defaultNumberOfKids=2;var f=Elm.Signal.lift(function(b){return b[1]})(d);f.defaultNumberOfKids=0;var b=Elm.Signal.lift(function(b){return b[2]})(d);b.defaultNumberOfKids=0;Value.addListener(window,"resize",function(b){var f=document.getElementById("widthChecker").offsetWidth;Dispatcher.notify(d.id,Value.Tuple(f,window.innerHeight))||this.removeEventListener("resize",arguments.callee,!1)});return{dimensions:d,-width:f,height:b}}();-Elm.Date=function(){var d="Sun Mon Tue Wed Thu Fri Sat".split(" "),f="Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec".split(" ");return{read:function(b){b=new window.Date(Elm.JavaScript.castStringToJSString(b));return isNaN(b.getTime())?["Nothing"]:["Just",b]},year:function(b){return b.getFullYear()},month:function(b){return[f[b.getMonth()]]},day:function(b){return b.getDate()},hour:function(b){return b.getHours()},minute:function(b){return b.getMinutes()},second:function(b){return b.getSeconds()},dayOfWeek:function(b){return[d[b.getDay()]]},-toTime:function(b){return b.getTime()},Mon:["Mon"],Tue:["Tue"],Wed:["Wed"],Thu:["Thu"],Fri:["Fri"],Sat:["Sat"],Sun:["Sun"],Jan:["Jan"],Feb:["Feb"],Mar:["Mar"],Apr:["Apr"],May:["May"],Jun:["Jun"],Jul:["Jul"],Aug:["Aug"],Sep:["Sep"],Oct:["Oct"],Nov:["Nov"],Dec:["Dec"]}}();Value.addListener(document,"elm_log",function(d){console.log(d.value)});Value.addListener(document,"elm_title",function(d){document.title=d.value});-Value.addListener(document,"elm_redirect",function(d){0<d.value.length&&(window.location=d.value)});Value.addListener(document,"elm_viewport",function(d){var f=document.getElementById("elm_viewport");f||(f=document.createElement("meta"),f.id="elm_viewport",f.name="viewport",document.head.appendChild(f));f.content=d.value;Dispatcher.notify(Elm.Window.dimensions.id,Value.Tuple(window.innerWidth,window.innerHeight))});-Elm.Prelude=function(){function d(b){return function(c){if(b instanceof Array&&c instanceof Array){var f=b.length;if(f==c.length){for(var a=1;a<f;++a){var m=d(b[a])(c[a]);if("EQ"!==m[0])return m}return["EQ"]}return[1==c.length?"GT":"LT"]}return[b===c?"EQ":b<c?"LT":"GT"]}}var f=function(b){return function(c){var d=b%c,d=0==b?0:0<c?0<=b?d:d+c:-f(-b)(-c);return d==c?0:d}};return{eq:Value.eq,id:function(b){return b},not:function(b){return!b},xor:function(b){return function(c){return b!=c}},fst:function(b){return b[1]},-snd:function(b){return b[2]},rem:function(b){return function(c){return b%c}},div:function(b){return function(c){return~~(b/c)}},otherwise:!0,compare:d,toFloat:function(b){return b},round:function(b){return Math.round(b)},floor:function(b){return Math.floor(b)},ceiling:function(b){return Math.ceil(b)},truncate:function(b){return~~b},readInt:function(b){b=Elm.JavaScript.castStringToJSString(b);var c=b.length;if(0===c)return["Nothing"];var d=0;if("-"==b[0]){if(1===c)return["Nothing"];d=1}for(;d<c;++d)if(!Elm.Char.isDigit(b[d]))return["Nothing"];-return["Just",parseInt(b)]},readFloat:function(b){b=Elm.JavaScript.castStringToJSString(b);var c=b.length;if(0===c)return["Nothing"];var d=0;if("-"==b[0]){if(1===c)return["Nothing"];d=1}for(var a=0;d<c;++d)if(!Elm.Char.isDigit(b[d])){if("."===b[d]&&(a+=1,1>=a))continue;return["Nothing"]}return["Just",parseFloat(b)]},sqrt:Math.sqrt,abs:Math.abs,pi:Math.PI,e:Math.E,sin:Math.sin,cos:Math.cos,tan:Math.tan,asin:Math.asin,acos:Math.acos,atan:Math.atan,atan2:function(b){return function(c){return Math.atan2(b,-c)}},mod:f,min:function(b){return function(c){return Math.min(b,c)}},max:function(b){return function(c){return Math.max(b,c)}},flip:function(b){return function(c){return function(d){return b(d)(c)}}},clamp:function(b){return function(c){return function(d){return Math.min(c,Math.max(b,d))}}},curry:function(b){return function(c){return function(d){return b(["Tuple2",c,d])}}},uncurry:function(b){return function(c){if("Tuple2"!==c[0])throw"Function was uncurry'd but was not given a pair.";return b(c[1])(c[2])}},-logBase:function(b){return function(c){return Math.log(c)/Math.log(b)}},Just:Elm.Maybe.Just,Nothing:Elm.Maybe.Nothing,maybe:Elm.Maybe.maybe,map:Elm.List.map,zip:Elm.List.zip,zipWith:Elm.List.zipWith,filter:Elm.List.filter,head:Elm.List.head,tail:Elm.List.tail,last:Elm.List.last,length:Elm.List.length,reverse:Elm.List.reverse,foldr:Elm.List.foldr,foldr1:Elm.List.foldr1,foldl:Elm.List.foldl,foldl1:Elm.List.foldl1,and:Elm.List.and,or:Elm.List.or,all:Elm.List.all,any:Elm.List.any,sum:Elm.List.sum,product:Elm.List.product,-concat:Elm.List.concat,concatMap:Elm.List.concatMap,maximum:Elm.List.maximum,minimum:Elm.List.minimum,scanl:Elm.List.scanl,scanl1:Elm.List.scanl1,take:Elm.List.take,drop:Elm.List.drop,zip:Elm.List.zip,unzip:Elm.List.unzip,lift:Elm.Signal.lift,lift2:Elm.Signal.lift2,lift3:Elm.Signal.lift3,lift4:Elm.Signal.lift4,lift5:Elm.Signal.lift5,lift6:Elm.Signal.lift6,lift7:Elm.Signal.lift7,lift8:Elm.Signal.lift8,foldp:Elm.Signal.foldp,foldp1:Elm.Signal.foldp1,foldp$:Elm.Signal.foldp$,constant:Elm.Signal.constant,-merge:Elm.Signal.merge,merges:Elm.Signal.merges,mergeEither:Elm.Signal.mergeEither,count:Elm.Signal.count,countIf:Elm.Signal.countIf,average:Elm.Signal.average,keepIf:Elm.Signal.keepIf,dropIf:Elm.Signal.dropIf,keepWhen:Elm.Signal.keepWhen,dropWhen:Elm.Signal.dropWhen,dropRepeats:Elm.Signal.dropRepeats,sampleOn:Elm.Signal.sampleOn,timestamp:Elm.Signal.timestamp,timeOf:Elm.Signal.timeOf}}();-(function(){var d=function(d){for(var b in d)Elm.Prelude[b]=d[b]};d(Elm.Color);d(Elm.Text);d(Elm.Graphics);d(Elm.Time);show=Value.show})();-Elm.Touch=function(){function d(b){b=j.remove(b.identifier);Date.now()-b.t<h&&(a=!0,m={_:[!0],x:[b.x],y:[b.y]})}function f(a,b){function d(f){for(var g=f.changedTouches.length;g--;)b(f.changedTouches[g]);for(var h=Array(f.touches.length),g=f.touches.length;g--;){var l=h,m=g,r=f.touches[g],q=j.lookup(r.identifier);l[m]={_:[!0],id:[r.identifier],x:[r.pageX],y:[r.pageY],x0:[q.x],y0:[q.y],t0:[q.t]}}if(!Dispatcher.notify(c.id,h))return document.removeEventListener(a,d);f.preventDefault()}Value.addListener(document,-a,d)}function b(a){a=Elm.Signal.lift(a)(c);c.defaultNumberOfKids+=1;a.defaultNumberOfKids=0;return a}var c=Elm.Signal.constant([]),h=500,a=!1,m={_:[!0],x:[0],y:[0]},j=new function(){this.keys=[];this.values=[];this.insert=function(a,b){this.keys.push(a);this.values.push(b)};this.lookup=function(a){a=this.keys.indexOf(a);return 0<=a?this.values[a]:{x:0,y:0,t:0}};this.remove=function(a){a=this.keys.indexOf(a);if(!(0>a)){var b=this.values[a];this.keys.splice(a,1);this.values.splice(a,1);return b}}};-f("touchstart",function(a){j.insert(a.identifier,{x:a.pageX,y:a.pageY,t:Date.now()})});f("touchmove",function(){});f("touchend",d);f("touchcancel",d);f("touchleave",d);var l=b(function(a){return Elm.JavaScript.castJSArrayToList(a)}),g=b(function(){return m});g.defaultNumberOfKids=1;g=Elm.Signal.keepIf(function(){var b=a;a=!1;return b})({_:[!0],x:[0],y:[0]})(g);g.defaultNumberOfKids=0;return{touches:l,taps:g}}();-Elm.Dict=function(){function d(a){return function(b){return function(c){return function(d){return function(e){return["RBNode",a,b,c,d,e]}}}}}function f(a){a:{switch(a[0]){case "RBEmpty":throw"(min RBEmpty) is not defined";case "RBNode":switch(a[4][0]){case "RBEmpty":a=["Tuple2",a[2],a[3]];break a}a=f(a[4]);break a}throw"Non-exhaustive pattern match in case";}return a}function b(a){return function(c){var d;a:{switch(c[0]){case "RBEmpty":d=w;break a;case "RBNode":d=function(){switch(q(a)(c[2])[0]){case "EQ":return z(c[3]);-case "GT":return b(a)(c[5]);case "LT":return b(a)(c[4])}throw"Non-exhaustive pattern match in case";}();break a}throw"Non-exhaustive pattern match in case";}return d}}function c(a){return function(b){return function(d){var e;a:{switch(d[0]){case "RBEmpty":e=a;break a;case "RBNode":e=function(){switch(q(b)(d[2])[0]){case "EQ":return d[3];case "GT":return c(a)(b)(d[5]);case "LT":return c(a)(b)(d[4])}throw"Non-exhaustive pattern match in case";}();break a}throw"Non-exhaustive pattern match in case";-}return e}}}function h(a){return function(c){return F(b(a)(c))}}function a(a){a:{switch(a[0]){case "RBNode":switch(a[5][0]){case "RBNode":a=d(a[1])(a[5][2])(a[5][3])(d(B)(a[2])(a[3])(a[4])(a[5][4]))(a[5][5]);break a}}throw"rotateLeft of a node without enough children";}return a}function m(a){a:{switch(a[0]){case "RBNode":switch(a[4][0]){case "RBNode":a=d(a[1])(a[4][2])(a[4][3])(a[4][4])(d(B)(a[2])(a[3])(a[4][5])(a[5]));break a}}throw"rotateRight of a node without enough children";}return a}function j(a){a:{switch(a[0]){case "Black":a=-B;break a;case "Red":a=E;break a}throw"Non-exhaustive pattern match in case";}return a}function l(a){a:{switch(a[0]){case "RBNode":switch(a[4][0]){case "RBNode":switch(a[5][0]){case "RBNode":a=d(j(a[1]))(a[2])(a[3])(d(j(a[4][1]))(a[4][2])(a[4][3])(a[4][4])(a[4][5]))(d(j(a[5][1]))(a[5][2])(a[5][3])(a[5][4])(a[5][5]));break a}}}throw"color_flip called on a RBEmpty or RBNode with a RBEmpty child";}return a}function g(b){a:switch(b[0]){case "RBNode":switch(b[5][0]){case "RBNode":switch(b[5][1][0]){case "Red":b=-a(b);break a}}}a:switch(b[0]){case "RBNode":switch(b[4][0]){case "RBNode":switch(b[4][1][0]){case "Red":switch(b[4][4][0]){case "RBNode":switch(b[4][4][1][0]){case "Red":b=m(b);break a}}}}}a:switch(b[0]){case "RBNode":switch(b[4][0]){case "RBNode":switch(b[4][1][0]){case "Red":switch(b[5][0]){case "RBNode":switch(b[5][1][0]){case "Red":b=l(b);break a}}}}}return b}function e(a){a:switch(a[0]){case "RBNode":switch(a[1][0]){case "Red":a=d(E)(a[2])(a[3])(a[4])(a[5]);break a}}return a}function k(a){return function(b){return function(c){var f=-function(c){var e;a:{switch(c[0]){case "RBEmpty":e=d(B)(a)(b)(A)(A);break a;case "RBNode":e=function(){switch(q(a)(c[2])[0]){case "EQ":return d(c[1])(c[2])(b)(c[4])(c[5]);case "GT":return d(c[1])(c[2])(c[3])(c[4])(f(c[5]));case "LT":return d(c[1])(c[2])(c[3])(f(c[4]))(c[5])}throw"Non-exhaustive pattern match in case";}();e=g(e);break a}throw"Non-exhaustive pattern match in case";}return e};return e(f(c))}}}function x(a){a:{switch(a[0]){case "RBNode":switch(a[4][0]){case "RBNode":switch(a[4][1][0]){case "Red":a=-!0;break a}}}a=!1}return a}function n(a){a:{switch(a[0]){case "RBNode":switch(a[4][0]){case "RBNode":switch(a[4][4][0]){case "RBNode":switch(a[4][4][1][0]){case "Red":a=!0;break a}}}}a=!1}return a}function p(b){if(y(x(b))&&y(n(b))){b=l(b);a:switch(b[0]){case "RBNode":b:switch(b[5][0]){case "RBNode":switch(b[5][4][0]){case "RBNode":switch(b[5][4][1][0]){case "Red":b=l(a(d(b[1])(b[2])(b[3])(b[4])(m(b[5]))));break b}}}break a}}return b}function s(a){return function(b){var c=function(b){a:{switch(b[0]){case "RBEmpty":b=-A;break a;case "RBNode":if("LT"===q(a)(b[2])[0])b:{b=p(b);switch(b[0]){case "RBEmpty":throw"delLT on RBEmpty";case "RBNode":b=g(d(b[1])(b[2])(b[3])(c(b[4]))(b[5]));break b}break}else{var h=x(b)?m(b):b,j;b:{switch(h[0]){case "RBNode":switch(h[5][0]){case "RBEmpty":j=D(a,h[2]);break b}}j=!1}if(j)b=h[4];else{h=y;b:{switch(b[0]){case "RBNode":switch(b[5][0]){case "RBNode":switch(b[5][1][0]){case "Red":j=!0;break b}}}j=!1}if(h=h(j)){h=y;b:{switch(b[0]){case "RBNode":switch(b[5][0]){case "RBNode":switch(b[5][4][0]){case "RBNode":switch(b[5][4][1][0]){case "Red":j=-!0;break b}}}}j=!1}h=h(j)}h&&(b=l(b),b=n(b)?l(m(b)):b);b:{switch(b[0]){case "RBNode":h=D(a,b[2]);break b}h=!1}if(h)b:{switch(b[0]){case "RBEmpty":throw"delEQ called on a RBEmpty";case "RBNode":j=f(b[5]);c:{switch(j[0]){case "Tuple2":h=j[1];break c}break}c:{switch(j[0]){case "Tuple2":j=j[2];break c}break}var h=d(b[1])(h)(j)(b[4]),k=function(a){a:{switch(a[0]){case "RBNode":switch(a[4][0]){case "RBEmpty":a=A;break a}}b:{a=p(a);switch(a[0]){case "RBEmpty":a=A;break b;case "RBNode":a=g(d(a[1])(a[2])(a[3])(k(a[4]))(a[5]));-break b}throw"Non-exhaustive pattern match in case";}}return a};b=e(k(b[5]));b=g(h(b));break b}break}else b:{switch(b[0]){case "RBEmpty":throw"delGT called on a RBEmpty";case "RBNode":b=g(d(b[1])(b[2])(b[3])(b[4])(c(b[5])));break b}break}}}break a}throw"Non-exhaustive pattern match in case";}return b};return h(a)(b)?e(c(b)):b}}function v(a){return function(b){a:{switch(b[0]){case "RBEmpty":b=A;break a;case "RBNode":b=d(b[1])(b[2])(a(b[3]))(v(a)(b[4]))(v(a)(b[5]));break a}throw"Non-exhaustive pattern match in case";-}return b}}function t(a){return function(b){return function(c){a:{switch(c[0]){case "RBEmpty":c=b;break a;case "RBNode":c=t(a)(a(c[2])(c[3])(t(a)(b)(c[4])))(c[5]);break a}throw"Non-exhaustive pattern match in case";}return c}}}function r(a){return function(b){return function(c){a:{switch(c[0]){case "RBEmpty":c=b;break a;case "RBNode":c=r(a)(a(c[2])(c[3])(r(a)(b)(c[5])))(c[4]);break a}throw"Non-exhaustive pattern match in case";}return c}}}var q=Elm.Prelude.compare,u=Elm.Prelude.uncurry,w=Elm.Prelude.Nothing,-z=Elm.Prelude.Just,y=Elm.Prelude.not,D=Elm.Prelude.eq,F=Elm.Maybe.isJust,B=["Red"],E=["Black"],A=["RBEmpty"],C=A;return{$op:{},empty:C,lookup:b,findWithDefault:c,member:h,insert:k,singleton:function(a){return function(b){return k(a)(b)(A)}},remove:s,map:v,foldl:t,foldr:r,union:function(a){return function(b){return t(k)(b)(a)}},intersect:function(a){return function(b){return t(function(a){return function(c){return function(d){return h(a)(b)?k(a)(c)(d):d}}})(C)(a)}},diff:function(a){return function(b){return t(function(a){return function(){return function(b){return s(a)(b)}}})(a)(b)}},-keys:function(a){return r(function(a){return function(){return function(b){return["Cons",a,b]}}})(["Nil"])(a)},values:function(a){return r(function(){return function(a){return function(b){return["Cons",a,b]}}})(["Nil"])(a)},toList:function(a){return r(function(a){return function(b){return function(c){return["Cons",["Tuple2",a,b],c]}}})(["Nil"])(a)},fromList:function(a){return Elm.List.foldl(u(k))(C)(a)}}}();-Elm.Set=function(){var d=Elm.Dict.empty,f=Elm.Dict.remove,b=Elm.Dict.member,c=Elm.Dict.union,h=Elm.Dict.intersect,a=Elm.Dict.diff,m=Elm.Dict.keys,j=Elm.List.foldl(function(a){return function(b){return Elm.Dict.insert(a)(["Tuple0"])(b)}})(d);return{empty:d,singleton:function(a){return Elm.Dict.singleton(a)(["Tuple0"])},insert:function(a){return Elm.Dict.insert(a)(["Tuple0"])},remove:f,member:b,union:c,intersect:h,diff:a,toList:m,fromList:j,foldl:function(a){return Elm.Dict.foldl(function(b){return function(){return function(c){return a(b)(c)}}})},-foldr:function(a){return Elm.Dict.foldr(function(b){return function(){return function(c){return a(b)(c)}}})},map:function(a){return function(b){b=m(b);return j(Elm.List.map(a)(b))}}}}();-(function(){try{var d={};for(this.i in Elm)eval("var "+this.i+"=Elm[this.i];");if(Elm.Automaton)throw"Module name collision, 'Automaton' is already defined.";Elm.Automaton=function(){function b(a){return["Automaton",a]}function c(a){return b(function(b){var d=unzip(map(function(a){a:{switch(a[0]){case "Automaton":a=a[1](b);break a}throw"Non-exhaustive pattern match in case";}return a})(a)),e;a:{switch(d[0]){case "Tuple2":e=d[1];break a}throw"Non-exhaustive pattern match in case";}a:{switch(d[0]){case "Tuple2":d=-d[2];break a}throw"Non-exhaustive pattern match in case";}return["Tuple2",e,c(d)]})}function f(a){return b(function(b){return["Tuple2",a(b),f(a)]})}function a(c){return function(d){return b(function(b){b=d(b)(c);return["Tuple2",b,a(b)(d)]})}}function m(a){return function(c){return b(function(b){var d=c(b)(a);a:{switch(d[0]){case "Tuple2":b=d[1];break a}throw"Non-exhaustive pattern match in case";}a:{switch(d[0]){case "Tuple2":d=d[2];break a}throw"Non-exhaustive pattern match in case";}return["Tuple2",-b,m(d)(c)]})}}function j(a){return function(b){a:{switch(a[0]){case "Tuple2":b:{switch(b[0]){case "Tuple2":b=["Tuple2",a[1]-b[1],a[2]-b[2]];break b}break}break a}throw"Non-exhaustive pattern match in case";}return b}}function l(a){return function(b){var c;a:{switch(a[0]){case "Tuple2":b:{switch(b[0]){case "Tuple2":var d=function(a){return["Tuple2",b[2],["Tuple2",a,b[2]]]};c=function(){switch(b[1][0]){case "DragFrom":var c;a[1]?c=["Tuple2",uncurry(move)(j(a[2])(b[1][1]))(b[2]),["Tuple2",["DragFrom",-b[1][1]],b[2]]]:(c=uncurry(move)(j(a[2])(b[1][1]))(b[2]),c=["Tuple2",c,["Tuple2",k,c]]);return c;case "Ignore":return d(a[1]?x:k);case "Listen":return d(not(a[1])?k:isWithin(a[2])(b[2])?["DragFrom",a[2]]:x)}throw"Non-exhaustive pattern match in case";}();break b}break}break a}throw"Non-exhaustive pattern match in case";}return c}}try{if(!(Elm.Prelude instanceof Object))throw"module not found";}catch(g){throw"Module 'Prelude' is missing. Compile with --make flag or load missing module in a separate JavaScript file.";-}var e={};for(this.i in Elm.Prelude)e[this.i]||eval("var "+this.i+" = Elm.Prelude[this.i];");var k=["Listen"],x=["Ignore"];d[">>>"]=function(a){return function(c){var e;a:{switch(a[0]){case "Automaton":e=a[1];break a}throw"Non-exhaustive pattern match in case";}var f;a:{switch(c[0]){case "Automaton":f=c[1];break a}throw"Non-exhaustive pattern match in case";}return b(function(a){a=e(a);var b;a:{switch(a[0]){case "Tuple2":b=a[1];break a}throw"Non-exhaustive pattern match in case";}a:{switch(a[0]){case "Tuple2":a=-a[2];break a}throw"Non-exhaustive pattern match in case";}var c=f(b);a:{switch(c[0]){case "Tuple2":b=c[1];break a}throw"Non-exhaustive pattern match in case";}a:{switch(c[0]){case "Tuple2":c=c[2];break a}throw"Non-exhaustive pattern match in case";}return["Tuple2",b,d[">>>"](a)(c)]})}};d["<<<"]=function(a){return function(b){return d[">>>"](b)(a)}};d["^>>"]=function(a){return function(b){return d[">>>"](f(a))(b)}};d[">>^"]=function(a){return function(b){return d[">>>"](a)(f(b))}};d["^<<"]=function(a){return function(b){return d[">>>"](b)(f(a))}};-d["<<^"]=function(a){return function(b){return d[">>>"](f(b))(a)}};e=a(0)(function(){return function(a){return 1+a}});return{$op:{">>>":d[">>>"],"<<<":d["<<<"],"^>>":d["^>>"],">>^":d[">>^"],"^<<":d["^<<"],"<<^":d["<<^"]},run:function(a){return function(b){a:{switch(a[0]){case "Automaton":b=lift(fst)(foldp$(function(a){return function(b){a:{switch(b[0]){case "Tuple2":switch(b[2][0]){case "Automaton":b=b[2][1](a);break a}}throw"Non-exhaustive pattern match in case";}return b}})(a[1])(b));break a}throw"Non-exhaustive pattern match in case";-}return b}},step:function(a){return function(b){a:{switch(a[0]){case "Automaton":b=a[1](b);break a}throw"Non-exhaustive pattern match in case";}return b}},combine:c,pure:f,init:a,init$:m,count:e,draggable:function(a){return m(["Tuple2",k,a])(l)}}}();Elm.main=function(){return Elm.Automaton.main}}catch(f){Elm.main=function(){document.body.innerHTML=Elm.Text.monospace('<br/><h2>Your browser may not be supported. Are you using a modern browser?</h2><br/><span style="color:grey">Runtime Error in Automaton module:<br/>'+-f+"</span>");throw f;}}})();
+ elm-runtime.js view
@@ -0,0 +1,5076 @@+Elm = {}; Elm.Native = {}; Elm.Native.Graphics = {}; +Elm.Graphics = {}; ElmRuntime = {}; ElmRuntime.Render = {} + +Elm.Native.Utils = function(elm) { + 'use strict'; + + elm.Native = elm.Native || {}; + if (elm.Native.Utils) return elm.Native.Utils; + + function eq(x,y) { + if (x === y) return true; + if (typeof x === "object") { + var c = 0; + for (var i in x) { ++c; if (!eq(x[i],y[i])) return false; } + return c === Object.keys(y).length; + } + if (typeof x === 'function') { + throw new Error('Equality error: general function equality is ' + + 'undecidable, and therefore, unsupported'); + } + return x === y; + } + + var EQ = 0, LT = 1, GT = 2, ord = ['EQ','LT','GT']; + function compare(x,y) { return { ctor: ord[cmp(x,y)] } } + function cmp(x,y) { + var ord; + if (typeof x !== 'object') return x === y ? EQ : x < y ? LT : GT; + + if (x.ctor === "Cons" || x.ctor === "Nil") { + while (true) { + if (x.ctor === "Nil" && y.ctor === "Nil") return EQ; + if (x.ctor !== y.ctor) return x.ctor === 'Nil' ? LT : GT; + ord = cmp(x._0, y._0); + if (ord !== EQ) return ord; + x = x._1; + y = y._1; + } + } + + if (x.ctor.slice(0,5) === 'Tuple') { + var n = x.ctor.slice(5) - 0; + var err = 'cannot compare tuples with more than 6 elements.'; + if (n === 0) return EQ; + if (n >= 1) { ord = cmp(x._0, y._0); if (ord !== EQ) return ord; + if (n >= 2) { ord = cmp(x._1, y._1); if (ord !== EQ) return ord; + if (n >= 3) { ord = cmp(x._2, y._2); if (ord !== EQ) return ord; + if (n >= 4) { ord = cmp(x._3, y._3); if (ord !== EQ) return ord; + if (n >= 5) { ord = cmp(x._4, y._4); if (ord !== EQ) return ord; + if (n >= 6) { ord = cmp(x._5, y._5); if (ord !== EQ) return ord; + if (n >= 7) throw new Error('Comparison error: ' + err); } } } } } } + return EQ; + } + throw new Error('Comparison error: comparison is only defined on ints, ' + + 'floats, times, chars, strings, lists of comparable values, ' + + 'and tuples of comparable values.') + } + + + var Tuple0 = { ctor: "Tuple0" }; + function Tuple2(x,y) { return { ctor:"Tuple2", _0:x, _1:y } } + + var count = 0; + function guid(_) { return count++ } + + function copy(r) { + var o = {}; + for (var i in r) { o[i] = r[i]; } + return o; + } + + function remove(x,r) { + var o = copy(r); + if (x in o._) { + o[x] = o._[x][0]; + o._[x] = o._[x].slice(1); + if (o._[x].length === 0) { delete o._[x]; } + } else { + delete o[x]; + } + return o; + } + + function replace(kvs,r) { + var o = copy(r); + for (var i = kvs.length; i--; ) { + var kvsi = kvs[i]; + o[kvsi[0]] = kvsi[1]; + } + return o; + } + + function insert(x,v,r) { + var o = copy(r); + if (x in o) o._[x] = [o[x]].concat(x in o._ ? o._[x].slice(0) : []); + o[x] = v; + return o; + } + + function max(a,b) { return a > b ? a : b } + function min(a,b) { return a < b ? a : b } + + function mod(a,b) { + var r = a % b; + var m = a === 0 ? 0 : (b > 0 ? (a >= 0 ? r : r+b) : -mod(-a,-b)); + + return m === b ? 0 : m; + } + + function htmlHeight(width, html) { + var t = document.createElement('div'); + t.innerHTML = html; + if (width > 0) { t.style.width = width + "px"; } + t.style.visibility = "hidden"; + t.style.styleFloat = "left"; + t.style.cssFloat = "left"; + + elm.node.appendChild(t); + var w = t.clientWidth; + var h = t.clientHeight; + elm.node.removeChild(t); + return Tuple2(w,h); + } + + function adjustOffset() { + var node = elm.node; + var offsetX = 0, offsetY = 0; + if (node.offsetParent) { + do { + offsetX += node.offsetLeft; + offsetY += node.offsetTop; + } while (node = node.offsetParent); + } + elm.node.offsetX = offsetX; + elm.node.offsetY = offsetY; + } + + if (elm.display === ElmRuntime.Display.COMPONENT) { + elm.node.addEventListener('mouseover', adjustOffset); + } + + return elm.Native.Utils = { + eq:eq, + cmp:compare, + compare:F2(compare), + Tuple0:Tuple0, + Tuple2:Tuple2, + copy: copy, + remove: remove, + replace: replace, + insert: insert, + guid: guid, + max : F2(max), + min : F2(min), + mod : F2(mod), + htmlHeight: F2(htmlHeight), + toFloat: function(x){return x} + }; +}; + +Elm.Native.Text = function(elm) { + 'use strict'; + + elm.Native = elm.Native || {}; + if (elm.Native.Text) return elm.Native.Text; + + var JS = Elm.JavaScript(elm); + var htmlHeight = Elm.Native.Utils(elm).htmlHeight; + var Color = Elm.Native.Color(elm); + var Element = Elm.Graphics.Element(elm); + var show = Elm.Native.Show(elm).show; + + function makeSpaces(s) { + if (s.length == 0) { return s; } + var arr = s.split(''); + if (arr[0] == ' ') { arr[0] = " " } + for (var i = arr.length; --i; ) { + if (arr[i][0] == ' ' && arr[i-1] == ' ') { + arr[i-1] = arr[i-1] + arr[i]; + arr[i] = ''; + } + } + for (var i = arr.length; i--; ) { + if (arr[i].length > 1 && arr[i][0] == ' ') { + var spaces = arr[i].split(''); + for (var j = spaces.length - 2; j >= 0; j -= 2) { + spaces[j] = ' '; + } + arr[i] = spaces.join(''); + } + } + arr = arr.join(''); + if (arr[arr.length-1] === " ") { + return arr.slice(0,-1) + ' '; + } + return arr; + } + + function properEscape(str) { + if (str.length == 0) return str; + str = str //.replace(/&/g, "&") + .replace(/"/g, /*"*/ '"') + .replace(/'/g, /*'*/ "'") + .replace(/</g, "<") + .replace(/>/g, ">") + .replace(/\n/g, "<br/>"); + var arr = str.split('<br/>'); + for (var i = arr.length; i--; ) { + arr[i] = makeSpaces(arr[i]); + } + return arr.join('<br/>'); + } + + function toText(str) { return properEscape(JS.fromString(str)); } + + function addTag(tag) { return function(text) { + return '<' + tag + ' style="padding:0;margin:0">' + text + '</' + tag + '>'; + } + } + + function addStyle(style, value, text) { + return "<span style='" + style + ":" + value + "'>" + text + "</span>"; + } + + function typeface(name, text) { + return addStyle('font-family', JS.fromString(name), text); + } + function monospace(text) { + return addStyle('font-family', 'monospace', text); + } + function size(px, text) { return addStyle('font-size', px + 'px', text) } + var header = addTag('h1'); + function height(h, text) { return addStyle('font-size', h+'em', text) } + function italic(text) { return addStyle('font-style', 'italic', text) } + var bold = addTag('b'); + + function extract(c) { + if (c._3 === 1) { return 'rgb(' + c._0 + ',' + c._1 + ',' + c._2 + ')'; } + return 'rgba(' + c._0 + ',' + c._1 + ',' + c._2 + ',' + c._3 + ')'; + } + function color(c, text) { + return addStyle('color', extract(c), text); + } + function underline(text) { return addStyle('text-decoration', 'underline', text) } + function overline(text) { return addStyle('text-decoration', 'overline', text) } + function strikeThrough(text) { + return addStyle('text-decoration', 'line-through', text); + } + function link(href, text) { + return "<a href='" + toText(href) + "'>" + text + "</a>"; + } + + function position(pos) { return function(text) { + var e = {ctor:'RawHtml', + _0: '<div style="padding:0;margin:0;text-align:' + + pos + '">' + text + '</div>' + }; + var p = A2(htmlHeight, 0, text); + return A3(Element.newElement, p._0, p._1, e); + } + } + + function asText(v) { + return position('left')(monospace(toText(show(v)))); + } + + function plainText(v) { + return position('left')(toText(v)); + } + + return elm.Native.Text = { + toText: toText, + + header : header, + height : F2(height), + italic : italic, + bold : bold, + underline : underline, + overline : overline, + strikeThrough : strikeThrough, + monospace : monospace, + typeface : F2(typeface), + color : F2(color), + link : F2(link), + + justified : position('justify'), + centered : position('center'), + righted : position('right'), + text : position('left'), + plainText : plainText, + + asText : asText + }; + +}; +Elm.Native.Show = function(elm) { + 'use strict'; + + elm.Native = elm.Native || {}; + if (elm.Native.Show) return elm.Native.Show; + + var NList = Elm.Native.List(elm); + var List = Elm.List(elm); + var Maybe = Elm.Maybe(elm); + var JS = Elm.JavaScript(elm); + var Dict = Elm.Dict(elm); + var Json = Elm.Json(elm); + var Tuple2 = Elm.Native.Utils(elm).Tuple2; + + var toString = function(v) { + if (typeof v === "function") { + var name = v.func ? v.func.name : v.name; + return '<function' + (name === '' ? '' : ': ') + name + '>'; + } else if (typeof v === "boolean") { + return v ? "True" : "False"; + } else if (typeof v === "number") { + return v+""; + } else if (typeof v === "string" && v.length < 2) { + return "'" + showChar(v) + "'"; + } else if (typeof v === "object" && '_' in v) { + var output = []; + for (var k in v._) { + for (var i = v._[k].length; i--; ) { + output.push(k + " = " + toString(v._[k][i])); + } + } + for (var k in v) { + if (k === '_') continue; + output.push(k + " = " + toString(v[k])); + } + if (output.length === 0) return "{}"; + return "{ " + output.join(", ") + " }"; + } else if (typeof v === "object" && 'ctor' in v) { + if (v.ctor.substring(0,5) === "Tuple") { + var output = []; + for (var k in v) { + if (k === 'ctor') continue; + output.push(toString(v[k])); + } + return "(" + output.join(",") + ")"; + } else if (v.ctor === "Cons") { + var isStr = typeof v._0 === "string", + start = isStr ? '"' : "[", + end = isStr ? '"' : "]", + sep = isStr ? "" : ",", + f = !isStr ? toString : showChar; + var output = start + f(v._0); + v = v._1; + while (v.ctor === "Cons") { + output += sep + f(v._0); + v = v._1; + } + return output + end; + } else if (v.ctor === "Nil") { + return "[]"; + } else if (v.ctor === "RBNode" || v.ctor === "RBEmpty") { + var cons = F3(function(k,v,acc){return NList.Cons(Tuple2(k,v),acc)}); + var list = A3(Dict.foldr, cons, NList.Nil, v); + var name = "Dict"; + if (list.ctor === "Cons" && list._0._1.ctor === "Tuple0") { + name = "Set"; + list = A2(List.map, function(x){return x._0}, list); + } + return name + ".fromList " + toString(list); + } else { + var output = ""; + for (var i in v) { + if (i === 'ctor') continue; + var str = toString(v[i]); + var parenless = str[0] === '{' || str.indexOf(' ') < 0; + output += ' ' + (parenless ? str : '(' + str + ')'); + } + return v.ctor + output; + } + } + return v+""; + }; + function show(v) { return NList.fromArray(toString(v)); } + + function showChar (c) { + return c === '\n' ? '\\n' : + c === '\t' ? '\\t' : + c === '\b' ? '\\b' : + c === '\r' ? '\\r' : + c === '\v' ? '\\v' : + c === '\0' ? '\\0' : + c === '\'' ? "\\'" : + c === '\"' ? '\\"' : + c === '\\' ? '\\\\' : c; + } + + return elm.Native.Show = { show:show }; +}; + +Elm.Native.Prelude = function(elm) { + 'use strict'; + if (elm.Native.Prelude) return elm.Native.Prelude; + + var JS = Elm.JavaScript(elm); + var Maybe = Elm.Maybe(elm); + var Utils = Elm.Native.Utils(elm); + var Char = Elm.Char(elm); + + function div(a,b) { return (a/b)|0; } + function rem(a,b) { return a % b; } + var mod = Utils.mod; + function abs(x) { return x < 0 ? -x : x; } + function logBase(base,n) { return Math.log(n) / Math.log(base); } + function min(a,b) { return a < b ? a : b; } + function max(a,b) { return a > b ? a : b; } + function clamp(lo,hi,n) { return n < lo ? lo : n > hi ? hi : n; } + function xor(a,b) { return a !== b; } + function not(b) { return !b; } + + function truncate(n) { return n|0; } + + function id(n) { return n; } + function flip(f,a,b) { return A2(f,b,a); } + function curry(f,a,b) { return f(Utils.Tuple2(a,b)); } + function uncurry(f,v) { return A2(f,v._0,v._1); } + function fst(t) { return t._0; } + function snd(t) { return t._1; } + + function readInt(str) { + var s = JS.fromString(str); + var len = s.length; + if (len === 0) { return Maybe.Nothing; } + var start = 0; + if (s[0] == '-') { + if (len === 1) { return Maybe.Nothing; } + start = 1; + } + for (var i = start; i < len; ++i) { + if (!Char.isDigit(s[i])) { return Maybe.Nothing; } + } + return Maybe.Just(parseInt(s, 10)); + } + + function readFloat(str) { + var s = JS.fromString(str); + var len = s.length; + if (len === 0) { return Maybe.Nothing; } + var start = 0; + if (s[0] == '-') { + if (len === 1) { return Maybe.Nothing; } + start = 1; + } + var dotCount = 0; + for (var i = start; i < len; ++i) { + if (Char.isDigit(s[i])) { continue; } + if (s[i] === '.') { + dotCount += 1; + if (dotCount <= 1) { continue; } + } + return Maybe.Nothing; + } + return Maybe.Just(parseFloat(s)); + } + + var prelude = { + div:F2(div), + rem:F2(rem), + mod:mod, + + pi:Math.PI, + e:Math.e, + cos:Math.cos, + sin:Math.sin, + tan:Math.tan, + acos:Math.acos, + asin:Math.asin, + atan:Math.atan, + atan2:F2(Math.atan2), + + sqrt:Math.sqrt, + abs:abs, + logBase:F2(logBase), + min:F2(min), + max:F2(max), + clamp:F3(clamp), + compare:Utils.compare, + + xor:F2(xor), + not:not, + otherwise:true, + + truncate:truncate, + ceiling:Math.ceil, + floor:Math.floor, + round:Math.round, + toFloat:id, + + readInt:readInt, + readFloat:readFloat, + + id:id, + flip:F3(flip), + curry:F3(curry), + uncurry:F2(uncurry), + fst:fst, + snd:snd + }; + + function add(Module) { + var M = Module(elm); + for (var k in M) { prelude[k] = M[k]; } + } + add(Elm.Native.Show); + add(Elm.Signal); + add(Elm.List); + add(Elm.Maybe); + add(Elm.Time); + add(Elm.Graphics.Element); + + return elm.Native.Prelude = prelude; +}; + +Elm.Native.Matrix2D = function(elm) { + "use strict"; + + elm.Native = elm.Native || {}; + if (elm.Native.Matrix2D) return elm.Native.Matrix2D; + + if (typeof Float32Array === 'undefined'){ Float32Array = Array; } + var A = Float32Array; + + // layout of matrix in an array is + // + // | m11 m12 dx | + // | m21 m22 dy | + // | 0 0 1 | + // + // new A([ m11, m12, dx, m21, m22, dy ]) + + var identity = new A([1,0,0,0,1,0]); + function matrix(m11, m12, m21, m22, dx, dy) { + return new A([m11, m12, dx, m21, m22, dy]); + } + function rotation(t) { + var c = Math.cos(t); + var s = Math.sin(t); + return new A([c, -s, 0, s, c, 0]); + } + + function rotate(t,m) { + var c = Math.cos(t); + var s = Math.sin(t); + var m11 = m[0], m12 = m[1], m21 = m[3], m22 = m[4]; + return new A([m11*c + m12*s, -m11*s + m12*c, m[2], + m21*c + m22*s, -m21*s + m22*c, m[5]]); + } + /* + function move(xy,m) { + var x = xy._0; + var y = xy._1; + var m11 = m[0], m12 = m[1], m21 = m[3], m22 = m[4]; + return new A([m11, m12, m11*x + m12*y + m[2], + m21, m22, m21*x + m22*y + m[5]]); + } + function scale(s,m) { return new A([m[0]*s, m[1]*s, m[2], m[3]*s, m[4]*s, m[5]]); } + function scaleX(x,m) { return new A([m[0]*x, m[1], m[2], m[3]*x, m[4], m[5]]); } + function scaleY(y,m) { return new A([m[0], m[1]*y, m[2], m[3], m[4]*y, m[5]]); } + function reflectX(m) { return new A([-m[0], m[1], m[2], -m[3], m[4], m[5]]); } + function reflectY(m) { return new A([m[0], -m[1], m[2], m[3], -m[4], m[5]]); } + + function transform(m11, m21, m12, m22, mdx, mdy, n) { + var n11 = n[0], n12 = n[1], n21 = n[3], n22 = n[4], ndx = n[2], ndy = n[5]; + return new A([m11*n11 + m12*n21, + m11*n12 + m12*n22, + m11*ndx + m12*ndy + mdx, + m21*n11 + m22*n21, + m21*n12 + m22*n22, + m21*ndx + m22*ndy + mdy]); + } + */ + function multiply(m, n) { + var m11 = m[0], m12 = m[1], m21 = m[3], m22 = m[4], mdx = m[2], mdy = m[5]; + var n11 = n[0], n12 = n[1], n21 = n[3], n22 = n[4], ndx = n[2], ndy = n[5]; + return new A([m11*n11 + m12*n21, + m11*n12 + m12*n22, + m11*ndx + m12*ndy + mdx, + m21*n11 + m22*n21, + m21*n12 + m22*n22, + m21*ndx + m22*ndy + mdy]); + } + + return elm.Native.Matrix2D = { + identity:identity, + matrix:F6(matrix), + rotation:rotation, + multiply:F2(multiply) + /* + transform:F7(transform), + rotate:F2(rotate), + move:F2(move), + scale:F2(scale), + scaleX:F2(scaleX), + scaleY:F2(scaleY), + reflectX:reflectX, + reflectY:reflectY + */ + }; + +}; +Elm.Native.List = function(elm) { + "use strict"; + + elm.Native = elm.Native || {}; + if (elm.Native.List) return elm.Native.List; + if ('values' in Elm.Native.List) + return elm.Native.List = Elm.Native.List.values; + + var Utils = Elm.Native.Utils(elm); + + // TODO: Improve Nil handling + // We can change places like: if (xs.ctor === 'Nil') ... to if (xs === Nil) ... + // but only if we're confident Nil can only be defined once. + // Currently (27Mar2013) each module can have different instantiations, so multiple Nil objects can exist + // (and if they're used interchangeably then direct object comparison fails where ctor doesn't). + // So, this can only be fixed when modules initialisation is also fixed. + // The performance overhead of the .ctor calls is 5-10% according to jsperf (depending on fn + list size) + // (on firefox 19) + + var Nil = { ctor:'Nil' }; + + // using freeze for every cons would be nice but is a huge (9x on firefox 19) + // performance penalty + function Cons(hd,tl) { return { ctor:"Cons", _0:hd, _1:tl }; } + + function throwError(f) { + throw new Error("Function '" + f + "' expects a non-empty list!"); + } + + function toArray(xs) { + var out = []; + while (xs.ctor !== 'Nil') { + out.push(xs._0); + xs = xs._1; + } + return out; + } + + function fromArray(arr) { + var out = Nil; + for (var i = arr.length; i--; ) { + out = Cons(arr[i], out); + } + return out; + } + + function range(lo,hi) { + var lst = Nil; + if (lo <= hi) { + do { lst = Cons(hi,lst) } while (hi-->lo); + } + return lst + } + + function append(xs,ys) { + if (typeof xs === "string") { return xs.concat(ys); } + if (xs.ctor === 'Nil') { return ys; } + var root = Cons(xs._0, Nil); + var curr = root; + xs = xs._1; + while (xs.ctor !== 'Nil') { + curr._1 = Cons(xs._0, Nil); + xs = xs._1; + curr = curr._1; + } + curr._1 = ys; + return root; + } + + function head(v) { return v.ctor === 'Nil' ? throwError('head') : v._0; } + function tail(v) { return v.ctor === 'Nil' ? throwError('tail') : v._1; } + + function last(xs) { + if (xs.ctor === 'Nil') { throwError('last'); } + var out = xs._0; + while (xs.ctor !== 'Nil') { + out = xs._0; + xs = xs._1; + } + return out; + } + + function map(f, xs) { + var arr = []; + while (xs.ctor !== 'Nil') { + arr.push(f(xs._0)); + xs = xs._1; + } + return fromArray(arr); + } + + // f defined similarly for both foldl and foldr (NB: different from Haskell) + // ie, foldl :: (a -> b -> b) -> b -> [a] -> b + function foldl(f, b, xs) { + var acc = b; + while (xs.ctor !== 'Nil') { + acc = A2(f, xs._0, acc); + xs = xs._1; + } + return acc; + } + + function foldr(f, b, xs) { + var arr = toArray(xs); + var acc = b; + for (var i = arr.length; i--; ) { + acc = A2(f, arr[i], acc); + } + return acc; + } + + function foldl1(f, xs) { + return xs.ctor === 'Nil' ? throwError('foldl1') : foldl(f, xs._0, xs._1); + } + + function foldr1(f, xs) { + if (xs.ctor === 'Nil') { throwError('foldr1'); } + var arr = toArray(xs); + var acc = arr.pop(); + for (var i = arr.length; i--; ) { + acc = A2(f, arr[i], acc); + } + return acc; + } + + function scanl(f, b, xs) { + var arr = toArray(xs); + arr.unshift(b); + var len = arr.length; + for (var i = 1; i < len; ++i) { + arr[i] = A2(f, arr[i], arr[i-1]); + } + return fromArray(arr); + } + + function scanl1(f, xs) { + return xs.ctor === 'Nil' ? throwError('scanl1') : scanl(f, xs._0, xs._1); + } + + function filter(pred, xs) { + var arr = []; + while (xs.ctor !== 'Nil') { + if (pred(xs._0)) { arr.push(xs._0); } + xs = xs._1; + } + return fromArray(arr); + } + + function length(xs) { + var out = 0; + while (xs.ctor !== 'Nil') { + out += 1; + xs = xs._1; + } + return out; + } + + function member(x, xs) { + while (xs.ctor !== 'Nil') { + if (Utils.eq(x,xs._0)) return true; + xs = xs._1; + } + return false; + } + + function reverse(xs) { return fromArray(toArray(xs).reverse()); } + + function concat(xss) { + if (xss.ctor === 'Nil') return xss; + var arr = toArray(xss); + var xs = arr[arr.length-1]; + for (var i = arr.length-1; i--; ) { + xs = append(arr[i], xs); + } + return xs; + } + + function all(pred, xs) { + while (xs.ctor !== 'Nil') { + if (!pred(xs._0)) return false; + xs = xs._1; + } + return true; + } + + function any(pred, xs) { + while (xs.ctor !== 'Nil') { + if (pred(xs._0)) return true; + xs = xs._1; + } + return false; + } + + function zipWith(f, xs, ys) { + var arr = []; + while (xs.ctor !== 'Nil' && ys.ctor !== 'Nil') { + arr.push(A2(f, xs._0, ys._0)); + xs = xs._1; + ys = ys._1; + } + return fromArray(arr); + } + + function zip(xs, ys) { + var arr = []; + while (xs.ctor !== 'Nil' && ys.ctor !== 'Nil') { + arr.push(Utils.Tuple2(xs._0, ys._0)); + xs = xs._1; + ys = ys._1; + } + return fromArray(arr); + } + + function sort(xs) { + function cmp(a,b) { + var ord = Utils.compare(a,b).ctor; + return ord=== 'EQ' ? 0 : ord === 'LT' ? -1 : 1; + } + return fromArray(toArray(xs).sort(cmp)); + } + + function take(n, xs) { + var arr = []; + while (xs.ctor !== 'Nil' && n > 0) { + arr.push(xs._0); + xs = xs._1; + --n; + } + return fromArray(arr); + } + + function drop(n, xs) { + while (xs.ctor !== 'Nil' && n > 0) { + xs = xs._1; + --n; + } + return xs; + } + + function join(sep, xss) { + if (typeof sep === 'string') return toArray(xss).join(sep); + if (xss.ctor === 'Nil') return Nil; + var s = toArray(sep); + var out = toArray(xss._0); + xss = xss._1; + while (xss.ctor !== 'Nil') { + out = out.concat(s, toArray(xss._0)); + xss = xss._1; + } + return fromArray(out); + } + + function split(seperator, list) { + var array = toArray(list); + var alen = array.length; + if (alen === 0) { + // splitting an empty list is a list of lists: [[]] + return Cons(Nil,Nil); + } + + var sep = toArray(seperator); + var seplen = sep.length; + if (seplen === 0) { + // splitting with an empty sep is a list of all elements + // Same as (map (\x -> [x]) list) + var out = Nil; + for (var i = alen; i--; ) { + out = Cons(Cons(array[i],Nil), out); + } + return out; + } + + var matches = [-seplen]; + var sepStart = sep[0]; + var len = alen - seplen + 1; + for (var i = 0; i < len; ++i) { + if (Utils.eq(array[i], sepStart)) { + var match = true; + for (var j = seplen; --j; ) { + if (!Utils.eq(array[i+j], sep[j])) { match = false; break; } + } + if (match) { + matches.push(i); + i += seplen - 1; + } + } + } + + // shortcut in case of no matches + if (matches.length === 0) { + return Cons(list,Nil); + } + + var out = Nil; + var index = alen - 1; + for (var i = matches.length; i--; ) { + var temp = Nil; + var stop = matches[i] + seplen - 1; + for ( ; index > stop; --index ) { + temp = Cons(array[index], temp); + } + out = Cons(temp,out); + index -= seplen; + } + return out; + } + + Elm.Native.List.values = { + Nil:Nil, + Cons:Cons, + toArray:toArray, + fromArray:fromArray, + range:range, + append:append, + + head:head, + tail:tail, + last:last, + + map:F2(map), + foldl:F3(foldl), + foldr:F3(foldr), + + foldl1:F2(foldl1), + foldr1:F2(foldr1), + scanl:F3(scanl), + scanl1:F2(scanl1), + filter:F2(filter), + length:length, + member:F2(member), + reverse:reverse, + concat:concat, + + all:F2(all), + any:F2(any), + zipWith:F3(zipWith), + zip:F2(zip), + sort:sort, + take:F2(take), + drop:F2(drop), + + join:F2(join), + split:F2(split) + }; + return elm.Native.List = Elm.Native.List.values; + +}; +Elm.Native.Json = function(elm) { + 'use strict'; + + var Maybe = Elm.Maybe(elm); + var Dict = Elm.Dict(elm); + var List = Elm.List(elm); + var JS = Elm.JavaScript(elm); + var Utils = Elm.Native.Utils(elm); + + function fromValue(v) { + switch (v.ctor) { + case 'Null' : return null; + case 'String' : return JS.fromString(v._0); + case 'Object' : + var obj = {}; + var array = JS.fromList(Dict.toList(v._0)); + for (var i = arr.length; i--; ) { + obj[JS.fromString(array[i]._0)] = fromValue(array[i]._1); + } + return obj; + case 'Array' : + var array = JS.fromList(v._0); + for (var i = array.length; i--; ) { + array[i] = fromValue(array[i]); + } + return array; + default : + return v._0; + } + } + + function toPrettyJSString(sep, obj) { + return JSON.stringify(fromValue(obj), null, JS.fromString(sep)); + } + + function toValue(v) { + switch (typeof v) { + case 'string' : return { ctor:"String", _0: JS.toString(v) }; + case 'number' : return { ctor:"Number", _0: JS.toFloat(v) }; + case 'boolean': return { ctor:"Bool" , _0: JS.toBool(v) }; + case 'object' : + if (v === null) return { ctor:"Null" }; + if (v instanceof Array) { + for (var i = v.length; i--; ) { v[i] = toValue(v[i]); } + return { ctor:"Array", _0: JS.toList(v) }; + } + var array = []; + for (var k in v) array.push(Utils.Tuple2(JS.toString(k), toValue(v[k]))); + return { ctor:"Object", _0: Dict.fromList(JS.toList(array)) }; + } + } + + function fromJSString(str) { + try { + return Maybe.Just(toValue(JSON.parse(str))); + } catch (e) { + return Maybe.Nothing; + } + } + + return elm.Native.Json = { + toJSString : F2(toPrettyJSString), + fromJSString : fromJSString, + toJSObject : fromValue, + fromJSObject : toValue + }; + +}; + +Elm.Native.JavaScript = function(elm) { + 'use strict'; + + elm.Native = elm.Native || {}; + if (elm.Native.JavaScript) return elm.Native.JavaScript; + + var List = Elm.Native.List(elm); + var Render = ElmRuntime.use(ElmRuntime.Render.Element); + + function fromJS(v) { + var type = typeof v; + if (type === 'number' ) return v; + if (type === 'boolean') return v; + if (type === 'string' ) return List.fromArray(v); + if (v instanceof Array) { + var arr = []; + var len = v.length; + for (var i = 0; i < len; ++i) { + var x = fromJS(v[i]); + if (x !== null) arr.push(x); + } + return List.fromArray(arr); + } + if (type === 'object') { + var rec = { _:{} }; + for (var f in v) { + var x = fromJS(v[f]); + if (x !== null) rec[f] = x; + } + return rec; + } + return null; + } + + function toJS(v) { + var type = typeof v; + if (type === 'number' || type === 'boolean') return v; + if (type === 'object' && '_' in v) { + var obj = {}; + for (var k in v) { + var x = v[k]; + if (x !== null) obj[k] = x; + } + return obj; + } + if (type === 'object' && (v.ctor === 'Cons' || v.ctor === 'Nil')) { + var array = List.toArray(v); + for (var i = array.length; i--; ) { + array[i] = toJS(array[i]); + } + if (typeof array[0] === 'string') array.join(''); + return array; + } + return null; + } + + function fromRecord(r) { + if (typeof r === 'object' && '_' in r) { + return toJS(r); + } + throw new Error("'fromRecord' must be called on a record."); + } + + function id(n) { return n; } + + function toElement(w,h,domNode) { + return A3( newElement, w, h, { + ctor: 'Custom', + type: 'DomNode', + render: function(node) { return node; }, + update: function(node,oldNode,newNode) { + if (node === newNode) return; + node.parentNode.replaceChild(newNode, node); + }, + model: domNode + }); + } + + function fromElement(element) { + return Render.render(element); + } + + return elm.Native.JavaScript = { + toFloat : id, + toBool : id, + toInt : function(n) { return n|0; }, + toString : List.fromArray, + toList : List.fromArray, + fromString : function(s) { return List.toArray(s).join(''); }, + fromList : List.toArray, + fromInt : id, + fromFloat : id, + fromBool : id, + + toElement : toElement, + fromElement : fromElement, + toRecord : fromJS, + fromRecord : fromRecord + }; + +}; +function F2(fun) { + function wrapper(a) { return function(b) { return fun(a,b) } } + wrapper.arity = 2; + wrapper.func = fun; + return wrapper; +} + +function F3(fun) { + function wrapper(a) { + return function(b) { return function(c) { return fun(a,b,c) }} + } + wrapper.arity = 3; + wrapper.func = fun; + return wrapper; +} + +function F4(fun) { + function wrapper(a) { return function(b) { return function(c) { + return function(d) { return fun(a,b,c,d) }}} + } + wrapper.arity = 4; + wrapper.func = fun; + return wrapper; +} + +function F5(fun) { + function wrapper(a) { return function(b) { return function(c) { + return function(d) { return function(e) { return fun(a,b,c,d,e) }}}} + } + wrapper.arity = 5; + wrapper.func = fun; + return wrapper; +} + +function F6(fun) { + function wrapper(a) { return function(b) { return function(c) { + return function(d) { return function(e) { return function(f) { + return fun(a,b,c,d,e,f) }}}}} + } + wrapper.arity = 6; + wrapper.func = fun; + return wrapper; +} + +function F7(fun) { + function wrapper(a) { return function(b) { return function(c) { + return function(d) { return function(e) { return function(f) { + return function(g) { return fun(a,b,c,d,e,f,g) }}}}}} + } + wrapper.arity = 7; + wrapper.func = fun; + return wrapper; +} + +function F8(fun) { + function wrapper(a) { return function(b) { return function(c) { + return function(d) { return function(e) { return function(f) { + return function(g) { return function(h) {return fun(a,b,c,d,e,f,g,h)}}}}}}} + } + wrapper.arity = 8; + wrapper.func = fun; + return wrapper; +} + +function F9(fun) { + function wrapper(a) { return function(b) { return function(c) { + return function(d) { return function(e) { return function(f) { + return function(g) { return function(h) { return function(i) { + return fun(a,b,c,d,e,f,g,h,i) }}}}}}}} + } + wrapper.arity = 9; + wrapper.func = fun; + return wrapper; +} + +function A2(fun,a,b) { + return fun.arity === 2 ? fun.func(a,b) : fun(a)(b); +} +function A3(fun,a,b,c) { + return fun.arity === 3 ? fun.func(a,b,c) : fun(a)(b)(c); +} +function A4(fun,a,b,c,d) { + return fun.arity === 4 ? fun.func(a,b,c,d) : fun(a)(b)(c)(d); +} +function A5(fun,a,b,c,d,e) { + return fun.arity === 5 ? fun.func(a,b,c,d,e) : fun(a)(b)(c)(d)(e); +} +function A6(fun,a,b,c,d,e,f) { + return fun.arity === 6 ? fun.func(a,b,c,d,e,f) : fun(a)(b)(c)(d)(e)(f); +} +function A7(fun,a,b,c,d,e,f,g) { + return fun.arity === 7 ? fun.func(a,b,c,d,e,f,g) : fun(a)(b)(c)(d)(e)(f)(g); +} +function A8(fun,a,b,c,d,e,f,g,h) { + return fun.arity === 8 ? fun.func(a,b,c,d,e,f,g,h) : fun(a)(b)(c)(d)(e)(f)(g)(h); +} +function A9(fun,a,b,c,d,e,f,g,h,i) { + return fun.arity === 9 ? fun.func(a,b,c,d,e,f,g,h,i) + : fun(a)(b)(c)(d)(e)(f)(g)(h)(i); +} + +Elm.Native.Error = function(elm) { + 'use strict'; + elm.Native = elm.Native || {}; + if (elm.Native.Error) return elm.Native.Error; + + var fromString = Elm.Native.JavaScript(elm).fromString; + + function Case(span) { + var msg = 'Non-exhaustive pattern match in case expression' + throw new Error(msg + " (" + span + ")") + } + + function If(span) { + var msg = 'Non-exhaustive pattern match in multi-way-if expression' + throw new Error(msg + " (" + span + ")") + } + + function raise(str) { throw new Error(fromString(str)); } + + return elm.Native.Error = { Case: Case, If: If, raise: raise }; +}; +Elm.Native.Date = function(elm) { + 'use strict'; + + elm.Native = elm.Native || {}; + if (elm.Native.Date) return elm.Native.Date; + + var JS = Elm.JavaScript(elm); + var Maybe = Elm.Maybe(elm); + + function dateNow() { return new window.Date; } + function readDate(str) { + var d = new window.Date(JS.fromString(str)); + if (isNaN(d.getTime())) return Maybe.Nothing; + return Maybe.Just(d); + } + + var dayTable = ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"]; + var monthTable = ["Jan", "Feb", "Mar", "Apr", "May", "Jun", + "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"]; + + return elm.Native.Date = { + read : readDate, + year : function(d) { return d.getFullYear(); }, + month : function(d) { return { ctor:monthTable[d.getMonth()] }; }, + day : function(d) { return d.getDate(); }, + hour : function(d) { return d.getHours(); }, + minute : function(d) { return d.getMinutes(); }, + second : function(d) { return d.getSeconds(); }, + toTime : function(d) { return d.getTime(); }, + dayOfWeek : function(d) { return { ctor:dayTable[d.getDay()] }; } + }; + +}; + + +Elm.Native.Color = function(elm) { + "use strict"; + + elm.Native = elm.Native || {}; + if (elm.Native.Color) return elm.Native.Color; + + var Utils = Elm.Native.Utils(elm); + + function complement(rgb) { + var hsv = toHSV(rgb); + hsv.hue = (hsv.hue + 180) % 360; + return toRGB(hsv); + } + + function hsva(h,s,v,a) { + var degree = A2(Utils.mod, h * 180 / Math.PI, 360); + var clr = toRGB({hue:degree, saturation:s, value:v}); + clr._3 = a; + return clr; + } + + function hsv(h,s,v) { + var degree = A2(Utils.mod, h * 180 / Math.PI, 360); + return toRGB({hue:degree, saturation:s, value:v}); + } + + function toHSV(rgb) { + var hsv = {}; + var r = rgb._0 / 255.0, g = rgb._1 / 255.0, b = rgb._2 / 255.0; + var M = Math.max(r,g,b); + var m = Math.min(r,g,b); + var c = M - m; + + var h = 0; + if (c === 0) { h = 0; } + else if (M === r) { h = ((g - b) / c) % 6; } + else if (M === g) { h = ((b - r) / c) + 2; } + else if (M === b) { h = ((r - g) / c) + 4; } + h *= 60; + + return { value : M, hue : h, saturation : (M === 0 ? 0 : c / M) }; + } + + function between(lo,hi,x) { return lo <= x && x < hi; } + function norm(n) { return Math.round(n*255); } + + function toRGB(hsv) { + var c = hsv.value * hsv.saturation; + var hue = hsv.hue / 60; + var x = c * (1 - Math.abs((hue % 2) - 1)); + var r = 0, g = 0, b = 0; + if (between(0,1,hue)) { r = c; g = x; b = 0; } + else if (between(1,2,hue)) { r = x; g = c; b = 0; } + else if (between(2,3,hue)) { r = 0; g = c; b = x; } + else if (between(3,4,hue)) { r = 0; g = x; b = c; } + else if (between(4,5,hue)) { r = x; g = 0; b = c; } + else if (between(5,6,hue)) { r = c; g = 0; b = x; } + + var m = hsv.value - c; + return { ctor:"Color", _0:norm(r+m), _1:norm(g+m), _2:norm(b+m), _3:1 }; + } + + return elm.Native.Color = { + hsva:F4(hsva), + hsv:F3(hsv), + complement:complement + }; + +}; +Elm.Native.Char = function(elm) { + 'use strict'; + + elm.Native = elm.Native || {}; + if (elm.Native.Char) return elm.Native.Char; + + function isBetween(lo,hi) { return function(chr) { + var c = chr.charCodeAt(0); + return lo <= c && c <= hi; + }; + } + var isDigit = isBetween('0'.charCodeAt(0),'9'.charCodeAt(0)); + var chk1 = isBetween('a'.charCodeAt(0),'f'.charCodeAt(0)); + var chk2 = isBetween('A'.charCodeAt(0),'F'.charCodeAt(0)); + + return elm.Native.Char = { + fromCode : function(c) { return String.fromCharCode(c); }, + toCode : function(c) { return c.charCodeAt(0); }, + toUpper : function(c) { return c.toUpperCase(); }, + toLower : function(c) { return c.toLowerCase(); }, + toLocaleUpper : function(c) { return c.toLocaleUpperCase(); }, + toLocaleLower : function(c) { return c.toLocaleLowerCase(); }, + isLower : isBetween('a'.charCodeAt(0),'z'.charCodeAt(0)), + isUpper : isBetween('A'.charCodeAt(0),'Z'.charCodeAt(0)), + isDigit : isDigit, + isOctDigit : isBetween('0'.charCodeAt(0),'7'.charCodeAt(0)), + isHexDigit : function(c) { return isDigit(c) || chk1(c) || chk2(c); } + }; + +}; + +Elm.Native.Window = function(elm) { + 'use strict'; + + elm.Native = elm.Native || {}; + if (elm.Native.Window) return elm.Native.Window; + + var Signal = Elm.Signal(elm); + var Tuple2 = Elm.Native.Utils(elm).Tuple2; + + function getWidth() { return elm.node.clientWidth; } + function getHeight() { + if (elm.display === ElmRuntime.Display.FULLSCREEN) { + return window.innerHeight; + } + return elm.node.clientHeight; + } + + var dimensions = Signal.constant(Tuple2(getWidth(), getHeight())); + dimensions.defaultNumberOfKids = 2; + + // Do not move width and height into Elm. By setting the default number of kids, + // the resize listener can be detached. + var width = A2(Signal.lift, function(p){return p._0;}, dimensions); + width.defaultNumberOfKids = 0; + + var height = A2(Signal.lift, function(p){return p._1;}, dimensions); + height.defaultNumberOfKids = 0; + + function resizeIfNeeded() { + var w = getWidth(); + var h = getHeight(); + if (dimensions.value._0 === w && dimensions.value._1 === h) return; + var hasListener = elm.notify(dimensions.id, Tuple2(w,h)); + if (!hasListener) window.removeEventListener('resize', resizeIfNeeded); + } + window.addEventListener('resize', resizeIfNeeded); + + return elm.Native.Window = { + dimensions:dimensions, + width:width, + height:height, + resizeIfNeeded:resizeIfNeeded + }; + +}; + +Elm.Native.WebSocket = function(elm) { + 'use strict'; + + elm.Native = elm.Native || {}; + if (elm.Native.WebSocket) return elm.Native.WebSocket; + + var Signal = Elm.Signal(elm); + var JS = Elm.JavaScript(elm); + var List = Elm.Native.List(elm); + + function open(url, outgoing) { + var incoming = Signal.constant(List.Nil); + var ws = new WebSocket(JS.fromString(url)); + + var pending = []; + var ready = false; + + ws.onopen = function(e) { + var len = pending.length; + for (var i = 0; i < len; ++i) { ws.send(pending[i]); } + ready = true; + }; + ws.onmessage = function(event) { + elm.notify(incoming.id, JS.toString(event.data)); + }; + + function send(msg) { + var s = JS.fromString(msg); + ready ? ws.send(s) : pending.push(s); + } + + function take1(x,y) { return x } + return A3(Signal.lift2, F2(take1), incoming, A2(Signal.lift, send, outgoing)); + } + + return elm.Native.WebSocket = { connect: F2(open) }; +}; + +Elm.Native.Touch = function(elm) { + 'use strict'; + + elm.Native = elm.Native || {}; + if (elm.Native.Touch) return elm.Native.Touch; + + var Signal = Elm.Signal(elm); + var JS = Elm.JavaScript(elm); + var _ = Elm.Native.Utils(elm); + + function Dict() { + this.keys = []; + this.values = []; + + this.insert = function(key,value) { + this.keys.push(key); + this.values.push(value); + }; + this.lookup = function(key) { + var i = this.keys.indexOf(key) + return i >= 0 ? this.values[i] : {x:0,y:0,t:0}; + }; + this.remove = function(key) { + var i = this.keys.indexOf(key); + if (i < 0) return; + var t = this.values[i]; + this.keys.splice(i,1); + this.values.splice(i,1); + return t; + }; + this.clear = function() { + this.keys = []; + this.values = []; + }; + } + + var root = Signal.constant([]), + tapTime = 500, + hasTap = false, + tap = {_:{},x:0,y:0}, + dict = new Dict(); + + function touch(t) { + var r = dict.lookup(t.identifier); + return {_ : {}, + id: t.identifier, + x : t.pageX - elm.node.offsetX, + y : t.pageY - elm.node.offsetY, + x0: r.x, + y0: r.y, + t0: r.t + }; + } + + var node = elm.display === ElmRuntime.Display.FULLSCREEN ? document : elm.node; + + function start(e) { + dict.insert(e.identifier, + {x: e.pageX - elm.node.offsetX, + y: e.pageY - elm.node.offsetY, + t: Date.now()}); + } + function end(e) { + var t = dict.remove(e.identifier); + if (Date.now() - t.t < tapTime) { + hasTap = true; + tap = {_:{}, x:t.x, y:t.y}; + } + } + + function listen(name, f) { + function update(e) { + for (var i = e.changedTouches.length; i--; ) { f(e.changedTouches[i]); } + var ts = new Array(e.touches.length); + for (var i = e.touches.length; i--; ) { ts[i] = touch(e.touches[i]); } + var hasListener = elm.notify(root.id, ts); + if (!hasListener) return node.removeEventListener(name, update); + e.preventDefault(); + } + node.addEventListener(name, update); + } + + listen("touchstart", start); + listen("touchmove", function(_){}); + listen("touchend", end); + listen("touchcancel", end); + listen("touchleave", end); + + var mouseID = -1; + function move(e) { + for (var i = root.value.length; i--; ) { + if (root.value[i].id === mouseID) { + root.value[i].x = e.pageX - elm.node.offsetX; + root.value[i].y = e.pageY - elm.node.offsetY; + elm.notify(root.id, root.value); + break; + } + } + } + node.addEventListener("mousedown", function(e) { + node.addEventListener("mousemove", move); + e.identifier = mouseID; + start(e); + root.value.push(touch(e)); + elm.notify(root.id, root.value); + }); + node.addEventListener("mouseup", function(e) { + node.removeEventListener("mousemove", move); + e.identifier = mouseID; + end(e); + for (var i = root.value.length; i--; ) { + if (root.value[i].id === mouseID) { + root.value.splice(i, 1); + --mouseID; + break; + } + } + elm.notify(root.id, root.value); + }); + node.addEventListener("blur", function() { + node.removeEventListener("mousemove", move); + if (root.values.length > 0) { + elm.notify(root.id, []); + --mouseID; + } + dict.clear(); + }); + + function dependency(f) { + var sig = A2( Signal.lift, f, root ); + root.defaultNumberOfKids += 1; + sig.defaultNumberOfKids = 0; + return sig; + } + + var touches = dependency(JS.toList); + + var taps = function() { + var sig = dependency(function(_) { return tap; }); + sig.defaultNumberOfKids = 1; + function pred(_) { var b = hasTap; hasTap = false; return b; } + var sig2 = A3( Signal.keepIf, pred, {_:{},x:0,y:0}, sig); + sig2.defaultNumberOfKids = 0; + return sig2; + }(); + + return elm.Native.Touch = { touches: touches, taps: taps }; + +}; +Elm.Native.Time = function(elm) { + 'use strict'; + + var Signal = Elm.Signal(elm); + var Maybe = Elm.Maybe(elm); + var Utils = Elm.Native.Utils(elm); + + function fpsWhen(desiredFPS, isOn) { + var msPerFrame = 1000 / desiredFPS; + var prev = Date.now(), curr = prev, diff = 0, wasOn = true; + var ticker = Signal.constant(diff); + function tick(zero) { return function() { + curr = Date.now(); + diff = zero ? 0 : curr - prev; + prev = curr; + elm.notify(ticker.id, diff); + }; + } + var timeoutID = 0; + function f(isOn, t) { + if (isOn) { + timeoutID = setTimeout(tick(!wasOn && isOn), msPerFrame); + } else if (wasOn) { + clearTimeout(timeoutID); + } + wasOn = isOn; + return t; + } + return A3( Signal.lift2, F2(f), isOn, ticker ); + } + + function everyWhen(t, isOn) { + var clock = Signal.constant(Date.now()); + function tellTime() { elm.notify(clock.id, Date.now()); } + setInterval(tellTime, t); + return clock; + } + + function since(t, s) { + function cmp(a,b) { return !Utils.eq(a,b); } + var dcount = Signal.count(A2(Signal.delay, t, s)); + return A3( Signal.lift2, F2(cmp), Signal.count(s), dcount ); + } + function read(s) { + var t = Date.parse(s); + return isNaN(t) ? Maybe.Nothing : Maybe.Just(t); + } + return elm.Native.Time = { + fpsWhen : F2(fpsWhen), + fps : function(t) { return fpsWhen(t, Signal.constant(true)); }, + every : function(t) { return everyWhen(t, Signal.constant(true)) }, + delay : Signal.delay, + timestamp : Signal.timestamp, + since : F2(since), + toDate : function(t) { return new window.Date(t); }, + read : read + }; + +}; + +Elm.Native.Signal = function(elm) { + 'use strict'; + + elm.Native = elm.Native || {}; + if (elm.Native.Signal) return elm.Native.Signal; + + var Utils = Elm.Native.Utils(elm); + var foldl1 = Elm.List(elm).foldl1; + + function send(node, timestep, changed) { + var kids = node.kids; + for (var i = kids.length; i--; ) { + kids[i].recv(timestep, changed, node.id); + } + } + + function Input(base) { + this.id = Utils.guid(); + this.value = base; + this.kids = []; + this.defaultNumberOfKids = 0; + this.recv = function(timestep, eid, v) { + var changed = eid === this.id; + if (changed) { this.value = v; } + send(this, timestep, changed); + return changed; + }; + elm.inputs.push(this); + } + + function LiftN(update, args) { + this.id = Utils.guid(); + this.value = update(); + this.kids = []; + + var n = args.length; + var count = 0; + var isChanged = false; + + this.recv = function(timestep, changed, parentID) { + ++count; + if (changed) { isChanged = true; } + if (count == n) { + if (isChanged) { this.value = update(); } + send(this, timestep, isChanged); + isChanged = false; + count = 0; + } + }; + for (var i = n; i--; ) { args[i].kids.push(this); } + } + + function lift(func, a) { + function update() { return func(a.value); } + return new LiftN(update, [a]); + } + function lift2(func, a, b) { + function update() { return A2( func, a.value, b.value ); } + return new LiftN(update, [a,b]); + } + function lift3(func, a, b, c) { + function update() { return A3( func, a.value, b.value, c.value ); } + return new LiftN(update, [a,b,c]); + } + function lift4(func, a, b, c, d) { + function update() { return A4( func, a.value, b.value, c.value, d.value ); } + return new LiftN(update, [a,b,c,d]); + } + function lift5(func, a, b, c, d, e) { + function update() { return A5( func, a.value, b.value, c.value, d.value, e.value ); } + return new LiftN(update, [a,b,c,d,e]); + } + function lift6(func, a, b, c, d, e, f) { + function update() { return A6( func, a.value, b.value, c.value, d.value, e.value, f.value ); } + return new LiftN(update, [a,b,c,d,e,f]); + } + function lift7(func, a, b, c, d, e, f, g) { + function update() { return A7( func, a.value, b.value, c.value, d.value, e.value, f.value, g.value ); } + return new LiftN(update, [a,b,c,d,e,f,g]); + } + function lift8(func, a, b, c, d, e, f, g, h) { + function update() { return A8( func, a.value, b.value, c.value, d.value, e.value, f.value, g.value, h.value ); } + return new LiftN(update, [a,b,c,d,e,f,g,h]); + } + + function foldp(func,state,input) { + var first = true; + function update() { + first ? first = false : state = A2(func, input.value, state); + return state; + } + return new LiftN(update, [input]); + } + + function DropIf(pred,base,input) { + this.id = Utils.guid(); + this.value = pred(input.value) ? base : input.value; + this.kids = []; + this.recv = function(timestep, changed, parentID) { + var chng = changed && !pred(input.value); + if (chng) { this.value = input.value; } + send(this, timestep, chng); + }; + input.kids.push(this); + } + + function DropRepeats(input) { + this.id = Utils.guid(); + this.value = input.value; + this.kids = []; + this.recv = function(timestep, changed, parentID) { + var chng = changed && !Utils.eq(this.value,input.value); + if (chng) { this.value = input.value; } + send(this, timestep, chng); + }; + input.kids.push(this); + } + + function dropWhen(s1,b,s2) { + var pairs = lift2( F2(function(x,y){return {x:x,y:y};}), s1, s2 ); + var dropped = new DropIf(function(p){return p.x;},{x:true,y:b},pairs); + return lift(function(p){return p.y;}, dropped); + } + + function timestamp(a) { + function update() { return Utils.Tuple2(Date.now(), a.value); } + return new LiftN(update, [a]); + } + + function SampleOn(s1,s2) { + this.id = Utils.guid(); + this.value = s2.value; + this.kids = []; + + var count = 0; + var isChanged = false; + + this.recv = function(timestep, changed, parentID) { + if (parentID === s1.id) isChanged = changed; + ++count; + if (count == 2) { + if (isChanged) { this.value = s2.value; } + send(this, timestep, isChanged); + count = 0; + isChanged = false; + } + }; + s1.kids.push(this); + s2.kids.push(this); + } + + function sampleOn(s1,s2) { return new SampleOn(s1,s2); } + + function delay(t,s) { + var delayed = new Input(s.value); + var firstEvent = true; + function update(v) { + if (firstEvent) { firstEvent = false; return; } + setTimeout(function() { elm.notify(delayed.id, v); }, t); + } + function first(a,b) { return a; } + return new SampleOn(delayed, lift2(F2(first), delayed, lift(update,s))); + } + + function Merge(s1,s2) { + this.id = Utils.guid(); + this.value = s1.value; + this.kids = []; + + var next = null; + var count = 0; + var isChanged = false; + + this.recv = function(timestep, changed, parentID) { + ++count; + if (changed) { + isChanged = true; + if (parentID == s2.id && next === null) { next = s2.value; } + if (parentID == s1.id) { next = s1.value; } + } + + if (count == 2) { + if (isChanged) { this.value = next; next = null; } + send(this, timestep, isChanged); + isChanged = false; + count = 0; + } + }; + s1.kids.push(this); + s2.kids.push(this); + } + + function merge(s1,s2) { return new Merge(s1,s2); } + function merges(ss) { return A2(foldl1, F2(merge), ss); } + + return elm.Native.Signal = { + constant : function(v) { return new Input(v); }, + lift : F2(lift ), + lift2 : F3(lift2), + lift3 : F4(lift3), + lift4 : F5(lift4), + lift5 : F6(lift5), + lift6 : F7(lift6), + lift7 : F8(lift7), + lift8 : F9(lift8), + foldp : F3(foldp), + delay : F2(delay), + merge : F2(merge), + merges : merges, + count : function(s) { return foldp(F2(function(_,c) { return c+1; }), 0, s); }, + countIf : F2(function(pred,s) { + return foldp(F2(function(x,c){ + return pred(x) ? c+1 : c; }), 0, s)}), + keepIf : F3(function(pred,base,sig) { + return new DropIf(function(x) {return !pred(x);},base,sig); }), + dropIf : F3(function(pred,base,sig) { return new DropIf(pred,base,sig); }), + keepWhen : F3(function(s1,b,s2) { + return dropWhen(lift(function(b){return !b;},s1), b, s2); }), + dropWhen : F3(dropWhen), + dropRepeats : function(s) { return new DropRepeats(s);}, + sampleOn : F2(sampleOn), + timestamp : timestamp + }; +}; + +Elm.Native.Random = function(elm) { + 'use strict'; + elm.Native = elm.Native || {}; + if (elm.Native.Random) return elm.Native.Random; + + var Signal = Elm.Signal(elm); + + function range(min, max, signal) { + function f(x) { return Math.floor(Math.random() * (max-min+1)) + min; } + return A2( Signal.lift, f, signal ); + } + + function flt(signal) { + function f(x) { return Math.random(); } + return A2( Signal.lift, f, signal ); + } + + elm.Native.Random = { range: F3(range) }; + elm.Native.Random['float'] = flt; + return elm.Native.Random; + +}; + +Elm.Native.Mouse = function(elm) { + 'use strict'; + elm.Native = elm.Native || {}; + if (elm.Native.Mouse) return elm.Native.Mouse; + + var Signal = Elm.Signal(elm); + var Utils = Elm.Native.Utils(elm); + + var position = Signal.constant(Utils.Tuple2(0,0)); + position.defaultNumberOfKids = 2; + + // do not move x and y into Elm. By setting their default number + // of kids, it is possible to detatch the mouse listeners if + // they are not needed. + var x = A2( Signal.lift, function(p){return p._0}, position); + x.defaultNumberOfKids = 0; + var y = A2( Signal.lift, function(p){return p._1}, position); + y.defaultNumberOfKids = 0; + + var isDown = Signal.constant(false); + var isClicked = Signal.constant(false); + var clicks = Signal.constant(Utils.Tuple0); + + function getXY(e) { + var posx = 0; + var posy = 0; + if (!e) e = window.event; + if (e.pageX || e.pageY) { + posx = e.pageX; + posy = e.pageY; + } else if (e.clientX || e.clientY) { + posx = e.clientX + document.body.scrollLeft + + document.documentElement.scrollLeft; + posy = e.clientY + document.body.scrollTop + + document.documentElement.scrollTop; + } + return Utils.Tuple2(posx-elm.node.offsetX, posy-elm.node.offsetY); + } + + var node = elm.display === ElmRuntime.Display.FULLSCREEN ? document : elm.node; + + function click(e) { + var hasListener1 = elm.notify(isClicked.id, true); + var hasListener2 = elm.notify(clicks.id, Utils.Tuple0); + elm.notify(isClicked.id, false); + if (!hasListener1 && !hasListener2) + node.removeEventListener('click', click); + } + + function down(e) { + var hasListener = elm.notify(isDown.id, true); + if (!hasListener) node.removeEventListener('mousedown', down); + } + + function up(e) { + var hasListener = elm.notify(isDown.id, false); + if (!hasListener) node.removeEventListener('mouseup', up); + } + + function move(e) { + var hasListener = elm.notify(position.id, getXY(e)); + if (!hasListener) node.removeEventListener('mousemove', move); + } + + node.addEventListener('click' , click); + node.addEventListener('mousedown', down); + node.addEventListener('mouseup' , up); + node.addEventListener('mousemove', move); + + return elm.Native.Mouse = { + position: position, + x:x, + y:y, + isClicked: isClicked, + isDown: isDown, + clicks: clicks + }; +}; +Elm.Native.Keyboard = function(elm) { + 'use strict'; + elm.Native = elm.Native || {}; + if (elm.Native.Keyboard) return elm.Native.Keyboard; + + var Signal = Elm.Signal(elm); + var NList = Elm.Native.List(elm); + + var keysDown = Signal.constant(NList.Nil); + var lastKey = Signal.constant('\0'); + + function down(e) { + if (NList.member(e.keyCode)(keysDown.value)) return; + var list = NList.Cons(e.keyCode, keysDown.value); + var hasListener = elm.notify(keysDown.id, list); + if (!hasListener) document.removeEventListener('keydown', down); + } + function up(e) { + function notEq(kc) { return kc !== e.keyCode; } + var codes = NList.filter(notEq)(keysDown.value); + var hasListener = elm.notify(keysDown.id, codes); + if (!hasListener) document.removeEventListener('keyup', up); + } + function blur(e) { + var hasListener = elm.notify(keysDown.id, NList.Nil); + if (!hasListener) document.removeEventListener('blur', blur); + } + function press(e) { + var hasListener = elm.notify(lastKey.id, e.charCode || e.keyCode); + if (!hasListener) document.removeEventListener('keypress', press); + } + + document.addEventListener('keydown' , down ); + document.addEventListener('keyup' , up ); + document.addEventListener('blur' , blur ); + document.addEventListener('keypress', press); + + function keySignal(f) { + var signal = A2( Signal.lift, f, keysDown ); + keysDown.defaultNumberOfKids += 1; + signal.defaultNumberOfKids = 0; + return signal; + } + + function dir(up, down, left, right) { + function f(ks) { + var x = 0, y = 0; + while (ks.ctor == "Cons") { + switch (ks._0) { + case left : --x; break; + case right: ++x; break; + case up : ++y; break; + case down : --y; break; + } + ks = ks._1; + } + return { _:{}, x:x, y:y }; + } + return keySignal(f); + } + + function is(key) { return keySignal(NList.member(key)); } + + return elm.Native.Keyboard = { + isDown:is, + directions:F4(dir), + keysDown:keysDown, + lastPressed:lastKey + }; + +}; + +Elm.Native.Http = function(elm) { + 'use strict'; + elm.Native = elm.Native || {}; + if (elm.Native.Http) return elm.Native.Http; + + + var JS = Elm.JavaScript(elm); + var List = Elm.List(elm); + var Signal = Elm.Signal(elm); + + + function registerReq(queue,responses) { return function(req) { + if (req.url !== "") { sendReq(queue,responses,req); } + }; + } + + function updateQueue(queue,responses) { + if (queue.length > 0) { + elm.notify(responses.id, queue[0].value); + if (queue[0].value.ctor !== 'Waiting') { + queue.shift(); + setTimeout(function() { updateQueue(queue,responses); }, 0); + } + } + } + + function setHeader(pair) { + request.setRequestHeader( JS.fomString(pair._0), JS.fromString(pair._1) ); + } + + function sendReq(queue,responses,req) { + var response = { value: { ctor:'Waiting' } }; + queue.push(response); + + var request = null; + if (window.ActiveXObject) { request = new ActiveXObject("Microsoft.XMLHTTP"); } + if (window.XMLHttpRequest) { request = new XMLHttpRequest(); } + request.onreadystatechange = function(e) { + if (request.readyState === 4) { + response.value = (request.status === 200 ? + { ctor:'Success', _0:JS.toString(request.responseText) } : + { ctor:'Failure', _0:request.status, _1:JS.toString(request.statusText) }); + setTimeout(function() { updateQueue(queue,responses); }, 0); + } + }; + request.open(JS.fromString(req.verb), JS.fromString(req.url), true); + List.map(setHeader)(req.headers); + request.send(JS.fromString(req.body)); + } + + function send(requests) { + var responses = Signal.constant(elm.Http.Waiting); + var sender = A2( Signal.lift, registerReq([],responses), requests ); + function f(x) { return function(y) { return x; } } + return A3( Signal.lift2, f, responses, sender ); + } + + return elm.Native.Http = {send:send}; + +}; + +Elm.Native.Graphics.Input = function(elm) { + "use strict"; + + elm.Native = elm.Native || {}; + elm.Native.Graphics = elm.Native.Graphics || {}; + if (elm.Native.Graphics.Input) return elm.Native.Graphics.Input; + + var Render = ElmRuntime.use(ElmRuntime.Render.Element); + var Utils = ElmRuntime.use(ElmRuntime.Render.Utils); + var newNode = Utils.newElement, fromString = Utils.fromString, + toString = Utils.toString; + + var Signal = Elm.Signal(elm); + var newElement = Elm.Graphics.Element(elm).newElement; + + function buttons(defaultValue) { + var events = Signal.constant(defaultValue); + + function render(model) { + var b = newNode('button'); + b.style.display = 'block'; + b.elmEvent = model.event; + function click() { elm.notify(events.id, b.elmEvent); } + b.addEventListener('click', click); + b.innerHTML = model.text; + return b; + } + + function update(node, oldModel, newModel) { + node.elmEvent = newModel.event; + var txt = newModel.text; + if (oldModel.text !== txt) node.innerHTML = txt; + } + + function button(evnt, txt) { + return A3(newElement, 100, 40, { + ctor: 'Custom', + type: 'Button', + render: render, + update: update, + model: { event:evnt, text:fromString(txt) } + }); + } + + return { _:{}, button:F2(button), events:events }; + } + + function customButtons(defaultValue) { + var events = Signal.constant(defaultValue); + + function render(model) { + var btn = newNode('div'); + btn.elmEvent = model.event; + + btn.elmUp = Render.render(model.up); + btn.elmHover = Render.render(model.hover); + btn.elmDown = Render.render(model.down); + + function replace(node) { + if (node !== btn.firstChild) btn.replaceChild(node, btn.firstChild); + } + var overCount = 0; + function over(e) { + if (overCount++ > 0) return; + replace(btn.elmHover); + } + function out(e) { + if (btn.contains(e.toElement || e.relatedTarget)) return; + overCount = 0; + replace(btn.elmUp); + } + function up() { + replace(btn.elmHover); + elm.notify(events.id, btn.elmEvent); + } + function down() { replace(btn.elmDown); } + btn.addEventListener('mouseover', over); + btn.addEventListener('mouseout' , out); + btn.addEventListener('mousedown', down); + btn.addEventListener('mouseup' , up); + + btn.appendChild(btn.elmUp); + return btn; + } + + function update(node, oldModel, newModel) { + node.elmEvent = newModel.event; + Render.update(node.elmUp, oldModel.up, newModel.up) + Render.update(node.elmHover, oldModel.hover, newModel.hover) + Render.update(node.elmDown, oldModel.down, newModel.down) + } + + function button(evnt, up, hover, down) { + return A3(newElement, + Math.max(up.props.width, hover.props.width, down.props.width), + Math.max(up.props.height, hover.props.height, down.props.height), + { ctor: 'Custom', + type: 'CustomButton', + render: render, + update: update, + model: { event:evnt, up:up, hover:hover, down:down } + }); + } + + return { _:{}, button:F4(button), events:events }; + } + + + function checkboxes(defaultValue) { + var events = Signal.constant(defaultValue); + + function render(model) { + var b = newNode('input'); + b.type = 'checkbox'; + b.checked = model.checked; + b.style.display = 'block'; + b.elmHandler = model.handler; + function change() { elm.notify(events.id, b.elmHandler(b.checked)); } + b.addEventListener('change', change); + return b; + } + + function update(node, oldModel, newModel) { + node.elmHandler = newModel.handler; + node.checked = newModel.checked; + return true; + } + + function box(handler, checked) { + return A3(newElement, 13, 13, { + ctor: 'Custom', + type: 'CheckBox', + render: render, + update: update, + model: { checked:checked, handler:handler } + }); + } + + return { _:{}, box:F2(box), events:events }; + } + + function mkTextPool(type) { return function fields(defaultValue) { + var events = Signal.constant(defaultValue); + + var state = null; + + function render(model) { + var field = newNode('input'); + field.elmHandler = model.handler; + + field.id = 'test'; + field.type = type; + field.placeholder = fromString(model.placeHolder); + field.value = fromString(model.state.string); + field.setSelectionRange(model.state.selectionStart, model.state.selectionEnd); + field.style.border = 'none'; + state = model.state; + + function update() { + var start = field.selectionStart, + end = field.selectionEnd; + if (field.selectionDirection === 'backward') { + start = end; + end = field.selectionStart; + } + state = { _:{}, + string:toString(field.value), + selectionStart:start, + selectionEnd:end }; + elm.notify(events.id, field.elmHandler(state)); + } + function mousedown() { + update(); + elm.node.addEventListener('mouseup', mouseup); + } + function mouseup() { + update(); + elm.node.removeEventListener('mouseup', mouseup) + } + field.addEventListener('keyup', update); + field.addEventListener('mousedown', mousedown); + + return field; + } + + function update(node, oldModel, newModel) { + node.elmHandler = newModel.handler; + if (state === newModel.state) return; + var newStr = fromString(newModel.state.string); + if (node.value !== newStr) node.value = newStr; + + var start = newModel.state.selectionStart; + var end = newModel.state.selectionEnd; + var direction = 'forward'; + if (end < start) { + start = end; + end = newModel.state.selectionStart; + direction = 'backward'; + } + + if (node.selectionStart !== start + || node.selectionEnd !== end + || node.selectionDirection !== direction) { + node.setSelectionRange(start, end, direction); + } + } + + function field(handler, placeHolder, state) { + return A3(newElement, 200, 30, + { ctor: 'Custom', + type: type + 'Input', + render: render, + update: update, + model: { handler:handler, + placeHolder:placeHolder, + state:state } + }); + } + + return { _:{}, field:F3(field), events:events }; + } + } + + return elm.Native.Graphics.Input = { + buttons:buttons, + customButtons:customButtons, + checkboxes:checkboxes, + fields:mkTextPool('text'), + emails:mkTextPool('email'), + passwords:mkTextPool('password') + }; + +}; + +Elm.Native.Graphics.Collage = function(elm) { + "use strict"; + + elm.Native = elm.Native || {}; + elm.Native.Graphics = elm.Native.Graphics || {}; + if (elm.Native.Graphics.Collage) return elm.Native.Graphics.Collage; + + var newElement = Elm.Graphics.Element(elm).newElement; + var C = ElmRuntime.use(ElmRuntime.Render.Collage); + + function collage(w,h,forms) { + return A3(newElement, w, h, { + ctor: 'Custom', + type: 'Collage', + render: C.render, + update: C.update, + model: {w:w, h:h, forms:forms} + }); + } + return elm.Native.Graphics.Collage = { collage:F3(collage) }; + +}; +Elm.Window = function(elm){ + var N = Elm.Native, _N = N.Utils(elm), _L = N.List(elm), _E = N.Error(elm), _str = N.JavaScript(elm).toString; + var $op = {}; + var W = Elm.Native.Window(elm); + elm.Native = elm.Native||{}; + var _ = elm.Native.Window||{}; + _.$op = {} + return elm.Window = _; + }; +Elm.WebSocket = function(elm){ + var N = Elm.Native, _N = N.Utils(elm), _L = N.List(elm), _E = N.Error(elm), _str = N.JavaScript(elm).toString; + var $op = {}; + var WS = Elm.Native.WebSocket(elm); + elm.Native = elm.Native||{}; + var _ = elm.Native.WebSocket||{}; + _.$op = {} + return elm.WebSocket = _; + }; +Elm.Touch = function(elm){ + var N = Elm.Native, _N = N.Utils(elm), _L = N.List(elm), _E = N.Error(elm), _str = N.JavaScript(elm).toString; + var $op = {}; + var T = Elm.Native.Touch(elm); + var Touch_0 = F6(function(x_1, y_2, id_3, x0_4, y0_5, t0_6){ + return { + _:{ + }, + id:id_3, + t0:t0_6, + x:x_1, + x0:x0_4, + y:y_2, + y0:y0_5};}); + elm.Native = elm.Native||{}; + var _ = elm.Native.Touch||{}; + _.$op = {}; + _.Touch = Touch_0 + return elm.Touch = _; + }; +Elm.Time = function(elm){ + var N = Elm.Native, _N = N.Utils(elm), _L = N.List(elm), _E = N.Error(elm), _str = N.JavaScript(elm).toString; + var $op = {}; + var T = Elm.Native.Time(elm); + var inMilliseconds_4 = function(t_8){ + return t_8;}; + var inSeconds_5 = function(t_9){ + return (t_9/second_1);}; + var inMinutes_6 = function(t_10){ + return (t_10/minute_2);}; + var inHours_7 = function(t_11){ + return (t_11/hour_3);}; + var millisecond_0 = 1; + var second_1 = (1000*millisecond_0); + var minute_2 = (60*second_1); + var hour_3 = (60*minute_2); + elm.Native = elm.Native||{}; + var _ = elm.Native.Time||{}; + _.$op = {}; + _.millisecond = millisecond_0; + _.second = second_1; + _.minute = minute_2; + _.hour = hour_3; + _.inMilliseconds = inMilliseconds_4; + _.inSeconds = inSeconds_5; + _.inMinutes = inMinutes_6; + _.inHours = inHours_7 + return elm.Time = _; + }; +Elm.Text = function(elm){ + var N = Elm.Native, _N = N.Utils(elm), _L = N.List(elm), _E = N.Error(elm), _str = N.JavaScript(elm).toString; + var $op = {}; + var T = Elm.Native.Text(elm); + elm.Native = elm.Native||{}; + var _ = elm.Native.Text||{}; + _.$op = {} + return elm.Text = _; + }; +Elm.Signal = function(elm){ + var N = Elm.Native, _N = N.Utils(elm), _L = N.List(elm), _E = N.Error(elm), _str = N.JavaScript(elm).toString; + var $op = {}; + var S = Elm.Native.Signal(elm); + var L = Elm.List(elm); + var combine_0 = A2(L.foldr, S.lift2(function(x_1){ + return function(y_2){ + return _L.Cons(x_1,y_2);};}), S.constant(_L.Nil)); + elm.Native = elm.Native||{}; + var _ = elm.Native.Signal||{}; + _.$op = {}; + _.combine = combine_0 + return elm.Signal = _; + }; +Elm.Set = function(elm){ + var N = Elm.Native, _N = N.Utils(elm), _L = N.List(elm), _E = N.Error(elm), _str = N.JavaScript(elm).toString; + var $op = {}; + var Dict = Elm.Dict(elm); + var List = Elm.List(elm); + var singleton_1 = function(k_13){ + return A2(Dict.singleton, k_13, {ctor:"Tuple0"});}; + var insert_2 = function(k_14){ + return A2(Dict.insert, k_14, {ctor:"Tuple0"});}; + var fromList_9 = function(xs_15){ + return A3(List.foldl, insert_2, empty_0, xs_15);}; + var foldl_10 = F3(function(f_16, b_17, s_18){ + return A3(Dict.foldl, function(k_19){ + return function(__20){ + return function(b_21){ + return A2(f_16, k_19, b_21);};};}, b_17, s_18);}); + var foldr_11 = F3(function(f_22, b_23, s_24){ + return A3(Dict.foldr, function(k_25){ + return function(__26){ + return function(b_27){ + return A2(f_22, k_25, b_27);};};}, b_23, s_24);}); + var map_12 = F2(function(f_28, s_29){ + return fromList_9(A2(List.map, f_28, toList_8(s_29)));}); + var empty_0 = Dict.empty; + var remove_3 = Dict.remove; + var member_4 = Dict.member; + var union_5 = Dict.union; + var intersect_6 = Dict.intersect; + var diff_7 = Dict.diff; + var toList_8 = Dict.keys; + elm.Native = elm.Native||{}; + var _ = elm.Native.Set||{}; + _.$op = {}; + _.empty = empty_0; + _.singleton = singleton_1; + _.insert = insert_2; + _.remove = remove_3; + _.member = member_4; + _.union = union_5; + _.intersect = intersect_6; + _.diff = diff_7; + _.toList = toList_8; + _.fromList = fromList_9; + _.foldl = foldl_10; + _.foldr = foldr_11; + _.map = map_12 + return elm.Set = _; + }; +Elm.Random = function(elm){ + var N = Elm.Native, _N = N.Utils(elm), _L = N.List(elm), _E = N.Error(elm), _str = N.JavaScript(elm).toString; + var $op = {}; + var R = Elm.Native.Random(elm); + elm.Native = elm.Native||{}; + var _ = elm.Native.Random||{}; + _.$op = {} + return elm.Random = _; + }; +Elm.Prelude = function(elm){ + var N = Elm.Native, _N = N.Utils(elm), _L = N.List(elm), _E = N.Error(elm), _str = N.JavaScript(elm).toString; + var $op = {}; + var N = Elm.Native.Prelude(elm); + var LT_5 = {ctor:"LT"}; + var EQ_6 = {ctor:"EQ"}; + var GT_7 = {ctor:"GT"}; + var radians_0 = function(t_9){ + return t_9;}; + var degrees_1 = function(d_10){ + return ((d_10*Math.PI)/180);}; + var turns_2 = function(r_11){ + return ((2*Math.PI)*r_11);}; + var fromPolar_3 = function(_22000_12){ + return function(){ + switch (_22000_12.ctor) { + case 'Tuple2': + return {ctor:"Tuple2", _0:(_22000_12._0*N.cos(_22000_12._1)), _1:(_22000_12._0*N.sin(_22000_12._1))}; + }_E.Case('Line 22, Column 20') }();}; + var toPolar_4 = function(_27000_15){ + return function(){ + switch (_27000_15.ctor) { + case 'Tuple2': + return {ctor:"Tuple2", _0:N.sqrt((Math.pow(_27000_15._0,2)+Math.pow(_27000_15._1,2))), _1:A2(N.atan2, _27000_15._1, _27000_15._0)}; + }_E.Case('Line 27, Column 18') }();}; + var otherwise_8 = true; + elm.Native = elm.Native||{}; + var _ = elm.Native.Prelude||{}; + _.$op = {}; + _.radians = radians_0; + _.degrees = degrees_1; + _.turns = turns_2; + _.fromPolar = fromPolar_3; + _.toPolar = toPolar_4; + _.LT = LT_5; + _.EQ = EQ_6; + _.GT = GT_7; + _.otherwise = otherwise_8 + return elm.Prelude = _; + }; +Elm.Mouse = function(elm){ + var N = Elm.Native, _N = N.Utils(elm), _L = N.List(elm), _E = N.Error(elm), _str = N.JavaScript(elm).toString; + var $op = {}; + var M = Elm.Native.Mouse(elm); + elm.Native = elm.Native||{}; + var _ = elm.Native.Mouse||{}; + _.$op = {} + return elm.Mouse = _; + }; +Elm.Maybe = function(elm){ + var N = Elm.Native, _N = N.Utils(elm), _L = N.List(elm), _E = N.Error(elm), _str = N.JavaScript(elm).toString; + var $op = {}; + var List = Elm.List(elm); + var Just_0 = function(a1){ + return {ctor:"Just", _0:a1};}; + var Nothing_1 = {ctor:"Nothing"}; + var maybe_2 = F3(function(b_7, f_8, m_9){ + return function(){ + switch (m_9.ctor) { + case 'Just': + return f_8(m_9._0); + case 'Nothing': + return b_7; + }_E.Case('Line 13, Column 15') }();}); + var cons_5 = F2(function(mx_12, xs_13){ + return A3(maybe_2, xs_13, function(x_14){ + return _L.Cons(x_14,xs_13);}, mx_12);}); + var isJust_3 = A2(maybe_2, false, function(__11){ + return true;}); + var isNothing_4 = function(x){ + return not(isJust_3(x));}; + var justs_6 = A2(List.foldr, cons_5, _L.Nil); + elm.Native = elm.Native||{}; + var _ = elm.Native.Maybe||{}; + _.$op = {}; + _.Just = Just_0; + _.Nothing = Nothing_1; + _.maybe = maybe_2; + _.isJust = isJust_3; + _.isNothing = isNothing_4; + _.cons = cons_5; + _.justs = justs_6 + return elm.Maybe = _; + }; +Elm.Matrix2D = function(elm){ + var N = Elm.Native, _N = N.Utils(elm), _L = N.List(elm), _E = N.Error(elm), _str = N.JavaScript(elm).toString; + var $op = {}; + var M = Elm.Native.Matrix2D(elm); + elm.Native = elm.Native||{}; + var _ = elm.Native.Matrix2D||{}; + _.$op = {} + return elm.Matrix2D = _; + }; +Elm.List = function(elm){ + var N = Elm.Native, _N = N.Utils(elm), _L = N.List(elm), _E = N.Error(elm), _str = N.JavaScript(elm).toString; + var $op = {}; + var _ = Elm.Native.Utils(elm); var Native = Native||{};Native.Utils = _; + var min = _.min, max = _.max; + var L = Elm.Native.List(elm); + var concatMap_0 = function(f_8){ + return function(x){ + return L.concat(A2(L.map, f_8, x));};}; + var partition_5 = F2(function(pred_13, lst_14){ + return function(){ + switch (lst_14.ctor) { + case 'Cons': + return function(){ + var _106000_17 = A2(partition_5, pred_13, lst_14._1); + var bs_18 = function(){ + switch (_106000_17.ctor) { + case 'Tuple2': + return _106000_17._0; + }_E.Case('Line 106, Column 30') }(); + var cs_19 = function(){ + switch (_106000_17.ctor) { + case 'Tuple2': + return _106000_17._1; + }_E.Case('Line 106, Column 30') }(); + return (pred_13(lst_14._0)?{ctor:"Tuple2", _0:_L.Cons(lst_14._0,bs_18), _1:cs_19}:{ctor:"Tuple2", _0:bs_18, _1:_L.Cons(lst_14._0,cs_19)});}(); + case 'Nil': + return {ctor:"Tuple2", _0:_L.Nil, _1:_L.Nil}; + }_E.Case('Line 104, Column 5') }();}); + var unzip_6 = function(pairs_24){ + return function(){ + switch (pairs_24.ctor) { + case 'Cons': + switch (pairs_24._0.ctor) { + case 'Tuple2': + return function(){ + var _127000_28 = unzip_6(pairs_24._1); + var xs_29 = function(){ + switch (_127000_28.ctor) { + case 'Tuple2': + return _127000_28._0; + }_E.Case('Line 127, Column 33') }(); + var ys_30 = function(){ + switch (_127000_28.ctor) { + case 'Tuple2': + return _127000_28._1; + }_E.Case('Line 127, Column 33') }(); + return {ctor:"Tuple2", _0:_L.Cons(pairs_24._0._0,xs_29), _1:_L.Cons(pairs_24._0._1,ys_30)};}(); + }break; + case 'Nil': + return {ctor:"Tuple2", _0:_L.Nil, _1:_L.Nil}; + }_E.Case('Line 125, Column 3') }();}; + var intersperse_7 = F2(function(sep_35, xs_36){ + return function(){ + switch (xs_36.ctor) { + case 'Cons': + switch (xs_36._1.ctor) { + case 'Cons': + return _L.Cons(xs_36._0,_L.Cons(sep_35,A2(intersperse_7, sep_35, _L.Cons(xs_36._1._0,xs_36._1._1)))); + case 'Nil': + return _L.Cons(xs_36._0,_L.Nil); + }break; + case 'Nil': + return _L.Nil; + }_E.Case('Line 145, Column 3') }();}); + var sum_1 = A2(L.foldl, function(x_9){ + return function(y_10){ + return (x_9+y_10);};}, 0); + var product_2 = A2(L.foldl, function(x_11){ + return function(y_12){ + return (x_11*y_12);};}, 1); + var maximum_3 = L.foldl1(max); + var minimum_4 = L.foldl1(min); + elm.Native = elm.Native||{}; + var _ = elm.Native.List||{}; + _.$op = {}; + _.concatMap = concatMap_0; + _.sum = sum_1; + _.product = product_2; + _.maximum = maximum_3; + _.minimum = minimum_4; + _.partition = partition_5; + _.unzip = unzip_6; + _.intersperse = intersperse_7 + return elm.List = _; + }; +Elm.Keyboard = function(elm){ + var N = Elm.Native, _N = N.Utils(elm), _L = N.List(elm), _E = N.Error(elm), _str = N.JavaScript(elm).toString; + var $op = {}; + var N = Elm.Native.Keyboard(elm); + var arrows_0 = A4(N.directions, 38, 40, 37, 39); + var wasd_1 = A4(N.directions, 87, 83, 65, 68); + var shift_2 = N.isDown(16); + var ctrl_3 = N.isDown(17); + var space_4 = N.isDown(32); + var enter_5 = N.isDown(13); + elm.Native = elm.Native||{}; + var _ = elm.Native.Keyboard||{}; + _.$op = {}; + _.arrows = arrows_0; + _.wasd = wasd_1; + _.shift = shift_2; + _.ctrl = ctrl_3; + _.space = space_4; + _.enter = enter_5 + return elm.Keyboard = _; + }; +Elm.Json = function(elm){ + var N = Elm.Native, _N = N.Utils(elm), _L = N.List(elm), _E = N.Error(elm), _str = N.JavaScript(elm).toString; + var $op = {}; + var Dict = Elm.Dict(elm); + var JS = Elm.JavaScript(elm); + var Native = Elm.Native.Json(elm); + var String_0 = function(a1){ + return {ctor:"String", _0:a1};}; + var Number_1 = function(a1){ + return {ctor:"Number", _0:a1};}; + var Boolean_2 = function(a1){ + return {ctor:"Boolean", _0:a1};}; + var Null_3 = {ctor:"Null"}; + var Array_4 = function(a1){ + return {ctor:"Array", _0:a1};}; + var Object_5 = function(a1){ + return {ctor:"Object", _0:a1};}; + var toString_6 = F2(function(sep_8, v_9){ + return JS.toString(A2(Native.toJSString, sep_8, v_9));}); + var fromString_7 = function(s_10){ + return Native.fromJSString(JS.fromString(s_10));}; + elm.Native = elm.Native||{}; + var _ = elm.Native.Json||{}; + _.$op = {}; + _.String = String_0; + _.Number = Number_1; + _.Boolean = Boolean_2; + _.Null = Null_3; + _.Array = Array_4; + _.Object = Object_5; + _.toString = toString_6; + _.fromString = fromString_7 + return elm.Json = _; + }; +Elm.JavaScript = function(elm){ + var N = Elm.Native, _N = N.Utils(elm), _L = N.List(elm), _E = N.Error(elm), _str = N.JavaScript(elm).toString; + var $op = {}; + elm.Native = elm.Native||{}; + var _ = elm.Native.JavaScript||{}; + _.$op = {} + return elm.JavaScript = _; + }; +Elm.Http = function(elm){ + var N = Elm.Native, _N = N.Utils(elm), _L = N.List(elm), _E = N.Error(elm), _str = N.JavaScript(elm).toString; + var $op = {}; + var _ = Elm.Native.Http(elm); var Native = Native||{};Native.Http = _; + var send = _.send; + var _ = Elm.Signal(elm); var Signal = _; + var lift = _.lift; + var Success_0 = function(a1){ + return {ctor:"Success", _0:a1};}; + var Waiting_1 = {ctor:"Waiting"}; + var Failure_2 = F2(function(a1, a2){ + return {ctor:"Failure", _0:a1, _1:a2};}); + var Request_3 = F4(function(verb_8, url_9, body_10, headers_11){ + return { + _:{ + }, + body:body_10, + headers:headers_11, + url:url_9, + verb:verb_8};}); + var get_5 = function(url_12){ + return A4(Request_3, _str('GET'), url_12, _str(''), _L.Nil);}; + var post_6 = F2(function(url_13, body_14){ + return A4(Request_3, _str('POST'), url_13, body_14, _L.Nil);}); + var sendGet_7 = function(reqs_15){ + return send(A2(lift, get_5, reqs_15));}; + var request_4 = Request_3; + elm.Native = elm.Native||{}; + var _ = elm.Native.Http||{}; + _.$op = {}; + _.Success = Success_0; + _.Waiting = Waiting_1; + _.Failure = Failure_2; + _.Request = Request_3; + _.request = request_4; + _.get = get_5; + _.post = post_6; + _.sendGet = sendGet_7 + return elm.Http = _; + }; +Elm.Either = function(elm){ + var N = Elm.Native, _N = N.Utils(elm), _L = N.List(elm), _E = N.Error(elm), _str = N.JavaScript(elm).toString; + var $op = {}; + var _ = Elm.List(elm); var List = _; + var Left_0 = function(a1){ + return {ctor:"Left", _0:a1};}; + var Right_1 = function(a1){ + return {ctor:"Right", _0:a1};}; + var either_2 = F3(function(f_11, g_12, e_13){ + return function(){ + switch (e_13.ctor) { + case 'Left': + return f_11(e_13._0); + case 'Right': + return g_12(e_13._0); + }_E.Case('Line 15, Column 16') }();}); + var isLeft_3 = function(e_16){ + return function(){ + switch (e_16.ctor) { + case 'Left': + return true; + } + return false; }();}; + var isRight_4 = function(e_17){ + return function(){ + switch (e_17.ctor) { + case 'Right': + return true; + } + return false; }();}; + var lefts_5 = function(es_18){ + return A3(List.foldr, consLeft_8, _L.Nil, es_18);}; + var rights_6 = function(es_19){ + return A3(List.foldr, consRight_9, _L.Nil, es_19);}; + var partition_7 = function(es_20){ + return A3(List.foldr, consEither_10, {ctor:"Tuple2", _0:_L.Nil, _1:_L.Nil}, es_20);}; + var consLeft_8 = F2(function(e_21, vs_22){ + return function(){ + switch (e_21.ctor) { + case 'Left': + return _L.Cons(e_21._0,vs_22); + case 'Right': + return vs_22; + }_E.Case('Line 39, Column 5') }();}); + var consRight_9 = F2(function(e_24, vs_25){ + return function(){ + switch (e_24.ctor) { + case 'Left': + return vs_25; + case 'Right': + return _L.Cons(e_24._0,vs_25); + }_E.Case('Line 44, Column 5') }();}); + var consEither_10 = F2(function(e_27, _51000_28){ + return function(){ + switch (_51000_28.ctor) { + case 'Tuple2': + return function(){ + switch (e_27.ctor) { + case 'Left': + return {ctor:"Tuple2", _0:_L.Cons(e_27._0,_51000_28._0), _1:_51000_28._1}; + case 'Right': + return {ctor:"Tuple2", _0:_51000_28._0, _1:_L.Cons(e_27._0,_51000_28._1)}; + }_E.Case('Line 49, Column 5') }(); + }_E.Case('Line 49, Column 5') }();}); + elm.Native = elm.Native||{}; + var _ = elm.Native.Either||{}; + _.$op = {}; + _.Left = Left_0; + _.Right = Right_1; + _.either = either_2; + _.isLeft = isLeft_3; + _.isRight = isRight_4; + _.lefts = lefts_5; + _.rights = rights_6; + _.partition = partition_7; + _.consLeft = consLeft_8; + _.consRight = consRight_9; + _.consEither = consEither_10 + return elm.Either = _; + }; +Elm.Dict = function(elm){ + var N = Elm.Native, _N = N.Utils(elm), _L = N.List(elm), _E = N.Error(elm), _str = N.JavaScript(elm).toString; + var $op = {}; + var Maybe = Elm.Maybe(elm); + var Error = Elm.Native.Error(elm); + var List = Elm.List(elm); + var _ = Elm.Native.Utils(elm); var Native = Native||{};Native.Utils = _; + var compare = _.compare; + var Red_0 = {ctor:"Red"}; + var Black_1 = {ctor:"Black"}; + var RBNode_2 = F5(function(a1, a2, a3, a4, a5){ + return {ctor:"RBNode", _0:a1, _1:a2, _2:a3, _3:a4, _4:a5};}); + var RBEmpty_3 = {ctor:"RBEmpty"}; + var min_5 = function(t_41){ + return function(){ + switch (t_41.ctor) { + case 'RBEmpty': + return Error.raise(_str('(min Empty) is not defined')); + case 'RBNode': + switch (t_41._3.ctor) { + case 'RBEmpty': + return {ctor:"Tuple2", _0:t_41._1, _1:t_41._2}; + } + return min_5(t_41._3); + }_E.Case('Line 104, Column 3') }();}; + var lookup_6 = F2(function(k_45, t_46){ + return function(){ + switch (t_46.ctor) { + case 'RBEmpty': + return Maybe.Nothing; + case 'RBNode': + return function(){ + var case12 = A2(compare, k_45, t_46._1); + switch (case12.ctor) { + case 'EQ': + return Maybe.Just(t_46._2); + case 'GT': + return A2(lookup_6, k_45, t_46._4); + case 'LT': + return A2(lookup_6, k_45, t_46._3); + }_E.Case('Line 124, Column 5') }(); + }_E.Case('Line 121, Column 2') }();}); + var findWithDefault_7 = F3(function(base_51, k_52, t_53){ + return function(){ + switch (t_53.ctor) { + case 'RBEmpty': + return base_51; + case 'RBNode': + return function(){ + var case19 = A2(compare, k_52, t_53._1); + switch (case19.ctor) { + case 'EQ': + return t_53._2; + case 'GT': + return A3(findWithDefault_7, base_51, k_52, t_53._4); + case 'LT': + return A3(findWithDefault_7, base_51, k_52, t_53._3); + }_E.Case('Line 136, Column 5') }(); + }_E.Case('Line 133, Column 2') }();}); + var member_8 = F2(function(k_58, t_59){ + return Maybe.isJust(A2(lookup_6, k_58, t_59));}); + var rotateLeft_9 = function(t_60){ + return function(){ + switch (t_60.ctor) { + case 'RBNode': + switch (t_60._4.ctor) { + case 'RBNode': + return A5(RBNode_2, t_60._0, t_60._4._1, t_60._4._2, A5(RBNode_2, Red_0, t_60._1, t_60._2, t_60._3, t_60._4._3), t_60._4._4); + }break; + } + return Error.raise(_str('rotateLeft of a node without enough children')); }();}; + var rotateRight_10 = function(t_70){ + return function(){ + switch (t_70.ctor) { + case 'RBNode': + switch (t_70._3.ctor) { + case 'RBNode': + return A5(RBNode_2, t_70._0, t_70._3._1, t_70._3._2, t_70._3._3, A5(RBNode_2, Red_0, t_70._1, t_70._2, t_70._3._4, t_70._4)); + }break; + } + return Error.raise(_str('rotateRight of a node without enough children')); }();}; + var rotateLeftIfNeeded_11 = function(t_80){ + return function(){ + switch (t_80.ctor) { + case 'RBNode': + switch (t_80._4.ctor) { + case 'RBNode': + switch (t_80._4._0.ctor) { + case 'Red': + return rotateLeft_9(t_80); + }break; + }break; + } + return t_80; }();}; + var rotateRightIfNeeded_12 = function(t_81){ + return function(){ + switch (t_81.ctor) { + case 'RBNode': + switch (t_81._3.ctor) { + case 'RBNode': + switch (t_81._3._0.ctor) { + case 'Red': + switch (t_81._3._3.ctor) { + case 'RBNode': + switch (t_81._3._3._0.ctor) { + case 'Red': + return rotateRight_10(t_81); + }break; + }break; + }break; + }break; + } + return t_81; }();}; + var otherColor_13 = function(c_82){ + return function(){ + switch (c_82.ctor) { + case 'Black': + return Red_0; + case 'Red': + return Black_1; + }_E.Case('Line 185, Column 16') }();}; + var color_flip_14 = function(t_83){ + return function(){ + switch (t_83.ctor) { + case 'RBNode': + switch (t_83._3.ctor) { + case 'RBNode': + switch (t_83._4.ctor) { + case 'RBNode': + return A5(RBNode_2, otherColor_13(t_83._0), t_83._1, t_83._2, A5(RBNode_2, otherColor_13(t_83._3._0), t_83._3._1, t_83._3._2, t_83._3._3, t_83._3._4), A5(RBNode_2, otherColor_13(t_83._4._0), t_83._4._1, t_83._4._2, t_83._4._3, t_83._4._4)); + }break; + }break; + } + return Error.raise(_str('color_flip called on a Empty or Node with a Empty child')); }();}; + var color_flipIfNeeded_15 = function(t_97){ + return function(){ + switch (t_97.ctor) { + case 'RBNode': + switch (t_97._3.ctor) { + case 'RBNode': + switch (t_97._3._0.ctor) { + case 'Red': + switch (t_97._4.ctor) { + case 'RBNode': + switch (t_97._4._0.ctor) { + case 'Red': + return color_flip_14(t_97); + }break; + }break; + }break; + }break; + } + return t_97; }();}; + var fixUp_16 = function(t_98){ + return color_flipIfNeeded_15(rotateRightIfNeeded_12(rotateLeftIfNeeded_11(t_98)));}; + var ensureBlackRoot_17 = function(t_99){ + return function(){ + switch (t_99.ctor) { + case 'RBNode': + switch (t_99._0.ctor) { + case 'Red': + return A5(RBNode_2, Black_1, t_99._1, t_99._2, t_99._3, t_99._4); + }break; + } + return t_99; }();}; + var insert_18 = F3(function(k_104, v_105, t_106){ + return function(){ + var ins_107 = function(t_108){ + return function(){ + switch (t_108.ctor) { + case 'RBEmpty': + return A5(RBNode_2, Red_0, k_104, v_105, RBEmpty_3, RBEmpty_3); + case 'RBNode': + return function(){ + var h_114 = function(){ + var case114 = A2(compare, k_104, t_108._1); + switch (case114.ctor) { + case 'EQ': + return A5(RBNode_2, t_108._0, t_108._1, v_105, t_108._3, t_108._4); + case 'GT': + return A5(RBNode_2, t_108._0, t_108._1, t_108._2, t_108._3, ins_107(t_108._4)); + case 'LT': + return A5(RBNode_2, t_108._0, t_108._1, t_108._2, ins_107(t_108._3), t_108._4); + }_E.Case('Line 218, Column 19') }(); + return fixUp_16(h_114);}(); + }_E.Case('Line 215, Column 7') }();}; + return ensureBlackRoot_17(ins_107(t_106));}();}); + var singleton_19 = F2(function(k_115, v_116){ + return A3(insert_18, k_115, v_116, RBEmpty_3);}); + var isRed_20 = function(t_117){ + return function(){ + switch (t_117.ctor) { + case 'RBNode': + switch (t_117._0.ctor) { + case 'Red': + return true; + }break; + } + return false; }();}; + var isRedLeft_21 = function(t_118){ + return function(){ + switch (t_118.ctor) { + case 'RBNode': + switch (t_118._3.ctor) { + case 'RBNode': + switch (t_118._3._0.ctor) { + case 'Red': + return true; + }break; + }break; + } + return false; }();}; + var isRedLeftLeft_22 = function(t_119){ + return function(){ + switch (t_119.ctor) { + case 'RBNode': + switch (t_119._3.ctor) { + case 'RBNode': + switch (t_119._3._3.ctor) { + case 'RBNode': + switch (t_119._3._3._0.ctor) { + case 'Red': + return true; + }break; + }break; + }break; + } + return false; }();}; + var isRedRight_23 = function(t_120){ + return function(){ + switch (t_120.ctor) { + case 'RBNode': + switch (t_120._4.ctor) { + case 'RBNode': + switch (t_120._4._0.ctor) { + case 'Red': + return true; + }break; + }break; + } + return false; }();}; + var isRedRightLeft_24 = function(t_121){ + return function(){ + switch (t_121.ctor) { + case 'RBNode': + switch (t_121._4.ctor) { + case 'RBNode': + switch (t_121._4._3.ctor) { + case 'RBNode': + switch (t_121._4._3._0.ctor) { + case 'Red': + return true; + }break; + }break; + }break; + } + return false; }();}; + var moveRedLeft_25 = function(t_122){ + return function(){ + var t$_123 = color_flip_14(t_122); + return function(){ + switch (t$_123.ctor) { + case 'RBNode': + return function(){ + switch (t$_123._4.ctor) { + case 'RBNode': + switch (t$_123._4._3.ctor) { + case 'RBNode': + switch (t$_123._4._3._0.ctor) { + case 'Red': + return color_flip_14(rotateLeft_9(A5(RBNode_2, t$_123._0, t$_123._1, t$_123._2, t$_123._3, rotateRight_10(t$_123._4)))); + }break; + }break; + } + return t$_123; }(); + } + return t$_123; }();}();}; + var moveRedRight_26 = function(t_129){ + return function(){ + var t$_130 = color_flip_14(t_129); + return (isRedLeftLeft_22(t$_130)?color_flip_14(rotateRight_10(t$_130)):t$_130);}();}; + var moveRedLeftIfNeeded_27 = function(t_131){ + return ((isRedLeft_21(t_131)||isRedLeftLeft_22(t_131))?t_131:moveRedLeft_25(t_131));}; + var moveRedRightIfNeeded_28 = function(t_132){ + return ((isRedRight_23(t_132)||isRedRightLeft_24(t_132))?t_132:moveRedRight_26(t_132));}; + var deleteMin_29 = function(t_133){ + return function(){ + var del_134 = function(t_135){ + return function(){ + switch (t_135.ctor) { + case 'RBNode': + switch (t_135._3.ctor) { + case 'RBEmpty': + return RBEmpty_3; + }break; + } + return function(){ + var case198 = moveRedLeftIfNeeded_27(t_135); + switch (case198.ctor) { + case 'RBEmpty': + return RBEmpty_3; + case 'RBNode': + return fixUp_16(A5(RBNode_2, case198._0, case198._1, case198._2, del_134(case198._3), case198._4)); + }_E.Case('Line 296, Column 12') }(); }();}; + return ensureBlackRoot_17(del_134(t_133));}();}; + var remove_30 = F2(function(k_141, t_142){ + return function(){ + var eq_and_noRightNode_143 = function(t_149){ + return function(){ + switch (t_149.ctor) { + case 'RBNode': + switch (t_149._4.ctor) { + case 'RBEmpty': + return _N.eq(k_141,t_149._1); + }break; + } + return false; }();}; + var eq_144 = function(t_151){ + return function(){ + switch (t_151.ctor) { + case 'RBNode': + return _N.eq(k_141,t_151._1); + } + return false; }();}; + var delLT_145 = function(t_153){ + return function(){ + var case216 = moveRedLeftIfNeeded_27(t_153); + switch (case216.ctor) { + case 'RBEmpty': + return Error.raise(_str('delLT on Empty')); + case 'RBNode': + return fixUp_16(A5(RBNode_2, case216._0, case216._1, case216._2, del_148(case216._3), case216._4)); + }_E.Case('Line 321, Column 17') }();}; + var delEQ_146 = function(t_159){ + return function(){ + switch (t_159.ctor) { + case 'RBEmpty': + return Error.raise(_str('delEQ called on a Empty')); + case 'RBNode': + return function(){ + var _325000_163 = min_5(t_159._4); + var k$_164 = function(){ + switch (_325000_163.ctor) { + case 'Tuple2': + return _325000_163._0; + }_E.Case('Line 325, Column 53') }(); + var v$_165 = function(){ + switch (_325000_163.ctor) { + case 'Tuple2': + return _325000_163._1; + }_E.Case('Line 325, Column 53') }(); + return fixUp_16(A5(RBNode_2, t_159._0, k$_164, v$_165, t_159._3, deleteMin_29(t_159._4)));}(); + }_E.Case('Line 324, Column 17') }();}; + var delGT_147 = function(t_170){ + return function(){ + switch (t_170.ctor) { + case 'RBEmpty': + return Error.raise(_str('delGT called on a Empty')); + case 'RBNode': + return fixUp_16(A5(RBNode_2, t_170._0, t_170._1, t_170._2, t_170._3, del_148(t_170._4))); + }_E.Case('Line 328, Column 17') }();}; + var del_148 = function(t_176){ + return function(){ + switch (t_176.ctor) { + case 'RBEmpty': + return RBEmpty_3; + case 'RBNode': + return ((_N.cmp(k_141,t_176._1).ctor==='LT')?delLT_145(t_176):function(){ + var u_178 = (isRedLeft_21(t_176)?rotateRight_10(t_176):t_176); + return (eq_and_noRightNode_143(u_178)?RBEmpty_3:function(){ + var t$_179 = moveRedRightIfNeeded_28(t_176); + return (eq_144(t$_179)?delEQ_146(t$_179):delGT_147(t$_179));}());}()); + }_E.Case('Line 331, Column 15') }();}; + return (A2(member_8, k_141, t_142)?ensureBlackRoot_17(del_148(t_142)):t_142);}();}); + var map_31 = F2(function(f_180, t_181){ + return function(){ + switch (t_181.ctor) { + case 'RBEmpty': + return RBEmpty_3; + case 'RBNode': + return A5(RBNode_2, t_181._0, t_181._1, f_180(t_181._2), A2(map_31, f_180, t_181._3), A2(map_31, f_180, t_181._4)); + }_E.Case('Line 351, Column 3') }();}); + var foldl_32 = F3(function(f_187, acc_188, t_189){ + return function(){ + switch (t_189.ctor) { + case 'RBEmpty': + return acc_188; + case 'RBNode': + return A3(foldl_32, f_187, A3(f_187, t_189._1, t_189._2, A3(foldl_32, f_187, acc_188, t_189._3)), t_189._4); + }_E.Case('Line 359, Column 3') }();}); + var foldr_33 = F3(function(f_194, acc_195, t_196){ + return function(){ + switch (t_196.ctor) { + case 'RBEmpty': + return acc_195; + case 'RBNode': + return A3(foldr_33, f_194, A3(f_194, t_196._1, t_196._2, A3(foldr_33, f_194, acc_195, t_196._4)), t_196._3); + }_E.Case('Line 367, Column 3') }();}); + var union_34 = F2(function(t1_201, t2_202){ + return A3(foldl_32, insert_18, t2_202, t1_201);}); + var intersect_35 = F2(function(t1_203, t2_204){ + return function(){ + var combine_205 = F3(function(k_206, v_207, t_208){ + return (A2(member_8, k_206, t2_204)?A3(insert_18, k_206, v_207, t_208):t_208);}); + return A3(foldl_32, combine_205, empty_4, t1_203);}();}); + var diff_36 = F2(function(t1_209, t2_210){ + return A3(foldl_32, function(k_211){ + return function(v_212){ + return function(t_213){ + return A2(remove_30, k_211, t_213);};};}, t1_209, t2_210);}); + var keys_37 = function(t_214){ + return A3(foldr_33, function(k_215){ + return function(v_216){ + return function(acc_217){ + return _L.Cons(k_215,acc_217);};};}, _L.Nil, t_214);}; + var values_38 = function(t_218){ + return A3(foldr_33, function(k_219){ + return function(v_220){ + return function(acc_221){ + return _L.Cons(v_220,acc_221);};};}, _L.Nil, t_218);}; + var toList_39 = function(t_222){ + return A3(foldr_33, function(k_223){ + return function(v_224){ + return function(acc_225){ + return _L.Cons({ctor:"Tuple2", _0:k_223, _1:v_224},acc_225);};};}, _L.Nil, t_222);}; + var fromList_40 = function(assocs_226){ + return A3(List.foldl, function(_0_227){ + return function(){ + switch (_0_227.ctor) { + case 'Tuple2': + return function(d_230){ + return A3(insert_18, _0_227._0, _0_227._1, d_230);}; + }_E.Case('Line 402, Column 43') }();}, empty_4, assocs_226);}; + var empty_4 = RBEmpty_3; + elm.Native = elm.Native||{}; + var _ = elm.Native.Dict||{}; + _.$op = {}; + _.empty = empty_4; + _.lookup = lookup_6; + _.findWithDefault = findWithDefault_7; + _.member = member_8; + _.insert = insert_18; + _.singleton = singleton_19; + _.remove = remove_30; + _.map = map_31; + _.foldl = foldl_32; + _.foldr = foldr_33; + _.union = union_34; + _.intersect = intersect_35; + _.diff = diff_36; + _.keys = keys_37; + _.values = values_38; + _.toList = toList_39; + _.fromList = fromList_40 + return elm.Dict = _; + }; +Elm.Date = function(elm){ + var N = Elm.Native, _N = N.Utils(elm), _L = N.List(elm), _E = N.Error(elm), _str = N.JavaScript(elm).toString; + var $op = {}; + var Mon_0 = {ctor:"Mon"}; + var Tue_1 = {ctor:"Tue"}; + var Wed_2 = {ctor:"Wed"}; + var Thu_3 = {ctor:"Thu"}; + var Fri_4 = {ctor:"Fri"}; + var Sat_5 = {ctor:"Sat"}; + var Sun_6 = {ctor:"Sun"}; + var Jan_7 = {ctor:"Jan"}; + var Feb_8 = {ctor:"Feb"}; + var Mar_9 = {ctor:"Mar"}; + var Apr_10 = {ctor:"Apr"}; + var May_11 = {ctor:"May"}; + var Jun_12 = {ctor:"Jun"}; + var Jul_13 = {ctor:"Jul"}; + var Aug_14 = {ctor:"Aug"}; + var Sep_15 = {ctor:"Sep"}; + var Oct_16 = {ctor:"Oct"}; + var Nov_17 = {ctor:"Nov"}; + var Dec_18 = {ctor:"Dec"}; + elm.Native = elm.Native||{}; + var _ = elm.Native.Date||{}; + _.$op = {}; + _.Mon = Mon_0; + _.Tue = Tue_1; + _.Wed = Wed_2; + _.Thu = Thu_3; + _.Fri = Fri_4; + _.Sat = Sat_5; + _.Sun = Sun_6; + _.Jan = Jan_7; + _.Feb = Feb_8; + _.Mar = Mar_9; + _.Apr = Apr_10; + _.May = May_11; + _.Jun = Jun_12; + _.Jul = Jul_13; + _.Aug = Aug_14; + _.Sep = Sep_15; + _.Oct = Oct_16; + _.Nov = Nov_17; + _.Dec = Dec_18 + return elm.Date = _; + }; +Elm.Color = function(elm){ + var N = Elm.Native, _N = N.Utils(elm), _L = N.List(elm), _E = N.Error(elm), _str = N.JavaScript(elm).toString; + var $op = {}; + var Color_0 = F4(function(a1, a2, a3, a4){ + return {ctor:"Color", _0:a1, _1:a2, _2:a3, _3:a4};}); + var Linear_20 = F3(function(a1, a2, a3){ + return {ctor:"Linear", _0:a1, _1:a2, _2:a3};}); + var Radial_21 = F5(function(a1, a2, a3, a4, a5){ + return {ctor:"Radial", _0:a1, _1:a2, _2:a3, _3:a4, _4:a5};}); + var rgb_2 = F3(function(r_24, g_25, b_26){ + return A4(Color_0, r_24, g_25, b_26, 1);}); + var rgba_1 = Color_0; + var red_3 = A4(Color_0, 255, 0, 0, 1); + var lime_4 = A4(Color_0, 0, 255, 0, 1); + var blue_5 = A4(Color_0, 0, 0, 255, 1); + var yellow_6 = A4(Color_0, 255, 255, 0, 1); + var cyan_7 = A4(Color_0, 0, 255, 255, 1); + var magenta_8 = A4(Color_0, 255, 0, 255, 1); + var black_9 = A4(Color_0, 0, 0, 0, 1); + var white_10 = A4(Color_0, 255, 255, 255, 1); + var gray_11 = A4(Color_0, 128, 128, 128, 1); + var grey_12 = A4(Color_0, 128, 128, 128, 1); + var maroon_13 = A4(Color_0, 128, 0, 0, 1); + var navy_14 = A4(Color_0, 0, 0, 128, 1); + var green_15 = A4(Color_0, 0, 128, 0, 1); + var teal_16 = A4(Color_0, 0, 128, 128, 1); + var purple_17 = A4(Color_0, 128, 0, 128, 1); + var violet_18 = A4(Color_0, 238, 130, 238, 1); + var forestGreen_19 = A4(Color_0, 34, 139, 34, 1); + var linear_22 = Linear_20; + var radial_23 = Radial_21; + elm.Native = elm.Native||{}; + var _ = elm.Native.Color||{}; + _.$op = {}; + _.Color = Color_0; + _.rgba = rgba_1; + _.rgb = rgb_2; + _.red = red_3; + _.lime = lime_4; + _.blue = blue_5; + _.yellow = yellow_6; + _.cyan = cyan_7; + _.magenta = magenta_8; + _.black = black_9; + _.white = white_10; + _.gray = gray_11; + _.grey = grey_12; + _.maroon = maroon_13; + _.navy = navy_14; + _.green = green_15; + _.teal = teal_16; + _.purple = purple_17; + _.violet = violet_18; + _.forestGreen = forestGreen_19; + _.Linear = Linear_20; + _.Radial = Radial_21; + _.linear = linear_22; + _.radial = radial_23 + return elm.Color = _; + }; +Elm.Char = function(elm){ + var N = Elm.Native, _N = N.Utils(elm), _L = N.List(elm), _E = N.Error(elm), _str = N.JavaScript(elm).toString; + var $op = {}; + var N = Elm.Native.Char(elm); + elm.Native = elm.Native||{}; + var _ = elm.Native.Char||{}; + _.$op = {} + return elm.Char = _; + }; +Elm.Automaton = function(elm){ + var N = Elm.Native, _N = N.Utils(elm), _L = N.List(elm), _E = N.Error(elm), _str = N.JavaScript(elm).toString; + var $op = {}; + var Step_0 = function(a1){ + return {ctor:"Step", _0:a1};}; + var run_1 = F3(function(_14000_12, base_13, inputs_14){ + return function(){ + switch (_14000_12.ctor) { + case 'Step': + return function(){ + var step_16 = F2(function(a_17, _13000_18){ + return function(){ + switch (_13000_18.ctor) { + case 'Tuple2': + switch (_13000_18._0.ctor) { + case 'Step': + return _13000_18._0._0(a_17); + }break; + }_E.Case('Line 13, Column 28') }();}); + return A2(lift, snd, A3(foldp, step_16, base_13, inputs_14));}(); + }_E.Case('Line 13, Column 3') }();}); + var step_2 = F2(function(a_20, _18000_21){ + return function(){ + switch (_18000_21.ctor) { + case 'Step': + return _18000_21._0(a_20); + }_E.Case('Line 18, Column 19') }();}); + $op['>>>'] = F2(function(f_23, g_24){ + return Step_0(function(a_25){ + return function(){ + var _23000_26 = A2(step_2, a_25, f_23); + var f$_27 = function(){ + switch (_23000_26.ctor) { + case 'Tuple2': + return _23000_26._0; + }_E.Case('Line 23, Column 29') }(); + var b_28 = function(){ + switch (_23000_26.ctor) { + case 'Tuple2': + return _23000_26._1; + }_E.Case('Line 23, Column 29') }(); + var _24000_29 = A2(step_2, b_28, g_24); + var g$_30 = function(){ + switch (_24000_29.ctor) { + case 'Tuple2': + return _24000_29._0; + }_E.Case('Line 24, Column 29') }(); + var c_31 = function(){ + switch (_24000_29.ctor) { + case 'Tuple2': + return _24000_29._1; + }_E.Case('Line 24, Column 29') }(); + return {ctor:"Tuple2", _0:$op['>>>'](f$_27)(g$_30), _1:c_31};}();});}); + $op['<<<'] = F2(function(g_40, f_41){ + return $op['>>>'](f_41)(g_40);}); + var combine_3 = function(autos_42){ + return Step_0(function(a_43){ + return function(){ + var _34000_44 = unzip(A2(map, step_2(a_43), autos_42)); + var autos$_45 = function(){ + switch (_34000_44.ctor) { + case 'Tuple2': + return _34000_44._0; + }_E.Case('Line 34, Column 34') }(); + var bs_46 = function(){ + switch (_34000_44.ctor) { + case 'Tuple2': + return _34000_44._1; + }_E.Case('Line 34, Column 34') }(); + return {ctor:"Tuple2", _0:combine_3(autos$_45), _1:bs_46};}();});}; + var pure_4 = function(f_51){ + return Step_0(function(x_52){ + return {ctor:"Tuple2", _0:pure_4(f_51), _1:f_51(x_52)};});}; + var state_5 = F2(function(s_53, f_54){ + return Step_0(function(x_55){ + return function(){ + var s$_56 = A2(f_54, x_55, s_53); + return {ctor:"Tuple2", _0:A2(state_5, s$_56, f_54), _1:s$_56};}();});}); + var hiddenState_6 = F2(function(s_57, f_58){ + return Step_0(function(x_59){ + return function(){ + var _58000_60 = A2(f_58, x_59, s_57); + var s$_61 = function(){ + switch (_58000_60.ctor) { + case 'Tuple2': + return _58000_60._0; + }_E.Case('Line 58, Column 46') }(); + var out_62 = function(){ + switch (_58000_60.ctor) { + case 'Tuple2': + return _58000_60._1; + }_E.Case('Line 58, Column 46') }(); + return {ctor:"Tuple2", _0:A2(hiddenState_6, s$_61, f_58), _1:out_62};}();});}); + var enqueue_9 = F2(function(x_69, _67000_70){ + return function(){ + switch (_67000_70.ctor) { + case 'Tuple2': + return {ctor:"Tuple2", _0:_L.Cons(x_69,_67000_70._0), _1:_67000_70._1}; + }_E.Case('Line 67, Column 22') }();}); + var dequeue_10 = function(q_73){ + return function(){ + switch (q_73.ctor) { + case 'Tuple2': + switch (q_73._0.ctor) { + case 'Nil': + switch (q_73._1.ctor) { + case 'Nil': + return Nothing; + }break; + } + switch (q_73._1.ctor) { + case 'Cons': + return Just({ctor:"Tuple2", _0:q_73._1._0, _1:{ctor:"Tuple2", _0:q_73._0, _1:q_73._1._1}}); + case 'Nil': + return enqueue_9({ctor:"Tuple2", _0:_L.Nil, _1:reverse(q_73._0)}); + }break; + }_E.Case('Line 68, Column 13') }();}; + var average_11 = function(k_78){ + return function(){ + var step_79 = F2(function(n_81, _78000_82){ + return function(){ + switch (_78000_82.ctor) { + case 'Tuple3': + return (_N.eq(_78000_82._1,k_78)?A2(stepFull_80, n_81, {ctor:"Tuple3", _0:_78000_82._0, _1:_78000_82._1, _2:_78000_82._2}):{ctor:"Tuple2", _0:{ctor:"Tuple3", _0:A2(enqueue_9, n_81, _78000_82._0), _1:(1+_78000_82._1), _2:(_78000_82._2+n_81)}, _1:((_78000_82._2+n_81)/(1+_78000_82._1))}); + }_E.Case('Line 77, Column 11') }();}); + var stepFull_80 = F2(function(n_86, _84000_87){ + return function(){ + switch (_84000_87.ctor) { + case 'Tuple3': + return function(){ + var case48 = dequeue_10(_84000_87._0); + switch (case48.ctor) { + case 'Just': + switch (case48._0.ctor) { + case 'Tuple2': + return function(){ + var sum$_93 = ((_84000_87._2+n_86)-case48._0._0); + return {ctor:"Tuple2", _0:{ctor:"Tuple3", _0:A2(enqueue_9, n_86, case48._0._1), _1:_84000_87._1, _2:sum$_93}, _1:(sum$_93/_84000_87._1)};}(); + }break; + case 'Nothing': + return {ctor:"Tuple2", _0:{ctor:"Tuple3", _0:_84000_87._0, _1:_84000_87._1, _2:_84000_87._2}, _1:0}; + }_E.Case('Line 80, Column 11') }(); + }_E.Case('Line 80, Column 11') }();}); + return A2(hiddenState_6, {ctor:"Tuple3", _0:empty_8, _1:0, _2:0}, step_79);}();}; + var count_7 = A2(state_5, 0, function(__67){ + return function(c_68){ + return (1+c_68);};}); + var empty_8 = {ctor:"Tuple2", _0:_L.Nil, _1:_L.Nil}; + elm.Native = elm.Native||{}; + var _ = elm.Native.Automaton||{}; + _.$op = {'>>>' : $op['>>>'], '<<<' : $op['<<<']}; + _.Step = Step_0; + _.run = run_1; + _.step = step_2; + _.combine = combine_3; + _.pure = pure_4; + _.state = state_5; + _.hiddenState = hiddenState_6; + _.count = count_7; + _.empty = empty_8; + _.enqueue = enqueue_9; + _.dequeue = dequeue_10; + _.average = average_11 + return elm.Automaton = _; + }; +Elm.JavaScript = Elm.JavaScript||{}; +Elm.JavaScript.Experimental = function(elm){ + var N = Elm.Native, _N = N.Utils(elm), _L = N.List(elm), _E = N.Error(elm), _str = N.JavaScript(elm).toString; + var $op = {}; + var JS = Elm.JavaScript(elm); + var toRecord_0 = JS.toRecord; + var fromRecord_1 = JS.fromRecord; + elm.Native = elm.Native||{}; + elm.Native.JavaScript = elm.Native.JavaScript||{}; + var _ = elm.Native.JavaScript.Experimental||{}; + _.$op = {}; + _.toRecord = toRecord_0; + _.fromRecord = fromRecord_1 + elm.JavaScript = elm.JavaScript||{}; + return elm.JavaScript.Experimental = _; + }; +Elm.Graphics = Elm.Graphics||{}; +Elm.Graphics.Input = function(elm){ + var N = Elm.Native, _N = N.Utils(elm), _L = N.List(elm), _E = N.Error(elm), _str = N.JavaScript(elm).toString; + var $op = {}; + var _ = Elm.Signal(elm); var Signal = _; + var lift = _.lift; + var N = Elm.Native.Graphics.Input(elm); + var id_0 = function(x_9){ + return x_9;}; + var button_1 = function(txt_10){ + return function(){ + var pool_11 = N.buttons({ctor:"Tuple0"}); + return {ctor:"Tuple2", _0:A2(pool_11.button, {ctor:"Tuple0"}, txt_10), _1:pool_11.events};}();}; + var customButton_2 = F3(function(up_12, hover_13, down_14){ + return function(){ + var pool_15 = N.customButtons({ctor:"Tuple0"}); + return {ctor:"Tuple2", _0:A4(pool_15.button, {ctor:"Tuple0"}, up_12, hover_13, down_14), _1:pool_15.events};}();}); + var checkbox_3 = function(b_16){ + return function(){ + var cbs_17 = N.checkboxes(b_16); + return {ctor:"Tuple2", _0:A2(lift, cbs_17.box(id_0), cbs_17.events), _1:cbs_17.events};}();}; + var FieldState_4 = F3(function(string_18, selectionStart_19, selectionEnd_20){ + return { + _:{ + }, + selectionEnd:selectionEnd_20, + selectionStart:selectionStart_19, + string:string_18};}); + var field_6 = function(placeHolder_21){ + return function(){ + var tfs_22 = N.fields(emptyFieldState_5); + return {ctor:"Tuple2", _0:A2(lift, A2(tfs_22.field, id_0, placeHolder_21), tfs_22.events), _1:A2(lift, function(__23){ + return __23.string;}, tfs_22.events)};}();}; + var password_7 = function(placeHolder_24){ + return function(){ + var tfs_25 = N.passwords(emptyFieldState_5); + return {ctor:"Tuple2", _0:A2(lift, A2(tfs_25.field, id_0, placeHolder_24), tfs_25.events), _1:A2(lift, function(__26){ + return __26.string;}, tfs_25.events)};}();}; + var email_8 = function(placeHolder_27){ + return function(){ + var tfs_28 = N.emails(emptyFieldState_5); + return {ctor:"Tuple2", _0:A2(lift, A2(tfs_28.field, id_0, placeHolder_27), tfs_28.events), _1:A2(lift, function(__29){ + return __29.string;}, tfs_28.events)};}();}; + var emptyFieldState_5 = { + _:{ + }, + selectionEnd:0, + selectionStart:0, + string:_str('')}; + elm.Native = elm.Native||{}; + elm.Native.Graphics = elm.Native.Graphics||{}; + var _ = elm.Native.Graphics.Input||{}; + _.$op = {}; + _.id = id_0; + _.button = button_1; + _.customButton = customButton_2; + _.checkbox = checkbox_3; + _.FieldState = FieldState_4; + _.emptyFieldState = emptyFieldState_5; + _.field = field_6; + _.password = password_7; + _.email = email_8 + elm.Graphics = elm.Graphics||{}; + return elm.Graphics.Input = _; + }; +Elm.Graphics = Elm.Graphics||{}; +Elm.Graphics.Element = function(elm){ + var N = Elm.Native, _N = N.Utils(elm), _L = N.List(elm), _E = N.Error(elm), _str = N.JavaScript(elm).toString; + var $op = {}; + var _ = Elm.Native.Utils(elm); var Native = Native||{};Native.Utils = _; + var guid = _.guid, max = _.max, htmlHeight = _.htmlHeight; + var JS = Elm.JavaScript(elm); + var List = Elm.List(elm); + var _ = Elm.Color(elm); var Color = _; + var _ = Elm.Maybe(elm); var Maybe = _; + var Just = _.Just, Nothing = _.Nothing; + var Image_13 = F4(function(a1, a2, a3, a4){ + return {ctor:"Image", _0:a1, _1:a2, _2:a3, _3:a4};}); + var Container_14 = F2(function(a1, a2){ + return {ctor:"Container", _0:a1, _1:a2};}); + var Flow_15 = F2(function(a1, a2){ + return {ctor:"Flow", _0:a1, _1:a2};}); + var Spacer_16 = {ctor:"Spacer"}; + var RawHtml_17 = function(a1){ + return {ctor:"RawHtml", _0:a1};}; + var Custom_18 = {ctor:"Custom"}; + var Plain_19 = {ctor:"Plain"}; + var Fitted_20 = {ctor:"Fitted"}; + var Cropped_21 = function(a1){ + return {ctor:"Cropped", _0:a1};}; + var P_25 = {ctor:"P"}; + var Z_26 = {ctor:"Z"}; + var N_27 = {ctor:"N"}; + var Absolute_28 = function(a1){ + return {ctor:"Absolute", _0:a1};}; + var Relative_29 = function(a1){ + return {ctor:"Relative", _0:a1};}; + var DUp_33 = {ctor:"DUp"}; + var DDown_34 = {ctor:"DDown"}; + var DLeft_35 = {ctor:"DLeft"}; + var DRight_36 = {ctor:"DRight"}; + var DIn_37 = {ctor:"DIn"}; + var DOut_38 = {ctor:"DOut"}; + var Properties_0 = F7(function(id_70, width_71, height_72, opacity_73, color_74, href_75, tag_76){ + return { + _:{ + }, + color:color_74, + height:height_72, + href:href_75, + id:id_70, + opacity:opacity_73, + tag:tag_76, + width:width_71};}); + var Element_1 = F2(function(props_77, element_78){ + return { + _:{ + }, + element:element_78, + props:props_77};}); + var widthOf_2 = function(e_79){ + return e_79.props.width;}; + var heightOf_3 = function(e_80){ + return e_80.props.height;}; + var sizeOf_4 = function(e_81){ + return {ctor:"Tuple2", _0:e_81.props.width, _1:e_81.props.height};}; + var width_5 = F2(function(nw_82, e_83){ + return function(){ + var p_84 = e_83.props; + var props_85 = function(){ + var case0 = e_83.element; + switch (case0.ctor) { + case 'Image': + return _N.replace([['height',((case0._2/case0._1)*nw_82)]], p_84); + case 'RawHtml': + return _N.replace([['height',function(){ + var _50000_89 = A2(htmlHeight, nw_82, case0._0); + var w_90 = function(){ + switch (_50000_89.ctor) { + case 'Tuple2': + return _50000_89._0; + }_E.Case('Line 50, Column 71') }(); + var h_91 = function(){ + switch (_50000_89.ctor) { + case 'Tuple2': + return _50000_89._1; + }_E.Case('Line 50, Column 71') }(); + return h_91;}()]], p_84); + } + return p_84; }(); + return { + _:{ + }, + element:e_83.element, + props:_N.replace([['width',nw_82]], props_85)};}();}); + var height_6 = F2(function(nh_96, e_97){ + return function(){ + var p_98 = e_97.props; + var props_99 = function(){ + var case12 = e_97.element; + switch (case12.ctor) { + case 'Image': + return _N.replace([['width',((case12._1/case12._2)*nh_96)]], p_98); + } + return p_98; }(); + return { + _:{ + }, + element:e_97.element, + props:_N.replace([['height',nh_96]], p_98)};}();}); + var opacity_7 = F2(function(o_102, e_103){ + return function(){ + var p_104 = e_103.props; + return { + _:{ + }, + element:e_103.element, + props:_N.replace([['opacity',o_102]], p_104)};}();}); + var color_8 = F2(function(c_105, e_106){ + return function(){ + var p_107 = e_106.props; + return { + _:{ + }, + element:e_106.element, + props:_N.replace([['color',Just(c_105)]], p_107)};}();}); + var tag_9 = F2(function(name_108, e_109){ + return function(){ + var p_110 = e_109.props; + return { + _:{ + }, + element:e_109.element, + props:_N.replace([['tag',JS.fromString(name_108)]], p_110)};}();}); + var link_10 = F2(function(href_111, e_112){ + return function(){ + var p_113 = e_112.props; + return { + _:{ + }, + element:e_112.element, + props:_N.replace([['href',JS.fromString(href_111)]], p_113)};}();}); + var newElement_12 = F3(function(w_114, h_115, e_116){ + return { + _:{ + }, + element:e_116, + props:A7(Properties_0, guid({ctor:"Tuple0"}), w_114, h_115, 1, Nothing, emptyStr_11, emptyStr_11)};}); + var image_22 = F3(function(w_117, h_118, src_119){ + return A3(newElement_12, w_117, h_118, A4(Image_13, Plain_19, w_117, h_118, JS.fromString(src_119)));}); + var fittedImage_23 = F3(function(w_120, h_121, src_122){ + return A3(newElement_12, w_120, h_121, A4(Image_13, Fitted_20, w_120, h_121, JS.fromString(src_122)));}); + var croppedImage_24 = F4(function(w_123, h_124, pos_125, src_126){ + return A3(newElement_12, w_123, h_124, A4(Image_13, Cropped_21(pos_125), w_123, h_124, JS.fromString(src_126)));}); + var Position_30 = F4(function(horizontal_127, vertical_128, x_129, y_130){ + return { + _:{ + }, + horizontal:horizontal_127, + vertical:vertical_128, + x:x_129, + y:y_130};}); + var container_31 = F4(function(w_131, h_132, pos_133, e_134){ + return A3(newElement_12, w_131, h_132, A2(Container_14, pos_133, e_134));}); + var spacer_32 = F2(function(w_135, h_136){ + return A3(newElement_12, w_135, h_136, Spacer_16);}); + var flow_39 = F2(function(dir_137, es_138){ + return function(){ + var ws_139 = A2(List.map, widthOf_2, es_138); + var hs_140 = A2(List.map, heightOf_3, es_138); + var newFlow_141 = F2(function(w_142, h_143){ + return A3(newElement_12, w_142, h_143, A2(Flow_15, dir_137, es_138));}); + return (_N.eq(es_138,_L.Nil)?A2(spacer_32, 0, 0):function(){ + switch (dir_137.ctor) { + case 'DDown': + return A2(newFlow_141, List.maximum(ws_139), List.sum(hs_140)); + case 'DIn': + return A2(newFlow_141, List.maximum(ws_139), List.maximum(hs_140)); + case 'DLeft': + return A2(newFlow_141, List.sum(ws_139), List.maximum(hs_140)); + case 'DOut': + return A2(newFlow_141, List.maximum(ws_139), List.maximum(hs_140)); + case 'DRight': + return A2(newFlow_141, List.sum(ws_139), List.maximum(hs_140)); + case 'DUp': + return A2(newFlow_141, List.maximum(ws_139), List.sum(hs_140)); + }_E.Case('Line 152, Column 3') }());}();}); + var above_40 = F2(function(hi_144, lo_145){ + return A3(newElement_12, A2(max, widthOf_2(hi_144), widthOf_2(lo_145)), (heightOf_3(hi_144)+heightOf_3(lo_145)), A2(Flow_15, DDown_34, _L.Cons(hi_144,_L.Cons(lo_145,_L.Nil))));}); + var below_41 = F2(function(lo_146, hi_147){ + return A3(newElement_12, A2(max, widthOf_2(hi_147), widthOf_2(lo_146)), (heightOf_3(hi_147)+heightOf_3(lo_146)), A2(Flow_15, DDown_34, _L.Cons(hi_147,_L.Cons(lo_146,_L.Nil))));}); + var beside_42 = F2(function(lft_148, rht_149){ + return A3(newElement_12, (widthOf_2(lft_148)+widthOf_2(rht_149)), A2(max, heightOf_3(lft_148), heightOf_3(rht_149)), A2(Flow_15, right_67, _L.Cons(lft_148,_L.Cons(rht_149,_L.Nil))));}); + var layers_43 = function(es_150){ + return function(){ + var ws_151 = A2(List.map, widthOf_2, es_150); + var hs_152 = A2(List.map, heightOf_3, es_150); + return A3(newElement_12, List.maximum(ws_151), List.maximum(hs_152), A2(Flow_15, DOut_38, es_150));}();}; + var middleAt_55 = F2(function(x_153, y_154){ + return { + _:{ + }, + horizontal:Z_26, + vertical:Z_26, + x:x_153, + y:y_154};}); + var topLeftAt_56 = F2(function(x_155, y_156){ + return { + _:{ + }, + horizontal:N_27, + vertical:P_25, + x:x_155, + y:y_156};}); + var topRightAt_57 = F2(function(x_157, y_158){ + return { + _:{ + }, + horizontal:P_25, + vertical:P_25, + x:x_157, + y:y_158};}); + var bottomLeftAt_58 = F2(function(x_159, y_160){ + return { + _:{ + }, + horizontal:N_27, + vertical:N_27, + x:x_159, + y:y_160};}); + var bottomRightAt_59 = F2(function(x_161, y_162){ + return { + _:{ + }, + horizontal:P_25, + vertical:N_27, + x:x_161, + y:y_162};}); + var midLeftAt_60 = F2(function(x_163, y_164){ + return { + _:{ + }, + horizontal:N_27, + vertical:Z_26, + x:x_163, + y:y_164};}); + var midRightAt_61 = F2(function(x_165, y_166){ + return { + _:{ + }, + horizontal:P_25, + vertical:Z_26, + x:x_165, + y:y_166};}); + var midTopAt_62 = F2(function(x_167, y_168){ + return { + _:{ + }, + horizontal:Z_26, + vertical:P_25, + x:x_167, + y:y_168};}); + var midBottomAt_63 = F2(function(x_169, y_170){ + return { + _:{ + }, + horizontal:Z_26, + vertical:N_27, + x:x_169, + y:y_170};}); + var emptyStr_11 = JS.fromString(_str('')); + var absolute_44 = Absolute_28; + var relative_45 = Relative_29; + var middle_46 = { + _:{ + }, + horizontal:Z_26, + vertical:Z_26, + x:Relative_29(0.5), + y:Relative_29(0.5)}; + var topLeft_47 = { + _:{ + }, + horizontal:N_27, + vertical:P_25, + x:Absolute_28(0), + y:Absolute_28(0)}; + var topRight_48 = _N.replace([['horizontal',P_25]], topLeft_47); + var bottomLeft_49 = _N.replace([['vertical',N_27]], topLeft_47); + var bottomRight_50 = _N.replace([['horizontal',P_25]], bottomLeft_49); + var midLeft_51 = _N.replace([['horizontal',N_27],['x',Absolute_28(0)]], middle_46); + var midRight_52 = _N.replace([['horizontal',P_25]], midLeft_51); + var midTop_53 = _N.replace([['vertical',P_25],['y',Absolute_28(0)]], middle_46); + var midBottom_54 = _N.replace([['vertical',N_27]], midTop_53); + var up_64 = DUp_33; + var down_65 = DDown_34; + var left_66 = DLeft_35; + var right_67 = DRight_36; + var inward_68 = DIn_37; + var outward_69 = DOut_38; + elm.Native = elm.Native||{}; + elm.Native.Graphics = elm.Native.Graphics||{}; + var _ = elm.Native.Graphics.Element||{}; + _.$op = {}; + _.widthOf = widthOf_2; + _.heightOf = heightOf_3; + _.sizeOf = sizeOf_4; + _.width = width_5; + _.height = height_6; + _.opacity = opacity_7; + _.color = color_8; + _.tag = tag_9; + _.link = link_10; + _.newElement = newElement_12; + _.image = image_22; + _.fittedImage = fittedImage_23; + _.croppedImage = croppedImage_24; + _.container = container_31; + _.spacer = spacer_32; + _.flow = flow_39; + _.above = above_40; + _.below = below_41; + _.beside = beside_42; + _.layers = layers_43; + _.absolute = absolute_44; + _.relative = relative_45; + _.middle = middle_46; + _.topLeft = topLeft_47; + _.topRight = topRight_48; + _.bottomLeft = bottomLeft_49; + _.bottomRight = bottomRight_50; + _.midLeft = midLeft_51; + _.midRight = midRight_52; + _.midTop = midTop_53; + _.midBottom = midBottom_54; + _.middleAt = middleAt_55; + _.topLeftAt = topLeftAt_56; + _.topRightAt = topRightAt_57; + _.bottomLeftAt = bottomLeftAt_58; + _.bottomRightAt = bottomRightAt_59; + _.midLeftAt = midLeftAt_60; + _.midRightAt = midRightAt_61; + _.midTopAt = midTopAt_62; + _.midBottomAt = midBottomAt_63; + _.up = up_64; + _.down = down_65; + _.left = left_66; + _.right = right_67; + _.inward = inward_68; + _.outward = outward_69 + elm.Graphics = elm.Graphics||{}; + return elm.Graphics.Element = _; + }; +Elm.Graphics = Elm.Graphics||{}; +Elm.Graphics.Collage = function(elm){ + var N = Elm.Native, _N = N.Utils(elm), _L = N.List(elm), _E = N.Error(elm), _str = N.JavaScript(elm).toString; + var $op = {}; + var _ = Elm.List(elm); var List = _; + var _ = Elm.Native.Utils(elm); var Native = Native||{};Native.Utils = _; + var toFloat = _.toFloat; + var _ = Elm.Either(elm); var Either = _; + var Matrix = Elm.Native.Matrix2D(elm); + var N = Elm.Native.Graphics.Collage(elm); + var _ = Elm.Graphics.Element(elm); var Graphics = Graphics||{};Graphics.Element = _; + var _ = Elm.Color(elm); var Color = _; + var Solid_1 = function(a1){ + return {ctor:"Solid", _0:a1};}; + var Texture_2 = function(a1){ + return {ctor:"Texture", _0:a1};}; + var Gradient_3 = function(a1){ + return {ctor:"Gradient", _0:a1};}; + var Flat_4 = {ctor:"Flat"}; + var Round_5 = {ctor:"Round"}; + var Padded_6 = {ctor:"Padded"}; + var Smooth_7 = {ctor:"Smooth"}; + var Sharp_8 = function(a1){ + return {ctor:"Sharp", _0:a1};}; + var Clipped_9 = {ctor:"Clipped"}; + var FPath_15 = F2(function(a1, a2){ + return {ctor:"FPath", _0:a1, _1:a2};}); + var FShape_16 = F2(function(a1, a2){ + return {ctor:"FShape", _0:a1, _1:a2};}); + var FImage_17 = F4(function(a1, a2, a3, a4){ + return {ctor:"FImage", _0:a1, _1:a2, _2:a3, _3:a4};}); + var FElement_18 = function(a1){ + return {ctor:"FElement", _0:a1};}; + var FGroup_19 = F2(function(a1, a2){ + return {ctor:"FGroup", _0:a1, _1:a2};}); + var Form_0 = F5(function(theta_44, scale_45, x_46, y_47, form_48){ + return { + _:{ + }, + form:form_48, + scale:scale_45, + theta:theta_44, + x:x_46, + y:y_47};}); + var LineStyle_10 = F6(function(color_49, width_50, cap_51, join_52, dashing_53, dashOffset_54){ + return { + _:{ + }, + cap:cap_51, + color:color_49, + dashOffset:dashOffset_54, + dashing:dashing_53, + join:join_52, + width:width_50};}); + var solid_12 = function(clr_55){ + return _N.replace([['color',clr_55]], defaultLine_11);}; + var dashed_13 = function(clr_56){ + return _N.replace([['color',clr_56],['dashing',_L.Cons(8,_L.Cons(4,_L.Nil))]], defaultLine_11);}; + var dotted_14 = function(clr_57){ + return _N.replace([['color',clr_57],['dashing',_L.Cons(3,_L.Cons(3,_L.Nil))]], defaultLine_11);}; + var form_20 = function(f_58){ + return { + _:{ + }, + form:f_58, + scale:1, + theta:0, + x:0, + y:0};}; + var fill_21 = F2(function(style_59, shape_60){ + return form_20(A2(FShape_16, Either.Right(style_59), shape_60));}); + var filled_22 = F2(function(color_61, shape_62){ + return A2(fill_21, Solid_1(color_61), shape_62);}); + var textured_23 = F2(function(src_63, shape_64){ + return A2(fill_21, Texture_2(src_63), shape_64);}); + var gradient_24 = F2(function(grad_65, shape_66){ + return A2(fill_21, Gradient_3(grad_65), shape_66);}); + var outlined_25 = F2(function(style_67, shape_68){ + return form_20(A2(FShape_16, Either.Left(style_67), shape_68));}); + var traced_26 = F2(function(style_69, path_70){ + return form_20(A2(FPath_15, style_69, path_70));}); + var sprite_27 = F4(function(w_71, h_72, pos_73, src_74){ + return form_20(A4(FImage_17, w_71, h_72, pos_73, src_74));}); + var toForm_28 = function(e_75){ + return form_20(FElement_18(e_75));}; + var group_29 = function(fs_76){ + return form_20(A2(FGroup_19, Matrix.identity, fs_76));}; + var groupTransform_30 = F2(function(matrix_77, fs_78){ + return form_20(A2(FGroup_19, matrix_77, fs_78));}); + var rotate_31 = F2(function(t_79, f_80){ + return _N.replace([['theta',(f_80.theta+t_79)]], f_80);}); + var scale_32 = F2(function(s_81, f_82){ + return _N.replace([['scale',(f_82.scale*s_81)]], f_82);}); + var move_33 = F2(function(_138000_83, f_84){ + return function(){ + switch (_138000_83.ctor) { + case 'Tuple2': + return _N.replace([['x',(f_84.x+_138000_83._0)],['y',(f_84.y+_138000_83._1)]], f_84); + }_E.Case('Line 138, Column 20') }();}); + var moveX_34 = F2(function(x_87, f_88){ + return _N.replace([['x',(f_88.x+x_87)]], f_88);}); + var moveY_35 = F2(function(y_89, f_90){ + return _N.replace([['y',(f_90.y+y_89)]], f_90);}); + var path_36 = function(ps_91){ + return ps_91;}; + var segment_37 = F2(function(p1_92, p2_93){ + return _L.Cons(p1_92,_L.Cons(p2_93,_L.Nil));}); + var polygon_38 = function(points_94){ + return points_94;}; + var rect_39 = F2(function(w_95, h_96){ + return _L.Cons({ctor:"Tuple2", _0:(0-(w_95/2)), _1:(0-(h_96/2))},_L.Cons({ctor:"Tuple2", _0:(0-(w_95/2)), _1:(h_96/2)},_L.Cons({ctor:"Tuple2", _0:(w_95/2), _1:(h_96/2)},_L.Cons({ctor:"Tuple2", _0:(w_95/2), _1:(0-(h_96/2))},_L.Nil))));}); + var square_40 = function(n_97){ + return A2(rect_39, w, h);}; + var oval_41 = F2(function(w_98, h_99){ + return function(){ + var n_100 = 50; + var t_101 = ((2*Math.PI)/n_100); + var hw_102 = (w_98/2); + var hh_103 = (h_99/2); + var f_104 = function(i_105){ + return {ctor:"Tuple2", _0:(hw_102*Math.cos((t_101*i_105))), _1:(hh_103*Math.sin((t_101*i_105)))};}; + return A2(List.map, f_104, _L.range(0,(n_100-1)));}();}); + var circle_42 = function(r_106){ + return A2(oval_41, (2*r_106), (2*r_106));}; + var ngon_43 = F2(function(n_107, r_108){ + return function(){ + var m_109 = toFloat(n_107); + var t_110 = ((2*Math.PI)/m_109); + var f_111 = function(i_112){ + return {ctor:"Tuple2", _0:(r_108*Math.cos((t_110*i_112))), _1:(r_108*Math.sin((t_110*i_112)))};}; + return A2(List.map, f_111, _L.range(0,(n_107-1)));}();}); + var defaultLine_11 = { + _:{ + }, + cap:Flat_4, + color:Color.black, + dashOffset:0, + dashing:_L.Nil, + join:Sharp_8(10), + width:1}; + elm.Native = elm.Native||{}; + elm.Native.Graphics = elm.Native.Graphics||{}; + var _ = elm.Native.Graphics.Collage||{}; + _.$op = {}; + _.Form = Form_0; + _.Solid = Solid_1; + _.Texture = Texture_2; + _.Gradient = Gradient_3; + _.Flat = Flat_4; + _.Round = Round_5; + _.Padded = Padded_6; + _.Smooth = Smooth_7; + _.Sharp = Sharp_8; + _.Clipped = Clipped_9; + _.LineStyle = LineStyle_10; + _.defaultLine = defaultLine_11; + _.solid = solid_12; + _.dashed = dashed_13; + _.dotted = dotted_14; + _.FPath = FPath_15; + _.FShape = FShape_16; + _.FImage = FImage_17; + _.FElement = FElement_18; + _.FGroup = FGroup_19; + _.form = form_20; + _.fill = fill_21; + _.filled = filled_22; + _.textured = textured_23; + _.gradient = gradient_24; + _.outlined = outlined_25; + _.traced = traced_26; + _.sprite = sprite_27; + _.toForm = toForm_28; + _.group = group_29; + _.groupTransform = groupTransform_30; + _.rotate = rotate_31; + _.scale = scale_32; + _.move = move_33; + _.moveX = moveX_34; + _.moveY = moveY_35; + _.path = path_36; + _.segment = segment_37; + _.polygon = polygon_38; + _.rect = rect_39; + _.square = square_40; + _.oval = oval_41; + _.circle = circle_42; + _.ngon = ngon_43 + elm.Graphics = elm.Graphics||{}; + return elm.Graphics.Collage = _; + }; +(function() { +'use strict'; + +ElmRuntime.Display = { FULLSCREEN: 0, COMPONENT: 1, NONE: 2 }; + +ElmRuntime.counter = 0; +ElmRuntime.guid = function() { return ElmRuntime.counter++; } + +ElmRuntime.use = function(M) { + if (typeof M === 'function') M = M(); + return M; +}; + +function isAlive(input) { + if (!('defaultNumberOfKids' in input)) return true; + var len = input.kids.length; + if (len === 0) return false; + if (len > input.defaultNumberOfKids) return true; + var alive = false; + for (var i = len; i--; ) { + alive = alive || isAlive(input.kids[i]); + } + return alive; +} + +ElmRuntime.filterDeadInputs = function(inputs) { + var temp = []; + for (var i = inputs.length; i--; ) { + if (isAlive(inputs[i])) temp.push(inputs[i]); + } + return temp; +}; + +// define the draw function +var vendors = ['ms', 'moz', 'webkit', 'o']; +for (var i = 0; i < vendors.length && !window.requestAnimationFrame; ++i) { + window.requestAnimationFrame = window[vendors[i]+'RequestAnimationFrame']; + window.cancelAnimationFrame = window[vendors[i]+'CancelAnimationFrame'] || + window[vendors[i]+'CancelRequestAnimationFrame']; +} + +if (window.requestAnimationFrame && window.cancelAnimationFrame) { + var previous = 0; + ElmRuntime.draw = function(callback) { + window.cancelAnimationFrame(previous); + previous = window.requestAnimationFrame(callback); + }; +} else { + ElmRuntime.draw = function(callback) { callback(); }; +} + +}()); + +(function() { +'use strict'; + +Elm.fullscreen = function(module) { + var style = document.createElement('style'); + style.type = 'text/css'; + style.innerHTML = "html,head,body { padding:0; margin:0; }" + + "body { font-family: calibri, helvetica, arial, sans-serif; }"; + document.head.appendChild(style); + var container = document.createElement('div'); + document.body.appendChild(container); + return init(ElmRuntime.Display.FULLSCREEN, container, module); +}; + +Elm.byId = function(id, module) { + var container = document.getElementById(id); + var tag = container.tagName; + if (tag !== 'DIV') { + throw new Error('Elm.byId must be given a div, not a ' + tag + '.'); + } + while (container.hasChildNodes()) { + container.removeChild(container.lastChild); + } + return init(ElmRuntime.Display.COMPONENT, container, module); +}; + +Elm.worker = function(module) { + return init(ElmRuntime.Display.NONE, {}, module); +}; + +function init(display, container, module) { + // defining state needed for an instance of the Elm RTS + var signalGraph = null; + var inputs = []; + var visualModel = null; + + function notify(id, v) { + var timestep = Date.now(); + var hasListener = false; + for (var i = inputs.length; i--; ) { + // must maintain the order of this stmt to avoid having the || + // short-circuiting the necessary work of recv + hasListener = inputs[i].recv(timestep, id, v) || hasListener; + } + return hasListener; + } + + container.offsetX = 0; + container.offsetY = 0; + + // create the actual RTS. Any impure modules will attach themselves to this + // object. This permits many Elm programs to be embedded per document. + var elm = { notify:notify, + node:container, + display:display, + id:ElmRuntime.guid(), + inputs:inputs + }; + + // Set up methods to communicate with Elm program from JS. + function send(name, value) { + if (typeof value === 'undefined') return function(v) { return send(name,v); }; + var e = document.createEvent('Event'); + e.initEvent(name + '_' + elm.id, true, true); + e.value = value; + document.dispatchEvent(e); + } + function recv(name, handler) { + document.addEventListener(name + '_' + elm.id, handler); + } + + recv('log', function(e) {console.log(e.value)}); + recv('title', function(e) {document.title = e.value}); + recv('redirect', function(e) { + if (e.value.length > 0) { window.location = e.value; } + }); + + // If graphics are not enabled, escape early, skip over setting up DOM stuff. + if (display === ElmRuntime.Display.NONE) { + module(elm); + return { send : send, recv : recv }; + } + + var Render = ElmRuntime.use(ElmRuntime.Render.Element); + + // evaluate the given module and extract its 'main' value. + signalGraph = module(elm).main; + + // make sure the signal graph is actually a signal, extract the visual model, + // and filter out any unused inputs. + var Signal = Elm.Signal(elm); + if (!('recv' in signalGraph)) signalGraph = Signal.constant(signalGraph); + visualModel = signalGraph.value; + inputs = ElmRuntime.filterDeadInputs(inputs); + + // Add the visualModel to the DOM + container.appendChild(Render.render(visualModel)); + if (elm.Native.Window) elm.Native.Window.resizeIfNeeded(); + + // set up updates so that the DOM is adjusted as necessary. + var update = Render.update; + function domUpdate(value) { + ElmRuntime.draw(function(_) { + update(container.firstChild, visualModel, value); + visualModel = value; + if (elm.Native.Window) elm.Native.Window.resizeIfNeeded(); + }); + return value; + } + + signalGraph = A2(Signal.lift, domUpdate, signalGraph); + + return { send : send, recv : recv, node : container }; +}; + +}()); +ElmRuntime.Render.Utils = function() { +'use strict'; + +function newElement(elementType) { + var e = document.createElement(elementType); + e.style.padding = "0"; + e.style.margin = "0"; + return e; +} + +function addTo(container, elem) { + container.appendChild(elem); +} + +function extract(c) { + if (c._3 === 1) { return 'rgb(' + c._0 + ',' + c._1 + ',' + c._2 + ')'; } + return 'rgba(' + c._0 + ',' + c._1 + ',' + c._2 + ',' + c._3 + ')'; +} + +function addTransform(style, trans) { + style.transform = trans; + style.msTransform = trans; + style.MozTransform = trans; + style.webkitTransform = trans; + style.OTransform = trans; +} + +function removeTransform(style) { + style.transform = 'none'; + style.msTransform = 'none'; + style.MozTransform = 'none'; + style.webkitTransform = 'none'; + style.OTransform = 'none'; +} + +var List = Elm.Native.List({}); + +return {addTo:addTo, + newElement:newElement, + extract : extract, + fromList: List.toArray, + fromString: function(s) { return List.toArray(s).join(''); }, + toString: List.fromArray, + eq: Elm.Native.Utils({}).eq, + addTransform: addTransform, + removeTransform: removeTransform + }; +}; + +ElmRuntime.Render.Element = function() { +'use strict'; + +var Utils = ElmRuntime.use(ElmRuntime.Render.Utils); +var newElement = Utils.newElement, extract = Utils.extract, + addTransform = Utils.addTransform, removeTransform = Utils.removeTransform, + fromList = Utils.fromList, eq = Utils.eq; + +function setProps(props, e) { + e.style.width = (props.width |0) + 'px'; + e.style.height = (props.height|0) + 'px'; + if (props.opacity !== 1) { e.style.opacity = props.opacity; } + if (props.color.ctor === 'Just') { + e.style.backgroundColor = extract(props.color._0); + } + if (props.tag !== '') { e.id = props.tag; } + if (props.href !== '') { + var a = newElement('a'); + a.href = props.href; + a.appendChild(e); + return a; + } + return e; +} + +function image(props, img) { + switch (img._0.ctor) { + case 'Plain': return plainImage(img._3); + case 'Fitted': return fittedImage(props.width, props.height, img._3); + case 'Cropped': return croppedImage(img,props.width,props.height,img._3); + } +} + +function plainImage(src) { + var img = newElement('img'); + img.src = src; + img.name = src; + img.style.display = "block"; + return img; +} + +function fittedImage(w, h, src) { + var e = newElement('div'); + e.style.position = "relative"; + e.style.overflow = "hidden"; + + var img = newElement('img'); + img.onload = function() { + img.style.position = 'absolute'; + img.style.margin = 'auto'; + + var sw = w, sh = h; + if (w / h > this.width / this.height) { + sh = Math.round(this.height * w / this.width); + } else { + sw = Math.round(this.width * h / this.height); + } + img.style.width = sw + 'px'; + img.style.height = sh + 'px'; + img.style.left = ((w - sw) / 2) + 'px'; + img.style.top = ((h - sh) / 2) + 'px'; + }; + img.src = src; + img.name = src; + e.appendChild(img); + return e; +} + +function croppedImage(elem, w, h, src) { + var pos = elem._0._0; + var e = newElement('div'); + e.style.position = "relative"; + e.style.overflow = "hidden"; + + var img = newElement('img'); + img.onload = function() { + img.style.position = 'absolute'; + img.style.margin = 'auto'; + var sw = w / elem._1, sh = h / elem._2; + img.style.width = ((this.width * sw)|0) + 'px'; + img.style.height = ((this.height * sh)|0) + 'px'; + img.style.left = ((- pos._0 * sw)|0) + 'px'; + img.style.top = ((- pos._1 * sh)|0) + 'px'; + }; + img.src = src; + img.name = src; + e.appendChild(img); + return e; +} + +function goIn(e) { e.style.position = 'absolute'; return e; } +function goDown(e) { return e } +function goRight(e) { e.style.styleFloat = e.style.cssFloat = "left"; return e; } +function flowWith(f, array) { + var container = newElement('div'); + for (var i = array.length; i--; ) { + container.appendChild(f(render(array[i]))); + } + return container; +} + +function flow(dir,elist) { + var array = fromList(elist); + switch(dir.ctor) { + case "DDown": array.reverse(); + case "DUp": return flowWith(goDown,array); + case "DRight": array.reverse(); + case "DLeft": return flowWith(goRight,array); + case "DOut": array.reverse(); + case "DIn": return flowWith(goIn,array); + } +} + +function toPos(pos) { + switch(pos.ctor) { + case "Absolute": return pos._0 + "px"; + case "Relative": return (pos._0 * 100) + "%"; + } +} + +function setPos(pos,w,h,e) { + e.style.position = 'absolute'; + e.style.margin = 'auto'; + var transform = ''; + switch(pos.horizontal.ctor) { + case 'P': e.style.right = toPos(pos.x); break; + case 'Z': transform = 'translateX(' + ((-w/2)|0) + 'px) '; + case 'N': e.style.left = toPos(pos.x); break; + } + switch(pos.vertical.ctor) { + case 'N': e.style.bottom = toPos(pos.y); break; + case 'Z': transform += 'translateY(' + ((-h/2)|0) + 'px)'; + case 'P': e.style.top = toPos(pos.y); break; + } + if (transform !== '') addTransform(e.style, transform); + return e; +} + +function container(pos,elem) { + var e = render(elem); + setPos(pos, elem.props.width, elem.props.height, e); + var div = newElement('div'); + div.style.position = 'relative'; + div.style.overflow = 'hidden'; + div.appendChild(e); + return div; +} + +function rawHtml(html) { + var e = newElement('div'); + e.innerHTML = html; + return e; +} + +function render(elem) { return setProps(elem.props, makeElement(elem)); } +function makeElement(e) { + var elem = e.element; + switch(elem.ctor) { + case 'Image': return image(e.props, elem); + case 'Flow': return flow(elem._0, elem._1); + case 'Container': return container(elem._0, elem._1); + case 'Spacer': return newElement('div'); + case 'RawHtml': return rawHtml(elem._0); + case 'Custom': return elem.render(elem.model); + } +} + +function update(node, curr, next) { + if (node.tagName === 'A') { node = node.firstChild; } + if (curr.props.id === next.props.id) return updateProps(node, curr, next); + if (curr.element.ctor !== next.element.ctor) { + node.parentNode.replaceChild(render(next),node); + return true; + } + var nextE = next.element, currE = curr.element; + switch(nextE.ctor) { + case "Spacer": break; + case "RawHtml": + if (nextE._0 !== currE._0) node.innerHTML = nextE._0; + break; + case "Image": + if (nextE._0.ctor === 'Plain') { + if (nextE._3 !== currE._3) node.src = nextE._3; + } else if (!eq(nextE,currE) || + next.props.width !== curr.props.width || + next.props.height !== curr.props.height) { + node.parentNode.replaceChild(render(next),node); + return true; + } + break; + case "Flow": + var arr = fromList(nextE._1); + for (var i = arr.length; i--; ) { arr[i] = arr[i].element.ctor; } + if (nextE._0.ctor !== currE._0.ctor) { + node.parentNode.replaceChild(render(next),node); + return true; + } + var nexts = fromList(nextE._1); + var kids = node.childNodes; + if (nexts.length !== kids.length) { + node.parentNode.replaceChild(render(next),node); + return true; + } + var currs = fromList(currE._1); + var goDir = function(x) { return x; }; + switch(nextE._0.ctor) { + case "DDown": case "DUp": goDir = goDown; break; + case "DRight": case "DLeft": goDir = goRight; break; + case "DOut": case "DIn": goDir = goIn; break; + } + for (var i = kids.length; i-- ;) { + update(kids[i],currs[i],nexts[i]); + goDir(kids[i]); + } + break; + case "Container": + var inner = node.firstChild; + if (!update(inner, currE._1, nextE._1)) { + if (nextE._0.horizontal.ctor !== currE._0.horizontal.ctor) { + inner.style.left = inner.style.right = 'none'; + removeTransform(inner.style); + } + if (nextE._0.vertical.ctor !== currE._0.vertical.ctor) { + inner.style.top = inner.style.bottom = 'none'; + removeTransform(inner.style); + } + } + setPos(nextE._0, nextE._1.props.width, nextE._1.props.height, inner); + break; + case "Custom": + if (currE.type === nextE.type) { + var done = nextE.update(node, currE.model, nextE.model); + if (done) return; + } else { + return node.parentNode.replaceChild(render(next), node); + } + } + updateProps(node, curr, next); +} + +function updateProps(node, curr, next) { + var props = next.props, currP = curr.props, e = node; + if (props.width !== currP.width) e.style.width = (props.width |0) + 'px'; + if (props.height !== currP.height) e.style.height = (props.height|0) + 'px'; + if (props.opacity !== 1 && props.opacity !== currP.opacity) { + e.style.opacity = props.opacity; + } + var nextColor = (props.color.ctor === 'Just' ? + extract(props.color._0) : 'transparent'); + if (e.style.backgroundColor !== nextColor) { + e.style.backgroundColor = nextColor; + } + if (props.tag !== currP.tag) { e.id = props.tag; } + if (props.href !== currP.href) { + if (currP.href === '') { + var a = newElement('a'); + a.href = props.href; + a.appendChild(e); + e.parentNode.replaceChild(a,e); + } else { + node.parentNode.href = props.href; + } + } +} + +return { render:render, update:update }; + +}; +ElmRuntime.Render.Collage = function() { +'use strict'; + +var Render = ElmRuntime.use(ElmRuntime.Render.Element); +var Matrix = Elm.Matrix2D({}); +var Utils = ElmRuntime.use(ElmRuntime.Render.Utils); +var newElement = Utils.newElement, + extract = Utils.extract, fromList = Utils.fromList, + fromString = Utils.fromString, addTransform = Utils.addTransform; + +function trace(ctx, path) { + var points = fromList(path); + var i = points.length - 1; + if (i <= 0) return; + ctx.moveTo(points[i]._0, points[i]._1); + while (i--) { ctx.lineTo(points[i]._0, points[i]._1); } + if (path.closed) { + i = points.length - 1; + ctx.lineTo(points[i]._0, points[i]._1); + } +} + +function line(ctx,style,path) { + style.dashing.ctor === 'Nil' ? trace(ctx, path) : customLineHelp(ctx, style, path); + ctx.stroke(); +} + +function customLineHelp(ctx, style, path) { + var points = fromList(path); + if (path.closed) points.push(points[0]); + var pattern = fromList(style.dashing); + var i = points.length - 1; + if (i <= 0) return; + var x0 = points[i]._0, y0 = points[i]._1; + var x1=0, y1=0, dx=0, dy=0, remaining=0, nx=0, ny=0; + var pindex = 0, plen = pattern.length; + var draw = true, segmentLength = pattern[0]; + ctx.moveTo(x0,y0); + while (i--) { + x1 = points[i]._0; y1 = points[i]._1; + dx = x1 - x0; dy = y1 - y0; + remaining = Math.sqrt(dx * dx + dy * dy); + while (segmentLength <= remaining) { + x0 += dx * segmentLength / remaining; + y0 += dy * segmentLength / remaining; + ctx[draw ? 'lineTo' : 'moveTo'](x0, y0); + // update starting position + dx = x1 - x0; dy = y1 - y0; + remaining = Math.sqrt(dx * dx + dy * dy); + // update pattern + draw = !draw; + pindex = (pindex + 1) % plen; + segmentLength = pattern[pindex]; + } + if (remaining > 0) { + ctx[draw ? 'lineTo' : 'moveTo'](x1, y1); + segmentLength -= remaining; + } + x0 = x1; y0 = y1; + } +} + +function drawLine(ctx, style, path) { + ctx.lineWidth = style.width; + var cap = style.cap.ctor; + ctx.lineCap = cap === 'Flat' ? 'butt' : + cap === 'Round' ? 'round' : 'square'; + var join = style.join.ctor; + ctx.lineJoin = join === 'Smooth' ? 'round' : + join === 'Sharp' ? 'miter' : 'bevel'; + ctx.miterLimit = style.join._0 || 10; + ctx.strokeStyle = extract(style.color); + return line(ctx, style, path); +} + +function texture(redo, ctx, src) { + var img = new Image(); + img.src = fromString(src); + img.onload = redo; + return ctx.createPattern(img, 'repeat'); +} + +function gradient(ctx, grad) { + var g; + var stops = []; + if (grad.ctor === 'Linear') { + var p0 = grad._0, p1 = grad._1; + g = ctx.createLinearGradient(p0._0, -p0._1, p1._0, -p1._1); + stops = fromList(grad._2); + } else { + var p0 = grad._0, p2 = grad._2; + g = ctx.createRadialGradient(p0._0, -p0._1, grad._1, p2._0, -p2._1, grad._3); + stops = fromList(grad._4); + } + var len = stops.length; + for (var i = 0; i < len; ++i) { + var stop = stops[i]; + g.addColorStop(stop._0, extract(stop._1)); + } + return g; +} + +function drawShape(redo, ctx, style, path) { + trace(ctx, path); + var sty = style.ctor; + ctx.fillStyle = + sty === 'Solid' ? extract(style._0) : + sty === 'Texture' ? texture(redo, ctx, style._0) : gradient(ctx, style._0); + ctx.fill(); +} + +function drawImage(redo, ctx, form) { + var img = new Image(); + img.onload = redo; + img.src = fromString(form._3); + var w = form._0, + h = form._1, + pos = form._2, + srcX = pos._0, + srcY = pos._1, + srcW = w, + srcH = h, + destX = -w/2, + destY = -h/2, + destW = w, + destH = h; + + ctx.drawImage(img, srcX, srcY, srcW, srcH, destX, destY, destW, destH); +} + +function renderForm(redo, ctx, form) { + ctx.save(); + var x = form.x, y = form.y, theta = form.theta, scale = form.scale; + if (x !== 0 || y !== 0) ctx.translate(x, y); + if (theta !== 0) ctx.rotate(theta); + ctx.scale(scale,-scale); + ctx.beginPath(); + var f = form.form; + switch(f.ctor) { + case 'FPath' : drawLine(ctx, f._0, f._1); break; + case 'FImage': drawImage(redo, ctx, f); break; + case 'FShape': + if (f._0.ctor === 'Left') { + f._1.closed = true; + drawLine(ctx, f._0._0, f._1); + } else { + drawShape(redo, ctx, f._0._0, f._1); + } + break; + } + ctx.restore(); +} + +function formToMatrix(form) { + var scale = form.scale; + var matrix = A6( Matrix.matrix, scale, 0, 0, scale, scale * form.x, scale * form.y ); + + var theta = form.theta + if (theta !== 0) + matrix = A2( Matrix.multiply, matrix, Matrix.rotation(theta) ); + + return matrix; +} + +function makeTransform(w, h, form, matrices) { + var props = form.form._0.props; + var m = A6( Matrix.matrix, 1, 0, 0, 1, + (w - props.width)/2, + (h - props.height)/2 ); + var len = matrices.length; + for (var i = 0; i < len; ++i) { m = A2( Matrix.multiply, m, matrices[i] ); } + m = A2( Matrix.multiply, m, formToMatrix(form) ); + + return 'matrix(' + m[0] + ',' + m[3] + ',' + + (-m[1]) + ',' + (-m[4]) + ',' + + m[2] + ',' + m[5] + ')'; +} + +function stepperHelp(list) { + var arr = fromList(list); + var i = 0; + function peekNext() { + return i < arr.length ? arr[i].form.ctor : ''; + } + // assumes that there is a next element + function next() { + var out = arr[i]; + ++i; + return out; + } + return { peekNext:peekNext, next:next }; +} + +function stepper(forms) { + var ps = [stepperHelp(forms)]; + var matrices = []; + function peekNext() { + var len = ps.length; + var formType = ''; + for (var i = 0; i < len; ++i ) { + if (formType = ps[i].peekNext()) return formType; + } + return ''; + } + // assumes that there is a next element + function next(ctx) { + while (!ps[0].peekNext()) { ps.shift(); matrices.pop(); ctx.restore(); } + var out = ps[0].next(); + var f = out.form; + if (f.ctor === 'FGroup') { + ps.unshift(stepperHelp(f._1)); + var m = A2( Matrix.multiply, f._0, formToMatrix(out)); + ctx.save(); + ctx.transform(m[0], m[3], m[1], m[4], m[2], m[5]); + matrices.push(m); + } + return out; + } + function transforms() { return matrices; } + return { peekNext:peekNext, next:next, transforms:transforms }; +} + +function makeCanvas(w,h) { + var canvas = newElement('canvas'); + canvas.style.width = w + 'px'; + canvas.style.height = h + 'px'; + canvas.style.display = "block"; + canvas.style.position = "absolute"; + canvas.width = w; + canvas.height = h; + return canvas; +} + +function render(model) { + var div = newElement('div'); + update(div, model, model); + return div; +} + +function updateTracker(w,h,div) { + var kids = div.childNodes; + var i = 0; + function transform(transforms, ctx) { + ctx.translate(w/2, h/2); + var len = transforms.length; + for (var i = 0; i < len; ++i) { + var m = transforms[i]; + ctx.save(); + ctx.transform(m[0], m[3], m[1], m[4], m[2], m[5]); + } + return ctx; + } + function getContext(transforms) { + while (i < kids.length) { + var node = kids[i++]; + if (node.getContext) { + node.width = w; + node.height = h; + node.style.width = w + 'px'; + node.style.height = h + 'px'; + return transform(transforms, node.getContext('2d')); + } + div.removeChild(node); + } + var canvas = makeCanvas(w,h); + div.appendChild(canvas); + // we have added a new node, so we must step our position + ++i; + return transform(transforms, canvas.getContext('2d')); + } + function element(matrices, form) { + var container = kids[i]; + if (!container || container.getContext) { + container = newElement('div'); + container.style.overflow = 'hidden'; + container.style.position = 'absolute'; + addTransform(container.style, 'scaleY(-1)'); + if (!container) { + div.appendChild(container); + } else { + div.insertBefore(container, kids[i]); + } + } + // we have added a new node, so we must step our position + ++i; + + container.style.width = w + 'px'; + container.style.height = h + 'px'; + + var elem = form.form._0; + var node = container.firstChild; + if (node) { + Render.update(node, node.oldElement, elem); + node = container.firstChild; + } else { + node = Render.render(elem); + container.appendChild(node); + } + node.oldElement = elem; + addTransform(node.style, makeTransform(w, h, form, matrices)); + } + return { getContext:getContext, element:element }; +} + + +function update(div, _, model) { + var w = model.w; + var h = model.h; + div.style.width = w + 'px'; + div.style.height = h + 'px'; + if (model.forms.ctor === 'Nil') { + while (div.hasChildNodes()) { + div.removeChild(div.lastChild); + } + } + var stpr = stepper(model.forms); + var tracker = updateTracker(w,h,div); + var ctx = null; + var formType = ''; + + while (formType = stpr.peekNext()) { + if (ctx === null && formType !== 'FElement') { + ctx = tracker.getContext(stpr.transforms()); + ctx.scale(1,-1); + } + var form = stpr.next(ctx); + if (formType === 'FElement') { + tracker.element(stpr.transforms(), form); + ctx = null; + } else if (formType !== 'FGroup') { + renderForm(function() { update(div, model, model); }, ctx, form); + } + } + return div; +} + +return { render:render, update:update }; + +};
− src/Ast.hs
@@ -1,148 +0,0 @@- -module Ast where - -import Context -import Data.Char (isDigit) -import Data.List (intercalate) -import Types.Types -import qualified Text.Pandoc as Pandoc - -data Module = Module [String] Exports Imports [Statement] - -type Exports = [String] - -type Imports = [(String, ImportMethod)] -data ImportMethod = As String | Hiding [String] | Importing [String] - deriving (Eq,Ord) - - -data Pattern = PData String [Pattern] - | PRecord [String] - | PVar String - | PAnything - deriving (Eq) - -type CExpr = Context Expr -data Expr = IntNum Int - | FloatNum Float - | Chr Char - | Str String - | Boolean Bool - | Range CExpr CExpr - | Access CExpr String - | Remove CExpr String - | Insert CExpr String CExpr - | Modify CExpr [(String,CExpr)] - | Record [(String,[String],CExpr)] - | Binop String CExpr CExpr - | Lambda String CExpr - | App CExpr CExpr - | If CExpr CExpr CExpr - | MultiIf [(CExpr,CExpr)] - | Let [Def] CExpr - | Var String - | Case CExpr [(Pattern,CExpr)] - | Data String [CExpr] - | Markdown Pandoc.Pandoc - deriving (Eq) - -data Def = FnDef String [String] CExpr - | OpDef String String String CExpr - deriving (Eq) - -data Statement = Definition Def - | Datatype String [X] [(String,[Type])] - | ImportEvent String CExpr String Type - | ExportEvent String String Type - deriving (Eq,Show) - -cons h t = epos h t (Data "Cons" [h,t]) -nil = C (Just "[]") NoSpan (Data "Nil" []) -list = foldr cons nil -tuple es = Data ("Tuple" ++ show (length es)) es - -delist (C _ _ (Data "Cons" [h,t])) = h : delist t -delist _ = [] - - -pcons h t = PData "Cons" [h,t] -pnil = PData "Nil" [] -plist = foldr pcons pnil -ptuple es = PData ("Tuple" ++ show (length es)) es - -brkt s = "{ " ++ s ++ " }" - -instance Show Pattern where - show (PRecord fs) = brkt (intercalate ", " fs) - show (PVar x) = x - show PAnything = "_" - show (PData "Cons" [hd@(PData "Cons" _),tl]) = - parens (show hd) ++ " : " ++ show tl - where parens s = "(" ++ s ++ ")" - show (PData "Cons" [hd,tl]) = show hd ++ " : " ++ show tl - show (PData "Nil" []) = "[]" - show (PData name ps) = - if take 5 name == "Tuple" && all isDigit (drop 5 name) then - parens . intercalate ", " $ map show ps - else (if null ps then id else parens) $ unwords (name : map show ps) - where parens s = "(" ++ s ++ ")" - -instance Show Expr where - show e = - case e of - IntNum n -> show n - FloatNum n -> show n - Chr c -> show c - Str s -> show s - Boolean b -> show b - Range e1 e2 -> "[" ++ show e1 ++ ".." ++ show e2 ++ "]" - Access e x -> show' e ++ "." ++ x - Remove e x -> brkt (show e ++ " - " ++ x) - Insert (C _ _ (Remove e y)) x v -> - brkt (show e ++ " - " ++ y ++ " | " ++ x ++ " = " ++ show v) - Insert e x v -> brkt (show e ++ " | " ++ x ++ " = " ++ show v) - Modify e fs -> brkt (show e ++" | "++ intercalate ", " (map field fs)) - where field (x,e) = x ++ " <- " ++ show e - Record r -> brkt (intercalate ", " (map fields r)) - where fields (f,args,e) = f ++ concatMap (' ':) args ++ " = " ++ show e - Binop op e1 e2 -> show' e1 ++ " " ++ op ++ " " ++ show' e2 - Lambda x e -> let (xs,e') = getLambdas (noContext $ Lambda x e) in - concat [ "\\", intercalate " " xs, " -> ", show e' ] - App e1 e2 -> show' e1 ++ " " ++ show' e2 - If e1 e2 e3 -> concat [ "if ", show e1, " then ", show e2, " else ", show e3 ] - MultiIf (p:ps) -> concat [ "if | ", iff p, sep (map iff ps) ] - where iff (b,e) = show b ++ " -> " ++ show e - sep = concatMap ("\n | " ++) - Let defs e -> "let { "++intercalate " ; " (map show defs)++" } in "++show e - Var x -> x - Case e pats -> "case "++ show e ++" of " ++ brkt (intercalate " ; " pats') - where pats' = map (\(p,e) -> show p ++ " -> " ++ show e) pats - Data name es - | name == "Cons" -> ("["++) . (++"]") . intercalate "," . map show $ - delist (noContext $ Data "Cons" es) - | name == "Nil" -> "[]" - | otherwise -> name ++ " " ++ intercalate " " (map show' es) - Markdown _ -> "[markdown| ... |]" - - -instance Show Def where - show e = - case e of - FnDef v [] e -> v ++ " = " ++ show e - FnDef f args e -> f ++ " " ++ intercalate " " args ++ " = " ++ show e - OpDef op a1 a2 e -> intercalate " " [a1,op,a2] ++ " = " ++ show e - -getLambdas (C _ _ (Lambda x e)) = (x:xs,e') - where (xs,e') = getLambdas e -getLambdas e = ([],e) - -show' (C _ _ e) = if needsParens e then "(" ++ show e ++ ")" else show e - -needsParens (Binop _ _ _) = True -needsParens (Lambda _ _) = True -needsParens (App _ _) = True -needsParens (If _ _ _) = True -needsParens (Let _ _) = True -needsParens (Case _ _) = True -needsParens (Data name (x:xs)) = name /= "Cons" -needsParens _ = False
− src/Compiler.hs
@@ -1,112 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-module Main where--import Data.Either (lefts, rights)-import Data.List (intersect, intercalate)-import Data.Maybe (fromMaybe)-import Data.Version (showVersion)-import System.Console.CmdArgs-import System.FilePath-import Text.Blaze.Html.Renderer.String (renderHtml)--import qualified Text.Jasmine as JS-import qualified Data.ByteString.Lazy.Char8 as BS--import Ast-import Initialize-import CompileToJS-import GenerateHtml-import Paths_Elm--data ELM =- ELM { make :: Bool- , files :: [FilePath]- , runtime :: Maybe FilePath- , separate_js :: Bool- , only_js :: Bool- , import_js :: [FilePath]- , generate_noscript :: Bool- , minify :: Bool- , output_directory :: Maybe FilePath- }- deriving (Data,Typeable,Show,Eq)--elm = ELM { make = False &= help "automatically compile dependencies."- , files = def &= args &= typ "FILES"- , runtime = Nothing &= typFile &=- help "Specify a custom location for Elm's runtime system."- , separate_js = False &= help "Compile to separate HTML and JS files."- , only_js = False &= help "Compile only to JavaScript."- , import_js = [] &= typFile &= help "Include a JavaScript file before the body of the Elm program. Can be used many times. Files will be included in the given order."- , generate_noscript = True &= help "Add generated <noscript> tag to HTML output."- , minify = False &= help "Minify generated JavaScript"- , output_directory = Nothing &= typFile &= help "Output files to directory specified. Defaults to the location of original file."- } &=- help "Compile Elm programs to HTML, CSS, and JavaScript." &=- summary ("The Elm Compiler " ++ showVersion version ++ ", (c) Evan Czaplicki")--main = do- args <- cmdArgs elm- mini <- getDataFileName ("elm-runtime-" ++ showVersion version ++ ".js")- compileArgs mini args--compileArgs mini (ELM _ [] _ _ _ _ _ _ _) =- putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"-compileArgs mini (ELM make files rtLoc split only js nscrpt isMini outputDir) =- mapM_ (fileTo isMini get what js nscrpt outputDir $ fromMaybe mini rtLoc) files- where get = if make then getModules [] else getModule- what = if only then JS else- if split then Split else HTML--data What = JS | HTML | Split--fileTo isMini get what jsFiles noscript outputDir rtLoc file = do- let jsStyle = if isMini then Minified else Readable- let formatJS = if isMini then BS.unpack . JS.minify . BS.pack else id- ems <- get file- jss <- concat `fmap` mapM readFile jsFiles- case ems of- Left err -> putStrLn $ "Error while compiling " ++ file ++ ":\n" ++ err- Right ms ->- let path = fromMaybe "" outputDir </> file- js = replaceExtension path ".js"- html = replaceExtension path ".html"- in case what of- JS -> writeFile js . formatJS $ jss ++ concatMap jsModule ms- HTML -> writeFile html . renderHtml $ modulesToHtml jsStyle "" rtLoc jss noscript ms- Split -> do- writeFile html . renderHtml $ linkedHtml rtLoc js ms- writeFile js . formatJS $ jss ++ concatMap jsModule ms--getModules :: [String] -> FilePath -> IO (Either String [([String],Module)])-getModules uses file = do- code <- readFile file- case initialize code of- Left err -> return . Left $ "Error in " ++ file ++ ":\n" ++ err- Right (escs, modul@(Module _ _ imports _)) ->- let imps = filter (`notElem` builtInModules) $ map fst imports in- case intersect uses imps of- x:_ -> return . Left $ "Error: Cyclic dependency. Module " ++- x ++ " depends on itself."- [] -> do- ems <- mapM (getModules (uses ++ imps) . toFilePath) imps- return $ case lefts ems of- [] -> Right $ concat (rights ems) ++ [(escs,modul)]- errs -> Left $ intercalate "\n" errs--getModule :: FilePath -> IO (Either String [([String],Module)])-getModule file = do- code <- readFile file- return . fmap (:[]) $ initialize code--toFilePath :: String -> FilePath-toFilePath modul = map (\c -> if c == '.' then '/' else c) modul ++ ".elm"--builtInModules =- concat [ [ "List", "Char", "Maybe", "Dict", "Set", "Automaton", "Date" ]- , [ "Signal", "Mouse", "Keyboard.Raw"- , "Window", "Time", "HTTP", "Input", "Random" ]- , [ "Graphics", "Text", "Color" ]- , map ("JavaScript"++) [ "", ".Experimental" ]- , [ "Prelude", "JSON" ]- ]
− src/Context.hs
@@ -1,43 +0,0 @@- -module Context where - -import Text.Parsec.Pos - - -data SrcPos = Pos Int Int - deriving (Eq,Ord) - -data SrcSpan = Span SrcPos SrcPos | NoSpan - deriving (Eq,Ord) - -data Context e = C (Maybe String) SrcSpan e deriving (Eq,Ord) - - -instance Show SrcPos where - show (Pos r c) = "Line " ++ show r ++ ", Column " ++ show c - -instance Show SrcSpan where - show span = - case span of - Span start end -> show start - NoSpan -> "" - -instance Show e => Show (Context e) where - show (C _ _ e) = show e - - - -noContext = C Nothing NoSpan - -pos start end = C Nothing - (Span (Pos (sourceLine start) (sourceColumn start)) - (Pos (sourceLine end ) (sourceColumn end ))) - -epos (C _ s1 _) (C _ s2 _) = C Nothing span - where span = case (s1,s2) of - (Span start _, Span _ end) -> Span start end - (_, NoSpan) -> s1 - (NoSpan, _) -> s2 - -addCtx x (C Nothing span e) = C (Just (show x)) span e -addCtx x (C txt span e) = C txt span e
− src/Gen/Cases.hs
@@ -1,80 +0,0 @@- -module Cases (caseToMatch, Match (..), Clause (..), matchSubst) where - -import Control.Arrow (first) -import Control.Monad (liftM,foldM) -import Data.List (groupBy,sortBy,lookup) -import Data.Maybe (fromMaybe) - -import Ast -import Context -import Guid -import Substitute - -caseToMatch patterns = do - v <- newVar - match [v] (map (first (:[])) patterns) Fail - -newVar = do n <- guid - return $ "case" ++ show n - -data Match = Match String [Clause] Match - | Break - | Fail - | Other CExpr - | Seq [Match] - deriving Show - -data Clause = Clause String [String] Match - deriving Show - -matchSubst :: [(String,String)] -> Match -> Match -matchSubst _ Break = Break -matchSubst _ Fail = Fail -matchSubst pairs (Seq ms) = Seq (map (matchSubst pairs) ms) -matchSubst pairs (Other (C t s e)) = - Other . C t s $ foldr ($) e $ map (\(x,y) -> subst x (Var y)) pairs -matchSubst pairs (Match n cs m) = - Match (varSubst n) (map clauseSubst cs) (matchSubst pairs m) - where varSubst v = fromMaybe v (lookup v pairs) - clauseSubst (Clause c vs m) = - Clause c (map varSubst vs) (matchSubst pairs m) - -isCon (PData _ _ : _, _) = True -isCon _ = False - -isVar p = not (isCon p) - -match :: [String] -> [([Pattern],CExpr)] -> Match -> GuidCounter Match -match [] [] def = return def -match [] [([],e)] Fail = return $ Other e -match [] [([],e)] Break = return $ Other e -match [] cs def = return $ Seq (map (Other . snd) cs ++ [def]) -match vs cs def - | all isVar cs = matchVar vs cs def - | all isCon cs = matchCon vs cs def - | otherwise = matchMix vs cs def - -matchVar :: [String] -> [([Pattern],CExpr)] -> Match -> GuidCounter Match -matchVar (v:vs) cs def = match vs (map subVar cs) def - where subVar (PVar x : ps, C t s e) = (ps, C t s $ subst x (Var v) e) - subVar (PAnything : ps, ce) = (ps, ce) - -matchCon :: [String] -> [([Pattern],CExpr)] -> Match -> GuidCounter Match -matchCon (v:vs) cs def = (flip (Match v) def) `liftM` mapM toClause css - where css = groupBy (withName (==)) $ sortBy (withName compare) cs - withName f (PData n1 _:_,_) (PData n2 _:_,_) = f n1 n2 - toClause cs = let (PData name _ : _ , _) = head cs in - matchClause name (v:vs) cs Break - -matchClause :: String -> [String] -> [([Pattern],CExpr)] -> Match -> GuidCounter Clause -matchClause c (v:vs) cs def = - do vs' <- getVars - Clause c vs' `liftM` match (vs' ++ vs) (map flatten cs) def - where flatten (PData _ ps' : ps, e) = (ps' ++ ps, e) - getVars = let (PData _ ps : _, _) = head cs in - mapM (\_ -> newVar) ps - -matchMix :: [String] -> [([Pattern],CExpr)] -> Match -> GuidCounter Match -matchMix vs cs def = foldM (flip $ match vs) def (reverse css) - where css = groupBy (\p1 p2 -> isCon p1 == isCon p2) cs
− src/Gen/CompileToJS.hs
@@ -1,327 +0,0 @@-module CompileToJS (showErr, jsModule) where--import Ast-import Context-import Control.Arrow (first)-import Control.Monad (liftM,(<=<),join,ap)-import Data.Char (isAlpha,isDigit)-import Data.List (intercalate,sortBy,inits,foldl')-import qualified Data.Map as Map-import Data.Either (partitionEithers)-import qualified Text.Pandoc as Pan--import Initialize-import Rename (derename)-import Cases-import Guid-import Parse.Library (isOp)-import Rename (deprime)--showErr :: String -> String-showErr err = mainEquals $ "Elm.Graphics.text(Elm.Text.monospace(" ++ msg ++ "))"- where msg = show . concatMap (++"<br>") . lines $ err--indent = concatMap f- where f '\n' = "\n "- f c = [c]--parens s = "(" ++ s ++ ")"-braces s = "{" ++ s ++ "}"-jsList ss = "["++ intercalate "," ss ++"]"-jsFunc args body = "function(" ++ args ++ "){" ++ indent body ++ "}"-assign x e = "\nvar " ++ x ++ "=" ++ e ++ ";"-ret e = "\nreturn "++ e ++";"-iff a b c = a ++ "?" ++ b ++ ":" ++ c-quoted s = "'" ++ concatMap f s ++ "'"- where f '\n' = "\\n"- f '\'' = "\\'"- f '\t' = "\\t"- f '\"' = "\\\""- f '\\' = "\\\\"- f c = [c]--mainEquals s = globalAssign "Elm.main" (jsFunc "" (ret s))-globalAssign m s = "\n" ++ m ++ "=" ++ s ++ ";"--tryBlock escapees names e = - concat [ "\ntry{\n" ++ e ++ "\n} catch (e) {"- , "\nElm.main=function() {"- , "\nvar msg = ('<br/><h2>Your browser may not be supported. " ++- "Are you using a modern browser?</h2>' +" ++- " '<br/><span style=\"color:grey\">Runtime Error in " ++- intercalate "." names ++ " module:<br/>' + e + '" ++ msg ++ "</span>');"- , "\ndocument.body.innerHTML = Elm.Text.monospace(msg);"- , "throw e;"- , "};}"- ]- where msg | escapees /= [] = concat [ "<br/><br/>The problem may stem from an improper usage of:<br/>"- , intercalate ", " $ map (concatMap escape) escapees ]- | otherwise = ""- escape '\'' = "\\'"- escape '"' = "\\\""- escape c = [c]---jsModule (escapees, Module names exports imports stmts) =- tryBlock escapees (tail modNames) $ concat- [ concatMap (\n -> globalAssign n $ n ++ " || {}") .- map (intercalate ".") . drop 2 . inits $- take (length modNames - 1) modNames- , "\nif (" ++ modName ++ ") throw new Error(\"Module name collision, '" ++- intercalate "." (tail modNames) ++ "' is already defined.\"); "- , globalAssign modName $ jsFunc "" (defs ++ includes ++ body ++ export) ++ "()"- , mainEquals $ modName ++ ".main" ]- where modNames = if null names then ["Elm", "Main"]- else "Elm" : names- modName = intercalate "." modNames- includes = concatMap jsImport $ map (first ("Elm."++)) imports- body = stmtsToJS stmts- export = getExports exports stmts- exps = if null exports then ["main"] else exports- defs = concat [ assign "$op" "{}"- , "\nfor(Elm['i'] in Elm){eval('var '+Elm['i']+'=Elm[Elm.i];');}" ]--getExports names stmts = ret . braces $ intercalate ",\n" (op : map fnPair fns)- where exNames n = either derename id n `elem` names- exports | null names = concatMap get stmts- | otherwise = filter exNames (concatMap get stmts)-- (fns,ops) = partitionEithers exports-- opPair op = "'" ++ op ++ "' : $op['" ++ op ++ "']"- fnPair fn = let fn' = derename fn in fn' ++ ":" ++ fn-- op = ("$op : "++) . braces . intercalate ", " $ map opPair ops-- get' (FnDef x _ _) = Left x- get' (OpDef op _ _ _) = Right op- get s = case s of Definition d -> [ get' d ]- Datatype _ _ tcs -> map (Left . fst) tcs- ImportEvent _ _ x _ -> [ Left x ]- ExportEvent _ _ _ -> []---jsImport (modul, how) =- concat [ "\ntry{\n if (!(" ++ modul ++ " instanceof Object)) throw new Error('module not found');\n} catch(e) {\n throw new Error(\"Module '"- , drop 1 (dropWhile (/='.') modul)- , "' is missing. Compile with --make flag or load missing "- , "module in a separate JavaScript file.\");\n}" ] ++- jsImport' (modul, how)- -jsImport' (modul, As name) = assign name modul-jsImport' (modul, Importing vs) = concatMap def vs- where def [] = []- def (o:p) | isOp o = let v = "$op['" ++ o:p ++ "']" in- "\n" ++ v ++ " = " ++ modul ++ "." ++ v ++ ";"- | otherwise = let v = deprime (o:p) in- assign v $ modul ++ "." ++ v--jsImport' (modul, Hiding vs) =- concat [ assign "hiddenVars" . ("{"++) . (++"}") . intercalate "," $- map (\v -> v ++ ":true") (map deprime vs)- , "\nfor (Elm['i'] in " ++ modul ++ ") "- , braces . indent . concat $- [ "\nif (hiddenVars[Elm['i']]) continue;"- , "\neval('var ' + Elm['i'] + ' = "- , modul, "[Elm.i];');" ]- ]--stmtsToJS :: [Statement] -> String-stmtsToJS stmts = run (concat `liftM` mapM toJS (sortBy cmpStmt stmts))- where cmpStmt s1 s2 = compare (valueOf s1) (valueOf s2)- valueOf s = case s of- Datatype _ _ _ -> 1- ImportEvent _ _ _ _ -> 2- Definition (FnDef f [] _) ->- if derename f == "main" then 5 else 4- Definition _ -> 3- ExportEvent _ _ _ -> 6--class ToJS a where- toJS :: a -> GuidCounter String--instance ToJS Def where- toJS (FnDef x [] e) = assign x `liftM` toJS' e- toJS (FnDef f (a:as) e) =- do body <- toJS' (foldr (\x e -> noContext (Lambda x e)) e as)- return $ concat ["\nfunction ",f,parens a, braces . indent $ ret body]- toJS (OpDef op a1 a2 e) =- do body <- toJS' (foldr (\x e -> noContext (Lambda x e)) e [a1,a2])- return $ concat [ "\n$op['", op, "'] = ", body, ";" ]--instance ToJS Statement where- toJS (Definition d) = toJS d- toJS (Datatype _ _ tcs) = concat `liftM` mapM (toJS . toDef) tcs- where toDef (name,args) = Definition . FnDef name vars . noContext $- Data (derename name) (map (noContext . Var) vars)- where vars = map (('a':) . show) [1..length args]- toJS (ImportEvent js base elm _) =- do v <- toJS' base- return $ concat [ "\nvar " ++ elm ++ "=Elm.Signal.constant(" ++ v ++ ");"- , "\nValue.addListener(document, '" ++ js- , "', function(e) { Dispatcher.notify(" ++ elm- , ".id, e.value); });" ]- toJS (ExportEvent js elm _) =- return $ concat [ "\nlift(function(v) { "- , "var e = document.createEvent('Event');"- , "e.initEvent('", js, "', true, true);"- , "e.value = v;"- , "document.dispatchEvent(e); return v; })(", elm, ");" ]--toJS' :: CExpr -> GuidCounter String-toJS' (C txt span expr) =- case expr of- MultiIf ps -> multiIfToJS span ps- Case e cases -> caseToJS span e cases- _ -> toJS expr--recordToJS e loop cmds = - do e' <- toJS' e- return $ jsFunc "" (concat [ assign "r" "{_:[true]}"- , assign "e" e'- , "\nfor(var i in e){", loop, "}"- , cmds- , ret "r" ]) ++ "()"--remove x = concat [ "\n if (i!='", x, "') { r[i]=e[i]; }"- , "\n else if (e[i].length>1) { r[i]=e[i].slice(1); }" ]-addField (x,e) = ((++add) . assign "v") `liftM` toJS' e- where add = concat [ "\nif (r.hasOwnProperty('", x, "')) {"- , "\n r.", x, " = r.", x, ".slice(0);"- , "\n r.", x, ".unshift(v);"- , "\n} else { r.", x, " = [v]; }" ]-setField (x,e) = do- set <- globalAssign ("r." ++ x ++ "[0]") `liftM` toJS' e- return (globalAssign ("r." ++ x) ("r." ++ x ++ ".slice(0)") ++ set)-access x e = jsFunc "r" (ret body) ++ parens e- where body = "r.hasOwnProperty('_') ? r." ++ x ++ "[0] : r." ++ x-makeRecord kvs = do- kvs' <- (Map.toList . foldl' combine Map.empty) `liftM` mapM prep kvs- let fs = map (\(k,vs) -> k ++ " : " ++ jsList vs) kvs' ++ ["_ : [true]"]- return $ braces ("\n " ++ intercalate ",\n " fs)- where combine r (k,v) = Map.insertWith (++) k v r- prep (k, as, e@(C t s _)) =- do v <- toJS' (foldr (\x e -> C t s $ Lambda x e) e as)- return (k,[v])---instance ToJS Expr where- toJS expr =- case expr of- IntNum n -> return $ show n- FloatNum n -> return $ show n- Var x -> return $ x- Chr c -> return $ quoted [c]- Str s -> return $ "Value.str" ++ parens (quoted s)- Boolean b -> return $ if b then "true" else "false"- Range lo hi -> jsRange `liftM` toJS' lo `ap` toJS' hi- Access e x -> access x `liftM` toJS' e- Remove e x -> recordToJS e (remove x) ""- Insert e x v -> recordToJS e "r[i]=e[i];" =<< addField (x,v)- Modify e fs -> recordToJS e "r[i]=e[i];" . concat =<< mapM setField fs- Record fs -> makeRecord fs- Binop op e1 e2 -> binop op `liftM` toJS' e1 `ap` toJS' e2-- If eb et ef ->- parens `liftM` (iff `liftM` toJS' eb `ap` toJS' et `ap` toJS' ef)-- Lambda v e -> liftM (jsFunc v . ret) (toJS' e)-- App (C _ _ (Var "toText")) (C _ _ (Str s)) ->- return $ "toText" ++ parens (quoted s)-- App (C _ _ (Var "link")) (C _ _ (Str s)) ->- return $ "link(" ++ quoted s ++ ")"-- App (C _ _ (Var "plainText")) (C _ _ (Str s)) ->- return $ "plainText(" ++ quoted s ++ ")"-- App e1 e2 -> (++) `liftM` (toJS' e1) `ap` (parens `liftM` toJS' e2)- Let defs e -> jsLet defs e- Data name es -> (\ss -> jsList $ quoted name : ss) `liftM` mapM toJS' es-- Markdown doc -> return $ "text('" ++ pad ++ md ++ pad ++ "')"- where pad = "<div style=\"height:0;width:0;\"> </div>"- md = formatMarkdown $ Pan.writeHtmlString Pan.def doc--formatMarkdown = concatMap f- where f '\'' = "\\'"- f '\n' = "\\n"- f '"' = "\""- f c = [c]--multiIfToJS span ps = format `liftM` mapM f ps- where format cs = foldr (\c e -> parens $ c ++ " : " ++ e) err cs- err = concat [ "(function(){throw new Error(\"Non-exhaustive "- , "multi-way-if expression (", show span, ")\");}())" ]- f (b,e) = do b' <- toJS' b- e' <- toJS' e- return (b' ++ " ? " ++ e')--jsLet defs e' = do- body <- (++) `liftM` jsDefs defs `ap` (ret `liftM` toJS' e')- return $ jsFunc "" body ++ "()"--jsDefs defs = concat `liftM` mapM toJS (sortBy f defs)- where f a b = compare (valueOf a) (valueOf b)- valueOf (FnDef _ args _) = min 1 (length args)- valueOf (OpDef _ _ _ _) = 1--caseToJS span e ps = do- match <- caseToMatch ps- e' <- toJS' e- (match',stmt) <- case (match,e) of- (Match name _ _, C _ _ (Var x)) -> return (matchSubst [(name,x)] match, "")- (Match name _ _, _) -> return (match, assign name e')- _ -> liftM (\n -> (match, e')) guid- matches <- matchToJS span match'- return $ concat [ "function(){", stmt, matches, "}()" ]--matchToJS span (Match name clauses def) = do- cases <- concat `liftM` mapM (clauseToJS span name) clauses- finally <- matchToJS span def- return $ concat [ "\nswitch(", name, "[0]){", indent cases, "\n}", finally ]-matchToJS span Fail = return ("\nthrow new Error(\"Non-exhaustive pattern match " ++- "in case expression (" ++ show span ++ ")\");")-matchToJS span Break = return "break;"-matchToJS span (Other e) = ret `liftM` toJS' e-matchToJS span (Seq ms) = concat `liftM` mapM (matchToJS span) ms--clauseToJS span var (Clause name vars e) = do- let vars' = map (\n -> var ++ "[" ++ show n ++ "]") [ 1 .. length vars ]- s <- matchToJS span $ matchSubst (zip vars vars') e- return $ concat [ "\ncase ", quoted name, ":", s ]--jsNil = "[\"Nil\"]"-jsCons e1 e2 = jsList [ quoted "Cons", e1, e2 ]-jsRange e1 e2 = (++"()") . jsFunc "" $- assign "lo" e1 ++ assign "hi" e2 ++ assign "lst" jsNil ++- "if(lo<=hi){do{lst=" ++ (jsCons "hi" "lst") ++ "}while(hi-->lo)}" ++- ret "lst"--binop (o:p) e1 e2- | isAlpha o || '_' == o = (o:p) ++ parens e1 ++ parens e2- | otherwise =- let ops = ["+","-","*","/","&&","||"] in- case o:p of- ":" -> jsCons e1 e2- "++" -> append e1 e2- "$" -> e1 ++ parens e2- "." -> jsFunc "x" . ret $ e1 ++ parens (e2 ++ parens "x")- "^" -> "Math.pow(" ++ e1 ++ "," ++ e2 ++ ")"- "==" -> "eq(" ++ e1 ++ "," ++ e2 ++ ")"- "/=" -> "not(eq(" ++ e1 ++ "," ++ e2 ++ "))"- "<" -> "(compare(" ++ e1 ++ ")(" ++ e2 ++ ")[0] === 'LT')"- ">" -> "(compare(" ++ e1 ++ ")(" ++ e2 ++ ")[0] === 'GT')"- "<=" -> "function() { var ord = compare(" ++ e1 ++ ")(" ++- e2 ++ ")[0]; return ord==='LT' || ord==='EQ'; }()"- ">=" -> "function() { var ord = compare(" ++ e1 ++ ")(" ++- e2 ++ ")[0]; return ord==='GT' || ord==='EQ'; }()"- "<~" -> "lift" ++ parens e1 ++ parens e2- "~" -> "lift2(function(f){return function(x){return f(x);};})" ++- parens e1 ++ parens e2- _ | elem (o:p) ops -> parens (e1 ++ (o:p) ++ e2)- | otherwise -> concat [ "$op['", o:p, "']"- , parens e1, parens e2 ]--append e1 e2 = "Value.append" ++ parens (e1 ++ "," ++ e2)
− src/Gen/ExtractNoscript.hs
@@ -1,60 +0,0 @@- -module ExtractNoscript (extractNoscript) where - -import Ast -import Context -import qualified Text.Pandoc as Pan - -extractNoscript :: Module -> String -extractNoscript modul = concat (extract modul) - -class Extract a where - extract :: a -> [String] - -instance Extract Module where - extract (Module _ _ _ stmts) = - map (\s -> "<p>" ++ s ++ "</p>") (concatMap extract stmts) - -instance Extract Statement where - extract (Definition d) = extract d - extract _ = [] - -instance Extract Def where - extract (FnDef _ _ e) = extract e - extract (OpDef _ _ _ e) = extract e - -instance Extract e => Extract (Context e) where - extract (C _ _ e) = extract e - -instance Extract Expr where - extract expr = - let f = extract in - case expr of - Str s -> [s] - Binop op e1 e2 -> case (op, f e1, f e2) of - ("++", [s1], [s2]) -> [s1 ++ s2] - (_ , ss1 , ss2 ) -> ss1 ++ ss2 - Lambda v e -> f e - App (C _ _ (App (C _ _ (Var "link")) src)) txt -> linkExtract src txt - App (C _ _ (App (C _ _ (Var "Graphics.link")) src)) txt -> linkExtract src txt - App (C _ _ (App (C _ _ (Var "Text.link")) src)) txt -> linkExtract src txt - App (C _ _ (Var "header")) e -> tag "h1" e - App (C _ _ (Var "bold")) e -> tag "b" e - App (C _ _ (Var "italic")) e -> tag "i" e - App (C _ _ (Var "monospace")) e -> tag "code" e - App e1 e2 -> f e1 ++ f e2 - If eb et ef -> f et ++ f ef - Let defs e -> concatMap extract defs ++ f e - Var _ -> [] - Case e cases -> concatMap (f . snd) cases - Data _ es -> concatMap f es - Markdown doc -> [ Pan.writeHtmlString Pan.def doc ] - _ -> [] - -linkExtract src txt = - case (extract src, extract txt) of - ([s1],[s2]) -> [ "<a href=\"" ++ s1 ++ "\">" ++ s2 ++ "</a>" ] - ( ss1, ss2) -> ss1 ++ ss2 - - -tag t e = map (\s -> concat [ "<", t, ">", s, "</", t, ">" ]) (extract e)
− src/Gen/GenerateHtml.hs
@@ -1,89 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module GenerateHtml (generateHtml,- body, css, widgetBody,- modulesToHtml, linkedHtml,- JSStyle (..)- ) where--import Data.List (intercalate)-import Text.Blaze (preEscapedToMarkup)-import Text.Blaze.Html (Html)-import qualified Text.Blaze.Html5 as H-import Text.Blaze.Html5 ((!))-import qualified Text.Blaze.Html5.Attributes as A--import Text.Jasmine (minify)-import qualified Data.ByteString.Lazy.Char8 as BS--import Ast-import Initialize-import CompileToJS-import ExtractNoscript--css = H.style ! A.type_ "text/css" $ preEscapedToMarkup- ("html,head,body { padding:0; margin:0; }\- \body { font-family: helvetica, arial, sans-serif; }" :: String)--data JSStyle = Minified | Readable--makeScript :: JSStyle -> Either String String -> H.Html-makeScript _ (Left s) =- H.script ! A.type_ "text/javascript" ! A.src (H.toValue s) $ ""-makeScript jsStyle (Right s) =- H.script ! A.type_ "text/javascript" $ preEscapedToMarkup content- where content = case jsStyle of - Minified -> BS.unpack . minify . BS.pack $ s- Readable -> s---- |This function compiles Elm code into simple HTML.------ Usage example:------ > generateHtml "/elm-min.js" "Some title" [elmFile|elm-source/somePage.elm|]-generateHtml :: String -- ^ Location of elm-min.js as expected by the browser- -> String -- ^ The page title- -> String -- ^ The elm source code.- -> Html-generateHtml libLoc title source =- case initialize source of- Left err -> createHtml Readable libLoc title (Right $ showErr err) (H.noscript "")- Right (escs, modul) -> modulesToHtml Readable title libLoc [] True [(escs,modul)]---modulesToHtml jsStyle title libLoc jss nscrpt pairs =- createHtml jsStyle libLoc title' js noscript- where modules = map snd pairs- js = Right $ jss ++ concatMap jsModule pairs- noscript = if nscrpt then extractNoscript $ last modules else ""- title' = if null title then altTitle else title- altTitle = (\(Module names _ _ _) -> intercalate "." names) $- last modules- --linkedHtml rtLoc jsLoc modules =- createHtml Readable rtLoc title (Left jsLoc) (H.noscript "")- where title = (\(Module names _ _ _) -> intercalate "." names) $- snd (last modules)---createHtml jsStyle libLoc title js noscript =- H.docTypeHtml $ do - H.head $ do- H.meta ! A.charset "UTF-8"- H.title . H.toHtml $ title- css- H.body $ do- makeScript Readable (Left libLoc)- makeScript jsStyle js- body noscript--body noscript = do- H.div ! A.id "widthChecker" ! A.style "width:100%; height:1px; position:absolute; top:-1px;" $ ""- H.div ! A.id "content" $ ""- H.script ! A.type_ "text/javascript" $ "Dispatcher.initialize()"- H.noscript $ preEscapedToMarkup noscript--widgetBody noscript = do- H.div ! A.id "widthChecker" ! A.style "width:100%; height:1px; position:absolute; top:-1px;" $ ""- H.div ! A.id "content" $ ""- H.noscript $ preEscapedToMarkup noscript
− src/Guid.hs
@@ -1,16 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-} -module Guid (guid, run, GuidCounter) where - -import Control.Monad.State (evalState, State, get, put) - --- Wrapper around State monad. -newtype GuidCounter a = GC { runGC :: State Int a } - deriving (Monad) - --- Get the next GUID, incrementing the counter. -guid :: GuidCounter Int -guid = GC $ do n <- get - put (n + 1) - return n - -run x = evalState (runGC x) 0
− src/Initialize.hs
@@ -1,22 +0,0 @@-module Initialize (initialize) where--import Control.Applicative ((<$>))-import Control.Monad.Error-import Data.List (lookup)--import Ast-import Parse.Parser (parseProgram)-import Rename-import Types.Types ((-:))-import Types.Hints (hints)-import Types.Unify-import Optimize---initialize str =- do modul@(Module name ex im stmts) <- parseProgram str- (escapees, subs) <- unify hints modul- let modul' = optimize . renameModule $ Module name ex im' stmts- where im' | any ((=="Prelude") . fst) im = im- | otherwise = ("Prelude", Hiding []) : im- subs `seq` return (escapees, modul')
− src/Language/Elm.hs
@@ -1,82 +0,0 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} -{- | This module exports the functions necessary for compiling Elm code into the - respective HTML, JS and CSS code. - - The type class @'ElmSource'@ requires an instance for all types that the Elm compiler - understands. The provided instances for String, Text and QuasiQuoted Elm source code - should be sufficient. - - The documentation for the Elm language is available at <http://elm-lang.org/Documentation.elm>, - and many interactive examples are available at <http://elm-lang.org/Examples.elm> - - Example implementations using Yesod and Happstack are available at <https://github.com/tazjin/Elm/tree/master/Examples> --} -module Language.Elm ( - ElmSource (..), - runtimeLocation - ) where - -import Data.Version (showVersion) -import CompileToJS -import ExtractNoscript -import GenerateHtml -import Initialize -import Text.Blaze.Html (Html) -import Language.Elm.Quasi -import Paths_Elm - -import qualified Data.Text as TS -import qualified Data.Text.Lazy as TL - --- |The absolute path to Elm's runtime system. -runtimeLocation :: IO FilePath -runtimeLocation = - getDataFileName ("elm-runtime-" ++ showVersion version ++ ".js") - -class ElmSource a where - -- |This function compiles Elm code to three separate parts: HTML, CSS, - -- and JavaScript. The HTML is only the contents of the body, so the three - -- parts must be combined in a basic HTML skeleton. - toParts :: a -> (Html, Html, String) - - -- |This function compiles Elm code into a full HTML page. - toHtml :: String -- ^ Location of elm-min.js as expected by the browser - -> String -- ^ The page title - -> a -- ^ The elm source code - -> Html - -instance ElmSource String where - toParts = toPartsHelper - toHtml = generateHtml - -instance ElmSource Elm where - toParts = toPartsHelper . TL.unpack . renderElm - toHtml elmL title = generateHtml elmL title . TL.unpack . renderElm - --- |Strict text -instance ElmSource TS.Text where - toParts = toPartsHelper . TS.unpack - toHtml elmL title = generateHtml elmL title . TS.unpack - --- |Lazy text -instance ElmSource TL.Text where - toParts = toPartsHelper . TL.unpack - toHtml elmL title = generateHtml elmL title . TL.unpack - --- | (urlRenderFn, urlRenderFn -> Elm) -instance ElmSource (t, t -> Elm) where - toParts (f, s) = toPartsHelper $ TL.unpack $ renderElm $ s f - toHtml elmL title (f, s) = generateHtml elmL title $ TL.unpack $ renderElm $ s f - --- | to be used without URL interpolation -instance ElmSource (t -> Elm) where - toParts s = toPartsHelper $ TL.unpack $ renderElm $ s undefined - toHtml l t s = generateHtml l t $ TL.unpack $ renderElm $ s undefined - - --- build helper to avoid boilerplate repetition -toPartsHelper :: String -> (Html, Html, String) -toPartsHelper source = (html, css, js) - where modul = initialize source - js = either showErr jsModule modul - html = widgetBody $ either id (extractNoscript . snd) modul
− src/Language/Elm/Quasi.hs
@@ -1,93 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE CPP #-}-{-# OPTIONS_GHC -fno-warn-missing-fields #-}---- | This module contains Shakespearean (see "Text.Shakespeare") templates for Elm.--- It introduces type-safe compile-time variable and URL interpolation. A typeclass--- @'ToElm'@ is provided for interpolated variables.------ Further reading on Shakespearean templates: <http://www.yesodweb.com/book/templates>------ Further reading on Elm: <http://elm-lang.org> -module Language.Elm.Quasi- ( -- * Functions- -- ** Template-Reading Functions- -- |These QuasiQuoters return functions of the type @(t -> 'Elm')@- -- where @t@ is the URL rendering function if type-safe URLs are used.- --- -- A usage example for both type-safe (Yesod) and standard path segment (Happstack)- -- URLs is provided in the Examples folder in the Git repository.- elm- , elmFile- , elmFileReload-- -- * Datatypes- , Elm (..)-- -- * Typeclass for interpolated variables- , ToElm (..)-- -- ** Rendering Functions- , renderElm-- ) where--import Language.Haskell.TH.Quote (QuasiQuoter (..))-import Language.Haskell.TH.Syntax-import Data.Text.Lazy.Builder (Builder, fromText, toLazyText, fromLazyText)-import Data.Monoid-import qualified Data.Text as TS-import qualified Data.Text.Lazy as TL-import Text.Shakespeare---- | Render Elm to lazy Text.-renderElm :: Elm -> TL.Text-renderElm (Elm b) = toLazyText b---- | Newtype wrapper of 'Builder'.-newtype Elm = Elm { unElm :: Builder }- deriving Monoid---- | A typeclass for types that can be interpolated in Elm templates.-class ToElm a where- toElm :: a -> Builder-instance ToElm [Char] where toElm = fromLazyText . TL.pack-instance ToElm TS.Text where toElm = fromText-instance ToElm TL.Text where toElm = fromLazyText--elmSettings :: Q ShakespeareSettings-elmSettings = do- toJExp <- [|toElm|]- wrapExp <- [|Elm|]- unWrapExp <- [|unElm|]- return $ defaultShakespeareSettings { toBuilder = toJExp- , wrap = wrapExp- , unwrap = unWrapExp- }---- |QuasiQuoter for embedding Elm code inside of Haskell code.------ Usage:--- @[elm|main = plaintext \"Some elm code\"|]@-elm :: QuasiQuoter-elm = QuasiQuoter { quoteExp = \s -> do- rs <- elmSettings- quoteExp (shakespeare rs) s- }---- |A Template Haskell function for embedding Elm code from external--- .elm files.------ Usage:--- @$(elmFile \"elm_source/index.elm\")@-elmFile :: FilePath -> Q Exp-elmFile fp = do- rs <- elmSettings- shakespeareFile rs fp--elmFileReload :: FilePath -> Q Exp-elmFileReload fp = do- rs <- elmSettings- shakespeareFileReload rs fp
− src/Optimize.hs
@@ -1,134 +0,0 @@-module Optimize (optimize) where--import Ast-import Context-import Control.Arrow (second)-import Data.Char (isAlpha)-import Substitute--optimize (Module name ims exs stmts) =- Module name ims exs (map optimizeStmt stmts)--optimizeStmt stmt = if stmt == stmt' then stmt' else optimizeStmt stmt'- where stmt' = simp stmt--class Simplify a where- simp :: a -> a--instance Simplify Statement where- simp (Definition def) = Definition (simp def)- simp (ImportEvent js b elm t) = ImportEvent js (simp b) elm t- simp stmt = stmt--instance Simplify Def where- simp (FnDef func args e) = FnDef func args (simp e)- simp (OpDef op a1 a2 e) = OpDef op a1 a2 (simp e)--instance Simplify e => Simplify (Context e) where- simp (C t s e) = C t s (simp e)--instance Simplify Expr where- simp expr =- let f = simp in- case expr of- Range e1 e2 -> Range (f e1) (f e2)- Binop op e1 e2 -> simp_binop op (f e1) (f e2)- Lambda x e -> Lambda x (f e)- Record fs -> Record (map (\(f,as,e) -> (f, as, simp e)) fs)- App (C t s (Lambda x e1)) e2 -> - if isValue e2' then subst x e2' e1' else App (C t s (Lambda x ce1')) ce2'- where ce1'@(C _ _ e1') = f e1- ce2'@(C _ _ e2') = f e2- App e1 e2 -> App (f e1) (f e2)- If e1 e2 e3 -> simp_if (f e1) (f e2) (f e3)- Let defs e -> Let (map simp defs) (f e)- Data name es -> Data name (map f es)- Case e cases -> Case (f e) (map (second f) cases)- _ -> expr--simp_if (C _ _ (Boolean b)) (C _ _ e2) (C _ _ e3) = if b then e2 else e3-simp_if a b c = If a b c--isValue e =- case e of { IntNum _ -> True- ; FloatNum _ -> True- ; Chr _ -> True- ; Str _ -> True- ; Boolean _ -> True- ; Var _ -> True- ; Data _ _ -> True- ; _ -> False }--simp_binop = binop--binop op ce1@(C t1 s1 e1) ce2@(C t2 s2 e2) =- let c1 = C t1 s1 in- let c2 = C t2 s2 in- case (op, e1, e2) of- (_, IntNum n, IntNum m) -> case op of- { "+" -> IntNum $ (+) n m- ; "-" -> IntNum $ (-) n m- ; "*" -> IntNum $ (*) n m- ; "^" -> IntNum $ n ^ m- ; "div" -> IntNum $ div n m- ; "mod" -> IntNum $ mod n m- ; "<" -> Boolean $ n < m- ; ">" -> Boolean $ n < m- ; "<=" -> Boolean $ n <= m- ; ">=" -> Boolean $ n >= m- ; "==" -> Boolean $ n == m- ; "/=" -> Boolean $ n /= m- ; _ -> Binop op ce1 ce2 }-- -- flip order to move lone integers to the left- ("+", _, IntNum n) -> binop "+" ce2 ce1- ("*", _, IntNum n) -> binop "*" ce2 ce1-- ("+", IntNum 0, _) -> e2- ("+", IntNum n, Binop "+" (C _ _ (IntNum m)) ce) ->- binop "+" (c1 $ IntNum (n+m)) ce- ("+", Binop "+" (C _ _ (IntNum n)) ce1'- , Binop "+" (C _ _ (IntNum m)) ce2') ->- binop "+" (noContext $ IntNum (n+m)) (noContext $ Binop "+" ce1' ce2')-- ("*", IntNum 0, _) -> e1- ("*", IntNum 1, _) -> e2- ("*", IntNum n, Binop "*" (C _ _ (IntNum m)) ce) ->- binop "*" (noContext $ IntNum (n*m)) ce- ("*", Binop "*" (C _ _ (IntNum n)) ce1'- , Binop "*" (C _ _ (IntNum m)) ce2') ->- binop "*" (noContext $ IntNum (n*m)) (noContext $ Binop "*" ce1' ce2')-- ("-", _, IntNum 0) -> e1- ("/", _, IntNum 1) -> e1- ("div", _, IntNum 1) -> e1-- (_, Boolean n, Boolean m) -> case op of "&&" -> Boolean $ n && m- "||" -> Boolean $ n || m- _ -> Binop op ce1 ce2-- ("&&", Boolean True, _) -> e2- ("&&", Boolean False, _) -> Boolean False- ("||", Boolean True, _) -> Boolean True- ("||", Boolean False, _) -> e2-- (":", _, _) -> let (C _ _ e) = cons ce1 ce2 in e-- ("++", Str s1, Str s2) -> Str $ s1 ++ s2- ("++", Str s1, Binop "++" (C _ _ (Str s2)) ce) ->- Binop "++" (c1 $ Str $ s1 ++ s2) ce- ("++", Binop "++" e (C _ _ (Str s1)), Str s2) ->- Binop "++" e (c1 $ Str $ s1 ++ s2)-- ("++", Data "Nil" [], _) -> e2- ("++", _, Data "Nil" []) -> e1- ("++", Data "Cons" [h,t], _) -> Data "Cons" [h, noContext $ binop "++" t ce2]-- ("$", _, _) -> App ce1 ce2- (".", _, _) ->- Lambda "x" (noContext $- App ce1 (noContext $ App ce2 (noContext $ Var "x")))-- _ | isAlpha (head op) || '_' == head op ->- App (noContext $ App (noContext $ Var op) ce1) ce2- | otherwise -> Binop op ce1 ce2
− src/Parse/Binops.hs
@@ -1,88 +0,0 @@-module Parse.Binops (binops) where--import Ast-import Context-import Control.Monad (liftM,guard)-import Control.Monad.Error-import Data.List (foldl',splitAt,elemIndices- ,group,groupBy,sortBy,find,intercalate)-import qualified Data.Map as Map-import Data.Maybe (mapMaybe)--import Text.Parsec-import Parse.Library--data Assoc = L | N | R deriving (Eq,Show)--type OpTable = [(Int, Assoc, String)]--table :: OpTable-table = [ (9, R, ".")- , (8, R, "^")- , (7, L, "*"), (7, L, "/"), (7, L, "mod"), (7, L, "div"), (7, L, "rem")- , (6, L, "+"), (6, L, "-")- , (5, R, ":" ), (5, R, "++")- , (4, N, "<="), (4, N, ">="), (4, N, "<")- , (4, N, "=="), (4, N, "/="), (4, N, ">")- , (4, L, "~"), (4, L, "<~")- , (3, R, "&&")- , (2, R, "||")- , (0, R, "$")- ]--opLevel op = Map.findWithDefault 9 op dict- where dict = Map.fromList (map (\(lvl,_,op) -> (op,lvl)) table)--opAssoc op = Map.findWithDefault R op dict- where dict = Map.fromList (map (\(_,assoc,op) -> (op,assoc)) table)--hasLevel n (op,e) = opLevel op == n--sortOps :: OpTable -> OpTable-sortOps = sortBy (\(i,_,_) (j,_,_) -> compare i j)--binops :: IParser CExpr -> IParser String -> IParser CExpr-binops term anyOp = do- e <- term- split 0 e =<< many (commitIf (whitespace >> anyOp) $ do- whitespace ; op <- anyOp- whitespace ; e <- term- return (op,e))--split :: Int -> CExpr -> [(String, CExpr)] -> IParser CExpr-split _ e [] = return e-split n e eops = do- assoc <- getAssoc n eops- es <- sequence (splitLevel n e eops)- let ops = map fst (filter (hasLevel n) eops)- case assoc of R -> joinR es ops- _ -> joinL es ops--splitLevel :: Int -> CExpr -> [(String, CExpr)] -> [IParser CExpr]-splitLevel n e eops =- case break (hasLevel n) eops of- (lops, (op,e'):rops) -> split (n+1) e lops : splitLevel n e' rops- (lops, []) -> [ split (n+1) e lops ]--joinL :: [CExpr] -> [String] -> IParser CExpr-joinL [e] [] = return e-joinL (a:b:es) (op:ops) = joinL (epos a b (Binop op a b) : es) ops-joinL _ _ = fail "Ill-formed binary expression. Report a compiler bug."--joinR :: [CExpr] -> [String] -> IParser CExpr-joinR [e] [] = return e-joinR (a:b:es) (op:ops) = do e <- joinR (b:es) ops- return (epos a e (Binop op a e))-joinR _ _ = fail "Ill-formed binary expression. Report a compiler bug."--getAssoc :: Int -> [(String,CExpr)] -> IParser Assoc-getAssoc n eops | all (==L) assocs = return L- | all (==R) assocs = return R - | all (==N) assocs = case assocs of [_] -> return N- _ -> fail msg- where levelOps = filter (hasLevel n) eops- assocs = map (opAssoc . fst) levelOps- msg = concat [ "Conflicting precedence for binary operators ("- , intercalate ", " (map fst eops), "). "- , "Consider adding parentheses to disambiguate." ]-
− src/Parse/Expr.hs
@@ -1,214 +0,0 @@-module Parse.Expr (def,term) where--import Ast-import Context-import Control.Applicative ((<$>), (<*>))-import Control.Monad-import Data.Char (isSymbol, isDigit)-import Data.List (foldl')-import Text.Parsec hiding (newline,spaces)-import Text.Parsec.Indent-import qualified Text.Pandoc as Pan--import Parse.Library-import Parse.Patterns-import Parse.Binops--import Guid-import Types.Types (Type (VarT), Scheme (Forall))--import System.IO.Unsafe----------- Basic Terms ----------numTerm :: IParser Expr-numTerm = toExpr <$> (preNum <?> "number")- where toExpr n | '.' `elem` n = FloatNum (read n)- | otherwise = IntNum (read n)- preNum = (++) <$> many1 digit <*> option "" postNum- postNum = do try $ lookAhead (string "." >> digit)- string "."- ('.':) <$> many1 digit--strTerm :: IParser Expr-strTerm = liftM Str . expecting "string" . betwixt '"' '"' . many $- backslashed <|> satisfy (/='"')--varTerm :: IParser Expr-varTerm = toVar <$> var <?> "variable"--toVar v = case v of "True" -> Boolean True- "False" -> Boolean False- _ -> Var v--chrTerm :: IParser Expr-chrTerm = Chr <$> betwixt '\'' '\'' (backslashed <|> satisfy (/='\''))- <?> "character"--accessor :: IParser Expr-accessor = do- start <- getPosition- lbl <- try (string "." >> rLabel)- end <- getPosition- let ctx e = addCtx ("." ++ lbl) (pos start end e)- return (Lambda "_" (ctx $ Access (ctx $ Var "_") lbl))----------- Complex Terms ----------listTerm :: IParser Expr-listTerm =- (do { try $ string "[markdown|"- ; md <- filter (/='\r') <$> manyTill anyChar (try $ string "|]")- ; return . Markdown $ Pan.readMarkdown Pan.def md })- <|> (braces $ choice- [ try $ do { lo <- expr; whitespace; string ".." ; whitespace- ; Range lo <$> expr }- , do (C _ _ e) <- list <$> commaSep expr- return e- ])--parensTerm :: IParser CExpr-parensTerm = parens $ choice- [ do start <- getPosition- op <- try anyOp- end <- getPosition- let ctxt = pos start end- return . ctxt . Lambda "x" . ctxt . Lambda "y" . ctxt $- Binop op (ctxt $ Var "x") (ctxt $ Var "y")- , do start <- getPosition- let comma = char ',' <?> "comma ','"- commas <- comma >> many (whitespace >> comma)- end <- getPosition- let vars = map (('v':) . show) [ 0 .. length commas + 1 ]- ctxt = pos start end- return $ foldr (\x e -> ctxt $ Lambda x e)- (ctxt . tuple $ map (ctxt . Var) vars) vars- , do start <- getPosition- es <- commaSep expr- end <- getPosition- return $ case es of [e] -> e- _ -> pos start end (tuple es)- ]--recordTerm :: IParser CExpr-recordTerm = brackets $ choice [ misc, addContext record ]- where field = do- fDefs <- (:) <$> (PVar <$> rLabel) <*> spacePrefix patternTerm- whitespace- e <- string "=" >> whitespace >> expr- run $ flattenPatterns fDefs e- extract [ FnDef f args exp ] = return (f,args,exp)- extract _ = fail "Improperly formed record field."- record = Record <$> (mapM extract =<< commaSep field)- change = do- lbl <- rLabel- whitespace >> string "<-" >> whitespace- (,) lbl <$> expr- remove r = addContext (string "-" >> whitespace >> Remove r <$> rLabel)- insert r = addContext $ do- string "|" >> whitespace- Insert r <$> rLabel <*>- (whitespace >> string "=" >> whitespace >> expr)- modify r = addContext- (string "|" >> whitespace >> Modify r <$> commaSep1 change)- misc = try $ do- record <- addContext (Var <$> rLabel)- whitespace- opt <- optionMaybe (remove record)- whitespace- case opt of- Just e -> try (insert e) <|> return e- Nothing -> try (insert record) <|> try (modify record)- --term :: IParser CExpr-term = addContext (choice [ numTerm, strTerm, chrTerm, listTerm, accessor ])- <|> accessible (addContext varTerm <|> parensTerm <|> recordTerm)- <?> "basic term (4, x, 'c', etc.)"---------- Applications ----------appExpr :: IParser CExpr-appExpr = do- tlist <- spaceSep1 term- return $ case tlist of- t:[] -> t- t:ts -> foldl' (\f x -> epos f x $ App f x) t ts---------- Normal Expressions ----------binaryExpr :: IParser CExpr-binaryExpr = binops appExpr anyOp--ifExpr :: IParser Expr-ifExpr = reserved "if" >> whitespace >> (normal <|> multiIf)- where normal = do e1 <- expr ; whitespace- reserved "then" ; whitespace ; e2 <- expr- whitespace <?> "an 'else' branch"- reserved "else" <?> "an 'else' branch" ; whitespace- If e1 e2 <$> expr- multiIf = (MultiIf <$> spaceSep1 iff)- where iff = do string "|" ; whitespace- b <- expr ; whitespace ; string "->" ; whitespace- (,) b <$> expr--lambdaExpr :: IParser CExpr-lambdaExpr = do char '\\' <|> char '\x03BB' <?> "anonymous function"- whitespace- pats <- spaceSep1 patternTerm- whitespace ; arrow ; whitespace- e <- expr- return . run $ makeLambda pats e--defSet :: IParser [Def]-defSet = concat <$> block (do d <- assignExpr ; whitespace ; return d)--letExpr :: IParser Expr-letExpr = do- reserved "let" ; whitespace- defs <- defSet- whitespace ; reserved "in" ; whitespace- Let defs <$> expr--caseExpr :: IParser Expr-caseExpr = do- reserved "case"; whitespace; e <- expr; whitespace; reserved "of"; whitespace- Case e <$> (with <|> without)- where case_ = do p <- patternExpr; whitespace; arrow; whitespace- (,) p <$> expr- with = brackets (semiSep1 (case_ <?> "cases { x -> ... }"))- without = block (do c <- case_ ; whitespace ; return c)--expr = addContext (choice [ ifExpr, letExpr, caseExpr ])- <|> lambdaExpr- <|> binaryExpr - <?> "an expression"--funcDef = try (do p1 <- try patternTerm ; infics p1 <|> func p1)- <|> ((:[]) <$> patternExpr)- <?> "the definition of a variable (x = ...)"- where func p@(PVar v) = (p:) <$> spacePrefix patternTerm- func p = do try (lookAhead (whitespace >> string "="))- return [p]- infics p1 = do- o:p <- try (whitespace >> anyOp)- p2 <- (whitespace >> patternTerm)- return $ if o == '`' then [ PVar $ takeWhile (/='`') p, p1, p2 ]- else [ PVar (o:p), p1, p2 ]--assignExpr :: IParser [Def]-assignExpr = withPos $ do- fDefs <- funcDef- whitespace- e <- string "=" >> whitespace >> expr- run $ flattenPatterns fDefs e--def = map Definition <$> assignExpr---parseDef str =- case iParse def "" str of- Right result -> Right result- Left err -> Left $ "Parse error at " ++ show err
− src/Parse/Foreign.hs
@@ -1,61 +0,0 @@--module Parse.Foreign (foreignDef) where--import Control.Applicative ((<$>), (<*>))-import Data.Either (partitionEithers)-import Text.Parsec hiding (newline,spaces)--import Ast-import Parse.Library-import Parse.Expr (term)-import Parse.Types-import Types.Types (signalOf)---foreignDef = do try (reserved "foreign") ; whitespace- importEvent <|> exportEvent--exportEvent = do- try (reserved "export" >> whitespace >> reserved "jsevent" >> whitespace)- js <- jsVar ; whitespace- elm <- lowVar ; whitespace- string "::" ; whitespace- tipe <- typeExpr- case tipe of- ADTPT "Signal" [pt] ->- either fail (return . ExportEvent js elm . signalOf) (toForeignType pt)- _ -> fail "When exporting events, the exported value must be a Signal."--importEvent = do- try (reserved "import" >> whitespace >> reserved "jsevent" >> whitespace)- js <- jsVar ; whitespace- base <- term <?> "Base case for imported signal (signals cannot be undefined)"- whitespace- elm <- lowVar <?> "Name of imported signal"- whitespace ; string "::" ; whitespace- tipe <- typeExpr- case tipe of- ADTPT "Signal" [pt] ->- either fail (return . ImportEvent js base elm . signalOf) (toForeignType pt)- _ -> fail "When importing events, the imported value must be a Signal."---jsVar :: (Monad m) => ParsecT [Char] u m String-jsVar = betwixt '"' '"' $ do- v <- (:) <$> (letter <|> char '_') <*> many (alphaNum <|> char '_')- if v `notElem` jsReserveds then return v else- fail $ "'" ++ v ++- "' is not a good name for a importing or exporting JS values."--jsReserveds =- [ "null", "undefined", "Nan", "Infinity", "true", "false", "eval"- , "arguments", "int", "byte", "char", "goto", "long", "final", "float"- , "short", "double", "native", "throws", "boolean", "abstract", "volatile"- , "transient", "synchronized", "function", "break", "case", "catch"- , "continue", "debugger", "default", "delete", "do", "else", "finally"- , "for", "function", "if", "in", "instanceof", "new", "return", "switch"- , "this", "throw", "try", "typeof", "var", "void", "while", "with", "class"- , "const", "enum", "export", "extends", "import", "super", "implements"- , "interface", "let", "package", "private", "protected", "public"- , "static", "yield"- ]
− src/Parse/Library.hs
@@ -1,180 +0,0 @@--module Parse.Library where--import Ast-import Context-import Control.Applicative ((<$>),(<*>))-import Control.Monad-import Control.Monad.State-import Data.Char (isSymbol,isUpper)-import Rename (deprime)-import Text.Parsec hiding (newline,spaces,State)-import Text.Parsec.Indent--reserveds = [ "if", "then", "else"- , "case", "of", "data"- , "let", "in"- , "module", "where"- , "import", "as", "hiding"- , "export", "foreign" ]--expecting = flip (<?>)--type IParser a = ParsecT String () (State SourcePos) a--iParse :: IParser a -> SourceName -> String -> Either ParseError a-iParse aParser source_name input =- runIndent source_name $ runParserT aParser () source_name input--backslashed :: IParser Char-backslashed = do { char '\\'; c <- anyChar- ; return . read $ ['\'','\\',c,'\''] }--var :: IParser String-var = makeVar (letter <|> char '_' <?> "variable")--lowVar :: IParser String-lowVar = makeVar (lower <?> "lower case variable")-capVar :: IParser String-capVar = makeVar (upper <?> "upper case variable")--rLabel :: IParser String-rLabel = deprime <$> lowVar--innerVarChar :: IParser Char-innerVarChar = alphaNum <|> char '_' <|> char '\'' <?> "" --makeVar :: IParser Char -> IParser String-makeVar p = do v <- (:) <$> p <*> many innerVarChar- guard (v `notElem` reserveds)- return v--reserved :: String -> IParser String-reserved word =- try (string word >> notFollowedBy innerVarChar) >> return word- <?> "reserved word '" ++ word ++ "'"--anyOp :: IParser String-anyOp = betwixt '`' '`' var <|> symOp <?> "infix operator (e.g. +, *, ||)"--isOp c = isSymbol c || elem c "+-/*=.$<>:&|^?%#@~!"--symOp :: IParser String-symOp = do op <- many1 (satisfy isOp)- guard (op `notElem` [ "=", "..", "->", "--", "|", "\8594" ])- case op of- "." -> notFollowedBy lower >> return op- _ -> return op--arrow :: IParser String-arrow = string "->" <|> string "\8594" <?> "arrow (->)"---commitIf check p = commit <|> try p- where commit = do (try $ lookAhead check) >> p--spaceySepBy1 :: IParser b -> IParser a -> IParser [a]-spaceySepBy1 sep p = do- a <- p- (a:) <$> many (commitIf (whitespace >> sep) (whitespace >> sep >> whitespace >> p))---commaSep1 :: IParser a -> IParser [a]-commaSep1 = spaceySepBy1 (char ',' <?> "comma ','")--commaSep :: IParser a -> IParser [a]-commaSep = option [] . commaSep1--semiSep1 :: IParser a -> IParser [a]-semiSep1 = spaceySepBy1 (char ';' <?> "semicolon ';'")--pipeSep1 :: IParser a -> IParser [a]-pipeSep1 = spaceySepBy1 (char '|' <?> "type divider '|'")--consSep1 :: IParser a -> IParser [a]-consSep1 = spaceySepBy1 (char ':' <?> "cons operator ':'")--dotSep1 :: IParser a -> IParser [a]-dotSep1 p = (:) <$> p <*> many (try (char '.') >> p)--spaceSep1 :: IParser a -> IParser [a]-spaceSep1 p = (:) <$> p <*> spacePrefix p--spacePrefix p = many (try (whitespace >> indented >> p))--followedBy a b = do x <- a ; b ; return x--betwixt a b c = do char a ; out <- c- char b <?> "closing '" ++ [b] ++ "'" ; return out--surround a z name p = do- char a ; whitespace ; v <- p ; whitespace- char z <?> unwords ["closing", name, show z]- return v--braces :: IParser a -> IParser a-braces = surround '[' ']' "brace"--parens :: IParser a -> IParser a-parens = surround '(' ')' "paren"--brackets :: IParser a -> IParser a-brackets = surround '{' '}' "bracket"--addContext :: IParser Expr -> IParser CExpr-addContext expr = do- start <- getPosition- e <- expr- end <- getPosition- return (pos start end e)--accessible :: IParser CExpr -> IParser CExpr-accessible expr = do- start <- getPosition- ce@(C s t e) <- expr- let rest f = do- let dot = char '.' >> notFollowedBy (char '.')- access <- optionMaybe (try dot <?> "field access (e.g. List.map)")- case access of- Nothing -> return ce- Just _ -> accessible $ do- v <- var <?> "field access (e.g. List.map)"- end <- getPosition- return (pos start end (f v))- case e of Var (c:cs) | isUpper c -> rest (\v -> Var (c:cs ++ '.':v))- | otherwise -> rest (Access ce)- _ -> rest (Access ce)---spaces :: IParser String-spaces = many1 ((multiComment <|> string " " <?> "") >> return ' ') <?> "spaces"--forcedWS :: IParser [String]-forcedWS = try (do { spaces; many nl_space }) <|> try (many1 nl_space)- where nl_space = try $ many1 newline >> spaces--whitespace :: IParser ()-whitespace = optional forcedWS <?> ""--freshLine :: IParser [[String]]-freshLine = try (do { many1 newline; many space_nl }) <|> try (many1 space_nl) <?> ""- where space_nl = try $ spaces >> many1 newline--newline :: IParser String-newline = simpleNewline <|> lineComment <?> ""--simpleNewline :: IParser String-simpleNewline = try (string "\r\n") <|> string "\n"--lineComment :: IParser String-lineComment = do try (string "--")- manyTill anyChar $ simpleNewline <|> (eof >> return "\n")--multiComment :: IParser String-multiComment = do { try (string "{-"); closeComment }--closeComment :: IParser String-closeComment = manyTill anyChar . choice $- [ try (string "-}") <?> "close comment"- , do { try $ string "{-"; closeComment; closeComment }- ]
− src/Parse/Modules.hs
@@ -1,47 +0,0 @@--module Parse.Modules (moduleDef, imports) where--import Control.Applicative ((<$>), (<*>))-import Data.List (intercalate)-import Text.Parsec hiding (newline,spaces)--import Ast-import Parse.Library--varList :: IParser [String]-varList = parens $ commaSep1 (var <|> parens symOp)--moduleDef :: IParser ([String], [String])-moduleDef = do- try (reserved "module")- whitespace- names <- dotSep1 capVar <?> "name of module"- whitespace- exports <- option [] varList- whitespace <?> "reserved word 'where'"- reserved "where"- return (names, exports)--imports :: IParser Imports-imports = option [] ((:) <$> import' <*> many (try (freshLine >> import')))---import' :: IParser (String, ImportMethod)-import' = do- reserved "import"- whitespace- name <- intercalate "." <$> dotSep1 capVar- method <- option (Hiding []) $ try (whitespace >>- (as' <|> hiding' <|> importing'))- return (name, method)---as' :: IParser ImportMethod-as' = reserved "as" >> whitespace >> As <$> capVar <?> "alias for module"--hiding' :: IParser ImportMethod-hiding' = reserved "hiding" >> whitespace >>- Hiding <$> varList <?> "listing of hidden values"--importing' :: IParser ImportMethod-importing' = Importing <$> varList <?> "listing of imported values (x,y,z)"
− src/Parse/Parser.hs
@@ -1,41 +0,0 @@-module Parse.Parser (parseProgram) where--import Ast-import Control.Applicative ((<$>), (<*>))-import Control.Monad-import Data.Char (isSymbol, isDigit)-import Data.List (foldl')-import Text.Parsec hiding (newline,spaces)--import Parse.Library-import Parse.Expr-import Parse.Types-import Parse.Modules-import Parse.Foreign---statement = (:[]) <$> foreignDef- <|> (:[]) <$> datatype- <|> def- <?> "datatype or variable definition"--freshDef = commitIf (freshLine >> (letter <|> char '_')) $ do- freshLine- statement <?> "another datatype or variable definition"--defs1 = do d <- statement <?> "at least one datatype or variable definition"- concat <$> (d:) <$> many freshDef--program = do- optional freshLine- (names,exports) <- option (["Main"],[]) (moduleDef `followedBy` freshLine)- is <- (do try (lookAhead $ reserved "import")- imports `followedBy` freshLine) <|> return []- statements <- defs1- optional freshLine ; optional spaces ; eof- return $ Module names exports is statements--parseProgram source = - case iParse program "" source of- Right result -> Right result- Left err -> Left $ "Parse error at " ++ show err
− src/Parse/Patterns.hs
@@ -1,104 +0,0 @@--module Parse.Patterns (patternTerm, patternExpr, makeLambda, flattenPatterns) where--import Ast-import Context-import Control.Applicative ((<$>),(<*>))-import Control.Monad-import Control.Monad.State-import Data.Char (isUpper)-import Guid-import Text.Parsec hiding (newline,spaces,State)-import Text.Parsec.Indent-import Parse.Library--patternBasic :: IParser Pattern-patternBasic =- choice [ char '_' >> return PAnything- , do x@(c:_) <- var- return $ if isUpper c then PData x [] else PVar x- ]--patternRecord :: IParser Pattern-patternRecord = PRecord <$> brackets (commaSep1 lowVar)--patternTuple :: IParser Pattern-patternTuple = do ps <- parens (commaSep patternExpr)- return $ case ps of { [p] -> p; _ -> ptuple ps }--patternList :: IParser Pattern-patternList = plist <$> braces (commaSep patternExpr)--patternTerm :: IParser Pattern-patternTerm = choice [ patternRecord, patternTuple, patternList, patternBasic ]- <?> "pattern"--patternConstructor :: IParser Pattern-patternConstructor = PData <$> capVar <*> spacePrefix patternTerm--patternExpr :: IParser Pattern-patternExpr = foldr1 pcons <$> consSep1 (patternConstructor <|> patternTerm) <?> "pattern"--makeLambda :: [Pattern] -> CExpr -> GuidCounter CExpr-makeLambda pats body = go (reverse pats) body- where go [] body = return body- go (p:ps) body@(C t s _) = do- (x,e) <- extract p body- go ps (C t s $ Lambda x e)- -extract :: Pattern -> CExpr -> GuidCounter (String, CExpr)-extract pattern body@(C t s _) =- let ctx = C t s in- let fn x e = (x,e) in- case pattern of- PAnything -> return $ fn "_" body- PVar x -> return $ fn x body- PData name ps -> do- x <- guid- let a = '_' : show x- return . fn a . ctx $ Case (ctx (Var a)) [(pattern, body)]- PRecord fs -> do- x <- guid- let a = '_' : show x- toDef f = FnDef f [] (ctx $ Access (ctx $ Var a) f)- return . fn a . ctx $ Let (map toDef fs) body--extracts :: [Pattern] -> CExpr -> GuidCounter ([String], CExpr)-extracts ps body = go [] (reverse ps) body- where go args [] body = return (args, body)- go args (p:ps) body = do (x,e) <- extract p body- go (x:args) ps e--flattenPatterns :: [Pattern] -> CExpr -> GuidCounter (IParser [Def])-flattenPatterns patterns exp@(C t s _) =- let ctx = C t s in- case patterns of- PVar f : args -> do- (as,e) <- extracts args exp- return . return $- if isOp (head f) then let [a,b] = as in [ OpDef f a b e ]- else [ FnDef f as e ]-- [p] -> return `liftM` matchSingle p exp p-- _ -> return . fail $ "Pattern (" ++ unwords (map show patterns) ++- ") cannot be used on the left-hand side of an assign statement."--matchSingle :: Pattern -> CExpr -> Pattern -> GuidCounter [Def]-matchSingle pat exp@(C t s _) p =- let ctx = C t s in- case p of- PData _ ps -> do x <- guid- let v = '_' : show x- dss <- mapM (matchSingle p . ctx $ Var v) ps- return (FnDef v [] exp : concat dss)-- PVar x ->- return [ FnDef x [] (ctx $ Case exp [(pat, ctx $ Var x)]) ]-- PRecord fs -> do- a <- (\x -> '_' : show x) `liftM` guid- let toDef f = FnDef f [] (ctx $ Access (ctx $ Var a) f)- return (FnDef a [] exp : map toDef fs)-- PAnything -> return []
− src/Parse/Types.hs
@@ -1,113 +0,0 @@-module Parse.Types where--import Ast-import Control.Applicative ((<$>),(<*>))-import Control.Monad (liftM,mapM)-import Data.Char (isUpper,isLower)-import Data.Maybe (fromMaybe)-import Data.List (lookup)-import Text.Parsec-import Text.Parsec.Indent--import Parse.Library-import Types.Types hiding (string,parens)-import Guid--data ParseType = VarPT String- | LambdaPT ParseType ParseType- | ADTPT String [ParseType]- | RecordPT [(String,ParseType)]--listPT t = ADTPT "List" [t]-tuplePT ts = ADTPT ("Tuple" ++ show (length ts)) ts--typeVar :: IParser ParseType-typeVar = VarPT <$> lowVar <?> "type variable"--typeList :: IParser ParseType-typeList = listPT <$> braces typeExpr--typeTuple :: IParser ParseType-typeTuple = do ts <- parens (commaSep typeExpr)- return $ case ts of { [t] -> t ; _ -> tuplePT ts }--typeRecord :: IParser ParseType-typeRecord = fmap RecordPT . brackets . commaSep $ do- lbl <- rLabel- whitespace >> string "::" >> whitespace- (,) lbl <$> typeExpr--typeUnambiguous :: IParser ParseType-typeUnambiguous = typeList <|> typeTuple <|> typeRecord--typeSimple :: IParser ParseType-typeSimple = dealias <$> var- where dealias "String" = listPT (VarPT "Char")- dealias "Time" = VarPT "Float"- dealias v = VarPT v--typeApp :: IParser ParseType-typeApp = do name <- capVar <?> "type constructor"- args <- spacePrefix (typeUnambiguous <|> typeSimple)- return $ case args of- [] -> VarPT name- _ -> ADTPT name args--typeExpr :: IParser ParseType-typeExpr = do- t1 <- typeVar <|> typeApp <|> typeUnambiguous- whitespace ; arr <- optionMaybe arrow ; whitespace- case arr of Just _ -> LambdaPT t1 <$> typeExpr- Nothing -> return t1--typeConstructor :: IParser (String, [ParseType])-typeConstructor = (,) <$> (capVar <?> "another type constructor")- <*> spacePrefix (typeSimple <|> typeUnambiguous)--datatype :: IParser Statement-datatype = do- reserved "data" <?> "datatype definition (data T = A | B | ...)"- forcedWS ; name <- capVar <?> "name of data-type" ; args <- spacePrefix lowVar- whitespace ; string "=" ; whitespace- tcs <- pipeSep1 typeConstructor- case toDatatype name args tcs of- Right dt -> return dt- Left msg -> fail msg--beta = liftM VarT guid--toDatatype name args tcs = Datatype name [1..n] <$> mapM toC tcs- where n = length args- tvarDict = zip args [1..n]- toC (name,pt) = (,) name <$> mapM toT pt- toT (LambdaPT t1 t2) = (==>) <$> toT t1 <*> toT t2- toT (ADTPT name args) = ADT name <$> mapM toT args- toT (VarPT x@(c:_))- | isLower c = VarT <$> case lookup x tvarDict of- Just v -> Right v- Nothing -> Left $ msg x- | otherwise = return $ ADT x []- toT (RecordPT fs) = do fs' <- mapM (\(x,pt) -> (,) x <$> toT pt) fs- return (RecordT (recordT fs') EmptyRecord)- msg x = "Type variable '" ++ x ++- "' is unbound in type constructor '" ++ name ++ "'."---toForeignType (LambdaPT t1 t2) =- fail $ "Elm's JavaScript event interface does not yet handle functions. " ++- "Only simple values can be imported and exported in this release."- --LambdaT <$> toForeignType t1 <*> toForeignType t2-toForeignType (ADTPT name args)- | isJsStructure name = ADT name <$> mapM toForeignType args- | otherwise =- Left $ "'" ++ name ++ "' is not an exportable type " ++- "constructor. Only 'JSArray' and 'JSTupleN' are exportable."--toForeignType (VarPT x@(c:_))- | isLower c =- Left "All exported types must be concrete types (JSNumber, JSString, etc.)"- | x `elem` ["JSString","JSNumber","JSElement","JSBool"] = Right (ADT x [])- | otherwise = Left $ "'" ++ x ++ "' is not an exportable type. Only JSTypes are exportable."--isJsStructure name = name == "JSArray" || isTuple- where isTuple = "JSTuple" == take 7 name && drop 7 name `elem` map show [2..5]
− src/Rename.hs
@@ -1,143 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-module Rename (renameModule, derename, deprime) where--import Ast-import Context-import Control.Arrow (first)-import Control.Monad (ap, liftM, foldM, mapM, Monad, zipWithM)-import Control.Monad.State (evalState, State, get, put)-import Data.Char (isLower,isDigit)-import Guid--derename var- | isDigit (last var) = reverse . tail . dropWhile isDigit $ reverse var- | otherwise = var--renameModule :: Module -> Module-renameModule modul = run (rename deprime modul)--class Rename a where- rename :: (String -> String) -> a -> GuidCounter a--instance Rename Module where - rename env (Module name ex im stmts) = do stmts' <- renameStmts env stmts- return (Module name ex im stmts')--instance Rename Def where- rename env (OpDef op a1 a2 e) =- do env' <- extends env [a1,a2]- OpDef op (env' a1) (env' a2) `liftM` rename env' e- rename env (FnDef f args e) =- do env' <- extends env args- FnDef (env f) (map env' args) `liftM` rename env' e--instance Rename Statement where- rename env (Definition def) = Definition `liftM` rename env def- rename env (Datatype name args tcs) =- return $ Datatype name args $ map (first env) tcs- rename env (ImportEvent js base elm tipe) =- do base' <- rename env base- return $ ImportEvent js base' (env elm) tipe- rename env (ExportEvent js elm tipe) =- return $ ExportEvent js (env elm) tipe--renameStmts env stmts = do env' <- extends env $ concatMap getNames stmts- mapM (rename env') stmts- where getNames stmt = case stmt of- Definition (FnDef n _ _) -> [n]- Datatype _ _ tcs -> map fst tcs- ImportEvent _ _ n _ -> [n]- _ -> []--instance Rename a => Rename (Context a) where- rename env (C t s e) = C t s `liftM` rename env e- -instance Rename Expr where- rename env expr =- let rnm = rename env in- case expr of-- Range e1 e2 -> Range `liftM` rnm e1- `ap` rnm e2- - Access e x -> Access `liftM` rnm e- `ap` return x-- Remove e x -> flip Remove x `liftM` rnm e-- Insert e x v -> flip Insert x `liftM` rnm e- `ap` rnm v-- Modify e fs -> Modify `liftM` rnm e- `ap` mapM (\(x,e) -> (,) x `liftM` rnm e) fs-- Record fs -> Record `liftM` mapM frnm fs- where frnm (f,as,e) = do env' <- extends env as- e' <- rename env' e- return (f, map env' as, e') -- Binop op@(h:_) e1 e2 ->- let rop = if isLower h || '_' == h- then env op- else op- in Binop rop `liftM` rnm e1- `ap` rnm e2-- Lambda x e -> do- (rx, env') <- extend env x- Lambda rx `liftM` rename env' e-- App e1 e2 -> App `liftM` rnm e1- `ap` rnm e2-- If e1 e2 e3 -> If `liftM` rnm e1- `ap` rnm e2- `ap` rnm e3-- MultiIf ps -> MultiIf `liftM` mapM grnm ps- where grnm (b,e) = (,) `liftM` rnm b- `ap` rnm e-- Let defs e -> renameLet env defs e-- Var x -> return . Var $ env x-- Data name es -> Data name `liftM` mapM rnm es-- Case e cases -> Case `liftM` rnm e- `ap` mapM (patternRename env) cases-- _ -> return expr--deprime = map (\c -> if c == '\'' then '$' else c)--extend :: (String -> String) -> String -> GuidCounter (String, String -> String)-extend env x = do- n <- guid- let rx = deprime x ++ "_" ++ show n- return (rx, \y -> if y == x then rx else env y)--extends :: (String -> String) -> [String] -> GuidCounter (String -> String)-extends env xs = foldM (\e x -> liftM snd $ extend e x) env xs--patternExtend :: Pattern -> (String -> String) -> GuidCounter (Pattern, String -> String)-patternExtend pattern env =- case pattern of- PAnything -> return (PAnything, env)- PVar x -> first PVar `liftM` extend env x- PData name ps ->- first (PData name . reverse) `liftM` foldM f ([], env) ps- where f (rps,env') p = do (rp,env'') <- patternExtend p env'- return (rp:rps, env'')--patternRename :: (String -> String) -> (Pattern, CExpr) -> GuidCounter (Pattern, CExpr)-patternRename env (p,e) = do- (rp,env') <- patternExtend p env- re <- rename env' e- return (rp,re)--renameLet env defs e = do env' <- extends env $ concatMap getNames defs- defs' <- mapM (rename env') defs- Let defs' `liftM` rename env' e- where getNames (FnDef n _ _) = [n]- getNames (OpDef _ _ _ _) = []
− src/Substitute.hs
@@ -1,28 +0,0 @@-module Substitute (subst) where - -import Ast -import Context -import Control.Arrow (second, (***)) - -subst :: String -> Expr -> Expr -> Expr -subst old new expr = - let f (C t s e) = C t s (subst old new e) in - case expr of - Range e1 e2 -> Range (f e1) (f e2) - Access e x -> Access (f e) x - Remove e x -> Remove (f e) x - Insert e x v -> Insert (f e) x (f v) - Modify r fs -> Modify (f r) (map (second f) fs) - Record fs -> Record (map (\(lbl,as,e) -> (lbl,as,f e)) fs) - Binop op e1 e2 -> Binop op (f e1) (f e2) - Lambda x e -> if x == old then expr else Lambda x (f e) - App e1 e2 -> App (f e1) (f e2) - If e1 e2 e3 -> If (f e1) (f e2) (f e3) - MultiIf ps -> MultiIf (map (f *** f) ps) - Let defs e -> Let (map substDef defs) (f e) - where substDef (FnDef name vs e) = FnDef name vs (f e) - substDef (OpDef op a1 a2 e) = OpDef op a1 a2 (f e) - Var x -> if x == old then new else expr - Case e cases -> Case (f e) $ map (second f) cases - Data name es -> Data name (map f es) - _ -> expr
− src/Types/Constrain.hs
@@ -1,295 +0,0 @@- -module Types.Constrain (constrain) where - -import Control.Arrow (second) -import Control.Monad (liftM,mapM,zipWithM,foldM) -import Control.Monad.State (evalState) -import Data.List (foldl',sort,group,isPrefixOf,intercalate,isSuffixOf) -import qualified Data.Map as Map -import qualified Data.Set as Set - -import Ast -import Context -import Guid - -import Types.Types -import Types.Substitutions - -beta = VarT `liftM` guid -unionA = Map.unionWith (++) -unionsA = Map.unionsWith (++) - -getAliases imports hints = hints ++ concatMap aliasesFrom imports' - where imports' = map head . group $ sort imports - aliasesFrom (name,method) = - case method of - As alias -> concatMap (findAlias name alias) hints - Hiding [] -> concatMap (findAlias name "") hints - _ -> [] - findAlias mName' mAlias (name,tipe) = - let mName = mName' ++ "." in - case mName `isPrefixOf` name of - True -> [ (mAlias ++ drop (length mName) name, tipe) ] - False -> [] - -findAmbiguous hints hints' assumptions continue = - let potentialDups = map head . filter (\g -> length g > 1) . group $ sort hints' - dups = filter (\k -> Map.member k assumptions) potentialDups - in case dups of - n:_ -> return . Left $ "Error: Ambiguous occurrence of '" ++ n ++ "' could refer to " ++ - intercalate ", " (filter (isSuffixOf n) hints) - _ -> continue - -constrain typeHints (Module _ _ imports stmts) = do - (ass,css,schemess) <- unzip3 `liftM` mapM stmtGen stmts - hints <- typeHints - let extraImports = ("Time", Hiding ["read"]) : map (\n -> (n, Hiding [])) - ["List","Signal","Text","Graphics","Color"] - insert as n = do v <- guid; return $ Map.insertWith' (\_ x -> x) n [v] as - aliasHints = getAliases (imports ++ extraImports) hints - allHints = Map.fromList (aliasHints ++ concat schemess) - assumptions <- foldM insert (unionsA ass) $ map fst (concat schemess) - findAmbiguous (map fst hints) (map fst aliasHints) assumptions $ do - let f k s vs = map (\v -> C (Just k) NoSpan $ v :<<: s) vs - cs = concat . Map.elems $ Map.intersectionWithKey f allHints assumptions - escapees = Map.keys $ Map.difference assumptions allHints - return . Right . (,) escapees $ cs ++ Set.toList (Set.unions css) - -type TVarMap = Map.Map String [X] -type ConstraintSet = Set.Set (Context Constraint) - -ctx e span = C (Just $ show e) span - -gen :: CExpr -> GuidCounter (TVarMap, ConstraintSet, Type) -gen (C _ span expr) = - let ctx' = C (Just $ show expr) span in - case expr of - Var x -> - do b <- guid - return (Map.singleton x [b], Set.empty, VarT b) - - App e1 e2 -> - do (a1,c1,t1) <- gen e1 - (a2,c2,t2) <- gen e2 - b <- beta - return ( unionA a1 a2 - , Set.unions [c1,c2 - ,Set.singleton . ctx' $ t1 :=: (LambdaT t2 b)] - , b ) - - Lambda x e -> - do (a,c,t) <- gen e - b <- beta - v <- guid - return ( Map.delete x a - , Set.union c . Set.fromList . - map (\x -> ctx' $ VarT x :=: b) $ - Map.findWithDefault [v] x a - , LambdaT b t ) - - Let defs e -> - do (as,cs,t) <- gen e - (ass, schemes) <- liftM unzip (mapM defScheme defs) - let assumptions = unionsA (as:ass) - getName d = case d of FnDef f _ _ -> f - OpDef op _ _ _ -> op - names = map getName defs - genCs name s = do - v <- guid - let vs = Map.findWithDefault [v] name assumptions - return $ map (\x -> ctx name span $ x :<<: s) vs - cs' <- zipWithM genCs names schemes - return ( foldr Map.delete assumptions names - , Set.union (Set.fromList . concat $ cs') cs - , t ) - - Case e cases -> - do (as,cs,t) <- gen e - (ass,css,ts) <- liftM unzip3 $ mapM (caseGen t) cases - return ( unionsA $ as:ass - , let cases' = map snd cases - ctxs = zipWith epos cases' (tail cases') - csts = zipWith (:=:) ts (tail ts) - cs' = Set.fromList (zipWith ($) ctxs csts) - in Set.unions $ cs' : cs : css - , head ts) - - If e1 e2 e3 -> - do (a1,c1,t1) <- gen e1 - (a2,c2,t2) <- gen e2 - (a3,c3,t3) <- gen e3 - return ( unionsA [a1,a2,a3] - , let c4 = Set.fromList [ ctx e1 span (t1 :=: bool) - , ctx' (t2 :=: t3) ] - in Set.unions [c1,c2,c3,c4] - , t2 ) - - Data name es -> - gen $ foldl' (\f x -> epos f x $ App f x) (ctx' $ Var name) es - - Binop op e1 e2 -> - gen $ ctx' (App (ctx' $ App (ctx' $ Var op) e1) e2) - - Access e label -> - do (as,cs,rtype) <- gen e - t <- beta - rtype' <- beta - let fs = Map.singleton label [t] - c = (ctx' (RecordT fs rtype' :=: rtype)) - return (as, Set.insert c cs, t) - - Remove e x -> - do (as,cs,rtype) <- gen e - t <- beta - rtype' <- beta - let c = (ctx' (RecordT (Map.singleton x [t]) rtype' :=: rtype)) - return (as, Set.insert c cs, rtype') - - Insert e x v -> - do (eas,ecs,etype) <- gen e - (vas,vcs,vtype) <- gen v - return ( unionA eas vas - , Set.union ecs vcs - , RecordT (Map.singleton x [vtype]) etype ) - - Modify record fields -> - do (ras,rcs,rtype) <- gen record - (ass,css,newTs) <- unzip3 `liftM` mapM gen (map snd fields) - oldTs <- mapM (\_ -> beta) fields - rtype' <- beta - let rT ts = RecordT (recordT (zip (map fst fields) ts)) rtype' - c = Set.singleton (ctx' (rtype :=: rT oldTs)) - return ( unionsA (ras:ass), Set.unions (c : rcs : css), rT newTs ) - - Record fields -> - let insert label tipe = Map.insertWith (++) label [tipe] - getScheme (f,args,e) = do - (as, _, (label, Forall _ cs tipe)) <- defGenHelp f args e - return (as, cs, insert label tipe) - in do (ass, css, fs) <- unzip3 `liftM` mapM getScheme fields - return ( unionsA ass - , Set.fromList (concat css) - , RecordT (foldr ($) Map.empty fs) EmptyRecord ) - - Range e1@(C w1 s1 _) e2@(C w2 s2 _) -> - do (a1,c1,t1) <- gen e1 - (a2,c2,t2) <- gen e2 - return ( unionsA [a1,a2] - , Set.unions [ c1, c2, Set.fromList [ C w1 s1 (t1 :=: int) - , C w1 s2 (t2 :=: int) ] ] - , listOf int ) - - MultiIf ps -> do (ass,css,t:ts) <- unzip3 `liftM` mapM genPair ps - let cs = Set.fromList (map (ctx' . (t :=:)) ts) - return (unionsA ass, Set.unions (cs:css), t) - where genPair (b@(C t s _),e) = do - (a1,c1,t1) <- gen b - (a2,c2,t2) <- gen e - return ( unionsA [a1,a2] - , Set.unions [ c1, c2 - , Set.singleton (C t s (t1 :=: bool)) ] - , t2 ) - - IntNum _ -> do t <- beta - return (Map.empty, Set.singleton (ctx' $ t :<: number), t) - - FloatNum _ -> primitive float - Chr _ -> primitive char - Str _ -> primitive string - Boolean _ -> primitive bool - Markdown _ -> primitive element - -- _ -> beta >>= primitive - -primitive :: Type -> GuidCounter (TVarMap, ConstraintSet, Type) -primitive t = return (Map.empty, Set.empty, t) - -caseGen :: Type - -> (Pattern, CExpr) - -> GuidCounter (TVarMap, ConstraintSet, Type) -caseGen tipe (p, ce@(C _ span e)) = do - (as ,cs , t ) <- gen ce - (as',cs',[t']) <- patternGen (as,cs,[]) p - let cs'' = Set.union cs' . Set.singleton . ctx p span $ t' :=: tipe - return ( as', cs'', t ) - -patternGen :: (TVarMap, ConstraintSet, [Type]) - -> Pattern - -> GuidCounter (TVarMap, ConstraintSet, [Type]) -patternGen (as,cs,ts) PAnything = ((,,) as cs . (\t -> ts++[t])) `liftM` beta -patternGen (as,cs,ts) (PVar v) = do - b <- beta - let cs' = map (\x -> ctx v NoSpan $ VarT x :=: b) $ Map.findWithDefault [] v as - return ( Map.delete v as, Set.union cs $ Set.fromList cs', ts ++ [b] ) -patternGen (as,cs,ts) p@(PData name ps) = do - constr <- guid - output <- beta - (as',cs',ts') <- foldM patternGen (as,cs,[]) ps - let t = foldr (==>) output ts' - let getC | isTupleString name = do - vs <- mapM (\_ -> beta) ps - return . Set.singleton . C (Just $ show p) NoSpan $ output :=: ADT name vs - | otherwise = return Set.empty - cs'' <- getC - return ( unionA as' (Map.singleton name [constr]) - , Set.unions [cs',cs'' - , Set.singleton . ctx p NoSpan $ VarT constr :=: t ] - , ts ++ [output] ) - - -defScheme :: Def -> GuidCounter (Map.Map String [X], Scheme) -defScheme def = do (as,cs,hint) <- defGen def - return ( as, snd hint ) - -defGen def = case def of - FnDef f args e -> defGenHelp f args e - OpDef op a1 a2 e -> defGenHelp op [a1,a2] e - -defGenHelp name args e = do - argDict <- mapM (\a -> liftM ((,) a) guid) args - (as,cs,t) <- gen e - let as' = foldr Map.delete as args - tipe = foldr (==>) t $ map (VarT . snd) argDict - genCs (arg,x) = do - v <- guid - let as' = Map.findWithDefault [v] arg as - return $ map (\y -> ctx arg NoSpan $ VarT x :=: VarT y) as' - cs' <- concat `liftM` mapM genCs argDict - scheme <- generalize (concat $ Map.elems as') $ - Forall (map snd argDict) (cs' ++ Set.toList cs) tipe - return ( as', Set.empty, (name, scheme) ) - -stmtGen (Definition def) = do (as,cs,hint) <- defGen def - return ( as, cs, [hint] ) - -stmtGen (Datatype name xs tcs) = do schemes <- mapM gen' tcs' - return (Map.empty, Set.empty, schemes) - where var n = length xs + n - ( a, b, c) = ( var 1, var 2, var 3) - (va,vb,vc) = (VarT a, VarT b, VarT c) - rnm (ADT n []) | n == "Number" = va - | n == "Appendable" = vb - | n == "Comparable" = vc - rnm t = t - tcs' = map (second (map rnm)) tcs - supers t = map (ctx name NoSpan) $ - zipWith (:<:) [va,vb,vc] [number,appendable t,comparable] - gen' (n,ts) = do t <- beta - let s = Forall (xs ++ [a,b,c]) (supers t) $ - foldr (==>) (ADT name $ map VarT xs) ts - (,) n `liftM` generalize [] s - -stmtGen (ExportEvent js elm tipe) = do - x <- guid - return ( Map.singleton elm [x] - , Set.singleton . ctx elm NoSpan $ VarT x :=: tipe - , [] ) - -stmtGen (ImportEvent js e@(C txt span base) elm tipe) = do - (as,cs,t) <- gen e - return ( as - , Set.insert (C txt span (signalOf t :=: tipe)) cs - , [ (elm, Forall [] [] tipe) ] ) - -getDatatypeInfo (Datatype name args tcs) = - Just (name, args, tcs) -getDatatypeInfo _ = Nothing
− src/Types/Hints.hs
@@ -1,443 +0,0 @@-module Types.Hints (hints) where--import Context-import Control.Arrow (first)-import Control.Monad (liftM,mapM)-import Types.Types-import Types.Substitutions (rescheme)--ctx str = C (Just str) NoSpan-prefix pre xs = map (first (\x -> pre ++ "." ++ x)) xs---------- Text and Elements ----------textToText = [ "header", "italic", "bold", "underline"- , "overline", "strikeThrough", "monospace" ]--textAttrs = [ "toText" -: string ==> text- , "Text.typeface" -: string ==> text ==> text- , "Text.link" -:: string ==> text ==> text- , numScheme (\t -> t ==> text ==> text) "Text.height"- ] ++ prefix "Text" (hasType (text ==> text) textToText)--elements =- let iee = int ==> element ==> element in- [ "plainText" -: string ==> element- , "link" -:: string ==> element ==> element- , "flow" -: direction ==> listOf element ==> element- , "layers" -: listOf element ==> element- , "text" -: text ==> element- , "image" -: int ==> int ==> string ==> element- , "video" -: int ==> int ==> string ==> element- , "opacity" -: float ==> element ==> element- , "width" -: iee- , "height" -: iee- , "size" -: int ==> iee- , "widthOf" -: element ==> int- , "heightOf"-: element ==> int- , "sizeOf" -: element ==> pairOf int- , "color" -: color ==> element ==> element- , "container" -: int ==> int ==> position ==> element ==> element- , "spacer" -: int ==> int ==> element- , "rightedText" -: text ==> element- , "centeredText" -: text ==> element- , "justifiedText" -: text ==> element- , "asText" -:: a ==> element - , "collage" -: int ==> int ==> listOf form ==> element- , "fittedImage" -: int ==> int ==> string ==> element- ]--directions = hasType direction ["up","down","left","right","inward","outward"]-positions =- hasType position ["topLeft","midLeft","bottomLeft","midTop","middle"- ,"midBottom","topRight","midRight","bottomRight"] ++- hasType (location ==> location ==> position)- ["topLeftAt","bottomLeftAt","middleAt","topRightAt","bottomRightAt"] ++- [ "absolute" -: int ==> location, "relative" -: float ==> location ]--lineTypes = [ numScheme (\n -> listOf (pairOf n) ==> line) "line"- , numScheme (\n -> pairOf n ==> pairOf n ==> line) "segment"- , "customLine" -: listOf int ==> color ==> line ==> form- ] ++ hasType (color ==> line ==> form) ["solid","dashed","dotted"]--shapes = [ twoNums (\n m -> listOf (pairOf n) ==> pairOf m ==> shape) "polygon"- , "filled" -: color ==> shape ==> form- , "outlined" -: color ==> shape ==> form- , "textured" -: string ==> shape ==> form- , "customOutline" -: listOf int ==> color ==> shape ==> form- ] ++ map (twoNums (\n m -> n ==> n ==> pairOf m ==> shape)) [ "ngon"- , "rect"- , "oval" ]--collages = [ numScheme (\n -> pairOf n ==> element ==> form) "toForm"- , numScheme (\n -> string ==> n ==> n ==> pairOf n ==> form) "sprite"- , numScheme (\n -> n ==> n ==> form ==> form) "move"- , numScheme (\n -> n ==> form ==> form) "rotate"- , numScheme (\n -> n ==> form ==> form) "scale"- , numScheme (\n -> pairOf n ==> form ==> bool) "isWithin"- ]--graphicsElement = prefix "Graphics"- (concat [elements,directions,positions,lineTypes,shapes,collages])-graphicsColor = prefix "Color" clrs- where clrs = [ numScheme (\n -> n ==> n ==> n ==> color) "rgb"- , numScheme (\n -> n ==> n ==> n ==> n ==> color) "rgba"- , "complement" -: color ==> color- ] ++ hasType color ["red","green","blue","black","white"- ,"yellow","cyan","magenta","grey","gray"]----------- Foreign ----------casts =- [ "castJSBoolToBool" -: jsBool ==> bool- , "castBoolToJSBool" -: bool ==> jsBool- , "castJSNumberToInt" -: jsNumber ==> int- , "castIntToJSNumber" -: int ==> jsNumber- , "castJSElementToElement" -: int ==> int ==> jsElement ==> element- , "castElementToJSElement" -: element ==> jsElement- , "castJSStringToString" -: jsString ==> string- , "castStringToJSString" -: string ==> jsString- , "castJSNumberToFloat" -: jsNumber ==> float - , "castFloatToJSNumber" -: float ==> jsNumber- ]--castToTuple n = (,) name $ Forall [1..n] [] (jsTuple vs ==> tupleOf vs)- where vs = map VarT [1..n]- name = "castJSTupleToTuple" ++ show n-castToJSTuple n = (,) name $ Forall [1..n] [] (tupleOf vs ==> jsTuple vs)- where vs = map VarT [1..n]- name = "castTupleToJSTuple" ++ show n--polyCasts =- map castToTuple [2..5] ++ map castToJSTuple [2..5] ++- [ "castJSArrayToList" -:: jsArray a ==> listOf a- , "castListToJSArray" -:: listOf a ==> jsArray a- ]--javascript = prefix "JavaScript" (concat [casts,polyCasts])--json = prefix "JSON"- [ "JsonString" -: string ==> jsonValue- , "JsonBool" -: bool ==> jsonValue- , "JsonNull" -: jsonValue- , "JsonArray" -: listOf jsonValue ==> jsonValue- , "JsonObject" -: jsonObject ==> jsonValue- , numScheme (\n -> n ==> jsonValue) "JsonNumber"- , "toString" -: jsonObject ==> string- , "fromString" -: string ==> jsonObject- , "lookup" -: string ==> jsonObject ==> maybeOf jsonValue- , "findObject" -: string ==> jsonObject ==> jsonObject- , "findArray" -: string ==> jsonObject ==> listOf jsonValue- , "findString" -: string ==> jsonObject ==> string- , "findWithDefault" -:: jsonValue ==> string ==> jsonObject ==> jsonValue- , "toPrettyString" -: string ==> jsonObject ==> string- , "toPrettyJSString" -: string ==> jsonObject ==> jsString- , "toList" -: jsonObject ==> listOf (tupleOf [string,jsonValue])- , "fromList" -: listOf (tupleOf [string,jsonValue]) ==> jsonObject- , "toJSString" -: jsonObject ==> jsString- , "fromJSString" -: jsString ==> jsonObject- ]----------- Signals ----------lyft n = sig (n+1) ("lift" ++ show n)-sig n name = (,) name $ Forall [1..n] [] (fn ts ==> fn (map signalOf ts))- where fn = foldr1 (==>)- ts = map VarT [1..n]--signals = prefix "Signal"- [ sig 1 "constant"- , sig 2 "lift" - ] ++ map lyft [2..8] ++ [- "<~" -:: (a ==> b) ==> signalOf a ==> signalOf b- , "~" -:: signalOf (a ==> b) ==> signalOf a ==> signalOf b- , "foldp" -:: (a ==> b ==> b) ==> b ==> signalOf a ==> signalOf b- , "foldp1" -:: (a ==> a ==> a) ==> signalOf a ==> signalOf a- , "foldp'" -:: (a ==> b ==> b) ==> (a ==> b) ==> signalOf a ==> signalOf b- , "count" -:: signalOf a ==> signalOf int- , "countIf" -:: (a ==> bool) ==> signalOf a ==> signalOf int- , "keepIf" -:: (a ==> bool) ==> a ==> signalOf a ==> signalOf a- , "dropIf" -:: (a ==> bool) ==> a ==> signalOf a ==> signalOf a- , "keepWhen" -:: signalOf bool ==> a ==> signalOf a ==> signalOf a- , "dropWhen" -:: signalOf bool ==> a ==> signalOf a ==> signalOf a- , "dropRepeats" -:: signalOf a ==> signalOf a- , "sampleOn" -:: signalOf a ==> signalOf b ==> signalOf b- , "timestamp" -:: signalOf a ==> signalOf (tupleOf [time,a])- , "timeOf" -:: signalOf a ==> signalOf time- , "merge" -:: signalOf a ==> signalOf a ==> signalOf a- , "merges" -:: listOf (signalOf a) ==> signalOf a- , "mergeEither" -:: signalOf a ==> signalOf b ==> signalOf (eitherOf a b)- , numScheme (\n -> int ==> signalOf n ==> signalOf float) "average"- ]--http = prefix "HTTP"- [ "send" -:: signalOf (request a) ==> signalOf (response string)- , "sendGet" -:: signalOf string ==> signalOf (response string)- , "get" -: string ==> request string- , "post" -: string ==> string ==> request string- , "request" -: string ==> string ==> string ==> listOf (pairOf string) ==> request string- , "Waiting" -:: response a- , "Failure" -:: int ==> string ==> response a- , "Success" -:: a ==> response a ]- where request t = ADT "Request" [t]- response t = ADT "Response" [t]--concreteSignals = - [ "Random.inRange" -: int ==> int ==> signalOf int- , "Random.randomize" -:: int ==> int ==> signalOf a ==> signalOf int- , "Window.dimensions" -: signalOf point- , "Window.width" -: signalOf int- , "Window.height" -: signalOf int- , "Mouse.position" -: signalOf point- , "Mouse.x" -: signalOf int- , "Mouse.y" -: signalOf int- , "Mouse.isDown" -: signalOf bool- , "Mouse.isClicked" -: signalOf bool- , "Mouse.clicks" -: signalOf (tupleOf [])- , "Input.textField" -: string ==> tupleOf [element, signalOf string]- , "Input.password" -: string ==> tupleOf [element, signalOf string]- , "Input.textArea" -: int ==> int ==> tupleOf [element, signalOf string]- , "Input.checkBox" -: bool ==> tupleOf [element, signalOf bool]- , "Input.button" -: string ==> tupleOf [element, signalOf bool]- , "Input.stringDropDown" -: listOf string ==> tupleOf [element, signalOf string]- , "Input.dropDown" -:: listOf (tupleOf [string,a]) ==> tupleOf [element, signalOf a]- ]--keyboards = prefix "Keyboard"- [ "Raw.keysDown" -: signalOf (listOf int)- , "Raw.charPressed" -: signalOf (maybeOf int)- , "arrows" -: signalOf (recordOf [("x",int),("y",int)])- , "wasd" -: signalOf (recordOf [("x",int),("y",int)])- , "ctrl" -: signalOf bool- , "space" -: signalOf bool- , "shift" -: signalOf bool- ]--touches = prefix "Touch"- [ "touches" -: signalOf (listOf (recordOf [("x" ,int) ,("y" ,int)- ,("x0",int) ,("y0",int)- ,("t0",time),("id",int)]))- , "taps" -: signalOf (recordOf [("x",int),("y",int)])- ]--times = prefix "Time"- [ numScheme (\n -> n ==> signalOf time) "fps"- , numScheme (\n -> n ==> signalOf bool ==> signalOf time) "fpsWhen"- , "every" -: time ==> signalOf time- , "delay" -:: time ==> signalOf a ==> signalOf a- , "since" -:: time ==> signalOf a ==> signalOf bool- , "hour" -: time- , "minute" -: time- , "second" -: time- , "ms" -: time- , "inHours" -: time ==> float- , "inMinutes" -: time ==> float- , "inSeconds" -: time ==> float- , "inMss" -: time ==> float- , "toDate" -: time ==> date- , "read" -: string ==> maybeOf time- ]--dates =- let days = map (-: day) ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"]- months = map (-: month) [ "Jan", "Feb", "Mar", "Apr", "May", "Jun"- , "Jul", "Aug", "Sep", "Oct", "Nov", "Dec" ]- in prefix "Date"- ([ "read" -: string ==> maybeOf date- , "year" -: date ==> int- , "month" -: date ==> month- , "day" -: date ==> int- , "hour" -: date ==> int- , "minute" -: date ==> int- , "second" -: date ==> int- , "dayOfWeek" -: date ==> day- , "toTime" -: date ==> time- ] ++ days ++ months)---------- Math and Binops ----------binop t = t ==> t ==> t-scheme1 super t name =- (name, Forall [0] [ ctx name $ VarT 0 :<: super- ] (t (VarT 0)))-scheme2 s1 s2 t name =- (name, Forall [0,1] [ ctx name $ VarT 0 :<: s1- , ctx name $ VarT 1 :<: s2- ] (t (VarT 0) (VarT 1)))-numScheme t name = scheme1 number t name-twoNums f name = scheme2 number number f name--math =- map (numScheme (\t -> t ==> binop t)) ["clamp"] ++- map (numScheme (\t -> binop t)) ["+","-","*","max","min"] ++- [ numScheme (\t -> t ==> t) "abs" ] ++- hasType (binop float) [ "/", "logBase" ] ++- hasType (binop int) ["rem","div","mod"] ++- hasType (float ==> float) ["sin","cos","tan","asin","acos","atan","sqrt"] ++- hasType float ["pi","e"] ++- hasType (int ==> float) ["toFloat","castIntToFloat"] ++- hasType (float ==> int) ["round","floor","ceiling","truncate"] ++- [ "show" -:: a ==> string- , "readInt" -: string ==> maybeOf int- , "readFloat" -: string ==> maybeOf float ]--bools =- [ "not" -: bool ==> bool ] ++- hasType (binop bool) ["&&","||"] ++- map (scheme1 comparable (\t -> t ==> t ==> bool)) ["<",">","<=",">="] ++- [ ( "compare"- , Forall [0,1] [ ctx "compare" $ VarT 0 :<: comparable ] (VarT 0 ==> VarT 0 ==> VarT 1) )- ]--chars = prefix "Char" (classify ++ convert1 ++ convert2)- where classify = hasType (char ==> bool)- ["isDigit","isOctDigit","isHexDigit","isUpper","isLower"]- convert1 = hasType (char ==> char)- ["toUpper","toLower","toLocaleUpper","toLocaleLower"]- convert2 = [ "toCode" -: char ==> int, "fromCode" -: int ==> char ]- ---------- Polymorphic Functions ----------[a,b,c] = map VarT [1,2,3]--infix 8 -::-name -:: tipe = (name, Forall [1,2,3] [] tipe)--funcs =- [ "id" -:: a ==> a- , "==" -:: a ==> a ==> bool- , "/=" -:: a ==> a ==> bool- , "flip" -:: (a ==> b ==> c) ==> (b ==> a ==> c)- , "." -:: (b ==> c) ==> (a ==> b) ==> (a ==> c)- , "$" -:: (a ==> b) ==> a ==> b- , ":" -:: a ==> listOf a ==> listOf a- , (,) "++" . Forall [0,1] [ ctx "++" $ VarT 0 :<: appendable (VarT 1) ] $ VarT 0 ==> VarT 0 ==> VarT 0- , "Cons" -:: a ==> listOf a ==> listOf a - , "Nil" -:: listOf a- , "Just" -:: a ==> maybeOf a- , "Nothing" -:: maybeOf a- , "Left" -:: a ==> eitherOf a b- , "Right" -:: b ==> eitherOf a b- , "curry" -:: (tupleOf [a,b] ==> c) ==> a ==> b ==> c- , "uncurry" -:: (a ==> b ==> c) ==> tupleOf [a,b] ==> c- ] ++ map tuple [0..8]--tuple n = ("Tuple" ++ show n, Forall [1..n] [] $ foldr (==>) (tupleOf vs) vs)- where vs = map VarT [1..n]--lists = prefix "List"- [ "and" -:: listOf bool ==> bool- , "or" -:: listOf bool ==> bool- , numScheme (\n -> listOf n ==> listOf n) "sort"- , "head" -:: listOf a ==> a- , "tail" -:: listOf a ==> listOf a- , "length" -:: listOf a ==> int- , "filter" -:: (a ==> bool) ==> listOf a ==> listOf a- , "foldr1" -:: (a ==> a ==> a) ==> listOf a ==> a- , "foldl1" -:: (a ==> a ==> a) ==> listOf a ==> a- , "scanl1" -:: (a ==> a ==> a) ==> listOf a ==> a- , "all" -:: (a ==> bool) ==> listOf a ==> bool- , "any" -:: (a ==> bool) ==> listOf a ==> bool- , "reverse" -:: listOf a ==> listOf a- , "take" -:: int ==> listOf a ==> listOf a- , "drop" -:: int ==> listOf a ==> listOf a- , "partition" -:: (a ==> bool) ==> listOf a ==> tupleOf [listOf a,listOf a]- , "intersperse" -:: a ==> listOf a ==> listOf a- , "zip" -:: listOf a ==>listOf b ==>listOf(tupleOf [a,b])- , "map" -:: (a ==> b) ==> listOf a ==> listOf b- , "foldr" -:: (a ==> b ==> b) ==> b ==> listOf a ==> b- , "foldl" -:: (a ==> b ==> b) ==> b ==> listOf a ==> b- , "scanl" -:: (a ==> b ==> b) ==> b ==> listOf a ==> listOf b- , (,) "concat" . Forall [0,1] [ ctx "concat" $ VarT 0 :<: appendable (VarT 1) ] $- listOf (VarT 0) ==> VarT 0- , (,) "concatMap" . Forall [0,1,2] [ ctx "concatMap" $ VarT 0 :<: appendable (VarT 1) ] $- (VarT 2 ==> VarT 0) ==> listOf (VarT 2) ==> VarT 0- , (,) "intercalate" . Forall [0,1] [ ctx "intercalate" $ VarT 0 :<: appendable (VarT 1) ] $- VarT 0 ==> listOf (VarT 0) ==> VarT 0- , "zipWith" -:: (a ==> b ==> c) ==> listOf a ==> listOf b ==> listOf c- ] ++ map (numScheme (\n -> listOf n ==> n)) [ "sum", "product"- , "maximum", "minimum" ]--maybeFuncs = prefix "Maybe"- [ "maybe" -:: b ==> (a ==> b) ==> maybeOf a ==> b- , "isJust" -:: maybeOf a ==> bool- , "isNothing" -:: maybeOf a ==> bool- , "cons" -:: maybeOf a ==> listOf a ==> listOf a- , "justs" -:: listOf (maybeOf a) ==> listOf a- ]--eithers = prefix "Either"- [ "isLeft" -:: eitherOf a b ==> bool- , "isRight" -:: eitherOf a b ==> bool- , "either" -:: (a ==> c) ==> (b ==> c) ==> eitherOf a b ==> c- , "lefts" -:: listOf (eitherOf a b) ==> listOf a- , "rights" -:: listOf (eitherOf a b) ==> listOf b- , "partition" -:: listOf (eitherOf a b) ==> tupleOf [listOf a,listOf b]- ]--dictionary =- let dict k v = ADT "Dict" [k,v] in- prefix "Dict"- [ "empty" -:: dict a b- , "singleton" -:: a ==> b ==> dict a b- , "insert" -:: a ==> b ==> dict a b ==> dict a b- , "remove" -:: a ==> dict a b ==> dict a b- , "member" -:: a ==> dict a b ==> bool- , "lookup" -:: a ==> dict a b ==> maybeOf b- , "findWithDefault" -:: b ==> a ==> dict a b ==> b- , "intersect" -:: dict a b ==> dict a c ==> dict a b- , "union" -:: dict a b ==> dict a b ==> dict a b- , "diff" -:: dict a b ==> dict a c ==> dict a b- , "map" -:: (b ==> c) ==> dict a b ==> dict a c- , "foldl" -:: (a ==> b ==> c ==> c) ==> c ==> dict a b ==> c- , "foldr" -:: (a ==> b ==> c ==> c) ==> c ==> dict a b ==> c- , "keys" -:: dict a b ==> listOf a- , "values" -:: dict a b ==> listOf b- , "toList" -:: dict a b ==> listOf (tupleOf [a,b])- , "fromList" -:: listOf (tupleOf [a,b]) ==> dict a b- ]--sets =- let set v = ADT "Set" [v] in- prefix "Set"- [ "empty" -:: set a- , "singleton" -:: a ==> set a- , "insert" -:: a ==> set a ==> set a- , "remove" -:: a ==> set a ==> set a- , "member" -:: a ==> set a ==> bool- , "intersect" -:: set a ==> set a ==> set a- , "union" -:: set a ==> set a ==> set a- , "diff" -:: set a ==> set a ==> set a- , "map" -:: (a ==> b) ==> set a ==> set b- , "foldl" -:: (a ==> b ==> b) ==> b ==> set a ==> b- , "foldr" -:: (a ==> b ==> b) ==> b ==> set a ==> b- , "toList" -:: set a ==> listOf a- , "fromList" -:: listOf a ==> set a- ]--automaton =- let auto a b = ADT "Automaton" [a,b] in- prefix "Automaton"- [ "pure" -:: (a ==> b) ==> auto a b- , "init" -:: b ==> (a ==> b ==> b) ==> auto a b- , "init'" -:: c ==> (a ==> c ==> tupleOf [b,c]) ==> auto a b- , ">>>" -:: auto a b ==> auto b c ==> auto a c- , "<<<" -:: auto b c ==> auto a b ==> auto a c- , "combine" -:: listOf (auto a b) ==> auto a (listOf b)- , "run" -:: auto a b ==> signalOf a ==> signalOf b- , "step" -:: auto a b ==> a ==> tupleOf [b,auto a b]- , "count" -:: auto a int- , "draggable" -:: form ==> auto (tupleOf [bool,point]) form- ]---------- Everything ----------hints = mapM (\(n,s) -> (,) n `liftM` rescheme s) (concat hs)- where hs = [ funcs, lists, signals, math, bools, textAttrs- , graphicsElement, graphicsColor, eithers, keyboards, touches- , concreteSignals, javascript, json, maybeFuncs- , http, dictionary, sets, automaton, times, dates- ]
− src/Types/Solver.hs
@@ -1,199 +0,0 @@--module Types.Solver (solver) where--import Context-import Control.Arrow (second)-import Control.Monad (liftM)-import Data.Either (lefts,rights)-import Data.List (foldl')-import Data.Maybe (isJust)-import qualified Data.Set as Set-import qualified Data.Map as Map-import Guid-import Types.Types-import Types.Constrain-import Types.Substitutions--isSolved ss (C _ _ (t1 :=: t2)) = t1 == t2-isSolved ss (C _ _ (x :<<: _)) = isJust (lookup x ss)-isSolved ss c = False--crush :: Scheme -> GuidCounter (Either String Scheme)-crush (Forall xs cs t) =- do subs <- solver cs Map.empty- return $ do ss' <- subs- let ss = Map.toList ss'- cs' = filter (not . isSolved ss) (subst ss cs)- return $ Forall xs cs' (subst ss t)--schemeSubHelp txt span x s t1 rltn t2 = do- (t1',cs1) <- sub t1- (t2',cs2) <- sub t2- return (C txt span (rltn t1' t2') : cs1 ++ cs2)- where sub t | not (occurs x t) = return (t, [])- | otherwise = do (st, cs) <- concretize s- return (subst [(x,st)] t, cs)--schemeSub x s c = do s' <- crush s- case s' of- Right s'' -> Right `liftM` schemeSub' x s'' c- Left err -> return $ Left err--schemeSub' x s c@(C txt span constraint) =- case constraint of- (t1 :=: t2) -> schemeSubHelp txt span x s t1 (:=:) t2- (t1 :<: t2) -> schemeSubHelp txt span x s t1 (:<:) t2- (y :<<: Forall cxs ccs ctipe)- | not (occurs x c) -> return [c]- | otherwise ->- do Forall xs cs tipe <- rescheme s- let ss = [(x,tipe)]- constraints = subst ss (cs ++ ccs)- c' = y :<<: Forall (cxs ++ xs) constraints (subst ss ctipe)- return [ C txt span c' ]--recordConstraints eq fs t fs' t' =- liftM concat . sequence $- [ constrain fs fs'- , liftM concat . mapM (\(k,ts) -> zipper [] k ts []) . Map.toList $- Map.difference fs fs'- , liftM concat . mapM (\(k,ts) -> zipper [] k [] ts) . Map.toList $- Map.difference fs' fs- ]- where constrain :: Map.Map String [Type] -> Map.Map String [Type]- -> GuidCounter [Context Constraint]- constrain as bs = liftM concat . sequence . Map.elems $- Map.intersectionWithKey (zipper []) as bs- zipper :: [Context Constraint] -> String -> [Type] -> [Type]- -> GuidCounter [Context Constraint]- zipper cs k xs ys =- case (xs,ys) of- (a:as, b:bs) -> zipper (eq a b : cs) k as bs- ([],[]) -> return cs- (as,[]) -> do x <- guid- let tipe = RecordT (Map.singleton k as) (VarT x)- return (cs ++ [eq t' tipe])- ([],bs) -> do x <- guid- let tipe = RecordT (Map.singleton k bs) (VarT x)- return (cs ++ [eq t tipe])- -solver :: [Context Constraint]- -> Map.Map X Type- -> GuidCounter (Either String (Map.Map X Type))-solver [] subs = return $ Right subs-solver (C txt span c : cs) subs =- let ctx = C txt span in- let eq t1 t2 = ctx (t1 :=: t2) in- case c of- -- Destruct Type-constructors- t1@(ADT n1 ts1) :=: t2@(ADT n2 ts2) ->- if n1 /= n2 then uniError txt span t1 t2 else- solver (zipWith eq ts1 ts2 ++ cs) subs-- LambdaT t1 t2 :=: LambdaT t1' t2' ->- solver ([ eq t1 t1', eq t2 t2' ] ++ cs) subs-- RecordT fs t :=: RecordT fs' t' ->- do cs' <- recordConstraints eq fs t fs' t'- solver (cs' ++ cs) subs-- -- Type-equality- VarT x :=: VarT y- | x == y -> solver cs subs- | otherwise ->- case (Map.lookup x subs, Map.lookup y subs) of- (Just (Super xts), Just (Super yts)) ->- let ts = Set.intersection xts yts- setXY t = Map.insert x t . Map.insert y t- in case Set.toList ts of- [] -> unionError txt span xts yts- [t] -> let cs1 = subst [(x,t),(y,t)] cs in- cs1 `seq` solver cs1 (setXY t subs)- _ -> solver cs $ setXY (Super ts) subs- (Just (Super xts), _) ->- let cs2 = subst [(y,VarT x)] cs in- solver cs2 $ Map.insert y (VarT x) subs- (_, _) ->- let cs3 = subst [(x,VarT y)] cs in- solver cs3 $ Map.insert x (VarT y) subs-- VarT x :=: t -> do- if x `occurs` t then occursError txt span (VarT x) t else- (case Map.lookup x subs of- Nothing -> let cs4 = subst [(x,t)] cs in- solver cs4 . Map.map (subst [(x,t)]) $- Map.insert x t subs- Just (Super ts) ->- let ts' = Set.intersection ts (Set.singleton t) in- case Set.toList ts' of- [] -> solver (ctx (t :<: Super ts) : cs) subs- [t'] -> let cs5 = subst [(x,t)] cs in- solver cs5 $ Map.insert x t' subs- _ -> solver cs $ Map.insert x (Super ts') subs- Just t' -> solver (ctx (t' :=: t) : cs) subs- )-- t :=: VarT x -> solver ((ctx (VarT x :=: t)) : cs) subs-- t1 :=: t2 | t1 == t2 -> solver cs subs- | otherwise -> uniError txt span t1 t2-- -- subtypes- VarT x :<: Super ts ->- case Map.lookup x subs of- Nothing -> solver cs $ Map.insert x (Super ts) subs- Just (Super ts') ->- case Set.toList $ Set.intersection ts ts' of- [] -> unionError txt span ts ts'- [t] -> solver (subst [(x,t)] cs) $ Map.insert x t subs- ts'' -> solver cs $- Map.insert x (Super $ Set.fromList ts'') subs-- ADT "List" [t] :<: Super ts- | any f (Set.toList ts) -> solver cs subs- | otherwise -> subtypeError txt span (ADT "List" [t]) (Super ts)- where f (ADT "List" [VarT _]) = True- f (ADT "List" [t']) = t == t'- f _ = False-- t :<: Super ts- | Set.member t ts -> solver cs subs- | otherwise -> subtypeError txt span t (Super ts)-- x :<<: s- | any (occurs x) cs ->- do css <- mapM (schemeSub x s) cs- case lefts css of- err : _ -> return $ Left err- [] -> solver (concat (rights css)) subs- | otherwise ->- do (t,cs7) <- concretize s- let cs'' = (cs ++ ctx (VarT x :=: t) : cs7)- solver cs'' subs--showMsg msg = case msg of- Just str -> "\nIn context: " ++ str- Nothing -> ""--occursError msg span t1 t2 =- return . Left $ concat- [ "Type error (" ++ show span ++ "):\n"- , "Occurs check: cannot construct the infinite type:\n"- , show t1, " = ", show t2, showMsg msg ]--uniError msg span t1 t2 =- return . Left $ concat- [ "Type error (" ++ show span ++ "):\n"- , show t1, " is not equal to ", show t2, showMsg msg ]--unionError msg span ts ts' =- return . Left $ concat- [ "Type error (" ++ show span ++ "):\n"- , "There are no types in both "- , show (Super ts), " and ", show (Super ts'), showMsg msg ]--subtypeError msg span t s =- return . Left $ concat- [ "Type error (" ++ show span ++ "):\n"- , show t, " is not a ", show s, showMsg msg ]-
− src/Types/Substitutions.hs
@@ -1,88 +0,0 @@--module Types.Substitutions (subst- ,occurs- ,concretize- ,rescheme- ,generalize) where--import Context-import Control.DeepSeq (NFData (..), deepseq)-import Control.Monad (liftM)-import Data.List (foldl')-import qualified Data.Set as Set-import qualified Data.Map as Map-import Guid-import Types.Types--class Subst a where- subst :: [(X,Type)] -> a -> a--instance Subst Type where- subst ss t =- case t of- VarT x -> case lookup x ss of- Nothing -> VarT x- Just (Super _) -> VarT x- Just t -> t- LambdaT t1 t2 -> LambdaT (subst ss t1) (subst ss t2)- ADT name ts -> ADT name (subst ss ts)- RecordT fs t -> RecordT (Map.map (subst ss) fs) (subst ss t)- EmptyRecord -> EmptyRecord- Super ts -> Super ts--instance Subst Scheme where- subst ss (Forall vs cs t) = Forall vs (subst ss cs) (subst ss t)--instance Subst Constraint where- subst ss (t1 :=: t2) = subst ss t1 :=: subst ss t2- subst ss (t :<: super) = subst ss t :<: super- subst ss (x :<<: poly) = x :<<: subst ss poly--instance Subst a => Subst (Context a) where- subst ss (C str span c) = C str span (subst ss c)--instance Subst a => Subst [a] where- subst ss as = map (subst ss) as---class FreeVars a where- freeVars :: a -> [X]--instance FreeVars Type where- freeVars (VarT v) = [v]- freeVars (LambdaT t1 t2) = freeVars t1 ++ freeVars t2- freeVars (ADT _ ts) = concatMap freeVars ts- freeVars (RecordT fs t) =- freeVars (concat $ Map.elems fs) ++ freeVars t- freeVars EmptyRecord = []- freeVars (Super _ ) = [] --instance FreeVars Constraint where- freeVars (t1 :=: t2) = freeVars t1 ++ freeVars t2- freeVars (t1 :<: t2) = freeVars t1 ++ freeVars t2- freeVars (x :<<: Forall xs cs t) = filter (`notElem` xs) frees- where frees = concatMap freeVars cs ++ freeVars t--instance FreeVars a => FreeVars (Context a) where- freeVars (C _ _ c) = freeVars c --instance FreeVars a => FreeVars [a] where- freeVars = concatMap freeVars--occurs x t = x `elem` freeVars t--concretize :: Scheme -> GuidCounter (Type, [Context Constraint])-concretize (Forall xs cs t) = do- ss <- zip xs `liftM` mapM (\_ -> liftM VarT guid) xs- return (subst ss t, subst ss cs)--rescheme :: Scheme -> GuidCounter Scheme-rescheme (Forall xs cs t) = do- xs' <- mapM (const guid) xs- let ss = zip xs (map VarT xs')- return $ Forall xs' (subst ss cs) (subst ss t)--generalize :: [X] -> Scheme -> GuidCounter Scheme-generalize exceptions (Forall xs cs t) = rescheme (Forall (xs ++ frees) cs t)- where allFrees = Set.fromList $ freeVars t ++ concatMap freeVars cs- frees = Set.toList $ Set.difference allFrees (Set.fromList exceptions)
− src/Types/Types.hs
@@ -1,121 +0,0 @@--module Types.Types where--import Context-import Data.Char (isDigit)-import Data.List (intercalate,isPrefixOf)-import qualified Data.Set as Set-import qualified Data.Map as Map--type X = Int--data Type = LambdaT Type Type- | VarT X- | ADT String [Type]- | EmptyRecord- | RecordT (Map.Map String [Type]) Type- | Super (Set.Set Type)- deriving (Eq, Ord)--data Scheme = Forall [X] [Context Constraint] Type deriving (Eq, Ord)--data Constraint = Type :=: Type- | Type :<: Type- | X :<<: Scheme- deriving (Eq, Ord, Show)--recordT :: [(String,Type)] -> Map.Map String [Type]-recordT fields =- foldl (\r (x,t) -> Map.insertWith (++) x [t] r) Map.empty fields--recordOf :: [(String,Type)] -> Type-recordOf fields = RecordT (recordT fields) EmptyRecord--tipe t = ADT t []--int = tipe "Int"-float = tipe "Float"-number = Super (Set.fromList [ int, float ])--char = tipe "Char"-bool = tipe "Bool"--string = listOf char -- tipe "String"-text = tipe "Text"--time = float --tipe "Time"-date = tipe "Date"-month = tipe "Month"-day = tipe "Day"--element = tipe "Element"-direction = tipe "Direction"-form = tipe "Form"-line = tipe "Line"-shape = tipe "Shape"-color = tipe "Color"-position = tipe "Position"-location = tipe "Location"--listOf t = ADT "List" [t]-signalOf t = ADT "Signal" [t]-tupleOf ts = ADT ("Tuple" ++ show (length ts)) ts-maybeOf t = ADT "Maybe" [t]-eitherOf a b = ADT "Maybe" [a,b]-pairOf t = tupleOf [t,t]-point = pairOf int-appendable t = Super (Set.fromList [ string, text, listOf t ])-comparable = Super (Set.fromList [ int, float, char, string, time, date ])--jsBool = tipe "JSBool"-jsNumber = tipe "JSNumber"-jsString = tipe "JSString"-jsElement = tipe "JSElement"-jsArray t = ADT "JSArray" [t]-jsTuple ts = ADT ("JSTuple" ++ show (length ts)) ts-jsonValue = tipe "JsonValue"-jsonObject = tipe "JsonObject"--infixr ==>-t1 ==> t2 = LambdaT t1 t2--infix 8 -:-name -: tipe = (,) name $ Forall [] [] tipe--hasType t = map (-: t)--parens = ("("++) . (++")")--instance Show Type where- show t =- case t of- { LambdaT t1@(LambdaT _ _) t2 -> parens (show t1) ++ " -> " ++ show t2- ; LambdaT t1 t2 -> show t1 ++ " -> " ++ show t2- ; VarT x -> 't' : show x- ; ADT "List" [ADT "Char" []] -> "String"- ; ADT "List" [tipe] -> "[" ++ show tipe ++ "]"- ; ADT name cs ->- if isTupleString name- then parens . intercalate "," $ map show cs- else case cs of- [] -> name- _ -> parens $ name ++ " " ++ unwords (map show cs)- ; Super ts -> "{" ++ (intercalate "," . map show $ Set.toList ts) ++ "}"- ; EmptyRecord -> "{}"- ; RecordT fs t ->- start ++ intercalate ", " (concatMap fields $ Map.toList fs) ++ " }"- where field n s = n ++ " :: " ++ show s- fields (n,ss) = map (field n) ss- start = case t of- EmptyRecord -> "{ "- _ -> "{ " ++ show t ++ " | "- }--instance Show Scheme where- show (Forall [] [] t) = show t- show (Forall xs cs t) =- concat [ "Forall ", show xs- , concatMap (("\n "++) . show) cs- , "\n ", parens (show t) ]--isTupleString str = "Tuple" `isPrefixOf` str && all isDigit (drop 5 str)
− src/Types/Unify.hs
@@ -1,19 +0,0 @@--module Types.Unify (unify) where--import Control.Monad (liftM)-import qualified Data.Map as Map--import Guid-import Types.Constrain-import Types.Solver--unify hints modul = run $ do- constraints <- constrain hints modul- case constraints of- Left msg -> return (Left msg)- Right (escapees, cs) ->- do subs <- solver cs Map.empty- return $ do ss <- subs- return (escapees, ss)-