e0b0cc0 · elk · git.iko.soy

Elm.cabal+44−8

compare with master

unifiedsplit

@@ -14,7 +14,7 @@ License-file: LICENSE

14

15Author: Evan Czaplicki

16Maintainer: info@elm-lang.org

18

19Category: Compiler, Language

20

@@ -22,7 +22,7 @@ Build-type: Custom

22

23Extra-source-files: changelog.txt

24Data-dir: data

25−Data-files: elm-runtime.js interfaces.data

25+Data-files: elm-runtime.js interfaces.data docs.json

26Cabal-version: >=1.9

27

28source-repository head

@@ -32,8 +32,7 @@ source-repository head

32Library

33 exposed-modules: Language.Elm

34 Hs-Source-Dirs: compiler

35− other-modules: Unique,

36− SourceSyntax.Declaration,

35+ other-modules: SourceSyntax.Declaration,

37 SourceSyntax.Expression,

36 SourceSyntax.Expression,

38 SourceSyntax.Everything,

37 SourceSyntax.Everything,

39 SourceSyntax.Helpers,

38 SourceSyntax.Helpers,

@@ -88,8 +87,8 @@ Library

88 containers >= 0.3,

87 containers >= 0.3,

89 directory,

88 directory,

90 filepath,

89 filepath,

91− hjsmin,

92 indents,

90 indents,

91+ language-ecmascript,

93 mtl >= 2,

92 mtl >= 2,

94 pandoc >= 1.10,

93 pandoc >= 1.10,

95 parsec >= 3.1.1,

94 parsec >= 3.1.1,

@@ -102,8 +101,7 @@ Executable elm

102 Main-is: Compiler.hs

101 Main-is: Compiler.hs

103 ghc-options: -threaded -O2

102 ghc-options: -threaded -O2

104 Hs-Source-Dirs: compiler

103 Hs-Source-Dirs: compiler

105− other-modules: Unique,

106− SourceSyntax.Declaration,

104+ other-modules: SourceSyntax.Declaration,

107 SourceSyntax.Expression,

105 SourceSyntax.Expression,

108 SourceSyntax.Everything,

106 SourceSyntax.Everything,

109 SourceSyntax.Helpers,

107 SourceSyntax.Helpers,

@@ -158,8 +156,8 @@ Executable elm

158 containers >= 0.3,

156 containers >= 0.3,

159 directory,

157 directory,

160 filepath,

158 filepath,

161− hjsmin,

162 indents,

159 indents,

160+ language-ecmascript,

163 mtl >= 2,

161 mtl >= 2,

164 pandoc >= 1.10,

162 pandoc >= 1.10,

165 parsec >= 3.1.1,

163 parsec >= 3.1.1,

@@ -168,6 +166,44 @@ Executable elm

168 union-find,

166 union-find,

169 uniplate

167 uniplate

170

168

169+Executable elm-doc

170+ Main-is: Docs.hs

171+ Hs-Source-Dirs: compiler

172+ other-modules: SourceSyntax.Declaration,

173+ SourceSyntax.Everything,

174+ SourceSyntax.Expression,

175+ SourceSyntax.Helpers,

176+ SourceSyntax.Literal,

177+ SourceSyntax.Location,

178+ SourceSyntax.Module,

179+ SourceSyntax.Pattern,

180+ SourceSyntax.PrettyPrint,

181+ SourceSyntax.Type,

182+ Parse.Binop,

183+ Parse.Declaration,

184+ Parse.Expression,

185+ Parse.Helpers,

186+ Parse.Literal,

187+ Parse.Module,

188+ Parse.Pattern,

189+ Parse.Type

190+

191+ Build-depends: aeson,

192+ aeson-pretty,

193+ base >=4.2 && <5,

194+ binary,

195+ bytestring,

196+ cmdargs,

197+ containers >= 0.3,

198+ directory,

199+ filepath,

200+ indents,

201+ mtl >= 2,

202+ pandoc >= 1.10,

203+ parsec >= 3.1.1,

204+ pretty,

205+ text

206+

171Test-Suite test-elm

207Test-Suite test-elm

172 Type: exitcode-stdio-1.0

208 Type: exitcode-stdio-1.0

173 Hs-Source-Dirs: tests

209 Hs-Source-Dirs: tests

LICENSE+1−1

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

2

3All rights reserved.

4

Setup.hs+37−23

@@ -12,6 +12,7 @@ import System.Process

12import Control.Monad

13import qualified Data.Binary as Binary

14import qualified Data.ByteString.Lazy as BS

15+import qualified Data.List as List

15

16

16-- Part 1

17-- Part 1

17-- ------

18-- ------

@@ -42,13 +43,20 @@ tempDir lbi = "temp"

42rts :: LocalBuildInfo -> FilePath

43rts :: LocalBuildInfo -> FilePath

43rts lbi = rtsDir lbi </> "elm-runtime.js"

44rts lbi = rtsDir lbi </> "elm-runtime.js"

44

45

46+-- The runtime is called:

47+docs :: LocalBuildInfo -> FilePath

48+docs lbi = rtsDir lbi </> "docs.json"

49+

45-- The interfaces for the Standard Libraries live in:

50-- The interfaces for the Standard Libraries live in:

46interfaces :: LocalBuildInfo -> FilePath

51interfaces :: LocalBuildInfo -> FilePath

47interfaces lbi = rtsDir lbi </> "interfaces.data"

52interfaces lbi = rtsDir lbi </> "interfaces.data"

48

53

49−-- buildDir with LocalBuildInfo points to "dist/build" (usually)

54+elm :: LocalBuildInfo -> FilePath

50elm lbi = buildDir lbi </> "elm" </> "elm"

55elm lbi = buildDir lbi </> "elm" </> "elm"

51

56

57+document :: LocalBuildInfo -> FilePath

58+document lbi = buildDir lbi </> "elm-doc" </> "elm-doc"

59+

52-- Care! This appears to be based on an unstable API

60-- Care! This appears to be based on an unstable API

53-- See: http://www.haskell.org/cabal/release/cabal-latest/doc/API/Cabal/Distribution-Simple.html#2

61-- See: http://www.haskell.org/cabal/release/cabal-latest/doc/API/Cabal/Distribution-Simple.html#2

54

62

@@ -75,16 +83,6 @@ filterExe name pd = pd {

75 executables = filter (\x -> (exeName x == name)) (executables pd)

83 executables = filter (\x -> (exeName x == name)) (executables pd)

76 }

84 }

77

85

78−-- It's not enough to fix the PackageDescription, we also have to fix the

79−-- LocalBuildInfo. This includes the component build order (data ComponentName)

80−-- which is horribly internal.

81−filterLBI :: String -> LocalBuildInfo -> LocalBuildInfo

82−filterLBI name lbi = lbi {

83− libraryConfig = Nothing,

84− compBuildOrder = [CExeName name],

85− executableConfigs = filter (\a -> (fst a == name)) (executableConfigs lbi)

86− }

87−

88

86

89-- Post Build

87-- Post Build

90

88

@@ -96,7 +94,10 @@ myPostBuild as bfs pd lbi = do

96 buildInterfaces lbi elmis

94 buildInterfaces lbi elmis

97 putStrLn "Custom build step: build elm-runtime.js"

95 putStrLn "Custom build step: build elm-runtime.js"

98 buildRuntime lbi elmos

96 buildRuntime lbi elmos

97+ putStrLn "Custom build step: build docs.json"

98+ buildDocs lbi

99 removeDirectoryRecursive (tempDir lbi)

100+ removeDirectoryRecursive ("libraries" </> "docs")

100 postBuild simpleUserHooks as bfs pd lbi

101 postBuild simpleUserHooks as bfs pd lbi

101

102

103

@@ -107,6 +108,7 @@ compileLibraries lbi = do

107 createDirectoryIfMissing True rts

108 createDirectoryIfMissing True rts

108 out_c <- canonicalizePath temp -- temp (root folder)

109 out_c <- canonicalizePath temp -- temp (root folder)

109 elm_c <- canonicalizePath (elm lbi) -- dist/build/elm/elm

110 elm_c <- canonicalizePath (elm lbi) -- dist/build/elm/elm

111+ doc_c <- canonicalizePath (document lbi) -- dist/build/elm-doc/elm-doc

110 rtd_c <- canonicalizePath rts -- data

112 rtd_c <- canonicalizePath rts -- data

111

113

112 let make file = do

114 let make file = do

@@ -122,9 +124,9 @@ compileLibraries lbi = do

122 , out_c </> replaceExtension file "elmi")

124 , out_c </> replaceExtension file "elmi")

123

125

124 setCurrentDirectory "libraries"

126 setCurrentDirectory "libraries"

125− print =<< getCurrentDirectory

126− files <- getFiles ".elm" "."

127+ paths <- getFiles ".elm" "."

127− files <- unzip `fmap` mapM make files

128+ files <- unzip `fmap` mapM make paths

129+ mapM_ (\path -> rawSystem doc_c [path]) paths

128 setCurrentDirectory ".."

130 setCurrentDirectory ".."

129 return files

131 return files

130

132

@@ -145,11 +147,23 @@ buildInterfaces lbi elmis = do

145buildRuntime :: LocalBuildInfo -> [FilePath] -> IO ()

147buildRuntime :: LocalBuildInfo -> [FilePath] -> IO ()

146buildRuntime lbi elmos = do

148buildRuntime lbi elmos = do

147 createDirectoryIfMissing True (rtsDir lbi)

149 createDirectoryIfMissing True (rtsDir lbi)

150+ let rts' = rts lbi

148− writeFile (rts lbi) "Elm = {}; Elm.Native = {}; Elm.Native.Graphics = {};\n\

151+ writeFile rts' "var Elm = {}; Elm.Native = {}; Elm.Native.Graphics = {};\n\

149− \Elm.Graphics = {}; ElmRuntime = {}; ElmRuntime.Render = {};\n"

152+ \var ElmRuntime = {}; ElmRuntime.Render = {};\n"

150− mapM_ (appendJS lbi) =<< getFiles ".js" "libraries"

153+ mapM_ (appendTo rts') =<< getFiles ".js" "libraries"

151− mapM_ (appendJS lbi) elmos

154+ mapM_ (appendTo rts') elmos

152− mapM_ (appendJS lbi) =<< getFiles ".js" "runtime"

155+ mapM_ (appendTo rts') =<< getFiles ".js" "runtime"

156+

157+buildDocs :: LocalBuildInfo -> IO ()

158+buildDocs lbi = do

159+ createDirectoryIfMissing True (rtsDir lbi)

160+ let docs' = docs lbi

161+ writeFile docs' "[\n"

162+ json <- getFiles ".json" ("libraries" </> "docs")

163+ let appends = map (appendTo docs') json

164+ addCommas = List.intersperse (appendFile docs' ",\n")

165+ sequence_ (addCommas appends)

166+ appendFile docs' "\n]"

153

167

154getFiles ext dir = do

168getFiles ext dir = do

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

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

@@ -158,8 +172,8 @@ getFiles ext dir = do

158 filess <- mapM (getFiles ext) dirs

172 filess <- mapM (getFiles ext) dirs

159 return (files ++ concat filess)

173 return (files ++ concat filess)

160

174

161−appendJS lbi file = do

175+appendTo :: FilePath -> FilePath -> IO ()

162− putStrLn (dropExtension file)

176+appendTo destination source = do

163− str <- readFile file

177+ str <- readFile source

164 length str `seq` return ()

178 length str `seq` return ()

165− appendFile (rts lbi) str

179+ appendFile destination str

changelog.txt+3

@@ -2,8 +2,11 @@

2Release 0.9.1

3=============

4

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

6+ * Realias types before printing

5 * Switch to Tango color scheme, adding a bunch of nice colors

7 * Switch to Tango color scheme, adding a bunch of nice colors

6 * add the greyscale function for easily producing greys

8 * add the greyscale function for easily producing greys

9+ * Check the type of main

7 * Fix miscellaneous bugs in type checker

10 * Fix miscellaneous bugs in type checker

8 * Switch name of Matrix2D to Transform2D

11 * Switch name of Matrix2D to Transform2D

9

12

compiler/Compiler.hs+40−39

@@ -13,9 +13,7 @@ import System.FilePath

13import System.IO

14import GHC.Conc

15

16−import qualified Text.Blaze.Html.Renderer.Pretty as Pretty

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

17−import qualified Text.Blaze.Html.Renderer.String as Normal

18−import qualified Text.Jasmine as JS

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

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

20import qualified Data.ByteString.Lazy as L

18import qualified Data.ByteString.Lazy as L

21

19

@@ -25,7 +23,7 @@ import SourceSyntax.Module

25import Parse.Module (getModuleName)

23import Parse.Module (getModuleName)

26import Initialize (buildFromSource, getSortedDependencies)

24import Initialize (buildFromSource, getSortedDependencies)

27import Generate.JavaScript (jsModule)

25import Generate.JavaScript (jsModule)

28−import Generate.Html (createHtml, JSStyle(..), JSSource(..))

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

29import Paths_Elm

27import Paths_Elm

30

28

31import SourceSyntax.PrettyPrint (pretty, variable)

29import SourceSyntax.PrettyPrint (pretty, variable)

@@ -42,36 +40,38 @@ data Flags =

42 , print_program :: Bool

40 , print_program :: Bool

43 , scripts :: [FilePath]

41 , scripts :: [FilePath]

44 , no_prelude :: Bool

42 , no_prelude :: Bool

45− , minify :: Bool

46 , cache_dir :: FilePath

43 , cache_dir :: FilePath

47 , build_dir :: FilePath

44 , build_dir :: FilePath

45+ , src_dir :: [FilePath]

48 }

46 }

49 deriving (Data,Typeable,Show,Eq)

47 deriving (Data,Typeable,Show,Eq)

50

48

51flags = Flags

49flags = Flags

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

52− { make = False

51+ , make = False

53 &= help "automatically compile dependencies."

52 &= help "automatically compile dependencies."

54− , files = def &= args &= typ "FILES"

55− , runtime = Nothing &= typFile

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

57 , only_js = False

53 , only_js = False

58 &= help "Compile only to JavaScript."

54 &= help "Compile only to JavaScript."

59− , print_types = False

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

61− , print_program = False

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

63− , scripts = [] &= typFile

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

65 , no_prelude = False

55 , no_prelude = False

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

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

67− , minify = False

57+ , scripts = [] &= typFile

68− &= help "Minify generated JavaScript and HTML"

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

59+ , runtime = Nothing &= typFile

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

69 , cache_dir = "cache" &= typFile

61 , cache_dir = "cache" &= typFile

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

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

71 , build_dir = "build" &= typFile

63 , build_dir = "build" &= typFile

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

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

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

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

67+ , print_types = False

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

69+ , print_program = False

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

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

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

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

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

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

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

75

76main :: IO ()

77main = do setNumCapabilities =<< getNumProcessors

@@ -118,7 +118,7 @@ buildFile flags moduleNum numModules interfaces filePath =

118 then return False

119 else do tsrc <- getModificationTime filePath

120 tint <- getModificationTime (elmo flags filePath)

121− return (tsrc < tint)

121+ return (tsrc <= tint)

122

123 number :: String

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

@@ -146,11 +146,12 @@ buildFile flags moduleNum numModules interfaces filePath =

146 True -> print . pretty $ program modul

147 return modul

148

149− if print_types flags then printTypes interfaces metaModule else return ()

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

150 let interface = Canonical.interface name $ ModuleInterface {

151 iTypes = types metaModule,

152 iAdts = datatypes metaModule,

153− iAliases = aliases metaModule

153+ iAliases = aliases metaModule,

154+ iFixities = fixities metaModule

154 }

155 }

155 createDirectoryIfMissing True . dropFileName $ elmi flags filePath

156 createDirectoryIfMissing True . dropFileName $ elmi flags filePath

156 handle <- openBinaryFile (elmi flags filePath) WriteMode

157 handle <- openBinaryFile (elmi flags filePath) WriteMode

@@ -175,34 +176,34 @@ getRuntime flags =

175build :: Flags -> FilePath -> IO ()

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

176build flags rootFile = do

177build flags rootFile = do

177 let noPrelude = no_prelude flags

178 let noPrelude = no_prelude flags

178− files <- if make flags then getSortedDependencies noPrelude rootFile else return [rootFile]

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

180+ else return [rootFile]

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

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

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

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

181− js <- foldM appendToOutput "" files

183+ js <- foldM appendToOutput BS.empty files

184+

182− case only_js flags of

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

183 True -> do

186 True -> do

184 putStr "Generating JavaScript ... "

187 putStr "Generating JavaScript ... "

185− writeFile (buildPath flags rootFile "js") (genJs js)

188+ return ("js", js)

186− putStrLn "Done"

187 False -> do

189 False -> do

188 putStr "Generating HTML ... "

190 putStr "Generating HTML ... "

189− runtime <- getRuntime flags

191+ rtsPath <- getRuntime flags

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

190− let html = genHtml $ createHtml runtime (takeBaseName rootFile) (sources js) moduleName ""

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

194+

191− htmlFile = buildPath flags rootFile "html"

195+ let targetFile = buildPath flags rootFile extension

192− createDirectoryIfMissing True (takeDirectory htmlFile)

196+ createDirectoryIfMissing True (takeDirectory targetFile)

193− writeFile htmlFile html

197+ BS.writeFile targetFile code

194− putStrLn "Done"

198+ putStrLn "Done"

195

199

196 where

200 where

197− appendToOutput :: String -> FilePath -> IO String

201+ appendToOutput :: BS.ByteString -> FilePath -> IO BS.ByteString

198 appendToOutput js filePath =

202 appendToOutput js filePath =

199− do src <- readFile (elmo flags filePath)

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

200− return (src ++ js)

204+ return (BS.append src js)

201

205

202− genHtml = if minify flags then Normal.renderHtml else Pretty.renderHtml

203− genJs = if minify flags then BS.unpack . JS.minify . BS.pack else id

204− sources js = map Link (scripts flags) ++

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

205− [ Source (if minify flags then Minified else Readable) js ]

206

207

208

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

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

compiler/Docs.hs+146−59

@@ -1,75 +1,162 @@

1−

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

2module Main where

3

4−import SourceSyntax.Declaration (Declaration(Datatype))

4+import System.Console.CmdArgs

5+import System.Directory

6+import System.FilePath

7+import System.Exit

8+

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

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

6−import Data.List (intercalate)

10+import Data.Aeson

11+import Data.Aeson.Encode.Pretty

12+import qualified Data.List as List

13+import qualified Data.Map as Map

14+import qualified Data.ByteString.Lazy as BS

15+import qualified Data.Text as Text

16+

17+import SourceSyntax.Helpers (isSymbol)

7−import Parse.Type

18+import SourceSyntax.Type (Type(..))

19+import SourceSyntax.Declaration (Declaration(..), Assoc(..))

20+import SourceSyntax.Expression (Def(..))

21+

22+import Text.Parsec hiding (newline,spaces)

23+import Parse.Declaration (alias,datatype,infixDecl)

24+import Parse.Expression (typeAnnotation)

8import Parse.Helpers

25import Parse.Helpers

9import Parse.Module (moduleDef)

26import Parse.Module (moduleDef)

10−import Text.Parsec hiding (newline,spaces)

27+

11−import System.Environment

28+data Flags = Flags

12−import System.Exit

29+ { files :: [FilePath] }

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

31+

32+defaultFlags = Flags

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

34+ } &= help "Generate documentation for Elm"

35+ &= summary ("Generate documentation for Elm, (c) Evan Czaplicki")

13

36

14main = do

37main = do

15− srcs <- mapM readFile =<< getArgs

38+ flags <- cmdArgs defaultFlags

16− case mapM docParse srcs of

39+ mapM parseFile (files flags)

40+

41+config = Config { confIndent = 2, confCompare = keyOrder keys }

42+ where

43+ keys = ["name","document","comment","raw","aliases","datatypes"

44+ ,"values","typeVariables","type","constructors"]

45+

46+parseFile path = do

47+ source <- readFile path

48+ case iParse docs source of

49+ Right json -> do

50+ putStrLn $ "Documenting " ++ path

51+ let docPath = "docs" </> replaceExtension path ".json"

52+ createDirectoryIfMissing True (dropFileName docPath)

53+ BS.writeFile docPath (encodePretty' config json)

54+ Left err -> do

55+ putStrLn $ "Parse error in " ++ path ++ " at " ++ show err

17− Left err -> putStrLn err >> exitFailure

56+ exitFailure

18− Right ms -> putStrLn (toModules ms)

57+

19−

58+docs :: IParser Value

20−toModules ms = wrap (intercalate ",\n " (map toModule ms))

59+docs = do

21− where wrap s = "{ \"modules\" : [\n " ++ s ++ "\n ]\n}"

60+ (name, exports, structure) <- moduleDocs

22−

61+ things <- document

23−toModule (name, values) =

62+ return $ documentToJson name exports structure things

24− "{ \"name\" : " ++ show name ++ ",\n " ++

63+

25− "\"values\" : [\n " ++ vs ++ "\n ]\n }"

64+docComment :: IParser String

26− where vs = intercalate ",\n " (map toValue values)

65+docComment = do

27−

66+ try (string "{-|")

28−toValue (name, tipe, desc) =

67+ contents <- closeComment

29− "{ \"name\" : " ++ show name ++

68+ let reversed = dropWhile (`elem` " \n\r") . drop 2 $ reverse contents

30− ",\n \"type\" : " ++ show tipe ++

69+ return $ dropWhile (==' ') (reverse reversed)

31− ",\n \"desc\" : " ++ show desc ++ "\n }"

70+

32−

71+moduleDocs = do

33−docParse :: String -> Either String (String, [(String, String, String)])

34−docParse = setupParser $ do

35 optional freshLine

72 optional freshLine

36− (names, exports) <- option (["Main"],[]) moduleDef

73+ (names,exports) <- moduleDef

37− info <- many (try (annotation exports) <|> try skip <|> end)

74+ manyTill (string " " <|> newline <?> "more whitespace")

75+ (lookAhead (string "{-|") <?> "module documentation comment")

76+ structure <- docComment

38− return (intercalate "." names, concat info)

77+ return (List.intercalate "." names, exports, structure)

78+

79+document :: IParser [(String, Declaration t v, String)]

80+document = onFreshLines (\t ts -> ts ++ [t]) [] docThing

81+

82+docThing :: IParser (String, Declaration t v, String)

83+docThing = uncommentable <|> commented <|> uncommented ""

39 where

84 where

40− skip = manyTill anyChar simpleNewline >> return []

85+ uncommentable = do

41− end = many1 anyChar >> return []

86+ ifx <- infixDecl

42−

87+ return ("", ifx, "")

43−annotation :: [String] -> IParser [(String, String, String)]

88+

44−annotation exports =

89+ commented = do

45− do description <- comment

90+ comment <- docComment

46− extras <- option [] (lookAhead adt)

91+ freshLine

47− varName <- try typeDef <|> name

92+ uncommented comment

48− varType <- tipe

93+

49− return $ extras ++ export varName varType description

94+ uncommented comment = do

95+ (src,def) <- withSource $ choice [ alias, datatype, Definition <$> typeAnnotation ]

96+ return (comment, def, src)

97+

98+

99+documentToJson name exports structure things =

100+ object $ [ "name" .= name

101+ , "document" .= structure

102+ , "values" .= toList values

103+ , "aliases" .= toList aliases

104+ , "datatypes" .= toList adts

105+ ]

50 where

106 where

51− comment = concatMap clip <$> many lineComment

107+ (values, aliases, adts) = collect Map.empty Map.empty Map.empty Map.empty things

52− clip str = case str of { ' ':rest -> rest ; _ -> str } ++ "\n"

108+

109+ toList dict = map object . Map.elems $ filterPublics dict

53

110

54− name = do v <- lowVar <|> parens symOp

111+ exportMap = Map.fromList (zip exports exports)

55− whitespace ; hasType ; whitespace ; return v

112+ filterPublics dict =

113+ case Map.null exportMap of

114+ True -> dict

115+ False -> Map.filterWithKey (\k _ -> Map.member k exportMap) dict

56

116

57− tipe = manyTill anyChar (try (simpleNewline >> notFollowedBy (string " ")))

117+collect infixes types aliases adts things =

118+ case things of

119+ [] -> (Map.union customOps nonCustomOps, aliases, adts)

120+ where

121+ nonCustomOps = Map.mapWithKey addDefaultInfix $ Map.difference types infixes

122+ addDefaultInfix name pairs

123+ | all isSymbol name = addInfix (L, 9 :: Int) pairs

124+ | otherwise = pairs

58

125

59− export name tipe desc =

126+ customOps = Map.intersectionWith addInfix infixes types

60− if null exports || name `elem` exports then [(name,tipe,desc)] else []

127+ addInfix (assoc,prec) pairs =

128+ [ "associativity" .= show assoc, "precedence" .= prec ] ++ pairs

61

129

62− typeDef = lookAhead ((string "data" <|> string "type") >> whitespace >> capVar)

130+ (comment, decl, source) : rest ->

131+ case decl of

132+ Fixity assoc prec name ->

133+ collect (Map.insert name (assoc,prec) infixes) types aliases adts rest

134+ Definition (TypeAnnotation name tipe) ->

135+ collect infixes (insert name [ "type" .= tipe ] types) aliases adts rest

136+ TypeAlias name vars tipe ->

137+ let fields = ["typeVariables" .= vars, "type" .= tipe ]

138+ in collect infixes types (insert name fields aliases) adts rest

139+ Datatype name vars ctors ->

140+ let tipe = Data name (map Var vars)

141+ fields = ["typeVariables" .= vars, "constructors" .= map (ctorToJson tipe) ctors ]

142+ in collect infixes types aliases (insert name fields adts) rest

143+ where

144+ insert name fields dict = Map.insert name (obj name fields) dict

145+ obj name fields =

146+ [ "name" .= name, "raw" .= source, "comment" .= comment ] ++ fields

63

147

64− adt = do undefined

148+instance ToJSON Type where

65−{-- TODO: reimplement this

149+ toJSON tipe =

66− (Datatype name tvs constructors) <- datatype

150+ case tipe of

67− let toType (cName, typeArgs) =

151+ Lambda t1 t2 -> toJSON [ "->", toJSON t1, toJSON t2 ]

68− (cName, show $ foldr (==>) (kADT name $ map kVarT tvs) typeArgs, "")

152+ Var x -> toJSON x

69− return $ map toType constructors

153+ Data name ts -> toJSON (toJSON name : map toJSON ts)

70−--}

154+ EmptyRecord -> object []

155+ Record fields ext -> object $ map (\(n,t) -> Text.pack n .= toJSON t) fields'

156+ where fields' = case ext of

157+ EmptyRecord -> fields

158+ _ -> ("_",ext) : fields

71

159

72−setupParser p source =

160+ctorToJson tipe (ctor, tipes) =

73− case iParse p "" source of

161+ object [ "name" .= ctor

74− Right result -> Right result

162+ , "type" .= foldr Lambda tipe tipes ]

75− Left err -> Left $ "Parse error at " ++ show err

compiler/Generate/Cases.hs+20−23

@@ -1,23 +1,27 @@

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

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

2

3−import Control.Arrow (first)

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

4+import Control.Arrow (first,second)

4−import Control.Monad (liftM,foldM)

5+import Control.Monad.State

5import Data.List (groupBy,sortBy,lookup)

6import Data.List (groupBy,sortBy,lookup)

6import Data.Maybe (fromMaybe)

7import Data.Maybe (fromMaybe)

7

8

8−import Unique

9import SourceSyntax.Location

10import SourceSyntax.Literal

11import SourceSyntax.Pattern

12import SourceSyntax.Expression

13import Transform.Substitute

14

15+

16+toMatch :: [(Pattern, LExpr t v)] -> State Int (String, Match t v)

15−caseToMatch patterns = do

17+toMatch patterns = do

16 v <- newVar

18 v <- newVar

17− (,) v `liftM` match [v] (map (first (:[])) patterns) Fail

19+ (,) v <$> match [v] (map (first (:[])) patterns) Fail

18

20

19−newVar = do n <- guid

21+newVar :: State Int String

22+newVar = do n <- get

23+ modify (+1)

20− return $ "case" ++ show n

24+ return $ "_case" ++ show n

21

25

22data Match t v

26data Match t v

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

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

@@ -51,7 +55,7 @@ isCon (p:ps, e) =

51

55

52isVar p = not (isCon p)

56isVar p = not (isCon p)

53

57

54−match :: [String] -> [([Pattern],LExpr t v)] -> Match t v -> Unique (Match t v)

58+match :: [String] -> [([Pattern],LExpr t v)] -> Match t v -> State Int (Match t v)

55match [] [] def = return def

59match [] [] def = return def

56match [] [([],e)] Fail = return $ Other e

60match [] [([],e)] Fail = return $ Other e

57match [] [([],e)] Break = return $ Other e

61match [] [([],e)] Break = return $ Other e

@@ -68,8 +72,7 @@ dealias v c@(p:ps, L s e) =

68 PAlias x pattern -> (pattern:ps, L s $ subst x (Var v) e)

72 PAlias x pattern -> (pattern:ps, L s $ subst x (Var v) e)

69 _ -> c

73 _ -> c

70

74

71−matchVar :: [String] -> [([Pattern],LExpr t v)] -> Match t v

75+matchVar :: [String] -> [([Pattern],LExpr t v)] -> Match t v -> State Int (Match t v)

72− -> Unique (Match t v)

73matchVar (v:vs) cs def = match vs (map subVar cs) def

76matchVar (v:vs) cs def = match vs (map subVar cs) def

74 where

77 where

75 subVar (p:ps, ce@(L s e)) = (ps, L s $ subOnePattern p e)

78 subVar (p:ps, ce@(L s e)) = (ps, L s $ subOnePattern p e)

@@ -81,9 +84,8 @@ matchVar (v:vs) cs def = match vs (map subVar cs) def

81 PRecord fs ->

84 PRecord fs ->

82 foldr (\x -> subst x (Access (L s (Var v)) x)) e fs

85 foldr (\x -> subst x (Access (L s (Var v)) x)) e fs

83

86

84−matchCon :: [String] -> [([Pattern],LExpr t v)] -> Match t v

87+matchCon :: [String] -> [([Pattern],LExpr t v)] -> Match t v -> State Int (Match t v)

85− -> Unique (Match t v)

86−matchCon (v:vs) cs def = (flip (Match v) def) `liftM` mapM toClause css

88+matchCon (v:vs) cs def = (flip (Match v) def) <$> mapM toClause css

87 where

89 where

88 css = groupBy eq (sortBy cmp cs)

90 css = groupBy eq (sortBy cmp cs)

89

91

@@ -102,14 +104,10 @@ matchCon (v:vs) cs def = (flip (Match v) def) `liftM` mapM toClause css

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

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

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

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

104

106

105−matchClause :: Either String Literal

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

106− -> [String]

107− -> [([Pattern],LExpr t v)]

108− -> Match t v

109− -> Unique (Clause t v)

110matchClause c (v:vs) cs def =

108matchClause c (v:vs) cs def =

111 do vs' <- getVars

109 do vs' <- getVars

112− Clause c vs' `liftM` match (vs' ++ vs) (map flatten cs) def

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

113 where

111 where

114

112

115 flatten (p:ps, e) =

113 flatten (p:ps, e) =

@@ -119,10 +117,9 @@ matchClause c (v:vs) cs def =

119

117

120 getVars =

118 getVars =

121 case head cs of

119 case head cs of

122− (PData _ ps : _, _) -> mapM (\_ -> newVar) ps

120+ (PData _ ps : _, _) -> forM ps (const newVar)

123 (PLiteral _ : _, _) -> return []

121 (PLiteral _ : _, _) -> return []

124

122

125−matchMix :: [String] -> [([Pattern],LExpr t v)] -> Match t v

123+matchMix :: [String] -> [([Pattern],LExpr t v)] -> Match t v -> State Int (Match t v)

126− -> Unique (Match t v)

127matchMix vs cs def = foldM (flip $ match vs) def (reverse css)

124matchMix vs cs def = foldM (flip $ match vs) def (reverse css)

128 where css = groupBy (\p1 p2 -> isCon p1 == isCon p2) cs

125 where css = groupBy (\p1 p2 -> isCon p1 == isCon p2) cs

compiler/Generate/Html.hs+4−22

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

1{-# LANGUAGE OverloadedStrings #-}

2module Generate.Html

3− (generateHtml,

4− createHtml,

3+ (createHtml,

5− JSStyle (..),

6 JSSource (..)

4 JSSource (..)

7 ) where

5 ) where

8

6

@@ -10,37 +8,21 @@ import Text.Blaze (preEscapedToMarkup)

10import qualified Text.Blaze.Html5 as H

8import qualified Text.Blaze.Html5 as H

11import Text.Blaze.Html5 ((!))

9import Text.Blaze.Html5 ((!))

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

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

13−

14−import Text.Jasmine (minify)

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

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

16

12

17import Initialize (buildFromSource)

13import Initialize (buildFromSource)

18import Generate.JavaScript

14import Generate.JavaScript

19import Generate.Noscript

15import Generate.Noscript

20

16

21−data JSStyle = Minified | Readable

22−data JSSource = Link String | Source JSStyle String

17+data JSSource = Link String | Source BS.ByteString

23

18

24makeScript :: JSSource -> H.Html

19makeScript :: JSSource -> H.Html

25makeScript source =

20makeScript source =

26 case source of

21 case source of

27 Link src -> H.script ! A.type_ "text/javascript" ! A.src (H.toValue src) $ ""

22 Link src -> H.script ! A.type_ "text/javascript" ! A.src (H.toValue src) $ ""

28− Source style src ->

23+ Source src ->

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

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

30− preEscapedToMarkup $ case style of

25+ preEscapedToMarkup $ BS.unpack src

31− Minified -> BS.unpack . minify . BS.pack $ src

32− Readable -> src

33−

34−-- |This function compiles Elm code into simple HTML.

35−--

36−-- Usage example:

37−--

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

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

40− -> String -- ^ The page title

41− -> String -- ^ The elm source code.

42− -> H.Html

43−generateHtml libLoc title source = error "function 'generateHtml' is unimplemented for now"

44

26

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

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

46createHtml libLoc title scripts moduleName noscript =

28createHtml libLoc title scripts moduleName noscript =

compiler/Generate/JavaScript.hs+380−330

@@ -1,361 +1,411 @@

1−module Generate.JavaScript (jsModule) where

1+module Generate.JavaScript where

2

3−import Control.Arrow (first,second)

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

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

4−import Control.Monad (liftM,(<=<),join,ap)

5+import Control.Monad.State

5−import Data.Char (isAlpha,isDigit)

6import qualified Data.List as List

7import qualified Data.Map as Map

8import qualified Data.Set as Set

9−import Data.Either (partitionEithers)

10import qualified Text.Pandoc as Pan

9import qualified Text.Pandoc as Pan

11

10

12−import Unique

13−import Generate.Cases

11+import qualified Generate.Cases as Case

14import SourceSyntax.Everything

12import SourceSyntax.Everything

15import SourceSyntax.Location

13import SourceSyntax.Location

16import qualified Transform.SortDefinitions as SD

14import qualified Transform.SortDefinitions as SD

15+import Language.ECMAScript3.Syntax

16+import Language.ECMAScript3.PrettyPrint

17+import Parse.Helpers (jsReserveds)

17

18

18−indent = concatMap f

19+makeSafe :: String -> String

19− where f '\n' = "\n "

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

20− f c = [c]

21+ where

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

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

24+ False -> x

25+ True -> "$" ++ x

26+

27+split = go []

28+ where

29+ go vars str =

30+ case break (=='.') str of

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

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

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

34+

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

36+ref name = VarRef () (var name)

37+prop name = PropId () (var name)

38+f <| x = CallExpr () f [x]

39+args ==> e = FuncExpr () Nothing (map var args) [ ReturnStmt () (Just e) ]

40+function args stmts = FuncExpr () Nothing (map var args) stmts

41+call = CallExpr ()

42+string = StringLit ()

43+

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

45+obj = dotSep . split

46+

47+varDecl x expr =

48+ VarDecl () (var x) (Just expr)

49+

50+include alias moduleName =

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

21

52

22internalImports name =

53internalImports name =

54+ VarDeclStmt ()

23− [ ("N" , "Elm.Native"),

55+ [ varDecl "N" (obj "Elm.Native")

24− ("_N", "N.Utils(elm)"),

56+ , include "_N" "N.Utils"

25− ("_L", "N.List(elm)"),

57+ , include "_L" "N.List"

26− ("_E", "N.Error(elm)"),

58+ , include "_E" "N.Error"

27− ("_J", "N.JavaScript(elm)"),

59+ , include "_J" "N.JavaScript"

28− ("_str", "_J.toString"),

29− ("$moduleName", quoted name)

60+ , varDecl "$moduleName" (string name)

30 ]

61 ]

31

62

32−parens s = "(" ++ s ++ ")"

63+literal lit =

33−brackets s = "{" ++ s ++ "}"

64+ case lit of

34−commaSep = List.intercalate ", "

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

35−dotSep = List.intercalate "."

66+ Str s -> string s

36−jsObj = brackets . commaSep

67+ IntNum n -> IntLit () n

37−jsList ss = "["++ List.intercalate "," ss ++"]"

68+ FloatNum n -> NumLit () n

38−jsFunc args body = "function(" ++ args ++ "){" ++ indent body ++ "}"

69+ Boolean b -> BoolLit () b

39−assign x e = "\nvar " ++ x ++ " = " ++ e ++ ";"

70+

40−ret e = "\nreturn "++ e ++";"

71+expression :: LExpr () () -> State Int (Expression ())

41−quoted s = "'" ++ concatMap f s ++ "'"

72+expression (L span expr) =

42− where f '\n' = "\\n"

73+ case expr of

43− f '\'' = "\\'"

74+ Var x -> return $ ref x

44− f '\t' = "\\t"

75+ Literal lit -> return $ literal lit

45− f '\"' = "\\\""

76+

46− f '\\' = "\\\\"

77+ Range lo hi ->

47− f c = [c]

78+ do lo' <- expression lo

48−

79+ hi' <- expression hi

49−globalAssign n e = "\n" ++ assign' n e ++ ";"

80+ return $ obj "_L.range" `call` [lo',hi']

50−assign' n e = n ++ " = " ++ e

81+

51−

82+ Access e x ->

83+ do e' <- expression e

84+ return $ DotRef () e' (var x)

85+

86+ Remove e x ->

87+ do e' <- expression e

88+ return $ obj "_N.remove" `call` [string x, e']

89+

90+ Insert e x v ->

91+ do v' <- expression v

92+ e' <- expression e

93+ return $ obj "_N.insert" `call` [string x, v', e']

94+

95+ Modify e fs ->

96+ do e' <- expression e

97+ fs' <- forM fs $ \(f,v) -> do

98+ v' <- expression v

99+ return $ ArrayLit () [string f, v']

100+ return $ obj "_N.replace" `call` [ArrayLit () fs', e']

101+

102+ Record fields ->

103+ do fields' <- forM fields $ \(f,e) -> do

104+ (,) f <$> expression e

105+ let fieldMap = List.foldl' combine Map.empty fields'

106+ return $ ObjectLit () $ (PropId () (var "_"), hidden fieldMap) : visible fieldMap

107+ where

108+ combine r (k,v) = Map.insertWith (++) k [v] r

109+ prop = PropId () . var

110+ hidden fs = ObjectLit () . map (prop *** ArrayLit ()) .

111+ Map.toList . Map.filter (not . null) $ Map.map tail fs

112+ visible fs = map (first prop) . Map.toList $ Map.map head fs

113+

114+ Binop op e1 e2 -> binop span op e1 e2

115+

116+ Lambda p e@(L s _) ->

117+ do body' <- expression body

118+ return $ case length args < 2 || length args > 9 of

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

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

121+ where

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

123+

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

125+ case pattern of

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

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

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

129+

130+ (patterns, innerBody) = collect [p] e

131+

132+ collect patterns lexpr@(L _ expr) =

133+ case expr of

134+ Lambda p e -> collect (p:patterns) e

135+ _ -> (patterns, lexpr)

136+

137+ App e1 e2 ->

138+ do func' <- expression func

139+ args' <- mapM expression args

140+ return $ case args' of

141+ [arg] -> func' <| arg

142+ _ | length args' <= 9 -> ref aN `call` (func':args')

143+ | otherwise -> foldl1 (<|) (func':args')

144+ where

145+ aN = "A" ++ show (length args)

146+ (func, args) = getArgs e1 [e2]

147+ getArgs func args =

148+ case func of

149+ (L _ (App f arg)) -> getArgs f (arg : args)

150+ _ -> (func, args)

151+

152+ Let defs e ->

153+ do let (defs',e') = SD.flattenLets defs e

154+ stmts <- concat <$> mapM definition defs'

155+ exp <- expression e'

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

157+

158+ MultiIf branches ->

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

160+ return $ case last branches of

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

162+ _ -> ifs branches'

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

164+ where

165+ ifs branches finally = foldr iff finally branches

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

167+

168+ Case e cases ->

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

170+ (revisedMatch, stmt) <-

171+ case e of

172+ L _ (Var x) -> return (Case.matchSubst [(tempVar,x)] initialMatch, [])

173+ _ -> do e' <- expression e

174+ return (initialMatch, [VarDeclStmt () [varDecl tempVar e']])

175+ match' <- match span revisedMatch

176+ return (function [] (stmt ++ match') `call` [])

177+

178+ ExplicitList es ->

179+ do es' <- mapM expression es

180+ return $ obj "_J.toList" <| ArrayLit () es'

181+

182+ Data name es ->

183+ do es' <- mapM expression es

184+ return $ ObjectLit () (ctor : fields es')

185+ where

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

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

188+

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

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

191+ md = Pan.writeHtmlString Pan.def doc

192+

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

194+definition def =

195+ case def of

196+ TypeAnnotation _ _ -> return []

197+

198+ Def pattern expr@(L span _) -> do

199+ expr' <- expression expr

200+ let assign x = varDecl x expr'

201+ case pattern of

202+ PVar x

203+ | isOp x ->

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

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

206+ | otherwise ->

207+ return [ VarDeclStmt () [ assign x ] ]

208+

209+ PRecord fields ->

210+ let setField f = varDecl f (dotSep ["$",f]) in

211+ return [ VarDeclStmt () (assign "$" : map setField fields) ]

212+

213+ PData name patterns | vars /= Nothing ->

214+ case vars of

215+ Just vs -> return [ VarDeclStmt () (setup (zipWith decl vs [0..])) ]

216+ where

217+ vars = getVars patterns

218+ getVars patterns =

219+ case patterns of

220+ PVar x : rest -> (x:) `fmap` getVars rest

221+ [] -> Just []

222+ _ -> Nothing

223+

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

225+ setup vars

226+ | isTuple name = assign "$" : vars

227+ | otherwise = safeAssign : vars

228+

229+ safeAssign = varDecl "$" (CondExpr () if' expr' exception)

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

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

232+

233+ _ ->

234+ do defs' <- concat <$> mapM toDef vars

235+ return (VarDeclStmt () [assign "$"] : defs')

236+ where

237+ vars = Set.toList $ SD.boundVars pattern

238+ mkVar = L span . Var

239+ toDef y = definition $

240+ Def (PVar y) (L span $ Case (mkVar "$") [(pattern, mkVar y)])

241+

242+match :: (Show a) => a -> Case.Match () () -> State Int [Statement ()]

243+match span mtch =

244+ case mtch of

245+ Case.Match name clauses mtch' ->

246+ do clauses' <- mapM (clause span name) clauses

247+ mtch'' <- match span mtch'

248+ return (SwitchStmt () (access name) clauses' : mtch'')

249+ where

250+ isLiteral p = case p of

251+ Case.Clause (Right _) _ _ -> True

252+ _ -> False

253+ access name = if any isLiteral clauses then ref name else dotSep [name,"ctor"]

254+

255+ Case.Fail ->

256+ return [ ExprStmt () (obj "_E.Case" `call` [ref "$moduleName", string (show span)]) ]

257+

258+ Case.Break -> return [BreakStmt () Nothing]

259+ Case.Other e ->

260+ do e' <- expression e

261+ return [ ReturnStmt () (Just e') ]

262+ Case.Seq ms -> concat <$> mapM (match span) (dropEnd [] ms)

263+ where

264+ dropEnd acc [] = acc

265+ dropEnd acc (m:ms) =

266+ case m of

267+ Case.Other _ -> acc ++ [m]

268+ _ -> dropEnd (acc ++ [m]) ms

269+

270+clause span variable (Case.Clause value vars mtch) =

271+ CaseClause () pattern <$> match span (Case.matchSubst (zip vars vars') mtch)

272+ where

273+ vars' = map (\n -> variable ++ "._" ++ show n) [0..]

274+ pattern = case value of

275+ Right (Boolean b) -> BoolLit () b

276+ Right lit -> literal lit

277+ Left name -> string $ case List.elemIndices '.' name of

278+ [] -> name

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

280+

281+

52−jsModule :: MetadataModule t v -> String

282+jsModule :: MetadataModule () () -> String

53jsModule modul =

283jsModule modul =

54− run $ do

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

55− body <- toJS . fst . SD.flattenLets [] $ program modul

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

56− foreignImport <- mapM importEvent (foreignImports modul)

57− return $ concat [ setup ("Elm": names modul)

58− , globalAssign ("Elm." ++ modName)

59− (jsFunc "elm" $ makeProgram body foreignImport) ]

60 where

286 where

61− modName = dotSep (names modul)

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

62− makeProgram body foreignImport =

288+ programStmts =

63− concat [ "\nvar " ++ usefulFuncs ++ ";"

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

290+ , [ IfSingleStmt () thisModule (ReturnStmt () (Just thisModule)) ]

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

64 , concatMap jsImport (imports modul)

292 , concatMap jsImport (imports modul)

65− , concat foreignImport

293+ , concatMap importEvent (foreignImports modul)

66− , assign "_op" "{}"

294+ , [ assign ["_op"] (ObjectLit () []) ]

67− , body

295+ , concat $ evalState (mapM definition . fst . SD.flattenLets [] $ program modul) 0

68− , concatMap exportEvent $ foreignExports modul

296+ , map exportEvent $ foreignExports modul

69− , jsExports

297+ , [ jsExports ]

298+ , [ ReturnStmt () (Just thisModule) ]

70 ]

299 ]

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

72− map dotSep . drop 2 . List.inits $ init names

73− usefulFuncs = commaSep (map (uncurry assign') (internalImports modName))

74

300

75− jsExports = setup ("elm" : names modul) ++

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

76− ret (assign' ("elm." ++ modName) (brackets exs))

302+ where

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

304+ entry x = (PropId () (var x), ref x)

305+

306+ assign path expr =

307+ case path of

308+ [x] -> VarDeclStmt () [ varDecl x expr ]

309+ _ -> ExprStmt () $

310+ AssignExpr () OpAssign (LDot () (dotSep (init path)) (last path)) expr

311+

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

313+ where

314+ path = split modul

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

316+

317+ setup namespace path = map create paths

77 where

318 where

78− exs = indent . commaSep . concatMap pair $ "_op" : exports modul

319+ create name = assign name (InfixExpr () OpLOr (dotSep name) (ObjectLit () []))

79− pair x | isOp x = []

320+ paths = case namespace of

80− | otherwise = ["\n" ++ x ++ " : " ++ x]

321+ Nothing -> tail . init $ List.inits path

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

81

323

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

82

325

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

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

84− do v <- toJS' base

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

85− return $ concat [ "\nvar " ++ elm ++ "=Signal.constant(" ++ v ++ ");"

328+ , ExprStmt () $

86− , "\ndocument.addEventListener('", js

329+ obj "document.addEventListener" `call`

330+ [ addId js

87− , "_' + elm.id, function(e) { elm.notify(", elm

331+ , function ["e"]

88− , ".id, e.value); });" ]

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

333+ ]

334+ ]

89

335

90 exportEvent (js,elm,_) =

336 exportEvent (js,elm,_) =

337+ ExprStmt () $

338+ ref "A2" `call`

91− concat [ "\nA2( Signal.lift, function(v) { "

339+ [ obj "Signal.lift"

340+ , function ["v"]

92− , "var e = document.createEvent('Event');"

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

93− , "e.initEvent('", js, "_' + elm.id, true, true);"

342+ , ExprStmt () $

94− , "e.value = v;"

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

344+ , ExprStmt () $ AssignExpr () OpAssign (LDot () (ref "e") "value") (ref "v")

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

345+ , ExprStmt () $ obj "document.dispatchEvent" <| ref "e"

96−

346+ , ReturnStmt () (Just $ ref "v")

97−jsImport (modul, method) =

347+ ]

98− concat $ zipWith3 (\s n v -> s ++ assign' n v ++ ";") starters subnames values

348+ , ref elm ]

99− where

349+

100− starters = "\nvar " : repeat "\n"

101− values = map (\name -> name ++ " || {}") (init subnames) ++

102− ["Elm." ++ modul ++ parens "elm"]

103− subnames = map dotSep . tail . List.inits $ split modul

104−

105− split names = case go [] names of

106− (name, []) -> [name]

107− (name, ns) -> name : split ns

108− go name str = case str of

109− '.':rest -> (reverse name, rest)

110− c:rest -> go (c:name) rest

111− [] -> (reverse name, [])

112−

113−

114−class ToJS a where

115− toJS :: a -> Unique String

116−

117−

118−instance ToJS (Def t v) where

119−

120− -- TODO: Make this handle patterns besides plain variables

121− toJS (Def (PVar x) e)

122− | isOp x = globalAssign ("_op['" ++ x ++ "']") `liftM` toJS' e

123− | otherwise = assign x `liftM` toJS' e

124−

125− toJS (Def pattern e@(L s _)) =

126− do n <- guid

127− let x = "_" ++ show n

128− var = L s . Var

129− toDef y = Def (PVar y) (L s $ Case (var x) [(pattern, var y)])

130− stmt <- assign x `liftM` toJS' e

131− vars <- toJS . map toDef . Set.toList $ SD.boundVars pattern

132− return (stmt ++ vars)

133−

134− toJS (TypeAnnotation _ _) = return ""

135−

136−

137−instance ToJS a => ToJS [a] where

138− toJS xs = concat `liftM` mapM toJS xs

139−

140−toJS' :: LExpr t v -> Unique String

141−toJS' (L span expr) =

142− case expr of

143− MultiIf ps -> multiIfToJS span ps

144− Case e cases -> caseToJS span e cases

145− _ -> toJS expr

146−

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

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

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

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

151−access x e = e ++ "." ++ x

152−makeRecord kvs = record `liftM` collect kvs

153− where

154− combine r (k,v) = Map.insertWith (++) k v r

155− collect = liftM (List.foldl' combine Map.empty) . mapM prep

156− prep (k, e) =

157− do v <- toJS' e

158− return (k, [v])

159− fields fs =

160− brackets ("\n "++List.intercalate ",\n " (map (\(k,v) -> k++":"++v) fs))

161− hidden = fields . map (second jsList) .

162− filter (not . null . snd) . Map.toList . Map.map tail

163− record kvs = fields . (("_", hidden kvs) :) . Map.toList . Map.map head $ kvs

164−

165−

166−instance ToJS Literal where

167− toJS lit =

168− case lit of

169− Chr c -> return $ quoted [c]

170− Str s -> return $ "_str" ++ parens (quoted s)

171− IntNum n -> return $ show n

172− FloatNum n -> return $ show n

173− Boolean b -> return $ if b then "true" else "false"

174−

175−

176−instance ToJS (Expr t v) where

177− toJS expr =

178− case expr of

179− Var x -> return x

180− Literal lit -> toJS lit

181− Range lo hi -> jsRange `liftM` toJS' lo `ap` toJS' hi

182− Access e x -> access x `liftM` toJS' e

183− Remove e x -> remove x `liftM` toJS' e

184− Insert e x v -> addField x `liftM` toJS' v `ap` toJS' e

185− Modify e fs -> do fs' <- (mapM (\(x,v) -> (,) x `liftM` toJS' v) fs)

186− setField fs' `liftM` toJS' e

187− Record fs -> makeRecord fs

188− Binop op e1 e2 -> binop op e1 e2

350+binop span op e1 e2 =

189−

351+ case op of

190− Lambda p e@(L s _) -> liftM fastFunc (toJS' body)

352+ "Basics.." ->

191− where

353+ do es <- mapM expression (e1 : collect [] e2)

192− fastFunc body

354+ return $ ["$"] ==> foldr (<|) (ref "$") es

193− | length args < 2 || length args > 9 =

355+ "Basics.<|" ->

194− foldr (\arg bod -> jsFunc arg (ret bod)) body args

356+ do e2' <- expression e2

195− | otherwise =

357+ es <- mapM expression (collect [] e1)

196− "F" ++ show (length args) ++ parens (jsFunc (commaSep args) (ret body))

358+ return $ foldr (<|) e2' es

197−

359+ "List.++" ->

198− (args, body) = first reverse $ foldr depattern ([], innerBody) (zip patterns [1..])

360+ do e1' <- expression e1

199−

361+ e2' <- expression e2

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

362+ return $ obj "_L.append" `call` [e1', e2']

201− case pattern of

363+ "::" -> expression (L span (Data "::" [e1,e2]))

202− PVar x -> (x : args, body)

364+ _ ->

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

365+ do e1' <- expression e1

204− in (arg:args, L s (Case (L s (Var arg)) [(pattern, body)]))

366+ e2' <- expression e2

205−

367+ return $ case Map.lookup op opDict of

206− (patterns, innerBody) = collect [p] e

368+ Just f -> f e1' e2'

207−

369+ Nothing -> ref "A2" `call` [ func, e1', e2' ]

208− collect patterns lexpr@(L _ expr) =

209− case expr of

210− Lambda p e -> collect (p:patterns) e

211− _ -> (patterns, lexpr)

212−

213− App e1 e2 -> jsApp e1 e2

214− Let defs e -> jsLet $ SD.flattenLets defs e

215−

216− ExplicitList es ->

217− do es' <- mapM toJS' es

218− return $ "_J.toList" ++ parens (jsList es')

219−

220− Data name es ->

221− do fs <- mapM toJS' es

222− return $ case name of

223− "[]" -> jsNil

224− "::" -> jsCons (head fs) ((head . tail) fs)

225− _ -> jsObj $ ("ctor:" ++ show name) : fields

226− where fields = zipWith (\n e -> "_" ++ show n ++ ":" ++ e) [0..] fs

227−

228− Markdown doc -> return $ "Text.text('" ++ pad ++ md ++ pad ++ "')"

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

230− md = formatMarkdown $ Pan.writeHtmlString Pan.def doc

231−

232−jsApp e1 e2 =

233− do f <- toJS' func

234− as <- mapM toJS' args

235− return $ case as of

236− [a] -> f ++ parens a

237− _ -> "A" ++ show (length as) ++ parens (commaSep (f:as))

238− where

239− (func, args) = go [e2] e1

240− go args e =

241− case e of

242− (L _ (App e1 e2)) -> go (e2 : args) e1

243− _ -> (e, args)

244−

245−formatMarkdown = concatMap f

246− where f '\'' = "\\'"

247− f '\n' = "\\n"

248− f '"' = "\""

249− f c = [c]

250−

251−multiIfToJS span ps =

252− case last ps of

253− (L _ (Var "otherwise"), e) -> toJS' e >>= \b -> format b (init ps)

254− _ -> format ("_E.If" ++ parens ("$moduleName," ++ quoted (show span))) ps

255 where

370 where

256− format base ps =

257− foldr (\c e -> parens $ c ++ " : " ++ e) base `liftM` mapM f ps

258− f (b,e) = do b' <- toJS' b

259− e' <- toJS' e

260− return (b' ++ " ? " ++ e')

261−

262−jsLet (defs,e') = do ds <- mapM toJS defs

263− e <- toJS' e'

264− return $ jsFunc "" (concat ds ++ ret e) ++ "()"

265−

266−caseToJS span e ps = do

267− (tempVar,match) <- caseToMatch ps

268− e' <- toJS' e

269− let (match',stmt) = case e of

270− L _ (Var x) -> (matchSubst [(tempVar,x)] match, "")

271− _ -> (match, assign tempVar e')

272− matches <- matchToJS span match'

273− return $ jsFunc "" (stmt ++ matches) ++ "()"

274−

275−matchToJS span match =

276− case match of

277− Match name clauses def ->

278− do cases <- concat `liftM` mapM (clauseToJS span name) clauses

279− finally <- matchToJS span def

280− let isLiteral p = case p of

281− Clause (Right _) _ _ -> True

282− _ -> False

283− access = if any isLiteral clauses then "" else ".ctor"

284− return $ concat [ "\nswitch (", name, access, ") {"

285− , indent cases, "\n}", finally ]

286− Fail -> return ("_E.Case" ++ parens ("$moduleName," ++ quoted (show span)))

287− Break -> return "break;"

288− Other e -> ret `liftM` toJS' e

289− Seq ms -> concat `liftM` mapM (matchToJS span) (dropEnd [] ms)

290− where

291− dropEnd acc [] = acc

292− dropEnd acc (m:ms) =

293− case m of

294− Other _ -> acc ++ [m]

295− _ -> dropEnd (acc ++ [m]) ms

296−

297−clauseToJS span var (Clause value vars e) = do

298− let vars' = map (\n -> var ++ "._" ++ show n) [0..]

299− s <- matchToJS span $ matchSubst (zip vars vars') e

300− pattern <- case value of

301− Right (Boolean True) -> return "true"

302− Right (Boolean False) -> return "false"

303− Right lit -> toJS lit

304− Left name -> return . quoted $ case List.elemIndices '.' name of

305− [] -> name

306− is -> drop (last is + 1) name

307− return $ concat [ "\ncase ", pattern, ":", indent s ]

308−

309−jsNil = "_L.Nil"

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

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

312−jsCompare e1 e2 op = parens ("_N.cmp(" ++ e1 ++ "," ++ e2 ++ ")" ++ op)

313−

314−

315−binop op e1 e2

316− | op == "Basics.." =

317− do ss <- mapM toJS' (e1 : collect [] e2)

318− return . jsFunc "$" . ret $ apply "$" ss

319− | op == "Basics.<|" =

320− do arg <- toJS' e2

321− funcs <- mapM toJS' (collect [] e1)

322− return (apply arg funcs)

323− | otherwise =

324− binopNormal op `liftM` toJS' e1 `ap` toJS' e2

325− where

326− apply = foldr (\f arg-> f ++ parens arg)

327−

328 collect es e =

371 collect es e =

329 case e of

372 case e of

330 L _ (Binop op e1 e2) | op == "Basics.." -> collect (es ++ [e1]) e2

373 L _ (Binop op e1 e2) | op == "Basics.." -> collect (es ++ [e1]) e2

331 _ -> es ++ [e]

374 _ -> es ++ [e]

332

375

333−binopNormal op s1 s2 =

376+ js1 = expression e1

334− case Map.lookup op opDict of

377+ js2 = expression e2

335− Just e -> e

378+

336− Nothing -> "A2" ++ parens (commaSep [ prefix ++ func, s1, s2 ])

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

337− where

338− func | isOp op' = "_op['" ++ op' ++ "']"

339− | otherwise = op'

380+ | otherwise = dotSep parts

340− (prefix, op') = case List.elemIndices '.' op of

381+ where

341− [] -> ("", op)

382+ parts = split op

342− xs -> splitAt (last xs + 1) op

383+ operator = last parts

343−

384+

344− opDict = Map.fromList $ basics ++

385+ opDict = Map.fromList (infixOps ++ specialOps)

345− [ ("::", jsCons s1 s2)

386+

346− , ("List.++", "_L.append" ++ parens (s1 ++ "," ++ s2)) ]

387+ specialOp str func = [ (str, func), ("Basics." ++ str, func) ]

347−

388+ infixOp str op = specialOp str (InfixExpr () op)

348− ops = pow : map (\op -> (op, parens (s1 ++ op ++ s2))) ["+","-","*","/","&&","||"]

389+

349− where pow = ("^" , "Math.pow(" ++ s1 ++ "," ++ s2 ++ ")")

390+ infixOps = concat

350−

391+ [ infixOp "+" OpAdd

351− basics = ops ++ map (\(op,e) -> ("Basics." ++ op, e))

392+ , infixOp "-" OpSub

352− (ops ++ [ ("<|", s1 ++ parens s2)

393+ , infixOp "*" OpMul

353− , ("|>", s2 ++ parens s1)

394+ , infixOp "/" OpDiv

354− , ("==", "_N.eq(" ++ s1 ++ "," ++ s2 ++ ")")

395+ , infixOp "&&" OpLAnd

355− , ("/=", "!_N.eq(" ++ s1 ++ "," ++ s2 ++ ")")

396+ , infixOp "||" OpLOr

356− , ("<" , jsCompare s1 s2 "<0")

397+ ]

357− , (">" , jsCompare s1 s2 ">0")

398+

358− , ("<=", jsCompare s1 s2 "<1")

399+ specialOps = concat

359− , (">=", jsCompare s1 s2 ">-1")

400+ [ specialOp "^" $ \a b -> obj "Math.pow" `call` [a,b]

360− , ("div", parens (s1 ++ "/" ++ s2 ++ "|0"))

401+ , specialOp "|>" $ flip (<|)

361− ])

402+ , specialOp "==" $ \a b -> obj "_N.eq" `call` [a,b]

403+ , specialOp "/=" $ \a b -> PrefixExpr () PrefixLNot (obj "_N.eq" `call` [a,b])

404+ , specialOp "<" $ cmp OpLT 0

405+ , specialOp ">" $ cmp OpGT 0

406+ , specialOp "<=" $ cmp OpLT 1

407+ , specialOp ">=" $ cmp OpGT (-1)

408+ , specialOp "div" $ \a b -> InfixExpr () OpBOr (InfixExpr () OpDiv a b) (IntLit () 0)

409+ ]

410+

411+ cmp op n a b = InfixExpr () op (obj "_N.cmp" `call` [a,b]) (IntLit () n)

compiler/Generate/Noscript.hs+1−1

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

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

50 Data _ es -> concatMap f es

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

52− Markdown doc -> [ Pan.writeHtmlString Pan.def doc ]

52+ Markdown doc _ -> [ Pan.writeHtmlString Pan.def doc ]

53 _ -> []

54

55extractLink src txt =

compiler/Initialize.hs+30−11

@@ -6,11 +6,13 @@ import qualified Data.Graph as Graph

6import qualified Data.List as List

7import qualified Data.Map as Map

8import qualified Data.Set as Set

9+import System.Directory

9import System.Exit

10import System.Exit

10import System.FilePath as FP

11import System.FilePath as FP

11import Text.PrettyPrint (Doc)

12import Text.PrettyPrint (Doc)

12

13

13import SourceSyntax.Everything

14import SourceSyntax.Everything

15+import qualified SourceSyntax.Type as Type

14import qualified Parse.Parse as Parse

16import qualified Parse.Parse as Parse

15import qualified Metadata.Prelude as Prelude

17import qualified Metadata.Prelude as Prelude

16import qualified Transform.Check as Check

18import qualified Transform.Check as Check

@@ -22,7 +24,10 @@ import qualified Transform.Canonicalize as Canonical

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

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

23buildFromSource noPrelude interfaces source =

25buildFromSource noPrelude interfaces source =

24 do let add = if noPrelude then id else Prelude.add

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

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

28+ . concatMap iFixities $ Map.elems interfaces

29+

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

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

26

31

27 -- check for structural errors

32 -- check for structural errors

28 Module names exs ims decls <-

33 Module names exs ims decls <-

@@ -34,7 +39,8 @@ buildFromSource noPrelude interfaces source =

34 | null exs =

39 | null exs =

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

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

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

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

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

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

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

38 | otherwise = exs

44 | otherwise = exs

39

45

40 metaModule <- Canonical.metadataModule interfaces $ MetadataModule {

46 metaModule <- Canonical.metadataModule interfaces $ MetadataModule {

@@ -57,9 +63,9 @@ buildFromSource noPrelude interfaces source =

57 return $ metaModule { types = types }

63 return $ metaModule { types = types }

58

64

59

65

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

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

61−getSortedDependencies noPrelude root =

67+getSortedDependencies srcDirs noPrelude root =

62− sortDeps =<< readDeps noPrelude root

68+ sortDeps =<< readDeps srcDirs noPrelude root

63

69

64type Deps = (FilePath, String, [String])

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

65

71

@@ -74,18 +80,18 @@ sortDeps depends =

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

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

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

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

76

82

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

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

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

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

79 where

85 where

80 builtIns = if noPrelude then Set.empty

86 builtIns = if noPrelude then Set.empty

81 else Set.fromList (Map.keys Prelude.interfaces)

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

82

88

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

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

84 go root = do

90 go root = do

85− txt <- liftIO $ readFile root

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

86 case Parse.dependencies txt of

92 case Parse.dependencies txt of

87 Left err -> liftIO (putStrLn msg >> print err >> exitFailure)

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

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

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

89

95

90 Right (name,deps) ->

96 Right (name,deps) ->

91 do seen <- get

97 do seen <- get

@@ -93,8 +99,21 @@ readDeps noPrelude root = evalStateT (go root) Set.empty

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

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

94 put (Set.insert name (Set.union newDeps seen))

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

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

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

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

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

97−

103+

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

105+getFile [] path = do

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

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

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

109+ exitFailure

110+

111+getFile (dir:dirs) path = do

112+ let path' = dir </> path

113+ exists <- doesFileExist path'

114+ case exists of

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

116+ False -> getFile dirs path

98

117

99isNative name = List.isPrefixOf "Native." name

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

100

119

compiler/Language/Elm.hs+3−11

@@ -1,17 +1,16 @@

1−{- | This module exports the functions necessary for compiling Elm code into the

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

2− respective HTML, CSS, and JS code.

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

3

4 The documentation for the Elm language is available at

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

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

7-}

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

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

9

10import qualified Data.List as List

11import qualified Data.Map as Map

12import Data.Version (showVersion)

13import Generate.JavaScript (jsModule)

14−import Generate.Html (generateHtml)

15import Initialize (buildFromSource)

14import Initialize (buildFromSource)

16import Parse.Module (getModuleName)

15import Parse.Module (getModuleName)

17import SourceSyntax.Module

16import SourceSyntax.Module

@@ -32,13 +31,6 @@ compile source =

32moduleName :: String -> Maybe String

31moduleName :: String -> Maybe String

33moduleName = getModuleName

32moduleName = getModuleName

34

33

35−-- |This function compiles Elm code into a full HTML page.

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

37− -> String -- ^ The page title

38− -> String -- ^ The elm source code

39− -> Html

40−toHtml = generateHtml

41−

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

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

43runtime :: IO FilePath

35runtime :: IO FilePath

44runtime = getDataFileName "elm-runtime.js"

36runtime = getDataFileName "elm-runtime.js"

compiler/Parse/Binop.hs+7−36

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

1−module Parse.Binop (binops, infixStmt, OpTable) where

1+module Parse.Binop (binops, OpTable) where

2

3import Control.Applicative ((<$>))

4import Control.Monad.Error

@@ -11,42 +11,23 @@ import SourceSyntax.Declaration (Assoc(..))

11import Text.Parsec

12import Parse.Helpers

13

14−type OpTable = [(Int, Assoc, String)]

15−

16−preludeTable :: OpTable

17−preludeTable =

18− [ (9, R, ".")

19− , (8, R, "^")

20− , (7, L, "*"), (7, L, "/"), (7, L, "mod"), (7, L, "div"), (7, L, "rem")

21− , (6, L, "+"), (6, L, "-")

22− , (5, R, "::"), (5, R, "++")

23− , (4, N, "<="), (4, N, ">="), (4, N, "<")

24− , (4, N, "=="), (4, N, "/="), (4, N, ">")

25− , (4, L, "~"), (4, L, "<~")

26− , (3, R, "&&")

27− , (2, R, "||")

28− , (0, R, "<|"), (0, L, "|>")

29− ]

30−

31opLevel :: OpTable -> String -> Int

14opLevel :: OpTable -> String -> Int

32−opLevel table op = Map.findWithDefault 9 op dict

15+opLevel table op = fst $ Map.findWithDefault (9,L) op table

33− where dict = Map.fromList (map (\(lvl,_,op) -> (op,lvl)) table)

34

16

35opAssoc :: OpTable -> String -> Assoc

17opAssoc :: OpTable -> String -> Assoc

36−opAssoc table op = Map.findWithDefault R op dict

18+opAssoc table op = snd $ Map.findWithDefault (9,L) op table

37− where dict = Map.fromList (map (\(_,assoc,op) -> (op,assoc)) table)

38

19

39hasLevel :: OpTable -> Int -> (String, LExpr t v) -> Bool

20hasLevel :: OpTable -> Int -> (String, LExpr t v) -> Bool

40hasLevel table n (op,_) = opLevel table op == n

21hasLevel table n (op,_) = opLevel table op == n

41

22

42−binops :: OpTable

43− -> IParser (LExpr t v)

23+binops :: IParser (LExpr t v)

44 -> IParser (LExpr t v)

24 -> IParser (LExpr t v)

45 -> IParser String

25 -> IParser String

46 -> IParser (LExpr t v)

26 -> IParser (LExpr t v)

47−binops table term last anyOp =

27+binops term last anyOp =

48 do e <- term

28 do e <- term

29+ table <- getState

49− split (table ++ preludeTable) 0 e =<< nextOps

30+ split table 0 e =<< nextOps

50 where

31 where

51 nextOps = choice [ commitIf (whitespace >> anyOp) $ do

32 nextOps = choice [ commitIf (whitespace >> anyOp) $ do

52 whitespace ; op <- anyOp ; whitespace

33 whitespace ; op <- anyOp ; whitespace

@@ -101,13 +82,3 @@ getAssoc table n eops

101 concat [ "Conflicting " ++ problem ++ " for binary operators ("

82 concat [ "Conflicting " ++ problem ++ " for binary operators ("

102 , intercalate ", " (map fst eops), "). "

83 , intercalate ", " (map fst eops), "). "

103 , "Consider adding parentheses to disambiguate." ]

84 , "Consider adding parentheses to disambiguate." ]

104−

105−infixStmt :: IParser (Int, Assoc, String)

106−infixStmt =

107− let infx str assoc = try (reserved ("infix" ++ str) >> return assoc) in

108− do assoc <- choice [ infx "l" L, infx "r" R, infx "" N ]

109− whitespace

110− prec <- do n <- digit ; return (read [n] :: Int)

111− whitespace

112− op <- anyOp

113− return (prec, assoc, op)

compiler/Parse/Declaration.hs+7−21

@@ -3,6 +3,7 @@ module Parse.Declaration where

3

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

5import qualified Data.List as List

6+import qualified Data.Set as Set

6import Text.Parsec hiding (newline,spaces)

7import Text.Parsec hiding (newline,spaces)

7import Text.Parsec.Indent

8import Text.Parsec.Indent

8import qualified Text.Pandoc as Pan

9import qualified Text.Pandoc as Pan

@@ -13,7 +14,6 @@ import qualified SourceSyntax.Type as T

13import qualified Parse.Type as Type

14import qualified Parse.Type as Type

14import SourceSyntax.Declaration (Declaration(..), Assoc(..))

15import SourceSyntax.Declaration (Declaration(..), Assoc(..))

15

16

16−import Unique

17

18declaration :: IParser (Declaration t v)

19declaration = alias <|> datatype <|> infixDecl <|> foreignDef <|> definition

@@ -71,8 +71,8 @@ exportEvent = do

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

72 case isExportable t of

73 Nothing -> return (ExportEvent eventName elmVar tipe)

74− Just err -> error err

74+ Just err -> fail err

75− _ -> error "When importing foreign events, the imported value must have type Signal."

75+ _ -> fail "When importing foreign events, the imported value must have type Signal."

76

77importEvent :: IParser (Declaration t v)

78importEvent = do

@@ -88,30 +88,16 @@ importEvent = do

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

89 case isExportable t of

90 Nothing -> return (ImportEvent eventName baseValue elmVar tipe)

91− Just err -> error err

91+ Just err -> fail err

92− _ -> error "When importing foreign events, the imported value must have type Signal."

92+ _ -> fail "When importing foreign events, the imported value must have type Signal."

93

94jsVar :: IParser String

95jsVar = betwixt '"' '"' $ do

96 v <- (:) <$> (letter <|> char '_') <*> many (alphaNum <|> char '_')

97− if v `notElem` jsReserveds then return v else

97+ if Set.notMember v jsReserveds then return v else

98− error $ "'" ++ v ++

98+ fail $ "'" ++ v ++

99 "' is not a good name for a importing or exporting JS values."

100

101−jsReserveds :: [String]

102−jsReserveds =

103− [ "null", "undefined", "Nan", "Infinity", "true", "false", "eval"

104− , "arguments", "int", "byte", "char", "goto", "long", "final", "float"

105− , "short", "double", "native", "throws", "boolean", "abstract", "volatile"

106− , "transient", "synchronized", "function", "break", "case", "catch"

107− , "continue", "debugger", "default", "delete", "do", "else", "finally"

108− , "for", "function", "if", "in", "instanceof", "new", "return", "switch"

109− , "this", "throw", "try", "typeof", "var", "void", "while", "with", "class"

110− , "const", "enum", "export", "extends", "import", "super", "implements"

111− , "interface", "let", "package", "private", "protected", "public"

112− , "static", "yield"

113− ]

114−

115isExportable tipe =

101isExportable tipe =

116 case tipe of

102 case tipe of

117 T.Lambda _ _ ->

103 T.Lambda _ _ ->

compiler/Parse/Expression.hs+45−44

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

1−module Parse.Expression (def,term) where

1+module Parse.Expression (def,term,typeAnnotation) where

2

3+import Control.Arrow ((***))

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

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

4import Data.List (foldl')

5import Data.List (foldl')

5import Text.Parsec hiding (newline,spaces)

6import Text.Parsec hiding (newline,spaces)

@@ -18,8 +19,6 @@ import qualified SourceSyntax.Literal as Literal

18import SourceSyntax.Expression

19import SourceSyntax.Expression

19import SourceSyntax.Declaration (Declaration(Definition))

20import SourceSyntax.Declaration (Declaration(Definition))

20

21

21−import Unique

22−

23

22

24-------- Basic Terms --------

23-------- Basic Terms --------

25

24

@@ -33,17 +32,14 @@ toVar v = case v of "True" -> Literal (Literal.Boolean True)

33

32

34accessor :: IParser (Expr t v)

33accessor :: IParser (Expr t v)

35accessor = do

34accessor = do

36− start <- getPosition

37− lbl <- try (string "." >> rLabel)

35+ (start, lbl, end) <- located (try (string "." >> rLabel))

38− end <- getPosition

39 let loc e = Location.at start end e

36 let loc e = Location.at start end e

40 return (Lambda (PVar "_") (loc $ Access (loc $ Var "_") lbl))

37 return (Lambda (PVar "_") (loc $ Access (loc $ Var "_") lbl))

41

38

42negative :: IParser (Expr t v)

39negative :: IParser (Expr t v)

43negative = do

40negative = do

44− start <- getPosition

41+ (start, nTerm, end) <-

45− nTerm <- try (char '-' >> notFollowedBy (char '.' <|> char '-')) >> term

42+ located (try (char '-' >> notFollowedBy (char '.' <|> char '-')) >> term)

46− end <- getPosition

47 let loc e = Location.at start end e

43 let loc e = Location.at start end e

48 return (Binop "-" (loc $ Literal (Literal.IntNum 0)) nTerm)

44 return (Binop "-" (loc $ Literal (Literal.IntNum 0)) nTerm)

49

45

@@ -51,43 +47,51 @@ negative = do

51-------- Complex Terms --------

47-------- Complex Terms --------

52

48

53listTerm :: IParser (Expr t v)

49listTerm :: IParser (Expr t v)

54−listTerm =

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

55− (do { try $ string "[markdown|"

51+ where

56− ; md <- filter (/='\r') <$> manyTill anyChar (try $ string "|]")

52+ range = do

53+ lo <- expr

54+ whitespace >> string ".." >> whitespace

55+ Range lo <$> expr

56+

57+ markdown' = do

58+ (rawText, exprs) <- markdown interpolation

59+ let md = Pan.readMarkdown Pan.def (filter (/='\r') rawText)

57− ; return . Markdown $ Pan.readMarkdown Pan.def md })

60+ return (Markdown md exprs)

58− <|> (braces $ choice

61+

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

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

64+

65+ interpolation md exprs = do

66+ try (string "{{")

67+ whitespace

68+ e <- expr

59− [ try $ do { lo <- expr; whitespace; string ".." ; whitespace

69+ whitespace

60− ; Range lo <$> expr }

70+ string "}}"

61− , ExplicitList <$> commaSep expr

71+ return (md ++ span exprs, exprs ++ [e])

62− ])

63

72

64parensTerm :: IParser (LExpr t v)

73parensTerm :: IParser (LExpr t v)

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

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

66 where

75 where

67 opFn = do

76 opFn = do

68− start <- getPosition

77+ (start, op, end) <- located anyOp

69− op <- anyOp

70− end <- getPosition

71 let loc = Location.at start end

78 let loc = Location.at start end

72 return . loc . Lambda (PVar "x") . loc . Lambda (PVar "y") . loc $

79 return . loc . Lambda (PVar "x") . loc . Lambda (PVar "y") . loc $

73 Binop op (loc $ Var "x") (loc $ Var "y")

80 Binop op (loc $ Var "x") (loc $ Var "y")

74

81

75 tupleFn = do

82 tupleFn = do

76− start <- getPosition

77 let comma = char ',' <?> "comma ','"

83 let comma = char ',' <?> "comma ','"

78− commas <- comma >> many (whitespace >> comma)

84+ (start, commas, end) <- located (comma >> many (whitespace >> comma))

79− end <- getPosition

80 let vars = map (('v':) . show) [ 0 .. length commas + 1 ]

85 let vars = map (('v':) . show) [ 0 .. length commas + 1 ]

81 loc = Location.at start end

86 loc = Location.at start end

82 return $ foldr (\x e -> loc $ Lambda x e)

87 return $ foldr (\x e -> loc $ Lambda x e)

83 (loc . tuple $ map (loc . Var) vars) (map PVar vars)

88 (loc . tuple $ map (loc . Var) vars) (map PVar vars)

84

89

85 parened = do

90 parened = do

86− start <- getPosition

87− es <- commaSep expr

91+ (start, es, end) <- located (commaSep expr)

88− end <- getPosition

89− return $ case es of [e] -> e

92+ return $ case es of

93+ [e] -> e

90− _ -> Location.at start end (tuple es)

94+ _ -> Location.at start end (tuple es)

91

95

92recordTerm :: IParser (LExpr t v)

96recordTerm :: IParser (LExpr t v)

93recordTerm = brackets $ choice [ misc, addLocation record ]

97recordTerm = brackets $ choice [ misc, addLocation record ]

@@ -144,7 +148,7 @@ appExpr = do

144-------- Normal Expressions --------

148-------- Normal Expressions --------

145

149

146binaryExpr :: IParser (LExpr t v)

150binaryExpr :: IParser (LExpr t v)

147−binaryExpr = binops [] appExpr lastExpr anyOp

151+binaryExpr = binops appExpr lastExpr anyOp

148 where lastExpr = addLocation (choice [ ifExpr, letExpr, caseExpr ])

152 where lastExpr = addLocation (choice [ ifExpr, letExpr, caseExpr ])

149 <|> lambdaExpr

153 <|> lambdaExpr

150

154

@@ -196,7 +200,8 @@ expr = addLocation (choice [ ifExpr, letExpr, caseExpr ])

196 <|> binaryExpr

200 <|> binaryExpr

197 <?> "an expression"

201 <?> "an expression"

198

202

199−funcDef =

203+defStart :: IParser [Pattern]

204+defStart =

200 choice [ do p1 <- try Pattern.term

205 choice [ do p1 <- try Pattern.term

201 infics p1 <|> func p1

206 infics p1 <|> func p1

202 , func =<< (PVar <$> parens symOp)

207 , func =<< (PVar <$> parens symOp)

@@ -219,24 +224,20 @@ makeFunction :: [Pattern] -> LExpr t v -> LExpr t v

219makeFunction args body@(L s _) =

224makeFunction args body@(L s _) =

220 foldr (\arg body' -> L s $ Lambda arg body') body args

225 foldr (\arg body' -> L s $ Lambda arg body') body args

221

226

222−assignExpr :: IParser (Def t v)

227+definition :: IParser (Def t v)

223−assignExpr = withPos $ do

228+definition = withPos $ do

224− (name:args) <- funcDef

229+ (name:args) <- defStart

225 whitespace >> string "=" >> whitespace

230 whitespace >> string "=" >> whitespace

226 body <- expr

231 body <- expr

227 return . Def name $ makeFunction args body

232 return . Def name $ makeFunction args body

228

233

229typeAnnotation :: IParser (Def t v)

234typeAnnotation :: IParser (Def t v)

230typeAnnotation = TypeAnnotation <$> try start <*> Type.expr

235typeAnnotation = TypeAnnotation <$> try start <*> Type.expr

231− where

236+ where

237+ start = do

232− start = do v <- lowVar <|> parens symOp

238+ v <- lowVar <|> parens symOp

233− whitespace ; hasType ; whitespace

239+ whitespace ; hasType ; whitespace

234− return v

240+ return v

235

241

236def :: IParser (Def t v)

242def :: IParser (Def t v)

237−def = typeAnnotation <|> assignExpr

243+def = typeAnnotation <|> definition

238−

239−attempt f parser str =

240− case iParse parser "" str of

241− Right result -> f result

242− Left err -> error $ "Parse error at " ++ show err

compiler/Parse/Helpers.hs+102−19

@@ -1,12 +1,17 @@

1module Parse.Helpers where

2

3+import Prelude hiding (until)

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

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

4import Control.Monad

5import Control.Monad

5import Control.Monad.State

6import Control.Monad.State

6import Data.Char (isUpper)

7import Data.Char (isUpper)

8+import qualified Data.Set as Set

9+import qualified Data.Map as Map

7import SourceSyntax.Helpers as Help

10import SourceSyntax.Helpers as Help

8import SourceSyntax.Location as Location

11import SourceSyntax.Location as Location

9import SourceSyntax.Expression

12import SourceSyntax.Expression

13+import SourceSyntax.PrettyPrint

14+import SourceSyntax.Declaration (Assoc)

10import Text.Parsec hiding (newline,spaces,State)

15import Text.Parsec hiding (newline,spaces,State)

11import Text.Parsec.Indent

16import Text.Parsec.Indent

12

17

@@ -18,13 +23,31 @@ reserveds = [ "if", "then", "else"

18 , "import", "as", "hiding", "open"

23 , "import", "as", "hiding", "open"

19 , "export", "foreign" ]

24 , "export", "foreign" ]

20

25

26+jsReserveds :: Set.Set String

27+jsReserveds = Set.fromList

28+ [ "null", "undefined", "Nan", "Infinity", "true", "false", "eval"

29+ , "arguments", "int", "byte", "char", "goto", "long", "final", "float"

30+ , "short", "double", "native", "throws", "boolean", "abstract", "volatile"

31+ , "transient", "synchronized", "function", "break", "case", "catch"

32+ , "continue", "debugger", "default", "delete", "do", "else", "finally"

33+ , "for", "function", "if", "in", "instanceof", "new", "return", "switch"

34+ , "this", "throw", "try", "typeof", "var", "void", "while", "with", "class"

35+ , "const", "enum", "export", "extends", "import", "super", "implements"

36+ , "interface", "let", "package", "private", "protected", "public"

37+ , "static", "yield"

38+ ]

39+

21expecting = flip (<?>)

40expecting = flip (<?>)

22

41

42+type OpTable = Map.Map String (Int, Assoc)

23−type IParser a = ParsecT String () (State SourcePos) a

43+type IParser a = ParsecT String OpTable (State SourcePos) a

44+

45+iParse :: IParser a -> String -> Either ParseError a

46+iParse = iParseWithTable "" Map.empty

24

47

25−iParse :: IParser a -> SourceName -> String -> Either ParseError a

48+iParseWithTable :: SourceName -> OpTable -> IParser a -> String -> Either ParseError a

26−iParse aParser source_name input =

49+iParseWithTable sourceName table aParser input =

27− runIndent source_name $ runParserT aParser () source_name input

50+ runIndent sourceName $ runParserT aParser table sourceName input

28

51

29backslashed :: IParser Char

52backslashed :: IParser Char

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

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

@@ -49,13 +72,10 @@ rLabel = lowVar

49innerVarChar :: IParser Char

72innerVarChar :: IParser Char

50innerVarChar = alphaNum <|> char '_' <|> char '\'' <?> ""

73innerVarChar = alphaNum <|> char '_' <|> char '\'' <?> ""

51

74

52−deprime :: String -> String

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

54−

55makeVar :: IParser Char -> IParser String

75makeVar :: IParser Char -> IParser String

56makeVar p = do v <- (:) <$> p <*> many innerVarChar

76makeVar p = do v <- (:) <$> p <*> many innerVarChar

57 guard (v `notElem` reserveds)

77 guard (v `notElem` reserveds)

58− return (deprime v)

78+ return v

59

79

60reserved :: String -> IParser String

80reserved :: String -> IParser String

61reserved word =

81reserved word =

@@ -147,12 +167,17 @@ parens = surround '(' ')' "paren"

147brackets :: IParser a -> IParser a

167brackets :: IParser a -> IParser a

148brackets = surround '{' '}' "bracket"

168brackets = surround '{' '}' "bracket"

149

169

150−addLocation :: IParser (Expr t v) -> IParser (LExpr t v)

170+addLocation :: (Pretty a) => IParser a -> IParser (Location.Located a)

151addLocation expr = do

171addLocation expr = do

172+ (start, e, end) <- located expr

173+ return (Location.at start end e)

174+

175+located :: IParser a -> IParser (SourcePos, a, SourcePos)

176+located p = do

152 start <- getPosition

177 start <- getPosition

153− e <- expr

178+ e <- p

154 end <- getPosition

179 end <- getPosition

155− return (Location.at start end e)

180+ return (start, e, end)

156

181

157accessible :: IParser (LExpr t v) -> IParser (LExpr t v)

182accessible :: IParser (LExpr t v) -> IParser (LExpr t v)

158accessible expr = do

183accessible expr = do

@@ -200,16 +225,74 @@ simpleNewline = try (string "\r\n") <|> string "\n"

200lineComment :: IParser String

225lineComment :: IParser String

201lineComment = do

226lineComment = do

202 try (string "--")

227 try (string "--")

203− comment <- manyTill anyChar $ simpleNewline <|> (eof >> return "\n")

228+ comment <- anyUntil $ simpleNewline <|> (eof >> return "\n")

204 return ("--" ++ comment)

229 return ("--" ++ comment)

205

230

206multiComment :: IParser String

231multiComment :: IParser String

207−multiComment = do { try (string "{-"); closeComment }

232+multiComment = (++) <$> try (string "{-") <*> closeComment

208

233

209closeComment :: IParser String

234closeComment :: IParser String

210−closeComment = do

235+closeComment =

211− comment <- manyTill anyChar . choice $

236+ anyUntil . choice $

212− [ try (string "-}") <?> "close comment"

237+ [ try (string "-}") <?> "close comment"

213− , do { try $ string "{-"; closeComment; closeComment }

238+ , concat <$> sequence [ try (string "{-"), closeComment, closeComment ]

214− ]

239+ ]

215− return ("{-" ++ comment ++ "-}")

240+

241+until :: IParser a -> IParser b -> IParser b

242+until p end = go

243+ where

244+ go = end <|> (p >> go)

245+

246+anyUntil :: IParser String -> IParser String

247+anyUntil end = go

248+ where

249+ go = end <|> (:) <$> anyChar <*> go

250+

251+ignoreUntil :: IParser a -> IParser (Maybe a)

252+ignoreUntil end = go

253+ where

254+ ignore p = const () <$> p

255+ filler = choice [ ignore multiComment

256+ , ignore (markdown (\_ _ -> mzero))

257+ , ignore anyChar

258+ ]

259+ go = choice [ Just <$> end

260+ , filler `until` choice [ const Nothing <$> eof, newline >> go ]

261+ ]

262+

263+onFreshLines :: (a -> b -> b) -> b -> IParser a -> IParser b

264+onFreshLines insert init thing = go init

265+ where

266+ go values = do

267+ optionValue <- ignoreUntil thing

268+ case optionValue of

269+ Nothing -> return values

270+ Just v -> go (insert v values)

271+

272+withSource :: IParser a -> IParser (String, a)

273+withSource p = do

274+ start <- getParserState

275+ result <- p

276+ endPos <- getPosition

277+ setParserState start

278+ raw <- anyUntilPos endPos

279+ return (raw, result)

280+

281+anyUntilPos :: SourcePos -> IParser String

282+anyUntilPos pos = go

283+ where

284+ go = do currentPos <- getPosition

285+ case currentPos == pos of

286+ True -> return []

287+ False -> (:) <$> anyChar <*> go

288+

289+markdown :: (String -> [a] -> IParser (String, [a])) -> IParser (String, [a])

290+markdown interpolation = try (string "[markdown|") >> closeMarkdown "" []

291+ where

292+ closeMarkdown md stuff =

293+ choice [ do try (string "|]")

294+ return (md, stuff)

295+ , uncurry closeMarkdown =<< interpolation md stuff

296+ , do c <- anyChar

297+ closeMarkdown (md ++ [c]) stuff

298+ ]

compiler/Parse/Literal.hs+4−1

@@ -14,10 +14,13 @@ num :: IParser Literal

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

15 where toLit n | '.' `elem` n = FloatNum (read n)

16 | otherwise = IntNum (read n)

17− preNum = (++) <$> many1 digit <*> option "" postNum

17+ preNum = concat <$> sequence [ option "" minus, many1 digit, option "" postNum ]

18 postNum = do try $ lookAhead (string "." >> digit)

19 string "."

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

21+ minus = try $ do string "-"

22+ lookAhead digit

23+ return "-"

21

24

22chr :: IParser Literal

25chr :: IParser Literal

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

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

compiler/Parse/Module.hs+1−1

@@ -13,7 +13,7 @@ varList = parens $ commaSep1 (var <|> parens symOp)

13

14getModuleName :: String -> Maybe String

15getModuleName source =

16− case iParse getModuleName "" source of

16+ case iParse getModuleName source of

17 Right name -> Just name

18 Left _ -> Nothing

19 where

compiler/Parse/Parse.hs+27−4

@@ -4,13 +4,16 @@ import Control.Applicative ((<$>), (<*>))

4import Control.Monad

5import Data.Char (isSymbol, isDigit)

6import Data.List (foldl',intercalate)

7+import qualified Data.Map as Map

7import Text.Parsec hiding (newline,spaces)

8import Text.Parsec hiding (newline,spaces)

8import qualified Text.PrettyPrint as P

9import qualified Text.PrettyPrint as P

9

10

10import qualified SourceSyntax.Module as S

11import qualified SourceSyntax.Module as S

12+import SourceSyntax.Declaration (Declaration(Fixity))

11import Parse.Helpers

13import Parse.Helpers

12−import Parse.Binop (infixStmt, OpTable)

14+import Parse.Binop (OpTable)

13import Parse.Expression

15import Parse.Expression

16+import Parse.Declaration (infixDecl)

14import Parse.Type

17import Parse.Type

15import Parse.Module

18import Parse.Module

16import qualified Parse.Declaration as Decl

19import qualified Parse.Declaration as Decl

@@ -22,8 +25,8 @@ freshDef = commitIf (freshLine >> (letter <|> char '_')) $ do

22decls = do d <- Decl.declaration <?> "at least one datatype or variable definition"

25decls = do d <- Decl.declaration <?> "at least one datatype or variable definition"

23 (d:) <$> many freshDef

26 (d:) <$> many freshDef

24

27

25−program :: String -> Either [P.Doc] (S.Module t v)

28+program :: OpTable -> String -> Either [P.Doc] (S.Module t v)

26−program = setupParser $ do

29+program table = setupParserWithTable table $ do

27 optional freshLine

30 optional freshLine

28 (names,exports) <- option (["Main"],[]) (moduleDef `followedBy` freshLine)

31 (names,exports) <- option (["Main"],[]) (moduleDef `followedBy` freshLine)

29 is <- (do try (lookAhead $ reserved "import")

32 is <- (do try (lookAhead $ reserved "import")

@@ -40,8 +43,28 @@ dependencies =

40 (,) <$> option "Main" (getName <$> moduleDef `followedBy` freshLine)

43 (,) <$> option "Main" (getName <$> moduleDef `followedBy` freshLine)

41 <*> option [] (map fst <$> imports `followedBy` freshLine)

44 <*> option [] (map fst <$> imports `followedBy` freshLine)

42

45

46+setupParserWithTable :: OpTable -> IParser a -> String -> Either [P.Doc] a

47+setupParserWithTable table p source =

48+ do localTable <- setupParser parseFixities source

49+ case Map.intersection table localTable of

50+ overlap | not (Map.null overlap) -> Left [ msg overlap ]

51+ | otherwise ->

52+ flip setupParser source $ do

53+ putState (Map.union table localTable)

54+ p

55+ where

56+ msg overlap =

57+ P.vcat [ P.text "Parse error:"

58+ , P.text $ "Overlapping definitions for infix operators: " ++

59+ intercalate " " (Map.keys overlap)

60+ ]

61+

62+parseFixities = do

63+ decls <- onFreshLines (:) [] infixDecl

64+ return $ Map.fromList [ (op,(lvl,assoc)) | Fixity assoc lvl op <- decls ]

65+

43setupParser :: IParser a -> String -> Either [P.Doc] a

66setupParser :: IParser a -> String -> Either [P.Doc] a

44setupParser p source =

67setupParser p source =

45− case iParse p "" source of

68+ case iParse p source of

46 Right result -> Right result

69 Right result -> Right result

47 Left err -> Left [ P.text $ "Parse error at " ++ show err ]

70 Left err -> Left [ P.text $ "Parse error at " ++ show err ]

compiler/Parse/Pattern.hs+1−6

@@ -6,7 +6,6 @@ import Control.Monad

6import Control.Monad.State

7import Data.Char (isUpper)

8import Data.List (intercalate)

9−import Unique

10import Text.Parsec hiding (newline,spaces,State)

9import Text.Parsec hiding (newline,spaces,State)

11import Text.Parsec.Indent

10import Text.Parsec.Indent

12

11

@@ -24,11 +23,7 @@ basic = choice

24 "True" -> PLiteral (Boolean True)

23 "True" -> PLiteral (Boolean True)

25 "False" -> PLiteral (Boolean False)

24 "False" -> PLiteral (Boolean False)

26 c : _ -> if isUpper c then PData v [] else PVar v

25 c : _ -> if isUpper c then PData v [] else PVar v

27− , do lit <- literal

26+ , PLiteral <$> literal

28− return $ case lit of

29− Str s -> foldr combine (PData "[]" []) s

30− where combine h t = PData "::" [PLiteral (Chr h),t]

31− _ -> PLiteral lit

32 ]

27 ]

33

28

34asPattern :: Pattern -> IParser Pattern

29asPattern :: Pattern -> IParser Pattern

compiler/Parse/Type.hs+3−12

@@ -9,7 +9,6 @@ import Text.Parsec.Indent

9

10import SourceSyntax.Type as T

11import Parse.Helpers

12−import Unique

13

12

14tvar :: IParser T.Type

13tvar :: IParser T.Type

15tvar = T.Var <$> lowVar <?> "type variable"

14tvar = T.Var <$> lowVar <?> "type variable"

@@ -35,7 +34,7 @@ record =

35 t <- tvar

34 t <- tvar

36 whitespace >> string "|" >> whitespace

35 whitespace >> string "|" >> whitespace

37 return t

36 return t

38− fields = commaSep $ do

37+ fields = commaSep1 $ do

39 lbl <- rLabel

38 lbl <- rLabel

40 whitespace >> hasType >> whitespace

39 whitespace >> hasType >> whitespace

41 (,) lbl <$> expr

40 (,) lbl <$> expr

@@ -63,19 +62,11 @@ app =

63expr :: IParser T.Type

62expr :: IParser T.Type

64expr =

63expr =

65 do t1 <- app <|> term

64 do t1 <- app <|> term

66− whitespace

67− arr <- optionMaybe (try arrow)

65+ arr <- optionMaybe $ try (whitespace >> arrow)

68− whitespace

69 case arr of

66 case arr of

70− Just _ -> T.Lambda t1 <$> expr

67+ Just _ -> T.Lambda t1 <$> (whitespace >> expr)

71 Nothing -> return t1

68 Nothing -> return t1

72

69

73constructor :: IParser (String, [T.Type])

70constructor :: IParser (String, [T.Type])

74constructor = (,) <$> (capTypeVar <?> "another type constructor")

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

75 <*> spacePrefix term

72 <*> spacePrefix term

76−

77−readType :: String -> Type

78−readType str =

79− case iParse expr "" str of

80− Left err -> error (show err)

81− Right tipe -> tipe

compiler/SourceSyntax/Declaration.hs+8−1

@@ -15,4 +15,11 @@ data Declaration tipe var

15 deriving (Eq, Show)

16

17data Assoc = L | N | R

18− deriving (Eq, Show)

18+ deriving (Eq)

19+

20+instance Show Assoc where

21+ show assoc =

22+ case assoc of

23+ L -> "left"

24+ N -> "non"

25+ R -> "right"

compiler/SourceSyntax/Expression.hs+4−2

@@ -30,7 +30,7 @@ data Expr t v

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

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

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

33− | Markdown Pandoc.Pandoc

33+ | Markdown Pandoc.Pandoc [LExpr t v]

34 deriving (Eq, Show, Data, Typeable)

35

36data Def tipe var

@@ -55,6 +55,8 @@ instance Pretty (Expr t v) where

55 Var x -> variable x

56 Range e1 e2 -> P.brackets (pretty e1 <> P.text ".." <> pretty e2)

57 ExplicitList es -> P.brackets (commaCat (map pretty es))

58+ Binop "-" (Location.L _ (Literal (Literal.IntNum 0))) e ->

59+ P.text "-" <> prettyParens e

58 Binop op e1 e2 -> P.sep [ prettyParens e1 <+> P.text op', prettyParens e2 ]

60 Binop op e1 e2 -> P.sep [ prettyParens e1 <+> P.text op', prettyParens e2 ]

59 where op' = if Help.isOp op then op else "`" ++ op ++ "`"

61 where op' = if Help.isOp op then op else "`" ++ op ++ "`"

60 Lambda p e -> let (ps,body) = collectLambdas (Location.none $ Lambda p e)

62 Lambda p e -> let (ps,body) = collectLambdas (Location.none $ Lambda p e)

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

94 where

96 where

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

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

96

98

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

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

98

100

99instance Pretty (Def t v) where

101instance Pretty (Def t v) where

100 pretty def =

102 pretty def =

compiler/SourceSyntax/Literal.hs+2−2

@@ -6,7 +6,7 @@ import SourceSyntax.PrettyPrint

6import qualified Text.PrettyPrint as PP

7

8data Literal = IntNum Int

9− | FloatNum Float

9+ | FloatNum Double

10 | Chr Char

11 | Str String

12 | Boolean Bool

@@ -16,7 +16,7 @@ instance Pretty Literal where

16 pretty literal =

17 case literal of

18 IntNum n -> PP.int n

19− FloatNum n -> PP.float n

19+ FloatNum n -> PP.double n

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

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

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

compiler/SourceSyntax/Module.hs+17−5

@@ -41,11 +41,23 @@ type Interfaces = Map.Map String ModuleInterface

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

42

43data ModuleInterface = ModuleInterface {

44− iTypes :: Map.Map String Type,

44+ iTypes :: Map.Map String Type,

45− iAdts :: [ADT],

45+ iAdts :: [ADT],

46− iAliases :: [(String, [String], Type)]

46+ iAliases :: [(String, [String], Type)],

47+ iFixities :: [(Assoc, Int, String)]

47} deriving Show

48} deriving Show

48

49

49instance Binary ModuleInterface where

50instance Binary ModuleInterface where

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

52+ put modul = do

53+ put (iTypes modul)

54+ put (iAdts modul)

50− put modul = put (iTypes modul) >> put (iAdts modul) >> put (iAliases modul)

55+ put (iAliases modul)

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

56+ put (iFixities modul)

57+

58+

59+instance Binary Assoc where

60+ get = do n <- getWord8

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

62+

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

compiler/Transform/Canonicalize.hs+17−7

@@ -18,10 +18,11 @@ import Text.PrettyPrint as P

18

19interface :: String -> ModuleInterface -> ModuleInterface

20interface moduleName iface =

21− ModuleInterface {

21+ ModuleInterface

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

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

23− iAdts = map (both prefix renameCtors) (iAdts iface),

23+ , iAdts = map (both prefix renameCtors) (iAdts iface)

24− iAliases = map (both prefix renameType') (iAliases iface)

24+ , iAliases = map (both prefix renameType') (iAliases iface)

25+ , iFixities = iFixities iface -- cannot have canonicalized operators while parsing

25 }

26 }

26 where

27 where

27 both f g (a,b,c) = (f a, b, g c)

28 both f g (a,b,c) = (f a, b, g c)

@@ -56,10 +57,19 @@ metadataModule ifaces modul =

56 program' <- rename initialEnv (program modul)

57 program' <- rename initialEnv (program modul)

57 aliases' <- mapM (third renameType') (aliases modul)

58 aliases' <- mapM (third renameType') (aliases modul)

58 datatypes' <- mapM (third (mapM (second (mapM renameType')))) (datatypes modul)

59 datatypes' <- mapM (third (mapM (second (mapM renameType')))) (datatypes modul)

60+ exports' <- mapM (third renameType') (foreignExports modul)

61+ imports' <- mapM (twoAndFour (rename initialEnv) renameType') (foreignImports modul)

59− return $ modul { program = program', aliases = aliases', datatypes = datatypes' }

62+ return $ modul { program = program'

63+ , aliases = aliases'

64+ , datatypes = datatypes'

65+ , foreignExports = exports'

66+ , foreignImports = imports' }

60 where

67 where

61 second f (a,b) = (,) a `fmap` f b

68 second f (a,b) = (,) a `fmap` f b

62 third f (a,b,c) = (,,) a b `fmap` f c

69 third f (a,b,c) = (,,) a b `fmap` f c

70+ twoAndFour f g (a,b,c,d) = do b' <- f b

71+ d' <- g d

72+ return (a,b',c,d')

63 renameType' =

73 renameType' =

64 Either.either (\err -> Left [P.text err]) return . renameType (replace "type" initialEnv)

74 Either.either (\err -> Left [P.text err]) return . renameType (replace "type" initialEnv)

65

75

@@ -79,7 +89,7 @@ metadataModule ifaces modul =

79

89

80 pair n = (n,n)

90 pair n = (n,n)

81 localEnv = map pair (map get1 (aliases modul) ++ map get1 (datatypes modul))

91 localEnv = map pair (map get1 (aliases modul) ++ map get1 (datatypes modul))

82− globalEnv = map pair $ ["_List",saveEnvName,"::","[]","Int","Float","Char","Bool"] ++

92+ globalEnv = map pair $ ["_List",saveEnvName,"::","[]","Int","Float","Char","Bool","String"] ++

83 map (\n -> "_Tuple" ++ show n) [0..9]

93 map (\n -> "_Tuple" ++ show n) [0..9]

84 realImports = filter (not . List.isPrefixOf "Native." . fst) (imports modul)

94 realImports = filter (not . List.isPrefixOf "Native." . fst) (imports modul)

85 initialEnv = Map.fromList (concatMap canon realImports ++ localEnv ++ globalEnv)

95 initialEnv = Map.fromList (concatMap canon realImports ++ localEnv ++ globalEnv)

@@ -163,7 +173,7 @@ rename env lexpr@(L s expr) =

163 branch (pattern,e) = (,) `liftM` format (renamePattern env pattern)

173 branch (pattern,e) = (,) `liftM` format (renamePattern env pattern)

164 `ap` rename (extend env pattern) e

174 `ap` rename (extend env pattern) e

165

175

166− Markdown _ -> return expr

176+ Markdown md es -> Markdown md `liftM` mapM rnm es

167

177

168

178

169renamePattern :: Env -> Pattern -> Either String Pattern

179renamePattern :: Env -> Pattern -> Either String Pattern

compiler/Transform/LetBoundVars.hsdeleted−54

@@ -1,54 +0,0 @@

1−module LetBoundVars (letBoundVars) where

2−

3−import Context

4−import Ast

5−

6−class LetBoundVars a where

7− letBoundVars :: a -> [String]

8−

9−instance LetBoundVars a => LetBoundVars [a] where

10− letBoundVars = concatMap letBoundVars

11−

12−instance LetBoundVars Statement where

13− letBoundVars stmt =

14− case stmt of

15− Definition d -> letBoundVars d

16− Datatype _ _ tcs -> []

17− ImportEvent _ e _ _ -> letBoundVars e

18− ExportEvent _ _ _ -> []

19− TypeAnnotation _ _ -> []

20− TypeAlias _ _ _ -> []

21−

22−instance LetBoundVars Def where

23− letBoundVars (FnDef n _ e) = n : letBoundVars e

24− letBoundVars (OpDef _ _ _ e) = letBoundVars e

25− letBoundVars _ = []

26−

27−instance LetBoundVars e => LetBoundVars (Context e) where

28− letBoundVars (C _ _ e) = letBoundVars e

29−

30−instance LetBoundVars Expr where

31− letBoundVars expr =

32− let f = letBoundVars in

33− case expr of

34− IntNum _ -> []

35− FloatNum _ -> []

36− Chr _ -> []

37− Str _ -> []

38− Boolean _ -> []

39− Range e1 e2 -> f e1 ++ f e2

40− Access e _ -> []

41− Remove e _ -> []

42− Insert e1 _ e2 -> f e1 ++ f e2

43− Modify e ps -> f e ++ concatMap (f . snd) ps

44− Record trps -> concatMap (\(_,_,e) -> f e) trps

45− Binop op e1 e2 -> f e1 ++ f e2

46− Lambda x e -> f e

47− App e1 e2 -> f e1 ++ f e2

48− If e1 e2 e3 -> concatMap f [e1,e2,e3]

49− MultiIf ps -> concatMap (\(b,e) -> f b ++ f e) ps

50− Let defs e -> concatMap letBoundVars defs ++ f e

51− Var x -> []

52− Data name es -> concatMap f es

53− Case e cases -> f e ++ concatMap (f . snd) cases

54− Markdown _ -> []

compiler/Transform/Replace.hsdeleted−60

@@ -1,60 +0,0 @@

1−module Replace (replace, depth) where

2−

3−import Ast

4−import Control.Arrow ((***))

5−import Data.Set (singleton,empty,unions,member, Set)

6−

7−replace :: String -> Expr -> Expr -> Expr

8−replace y v expr =

9− let f = replace y v in

10− case expr of

11− Range e1 e2 -> Range (f e1) (f e2)

12− Access e x -> Access (f e) x

13− Binop op e1 e2 -> Binop op (f e1) (f e2)

14− App e1 e2 -> App (f e1) (f e2)

15− If e1 e2 e3 -> If (f e1) (f e2) (f e3)

16− Guard ps -> map (f *** f) ps

17− Lift e es -> Lift (f e) (map f es)

18− Fold e1 e2 e3 -> Fold (f e1) (f e2) (f e3)

19− Async e -> Async (f e)

20− Let defs e -> if y `elem` vs then Let defs e else Let (zip vs (map f es)) (f e)

21− where (vs,es) = unzip defs

22− Var x -> if x == y then v else Var x

23− ExplicitList es -> ExplicitList (map f es)

24− Data name es -> Data name (map f es)

25− Case e cases -> Case (f e) $ map (caseReplace y v) cases

26− _ -> expr

27−

28−caseReplace :: String -> Expr -> (Pattern, Expr) -> (Pattern, Expr)

29−caseReplace y v (p,e) =

30− if member y (patternVars p) then (p,e) else (p, replace y v e)

31−

32−patternVars :: Pattern -> Set String

33−patternVars pattern =

34− case pattern of

35− PData _ ps -> unions (map patternVars ps)

36− PVar x -> singleton x

37− PAsVar x p -> insert x (patternVars p)

38− PAnything -> empty

39− PLiteral _ -> empty

40−

41−depth :: Expr -> Integer

42−depth = depth' 0

43−depth' d expr =

44− let f = depth' (d+1) in

45− case expr of

46− Range e1 e2 -> max (f e1) (f e2)

47− Access e x -> f e

48− Binop op e1 e2 -> max (f e1) (f e2)

49− Lambda x e -> f e

50− App e1 e2 -> max (f e1) (f e2)

51− If e1 e2 e3 -> maximum [f e1, f e2, f e3]

52− Guard ps -> maximum (map (uncurry max . f *** f) ps)

53− Lift e es -> maximum $ f e : map f es

54− Fold e1 e2 e3 -> maximum [f e1, f e2, f e3]

55− Async e -> f e

56− Let defs e -> let (_,es) = unzip defs in maximum $ f e : map f es

57− Data "::" es -> maximum $ map (depth' d) es

58− Data name es -> maximum $ 1 : map f es

59− Case e cases -> maximum $ f e : map (f . snd) cases

60− _ -> d

compiler/Transform/SortDefinitions.hs+1−1

@@ -97,7 +97,7 @@ reorder lexpr@(L s expr) =

97 Record fields ->

98 Record `liftM` mapM reorderField fields

99

100− Markdown _ -> return expr

100+ Markdown md es -> Markdown md <$> mapM reorder es

101

102 -- Actually do some reordering

103 Let defs body ->

compiler/Transform/Substitute.hs+19−6

@@ -1,9 +1,11 @@

1{-# OPTIONS_GHC -Wall #-}

2module Transform.Substitute (subst) where

3

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

4import SourceSyntax.Expression

5import SourceSyntax.Expression

5import SourceSyntax.Location

6import SourceSyntax.Location

6−import Control.Arrow (second, (***))

7+import qualified Data.Set as Set

8+import qualified Transform.SortDefinitions as SD

7

9

8subst :: String -> Expr t v -> Expr t v -> Expr t v

10subst :: String -> Expr t v -> Expr t v -> Expr t v

9subst old new expr =

11subst old new expr =

@@ -12,12 +14,23 @@ subst old new expr =

12 Range e1 e2 -> Range (f e1) (f e2)

14 Range e1 e2 -> Range (f e1) (f e2)

13 ExplicitList es -> ExplicitList (map f es)

15 ExplicitList es -> ExplicitList (map f es)

14 Binop op e1 e2 -> Binop op (f e1) (f e2)

16 Binop op e1 e2 -> Binop op (f e1) (f e2)

15− Lambda p e -> Lambda p (f e)

17+ Lambda p e

18+ | Set.member old (SD.boundVars p) -> expr

19+ | otherwise -> Lambda p (f e)

16 App e1 e2 -> App (f e1) (f e2)

20 App e1 e2 -> App (f e1) (f e2)

17 MultiIf ps -> MultiIf (map (f *** f) ps)

21 MultiIf ps -> MultiIf (map (f *** f) ps)

22+

23+ Let defs body

24+ | anyShadow -> expr

18− Let defs body -> Let (map substDef defs) (f body)

25+ | otherwise -> Let (map substDef defs) (f body)

19− where substDef (Def name e) = Def name (f e)

26+ where

27+ anyShadow =

28+ any (Set.member old . SD.boundVars) [ p | Def p _ <- defs ]

29+ substDef def =

30+ case def of

20− substDef anno@(TypeAnnotation _ _) = anno

31+ TypeAnnotation _ _ -> def

32+ Def p e -> Def p (f e)

33+

21 Var x -> if x == old then new else expr

34 Var x -> if x == old then new else expr

22 Case e cases -> Case (f e) $ map (second f) cases

35 Case e cases -> Case (f e) $ map (second f) cases

23 Data name es -> Data name (map f es)

36 Data name es -> Data name (map f es)

@@ -27,4 +40,4 @@ subst old new expr =

27 Modify r fs -> Modify (f r) (map (second f) fs)

40 Modify r fs -> Modify (f r) (map (second f) fs)

28 Record fs -> Record (map (second f) fs)

41 Record fs -> Record (map (second f) fs)

29 Literal _ -> expr

42 Literal _ -> expr

30− Markdown _ -> expr

43+ Markdown md es -> Markdown md (map f es)

compiler/Type/Alias.hs+20−4

@@ -56,14 +56,16 @@ localizer metaModule = go

56realias :: Rules -> Type -> Type

57realias (aliases,localize) tipe = localize (canonicalRealias aliases tipe)

58

59+-- Realias using canonical aliases, so results will have aliases

60+-- that are fully qualified and possible to compare.

59canonicalRealias :: [(String,[String],Type)] -> Type -> Type

61canonicalRealias :: [(String,[String],Type)] -> Type -> Type

60canonicalRealias aliases tipe =

62canonicalRealias aliases tipe =

61 case concatMap tryRealias aliases of

63 case concatMap tryRealias aliases of

62− [tipe''] -> f tipe''

63− _ -> if tipe == tipe' then tipe else f tipe'

64+ [] -> if tipe == tipe' then tipe else f tipe'

65+ tipes -> f (bestType tipes)

64 where

66 where

65− tryRealias (name, args, t) =

67+ tryRealias (name, args, aliasTipe) =

66− case diff t tipe of

68+ case diff aliasTipe tipe of

67 Nothing -> []

69 Nothing -> []

68 Just kvs ->

70 Just kvs ->

69 let holes = collectFields kvs

71 let holes = collectFields kvs

@@ -85,6 +87,20 @@ canonicalRealias aliases tipe =

85allEqual [] = True

87allEqual [] = True

86allEqual (x:xs) = all (==x) xs

88allEqual (x:xs) = all (==x) xs

87

89

90+bestType tipes = fst $ List.minimumBy (\a b -> compare (snd a) (snd b)) pairs

91+ where

92+ pairs :: [(Type,Int)]

93+ pairs = zip tipes (map numFields tipes)

94+

95+ numFields :: Type -> Int

96+ numFields tipe =

97+ case tipe of

98+ Lambda t1 t2 -> numFields t1 + numFields t2

99+ Var _ -> 0

100+ Data _ ts -> sum (map numFields ts)

101+ EmptyRecord -> 0

102+ Record fields ext -> length fields + sum (map (numFields . snd) fields) + numFields ext

103+

88diff :: Type -> Type -> Maybe [(String,Type)]

104diff :: Type -> Type -> Maybe [(String,Type)]

89diff general specific =

105diff general specific =

90 case (general, specific) of

106 case (general, specific) of

compiler/Type/Constrain/Expression.hs+22−18

@@ -6,9 +6,10 @@ import qualified Data.Set as Set

6import Control.Arrow (second)

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

8import qualified Control.Monad as Monad

9−import Control.Monad.Error (ErrorT, runErrorT)

9+import Control.Monad.Error

10import Control.Monad.State

11import Data.Traversable (traverse)

12+import qualified Text.PrettyPrint as PP

12

13

13import SourceSyntax.Location as Loc

14import SourceSyntax.Location as Loc

14import SourceSyntax.Pattern (Pattern(PVar))

15import SourceSyntax.Pattern (Pattern(PVar))

@@ -22,7 +23,7 @@ import qualified Type.Constrain.Pattern as Pattern

22import qualified Transform.SortDefinitions as SD

23import qualified Transform.SortDefinitions as SD

23

24

25

25−constrain :: Env.Environment -> LExpr a b -> Type -> IO TypeConstraint

26+constrain :: Env.Environment -> LExpr a b -> Type -> ErrorT [PP.Doc] IO TypeConstraint

26constrain env (L span expr) tipe =

27constrain env (L span expr) tipe =

27 let list t = Env.get env Env.types "_List" <| t

28 let list t = Env.get env Env.types "_List" <| t

28 and = L span . CAnd

29 and = L span . CAnd

@@ -32,7 +33,7 @@ constrain env (L span expr) tipe =

32 clet schemes c = L span (CLet schemes c)

33 clet schemes c = L span (CLet schemes c)

33 in

34 in

34 case expr of

35 case expr of

35− Literal lit -> Literal.constrain env span lit tipe

36+ Literal lit -> liftIO $ Literal.constrain env span lit tipe

36

37

37 Var name | name == saveEnvName -> return (L span CSaveEnv)

38 Var name | name == saveEnvName -> return (L span CSaveEnv)

38 | otherwise -> return (name <? tipe)

39 | otherwise -> return (name <? tipe)

@@ -87,7 +88,7 @@ constrain env (L span expr) tipe =

87 and . (:) ce <$> mapM branch branches

88 and . (:) ce <$> mapM branch branches

88

89

89 Data name exprs ->

90 Data name exprs ->

90− do vars <- forM exprs $ \_ -> var Flexible

91+ do vars <- forM exprs $ \_ -> liftIO (var Flexible)

91 let pairs = zip exprs (map VarN vars)

92 let pairs = zip exprs (map VarN vars)

92 (ctipe, cs) <- Monad.foldM step (tipe,true) (reverse pairs)

93 (ctipe, cs) <- Monad.foldM step (tipe,true) (reverse pairs)

93 return $ ex vars (cs /\ name <? ctipe)

94 return $ ex vars (cs /\ name <? ctipe)

@@ -114,11 +115,11 @@ constrain env (L span expr) tipe =

114

115

115 Modify e fields ->

116 Modify e fields ->

116 exists $ \t -> do

117 exists $ \t -> do

117− oldVars <- forM fields $ \_ -> var Flexible

118+ oldVars <- forM fields $ \_ -> liftIO (var Flexible)

118 let oldFields = SrcT.fieldMap (zip (map fst fields) (map VarN oldVars))

119 let oldFields = SrcT.fieldMap (zip (map fst fields) (map VarN oldVars))

119 cOld <- ex oldVars <$> constrain env e (record oldFields t)

120 cOld <- ex oldVars <$> constrain env e (record oldFields t)

120

121

121− newVars <- forM fields $ \_ -> var Flexible

122+ newVars <- forM fields $ \_ -> liftIO (var Flexible)

122 let newFields = SrcT.fieldMap (zip (map fst fields) (map VarN newVars))

123 let newFields = SrcT.fieldMap (zip (map fst fields) (map VarN newVars))

123 let cNew = tipe === record newFields t

124 let cNew = tipe === record newFields t

124

125

@@ -127,14 +128,17 @@ constrain env (L span expr) tipe =

127 return $ cOld /\ ex newVars (and (cNew : cs))

128 return $ cOld /\ ex newVars (and (cNew : cs))

128

129

129 Record fields ->

130 Record fields ->

130− do vars <- forM fields $ \_ -> var Flexible

131+ do vars <- forM fields $ \_ -> liftIO (var Flexible)

131 cs <- zipWithM (constrain env) (map snd fields) (map VarN vars)

132 cs <- zipWithM (constrain env) (map snd fields) (map VarN vars)

132 let fields' = SrcT.fieldMap (zip (map fst fields) (map VarN vars))

133 let fields' = SrcT.fieldMap (zip (map fst fields) (map VarN vars))

133 recordType = record fields' (TermN EmptyRecord1)

134 recordType = record fields' (TermN EmptyRecord1)

134 return . ex vars . and $ tipe === recordType : cs

135 return . ex vars . and $ tipe === recordType : cs

135

136

136− Markdown _ ->

137+ Markdown _ es ->

138+ do vars <- forM es $ \_ -> liftIO (var Flexible)

139+ let tvars = map VarN vars

140+ cs <- zipWithM (constrain env) es tvars

137− return ("Graphics.Element.markdown" <? tipe)

141+ return . ex vars $ and ("Text.markdown" <? tipe : cs)

138

142

139 Let defs body ->

143 Let defs body ->

140 do c <- constrain env body tipe

144 do c <- constrain env body tipe

@@ -146,15 +150,16 @@ constrain env (L span expr) tipe =

146 (clet [Scheme rqs fqs (clet [monoscheme header] c2) header ]

150 (clet [Scheme rqs fqs (clet [monoscheme header] c2) header ]

147 (c1 /\ c))

151 (c1 /\ c))

148

152

153+

149constrainDef env info (pattern, expr, maybeTipe) =

154constrainDef env info (pattern, expr, maybeTipe) =

150 let qs = [] -- should come from the def, but I'm not sure what would live there...

155 let qs = [] -- should come from the def, but I'm not sure what would live there...

151 (schemes, rigidQuantifiers, flexibleQuantifiers, headers, c2, c1) = info

156 (schemes, rigidQuantifiers, flexibleQuantifiers, headers, c2, c1) = info

152 in

157 in

153− do rigidVars <- mapM (\_ -> var Rigid) qs -- Some mistake may be happening here.

158+ do rigidVars <- forM qs (\_ -> liftIO $ var Rigid) -- Some mistake may be happening here.

154− -- Currently, qs is always the empty list.

159+ -- Currently, qs is always [].

155 case (pattern, maybeTipe) of

160 case (pattern, maybeTipe) of

156 (PVar name, Just tipe) -> do

161 (PVar name, Just tipe) -> do

157− flexiVars <- mapM (\_ -> var Flexible) qs

162+ flexiVars <- forM qs (\_ -> liftIO $ var Flexible)

158 let inserts = zipWith (\arg typ -> Map.insert arg (VarN typ)) qs flexiVars

163 let inserts = zipWith (\arg typ -> Map.insert arg (VarN typ)) qs flexiVars

159 env' = env { Env.value = List.foldl' (\x f -> f x) (Env.value env) inserts }

164 env' = env { Env.value = List.foldl' (\x f -> f x) (Env.value env) inserts }

160 (vars, typ) <- Env.instantiateType env tipe Map.empty

165 (vars, typ) <- Env.instantiateType env tipe Map.empty

@@ -171,7 +176,7 @@ constrainDef env info (pattern, expr, maybeTipe) =

171 , fl rigidVars c /\ c1 )

176 , fl rigidVars c /\ c1 )

172

177

173 (PVar name, Nothing) -> do

178 (PVar name, Nothing) -> do

174− v <- var Flexible

179+ v <- liftIO $ var Flexible

175 let tipe = VarN v

180 let tipe = VarN v

176 inserts = zipWith (\arg typ -> Map.insert arg (VarN typ)) qs rigidVars

181 inserts = zipWith (\arg typ -> Map.insert arg (VarN typ)) qs rigidVars

177 env' = env { Env.value = List.foldl' (\x f -> f x) (Env.value env) inserts }

182 env' = env { Env.value = List.foldl' (\x f -> f x) (Env.value env) inserts }

@@ -183,7 +188,6 @@ constrainDef env info (pattern, expr, maybeTipe) =

183 , c /\ c2

188 , c /\ c2

184 , c1 )

189 , c1 )

185

190

186−

187expandPattern :: (Pattern, LExpr t v, Maybe SrcT.Type)

191expandPattern :: (Pattern, LExpr t v, Maybe SrcT.Type)

188 -> [(Pattern, LExpr t v, Maybe SrcT.Type)]

192 -> [(Pattern, LExpr t v, Maybe SrcT.Type)]

189expandPattern triple@(pattern, lexpr@(L s _), maybeType) =

193expandPattern triple@(pattern, lexpr@(L s _), maybeType) =

@@ -212,9 +216,9 @@ collapseDefs = concatMap expandPattern . go [] Map.empty Map.empty

212 TypeAnnotation name typ ->

216 TypeAnnotation name typ ->

213 go output defs (Map.insert name typ typs) ds

217 go output defs (Map.insert name typ typs) ds

214

218

215−try :: SrcSpan -> ErrorT String IO a -> IO a

219+try :: SrcSpan -> ErrorT (SrcSpan -> PP.Doc) IO a -> ErrorT [PP.Doc] IO a

216try span computation = do

220try span computation = do

217− result <- runErrorT computation

221+ result <- liftIO $ runErrorT computation

218 case result of

222 case result of

219− Left msg -> error $ "\nType error " ++ show span ++ "\n" ++ msg

223+ Left err -> throwError [err span]

220− Right value -> return value

224+ Right value -> return value

compiler/Type/Constrain/Literal.hs+5−5

@@ -10,12 +10,12 @@ constrain env span literal tipe =

10 do tipe' <- litType

11 return . L span $ CEqual tipe tipe'

12 where

13− prim name = Env.get env Env.types name

13+ prim name = return (Env.get env Env.types name)

14

15 litType =

16 case literal of

17 IntNum _ -> VarN `fmap` var (Is Number)

18− FloatNum _ -> return (prim "Float")

18+ FloatNum _ -> prim "Float"

19− Chr _ -> return (prim "Char")

19+ Chr _ -> prim "Char"

20− Str _ -> return (TermN (App1 (prim "_List") (prim "Char")))

20+ Str _ -> prim "String"

21− Boolean _ -> return (prim "Bool")

21+ Boolean _ -> prim "Bool"

compiler/Type/Constrain/Pattern.hs+16−3

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

1+{-# LANGUAGE FlexibleInstances #-}

1module Type.Constrain.Pattern where

2module Type.Constrain.Pattern where

2

3

3import Control.Arrow (second)

4import Control.Arrow (second)

@@ -7,8 +8,10 @@ import Control.Monad.Error

7import qualified Data.List as List

8import qualified Data.List as List

8import qualified Data.Maybe as Maybe

9import qualified Data.Maybe as Maybe

9import qualified Data.Map as Map

10import qualified Data.Map as Map

11+import qualified Text.PrettyPrint as PP

10

12

11import SourceSyntax.Pattern

13import SourceSyntax.Pattern

14+import SourceSyntax.Location

12import SourceSyntax.PrettyPrint

15import SourceSyntax.PrettyPrint

13import Text.PrettyPrint (render)

16import Text.PrettyPrint (render)

14import qualified SourceSyntax.Location as Loc

17import qualified SourceSyntax.Location as Loc

@@ -18,7 +21,7 @@ import Type.Environment as Env

18import qualified Type.Constrain.Literal as Literal

21import qualified Type.Constrain.Literal as Literal

19

22

20

23

21−constrain :: Environment -> Pattern -> Type -> ErrorT String IO Fragment

24+constrain :: Environment -> Pattern -> Type -> ErrorT (SrcSpan -> PP.Doc) IO Fragment

22constrain env pattern tipe =

25constrain env pattern tipe =

23 let span = Loc.NoSpan (render $ pretty pattern)

26 let span = Loc.NoSpan (render $ pretty pattern)

24 t1 === t2 = Loc.L span (CEqual t1 t2)

27 t1 === t2 = Loc.L span (CEqual t1 t2)

@@ -51,7 +54,11 @@ constrain env pattern tipe =

51 let msg = concat [ "Constructor '", name, "' expects ", show kind

54 let msg = concat [ "Constructor '", name, "' expects ", show kind

52 , " argument", if kind == 1 then "" else "s"

55 , " argument", if kind == 1 then "" else "s"

53 , " but was given ", show (length patterns), "." ]

56 , " but was given ", show (length patterns), "." ]

57+ err span = PP.vcat [ PP.text $ "Type error " ++ show span

58+ , PP.text msg ]

54− if length patterns /= kind then throwError msg else do

59+ case length patterns == kind of

60+ False -> throwError err

61+ True -> do

55 fragment <- Monad.liftM joinFragments (Monad.zipWithM (constrain env) patterns args)

62 fragment <- Monad.liftM joinFragments (Monad.zipWithM (constrain env) patterns args)

56 return $ fragment {

63 return $ fragment {

57 typeConstraint = typeConstraint fragment /\ tipe === result,

64 typeConstraint = typeConstraint fragment /\ tipe === result,

@@ -61,9 +68,15 @@ constrain env pattern tipe =

61 PRecord fields -> do

68 PRecord fields -> do

62 pairs <- liftIO $ mapM (\name -> (,) name <$> var Flexible) fields

69 pairs <- liftIO $ mapM (\name -> (,) name <$> var Flexible) fields

63 let tenv = Map.fromList (map (second VarN) pairs)

70 let tenv = Map.fromList (map (second VarN) pairs)

64− c <- liftIO . exists $ \t -> return (tipe === record (Map.map (:[]) tenv) t)

71+ c <- exists $ \t -> return (tipe === record (Map.map (:[]) tenv) t)

65 return $ Fragment {

72 return $ Fragment {

66 typeEnv = tenv,

73 typeEnv = tenv,

67 vars = map snd pairs,

74 vars = map snd pairs,

68 typeConstraint = c

75 typeConstraint = c

69 }

76 }

77+

78+instance Error (SrcSpan -> PP.Doc) where

79+ noMsg _ = PP.empty

80+ strMsg str span =

81+ PP.vcat [ PP.text $ "Type error " ++ show span

82+ , PP.text str ]

compiler/Type/Environment.hs+13−8

@@ -1,12 +1,16 @@

1module Type.Environment where

2

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

4+import Control.Exception (try, SomeException)

4import Control.Monad

5import Control.Monad

6+import Control.Monad.Trans.Error (ErrorList(..))

7+import Control.Monad.Error (ErrorT, throwError, liftIO)

5import qualified Control.Monad.State as State

8import qualified Control.Monad.State as State

6import qualified Data.Traversable as Traverse

9import qualified Data.Traversable as Traverse

7import qualified Data.Map as Map

10import qualified Data.Map as Map

8import Data.List (isPrefixOf)

11import Data.List (isPrefixOf)

9import qualified Data.UnionFind.IO as UF

12import qualified Data.UnionFind.IO as UF

13+import qualified Text.PrettyPrint as PP

10

14

11import qualified SourceSyntax.Type as Src

15import qualified SourceSyntax.Type as Src

12import SourceSyntax.Module (ADT)

16import SourceSyntax.Module (ADT)

@@ -51,7 +55,7 @@ makeTypes datatypes =

51 builtins :: [(String,Int)]

55 builtins :: [(String,Int)]

52 builtins = concat [ map tuple [0..9]

56 builtins = concat [ map tuple [0..9]

53 , kind 1 ["_List"]

57 , kind 1 ["_List"]

54− , kind 0 ["Int","Float","Char","Bool"]

58+ , kind 0 ["Int","Float","Char","String","Bool"]

55 ]

59 ]

56

60

57

61

@@ -105,11 +109,15 @@ get env subDict key = Map.findWithDefault err key (subDict env)

105freshDataScheme :: Environment -> String -> IO (Int, [Variable], [Type], Type)

109freshDataScheme :: Environment -> String -> IO (Int, [Variable], [Type], Type)

106freshDataScheme env name = get env constructor name

110freshDataScheme env name = get env constructor name

107

111

108−instantiateType ::

112+instance ErrorList PP.Doc where

113+ listMsg str = [PP.text str]

114+

109− Environment -> Src.Type -> VarDict -> IO ([Variable], Type)

115+instantiateType :: Environment -> Src.Type -> VarDict -> ErrorT [PP.Doc] IO ([Variable], Type)

110instantiateType env sourceType dict =

116instantiateType env sourceType dict =

111− do (tipe, (dict',_)) <- State.runStateT (instantiator env sourceType) (dict, Map.empty)

117+ do result <- liftIO $ try (State.runStateT (instantiator env sourceType) (dict, Map.empty))

118+ case result :: Either SomeException (Type, (VarDict, TypeDict)) of

119+ Left someError -> throwError [ PP.text $ show someError ]

112− return (Map.elems dict', tipe)

120+ Right (tipe, (dict',_)) -> return (Map.elems dict', tipe)

113

121

114instantiator :: Environment -> Src.Type

122instantiator :: Environment -> Src.Type

115 -> State.StateT (VarDict, TypeDict) IO Type

123 -> State.StateT (VarDict, TypeDict) IO Type

@@ -135,9 +143,6 @@ instantiator env sourceType = go sourceType

135 | "appendable" `isPrefixOf` x = Is Appendable

143 | "appendable" `isPrefixOf` x = Is Appendable

136 | otherwise = Flexible

144 | otherwise = Flexible

137

145

138− Src.Data "String" [] ->

139− return (get env types "_List" <| get env types "Char")

140−

141 Src.Data name ts -> do

146 Src.Data name ts -> do

142 ts' <- mapM go ts

147 ts' <- mapM go ts

143 case (Map.lookup name (types env), Map.lookup name (aliases env)) of

148 case (Map.lookup name (types env), Map.lookup name (aliases env)) of

compiler/Type/Inference.hs+24−18

@@ -16,7 +16,8 @@ import SourceSyntax.Type (Type)

16import Text.PrettyPrint

17import qualified Type.State as TS

18import Type.ExtraChecks (extraChecks)

19−import Control.Monad.State

19+import Control.Monad.State (execStateT, forM)

20+import Control.Monad.Error (runErrorT, liftIO)

20import Control.Arrow (second)

21import Control.Arrow (second)

21import qualified Type.Alias as Alias

22import qualified Type.Alias as Alias

22

23

@@ -33,20 +34,25 @@ infer interfaces modul = unsafePerformIO $ do

33 do (_, vars, args, result) <- Env.freshDataScheme env name

34 do (_, vars, args, result) <- Env.freshDataScheme env name

34 return (name, (vars, foldr (T.==>) result args))

35 return (name, (vars, foldr (T.==>) result args))

35

36

37+ attemptConstraint <- runErrorT $ do

36− importedVars <-

38+ importedVars <-

37− forM (concatMap (Map.toList . iTypes) $ Map.elems interfaces) $ \(name,tipe) ->

39+ forM (concatMap (Map.toList . iTypes) $ Map.elems interfaces) $ \(name,tipe) ->

38− (,) name `fmap` Env.instantiateType env tipe Map.empty

40+ (,) name `fmap` Env.instantiateType env tipe Map.empty

39−

41+

40− let allTypes = ctors ++ importedVars

42+ let allTypes = ctors ++ importedVars

41− vars = concatMap (fst . snd) allTypes

43+ vars = concatMap (fst . snd) allTypes

42− header = Map.map snd (Map.fromList allTypes)

44+ header = Map.map snd (Map.fromList allTypes)

43− environ = noneNoDocs . T.CLet [ T.Scheme vars [] (noneNoDocs T.CTrue) header ]

45+ environ = noneNoDocs . T.CLet [ T.Scheme vars [] (noneNoDocs T.CTrue) header ]

44−

46+

45− fvar <- T.var T.Flexible

47+ fvar <- liftIO $ T.var T.Flexible

46− constraint <- environ `fmap` TcExpr.constrain env (program modul) (T.VarN fvar)

48+ c <- TcExpr.constrain env (program modul) (T.VarN fvar)

47−

49+ return (header, environ c)

50+

51+ case attemptConstraint of

52+ Left err -> return $ Left err

53+ Right (header, constraint) -> do

48− state <- execStateT (Solve.solve constraint) TS.initialState

54+ state <- execStateT (Solve.solve constraint) TS.initialState

49− let rules = Alias.rules interfaces modul

55+ let rules = Alias.rules interfaces modul

50− case TS.sErrors state of

56+ case TS.sErrors state of

51− errors@(_:_) -> Left `fmap` sequence (map ($ rules) (reverse errors))

57+ errors@(_:_) -> Left `fmap` sequence (map ($ rules) (reverse errors))

52− [] -> extraChecks rules (Map.difference (TS.sSavedEnv state) header)

58+ [] -> extraChecks rules (Map.difference (TS.sSavedEnv state) header)

compiler/Type/Type.hs+3−2

@@ -9,6 +9,7 @@ import Text.PrettyPrint as P

9import System.IO.Unsafe

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

11import Control.Monad.State

12+import Control.Monad.Error

12import Data.Traversable (traverse)

13import Data.Traversable (traverse)

13import SourceSyntax.Location

14import SourceSyntax.Location

14import SourceSyntax.Helpers (isTuple)

15import SourceSyntax.Helpers (isTuple)

@@ -130,9 +131,9 @@ ex fqs constraint@(L s _) = L s $ CLet [Scheme [] fqs constraint Map.empty] (L s

130fl :: [Variable] -> TypeConstraint -> TypeConstraint

131fl :: [Variable] -> TypeConstraint -> TypeConstraint

131fl rqs constraint@(L s _) = L s $ CLet [Scheme rqs [] constraint Map.empty] (L s CTrue)

132fl rqs constraint@(L s _) = L s $ CLet [Scheme rqs [] constraint Map.empty] (L s CTrue)

132

133

133−exists :: (Type -> IO TypeConstraint) -> IO TypeConstraint

134+exists :: Error e => (Type -> ErrorT e IO TypeConstraint) -> ErrorT e IO TypeConstraint

134exists f = do

135exists f = do

135− v <- var Flexible

136+ v <- liftIO $ var Flexible

136 ex [v] <$> f (VarN v)

137 ex [v] <$> f (VarN v)

137

138

139

compiler/Type/Unify.hs+6−4

@@ -82,10 +82,10 @@ actuallyUnify span variable1 variable2 = do

82

83 comparableError str = TS.addError span (str ++ msg) variable1 variable2

84 where msg = "Expecting something comparable such as an\n" ++

85− "Int, Float, Char, or a list or tuple of comparables."

85+ "Int, Float, Char, String, or a list or tuple of comparables."

86

87 unifyComparable var name

88− | name `elem` ["Int","Float","Char","comparable"] = flexAndUnify var

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

89 | otherwise = comparableError ""

90

91 unifyComparableStructure varSuper varFlex =

@@ -129,8 +129,10 @@ actuallyUnify span variable1 variable2 = do

129 (Is Comparable, _, _, _) -> unifyComparableStructure variable1 variable2

130 (_, Is Comparable, _, _) -> unifyComparableStructure variable2 variable1

131

132+ (Is Appendable, _, _, Just ctor)

132− (Is Appendable, _, _, Just "Text.Text") -> flexAndUnify variable1

133+ | ctor `elem` ["Text.Text","String"] -> flexAndUnify variable1

134+ (_, Is Appendable, Just ctor, _)

133− (_, Is Appendable, Just "Text.Text", _) -> flexAndUnify variable2

135+ | ctor `elem` ["Text.Text","String"] -> flexAndUnify variable2

134 (Is Appendable, _, _, _) -> unifyAppendable variable1 variable2

136 (Is Appendable, _, _, _) -> unifyAppendable variable1 variable2

135 (_, Is Appendable, _, _) -> unifyAppendable variable2 variable1

137 (_, Is Appendable, _, _) -> unifyAppendable variable2 variable1

136

138

compiler/Unique.hsdeleted−19

@@ -1,19 +0,0 @@

1−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

2−module Unique (guid, set, run, runAt, Unique) where

3−

4−import Control.Monad.State (evalState, State, get, put)

5−

6−-- Wrapper around State monad.

7−newtype Unique a = U { runU :: State Int a }

8− deriving (Monad)

9−

10−-- Get the next GUID, incrementing the counter.

11−guid :: Unique Int

12−guid = U $ do n <- get

13− put (n + 1)

14− return n

15−

16−set n = U (put n)

17−

18−run = runAt 0

19−runAt n x = evalState (runU x) n

libraries/Automaton.elm+49−27

@@ -1,8 +1,24 @@

1+module Automaton ( pure, state, hiddenState, run, step

2+ , (<<<), (>>>), combine, count, average

3+ ) where

4+

1−-- This library is a way to package up dynamic behavior. It makes it easier to

5+{-| This library is a way to package up dynamic behavior. It makes it easier to

2−-- dynamically create dynamic components. See the [original release

6+dynamically create dynamic components. See the [original release

3−-- notes](/blog/announce/version-0.5.0.elm) on this library to get a feel for how

7+notes](/blog/announce/version-0.5.0.elm) on this library to get a feel for how

4−-- it can be used.

8+it can be used.

5−module Automaton where

9+

10+# Create

11+@docs pure, state, hiddenState

12+

13+# Evaluate

14+@docs run, step

15+

16+# Combine

17+@docs (>>>), (<<<), combine

18+

19+# Common Automatons

20+@docs count, average

21+-}

6

22

7import open Basics

23import open Basics

8import Signal (lift,foldp,Signal)

24import Signal (lift,foldp,Signal)

@@ -11,59 +27,66 @@ import Maybe (Just, Nothing)

11

27

12data Automaton a b = Step (a -> (Automaton a b, b))

28data Automaton a b = Step (a -> (Automaton a b, b))

13

29

14−-- Run an automaton on a given signal. The automaton steps forward

30+{-| Run an automaton on a given signal. The automaton steps forward whenever the

15−-- whenever the input signal updates.

31+input signal updates.

32+-}

16run : Automaton a b -> b -> Signal a -> Signal b

33run : Automaton a b -> b -> Signal a -> Signal b

17run auto base inputs =

34run auto base inputs =

18 let step a (Step f, _) = f a

35 let step a (Step f, _) = f a

19 in lift (\(x,y) -> y) (foldp step (auto,base) inputs)

36 in lift (\(x,y) -> y) (foldp step (auto,base) inputs)

20

37

21−-- Step an automaton forward once with a given input.

38+{-| Step an automaton forward once with a given input. -}

22step : a -> Automaton a b -> (Automaton a b, b)

39step : a -> Automaton a b -> (Automaton a b, b)

23step a (Step f) = f a

40step a (Step f) = f a

24

41

25−-- Compose two automatons, chaining them together.

42+{-| Compose two automatons, chaining them together. -}

26(>>>) : Automaton a b -> Automaton b c -> Automaton a c

43(>>>) : Automaton a b -> Automaton b c -> Automaton a c

27f >>> g =

44f >>> g =

28 Step (\a -> let (f', b) = step a f

45 Step (\a -> let (f', b) = step a f

29 (g', c) = step b g

46 (g', c) = step b g

30 in (f' >>> g', c))

47 in (f' >>> g', c))

31

48

32−-- Compose two automatons, chaining them together.

49+{-| Compose two automatons, chaining them together. -}

33(<<<) : Automaton b c -> Automaton a b -> Automaton a c

50(<<<) : Automaton b c -> Automaton a b -> Automaton a c

34g <<< f = f >>> g

51g <<< f = f >>> g

35

52

36−-- Combine a list of automatons into a single automaton that produces a list.

53+{-| Combine a list of automatons into a single automaton that produces a

54+list.

55+-}

37combine : [Automaton a b] -> Automaton a [b]

56combine : [Automaton a b] -> Automaton a [b]

38combine autos =

57combine autos =

39 Step (\a -> let (autos', bs) = unzip (map (step a) autos)

58 Step (\a -> let (autos', bs) = unzip (map (step a) autos)

40 in (combine autos', bs))

59 in (combine autos', bs))

41

60

42−-- Create an automaton with no memory. It just applies the given function to

61+{-| Create an automaton with no memory. It just applies the given function to

43−-- every input.

62+every input.

63+-}

44pure : (a -> b) -> Automaton a b

64pure : (a -> b) -> Automaton a b

45pure f = Step (\x -> (pure f, f x))

65pure f = Step (\x -> (pure f, f x))

46

66

67+

47−-- Create an automaton with state. Requires an initial state and a step

68+{-| Create an automaton with state. Requires an initial state and a step

48−-- function to step the state forward. For example, an automaton that counted

69+function to step the state forward. For example, an automaton that counted

49−-- how many steps it has taken would look like this:

70+how many steps it has taken would look like this:

50−--

71+

51−-- count = Automaton a Int

72+ count = Automaton a Int

52−-- count = state 0 (\\_ c -> c+1)

73+ count = state 0 (\\_ c -> c+1)

53−--

74+

54−-- It is a stateful automaton. The initial state is zero, and the step function

75+It is a stateful automaton. The initial state is zero, and the step function

55−-- increments the state on every step.

76+increments the state on every step.

77+-}

56state : b -> (a -> b -> b) -> Automaton a b

78state : b -> (a -> b -> b) -> Automaton a b

57state s f = Step (\x -> let s' = f x s

79state s f = Step (\x -> let s' = f x s

58 in (state s' f, s'))

80 in (state s' f, s'))

59

81

60−-- Create an automaton with hidden state. Requires an initial state and a

82+{-| Create an automaton with hidden state. Requires an initial state and a

61−-- step function to step the state forward and produce an output.

83+step function to step the state forward and produce an output.

84+-}

62hiddenState : s -> (a -> s -> (s,b)) -> Automaton a b

85hiddenState : s -> (a -> s -> (s,b)) -> Automaton a b

63hiddenState s f = Step (\x -> let (s',out) = f x s

86hiddenState s f = Step (\x -> let (s',out) = f x s

64 in (hiddenState s' f, out))

87 in (hiddenState s' f, out))

65

88

66−-- Count the number of steps taken.

89+{-| Count the number of steps taken. -}

67count : Automaton a Int

90count : Automaton a Int

68count = state 0 (\_ c -> c + 1)

91count = state 0 (\_ c -> c + 1)

69

92

@@ -75,7 +98,7 @@ dequeue q = case q of

75 (en,[]) -> dequeue ([], reverse en)

98 (en,[]) -> dequeue ([], reverse en)

76 (en,hd::tl) -> Just (hd, (en,tl))

99 (en,hd::tl) -> Just (hd, (en,tl))

77

100

78−-- Computes the running average of the last `n` inputs.

101+{-| Computes the running average of the last `n` inputs. -}

79average : Int -> Automaton Float Float

102average : Int -> Automaton Float Float

80average k =

103average k =

81 let step n (ns,len,sum) =

104 let step n (ns,len,sum) =

@@ -98,4 +121,3 @@ library faster and better:

98Speeding things up is a really low priority. Language features and

121Speeding things up is a really low priority. Language features and

99libraries with nice APIs and are way more important!

122libraries with nice APIs and are way more important!

100--}

123--}

101−

libraries/AutomatonV2.elmnew file+149

@@ -0,0 +1,149 @@

1+module AutomatonV2 where

2+{-| This library is a way to package up dynamic behavior. It makes it easier to

3+dynamically create dynamic components. See the [original release

4+notes](/blog/announce/version-0.5.0.elm) on this library to get a feel for how

5+it can be used.

6+-}

7+

8+import open Basics

9+import Signal (lift,foldp,Signal)

10+import open List

11+import Maybe (Just, Nothing)

12+

13+data Automaton input output = Pure (input -> output)

14+ | Stateful state (input -> state -> (output,state))

15+

16+-- The basics

17+

18+-- AFRP name: arr

19+pure: (i -> o) -> Automaton i o

20+pure = Pure

21+

22+-- AFRP name: >>>

23+andThen: Automaton i inter -> Automaton inter o -> Automaton i o

24+andThen first second =

25+ case first of

26+ Pure f -> case second of -- f is the function from first

27+ Pure s -> Pure (s . f) -- s is the function from second

28+ Stateful b s -> Stateful b (\i -> s (f i)) -- b is the base state from second

29+ Stateful fb f -> case second of -- fb is the base state from first

30+ Pure s -> Stateful fb (\i st -> -- sb is the base state from second

31+ let (inter, st') = f i st -- i is the input

32+ in (s inter, st')) -- st is the input state

33+ Stateful sb s -> Stateful (fb, sb) (\i (fst, sst) -> -- inter is the intermediate value

34+ let (inter, fst') = f i fst -- st' is the new state

35+ (o, sst') = s inter sst -- fst and sst are the state of first and second

36+ in (o, (fst', sst'))) -- ect...

37+

38+-- AFRP name: first

39+extendDown: Automaton i o -> Automaton (i,extra) (o,extra)

40+extendDown auto = case auto of

41+ Pure fun -> Pure (\(i,extra) -> (fun i, extra))

42+ Stateful base fun -> Stateful base (\(i,extra) s -> (fun i s, extra))

43+

44+-- AFRP name: loop

45+loop: s -> Automaton (i,s) (o,s) -> Automaton i o

46+loop base auto = case auto of

47+ Pure fun -> Stateful base (curry fun)

48+ Stateful base2 fun -> -- fun: (i, s) -> s2 -> ((o, s), s2)

49+ let newFun = (\i (s,s2) ->

50+ let ((o, s'), s2') = fun (i, s) s2

51+ in (o, (s', s2'))) -- newFun: i -> (s, s2) -> (o, (s, s2))

52+ in Stateful (base, base2) newFun

53+

54+-- Run an automaton on a given signal

55+run: Automaton i o -> o -> Signal i -> Signal o

56+run auto baseOut input = case auto of

57+ Pure fun -> lift fun input

58+ Stateful base fun -> lift fst

59+ (foldp (\i (o, s) -> fun i s)

60+ (baseOut, base) input)

61+

62+

63+-- Other frequently used functions/operators

64+

65+-- Create an automaton with state. Requires an initial state and a step

66+-- function to step the state forward. For example, an automaton that counted

67+-- how many steps it has taken would look like this:

68+--

69+-- count = Automaton a Int

70+-- count = state 0 (\\_ c -> c+1)

71+--

72+-- It is a stateful automaton. The initial state is zero, and the step function

73+-- increments the state on every step.

74+state : s -> (i -> s -> s) -> Automaton i s

75+state base fun = loop base (pure (\(i,s) ->

76+ let s' = fun i s

77+ in (s',s')))

78+

79+-- Create an automaton with hidden state. Requires an initial state and a

80+-- step function to step the state forward and produce an output.

81+hiddenState : s -> (i -> s -> (s,o)) -> Automaton i o

82+hiddenState base fun = loop base (pure (\(i,s) ->

83+ let (o,s') = fun i s

84+ in (s',o)))

85+

86+-- AFRP name: second

87+extendUp: Automaton i o -> Automaton (extra,i) (extra,o)

88+extendUp auto =

89+ let swap (a, b) = (b, a)

90+ in pure swap `andThen` extendDown auto `andThen` pure swap

91+

92+-- (parallel composition)

93+pair: Automaton i1 o1 -> Automaton i2 o2 -> Automaton (i1,i2) (o1,o2)

94+pair f g = extendDown f `andThen` extendUp g

95+

96+branch : Automaton i o1 -> Automaton i o2 -> Automaton i (o1,o2)

97+branch f g =

98+ let double = pure (\i -> (i,i))

99+ in double `andThen` pair f g

100+

101+combi: Automaton i o -> Automaton i [o] -> Automaton i [o]

102+combi a1 a2 = (a1 `branch` a2) `andThen` pure (uncurry (::))

103+

104+-- Combine a list of automatons into a single automaton that produces a list.

105+combine : [Automaton i o] -> Automaton i [o]

106+combine autos =

107+ let l = length autos

108+ in if l == 0

109+ then pure (\_ -> [])

110+ else foldr combi (last autos `andThen` pure (\a -> [a])) (take (l-1) autos)

111+

112+

113+-- Examples of automata

114+

115+-- Count the number of steps taken.

116+count : Automaton a Int

117+count = state 0 (\_ c -> c + 1)

118+

119+type Queue t = ([t],[t])

120+empty = ([],[])

121+enqueue x (en,de) = (x::en, de)

122+dequeue q = case q of

123+ ([],[]) -> Nothing

124+ (en,[]) -> dequeue ([], reverse en)

125+ (en,hd::tl) -> Just (hd, (en,tl))

126+

127+-- Computes the running average of the last `n` inputs.

128+average : Int -> Automaton Float Float

129+average k =

130+ let step n (ns,len,sum) =

131+ if len == k then stepFull n (ns,len,sum)

132+ else ((enqueue n ns, len+1, sum+n), (sum+n) / (toFloat len+1))

133+ stepFull n (ns,len,sum) =

134+ case dequeue ns of

135+ Nothing -> ((ns,len,sum), 0)

136+ Just (m,ns') -> let sum' = sum + n - m

137+ in ((enqueue n ns', len, sum'), sum' / toFloat len)

138+ in hiddenState (empty,0,0) step

139+

140+

141+{-- TODO(evancz): See the following papers for ideas on how to make this

142+library faster and better:

143+

144+- Functional Reactive Programming, Continued -- took some inspirations from this paper (Apanatshka)

145+- Causal commutative arrows and their optimization

146+

147+Speeding things up is a really low priority. Language features and

148+libraries with nice APIs and are way more important!

149+--}

libraries/Basics.elm+165−85

@@ -1,30 +1,77 @@

1

2module Basics where

3

4−import Native.Basics

4+{-| Tons of useful functions that get imported by default.

5+

6+The following libraries also get imported by default: List, Signal,

7+Text, Maybe, Time, Graphics.Element, Color, Graphics.Collage.

8+

9+# Equality

10+@docs (==), (/=)

11+

12+# Comparison

13+

14+These functions only work on `comparable` types. This includes numbers,

15+characters, strings, lists of comparable things, and tuples of comparable

16+things. Note that tuples with 7 or more elements are not comparable; why

17+are your tuples so big?

18+

19+@docs (<), (>), (<=), (>=), max, min, Order, compare

20+

21+# Booleans

22+@docs not, (&&), (||), xor, otherwise

23+

24+# Mathematics

25+@docs (+), (-), (*), (/), (^), div, rem, mod, abs, sqrt, clamp, logBase, e

26+

27+# Trigonometry

28+@docs pi, cos, sin, tan, acos, asin, atan, atan2

29+

30+# Number Conversions

31+@docs round, floor, ceiling, truncate, toFloat

5

32

6−type String = [Char]

33+# Angle Conversions

34+All angle conversions result in “standard Elm angles”

35+which happen to be radians.

7

36

37+@docs degrees, radians, turns

38+

39+# Polar Coordinates

40+@docs toPolar, fromPolar

41+

42+# Tuples

43+@docs fst, snd

44+

45+# Higher-Order Helpers

46+@docs id, (<|), (|>), (.), flip, curry, uncurry

47+

48+-}

49+

50+import Native.Basics

51+

8−-- Convert radians to standard Elm angles (radians).

52+{-| Convert radians to standard Elm angles (radians). -}

9radians : Float -> Float

53radians : Float -> Float

10radians t = t

54radians t = t

11

55

12−-- Convert degrees to standard Elm angles (radians).

56+{-| Convert degrees to standard Elm angles (radians). -}

13degrees : Float -> Float

57degrees : Float -> Float

14degrees d = d * Native.Basics.pi / 180

58degrees d = d * Native.Basics.pi / 180

15

59

16−-- Convert turns to standard Elm angles (radians).

60+{-| Convert turns to standard Elm angles (radians).

17−-- One turn is equal to 360°.

61+One turn is equal to 360°.

62+-}

18turns : Float -> Float

63turns : Float -> Float

19turns r = 2 * Native.Basics.pi * r

64turns r = 2 * Native.Basics.pi * r

20

65

21−-- Start with polar coordinates (r,θ)

66+{-| Start with polar coordinates (r,θ)

22−-- and get out cartesian coordinates (x,y).

67+and get out cartesian coordinates (x,y).

68+-}

23fromPolar : (Float,Float) -> (Float,Float)

69fromPolar : (Float,Float) -> (Float,Float)

24fromPolar (r,t) = (r * Native.Basics.cos t, r * Native.Basics.sin t)

70fromPolar (r,t) = (r * Native.Basics.cos t, r * Native.Basics.sin t)

25

71

26−-- Start with cartesian coordinates (x,y)

72+{-| Start with cartesian coordinates (x,y)

27−-- and get out polar coordinates (r,θ).

73+and get out polar coordinates (r,θ).

74+-}

28toPolar : (Float,Float) -> (Float,Float)

75toPolar : (Float,Float) -> (Float,Float)

29toPolar (x,y) = (Native.Basics.sqrt (x^2 + y^2), Native.Basics.atan2 y x)

76toPolar (x,y) = (Native.Basics.sqrt (x^2 + y^2), Native.Basics.atan2 y x)

30

77

@@ -37,23 +84,33 @@ toPolar (x,y) = (Native.Basics.sqrt (x^2 + y^2), Native.Basics.atan2 y x)

37(*) : number -> number -> number

84(*) : number -> number -> number

38(*) = Native.Basics.mul

85(*) = Native.Basics.mul

39

86

40−-- Floating point division.

87+{-| Floating point division. -}

41(/) : Float -> Float -> Float

88(/) : Float -> Float -> Float

42(/) = Native.Basics.floatDiv

89(/) = Native.Basics.floatDiv

43

90

91+infixl 6 +

92+infixl 6 -

93+infixl 7 *

94+infixl 7 /

95+infixl 8 ^

96+

97+infixl 7 `div`

98+infixl 7 `mod`

99+infixl 7 `rem`

100+

44−-- Integer division, remainder is discarded.

101+{-| Integer division, remainder is discarded. -}

45div : Int -> Int -> Int

102div : Int -> Int -> Int

46div = Native.Basics.div

103div = Native.Basics.div

47

104

48−-- Finds the remainder after dividing one number by another: ``4 `rem` 3 == 1``

105+{-| Finds the remainder after dividing one number by another: ``4 `rem` 3 == 1`` -}

49rem : Int -> Int -> Int

106rem : Int -> Int -> Int

50rem = Native.Basics.rem

107rem = Native.Basics.rem

51

108

52−-- Perform modular arithmetic: ``7 `mod` 2 == 1``

109+{-| Perform modular arithmetic: ``7 `mod` 2 == 1`` -}

53mod : Int -> Int -> Int

110mod : Int -> Int -> Int

54mod = Native.Basics.mod

111mod = Native.Basics.mod

55

112

56−-- Exponentiation: `3^2 == 9`

113+{-| Exponentiation: `3^2 == 9` -}

57(^) : number -> number -> number

114(^) : number -> number -> number

58(^) = Native.Basics.exp

115(^) = Native.Basics.exp

59

116

@@ -72,58 +129,53 @@ acos = Native.Basics.acos

72asin : Float -> Float

129asin : Float -> Float

73asin = Native.Basics.asin

130asin = Native.Basics.asin

74

131

75−-- You probably do not want to use this. Because it takes `(y/x)` as the argument

132+{-| You probably do not want to use this. It takes `(y/x)` as the

76−-- there is no way to know where the negative signs come from so the resulting

133+argument, so there is no way to know whether the negative signs comes from

77−-- angle is always between π/2 and -π/2 (in quadrants I and IV).

134+the `y` or `x`. Thus, the resulting angle is always between π/2 and -π/2

135+(in quadrants I and IV). You probably want to use `atan2` instead.

136+-}

78atan : Float -> Float

137atan : Float -> Float

79atan = Native.Basics.atan

138atan = Native.Basics.atan

80

139

81−-- This helps you find the angle of a cartesian coordinate.

140+{-| This helps you find the angle of a cartesian coordinate.

82−-- You will almost certainly want to use this instead of `atan`.

141+You will almost certainly want to use this instead of `atan`.

83−-- So `atan2 y x` computes *atan(y/x)* but also keeps track of which

142+So `atan2 y x` computes *atan(y/x)* but also keeps track of which

84−-- quadrant the angle should really be in. The result will be between

143+quadrant the angle should really be in. The result will be between

85−-- π and -π, giving you the full range of angles.

144+π and -π, giving you the full range of angles.

145+-}

86atan2 : Float -> Float -> Float

146atan2 : Float -> Float -> Float

87atan2 = Native.Basics.atan2

147atan2 = Native.Basics.atan2

88

148

89−-- Take the square root of a number.

149+{-| Take the square root of a number. -}

90sqrt : number -> number

150sqrt : number -> number

91sqrt = Native.Basics.sqrt

151sqrt = Native.Basics.sqrt

92

152

93−-- Take the absolute value of a number.

153+{-| Take the absolute value of a number. -}

94abs : number -> number

154abs : number -> number

95abs = Native.Basics.abs

155abs = Native.Basics.abs

96

156

97−-- Calculate the logarithm of a number with a given base: `logBase 10 100 == 2`

157+{-| Calculate the logarithm of a number with a given base: `logBase 10 100 == 2` -}

98logBase : number -> number -> number

158logBase : number -> number -> number

99logBase = Native.Basics.logBase

159logBase = Native.Basics.logBase

100

160

101−-- Given two comparables, returns the smaller one.

161+{-| Clamps a number within a given range. With the expression

102−min : comparable -> comparable -> comparable

162+`clamp 100 200 x` the results are as follows:

103−min = Native.Basics.min

104−

105−-- Given two comparables, returns the larger one.

106−max : comparable -> comparable -> comparable

107−max = Native.Basics.max

108

163

109−-- Clamps a number within a given range. With the expression `clamp 100 200 x`

110−-- the results are as follows:

111−--

112−-- * `100 if x < 100`

164+ 100 if x < 100

113−-- * ` x if 100 <= x < 200`

165+ x if 100 <= x < 200

114−-- * `200 if 200 <= x`

166+ 200 if 200 <= x

167+-}

115clamp : number -> number -> number -> number

168clamp : number -> number -> number -> number

116clamp = Native.Basics.clamp

169clamp = Native.Basics.clamp

117

170

118−-- An approximation of pi.

171+{-| An approximation of pi. -}

119pi : Float

172pi : Float

120pi = Native.Basics.pi

173pi = Native.Basics.pi

121

174

122−-- An approximation of e.

175+{-| An approximation of e. -}

123e : Float

176e : Float

124e = Native.Basics.e

177e = Native.Basics.e

125

178

126−-- Compare any two values for structural equality. Functions cannot be compared.

127(==) : a -> a -> Bool

179(==) : a -> a -> Bool

128(==) = Native.Basics.eq

180(==) = Native.Basics.eq

129

181

@@ -142,113 +194,141 @@ e = Native.Basics.e

142(>=) : comparable -> comparable -> Bool

194(>=) : comparable -> comparable -> Bool

143(>=) = Native.Basics.ge

195(>=) = Native.Basics.ge

144

196

197+infix 4 ==

198+infix 4 /=

199+infix 4 <

200+infix 4 >

201+infix 4 <=

202+infix 4 >=

203+

145−-- Compare any two comparable values. Comparable values include `String`, `Char`,

204+{-| Compare any two comparable values. Comparable values include `String`, `Char`,

146−-- `Int`, `Float`, `Time`, or a list or tuple containing comparable values.

205+`Int`, `Float`, `Time`, or a list or tuple containing comparable values.

147−-- These are also the only values that work as `Dict` keys or `Set` members.

206+These are also the only values that work as `Dict` keys or `Set` members.

207+-}

148compare : comparable -> comparable -> Order

208compare : comparable -> comparable -> Order

149compare = Native.Basics.compare

209compare = Native.Basics.compare

150

210

151−-- Represents the relative ordering of two things.

211+{-| Represents the relative ordering of two things.

152−-- The relations are less than, equal to, and greater than.

212+The relations are less than, equal to, and greater than.

213+-}

153data Order = LT | EQ | GT

214data Order = LT | EQ | GT

154

215

216+{-| Given two comparables, returns the smaller one. -}

217+min : comparable -> comparable -> comparable

218+min = Native.Basics.min

219+

220+{-| Given two comparables, returns the larger one. -}

221+max : comparable -> comparable -> comparable

222+max = Native.Basics.max

223+

155−-- The and operator. True if both inputs are True.

224+{-| The and operator. True if both inputs are True. -}

156(&&) : Bool -> Bool -> Bool

225(&&) : Bool -> Bool -> Bool

157(&&) = Native.Basics.and

226(&&) = Native.Basics.and

158

227

159−-- The or operator. True if one or both inputs are True.

228+{-| The or operator. True if one or both inputs are True. -}

160(||) : Bool -> Bool -> Bool

229(||) : Bool -> Bool -> Bool

161(||) = Native.Basics.or

230(||) = Native.Basics.or

162

231

232+infixr 3 &&

233+infixr 2 ||

234+

163−-- The exclusive-or operator. True if exactly one input is True.

235+{-| The exclusive-or operator. True if exactly one input is True. -}

164xor : Bool -> Bool -> Bool

236xor : Bool -> Bool -> Bool

165xor = Native.Basics.xor

237xor = Native.Basics.xor

166

238

167−-- Negate a boolean value: `(not True == False)` and `(not False == True)`

239+{-| Negate a boolean value: `(not True == False)` and `(not False == True)` -}

168not : Bool -> Bool

240not : Bool -> Bool

169not = Native.Basics.not

241not = Native.Basics.not

170

242

171−-- Equal to true. Useful as the last case of a multi-way-if.

243+{-| Equal to true. Useful as the last case of a multi-way-if. -}

172otherwise : Bool

244otherwise : Bool

173otherwise = True

245otherwise = True

174

246

175

247

176-- Conversions

248-- Conversions

177

249

178−-- Round a number to the nearest integer.

250+{-| Round a number to the nearest integer. -}

179round : Float -> Int

251round : Float -> Int

180round = Native.Basics.round

252round = Native.Basics.round

181

253

182−-- Truncate a decimal number, rounding towards zero.

254+{-| Truncate a decimal number, rounding towards zero. -}

183truncate : Float -> Int

255truncate : Float -> Int

184truncate = Native.Basics.truncate

256truncate = Native.Basics.truncate

185

257

186−-- Floor function, rounding down.

258+{-| Floor function, rounding down. -}

187floor : Float -> Int

259floor : Float -> Int

188floor = Native.Basics.floor

260floor = Native.Basics.floor

189

261

190−-- Ceiling function, rounding up.

262+{-| Ceiling function, rounding up. -}

191ceiling : Float -> Int

263ceiling : Float -> Int

192ceiling = Native.Basics.ceiling

264ceiling = Native.Basics.ceiling

193

265

194−-- Convert an integer into a float.

266+{-| Convert an integer into a float. -}

195toFloat : Int -> Float

267toFloat : Int -> Float

196toFloat = Native.Basics.toFloat

268toFloat = Native.Basics.toFloat

197

269

198

270

199-- Function Helpers

271-- Function Helpers

200

272

201−-- Function composition: `(f . g == (\\x -> f (g x)))`

273+{-| Function composition: `(f . g == (\\x -> f (g x)))` -}

202(.) : (b -> c) -> (a -> b) -> (a -> c)

274(.) : (b -> c) -> (a -> b) -> (a -> c)

203(.) f g x = f (g x)

275(.) f g x = f (g x)

204

276

205−-- Forward function application `x |> f == f x`. This function is useful

277+{-| Forward function application `x |> f == f x`. This function is useful

206−-- for avoiding parenthesis and writing code in a more natural way.

278+for avoiding parenthesis and writing code in a more natural way.

207−-- Consider the following code to create a pentagon:

279+Consider the following code to create a pentagon:

208−--

280+

209−-- scale 2 (move (10,10) (filled blue (ngon 5 30)))

281+ scale 2 (move (10,10) (filled blue (ngon 5 30)))

210−--

282+

211−-- This can also be written as:

283+This can also be written as:

212−--

284+

213−-- ngon 5 30 |> filled blue

285+ ngon 5 30 |> filled blue

214−-- |> move (10,10)

286+ |> move (10,10)

215−-- |> scale 2

287+ |> scale 2

288+-}

216(|>) : a -> (a -> b) -> b

289(|>) : a -> (a -> b) -> b

217x |> f = f x

290x |> f = f x

218

291

219−-- Function application `f <| x == f x`. This function is useful for avoiding

292+{-| Function application `f <| x == f x`. This function is useful for avoiding

220−-- parenthesis. Consider the following code to create a text element:

293+parenthesis. Consider the following code to create a text element:

221−--

294+

222−-- text (monospace (toText "code"))

295+ text (monospace (toText "code"))

223−--

296+

224−-- This can also be written as:

297+This can also be written as:

225−--

298+

226−-- text . monospace <| toText "code"

299+ text . monospace <| toText "code"

300+-}

227(<|) : (a -> b) -> a -> b

301(<|) : (a -> b) -> a -> b

228f <| x = f x

302f <| x = f x

229

303

304+infixr 9 .

305+infixr 0 <|

306+infixl 0 |>

307+

230−-- Given a value, returns exactly the same value.

308+{-| Given a value, returns exactly the same value. -}

231id : a -> a

309id : a -> a

232id x = x

310id x = x

233

311

234−-- Given a 2-tuple, returns the first value.

312+{-| Given a 2-tuple, returns the first value. -}

235fst : (a,b) -> a

313fst : (a,b) -> a

236fst = Native.Basics.fst

314fst = Native.Basics.fst

237

315

238−-- Given a 2-tuple, returns the second value.

316+{-| Given a 2-tuple, returns the second value. -}

239snd : (a,b) -> b

317snd : (a,b) -> b

240snd = Native.Basics.snd

318snd = Native.Basics.snd

241

319

242−-- Flips the order of the first two arguments to a function.

320+{-| Flips the order of the first two arguments to a function. -}

243flip : (a -> b -> c) -> (b -> a -> c)

321flip : (a -> b -> c) -> (b -> a -> c)

244flip f b a = f a b

322flip f b a = f a b

245

323

246−-- Change how arguments are passed to a function. This splits paired arguments

324+{-| Change how arguments are passed to a function.

247−-- into two separate arguments.

325+This splits paired arguments into two separate arguments.

326+-}

248curry : ((a,b) -> c) -> a -> b -> c

327curry : ((a,b) -> c) -> a -> b -> c

249curry = Native.Basics.curry

328curry = Native.Basics.curry

250

329

251−-- Change how arguments are passed to a function. This combines two arguments

330+{-| Change how arguments are passed to a function.

252−-- into a sigle pair.

331+This combines two arguments into a sigle pair.

332+-}

253uncurry : (a -> b -> c) -> (a,b) -> c

333uncurry : (a -> b -> c) -> (a,b) -> c

254uncurry = Native.Basics.uncurry

334uncurry = Native.Basics.uncurry

libraries/Char.elm+23−11

@@ -1,50 +1,62 @@

1

2module Char where

3

4+{-| Functions for working with characters. Character literals are enclosed in

5+`'a'` pair of single quotes.

6+

7+# Classification

8+@docs isUpper, isLower, isDigit, isOctDigit, isHexDigit

9+

10+# Conversion

11+@docs toUpper, toLower, toLocaleUpper, toLocaleLower, toCode, fromCode

12+

13+-}

14+

4import Native.Char

15import Native.Char

5

16

6−-- True for upper case letters.

17+{-| True for upper case letters. -}

7isUpper : Char -> Bool

18isUpper : Char -> Bool

8isUpper = Native.Char.isUpper

19isUpper = Native.Char.isUpper

9

20

10−-- True for lower case letters.

21+{-| True for lower case letters. -}

11isLower : Char -> Bool

22isLower : Char -> Bool

12isLower = Native.Char.isLower

23isLower = Native.Char.isLower

13

24

14−-- True for ASCII digits (`0..9`).

25+{-| True for ASCII digits `[0-9]`. -}

15isDigit : Char -> Bool

26isDigit : Char -> Bool

16isDigit = Native.Char.isDigit

27isDigit = Native.Char.isDigit

17

28

18−-- True for ASCII octal digits (`0..7`).

29+{-| True for ASCII octal digits `[0-7]`. -}

19isOctDigit : Char -> Bool

30isOctDigit : Char -> Bool

20isOctDigit = Native.Char.isOctDigit

31isOctDigit = Native.Char.isOctDigit

21

32

22−-- True for ASCII hexadecimal digits (`0..9a..fA..F`).

33+{-| True for ASCII hexadecimal digits `[0-9a-fA-F]`. -}

23isHexDigit : Char -> Bool

34isHexDigit : Char -> Bool

24isHexDigit = Native.Char.isHexDigit

35isHexDigit = Native.Char.isHexDigit

25

36

26−-- Convert to upper case.

37+{-| Convert to upper case. -}

27toUpper : Char -> Char

38toUpper : Char -> Char

28toUpper = Native.Char.toUpper

39toUpper = Native.Char.toUpper

29

40

30−-- Convert to lower case.

41+{-| Convert to lower case. -}

31toLower : Char -> Char

42toLower : Char -> Char

32toLower = Native.Char.toLower

43toLower = Native.Char.toLower

33

44

34−-- Convert to upper case, according to any locale-specific case mappings.

45+{-| Convert to upper case, according to any locale-specific case mappings. -}

35toLocaleUpper : Char -> Char

46toLocaleUpper : Char -> Char

36toLocaleUpper = Native.Char.toLocaleUpper

47toLocaleUpper = Native.Char.toLocaleUpper

37

48

38−-- Convert to lower case, according to any locale-specific case mappings.

49+{-| Convert to lower case, according to any locale-specific case mappings. -}

39toLocaleLower : Char -> Char

50toLocaleLower : Char -> Char

40toLocaleLower = Native.Char.toLocaleLower

51toLocaleLower = Native.Char.toLocaleLower

41

52

42type KeyCode = Int

53type KeyCode = Int

43

54

44−-- Convert to unicode.

55+{-| Convert to unicode. Used with the [`Keyboard`](/docs/Keyboard.elm)

56+library, which expects the input to be uppercase. -}

45toCode : Char -> KeyCode

57toCode : Char -> KeyCode

46toCode = Native.Char.toCode

58toCode = Native.Char.toCode

47

59

48−-- Convert from unicode.

60+{-| Convert from unicode. -}

49fromCode : KeyCode -> Char

61fromCode : KeyCode -> Char

50fromCode = Native.Char.fromCode

62fromCode = Native.Char.fromCode

libraries/Color.elm+121−47

@@ -1,82 +1,156 @@

1−

2module Color where

1module Color where

3

2

3+{-| Library for working with colors. Includes

4+[RGB](https://en.wikipedia.org/wiki/RGB_color_model) and

5+[HSV](http://en.wikipedia.org/wiki/HSL_and_HSV) creation, gradients, and

6+built-in names.

7+

8+# Creation

9+@docs rgb, rgba, hsv, hsva, grayscale, greyscale

10+

11+# From Other Colors

12+@docs complement

13+

14+# Gradients

15+@docs linear, radial

16+

17+# Built-in Colors

18+These colors come from the [Tango

19+palette](http://tango.freedesktop.org/Tango_Icon_Theme_Guidelines)

20+which provides aesthetically reasonable defaults for colors. Each color also

21+comes with a light and dark version.

22+

23+### Standard

24+@docs red, orange, yellow, green, blue, purple, brown

25+

26+### Light

27+@docs lightRed, lightOrange, lightYellow, lightGreen, lightBlue, lightPurple,

28+ lightBrown

29+

30+### Dark

31+@docs darkRed, darkOrange, darkYellow, darkGreen, darkBlue, darkPurple,

32+ darkBrown

33+

34+### Eight Shades of Grey

35+These colors are a compatible series of shades of grey, fitting nicely

36+with the Tango palette.

37+@docs white, lightGrey, grey, darkGrey, lightCharcoal, charcoal, darkCharcoal, black

38+

39+These are identical to the *grey* versions. It seems the spelling is regional, but

40+that has never helped me remember which one I should be writing.

41+@docs lightGray, gray, darkGray

42+

43+-}

44+

4import Native.Color

45import Native.Color

5import Basics ((-))

46import Basics ((-))

6

47

7data Color = Color Int Int Int Float

48data Color = Color Int Int Int Float

8

49

9−-- Create RGB colors with an alpha component for transparency.

50+{-| Create RGB colors with an alpha component for transparency.

10−-- The alpha component is specified with numbers between 0 and 1.

51+The alpha component is specified with numbers between 0 and 1. -}

11rgba : Int -> Int -> Int -> Float -> Color

52rgba : Int -> Int -> Int -> Float -> Color

12rgba = Color

53rgba = Color

13

54

14−-- Create RGB colors from numbers between 0 and 255 inclusive.

55+{-| Create RGB colors from numbers between 0 and 255 inclusive. -}

15rgb : Int -> Int -> Int -> Color

56rgb : Int -> Int -> Int -> Color

16rgb r g b = Color r g b 1

57rgb r g b = Color r g b 1

17

58

18−lightYellow = Color 255 233 79 1

59+lightRed : Color

60+lightRed = Color 239 41 41 1

61+red : Color

19−yellow = Color 237 212 0 1

62+red = Color 204 0 0 1

20−darkYellow = Color 196 160 0 1

63+darkRed : Color

64+darkRed = Color 164 0 0 1

21

65

66+lightOrange : Color

22lightOrange = Color 252 175 62 1

67lightOrange = Color 252 175 62 1

68+orange : Color

23−orange = Color 245 121 0 1

69+orange = Color 245 121 0 1

24−darkOrange = Color 206 92 0 1

70+darkOrange : Color

25−

71+darkOrange = Color 206 92 0 1

26−lightBrown = Color 233 185 110 1

27−brown = Color 193 125 17 1

28−darkBrown = Color 143 89 2 1

29

72

73+lightYellow : Color

74+lightYellow = Color 255 233 79 1

75+yellow : Color

76+yellow = Color 237 212 0 1

77+darkYellow : Color

78+darkYellow = Color 196 160 0 1

79+

80+lightGreen : Color

30−lightGreen = Color 138 226 52 1

81+lightGreen = Color 138 226 52 1

82+green : Color

31−green = Color 115 210 22 1

83+green = Color 115 210 22 1

84+darkGreen : Color

32darkGreen = Color 78 154 6 1

85darkGreen = Color 78 154 6 1

33

86

87+lightBlue : Color

34−lightBlue = Color 114 159 207 1

88+lightBlue = Color 114 159 207 1

89+blue : Color

35−blue = Color 52 101 164 1

90+blue = Color 52 101 164 1

91+darkBlue : Color

36−darkBlue = Color 32 74 135 1

92+darkBlue = Color 32 74 135 1

37

93

94+lightPurple : Color

38lightPurple = Color 173 127 168 1

95lightPurple = Color 173 127 168 1

96+purple : Color

39−purple = Color 117 80 123 1

97+purple = Color 117 80 123 1

98+darkPurple : Color

40−darkPurple = Color 92 53 102 1

99+darkPurple = Color 92 53 102 1

41−

100+

42−lightRed = Color 239 41 41 1

101+lightBrown : Color

43−red = Color 204 0 0 1

102+lightBrown = Color 233 185 110 1

44−darkRed = Color 164 0 0 1

103+brown : Color

104+brown = Color 193 125 17 1

105+darkBrown : Color

106+darkBrown = Color 143 89 2 1

45

107

108+black : Color

46−black = Color 0 0 0 1

109+black = Color 0 0 0 1

110+white : Color

47−white = Color 255 255 255 1

111+white = Color 255 255 255 1

48

112

113+lightGrey : Color

49−lightGrey = Color 238 238 236 1

114+lightGrey = Color 238 238 236 1

115+grey : Color

50−grey = Color 211 215 207 1

116+grey = Color 211 215 207 1

117+darkGrey : Color

51−darkGrey = Color 186 189 182 1

118+darkGrey = Color 186 189 182 1

52

119

120+lightGray : Color

53lightGray = Color 238 238 236 1

121lightGray = Color 238 238 236 1

122+gray : Color

54gray = Color 211 215 207 1

123gray = Color 211 215 207 1

124+darkGray : Color

55darkGray = Color 186 189 182 1

125darkGray = Color 186 189 182 1

56

126

127+lightCharcoal : Color

57lightCharcoal = Color 136 138 133 1

128lightCharcoal = Color 136 138 133 1

129+charcoal : Color

58charcoal = Color 85 87 83 1

130charcoal = Color 85 87 83 1

131+darkCharcoal : Color

59darkCharcoal = Color 46 52 54 1

132darkCharcoal = Color 46 52 54 1

60

133

134+{-| Produce a gray based on the input. 0 is white, 1 is black. -}

61grayscale : Float -> Color

135grayscale : Float -> Color

62grayscale p = hsv 0 0 (1-p)

136grayscale p = hsv 0 0 (1-p)

137+

138+greyscale : Float -> Color

63greyscale p = hsv 0 0 (1-p)

139greyscale p = hsv 0 0 (1-p)

64

140

65−-- Produce a “complementary color”.

141+{-| Produce a “complementary color”.

66−-- The two colors will accent each other.

142+The two colors will accent each other. -}

67complement : Color -> Color

143complement : Color -> Color

68complement = Native.Color.complement

144complement = Native.Color.complement

69

145

70−-- Create [HSV colors](http://en.wikipedia.org/wiki/HSL_and_HSV)

146+{-| Create [HSV colors](http://en.wikipedia.org/wiki/HSL_and_HSV)

71−-- with an alpha component for transparency.

147+with an alpha component for transparency. -}

72hsva : Float -> Float -> Float -> Float -> Color

148hsva : Float -> Float -> Float -> Float -> Color

73hsva = Native.Color.hsva

149hsva = Native.Color.hsva

74

150

75−-- Create [HSV colors](http://en.wikipedia.org/wiki/HSL_and_HSV).

151+{-| Create [HSV colors](http://en.wikipedia.org/wiki/HSL_and_HSV). This is very

76−-- This is very convenient for creating colors that cycle and shift.

152+convenient for creating colors that cycle and shift. Hue is an angle and should

77−-- Hue is an angle and should be given in standard Elm angles (radians).

153+be given in standard Elm angles (radians). -}

78−--

79−-- hsv (degrees 240) 1 1 == blue

80hsv : Float -> Float -> Float -> Color

154hsv : Float -> Float -> Float -> Color

81hsv = Native.Color.hsv

155hsv = Native.Color.hsv

82

156

@@ -84,17 +158,17 @@ data Gradient

84 = Linear (Float,Float) (Float,Float) [(Float,Color)]

158 = Linear (Float,Float) (Float,Float) [(Float,Color)]

85 | Radial (Float,Float) Float (Float,Float) Float [(Float,Color)]

159 | Radial (Float,Float) Float (Float,Float) Float [(Float,Color)]

86

160

87−-- Create a linear gradient. Takes a start and end point and then a series

161+{-| Create a linear gradient. Takes a start and end point and then a series of

88−-- of “color stops” that indicate how to interpolate between

162+“color stops” that indicate how to interpolate between the start and

89−-- the start and end points. See [this example](/edit/examples/Elements/LinearGradient.elm) for

163+end points. See [this example](/edit/examples/Elements/LinearGradient.elm) for a

90−-- a more visual explanation.

164+more visual explanation. -}

91linear : (number, number) -> (number, number) -> [(Float,Color)] -> Gradient

165linear : (number, number) -> (number, number) -> [(Float,Color)] -> Gradient

92linear = Linear

166linear = Linear

93

167

94−-- Create a radial gradient. First takes a start point and inner radius.

168+{-| Create a radial gradient. First takes a start point and inner radius. Then

95−-- Then takes an end point and outer radius. It then takes a series

169+takes an end point and outer radius. It then takes a series of “color

96−-- of “color stops” that indicate how to interpolate between

170+stops” that indicate how to interpolate between the inner and outer

97−-- the inner and outer circles. See [this example](/edit/examples/Elements/RadialGradient.elm) for

171+circles. See [this example](/edit/examples/Elements/RadialGradient.elm) for a

98−-- a more visual explanation.

172+more visual explanation. -}

99radial : (number,number) -> number -> (number,number) -> number -> [(Float,Color)] -> Gradient

173radial : (number,number) -> number -> (number,number) -> number -> [(Float,Color)] -> Gradient

100radial = Radial

174radial = Radial

libraries/Date.elm+32−25

@@ -1,65 +1,72 @@

1

2−-- Library for working with dates. It is still a work in progress, so email

3−-- the mailing list if you are having issues with internationalization or

4−-- locale formatting or something.

5module Date where

2module Date where

6

3

7−import Basics (String)

4+{-| Library for working with dates. Email the mailing list if you encounter

5+issues with internationalization or locale formatting.

6+

7+# Conversions

8+@docs read, toTime

9+

10+# Extractions

11+@docs year, month, Month, day, dayOfWeek, Day, hour, minute, second

12+

13+-}

14+

8import Native.Date

15import Native.Date

9import Time (Time)

16import Time (Time)

10import Maybe (Maybe)

17import Maybe (Maybe)

11

18

12data Date = Date

19data Date = Date

13

20

14−-- Represents the days of the week.

21+{-| Represents the days of the week. -}

15data Day = Mon | Tue | Wed | Thu | Fri | Sat | Sun

22data Day = Mon | Tue | Wed | Thu | Fri | Sat | Sun

16

23

17−-- Represents the month of the year.

24+{-| Represents the month of the year. -}

18data Month = Jan | Feb | Mar | Apr

25data Month = Jan | Feb | Mar | Apr

19 | May | Jun | Jul | Aug

26 | May | Jun | Jul | Aug

20 | Sep | Oct | Nov | Dec

27 | Sep | Oct | Nov | Dec

21

28

22−-- Attempt to read a date from a string.

29+{-| Attempt to read a date from a string. -}

23read : String -> Maybe Date

30read : String -> Maybe Date

24read = Native.Date.read

31read = Native.Date.read

25

32

26−-- Convert a date into a time since midnight (UTC) of 1 January 1990 (i.e.

33+{-| Convert a date into a time since midnight (UTC) of 1 January 1990 (i.e.

27−-- [UNIX time](http://en.wikipedia.org/wiki/Unix_time)). Given the date 23 June

34+[UNIX time](http://en.wikipedia.org/wiki/Unix_time)). Given the date 23 June

28−-- 1990 at 11:45AM this returns the corresponding time.

35+1990 at 11:45AM this returns the corresponding time. -}

29toTime : Date -> Time

36toTime : Date -> Time

30toTime = Native.Date.toTime

37toTime = Native.Date.toTime

31

38

32−-- Extract the year of a given date. Given the date 23 June 1990 at 11:45AM

39+{-| Extract the year of a given date. Given the date 23 June 1990 at 11:45AM

33−-- this returns the integer `1990`.

40+this returns the integer `1990`. -}

34year : Date -> Int

41year : Date -> Int

35year = Native.Date.year

42year = Native.Date.year

36

43

37−-- Extract the month of a given date. Given the date 23 June 1990 at 11:45AM

44+{-| Extract the month of a given date. Given the date 23 June 1990 at 11:45AM

38−-- this returns the Month `Jun` as defined below.

45+this returns the Month `Jun` as defined below. -}

39month : Date -> Month

46month : Date -> Month

40month = Native.Date.month

47month = Native.Date.month

41

48

42−-- Extract the day of a given date. Given the date 23 June 1990 at 11:45AM

49+{-| Extract the day of a given date. Given the date 23 June 1990 at 11:45AM

43−-- this returns the integer `23`.

50+this returns the integer `23`. -}

44day : Date -> Int

51day : Date -> Int

45day = Native.Date.day

52day = Native.Date.day

46

53

47−-- Extract the day of the week for a given date. Given the date 23 June

54+{-| Extract the day of the week for a given date. Given the date 23 June

48−-- 1990 at 11:45AM this returns the Day `Thu` as defined below.

55+1990 at 11:45AM this returns the Day `Thu` as defined below. -}

49dayOfWeek : Date -> Day

56dayOfWeek : Date -> Day

50dayOfWeek = Native.Date.dayOfWeek

57dayOfWeek = Native.Date.dayOfWeek

51

58

52−-- Extract the hour of a given date. Given the date 23 June 1990 at 11:45AM

59+{-| Extract the hour of a given date. Given the date 23 June 1990 at 11:45AM

53−-- this returns the integer `11`.

60+this returns the integer `11`. -}

54hour : Date -> Int

61hour : Date -> Int

55hour = Native.Date.hour

62hour = Native.Date.hour

56

63

57−-- Extract the minute of a given date. Given the date 23 June 1990 at 11:45AM

64+{-| Extract the minute of a given date. Given the date 23 June 1990 at 11:45AM

58−-- this returns the integer `45`.

65+this returns the integer `45`. -}

59minute : Date -> Int

66minute : Date -> Int

60minute = Native.Date.minute

67minute = Native.Date.minute

61

68

62−-- Extract the second of a given date. Given the date 23 June 1990 at 11:45AM

69+{-| Extract the second of a given date. Given the date 23 June 1990 at 11:45AM

63−-- this returns the integer `0`.

70+this returns the integer `0`. -}

64second : Date -> Int

71second : Date -> Int

65−second = Native.Date.second

72+second = Native.Date.second

libraries/Dict.elm+198−253

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

1−

2module Dict (empty,singleton,insert

1module Dict (empty,singleton,insert

3 ,lookup,findWithDefault

2 ,lookup,findWithDefault

4 ,remove,member

3 ,remove,member

@@ -8,151 +7,88 @@ module Dict (empty,singleton,insert

8 ,toList,fromList

7 ,toList,fromList

9 ) where

8 ) where

10

9

10+{-| A dictionary mapping unique keys to values. The keys can be any comparable

11+type. This includes `Int`, `Float`, `Time`, `Char`, `String`, and tuples or

12+lists of comparable types.

13+

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

15+

16+# Build

17+@docs empty, singleton, insert, remove

18+

19+# Query

20+@docs member, lookup, findWithDefault

21+

22+# Combine

23+@docs union, intersect, diff

24+

25+# Lists

26+@docs keys, values, toList, fromList

27+

28+# Transform

29+@docs map, foldl, foldr

30+

31+-}

32+

33+

11import open Basics

34import open Basics

12import open Maybe

35import open Maybe

13import Native.Error

36import Native.Error

14import List as List

37import List as List

15import Native.Utils

38import Native.Utils

16

39

40+-- BBlack and NBlack should only be used during the deletion

41+-- algorithm. Any other occurrence is a bug and should fail an assert.

17data NColor = Red | Black

42data NColor = Red | Black

43+ | BBlack | NBlack

18

44

19−data Dict k v = RBNode NColor k v (Dict k v) (Dict k v) | RBEmpty

45+data LeafColor = LBlack | LBBlack

20−

21−-- Create an empty dictionary.

22−empty : Dict comparable v

23−empty = RBEmpty

24−

25−{-- Helpers for checking invariants

26−

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

28−equal_pathLen t =

29− let path_numBlacks t =

30− case t of

31− RBEmpty -> 1

32− RBNode col _ _ l r ->

33− let { bl = path_numBlacks l ; br = path_numBlacks r } in

34− if bl /= br || bl == 0-1 || br == 0-1

35− then 0-1

36− else bl + (if col == Red then 0 else 1)

37− in 0-1 /= path_numBlacks t

38−

39−rootBlack t =

40− case t of

41− RBEmpty -> True

42− RBNode Black _ _ _ _ -> True

43− _ -> False

44−

45−redBlack_children t =

46− case t of

47− { RBNode Red _ _ (RBNode Red _ _ _ _) _ -> False

48− ; RBNode Red _ _ _ (RBNode Red _ _ _ _) -> False

49− ; RBEmpty -> True

50− ; RBNode _ _ _ l r -> redBlack_children l && redBlack_children r

51− }

52−

53−findExtreme f t =

54− case t of

55− { RBEmpty -> Nothing

56− ; RBNode c k _ l r ->

57− case findExtreme f (f (l,r)) of

58− { Nothing -> Just k

59− ; Just k' -> Just k' }

60− }

61−

62−findminRbt t = findExtreme fst t

63−findmaxRbt t = findExtreme snd t

64−

65−-- "Option LT than"

66−-- Returns True if either xo or yo is Nothing

67−-- Otherwise returns the result of comparing the values using f

68−

69−optionRelation f u xo yo =

70− case (xo,yo) of

71− { (Nothing,_) -> u

72− ; (_,Nothing) -> u

73− ; (Just x, Just y) -> f x y }

74−

75−olt xo yo = optionRelation (< ) True xo yo

76−olte xo yo = optionRelation (<=) True xo yo

77−

78−ordered t =

79− case t of

80− { RBEmpty -> True

81− ; RBNode c k v l r ->

82− let (lmax,rmin) = (findmaxRbt l, findminRbt r) in

83− olte lmax (Just k) && olte (Just k) rmin && ordered l && ordered r

84− }

85−

86−-- Check that there aren't any right red nodes in the tree *)

87−leftLeaning t =

88− case t of

89− { RBEmpty -> True

90− ; RBNode _ _ _ (RBNode Black _ _ _ _) (RBNode Red _ _ _ _) -> False

91− ; RBNode _ _ _ RBEmpty (RBNode Red _ _ _ _) -> False

92− ; RBNode _ _ _ l r -> (leftLeaning l) && (leftLeaning r)

93− }

94−

95−invariants_hold t =

96− ordered t && rootBlack t && redBlack_children t &&

97− equal_pathLen t && leftLeaning t

98

46

99−--** End invariant helpers *****

47+data Dict k v = RBNode NColor k v (Dict k v) (Dict k v)

100−--}

48+ | RBEmpty LeafColor

101

49

50+{-| Create an empty dictionary. -}

51+empty : Dict comparable v

52+empty = RBEmpty LBlack

102

53

103min : Dict k v -> (k,v)

54min : Dict k v -> (k,v)

104min t =

55min t =

105 case t of

56 case t of

106− RBNode _ k v RBEmpty _ -> (k,v)

57+ RBNode _ k v (RBEmpty LBlack) _ -> (k,v)

107 RBNode _ _ _ l _ -> min l

58 RBNode _ _ _ l _ -> min l

108− RBEmpty -> Native.Error.raise "(min Empty) is not defined"

59+ RBEmpty LBlack -> Native.Error.raise "(min Empty) is not defined"

109

60

110−{--

61+max : Dict k v -> (k, v)

111max t =

62max t =

112 case t of

63 case t of

113− { RBNode _ k v _ RBEmpty -> (k,v)

64+ RBNode _ k v _ (RBEmpty _) -> (k,v)

114− ; RBNode _ _ _ _ r -> max r

65+ RBNode _ _ _ _ r -> max r

115− ; RBEmpty -> Native.Error.raise "(max Empty) is not defined"

66+ RBEmpty _ -> Native.Error.raise "(max Empty) is not defined"

116− }

117−--}

118

67

119−-- Lookup the value associated with a key.

68+{-| Lookup the value associated with a key. -}

120lookup : comparable -> Dict comparable v -> Maybe v

69lookup : comparable -> Dict comparable v -> Maybe v

121lookup k t =

70lookup k t =

122 case t of

71 case t of

123− RBEmpty -> Nothing

72+ RBEmpty LBlack -> Nothing

124 RBNode _ k' v l r ->

73 RBNode _ k' v l r ->

125 case Native.Utils.compare k k' of

74 case Native.Utils.compare k k' of

126 LT -> lookup k l

75 LT -> lookup k l

127 EQ -> Just v

76 EQ -> Just v

128 GT -> lookup k r

77 GT -> lookup k r

129

78

130−-- Find the value associated with a key. If the key is not found,

79+{-| Find the value associated with a key. If the key is not found,

131−-- return the default value.

80+return the default value. -}

132findWithDefault : v -> comparable -> Dict comparable v -> v

81findWithDefault : v -> comparable -> Dict comparable v -> v

133findWithDefault base k t =

82findWithDefault base k t =

134 case t of

83 case t of

135− RBEmpty -> base

84+ RBEmpty LBlack -> base

136 RBNode _ k' v l r ->

85 RBNode _ k' v l r ->

137 case Native.Utils.compare k k' of

86 case Native.Utils.compare k k' of

138 LT -> findWithDefault base k l

87 LT -> findWithDefault base k l

139 EQ -> v

88 EQ -> v

140 GT -> findWithDefault base k r

89 GT -> findWithDefault base k r

141

90

142−{--

143−-- Find the value associated with a key. If the key is not found, there will be a runtime error.

144−find k t =

145− case t of

146− { RBEmpty -> Native.Error.raise "Key was not found in dictionary!"

147− ; RBNode _ k' v l r ->

148− case Native.Utils.compare k k' of

149− { LT -> find k l

150− ; EQ -> v

151− ; GT -> find k r }

152− }

153−--}

154−

155−-- Determine if a key is in a dictionary.

91+{-| Determine if a key is in a dictionary. -}

156member : comparable -> Dict comparable v -> Bool

92member : comparable -> Dict comparable v -> Bool

157-- Does t contain k?

93-- Does t contain k?

158member k t = isJust <| lookup k t

94member k t = isJust <| lookup k t

@@ -206,15 +142,16 @@ ensureBlackRoot : Dict k v -> Dict k v

206ensureBlackRoot t =

142ensureBlackRoot t =

207 case t of

143 case t of

208 RBNode Red k v l r -> RBNode Black k v l r

144 RBNode Red k v l r -> RBNode Black k v l r

209− _ -> t

145+ RBNode Black _ _ _ _ -> t

146+ RBEmpty LBlack -> t

210

147

211−-- Insert a key-value pair into a dictionary. Replaces value when there is

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

212−-- a collision.

149+a collision. -}

213insert : comparable -> v -> Dict comparable v -> Dict comparable v

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

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

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

215 let ins t =

152 let ins t =

216 case t of

153 case t of

217− RBEmpty -> RBNode Red k v RBEmpty RBEmpty

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

218 RBNode c k' v' l r ->

155 RBNode c k' v' l r ->

219 let h = case Native.Utils.compare k k' of

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

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

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

@@ -222,182 +159,190 @@ insert k v t = -- Invariant: t is a valid left-leaning rb tree

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

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

223 in fixUp h

160 in fixUp h

224 in ensureBlackRoot (ins t)

161 in ensureBlackRoot (ins t)

225−{--

226− if not (invariants_hold t) then

227− Native.Error.raise "invariants broken before insert"

228− else (let new_t = ensureBlackRoot (ins t) in

229− if not (invariants_hold new_t) then

230− Native.Error.raise "invariants broken after insert"

231− else new_t)

232−--}

233−

234−-- Create a dictionary with one key-value pair.

235−singleton : comparable -> v -> Dict comparable v

236−singleton k v = insert k v RBEmpty

237−

238−isRed : Dict k v -> Bool

239−isRed t =

240− case t of

241− RBNode Red _ _ _ _ -> True

242− _ -> False

243

162

244−isRedLeft : Dict k v -> Bool

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

245−isRedLeft t =

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

246− case t of

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

247− RBNode _ _ _ (RBNode Red _ _ _ _) _ -> True

166+

248− _ -> False

167+{- Remove helpers: everything from here to remove should only be used

249−

168+ internally by remove as they would otherwise break rb-invariants -}

250−isRedLeftLeft : Dict k v -> Bool

169+

251−isRedLeftLeft t =

170+isBBlack : Dict k v -> Bool

252− case t of

171+isBBlack t = case t of

253− RBNode _ _ _ (RBNode _ _ _ (RBNode Red _ _ _ _) _) _ -> True

172+ RBNode c _ _ _ _ -> case c of

254− _ -> False

173+ BBlack -> True

255−

174+ _ -> False

256−isRedRight : Dict k v -> Bool

175+ RBEmpty LBBlack -> True

257−isRedRight t =

176+ _ -> False

258− case t of

177+

259− RBNode _ _ _ _ (RBNode Red _ _ _ _) -> True

178+moreBlack : NColor -> NColor

260− _ -> False

179+moreBlack c = case c of

261−

180+ BBlack -> BBlack

262−isRedRightLeft : Dict k v -> Bool

181+ Black -> BBlack

263−isRedRightLeft t =

182+ Red -> Black

264− case t of

183+ NBlack -> Red

265− RBNode _ _ _ _ (RBNode _ _ _ (RBNode Red _ _ _ _) _) -> True

184+lessBlack : NColor -> NColor

266− _ -> False

185+lessBlack c = case c of

267−

186+ BBlack -> Black

268−moveRedLeft : Dict k v -> Dict k v

187+ Black -> Red

269−moveRedLeft t =

188+ Red -> NBlack

270− let t' = color_flip t in

189+ NBlack -> NBlack

271− case t' of

190+

272− RBNode c k v l r ->

191+moreBlackTree : Dict k v -> Dict k v

273− case r of

192+moreBlackTree t = case t of

274− RBNode _ _ _ (RBNode Red _ _ _ _) _ ->

193+ RBNode c k v l r -> RBNode (moreBlack c) k v l r

275− color_flip (rotateLeft (RBNode c k v l (rotateRight r)))

194+ RBEmpty _ -> RBEmpty LBBlack

276− _ -> t'

195+

277− _ -> t'

196+lessBlackTree : Dict k v -> Dict k v

278−

197+lessBlackTree t = case t of

279−moveRedRight : Dict k v -> Dict k v

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

280−moveRedRight t =

199+ RBEmpty _ -> RBEmpty LBlack

281− let t' = color_flip t in

200+

282− if isRedLeftLeft t' then color_flip (rotateRight t') else t'

201+-- Finds and deletes k in t

283−

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

284−moveRedLeftIfNeeded : Dict k v -> Dict k v

203+del k t = case t of

285−moveRedLeftIfNeeded t =

204+ RBEmpty _ -> t

286− if isRedLeft t || isRedLeftLeft t then t else moveRedLeft t

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

287−

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

288−moveRedRightIfNeeded : Dict k v -> Dict k v

207+ EQ -> rem t

289−moveRedRightIfNeeded t =

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

290− if isRedRight t || isRedRightLeft t then t else moveRedRight t

209+

291−

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

292−deleteMin : Dict k v -> Dict k v

211+rem : Dict k v -> Dict k v

293−deleteMin t =

212+rem t = case t of

294− let del t =

213+ RBNode c k v (RBEmpty _) (RBEmpty _) -> case c of

295− case t of

214+ Red -> RBEmpty LBlack

296− RBNode _ _ _ RBEmpty _ -> RBEmpty

215+ Black -> RBEmpty LBBlack

297− _ -> case moveRedLeftIfNeeded t of

216+ RBNode Black _ _ (RBEmpty _) (RBNode _ k v l r) ->

298− RBNode c k v l r -> fixUp (RBNode c k v (del l) r)

217+ RBNode Black k v l r

299− RBEmpty -> RBEmpty

218+ RBNode Black _ _ (RBNode _ k v l r) (RBEmpty _) ->

300− in ensureBlackRoot (del t)

219+ RBNode Black k v l r

301−

220+ -- l and r are both RBNodes

302−{--

221+ RBNode c _ _ l r ->

303−deleteMax t =

222+ let (k, v) = max l

304− let del t =

223+ l' = remove_max l

305− let t' = if isRedLeft t then rotateRight t else t in

224+ in bubble c k v l' r

306− case t' of

225+

307− { RBNode _ _ _ _ RBEmpty -> RBEmpty

226+-- Kills a BBlack or moves it upward, may leave behind NBlack

308− ; _ -> let t'' = moveRedRightIfNeeded t' in

227+bubble : NColor -> k -> v -> Dict k v -> Dict k v -> Dict k v

309− case t'' of

228+bubble c k v l r = if isBBlack l || isBBlack r

310− { RBNode c k v l r -> fixUp (RBNode c k v l (del r))

229+ then balance (moreBlack c) k v (lessBlackTree l) (lessBlackTree r)

311− ; RBEmpty -> RBEmpty } }

230+ else RBNode c k v l r

312− in ensureBlackRoot (del t)

231+

313−--}

232+-- Removes rightmost node, may leave root as BBlack

314−

233+remove_max : Dict k v -> Dict k v

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

234+remove_max t = case t of

316−-- no changes are made.

235+ RBNode c k v l (RBEmpty _) -> rem t

236+ RBNode c k v l r -> bubble c k v l (remove_max r)

237+

238+-- generalized tree balancing act

239+balance : NColor -> k -> v -> Dict k v -> Dict k v -> Dict k v

240+balance c k v l r = balance_node (RBNode c k v l r)

241+

242+blackish : Dict k v -> Bool

243+blackish (RBNode c _ _ _ _) = c == Black || c == BBlack

244+

245+balance_node : Dict k v -> Dict k v

246+balance_node t =

247+ let assemble col xk xv yk yv zk zv a b c d =

248+ RBNode (lessBlack col) yk yv (RBNode Black xk xv a b) (RBNode Black zk zv c d)

249+ in

250+ if blackish t

251+ then case t of

252+ RBNode col zk zv (RBNode Red yk yv (RBNode Red xk xv a b) c) d ->

253+ assemble col xk xv yk yv zk zv a b c d

254+ RBNode col zk zv (RBNode Red xk xv a (RBNode Red yk yv b c)) d ->

255+ assemble col xk xv yk yv zk zv a b c d

256+ RBNode col xk xv a (RBNode Red zk zv (RBNode Red yk yv b c) d) ->

257+ assemble col xk xv yk yv zk zv a b c d

258+ RBNode col xk xv a (RBNode Red yk yv b (RBNode Red zk zv c d)) ->

259+ assemble col xk xv yk yv zk zv a b c d

260+

261+ RBNode BBlack xk xv a (RBNode NBlack zk zv (RBNode Black yk yv b c) d) ->

262+ case d of

263+ (RBNode Black _ _ _ _) ->

264+ RBNode Black yk yv (RBNode Black xk xv a b) (balance Black zk zv c (redden d))

265+ _ -> t

266+

267+ RBNode BBlack zk zv (RBNode NBlack xk xv a (RBNode Black yk yv b c)) d ->

268+ case a of

269+ (RBNode Black _ _ _ _) ->

270+ RBNode Black yk yv (balance Black xk xv (redden a) b) (RBNode Black zk zv c d)

271+ _ -> t

272+

273+ _ -> t

274+

275+ else t

276+

277+-- make the top node black

278+blacken : Dict k v -> Dict k v

279+blacken t = case t of

280+ RBEmpty _ -> RBEmpty LBlack

281+ RBNode _ k v l r -> RBNode Black k v l r

282+

283+-- make the top node red

284+redden : Dict k v -> Dict k v

285+redden t = case t of

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

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

288+

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

290+no changes are made. -}

317remove : comparable -> Dict comparable v -> Dict comparable v

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

318−remove k t =

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

319− let eq_and_noRightNode t =

293+

320− case t of { RBNode _ k' _ _ RBEmpty -> k == k' ; _ -> False }

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

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

322− delLT t = case moveRedLeftIfNeeded t of

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

324− RBEmpty -> Native.Error.raise "delLT on Empty"

325− delEQ t = case t of -- Replace with successor

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

327− fixUp (RBNode c k' v' l (deleteMin r))

328− RBEmpty -> Native.Error.raise "delEQ called on a Empty"

329− delGT t = case t of

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

331− RBEmpty -> Native.Error.raise "delGT called on a Empty"

332− del t = case t of

333− RBEmpty -> RBEmpty

334− RBNode _ k' _ _ _ ->

335− if k < k' then delLT t else

336− let u = if isRedLeft t then rotateRight t else t in

337− if eq_and_noRightNode u then RBEmpty else

338− let t' = moveRedRightIfNeeded t in

339− if eq t' then delEQ t' else delGT t'

340− in if member k t then ensureBlackRoot (del t) else t

341−{--

342− if not (invariants_hold t) then

343− Native.Error.raise "invariants broken before remove"

344− else (let t' = ensureBlackRoot (del t) in

345− if invariants_hold t' then t' else

346− Native.Error.raise "invariants broken after remove")

347−--}

348−

349−-- Apply a function to all values in a dictionary.

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

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

351map f t =

296map f t =

352 case t of

297 case t of

353− RBEmpty -> RBEmpty

298+ RBEmpty LBlack -> RBEmpty LBlack

354 RBNode c k v l r -> RBNode c k (f v) (map f l) (map f r)

299 RBNode c k v l r -> RBNode c k (f v) (map f l) (map f r)

355

300

356−-- Fold over the key-value pairs in a dictionary, in order from lowest

301+{-| Fold over the key-value pairs in a dictionary, in order from lowest

357−-- key to highest key.

302+key to highest key. -}

358foldl : (comparable -> v -> b -> b) -> b -> Dict comparable v -> b

303foldl : (comparable -> v -> b -> b) -> b -> Dict comparable v -> b

359foldl f acc t =

304foldl f acc t =

360 case t of

305 case t of

361− RBEmpty -> acc

306+ RBEmpty LBlack -> acc

362 RBNode _ k v l r -> foldl f (f k v (foldl f acc l)) r

307 RBNode _ k v l r -> foldl f (f k v (foldl f acc l)) r

363

308

364−-- Fold over the key-value pairs in a dictionary, in order from highest

309+{-| Fold over the key-value pairs in a dictionary, in order from highest

365−-- key to lowest key.

310+key to lowest key. -}

366foldr : (comparable -> v -> b -> b) -> b -> Dict comparable v -> b

311foldr : (comparable -> v -> b -> b) -> b -> Dict comparable v -> b

367foldr f acc t =

312foldr f acc t =

368 case t of

313 case t of

369− RBEmpty -> acc

314+ RBEmpty LBlack -> acc

370 RBNode _ k v l r -> foldr f (f k v (foldr f acc r)) l

315 RBNode _ k v l r -> foldr f (f k v (foldr f acc r)) l

371

316

372−-- Combine two dictionaries. If there is a collision, preference is given

317+{-| Combine two dictionaries. If there is a collision, preference is given

373−-- to the first dictionary.

318+to the first dictionary. -}

374union : Dict comparable v -> Dict comparable v -> Dict comparable v

319union : Dict comparable v -> Dict comparable v -> Dict comparable v

375union t1 t2 = foldl insert t2 t1

320union t1 t2 = foldl insert t2 t1

376

321

377−-- Keep a key-value pair when its key appears in the second dictionary.

322+{-| Keep a key-value pair when its key appears in the second dictionary.

378−-- Preference is given to values in the first dictionary.

323+Preference is given to values in the first dictionary. -}

379intersect : Dict comparable v -> Dict comparable v -> Dict comparable v

324intersect : Dict comparable v -> Dict comparable v -> Dict comparable v

380intersect t1 t2 =

325intersect t1 t2 =

381 let combine k v t = if k `member` t2 then insert k v t else t

326 let combine k v t = if k `member` t2 then insert k v t else t

382 in foldl combine empty t1

327 in foldl combine empty t1

383

328

384−-- Keep a key-value pair when its key does not appear in the second dictionary.

329+{-| Keep a key-value pair when its key does not appear in the second dictionary.

385−-- Preference is given to the first dictionary.

330+Preference is given to the first dictionary. -}

386diff : Dict comparable v -> Dict comparable v -> Dict comparable v

331diff : Dict comparable v -> Dict comparable v -> Dict comparable v

387diff t1 t2 = foldl (\k v t -> remove k t) t1 t2

332diff t1 t2 = foldl (\k v t -> remove k t) t1 t2

388

333

389−-- Get all of the keys in a dictionary.

334+{-| Get all of the keys in a dictionary. -}

390keys : Dict comparable v -> [comparable]

335keys : Dict comparable v -> [comparable]

391keys t = foldr (\k v acc -> k :: acc) [] t

336keys t = foldr (\k v acc -> k :: acc) [] t

392

337

393−-- Get all of the values in a dictionary.

338+{-| Get all of the values in a dictionary. -}

394values : Dict comparable v -> [v]

339values : Dict comparable v -> [v]

395values t = foldr (\k v acc -> v :: acc) [] t

340values t = foldr (\k v acc -> v :: acc) [] t

396

341

397−-- Convert a dictionary into an association list of key-value pairs.

342+{-| Convert a dictionary into an association list of key-value pairs. -}

398toList : Dict comparable v -> [(comparable,v)]

343toList : Dict comparable v -> [(comparable,v)]

399toList t = foldr (\k v acc -> (k,v) :: acc) [] t

344toList t = foldr (\k v acc -> (k,v) :: acc) [] t

400

345

401−-- Convert an association list into a dictionary.

346+{-| Convert an association list into a dictionary. -}

402fromList : [(comparable,v)] -> Dict comparable v

347fromList : [(comparable,v)] -> Dict comparable v

403fromList assocs = List.foldl (\(k,v) d -> insert k v d) empty assocs

348fromList assocs = List.foldl (\(k,v) d -> insert k v d) empty assocs

libraries/Either.elm+42−14

@@ -1,51 +1,79 @@

1−

2module Either where

1module Either where

3

2

3+{-| Represents any data that can take two different types.

4+

5+# Type and Constructors

6+@docs Either

7+

8+# Taking Eithers apart

9+@docs either, isLeft, isRight

10+

11+# Eithers and Lists

12+@docs lefts, rights, partition

13+

14+-}

15+

4import List

16import List

5

17

6−-- Represents any data that can take two different types.

18+{-| Represents any data may take two forms. For example, a user ID may be

7−--

19+either an `Int` or a `String`.

8−-- This can also be used for error handling `(Either String a)` where error

20+

9−-- messages are stored on the left, and the correct values (“right”

21+This can also be used for error handling `(Either String a)` where

10−-- values) are stored on the right.

22+error messages are stored on the left, and the correct values

23+(“right” values) are stored on the right.

24+-}

11data Either a b = Left a | Right b

25data Either a b = Left a | Right b

12

26

13−-- Apply the first function to a `Left` and the second function to a `Right`.

27+{-| Apply the first function to a `Left` and the second function to a `Right`.

14−-- This allows the extraction of a value from an `Either`.

28+This allows the extraction of a value from an `Either`.

29+-}

15either : (a -> c) -> (b -> c) -> Either a b -> c

30either : (a -> c) -> (b -> c) -> Either a b -> c

16either f g e = case e of { Left x -> f x ; Right y -> g y }

31either f g e = case e of { Left x -> f x ; Right y -> g y }

17

32

18−-- True if the value is a `Left`.

33+{-| True if the value is a `Left`. -}

19isLeft : Either a b -> Bool

34isLeft : Either a b -> Bool

20isLeft e = case e of { Left _ -> True ; _ -> False }

35isLeft e = case e of { Left _ -> True ; _ -> False }

21

36

22−-- True if the value is a `Right`.

37+{-| True if the value is a `Right`. -}

23isRight : Either a b -> Bool

38isRight : Either a b -> Bool

24isRight e = case e of { Right _ -> True ; _ -> False }

39isRight e = case e of { Right _ -> True ; _ -> False }

25

40

26−-- Keep only the values held in `Left` values.

41+{-| Keep only the values held in `Left` values. -}

27lefts : [Either a b] -> [a]

42lefts : [Either a b] -> [a]

28lefts es = List.foldr consLeft [] es

43lefts es = List.foldr consLeft [] es

29

44

30−-- Keep only the values held in `Right` values.

45+{-| Keep only the values held in `Right` values. -}

31rights : [Either a b] -> [b]

46rights : [Either a b] -> [b]

32rights es = List.foldr consRight [] es

47rights es = List.foldr consRight [] es

33

48

34−-- Split into two lists, lefts on the left and rights on the right. So we

49+{-| Split into two lists, lefts on the left and rights on the right. So we

35−-- have the equivalence: `(partition es == (lefts es, rights es))`

50+have the equivalence: `(partition es == (lefts es, rights es))`

51+-}

36partition : [Either a b] -> ([a],[b])

52partition : [Either a b] -> ([a],[b])

37partition es = List.foldr consEither ([],[]) es

53partition es = List.foldr consEither ([],[]) es

38

54

55+{-| If `Left`, add the value to the front of the list.

56+If `Right`, return the list unchanged

57+-}

58+consLeft : Either a b -> [a] -> [a]

39consLeft e vs =

59consLeft e vs =

40 case e of

60 case e of

41 Left v -> v::vs

61 Left v -> v::vs

42 Right _ -> vs

62 Right _ -> vs

43

63

64+{-| If `Right`, add the value to the front of the list.

65+If `Left`, return the list unchanged.

66+-}

67+consRight : Either a b -> [b] -> [b]

44consRight e vs =

68consRight e vs =

45 case e of

69 case e of

46 Left _ -> vs

70 Left _ -> vs

47 Right v -> v::vs

71 Right v -> v::vs

48

72

73+{-| If `Left`, add the value to the left list.

74+If `Right`, add the value to the right list.

75+-}

76+consEither : Either a b -> ([a], [b]) -> ([a], [b])

49consEither e (ls,rs) =

77consEither e (ls,rs) =

50 case e of

78 case e of

51 Left l -> (l::ls,rs)

79 Left l -> (l::ls,rs)

libraries/Graphics/Collage.elm+103−58

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

1−

2module Graphics.Collage where

1module Graphics.Collage where

3

2

3+{-| The collage API is for freeform graphics. You can move, rotate, scale, etc.

4+all sorts of forms including lines, shapes, images, and elements.

5+

6+# Unstructured Graphics

7+@docs collage

8+

9+# Creating Forms

10+@docs toForm, filled, textured, gradient, outlined, traced

11+

12+# Transforming Forms

13+@docs move, moveX, moveY, scale, rotate, alpha

14+

15+# Grouping Forms

16+Grouping forms makes it easier to write modular graphics code. You can create

17+a form that is a composite of many subforms. From there it is easy to transform

18+it as a single unit.

19+

20+@docs group, groupTransform

21+

22+# Shapes

23+@docs rect, oval, square, circle, ngon, polygon

24+

25+# Paths

26+@docs segment, path

27+

28+# Line Styles

29+@docs solid, dashed, dotted, LineStyle, LineCap, LineJoin, defaultLine

30+

31+-}

32+

4import open Basics

33import open Basics

5import List

34import List

6import Either (Either, Left, Right)

35import Either (Either, Left, Right)

@@ -25,16 +54,18 @@ data FillStyle

25 | Texture String

54 | Texture String

26 | Grad Gradient

55 | Grad Gradient

27

56

28−-- The shape of the ends of a line.

57+{-| The shape of the ends of a line. -}

29data LineCap = Flat | Round | Padded

58data LineCap = Flat | Round | Padded

30

59

31−-- The shape of the “joints” of a line, where each line segment

60+{-| The shape of the “joints” of a line, where each line segment

32−-- meets. `Sharp` takes an argument to limit the length of the joint. This

61+meets. `Sharp` takes an argument to limit the length of the joint. This

33−-- defaults to 10.

62+defaults to 10.

63+-}

34data LineJoin = Smooth | Sharp Float | Clipped

64data LineJoin = Smooth | Sharp Float | Clipped

35

65

36−-- All of the attributes of a line style. This lets you build up a line style

66+{-| All of the attributes of a line style. This lets you build up a line style

37−-- however you want. You can also update existing line styles with record updates.

67+however you want. You can also update existing line styles with record updates.

68+-}

38type LineStyle = {

69type LineStyle = {

39 color : Color,

70 color : Color,

40 width : Float,

71 width : Float,

@@ -44,11 +75,12 @@ type LineStyle = {

44 dashOffset : Int

75 dashOffset : Int

45 }

76 }

46

77

47−-- The default line style, which is solid black with flat caps and sharp joints.

78+{-| The default line style, which is solid black with flat caps and sharp joints.

48−-- You can use record updates to build the line style you

79+You can use record updates to build the line style you

49−-- want. For example, to make a thicker line, you could say:

80+want. For example, to make a thicker line, you could say:

50−--

81+

51−-- { defaultLine | width <- 10 }

82+ { defaultLine | width <- 10 }

83+-}

52defaultLine : LineStyle

84defaultLine : LineStyle

53defaultLine = {

85defaultLine = {

54 color = black,

86 color = black,

@@ -59,15 +91,15 @@ defaultLine = {

59 dashOffset = 0

91 dashOffset = 0

60 }

92 }

61

93

62−-- Create a solid line style with a given color.

94+{-| Create a solid line style with a given color. -}

63solid : Color -> LineStyle

95solid : Color -> LineStyle

64solid clr = { defaultLine | color <- clr }

96solid clr = { defaultLine | color <- clr }

65

97

66−-- Create a dashed line style with a given color. Dashing equals `[8,4]`.

98+{-| Create a dashed line style with a given color. Dashing equals `[8,4]`. -}

67dashed : Color -> LineStyle

99dashed : Color -> LineStyle

68dashed clr = { defaultLine | color <- clr, dashing <- [8,4] }

100dashed clr = { defaultLine | color <- clr, dashing <- [8,4] }

69

101

70−-- Create a dotted line style with a given color. Dashing equals `[3,3]`.

102+{-| Create a dotted line style with a given color. Dashing equals `[3,3]`. -}

71dotted : Color -> LineStyle

103dotted : Color -> LineStyle

72dotted clr = { defaultLine | color <- clr, dashing <- [3,3] }

104dotted clr = { defaultLine | color <- clr, dashing <- [3,3] }

73

105

@@ -83,113 +115,125 @@ form f = { theta=0, scale=1, x=0, y=0, alpha=1, form=f }

83

115

84fill style shape = form (FShape (Right style) shape)

116fill style shape = form (FShape (Right style) shape)

85

117

86−-- Create a filled in shape.

118+{-| Create a filled in shape. -}

87filled : Color -> Shape -> Form

119filled : Color -> Shape -> Form

88filled color shape = fill (Solid color) shape

120filled color shape = fill (Solid color) shape

89

121

90−-- Create a textured shape. The texture is described by some url and is

122+{-| Create a textured shape. The texture is described by some url and is

91−-- tiled to fill the entire shape.

123+tiled to fill the entire shape.

124+-}

92textured : String -> Shape -> Form

125textured : String -> Shape -> Form

93textured src shape = fill (Texture src) shape

126textured src shape = fill (Texture src) shape

94

127

95−-- Fill a shape with a [gradient](/docs/Color.elm#linear).

128+{-| Fill a shape with a [gradient](/docs/Color.elm#linear). -}

96gradient : Gradient -> Shape -> Form

129gradient : Gradient -> Shape -> Form

97gradient grad shape = fill (Grad grad) shape

130gradient grad shape = fill (Grad grad) shape

98

131

99−-- Outline a shape with a given line style.

132+{-| Outline a shape with a given line style. -}

100outlined : LineStyle -> Shape -> Form

133outlined : LineStyle -> Shape -> Form

101outlined style shape = form (FShape (Left style) shape)

134outlined style shape = form (FShape (Left style) shape)

102

135

103−-- Trace a path with a given line style.

136+{-| Trace a path with a given line style. -}

104traced : LineStyle -> Path -> Form

137traced : LineStyle -> Path -> Form

105traced style path = form (FPath style path)

138traced style path = form (FPath style path)

106

139

107−-- Create a sprite from a sprite sheet. It cuts out a rectangle

140+{-| Create a sprite from a sprite sheet. It cuts out a rectangle

108−-- at a given position.

141+at a given position.

142+-}

109sprite : Int -> Int -> (Int,Int) -> String -> Form

143sprite : Int -> Int -> (Int,Int) -> String -> Form

110sprite w h pos src = form (FImage w h pos src)

144sprite w h pos src = form (FImage w h pos src)

111

145

112−-- Turn any `Element` into a `Form`. This lets you use text, gifs, and video

146+{-| Turn any `Element` into a `Form`. This lets you use text, gifs, and video

113−-- in your collage. This means you can move, rotate, and scale

147+in your collage. This means you can move, rotate, and scale

114−-- an `Element` however you want.

148+an `Element` however you want.

149+-}

115toForm : Element -> Form

150toForm : Element -> Form

116toForm e = form (FElement e)

151toForm e = form (FElement e)

117

152

118−-- Flatten many forms into a single `Form`. This lets you move and rotate them

153+{-| Flatten many forms into a single `Form`. This lets you move and rotate them

119−-- as a single unit, making it possible to build small, modular components.

154+as a single unit, making it possible to build small, modular components.

155+-}

120group : [Form] -> Form

156group : [Form] -> Form

121group fs = form (FGroup identity fs)

157group fs = form (FGroup identity fs)

122

158

123−-- Flatten many forms into a single `Form` and then apply a matrix

159+{-| Flatten many forms into a single `Form` and then apply a matrix

124−-- transformation.

160+transformation.

161+-}

125groupTransform : Transform2D -> [Form] -> Form

162groupTransform : Transform2D -> [Form] -> Form

126groupTransform matrix fs = form (FGroup matrix fs)

163groupTransform matrix fs = form (FGroup matrix fs)

127

164

128−-- Rotate a form by a given angle. Rotate takes standard Elm angles (radians)

165+{-| Rotate a form by a given angle. Rotate takes standard Elm angles (radians)

129−-- and turns things counterclockwise. So to turn `form` 30° to the left

166+and turns things counterclockwise. So to turn `form` 30° to the left

130−-- you would say, `(rotate (degrees 30) form)`.

167+you would say, `(rotate (degrees 30) form)`.

168+-}

131rotate : number -> Form -> Form

169rotate : number -> Form -> Form

132rotate t f = { f | theta <- f.theta + t }

170rotate t f = { f | theta <- f.theta + t }

133

171

134−-- Scale a form by a given factor. Scaling by 2 doubles the size.

172+{-| Scale a form by a given factor. Scaling by 2 doubles the size.

173+-}

135scale : number -> Form -> Form

174scale : number -> Form -> Form

136scale s f = { f | scale <- f.scale * s }

175scale s f = { f | scale <- f.scale * s }

137

176

138−-- Move a form by the given amount. This is a relative translation so

177+{-| Move a form by the given amount. This is a relative translation so

139−-- `(move (10,10) form)` would move `form` ten pixels up and ten pixels to the

178+`(move (10,10) form)` would move `form` ten pixels up and ten pixels to the

140−-- right.

179+right.

180+-}

141move : (number,number) -> Form -> Form

181move : (number,number) -> Form -> Form

142move (x,y) f = { f | x <- f.x + x, y <- f.y + y }

182move (x,y) f = { f | x <- f.x + x, y <- f.y + y }

143

183

144−-- Move a shape in the x direction. This is relative so `(moveX 10 form)` moves

184+{-| Move a shape in the x direction. This is relative so `(moveX 10 form)` moves

145−-- `form` 10 pixels to the right.

185+`form` 10 pixels to the right.

186+-}

146moveX : number -> Form -> Form

187moveX : number -> Form -> Form

147moveX x f = { f | x <- f.x + x }

188moveX x f = { f | x <- f.x + x }

148

189

149−-- Move a shape in the y direction. This is relative so `(moveY 10 form)` moves

190+{-| Move a shape in the y direction. This is relative so `(moveY 10 form)` moves

150−-- `form` upwards by 10 pixels.

191+`form` upwards by 10 pixels.

192+-}

151moveY : number -> Form -> Form

193moveY : number -> Form -> Form

152moveY y f = { f | y <- f.y + y }

194moveY y f = { f | y <- f.y + y }

153

195

154−-- Set the alpha of a `Form`. The default is 1, and 0 is totally transparent.

196+{-| Set the alpha of a `Form`. The default is 1, and 0 is totally transparent. -}

155alpha : Float -> Form -> Form

197alpha : Float -> Form -> Form

156alpha a f = { f | alpha <- a }

198alpha a f = { f | alpha <- a }

157

199

158−-- A collage is a collection of 2D forms. There are no strict positioning

200+{-| A collage is a collection of 2D forms. There are no strict positioning

159−-- relationships between forms, so you are free to do all kinds of 2D graphics.

201+relationships between forms, so you are free to do all kinds of 2D graphics.

202+-}

160collage : Int -> Int -> [Form] -> Element

203collage : Int -> Int -> [Form] -> Element

161collage = Native.Graphics.Collage.collage

204collage = Native.Graphics.Collage.collage

162

205

163

206

164type Path = [(number,number)]

207type Path = [(number,number)]

165

208

166−-- Create a path that follows a sequence of points.

209+{-| Create a path that follows a sequence of points. -}

167path : [(number,number)] -> Path

210path : [(number,number)] -> Path

168path ps = ps

211path ps = ps

169

212

170−-- Create a path along a given line segment.

213+{-| Create a path along a given line segment. -}

171segment : (number,number) -> (number,number) -> Path

214segment : (number,number) -> (number,number) -> Path

172segment p1 p2 = [p1,p2]

215segment p1 p2 = [p1,p2]

173

216

174type Shape = [(number,number)]

217type Shape = [(number,number)]

175

218

176−-- Create an arbitrary polygon by specifying its corners in order.

219+{-| Create an arbitrary polygon by specifying its corners in order.

177−-- `polygon` will automatically close all shapes, so the given list

220+`polygon` will automatically close all shapes, so the given list

178−-- of points does not need to start and end with the same position.

221+of points does not need to start and end with the same position.

222+-}

179polygon : [(number,number)] -> Shape

223polygon : [(number,number)] -> Shape

180polygon points = points

224polygon points = points

181

225

182−-- A rectangle with a given width and height.

226+{-| A rectangle with a given width and height. -}

183rect : number -> number -> Shape

227rect : number -> number -> Shape

184rect w h = let hw = w/2

228rect w h = let hw = w/2

185 hh = h/2

229 hh = h/2

186 in [ (0-hw,0-hh), (0-hw,hh), (hw,hh), (hw,0-hh) ]

230 in [ (0-hw,0-hh), (0-hw,hh), (hw,hh), (hw,0-hh) ]

187

231

188−-- A square with a given edge length.

232+{-| A square with a given edge length. -}

189square : number -> Shape

233square : number -> Shape

190square n = rect n n

234square n = rect n n

191

235

192−-- An oval with a given width and height.

236+{-| An oval with a given width and height. -}

193oval : number -> number -> Shape

237oval : number -> number -> Shape

194oval w h =

238oval w h =

195 let n = 50

239 let n = 50

@@ -199,15 +243,16 @@ oval w h =

199 f i = (hw * cos (t*i), hh * sin (t*i))

243 f i = (hw * cos (t*i), hh * sin (t*i))

200 in List.map f [0..n-1]

244 in List.map f [0..n-1]

201

245

202−-- A circle with a given radius.

246+{-| A circle with a given radius. -}

203circle : number -> Shape

247circle : number -> Shape

204circle r = oval (2*r) (2*r)

248circle r = oval (2*r) (2*r)

205

249

206−-- A regular polygon with N sides. The first argument specifies the number

250+{-| A regular polygon with N sides. The first argument specifies the number

207−-- of sides and the second is the radius. So to create a pentagon with radius

251+of sides and the second is the radius. So to create a pentagon with radius

208−-- 30 you would say:

252+30 you would say:

209−--

253+

210−-- ngon 5 30

254+ ngon 5 30

255+-}

211ngon : Int -> number -> Shape

256ngon : Int -> number -> Shape

212ngon n r =

257ngon n r =

213 let m = toFloat n

258 let m = toFloat n

libraries/Graphics/Element.elm+95−51

@@ -1,5 +1,41 @@

1−

2module Graphics.Element where

1module Graphics.Element where

2+{-| Graphical elements that snap together to build complex widgets and layouts.

3+Each Element is a rectangle with a known width and height, making them easy to

4+combine and position.

5+

6+# Images

7+@docs image, fittedImage, croppedImage, tiledImage

8+

9+# Styling

10+@docs width, height, size, color, opacity, link, tag

11+

12+# Inspection

13+@docs widthOf, heightOf, sizeOf

14+

15+# Layout

16+@docs flow, up, down, left, right, inward, outward

17+

18+## Layout Aliases

19+There are also some convenience functions for working

20+with `flow` in specific cases:

21+

22+@docs layers, above, below, beside

23+

24+# Positioning

25+@docs spacer, container

26+

27+## Specific Positions

28+

29+To create a `Position` you can use any of the built-in positions

30+which cover nine common positions.

31+@docs middle, midTop, midBottom, midLeft, midRight, topLeft, topRight,

32+ bottomLeft, bottomRight

33+

34+If you need more precision, you can create custom positions.

35+

36+@docs absolute, relative, middleAt, midTopAt, midBottomAt, midLeftAt,

37+ midRightAt, topLeftAt, topRightAt, bottomLeftAt, bottomRightAt

38+-}

3

39

4import open Basics

40import open Basics

5import Native.Utils

41import Native.Utils

@@ -22,19 +58,19 @@ type Properties = {

22

58

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

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

24

60

25−-- Get the width of an Element

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

26widthOf : Element -> Int

62widthOf : Element -> Int

27widthOf e = e.props.width

63widthOf e = e.props.width

28

64

29−-- Get the height of an Element

65+{-| Get the height of an Element -}

30heightOf : Element -> Int

66heightOf : Element -> Int

31heightOf e = e.props.height

67heightOf e = e.props.height

32

68

33−-- Get the width and height of an Element

69+{-| Get the width and height of an Element -}

34sizeOf : Element -> (Int,Int)

70sizeOf : Element -> (Int,Int)

35sizeOf e = (e.props.width, e.props.height)

71sizeOf e = (e.props.width, e.props.height)

36

72

37−-- Create an `Element` with a given width.

73+{-| Create an `Element` with a given width. -}

38width : Int -> Element -> Element

74width : Int -> Element -> Element

39width nw e =

75width nw e =

40 let p = e.props

76 let p = e.props

@@ -44,7 +80,7 @@ width nw e =

44 _ -> p

80 _ -> p

45 in { element=e.element, props={ props | width <- nw } }

81 in { element=e.element, props={ props | width <- nw } }

46

82

47−-- Create an `Element` with a given height.

83+{-| Create an `Element` with a given height. -}

48height : Int -> Element -> Element

84height : Int -> Element -> Element

49height nh e =

85height nh e =

50 let p = e.props

86 let p = e.props

@@ -53,30 +89,32 @@ height nh e =

53 _ -> p

89 _ -> p

54 in { element=e.element, props={ p | height <- nh} }

90 in { element=e.element, props={ p | height <- nh} }

55

91

56−-- Create an `Element` with a new width and height.

92+{-| Create an `Element` with a new width and height. -}

57size : Int -> Int -> Element -> Element

93size : Int -> Int -> Element -> Element

58size w h e = height h (width w e)

94size w h e = height h (width w e)

59

95

60−-- Create an `Element` with a given opacity. Opacity is a number between 0 and 1

96+{-| Create an `Element` with a given opacity. Opacity is a number between 0 and 1

61−-- where 0 means totally clear.

97+where 0 means totally clear.

98+-}

62opacity : Float -> Element -> Element

99opacity : Float -> Element -> Element

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

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

64

101

65−-- Create an `Element` with a given background color.

102+{-| Create an `Element` with a given background color. -}

66color : Color -> Element -> Element

103color : Color -> Element -> Element

67color c e = let p = e.props in

104color c e = let p = e.props in

68 { element = e.element

105 { element = e.element

69 , props = { p | color <- Just c}

106 , props = { p | color <- Just c}

70 }

107 }

71

108

72−-- Create an `Element` with a tag. This lets you link directly to it.

109+{-| Create an `Element` with a tag. This lets you link directly to it.

73−-- The element `(tag "all-about-badgers" thirdParagraph)` can be reached

110+The element `(tag "all-about-badgers" thirdParagraph)` can be reached

74−-- with a link lik this: `/facts-about-animals.elm#all-about-badgers`

111+with a link lik this: `/facts-about-animals.elm#all-about-badgers`

112+-}

75tag : String -> Element -> Element

113tag : String -> Element -> Element

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

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

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

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

78

116

79−-- Create an `Element` that is a hyper-link.

117+{-| Create an `Element` that is a hyper-link. -}

80link : String -> Element -> Element

118link : String -> Element -> Element

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

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

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

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

@@ -95,20 +133,22 @@ data ElementPrim

95

133

96data ImageStyle = Plain | Fitted | Cropped (Int,Int) | Tiled

134data ImageStyle = Plain | Fitted | Cropped (Int,Int) | Tiled

97

135

98−-- Create an image given a width, height, and image source.

136+{-| Create an image given a width, height, and image source. -}

99image : Int -> Int -> String -> Element

137image : Int -> Int -> String -> Element

100image w h src = newElement w h (Image Plain w h (JS.fromString src))

138image w h src = newElement w h (Image Plain w h (JS.fromString src))

101

139

102−-- Create a fitted image given a width, height, and image source.

140+{-| Create a fitted image given a width, height, and image source.

103−-- This will crop the picture to best fill the given dimensions.

141+This will crop the picture to best fill the given dimensions.

142+-}

104fittedImage : Int -> Int -> String -> Element

143fittedImage : Int -> Int -> String -> Element

105fittedImage w h src = newElement w h (Image Fitted w h (JS.fromString src))

144fittedImage w h src = newElement w h (Image Fitted w h (JS.fromString src))

106

145

107−-- Create a cropped image. Take a rectangle out of the picture starting

146+{-| Create a cropped image. Take a rectangle out of the picture starting

108−-- at the given top left coordinate. If you have a 140-by-140 image,

147+at the given top left coordinate. If you have a 140-by-140 image,

109−-- the following will cut a 100-by-100 square out of the middle of it.

148+the following will cut a 100-by-100 square out of the middle of it.

110−--

149+

111−-- croppedImage (20,20) 100 100 "yogi.jpg"

150+ croppedImage (20,20) 100 100 "yogi.jpg"

151+-}

112croppedImage : (Int,Int) -> Int -> Int -> String -> Element

152croppedImage : (Int,Int) -> Int -> Int -> String -> Element

113croppedImage pos w h src =

153croppedImage pos w h src =

114 newElement w h (Image (Cropped pos) w h (JS.fromString src))

154 newElement w h (Image (Cropped pos) w h (JS.fromString src))

@@ -117,38 +157,38 @@ tiledImage : Int -> Int -> String -> Element

117tiledImage w h src =

157tiledImage w h src =

118 newElement w h (Image Tiled w h (JS.fromString src))

158 newElement w h (Image Tiled w h (JS.fromString src))

119

159

120−markdown : Element

121−markdown = Native.Utils.undefined

122−

123data Three = P | Z | N

160data Three = P | Z | N

124data Pos = Absolute Int | Relative Float

161data Pos = Absolute Int | Relative Float

125type Position = { horizontal : Three, vertical : Three, x : Pos, y : Pos }

162type Position = { horizontal : Three, vertical : Three, x : Pos, y : Pos }

126

163

127−-- Put an element in a container. This lets you position the element really

164+{-| Put an element in a container. This lets you position the element really

128−-- easily, and there are tons of ways to set the `Position`.

165+easily, and there are tons of ways to set the `Position`.

129−-- To center `element` exactly in a 300-by-300 square you would say:

166+To center `element` exactly in a 300-by-300 square you would say:

130−--

167+

131−-- container 300 300 middle element

168+ container 300 300 middle element

132−--

169+

133−-- By setting the color of the container, you can create borders.

170+By setting the color of the container, you can create borders.

171+-}

134container : Int -> Int -> Position -> Element -> Element

172container : Int -> Int -> Position -> Element -> Element

135container w h pos e = newElement w h (Container pos e)

173container w h pos e = newElement w h (Container pos e)

136

174

137−-- Create an empty box. This is useful for getting your spacing right and

175+{-| Create an empty box. This is useful for getting your spacing right and

138−-- for making borders.

176+for making borders.

177+-}

139spacer : Int -> Int -> Element

178spacer : Int -> Int -> Element

140spacer w h = newElement w h Spacer

179spacer w h = newElement w h Spacer

141

180

143

182

144−-- Have a list of elements flow in a particular direction.

183+{-| Have a list of elements flow in a particular direction.

145−-- The `Direction` starts from the first element in the list.

184+The `Direction` starts from the first element in the list.

146−--

185+

147−-- flow right [a,b,c]

186+ flow right [a,b,c]

148−--

187+

149−-- +---+---+---+

188+ +---+---+---+

150−-- | a | b | c |

189+ | a | b | c |

151−-- +---+---+---+

190+ +---+---+---+

191+-}

152flow : Direction -> [Element] -> Element

192flow : Direction -> [Element] -> Element

153flow dir es =

193flow dir es =

154 let ws = List.map widthOf es

194 let ws = List.map widthOf es

@@ -164,33 +204,37 @@ flow dir es =

164 DIn -> newFlow (List.maximum ws) (List.maximum hs)

204 DIn -> newFlow (List.maximum ws) (List.maximum hs)

165 DOut -> newFlow (List.maximum ws) (List.maximum hs)

205 DOut -> newFlow (List.maximum ws) (List.maximum hs)

166

206

167−-- Stack elements vertically. To put `a` above `b` you would say:

207+{-| Stack elements vertically. To put `a` above `b` you would say:

168−--

208+

169−-- a `above` b

209+ a `above` b

210+-}

170above : Element -> Element -> Element

211above : Element -> Element -> Element

171above hi lo =

212above hi lo =

172 newElement (max (widthOf hi) (widthOf lo))

213 newElement (max (widthOf hi) (widthOf lo))

173 (heightOf hi + heightOf lo)

214 (heightOf hi + heightOf lo)

174 (Flow DDown [hi,lo])

215 (Flow DDown [hi,lo])

175

216

176−-- Stack elements vertically. To put `a` below `b` you would say:

217+{-| Stack elements vertically. To put `a` below `b` you would say:

177−--

218+

178−-- a `below` b

219+ a `below` b

220+-}

179below : Element -> Element -> Element

221below : Element -> Element -> Element

180below lo hi =

222below lo hi =

181 newElement (max (widthOf hi) (widthOf lo))

223 newElement (max (widthOf hi) (widthOf lo))

182 (heightOf hi + heightOf lo)

224 (heightOf hi + heightOf lo)

183 (Flow DDown [hi,lo])

225 (Flow DDown [hi,lo])

184

226

185−-- Put elements beside each other horizontally.

227+{-| Put elements beside each other horizontally.

228+-}

186beside : Element -> Element -> Element

229beside : Element -> Element -> Element

187beside lft rht =

230beside lft rht =

188 newElement (widthOf lft + widthOf rht)

231 newElement (widthOf lft + widthOf rht)

189 (max (heightOf lft) (heightOf rht))

232 (max (heightOf lft) (heightOf rht))

190 (Flow right [lft,rht])

233 (Flow right [lft,rht])

191

234

192−-- Layer elements on top of each other, starting from the bottom.

235+{-| Layer elements on top of each other, starting from the bottom.

193−-- `(layers == flow outward)`

236+`(layers == flow outward)`

237+-}

194layers : [Element] -> Element

238layers : [Element] -> Element

195layers es =

239layers es =

196 let ws = List.map widthOf es

240 let ws = List.map widthOf es

libraries/Graphics/Input.elm+115−76

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

1−

2module Graphics.Input where

1module Graphics.Input where

3

2

3+{-| This module is for creating standard input widgets such as buttons and

4+text boxes. In general, functions in this library return a signal representing

5+events from the user.

6+

7+The simplest inputs are *one-way inputs*, meaning the user can update

8+them, but the programmer cannot. If you need to update an input from

9+within the program you want the slightly more complex *two-way inputs*.

10+This document will always show the one-way inputs first, *then* the

11+two-way inputs.

12+

13+# Buttons

14+@docs button, customButton, buttons, customButtons

15+

16+# Fields

17+@docs field, password, email, fields, FieldState, emptyFieldState

18+

19+# Checkboxes

20+@docs checkbox, checkboxes

21+

22+# Drop Downs

23+@docs stringDropDown, dropDown

24+

25+# Mouse Hover

26+@docs hoverable, hoverables

27+-}

28+

4import Basics (String)

29import Basics (String)

5import Signal (Signal,lift,dropRepeats)

30import Signal (Signal,lift,dropRepeats)

6import Native.Graphics.Input

31import Native.Graphics.Input

@@ -11,116 +36,127 @@ import JavaScript (JSString)

11

36

12id x = x

37id x = x

13

38

14−-- Create a group of buttons.

39+{-| Create a group of buttons.

15−--

40+

16−-- * The first argument is the default value of the `events` signal.

41+ * The first argument is the default value of the `events` signal.

17−-- * The `events` signal represents all of the activity in this group

42+ * The `events` signal represents all of the activity in this group

18−-- of buttons.

43+ of buttons.

19−-- * The `button` function creates a button

44+ * The `button` function creates a button

20−-- with the given name, like “Submit” or “Cancel”.

45+ with the given name, like “Submit” or “Cancel”.

21−-- The `a` value is sent to `events` whenever the button is pressed.

46+ The `a` value is sent to `events` whenever the button is pressed.

47+-}

22buttons : a -> { events : Signal a,

48buttons : a -> { events : Signal a,

23 button : a -> String -> Element }

49 button : a -> String -> Element }

24buttons = Native.Graphics.Input.buttons

50buttons = Native.Graphics.Input.buttons

25

51

26−-- Create a button with a given label. The result is an `Element` and

52+{-| Create a button with a given label. The result is an `Element` and

27−-- a signal of units. This signal triggers whenever the button is pressed.

53+a signal of units. This signal triggers whenever the button is pressed.

54+-}

28button : String -> (Element, Signal ())

55button : String -> (Element, Signal ())

29button txt =

56button txt =

30 let pool = buttons ()

57 let pool = buttons ()

31 in (pool.button () txt, pool.events)

58 in (pool.button () txt, pool.events)

32

59

33−-- Create a group of custom buttons.

60+{-| Create a group of custom buttons.

34−--

61+

35−-- * The first argument is the default value of the `events` signal.

62+ * The first argument is the default value of the `events` signal.

36−-- * The `events` signal represents all of the activity in this group

63+ * The `events` signal represents all of the activity in this group

37−-- of custom buttons.

64+ of custom buttons.

38−-- * The `customButton` function creates a button with three different visual

65+ * The `customButton` function creates a button with three different visual

39−-- states, one for up, hovering, and down. The resulting button has dimensions

66+ states, one for up, hovering, and down. The resulting button has dimensions

40−-- large enough to fit all three possible `Elements`.

67+ large enough to fit all three possible `Elements`.

41−-- The `a` value is sent to `events` whenever the button is pressed.

68+ The `a` value is sent to `events` whenever the button is pressed.

69+-}

42customButtons : a -> { events : Signal a,

70customButtons : a -> { events : Signal a,

43 customButton : a -> Element -> Element -> Element -> Element }

71 customButton : a -> Element -> Element -> Element -> Element }

44customButtons = Native.Graphics.Input.customButtons

72customButtons = Native.Graphics.Input.customButtons

45

73

46−-- Create a button with custom states for up, hovering, and down

74+{-| Create a button with custom states for up, hovering, and down

47−-- (given in that order). The result is an `Element` and

75+(given in that order). The result is an `Element` and a signal of

48−-- a signal of units. This signal triggers whenever the button is pressed.

76+units. This signal triggers whenever the button is pressed.

77+-}

49customButton : Element -> Element -> Element -> (Element, Signal ())

78customButton : Element -> Element -> Element -> (Element, Signal ())

50customButton up hover down =

79customButton up hover down =

51 let pool = customButtons ()

80 let pool = customButtons ()

52 in (pool.customButton () up hover down, pool.events)

81 in (pool.customButton () up hover down, pool.events)

53

82

54−-- Create a group of checkboxes.

83+{-| Create a group of checkboxes.

55−--

84+

56−-- * The first argument is the default value of the `events` signal.

85+ * The first argument is the default value of the `events` signal.

57−-- * The `events` signal represents all of the activity in this group

86+ * The `events` signal represents all of the activity in this group

58−-- of checkboxes.

87+ of checkboxes.

59−-- * The `checkbox` function creates a

88+ * The `checkbox` function creates a

60−-- checkbox with a given state. The `(Bool -> a)` function is used

89+ checkbox with a given state. The `(Bool -> a)` function is used

61−-- when the checkbox is modified. It takes the new state and turns

90+ when the checkbox is modified. It takes the new state and turns

62−-- it into a value that can be sent to `events`. For example, this

91+ it into a value that can be sent to `events`. For example, this

63−-- lets you add an ID to distinguish between checkboxes.

92+ lets you add an ID to distinguish between checkboxes.

93+-}

64checkboxes : a -> { events : Signal a,

94checkboxes : a -> { events : Signal a,

65 checkbox : (Bool -> a) -> Bool -> Element }

95 checkbox : (Bool -> a) -> Bool -> Element }

66checkboxes = Native.Graphics.Input.checkboxes

96checkboxes = Native.Graphics.Input.checkboxes

67

97

68−-- Create a checkbox with a given start state. Unlike `button`, this result

98+{-| Create a checkbox with a given start state. Unlike `button`, this

69−-- is a *signal* of elements. That is because a checkbox has state that

99+result is a *signal* of elements. That is because a checkbox has state

70−-- updates based on user input.

100+that updates based on user input. The boolean signal represents the

71−-- The boolean signal represents the current state of the checkbox.

101+current state of the checkbox.

102+-}

72checkbox : Bool -> (Signal Element, Signal Bool)

103checkbox : Bool -> (Signal Element, Signal Bool)

73checkbox b =

104checkbox b =

74 let cbs = checkboxes b

105 let cbs = checkboxes b

75 in (lift (cbs.checkbox id) cbs.events, cbs.events)

106 in (lift (cbs.checkbox id) cbs.events, cbs.events)

76

107

77−-- Detect when the mouse is hovering over some elements. This

108+{-| Detect when the mouse is hovering over some elements. This

78−-- allows you to create and destroy elements dynamically and still

109+allows you to create and destroy elements dynamically and still

79−-- detect hover information.

110+detect hover information.

111+-}

80hoverables : a -> { events : Signal a,

112hoverables : a -> { events : Signal a,

81 hoverable : (Bool -> a) -> Element -> Element }

113 hoverable : (Bool -> a) -> Element -> Element }

82hoverables = Native.Graphics.Input.hoverables

114hoverables = Native.Graphics.Input.hoverables

83

115

84−-- Detect when the mouse is hovering over a specifici `Element`.

116+{-| Detect when the mouse is hovering over a specifici `Element`. -}

85hoverable : Element -> (Element, Signal Bool)

117hoverable : Element -> (Element, Signal Bool)

86hoverable elem =

118hoverable elem =

87 let pool = hoverables False

119 let pool = hoverables False

88 in (pool.hoverable id elem, pool.events)

120 in (pool.hoverable id elem, pool.events)

89

121

90−-- Represents the current state of a text field. The `string` represents the

122+{-| Represents the current state of a text field. The `string` represents the

91−-- characters filling the text field. The `selectionStart` and `selectionEnd`

123+characters filling the text field. The `selectionStart` and `selectionEnd`

92−-- values represent what the user has selected with their mouse or keyboard.

124+values represent what the user has selected with their mouse or keyboard.

93−-- For example:

125+For example:

94−--

126+

95−-- { string="She sells sea shells", selectionStart=3, selectionEnd=0 }

127+ { string="She sells sea shells", selectionStart=3, selectionEnd=0 }

96−--

128+

97−-- This means the user highlighted the substring `"She"` backwards.

129+This means the user highlighted the substring `"She"` backwards.

130+-}

98type FieldState = { string:String, selectionStart:Int, selectionEnd:Int }

131type FieldState = { string:String, selectionStart:Int, selectionEnd:Int }

99

132

100−-- Create a group of text input fields.

133+{-| Create a group of text input fields.

101−--

134+

102−-- * The first argument is the default value of the `events` signal.

135+ * The first argument is the default value of the `events` signal.

103−-- * The `events` signal represents all of the activity in this group

136+ * The `events` signal represents all of the activity in this group

104−-- of text fields.

137+ of text fields.

105−-- * The `field` function creates a

138+ * The `field` function creates a

106−-- field with the given ghost text and initial field state.

139+ field with the given ghost text and initial field state.

107−-- When the field is modified, the `(FieldState -> a)` function

140+ When the field is modified, the `(FieldState -> a)` function

108−-- takes the new state and turns

141+ takes the new state and turns

109−-- it into a value that can be sent to `events`. For example, this

142+ it into a value that can be sent to `events`. For example, this

110−-- lets you add an ID to distinguish between input fields.

143+ lets you add an ID to distinguish between input fields.

144+-}

111fields : a -> { events : Signal a,

145fields : a -> { events : Signal a,

112 field : (FieldState -> a) -> String -> FieldState -> Element }

146 field : (FieldState -> a) -> String -> FieldState -> Element }

113fields = Native.Graphics.Input.fields

147fields = Native.Graphics.Input.fields

114

148

115−-- The empty field state:

149+{-| The empty field state:

116−--

150+

117−-- { string="", selectionStart=0, selectionEnd=0 }

151+ { string="", selectionStart=0, selectionEnd=0 }

152+-}

118emptyFieldState : FieldState

153emptyFieldState : FieldState

119emptyFieldState = { string="", selectionStart=0, selectionEnd=0 }

154emptyFieldState = { string="", selectionStart=0, selectionEnd=0 }

120

155

121−-- Create a field with the given default text. The output is an element that

156+{-| Create a field with the given default text. The output is an element

122−-- updates to match the user input and a signal of strings representing the

157+that updates to match the user input and a signal of strings representing

123−-- content of the field.

158+the content of the field.

159+-}

124field : String -> (Signal Element, Signal String)

160field : String -> (Signal Element, Signal String)

125field placeHolder =

161field placeHolder =

126 let tfs = fields emptyFieldState

162 let tfs = fields emptyFieldState

@@ -128,7 +164,7 @@ field placeHolder =

128 in (lift (tfs.field id placeHolder) changes,

164 in (lift (tfs.field id placeHolder) changes,

129 dropRepeats (lift .string changes))

165 dropRepeats (lift .string changes))

130

166

131−-- Same as `field` but the UI element blocks out each characters.

167+{-| Same as `field` but the UI element blocks out each characters. -}

132password : String -> (Signal Element, Signal String)

168password : String -> (Signal Element, Signal String)

133password placeHolder =

169password placeHolder =

134 let tfs = Native.Graphics.Input.passwords emptyFieldState

170 let tfs = Native.Graphics.Input.passwords emptyFieldState

@@ -136,9 +172,10 @@ password placeHolder =

136 in (lift (tfs.field id placeHolder) changes,

172 in (lift (tfs.field id placeHolder) changes,

137 dropRepeats (lift .string changes))

173 dropRepeats (lift .string changes))

138

174

139−-- Same as `field` but it adds an annotation that this field is for email

175+{-| Same as `field` but it adds an annotation that this field is for email

140−-- addresses. This is helpful for auto-complete and for mobile users who may

176+addresses. This is helpful for auto-complete and for mobile users who may

141−-- get a custom keyboard with an `@` and `.com` button.

177+get a custom keyboard with an `@` and `.com` button.

178+-}

142email : String -> (Signal Element, Signal String)

179email : String -> (Signal Element, Signal String)

143email placeHolder =

180email placeHolder =

144 let tfs = Native.Graphics.Input.emails emptyFieldState

181 let tfs = Native.Graphics.Input.emails emptyFieldState

@@ -146,15 +183,17 @@ email placeHolder =

146 in (lift (tfs.field id placeHolder) changes,

183 in (lift (tfs.field id placeHolder) changes,

147 dropRepeats (lift .string changes))

184 dropRepeats (lift .string changes))

148

185

149−-- Create a drop-down menu. When the user selects a string,

186+{-| Create a drop-down menu. When the user selects a string,

150−-- the current state of the drop-down is set to the associated

187+the current state of the drop-down is set to the associated

151−-- value. This lets you avoid manually mapping the string onto

188+value. This lets you avoid manually mapping the string onto

152−-- functions and values.

189+functions and values.

190+-}

153dropDown : [(String,a)] -> (Signal Element, Signal a)

191dropDown : [(String,a)] -> (Signal Element, Signal a)

154dropDown = Native.Graphics.Input.dropDown

192dropDown = Native.Graphics.Input.dropDown

155

193

156−-- Create a drop-down menu for selecting strings. The resulting

194+{-| Create a drop-down menu for selecting strings. The resulting

157−-- signal of strings represents the string that is currently selected.

195+signal of strings represents the string that is currently selected.

196+-}

158stringDropDown : [String] -> (Signal Element, Signal String)

197stringDropDown : [String] -> (Signal Element, Signal String)

159stringDropDown strs =

198stringDropDown strs =

160 dropDown (List.map (\s -> (s,s)) strs)

199 dropDown (List.map (\s -> (s,s)) strs)

libraries/Http.elm+28−17

@@ -1,15 +1,25 @@

1−-- A library for asynchronous HTTP requests (AJAX). See the

2−-- [WebSocket](http://elm-lang.org/docs/WebSocket.elm) library if

3−-- you have very strict latency requirements.

4−

5module Http where

1module Http where

6

2

7−import open Basics

3+{-| A library for asynchronous HTTP requests. See the

4+[WebSocket](http://elm-lang.org/docs/WebSocket.elm) library if

5+you have very strict latency requirements.

6+

7+# Sending Requests

8+@docs send, sendGet

9+

10+# Creating Requests

11+@docs get, post, request

12+

13+# Responses

14+@docs Response

15+-}

16+

8import open Signal

17import open Signal

9import Native.Http

18import Native.Http

10

19

11−-- The datatype for responses. Success contains only the returned message.

20+{-| The datatype for responses. Success contains only the returned message.

12−-- Failures contain both an error code and an error message.

21+Failures contain both an error code and an error message.

22+-}

13data Response a = Success a | Waiting | Failure Int String

23data Response a = Success a | Waiting | Failure Int String

14

24

15type Request a = {

25type Request a = {

@@ -19,27 +29,28 @@ type Request a = {

19 headers : [(String,String)]

29 headers : [(String,String)]

20 }

30 }

21

31

22−-- Create a customized request. Arguments are request type (get, post, put,

32+{-| Create a customized request. Arguments are request type (get, post, put,

23−-- delete, etc.), target url, data, and a list of additional headers.

33+delete, etc.), target url, data, and a list of additional headers.

34+-}

24request : String -> String -> String -> [(String,String)] -> Request String

35request : String -> String -> String -> [(String,String)] -> Request String

25request = Request

36request = Request

26

37

27−-- Create a GET request to the given url.

38+{-| Create a GET request to the given url. -}

28get : String -> Request String

39get : String -> Request String

29get url = Request "GET" url "" []

40get url = Request "GET" url "" []

30

41

31−-- Create a POST request to the given url, carrying the given data.

42+{-| Create a POST request to the given url, carrying the given data. -}

32post : String -> String -> Request String

43post : String -> String -> Request String

33post url body = Request "POST" url body []

44post url body = Request "POST" url body []

34

45

35−

46+{-| Performs an HTTP request with the given requests. Produces a signal

36−-- Performs an HTTP request with the given requests. Produces a signal

47+that carries the responses.

37−-- that carries the responses.

48+-}

38send : Signal (Request a) -> Signal (Response String)

49send : Signal (Request a) -> Signal (Response String)

39send = Native.Http.send

50send = Native.Http.send

40

51

41−-- Performs an HTTP GET request with the given urls. Produces a signal

52+{-| Performs an HTTP GET request with the given urls. Produces a signal

42−-- that carries the responses.

53+that carries the responses.

54+-}

43sendGet : Signal String -> Signal (Response String)

55sendGet : Signal String -> Signal (Response String)

44sendGet reqs = send (lift get reqs)

56sendGet reqs = send (lift get reqs)

45−

libraries/JavaScript.elm+22−8

@@ -1,8 +1,22 @@

1

2module JavaScript where

3

4+{-|This library does basic conversions between Elm and JS values. This allows

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

6+integration.

7+

8+# Javascript to Elm

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

10+

11+# JavaScript from Elm

12+@docs fromString, fromInt, fromFloat, fromBool fromList

13+-}

14+{-

15+# DOM Nodes and Elements

16+@docs toElement, fromElement

17+-}

18+

4import Native.JavaScript

19import Native.JavaScript

5−import open Basics

6

20

7data JSNumber = JSNumber

21data JSNumber = JSNumber

8data JSBool = JSBool

22data JSBool = JSBool

@@ -11,7 +25,7 @@ data JSArray a = JSArray a

11data JSDomNode = JSDomNode

25data JSDomNode = JSDomNode

12data JSObject = JSObject

26data JSObject = JSObject

13

27

14−-- Requires that the input array be uniform (all members have the same type)

28+{-| Requires that the input array be uniform (all members have the same type) -}

15toList : JSArray a -> [a]

29toList : JSArray a -> [a]

16toList = Native.JavaScript.toList

30toList = Native.JavaScript.toList

17

31

@@ -28,7 +42,7 @@ toString : JSString -> String

28toString = Native.JavaScript.toString

42toString = Native.JavaScript.toString

29

43

30

44

31−-- Produces a uniform JavaScript array with all members of the same type.

45+{-| Produces a uniform JavaScript array with all members of the same type. -}

32fromList : [a] -> JSArray a

46fromList : [a] -> JSArray a

33fromList = Native.JavaScript.fromList

47fromList = Native.JavaScript.fromList

34

48

@@ -44,13 +58,13 @@ fromBool = Native.JavaScript.fromBool

44fromString : String -> JSString

58fromString : String -> JSString

45fromString = Native.JavaScript.fromString

59fromString = Native.JavaScript.fromString

46

60

47−{--

61+{-

48−-- Turn an `Element` into a plain old DOM node.

62+{-| Turn an `Element` into a DOM node. -}

49fromElement : Element -> JSDomNode

63fromElement : Element -> JSDomNode

50fromElement = Native.JavaScript.fromElement

64fromElement = Native.JavaScript.fromElement

51

65

52−-- Turn a DOM node into an `Element`. You can resize the node

66+{-| Turn a DOM node into an `Element`. You can resize the node

53−-- using the normal `width` and `height` functions.

67+using the normal `width` and `height` functions. -}

54toElement : Int -> Int -> JSDomNode -> Element

68toElement : Int -> Int -> JSDomNode -> Element

55toElement = Native.JavaScript.toElement

69toElement = Native.JavaScript.toElement

56−--}

70+-}

libraries/JavaScript/Experimental.elm+31−22

@@ -1,32 +1,41 @@

1−

2module JavaScript.Experimental where

1module JavaScript.Experimental where

2+{-| A pair of very experimental functions for converting between

3+Elm records and JavaScript objects. It currently uses a best effort

4+conversion that can cause runtime errors. This API should change and

5+improve as we find its key failings.

6+

7+# Converting between Elm records and JS Objects

8+@docs toRecord, fromRecord

9+-}

3

10

4import JavaScript (JSObject)

11import JavaScript (JSObject)

5import Native.JavaScript

12import Native.JavaScript

6

13

7−-- Turn arbitrary JavaScript objects into Elm records.

14+{-| Turn arbitrary JavaScript objects into Elm records.

8−-- Arrays are converted into lists, nested objects are allowed.

15+Arrays are converted into lists, nested objects are allowed.

9−-- No `null` values or non-homogeneous arrays.

16+No `null` values or non-homogeneous arrays.

10−--

17+

11−-- -- OK objects

18+ -- OK objects

12−-- { student:"Steve", scores:[83,94,99,72] }

19+ { student:"Steve", scores:[83,94,99,72] }

13−-- { errorLevel:10, critical:true }

20+ { errorLevel:10, critical:true }

14−--

21+

15−-- -- BAD objects

22+ -- BAD objects

16−-- { answer:null }

23+ { answer:null }

17−-- { info:[true,42,'what'] }

24+ { info:[true,42,'what'] }

25+-}

18toRecord : JSObject -> a

26toRecord : JSObject -> a

19toRecord = Native.JavaScript.toRecord

27toRecord = Native.JavaScript.toRecord

20

28

21−-- Turn arbitrary Elm records into JavaScript objects.

29+{-| Turn arbitrary Elm records into JavaScript objects.

22−-- Lists become arrays, nested records are allowed. No ADTs.

30+Lists become arrays, nested records are allowed. No ADTs.

23−--

31+

24−-- -- OK records

32+ -- OK records

25−-- { student="Steve", scores=[83,94,99,72] }

33+ { student="Steve", scores=[83,94,99,72] }

26−-- { errorLevel=10, critical=True }

34+ { errorLevel=10, critical=True }

27−--

35+

28−-- -- BAD records

36+ -- BAD records

29−-- { answer = Nothing }

37+ { answer = Nothing }

30−-- { result = Left "An error occurred" }

38+ { result = Left "An error occurred" }

39+-}

31fromRecord : a -> JSObject

40fromRecord : a -> JSObject

32fromRecord = Native.JavaScript.fromRecord

41fromRecord = Native.JavaScript.fromRecord

libraries/Json.elm+51−39

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

1

2−-- TOOD: Evan please review texts

3−

4module Json where

2module Json where

5

3

4+{-| Library for working with [JSON](https://en.wikipedia.org/wiki/JSON) values.

5+

6+# Strings

7+@docs fromString, toString

8+

9+# JS Strings

10+@docs fromJSString, toJSString

11+

12+# JS Objects

13+@docs fromJSObject, toJSObject

14+

15+-}

16+

6import open Basics

17import open Basics

7import Dict

18import Dict

8import Maybe (Maybe)

19import Maybe (Maybe)

@@ -10,9 +21,9 @@ import JavaScript as JS

10import Native.Json

21import Native.Json

11import JavaScript (JSObject, JSString)

22import JavaScript (JSObject, JSString)

12

23

13−-- This datatype can represent all valid values that can be held in a JSON

24+{-| This datatype can represent all valid values that can be held in a JSON

14−-- object. In Elm, a proper JSON object is represented as a (Dict String JsonValue)

25+object. In Elm, a proper JSON object is represented as a (Dict String JsonValue)

15−-- which is a mapping from strings to Json Values.

26+which is a mapping from strings to Json Values. -}

16data JsonValue

27data JsonValue

17 = String String

28 = String String

18 | Number Float

29 | Number Float

@@ -24,42 +35,43 @@ data JsonValue

24

35

25-- String Converters

36-- String Converters

26

37

27−-- Convert a `JsonValue` into a prettified string.

38+{-| Convert a `JsonValue` into a prettified string.

28−-- The first argument is a separator token (e.g. \" \", \"\\n\", etc.) that will

39+The first argument is a separator token (e.g. \" \", \"\\n\", etc.) that will

29−-- be used for indentation in the prettified string version of the JSON.

40+be used for indentation in the prettified string version of the JSON. -}

30toString : String -> JsonValue -> String

41toString : String -> JsonValue -> String

31toString sep v = JS.toString (Native.Json.toJSString sep v)

42toString sep v = JS.toString (Native.Json.toJSString sep v)

32

43

33−-- Convert a proper JSON object into a JavaScript string.

44+{-| Convert a proper JSON object into a JavaScript string.

34−-- Note that the type JSString seen here is not the same as the type constructor

45+Note that the type JSString seen here is not the same as the type constructor

35−-- JsonString used elsewhere in this module.

46+JsonString used elsewhere in this module. -}

36toJSString : String -> JsonValue -> JSString

47toJSString : String -> JsonValue -> JSString

37toJSString = Native.Json.toJSString

48toJSString = Native.Json.toJSString

38

49

39−-- Parse a string representation of a proper JSON object into

50+{-| Parse a string representation of a proper JSON object into

40−-- its Elm representation.

51+its Elm representation. -}

41fromString : String -> Maybe JsonValue

52fromString : String -> Maybe JsonValue

42fromString s = Native.Json.fromJSString (JS.fromString s)

53fromString s = Native.Json.fromJSString (JS.fromString s)

43

54

44−-- Parse a JavaScript string representation of a proper JSON object into

55+{-| Parse a JavaScript string representation of a proper JSON object into

45−-- its Elm representation.

56+its Elm representation. -}

46fromJSString : JSString -> Maybe JsonValue

57fromJSString : JSString -> Maybe JsonValue

47fromJSString = Native.Json.fromJSString

58fromJSString = Native.Json.fromJSString

48

59

49−-- Convert a JS object into a `JsonValue`.

60+{-| Convert a JS object into a `JsonValue`. -}

50fromJSObject : JSObject -> JsonValue

61fromJSObject : JSObject -> JsonValue

51fromJSObject = Native.Json.fromJSObject

62fromJSObject = Native.Json.fromJSObject

52

63

53−-- Convert a `JsonValue` into a `JSObject`. Paired with the

64+{-| Convert a `JsonValue` into a `JSObject`. Paired with the

54−-- [`JavaScript.Experimental` library](/docs/JavaScript/Experimental.elm),

65+[`JavaScript.Experimental` library](/docs/JavaScript/Experimental.elm),

55−-- This lets you convert strings into Elm records:

66+This lets you convert strings into Elm records:

56−--

67+

57−-- import JavaScript.Experimental as JS

68+ import JavaScript.Experimental as JS

58−--

69+

59−-- stringToRecord str =

70+ stringToRecord str =

60−-- case fromString str of

71+ case fromString str of

61−-- Just jsonValue -> Just (JS.toRecord (toJSObject jsonValue))

72+ Just jsonValue -> Just (JS.toRecord (toJSObject jsonValue))

62−-- Nothing -> Nothing

73+ Nothing -> Nothing

74+-}

63toJSObject : JsonValue -> JSObject

75toJSObject : JsonValue -> JSObject

64toJSObject = Native.Json.toJSObject

76toJSObject = Native.Json.toJSObject

65

77

@@ -83,8 +95,8 @@ toJSObject = Native.Json.toJSObject

83

95

84 -- Extract Elm values from dictionaries of Json values

96 -- Extract Elm values from dictionaries of Json values

85

97

86− -- Find a value in a Json Object using the passed get function. If the key is

98+ {-| Find a value in a Json Object using the passed get function. If the key is

87− -- not found, this returns the given default/base value.

99+ not found, this returns the given default/base value. -}

88 find get base =

100 find get base =

89 let f key dict =

101 let f key dict =

90 case Dict.lookup key dict of

102 case Dict.lookup key dict of

@@ -92,28 +104,28 @@ toJSObject = Native.Json.toJSObject

92 Just v -> get v

104 Just v -> get v

93 in f

105 in f

94

106

95− -- Find a string value in an Elm Json object. If the key is not found or the

107+ {-| Find a string value in an Elm Json object. If the key is not found or the

96− -- value found is not a string, this returns the empty string.

108+ value found is not a string, this returns the empty string. -}

97 findString : String -> Object -> String

109 findString : String -> Object -> String

98 findString = find string ""

110 findString = find string ""

99

111

100− -- Find a number value in an Elm Json object. If the key is not found or the

112+ {-| Find a number value in an Elm Json object. If the key is not found or the

101− -- value found is not a number, this returns 0

113+ value found is not a number, this returns 0 -}

102 findNumber : String -> Object -> Float

114 findNumber : String -> Object -> Float

103 findNumber = find number 0

115 findNumber = find number 0

104

116

105− -- Find a boolean value in an Elm Json object. If the key is not found or the

117+ {-| Find a boolean value in an Elm Json object. If the key is not found or the

106− -- value found is not a boolean, this returns the False.

118+ value found is not a boolean, this returns the False. -}

107 findBoolean : String -> Object -> Bool

119 findBoolean : String -> Object -> Bool

108 findBoolean = find boolean False

120 findBoolean = find boolean False

109

121

110− -- Find an array value in an Elm Json object. If the key is not found or the

122+ {-| Find an array value in an Elm Json object. If the key is not found or the

111− -- value found is not an array, this returns an empty list.

123+ value found is not an array, this returns an empty list. -}

112 findArray : String -> Object -> [JsonValue]

124 findArray : String -> Object -> [JsonValue]

113 findArray = find array []

125 findArray = find array []

114

126

115− -- Find an object value in an Elm Json object. If the key is not found or the

127+ {-| Find an object value in an Elm Json object. If the key is not found or the

116− -- value found is not an object, this returns an empty object.

128+ value found is not an object, this returns an empty object. -}

117 findObject : String -> Object -> Object

129 findObject : String -> Object -> Object

118 findObject = find object Dict.empty

130 findObject = find object Dict.empty

119− --}

131+ --}

libraries/Keyboard.elm+42−22

@@ -1,57 +1,77 @@

1module Keyboard where

2

3+{-| Library for working with keyboard input.

4+

5+# Representing Keys

6+@docs KeyCode

7+

8+# Directions

9+@docs arrows, wasd, directions

10+

11+# Specific Keys

12+@docs shift, enter, space, ctrl

13+

14+# General Keypresses

15+@docs isDown, keysDown, lastPressed

16+

17+-}

18+

3import Signal (Signal)

19import Signal (Signal)

4import Native.Keyboard

20import Native.Keyboard

5

21

6−-- Type alias to make it clearer what integers are supposed to represent

22+{-| Type alias to make it clearer what integers are supposed to represent

7−-- in this library. Use [`Char.toCode`](docs/Char.elm#toCode) and

23+in this library. Use [`Char.toCode`](docs/Char.elm#toCode) and

8−-- [`Char.fromCode`](/docs/Char.elm#fromCode) to convert key codes to characters.

24+[`Char.fromCode`](/docs/Char.elm#fromCode) to convert key codes to characters.

25+Use the uppercase character with `toCode`.

26+-}

9type KeyCode = Int

27type KeyCode = Int

10

28

11−-- Custom key directions so that you can support different locales.

29+{-| Custom key directions to support different locales. The order is up, down,

12−-- The plan is to have a locale independent version of this function

30+left, right.

13−-- that uses the physical location of keys, but I don't know how to do it.

31+-}

14directions : KeyCode -> KeyCode -> KeyCode -> KeyCode -> Signal { x:Int, y:Int }

32directions : KeyCode -> KeyCode -> KeyCode -> KeyCode -> Signal { x:Int, y:Int }

15directions = Native.Keyboard.directions

33directions = Native.Keyboard.directions

16

34

17−-- A signal of records indicating which arrow keys are pressed.

35+{-| A signal of records indicating which arrow keys are pressed.

18−--

36+

19−-- `{ x = 0, y = 0 }` when pressing no arrows.<br>

37+`{ x = 0, y = 0 }` when pressing no arrows.<br>

20−-- `{ x =-1, y = 0 }` when pressing the left arrow.<br>

38+`{ x =-1, y = 0 }` when pressing the left arrow.<br>

21−-- `{ x = 1, y = 1 }` when pressing the up and right arrows.<br>

39+`{ x = 1, y = 1 }` when pressing the up and right arrows.<br>

22−-- `{ x = 0, y =-1 }` when pressing the down, left, and right arrows.

40+`{ x = 0, y =-1 }` when pressing the down, left, and right arrows.

41+-}

23arrows : Signal { x:Int, y:Int }

42arrows : Signal { x:Int, y:Int }

24arrows = directions 38 40 37 39

43arrows = directions 38 40 37 39

25

44

26−-- Just like the arrows signal, but this uses keys w, a, s, and d,

45+{-| Just like the arrows signal, but this uses keys w, a, s, and d,

27−-- which are common controls for many computer games.

46+which are common controls for many computer games.

47+-}

28wasd : Signal { x:Int, y:Int }

48wasd : Signal { x:Int, y:Int }

29wasd = directions 87 83 65 68

49wasd = directions 87 83 65 68

30

50

31−-- Whether an arbitrary key is pressed.

51+{-| Whether an arbitrary key is pressed. -}

32isDown : KeyCode -> Signal Bool

52isDown : KeyCode -> Signal Bool

33isDown = Native.Keyboard.isDown

53isDown = Native.Keyboard.isDown

34

54

35−-- Whether the shift key is pressed.

55+{-| Whether the shift key is pressed. -}

36shift : Signal Bool

56shift : Signal Bool

37shift = isDown 16

57shift = isDown 16

38

58

39−-- Whether the control key is pressed.

59+{-| Whether the control key is pressed. -}

40ctrl : Signal Bool

60ctrl : Signal Bool

41ctrl = isDown 17

61ctrl = isDown 17

42

62

43−-- Whether the space key is pressed.

63+{-| Whether the space key is pressed. -}

44space : Signal Bool

64space : Signal Bool

45space = isDown 32

65space = isDown 32

46

66

47−-- Whether the enter key is pressed.

67+{-| Whether the enter key is pressed. -}

48enter : Signal Bool

68enter : Signal Bool

49enter = isDown 13

69enter = isDown 13

50

70

51−-- List of keys that are currently down.

71+{-| List of keys that are currently down. -}

52keysDown : Signal [KeyCode]

72keysDown : Signal [KeyCode]

53keysDown = Native.Keyboard.keysDown

73keysDown = Native.Keyboard.keysDown

54

74

55−-- The latest key that has been pressed.

75+{-| The latest key that has been pressed. -}

56lastPressed : Signal KeyCode

76lastPressed : Signal KeyCode

57−lastPressed = Native.Keyboard.lastPressed

77+lastPressed = Native.Keyboard.lastPressed

libraries/List.elm+105−66

@@ -1,131 +1,166 @@

1−

2module List where

1module List where

3

2

3+{-| A library for manipulating lists of values. Every value in a

4+list must have the same type.

5+

6+# Basics

7+@docs (::), (++), isEmpty, length, reverse, map

8+

9+# Sub-lists

10+@docs head, tail, last, filter, take, drop

11+

12+# Putting Lists Together

13+@docs concat, concatMap, join, intersperse, zip, zipWith

14+

15+# Taking Lists Apart

16+@docs partition, unzip

17+

18+# Folds

19+@docs foldr, foldl, foldr1, foldl1, scanl, scanl1

20+

21+# Special Folds

22+@docs sum, product, maximum, minimum, all, any, and, or

23+-}

24+

4import open Basics

25import open Basics

5import Native.List

26import Native.List

6

27

7−-- Add an element to the front of a list `(1 :: [2,3] == [1,2,3])`

28+{-| Add an element to the front of a list `(1 :: [2,3] == [1,2,3])` -}

8(::) : a -> [a] -> [a]

29(::) : a -> [a] -> [a]

9(::) = Native.List.cons

30(::) = Native.List.cons

10

31

11−-- Puts two appendable things together:

32+{-| Puts two appendable things together:

12−--

33+

13−-- [1,1] ++ [2,3] == [1,1,2,3]

34+ [1,1] ++ [2,3] == [1,1,2,3]

14−-- "abc" ++ "123" == "abc123"

35+ "abc" ++ "123" == "abc123"

36+-}

15(++) : appendable -> appendable -> appendable

37(++) : appendable -> appendable -> appendable

16(++) = Native.List.append

38(++) = Native.List.append

17

39

18−-- Extract the first element of a list. List must be non-empty.

40+infixr 5 ::

19−-- `(head [1,2,3] == 1)`

41+infixr 5 ++

42+

43+{-| Extract the first element of a list. List must be non-empty.

44+`(head [1,2,3] == 1)`

45+-}

20head : [a] -> a

46head : [a] -> a

21head = Native.List.head

47head = Native.List.head

22

48

23−-- Extract the elements after the head of the list. List must be non-empty.

49+{-| Extract the elements after the head of the list. List must be non-empty.

24−-- `(tail [1,2,3] == [2,3])`

50+`(tail [1,2,3] == [2,3])`

51+-}

25tail : [a] -> [a]

52tail : [a] -> [a]

26tail = Native.List.tail

53tail = Native.List.tail

27

54

28−-- Extract the last element of a list. List must be non-empty.

55+{-| Extract the last element of a list. List must be non-empty.

29−-- `(last [1,2,3] == 3)`

56+`(last [1,2,3] == 3)`

57+-}

30last : [a] -> a

58last : [a] -> a

31last = Native.List.last

59last = Native.List.last

32

60

33−-- Check if a list is empty `(isEmpty [] == True)`

61+{-| Check if a list is empty `(isEmpty [] == True)` -}

34isEmpty : [a] -> Bool

62isEmpty : [a] -> Bool

35isEmpty xs =

63isEmpty xs =

36 case xs of

64 case xs of

37 [] -> True

65 [] -> True

38 _ -> False

66 _ -> False

39

67

40−-- Apply a function to every element of a list: `(map sqrt [1,4,9] == [1,2,3])`

68+{-| Apply a function to every element of a list: `(map sqrt [1,4,9] == [1,2,3])` -}

41map : (a -> b) -> [a] -> [b]

69map : (a -> b) -> [a] -> [b]

42map = Native.List.map

70map = Native.List.map

43

71

44−-- Reduce a list from the left: `(foldl (::) [] "gateman" == "nametag")`

72+{-| Reduce a list from the left: `(foldl (::) [] [1,2,3] == [3,2,1])` -}

45foldl : (a -> b -> b) -> b -> [a] -> b

73foldl : (a -> b -> b) -> b -> [a] -> b

46foldl = Native.List.foldl

74foldl = Native.List.foldl

47

75

48−-- Reduce a list from the right: `(foldr (+) 0 [1,2,3] == 6)`

76+{-| Reduce a list from the right: `(foldr (+) 0 [1,2,3] == 6)` -}

49foldr : (a -> b -> b) -> b -> [a] -> b

77foldr : (a -> b -> b) -> b -> [a] -> b

50foldr = Native.List.foldr

78foldr = Native.List.foldr

51

79

52−-- Reduce a list from the left without a base case. List must be non-empty.

80+{-| Reduce a list from the left without a base case. List must be non-empty. -}

53foldl1 : (a -> a -> a) -> [a] -> a

81foldl1 : (a -> a -> a) -> [a] -> a

54foldl1 = Native.List.foldl1

82foldl1 = Native.List.foldl1

55

83

56−-- Reduce a list from the right without a base case. List must be non-empty.

84+{-| Reduce a list from the right without a base case. List must be non-empty. -}

57foldr1 : (a -> a -> a) -> [a] -> a

85foldr1 : (a -> a -> a) -> [a] -> a

58foldr1 = Native.List.foldr1

86foldr1 = Native.List.foldr1

59

87

60−-- Reduce a list from the left, building up all of the intermediate results into a list.

88+{-| Reduce a list from the left, building up all of the intermediate results into a list.

61−--

89+

62−-- scanl (+) 0 [1,2,3,4] == [0,1,3,6,10]

90+ scanl (+) 0 [1,2,3,4] == [0,1,3,6,10]

91+-}

63scanl : (a -> b -> b) -> b -> [a] -> [b]

92scanl : (a -> b -> b) -> b -> [a] -> [b]

64scanl = Native.List.scanl

93scanl = Native.List.scanl

65

94

66−-- Same as scanl but it doesn't require a base case. List must be non-empty.

95+{-| Same as scanl but it doesn't require a base case. List must be non-empty.

67−--

96+

68−-- scanl1 (+) [1,2,3,4] == [1,3,6,10]

97+ scanl1 (+) [1,2,3,4] == [1,3,6,10]

98+-}

69scanl1 : (a -> a -> a) -> [a] -> [a]

99scanl1 : (a -> a -> a) -> [a] -> [a]

70scanl1 = Native.List.scanl1

100scanl1 = Native.List.scanl1

71

101

72−-- Filter out elements which do not satisfy the predicate: `(filter isLower "AaBbCc" == "abc")`

102+{-| Keep only elements that satisfy the predicate:

103+`(filter isEven [1..6] == [2,4,6])`

104+-}

73filter : (a -> Bool) -> [a] -> [a]

105filter : (a -> Bool) -> [a] -> [a]

74filter = Native.List.filter

106filter = Native.List.filter

75

107

76−-- Determine the length of a list: `(length "innumerable" == 11)`

108+{-| Determine the length of a list: `(length [1,2,3] == 3)` -}

77length : [a] -> Int

109length : [a] -> Int

78length = Native.List.length

110length = Native.List.length

79

111

80−-- Reverse a list. `(reverse [1..4] == [4,3,2,1])`

112+{-| Reverse a list. `(reverse [1..4] == [4,3,2,1])` -}

81reverse : [a] -> [a]

113reverse : [a] -> [a]

82reverse = Native.List.reverse

114reverse = Native.List.reverse

83

115

84−-- Check to see if all elements satisfy the predicate.

116+{-| Check to see if all elements satisfy the predicate. -}

85all : (a -> Bool) -> [a] -> Bool

117all : (a -> Bool) -> [a] -> Bool

86all = Native.List.all

118all = Native.List.all

87

119

88−-- Check to see if any elements satisfy the predicate.

120+{-| Check to see if any elements satisfy the predicate. -}

89any : (a -> Bool) -> [a] -> Bool

121any : (a -> Bool) -> [a] -> Bool

90any = Native.List.any

122any = Native.List.any

91

123

92−-- Check to see if all elements are True.

124+{-| Check to see if all elements are True. -}

93and : [Bool] -> Bool

125and : [Bool] -> Bool

94and = foldl (&&) True

126and = foldl (&&) True

95

127

96−-- Check to see if any elements are True.

128+{-| Check to see if any elements are True. -}

97or : [Bool] -> Bool

129or : [Bool] -> Bool

98or = foldl (||) False

130or = foldl (||) False

99

131

100−-- Concatenate a list of appendable things:

132+{-| Concatenate a list of appendable things:

101−--

133+

102−-- concat ["tree","house"] == "treehouse"

134+ concat [[1,2],[3],[4,5]] == [1,2,3,4,5]

135+ concat ["tree","house"] == "treehouse"

136+-}

103concat : [appendable] -> appendable

137concat : [appendable] -> appendable

104concat = Native.List.concat

138concat = Native.List.concat

105

139

106−-- Map a given function onto a list and flatten the resulting lists.

140+{-| Map a given function onto a list and flatten the resulting lists.

107−--

141+

108−-- concatMap f xs == concat (map f xs)

142+ concatMap f xs == concat (map f xs)

143+-}

109concatMap : (a -> appendable) -> [a] -> appendable

144concatMap : (a -> appendable) -> [a] -> appendable

110concatMap f list = concat (map f list)

145concatMap f list = concat (map f list)

111

146

112−-- Get the sum of the list elements. `(sum [1..4] == 10)`

147+{-| Get the sum of the list elements. `(sum [1..4] == 10)` -}

113sum : [number] -> number

148sum : [number] -> number

114sum = foldl (+) 0

149sum = foldl (+) 0

115

150

116−-- Get the product of the list elements. `(product [1..4] == 24)`

151+{-| Get the product of the list elements. `(product [1..4] == 24)` -}

117product : [number] -> number

152product : [number] -> number

118product = foldl (*) 1

153product = foldl (*) 1

119

154

120−-- Find the maximum element in a non-empty list: `maximum [1,4,2] == 4`

155+{-| Find the maximum element in a non-empty list: `maximum [1,4,2] == 4` -}

121maximum : [comparable] -> comparable

156maximum : [comparable] -> comparable

122maximum = foldl1 max

157maximum = foldl1 max

123

158

124−-- Find the minimum element in a non-empty list: `minimum [3,2,1] == 1`

159+{-| Find the minimum element in a non-empty list: `minimum [3,2,1] == 1` -}

125minimum : [comparable] -> comparable

160minimum : [comparable] -> comparable

126minimum = foldl1 min

161minimum = foldl1 min

127

162

128−-- Split a list based on the predicate.

163+{-| Split a list based on the predicate. -}

129partition : (a -> Bool) -> [a] -> ([a],[a])

164partition : (a -> Bool) -> [a] -> ([a],[a])

130partition pred lst =

165partition pred lst =

131 case lst of

166 case lst of

@@ -133,44 +168,42 @@ partition pred lst =

133 x::xs -> let (bs,cs) = partition pred xs in

168 x::xs -> let (bs,cs) = partition pred xs in

134 if pred x then (x::bs,cs) else (bs,x::cs)

169 if pred x then (x::bs,cs) else (bs,x::cs)

135

170

136−-- Combine two lists, combining them into tuples pairwise.

171+{-| Combine two lists, combining them into tuples pairwise.

137−-- If one list is longer, the extra elements are dropped.

172+If one list is longer, the extra elements are dropped.

138−--

173+

139−-- zip [1,2,3] [6,7] == [(1,6),(2,7)]

174+ zip [1,2,3] [6,7] == [(1,6),(2,7)]

140−-- zip == zipWith (,)

175+ zip == zipWith (,)

176+-}

141zip : [a] -> [b] -> [(a,b)]

177zip : [a] -> [b] -> [(a,b)]

142zip = Native.List.zip

178zip = Native.List.zip

143

179

144−-- Combine two lists, combining them with the given function.

180+{-| Combine two lists, combining them with the given function.

145−-- If one list is longer, the extra elements are dropped.

181+If one list is longer, the extra elements are dropped.

146−--

182+

147−-- zipWith (+) [1,2,3] [1,2,3,4] == [2,4,6]

183+ zipWith (+) [1,2,3] [1,2,3,4] == [2,4,6]

184+-}

148zipWith : (a -> b -> c) -> [a] -> [b] -> [c]

185zipWith : (a -> b -> c) -> [a] -> [b] -> [c]

149zipWith = Native.List.zipWith

186zipWith = Native.List.zipWith

150

187

151−-- Decompose a list of tuples.

188+{-| Decompose a list of tuples. -}

152unzip : [(a,b)] -> ([a],[b])

189unzip : [(a,b)] -> ([a],[b])

153unzip pairs =

190unzip pairs =

154 case pairs of

191 case pairs of

155 [] -> ([],[])

192 [] -> ([],[])

156 (x,y)::ps -> let (xs,ys) = (unzip ps) in (x::xs,y::ys)

193 (x,y)::ps -> let (xs,ys) = (unzip ps) in (x::xs,y::ys)

157

194

158−-- Split a list with a given seperator.

195+{-| Places the given value between all of the lists in the second

159−--

196+argument and concatenates the result.

160−-- split "," "hello,there,friend" == ["hello", "there", "friend"]

161−split : [a] -> [a] -> [[a]]

162−split = Native.List.split

163

197

164−-- Places the given value between all of the lists in the second argument

198+ join "a" ["H","w","ii","n"] == "Hawaiian"

165−-- and concatenates the result.

199+-}

166−--

167−-- join "a" ["H","w","ii","n"] == "Hawaiian"

168join : appendable -> [appendable] -> appendable

200join : appendable -> [appendable] -> appendable

169join = Native.List.join

201join = Native.List.join

170

202

171−-- Places the given value between all members of the given list.

203+{-| Places the given value between all members of the given list.

172−--

204+

173−-- intersperse ' ' "INCEPTION" == "I N C E P T I O N"

205+ intersperse "on" ["turtles","turtles","turtles"] == ["turtles","on","turtles","on","turtles"]

206+-}

174intersperse : a -> [a] -> [a]

207intersperse : a -> [a] -> [a]

175intersperse sep xs =

208intersperse sep xs =

176 case xs of

209 case xs of

@@ -178,10 +211,16 @@ intersperse sep xs =

178 [a] -> [a]

211 [a] -> [a]

179 [] -> []

212 [] -> []

180

213

181−-- Take the first n members of a list: `(take 2 [1,2,3,4] == [1,2])`

214+{-| Take the first n members of a list: `(take 2 [1,2,3,4] == [1,2])` -}

182take : Int -> [a] -> [a]

215take : Int -> [a] -> [a]

183take = Native.List.take

216take = Native.List.take

184

217

185−-- Drop the first n members of a list: `(drop 2 [1,2,3,4] == [3,4])`

218+{-| Drop the first n members of a list: `(drop 2 [1,2,3,4] == [3,4])` -}

186drop : Int -> [a] -> [a]

219drop : Int -> [a] -> [a]

187drop = Native.List.drop

220drop = Native.List.drop

221+

222+{-| Creates a list with *n* copies of a value:

223+`(repeat 3 (0,0) == [(0,0),(0,0),(0,0)]`

224+-}

225+repeat : Int -> a -> [a]

226+repeat = Native.List.repeat

libraries/Maybe.elm+28−10

@@ -1,34 +1,52 @@

1−

2module Maybe where

1module Maybe where

3

2

3+{-| Represents an optional value. Maybe it is there, maybe it is not.

4+

5+# Type and Constructors

6+@docs Maybe

7+

8+# Taking Maybes apart

9+@docs maybe, isJust, isNothing

10+

11+# Maybes and Lists

12+@docs justs

13+-}

14+

4import Basics (not, (.))

15import Basics (not, (.))

5import List (foldr)

16import List (foldr)

6

17

7−-- The Maybe datatype. Useful when a computation may or may not

18+{-| The Maybe datatype. Useful when a computation may or may not

8−-- result in a value (e.g. logarithm is defined only for positive numbers).

19+result in a value (e.g. logarithm is defined only for positive

20+numbers).

21+-}

9data Maybe a = Just a | Nothing

22data Maybe a = Just a | Nothing

10

23

11−-- Apply a function to the contents of a `Maybe`.

24+{-| Apply a function to the contents of a `Maybe`.

12−-- Return default when given `Nothing`.

25+Return default when given `Nothing`.

26+-}

13maybe : b -> (a -> b) -> Maybe a -> b

27maybe : b -> (a -> b) -> Maybe a -> b

14maybe b f m = case m of

28maybe b f m = case m of

15 Just v -> f v

29 Just v -> f v

16 Nothing -> b

30 Nothing -> b

17

31

18−-- Check if constructed with `Just`.

32+{-| Check if constructed with `Just`.

33+-}

19isJust : Maybe a -> Bool

34isJust : Maybe a -> Bool

20isJust = maybe False (\_ -> True)

35isJust = maybe False (\_ -> True)

21

36

22−-- Check if constructed with `Nothing`.

37+{-| Check if constructed with `Nothing`.

38+-}

23isNothing : Maybe a -> Bool

39isNothing : Maybe a -> Bool

24isNothing = not . isJust

40isNothing = not . isJust

25

41

26

42

27−-- If `Just`, adds the value to the front of the list.

43+{-| If `Just`, adds the value to the front of the list.

28−-- If `Nothing`, list is unchanged.

44+If `Nothing`, list is unchanged.

45+-}

29cons : Maybe a -> [a] -> [a]

46cons : Maybe a -> [a] -> [a]

30cons mx xs = maybe xs (\x -> x :: xs) mx

47cons mx xs = maybe xs (\x -> x :: xs) mx

31

48

32−-- Filters out Nothings and extracts the remaining values.

49+{-| Filters out Nothings and extracts the remaining values.

50+-}

33justs : [Maybe a] -> [a]

51justs : [Maybe a] -> [a]

34justs = foldr cons []

52justs = foldr cons []

libraries/Mouse.elm+19−9

@@ -1,31 +1,41 @@

1

2module Mouse where

3

4+{-| Library for working with mouse input.

5+

6+# Position

7+@docs position, x, y

8+

9+# Button Status

10+@docs isDown, clicks, isClicked

11+

12+-}

13+

4import Signal (Signal)

14import Signal (Signal)

5import Native.Mouse

15import Native.Mouse

6

16

7−-- The current mouse position.

17+{-| The current mouse position. -}

8position : Signal (Int,Int)

18position : Signal (Int,Int)

9position = Native.Mouse.position

19position = Native.Mouse.position

10

20

11−-- The current x-coordinate of the mouse.

21+{-| The current x-coordinate of the mouse. -}

12x : Signal Int

22x : Signal Int

13x = Native.Mouse.x

23x = Native.Mouse.x

14

24

15−-- The current y-coordinate of the mouse.

25+{-| The current y-coordinate of the mouse. -}

16y : Signal Int

26y : Signal Int

17y = Native.Mouse.y

27y = Native.Mouse.y

18

28

19−-- The current state of the left mouse-button.

29+{-| The current state of the left mouse-button.

20−-- True when the button is down, and false otherwise.

30+True when the button is down, and false otherwise. -}

21isDown : Signal Bool

31isDown : Signal Bool

22isDown = Native.Mouse.isDown

32isDown = Native.Mouse.isDown

23

33

24−-- True immediately after the left mouse-button has been clicked,

34+{-| True immediately after the left mouse-button has been clicked,

25−-- and false otherwise.

35+and false otherwise. -}

26isClicked : Signal Bool

36isClicked : Signal Bool

27isClicked = Native.Mouse.isClicked

37isClicked = Native.Mouse.isClicked

28

38

29−-- Always equal to unit. Event triggers on every mouse click.

39+{-| Always equal to unit. Event triggers on every mouse click. -}

30clicks : Signal ()

40clicks : Signal ()

31−clicks = Native.Mouse.clicks

41+clicks = Native.Mouse.clicks

libraries/Native/Basics.js+8−47

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

1

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

2+Elm.Native.Basics = {};

3− 'use strict';

3+Elm.Native.Basics.make = function(elm) {

4− if (elm.Native.Basics) return elm.Native.Basics;

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

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

6+ if (elm.Native.Basics.values) return elm.Native.Basics.values;

5

7

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

8+ var JS = Elm.Native.JavaScript.make(elm);

7− // var Maybe = Elm.Maybe(elm);

9+ var Utils = Elm.Native.Utils.make(elm);

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

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

10

11 function div(a,b) { return (a/b)|0; }

12 function rem(a,b) { return a % b; }

@@ -26,43 +26,7 @@ Elm.Native.Basics = function(elm) {

26 function uncurry(f,v) { return A2(f,v._0,v._1); }

27 function fst(t) { return t._0; }

28 function snd(t) { return t._1; }

29−/*

30− function readInt(str) {

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

32− var len = s.length;

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

34− var start = 0;

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

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

37− start = 1;

38− }

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

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

41− }

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

43− }

44

29

45− function readFloat(str) {

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

47− var len = s.length;

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

49− var start = 0;

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

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

52− start = 1;

53− }

54− var dotCount = 0;

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

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

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

58− dotCount += 1;

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

60− }

61− return Maybe.Nothing;

62− }

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

64− }

65−*/

66 var basics = {

30 var basics = {

67 div:F2(div),

31 div:F2(div),

68 rem:F2(rem),

32 rem:F2(rem),

@@ -95,14 +59,11 @@ Elm.Native.Basics = function(elm) {

95 round:Math.round,

59 round:Math.round,

96 toFloat:function(x) { return x; },

60 toFloat:function(x) { return x; },

97

61

98− //readInt:readInt,

99− //readFloat:readFloat,

100−

101 curry:F3(curry),

62 curry:F3(curry),

102 uncurry:F2(uncurry),

63 uncurry:F2(uncurry),

103 fst:fst,

64 fst:fst,

104 snd:snd

65 snd:snd

105 };

66 };

106

67

107− return elm.Native.Basics = basics;

68+ return elm.Native.Basics.values = basics;

108};

69};

libraries/Native/Char.js+26−28

@@ -1,31 +1,29 @@

1+Elm.Native.Char = {};

2+Elm.Native.Char.make = function(elm) {

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

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

5+ if (elm.Native.Char.values) return elm.Native.Char.values;

1

6

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

7+ function isBetween(lo,hi) { return function(chr) {

3− 'use strict';

8+ var c = chr.charCodeAt(0);

4−

9+ return lo <= c && c <= hi;

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

10+ };

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

11+ }

7−

12+ var isDigit = isBetween('0'.charCodeAt(0),'9'.charCodeAt(0));

8− function isBetween(lo,hi) { return function(chr) {

13+ var chk1 = isBetween('a'.charCodeAt(0),'f'.charCodeAt(0));

9− var c = chr.charCodeAt(0);

14+ var chk2 = isBetween('A'.charCodeAt(0),'F'.charCodeAt(0));

10− return lo <= c && c <= hi;

11− };

12− }

13− var isDigit = isBetween('0'.charCodeAt(0),'9'.charCodeAt(0));

14− var chk1 = isBetween('a'.charCodeAt(0),'f'.charCodeAt(0));

15− var chk2 = isBetween('A'.charCodeAt(0),'F'.charCodeAt(0));

16−

17− return elm.Native.Char = {

18− fromCode : function(c) { return String.fromCharCode(c); },

19− toCode : function(c) { return c.toUpperCase().charCodeAt(0); },

20− toUpper : function(c) { return c.toUpperCase(); },

21− toLower : function(c) { return c.toLowerCase(); },

22− toLocaleUpper : function(c) { return c.toLocaleUpperCase(); },

23− toLocaleLower : function(c) { return c.toLocaleLowerCase(); },

24− isLower : isBetween('a'.charCodeAt(0),'z'.charCodeAt(0)),

25− isUpper : isBetween('A'.charCodeAt(0),'Z'.charCodeAt(0)),

26− isDigit : isDigit,

27− isOctDigit : isBetween('0'.charCodeAt(0),'7'.charCodeAt(0)),

28− isHexDigit : function(c) { return isDigit(c) || chk1(c) || chk2(c); }

29− };

30

15

16+ return elm.Native.Char.values = {

17+ fromCode : function(c) { return String.fromCharCode(c); },

18+ toCode : function(c) { return c.toUpperCase().charCodeAt(0); },

19+ toUpper : function(c) { return c.toUpperCase(); },

20+ toLower : function(c) { return c.toLowerCase(); },

21+ toLocaleUpper : function(c) { return c.toLocaleUpperCase(); },

22+ toLocaleLower : function(c) { return c.toLocaleLowerCase(); },

23+ isLower : isBetween('a'.charCodeAt(0),'z'.charCodeAt(0)),

24+ isUpper : isBetween('A'.charCodeAt(0),'Z'.charCodeAt(0)),

25+ isDigit : isDigit,

26+ isOctDigit : isBetween('0'.charCodeAt(0),'7'.charCodeAt(0)),

27+ isHexDigit : function(c) { return isDigit(c) || chk1(c) || chk2(c); }

28+ };

31};

29};

libraries/Native/Color.js+56−58

@@ -1,71 +1,69 @@

1+Elm.Native.Color = {};

2+Elm.Native.Color.make = function(elm) {

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

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

5+ if (elm.Native.Color.values) return elm.Native.Color.values;

1

6

7+ var Utils = Elm.Native.Utils.make(elm);

2

8

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

9+ function complement(rgb) {

4− "use strict";

10+ var hsv = toHSV(rgb);

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

12+ return toRGB(hsv);

13+ }

5

14

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

15+ function hsva(h,s,v,a) {

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

16+ var degree = A2(Utils.mod, h * 180 / Math.PI, 360);

17+ var clr = toRGB({hue:degree, saturation:s, value:v});

18+ clr._3 = a;

19+ return clr;

20+ }

8

21

9− var Utils = Elm.Native.Utils(elm);

22+ function hsv(h,s,v) {

23+ var degree = A2(Utils.mod, h * 180 / Math.PI, 360);

24+ return toRGB({hue:degree, saturation:s, value:v});

25+ }

10

26

11− function complement(rgb) {

27+ function toHSV(rgb) {

12− var hsv = toHSV(rgb);

28+ var hsv = {};

13− hsv.hue = (hsv.hue + 180) % 360;

29+ var r = rgb._0 / 255.0, g = rgb._1 / 255.0, b = rgb._2 / 255.0;

14− return toRGB(hsv);

30+ var M = Math.max(r,g,b);

15− }

31+ var m = Math.min(r,g,b);

32+ var c = M - m;

16

33

17− function hsva(h,s,v,a) {

34+ var h = 0;

18− var degree = A2(Utils.mod, h * 180 / Math.PI, 360);

35+ if (c === 0) { h = 0; }

19− var clr = toRGB({hue:degree, saturation:s, value:v});

36+ else if (M === r) { h = ((g - b) / c) % 6; }

20− clr._3 = a;

37+ else if (M === g) { h = ((b - r) / c) + 2; }

21− return clr;

38+ else if (M === b) { h = ((r - g) / c) + 4; }

22− }

39+ h *= 60;

23

40

24− function hsv(h,s,v) {

41+ return { value : M, hue : h, saturation : (M === 0 ? 0 : c / M) };

25− var degree = A2(Utils.mod, h * 180 / Math.PI, 360);

42+ }

26− return toRGB({hue:degree, saturation:s, value:v});

27− }

28

43

29− function toHSV(rgb) {

44+ function between(lo,hi,x) { return lo <= x && x < hi; }

30− var hsv = {};

45+ function norm(n) { return Math.round(n*255); }

31− var r = rgb._0 / 255.0, g = rgb._1 / 255.0, b = rgb._2 / 255.0;

32− var M = Math.max(r,g,b);

33− var m = Math.min(r,g,b);

34− var c = M - m;

35

46

36− var h = 0;

47+ function toRGB(hsv) {

37− if (c === 0) { h = 0; }

48+ var c = hsv.value * hsv.saturation;

38− else if (M === r) { h = ((g - b) / c) % 6; }

49+ var hue = hsv.hue / 60;

39− else if (M === g) { h = ((b - r) / c) + 2; }

50+ var x = c * (1 - Math.abs((hue % 2) - 1));

40− else if (M === b) { h = ((r - g) / c) + 4; }

51+ var r = 0, g = 0, b = 0;

41− h *= 60;

52+ if (between(0,1,hue)) { r = c; g = x; b = 0; }

53+ else if (between(1,2,hue)) { r = x; g = c; b = 0; }

54+ else if (between(2,3,hue)) { r = 0; g = c; b = x; }

55+ else if (between(3,4,hue)) { r = 0; g = x; b = c; }

56+ else if (between(4,5,hue)) { r = x; g = 0; b = c; }

57+ else if (between(5,6,hue)) { r = c; g = 0; b = x; }

42

58

43− return { value : M, hue : h, saturation : (M === 0 ? 0 : c / M) };

59+ var m = hsv.value - c;

44− }

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

61+ }

45

62

46− function between(lo,hi,x) { return lo <= x && x < hi; }

63+ return elm.Native.Color.values = {

47− function norm(n) { return Math.round(n*255); }

64+ hsva:F4(hsva),

48−

65+ hsv:F3(hsv),

49− function toRGB(hsv) {

66+ complement:complement

50− var c = hsv.value * hsv.saturation;

67+ };

51− var hue = hsv.hue / 60;

52− var x = c * (1 - Math.abs((hue % 2) - 1));

53− var r = 0, g = 0, b = 0;

54− if (between(0,1,hue)) { r = c; g = x; b = 0; }

55− else if (between(1,2,hue)) { r = x; g = c; b = 0; }

56− else if (between(2,3,hue)) { r = 0; g = c; b = x; }

57− else if (between(3,4,hue)) { r = 0; g = x; b = c; }

58− else if (between(4,5,hue)) { r = x; g = 0; b = c; }

59− else if (between(5,6,hue)) { r = c; g = 0; b = x; }

60−

61− var m = hsv.value - c;

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

63− }

64−

65− return elm.Native.Color = {

66− hsva:F4(hsva),

67− hsv:F3(hsv),

68− complement:complement

69− };

70

68

71};

69};

libraries/Native/Date.js+7−8

@@ -1,12 +1,11 @@

1−

1+Elm.Native.Date = {};

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

2+Elm.Native.Date.make = function(elm) {

3− 'use strict';

4−

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

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

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

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

5+ if (elm.Native.Date.values) return elm.Native.Date.values;

7

6

8− var JS = Elm.JavaScript(elm);

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

9− var Maybe = Elm.Maybe(elm);

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

10

9

11 function dateNow() { return new window.Date; }

10 function dateNow() { return new window.Date; }

12 function readDate(str) {

11 function readDate(str) {

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

19 var monthTable = ["Jan", "Feb", "Mar", "Apr", "May", "Jun",

18 var monthTable = ["Jan", "Feb", "Mar", "Apr", "May", "Jun",

20 "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"];

19 "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"];

21

20

22− return elm.Native.Date = {

21+ return elm.Native.Date.values = {

23 read : readDate,

22 read : readDate,

24 year : function(d) { return d.getFullYear(); },

23 year : function(d) { return d.getFullYear(); },

25 month : function(d) { return { ctor:monthTable[d.getMonth()] }; },

24 month : function(d) { return { ctor:monthTable[d.getMonth()] }; },

libraries/Native/Error.js+6−6

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

1−

1+Elm.Native.Error = {};

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

2+Elm.Native.Error.make = function(elm) {

3− 'use strict';

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

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

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

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

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

6

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

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

8

9 function indent(lines) {

10 var msg = '';

@@ -28,5 +28,5 @@ Elm.Native.Error = function(elm) {

28

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

30

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

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

32};

libraries/Native/Graphics/Collage.js+6−6

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

1−

1+Elm.Native.Graphics.Collage = {};

2−Elm.Native.Graphics.Collage = function(elm) {

2+Elm.Native.Graphics.Collage.make = function(elm) {

3− "use strict";

4

3

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

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

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

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

7− if (elm.Native.Graphics.Collage) return elm.Native.Graphics.Collage;

6+ elm.Native.Graphics.Collage = elm.Native.Graphics.Collage || {};

7+ if (elm.Native.Graphics.Collage.values) return elm.Native.Graphics.Collage.values;

8

9− var newElement = Elm.Graphics.Element(elm).newElement;

9+ var newElement = Elm.Graphics.Element.make(elm).newElement;

10 var C = ElmRuntime.use(ElmRuntime.Render.Collage);

11

12 function collage(w,h,forms) {

@@ -18,6 +18,6 @@ Elm.Native.Graphics.Collage = function(elm) {

18 model: {w:w, h:h, forms:forms}

19 });

20 }

21− return elm.Native.Graphics.Collage = { collage:F3(collage) };

21+ return elm.Native.Graphics.Collage.values = { collage:F3(collage) };

22

23};

libraries/Native/Graphics/Input.js+9−9

@@ -1,18 +1,18 @@

1−

1+Elm.Native.Graphics.Input = {};

2−Elm.Native.Graphics.Input = function(elm) {

2+Elm.Native.Graphics.Input.make = function(elm) {

3− "use strict";

4

3

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

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

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

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

7− if (elm.Native.Graphics.Input) return elm.Native.Graphics.Input;

6+ elm.Native.Graphics.Input = elm.Native.Graphics.Input || {};

7+ if (elm.Native.Graphics.Input.values) return elm.Native.Graphics.Input.values;

8

9 var Render = ElmRuntime.use(ElmRuntime.Render.Element);

10 var newNode = ElmRuntime.use(ElmRuntime.Render.Utils).newElement;

11

12− var Signal = Elm.Signal(elm);

12+ var Signal = Elm.Signal.make(elm);

13− var newElement = Elm.Graphics.Element(elm).newElement;

13+ var newElement = Elm.Graphics.Element.make(elm).newElement;

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

14+ var JS = Elm.Native.JavaScript.make(elm);

15− var Utils = Elm.Native.Utils(elm);

15+ var Utils = Elm.Native.Utils.make(elm);

16 var Tuple2 = Utils.Tuple2;

17

18 function dropDown(values) {

@@ -290,7 +290,7 @@ Elm.Native.Graphics.Input = function(elm) {

290 }

291 }

292

293− return elm.Native.Graphics.Input = {

293+ return elm.Native.Graphics.Input.values = {

294 buttons:buttons,

295 customButtons:customButtons,

296 hoverables:hoverables,

libraries/Native/JavaScript.js+13−18

@@ -1,18 +1,17 @@

1−

1+Elm.Native.JavaScript = {};

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

2+Elm.Native.JavaScript.make = function(elm) {

3− 'use strict';

4−

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

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

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

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

5+ if (elm.Native.JavaScript.values) return elm.Native.JavaScript.values;

7

6

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

7+ var List = Elm.Native.List.make(elm);

9 var Render = ElmRuntime.use(ElmRuntime.Render.Element);

8 var Render = ElmRuntime.use(ElmRuntime.Render.Element);

10

9

11 function fromJS(v) {

10 function fromJS(v) {

12 var type = typeof v;

11 var type = typeof v;

13 if (type === 'number' ) return v;

12 if (type === 'number' ) return v;

14 if (type === 'boolean') return v;

13 if (type === 'boolean') return v;

15− if (type === 'string' ) return List.fromArray(v);

14+ if (type === 'string' ) return v;

16 if (v instanceof Array) {

15 if (v instanceof Array) {

17 var arr = [];

16 var arr = [];

18 var len = v.length;

17 var len = v.length;

@@ -46,12 +45,8 @@ Elm.Native.JavaScript = function(elm) {

46 }

45 }

47 if (type === 'object' && (v.ctor === '::' || v.ctor === '[]')) {

46 if (type === 'object' && (v.ctor === '::' || v.ctor === '[]')) {

48 var array = List.toArray(v);

47 var array = List.toArray(v);

49− if (typeof array[0] === 'string') {

48+ for (var i = array.length; i--; ) {

50− array = array.join('');

49+ array[i] = toJS(array[i]);

51− } else {

52− for (var i = array.length; i--; ) {

53− array[i] = toJS(array[i]);

54− }

55 }

50 }

56 return array;

51 return array;

57 }

52 }

@@ -84,13 +79,13 @@ Elm.Native.JavaScript = function(elm) {

84 return Render.render(element);

79 return Render.render(element);

85 }

80 }

86

81

87− return elm.Native.JavaScript = {

82+ return elm.Native.JavaScript.values = {

88− toFloat : id,

89− toBool : id,

90 toInt : function(n) { return n|0; },

83 toInt : function(n) { return n|0; },

91− toString : List.fromArray,

84+ toFloat : function(n) { return +n; },

85+ toBool : id,

86+ toString : id,

92 toList : List.fromArray,

87 toList : List.fromArray,

93− fromString : function(s) { return List.toArray(s).join(''); },

88+ fromString : id,

94 fromList : List.toArray,

89 fromList : List.toArray,

95 fromInt : id,

90 fromInt : id,

96 fromFloat : id,

91 fromFloat : id,

libraries/Native/Json.js+11−8

@@ -1,12 +1,15 @@

1+Elm.Native.Json = {};

2+Elm.Native.Json.make = function(elm) {

1

3

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

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

3− 'use strict';

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

6+ if (elm.Native.Json.values) return elm.Native.Json.values;

4

7

5− var Maybe = Elm.Maybe(elm);

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

6− var Dict = Elm.Dict(elm);

9+ var Dict = Elm.Dict.make(elm);

7− var List = Elm.List(elm);

10+ var List = Elm.List.make(elm);

8− var JS = Elm.JavaScript(elm);

11+ var JS = Elm.JavaScript.make(elm);

9− var Utils = Elm.Native.Utils(elm);

12+ var Utils = Elm.Native.Utils.make(elm);

10

13

11 function fromValue(v) {

14 function fromValue(v) {

12 switch (v.ctor) {

15 switch (v.ctor) {

@@ -59,7 +62,7 @@ Elm.Native.Json = function(elm) {

59 }

62 }

60 }

63 }

61

64

62− return elm.Native.Json = {

65+ return elm.Native.Json.values = {

63 toJSString : F2(toPrettyJSString),

66 toJSString : F2(toPrettyJSString),

64 fromJSString : fromJSString,

67 fromJSString : fromJSString,

65 toJSObject : fromValue,

68 toJSObject : fromValue,

libraries/Native/List.js+272−315

@@ -1,353 +1,310 @@

1−Elm.Native.List = function(elm) {

1+Elm.Native.List = {};

2− "use strict";

2+Elm.Native.List.make = function(elm) {

3−

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

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

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

5− if (elm.Native.List) return elm.Native.List;

5+ if (elm.Native.List.values) return elm.Native.List.values;

6− if ('values' in Elm.Native.List)

6+ if ('values' in Elm.Native.List)

7− return elm.Native.List = Elm.Native.List.values;

7+ return elm.Native.List.values = Elm.Native.List.values;

8−

8+

9− var Utils = Elm.Native.Utils(elm);

9+ var Utils = Elm.Native.Utils.make(elm);

10−

10+

11− // TODO: Improve Nil handling

11+ // TODO: Improve Nil handling

12− // We can change places like: if (xs.ctor === '[]') ... to if (xs === Nil) ...

12+ // We can change places like: if (xs.ctor === '[]') ... to if (xs === Nil) ...

13− // but only if we're confident Nil can only be defined once.

13+ // but only if we're confident Nil can only be defined once.

14− // Currently (27Mar2013) each module can have different instantiations, so multiple Nil objects can exist

14+ // Currently (27Mar2013) each module can have different instantiations, so multiple Nil objects can exist

15− // (and if they're used interchangeably then direct object comparison fails where ctor doesn't).

15+ // (and if they're used interchangeably then direct object comparison fails where ctor doesn't).

16− // So, this can only be fixed when modules initialisation is also fixed.

16+ // So, this can only be fixed when modules initialisation is also fixed.

17− // The performance overhead of the .ctor calls is 5-10% according to jsperf (depending on fn + list size)

17+ // The performance overhead of the .ctor calls is 5-10% according to jsperf (depending on fn + list size)

18− // (on firefox 19)

18+ // (on firefox 19)

19−

19+

20− var Nil = { ctor:'[]' };

20+ var Nil = { ctor:'[]' };

21−

21+

22− // using freeze for every cons would be nice but is a huge (9x on firefox 19)

22+ // using freeze for every cons would be nice but is a huge (9x on firefox 19)

23− // performance penalty

23+ // performance penalty

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

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

25−

25+

26− function throwError(f) {

26+ function throwError(f) {

27− throw new Error("Function '" + f + "' expects a non-empty list!");

27+ throw new Error("Function '" + f + "' expects a non-empty list!");

28− }

29−

30− function toArray(xs) {

31− var out = [];

32− while (xs.ctor !== '[]') {

33− out.push(xs._0);

34− xs = xs._1;

35 }

28 }

36− return out;

37− }

38

29

39− function fromArray(arr) {

30+ function toArray(xs) {

40− var out = Nil;

31+ var out = [];

41− for (var i = arr.length; i--; ) {

32+ while (xs.ctor !== '[]') {

42− out = Cons(arr[i], out);

33+ out.push(xs._0);

34+ xs = xs._1;

35+ }

36+ return out;

43 }

37 }

44− return out;

45− }

46

38

47− function range(lo,hi) {

39+ function fromArray(arr) {

48− var lst = Nil;

40+ var out = Nil;

49− if (lo <= hi) {

41+ for (var i = arr.length; i--; ) {

50− do { lst = Cons(hi,lst) } while (hi-->lo);

42+ out = Cons(arr[i], out);

43+ }

44+ return out;

51 }

45 }

52− return lst

46+

53− }

47+ function range(lo,hi) {

54−

48+ var lst = Nil;

55− function append(xs,ys) {

49+ if (lo <= hi) {

56− if (typeof xs === "string") { return xs.concat(ys); }

50+ do { lst = Cons(hi,lst) } while (hi-->lo);

57− if (xs.ctor === '[]') { return ys; }

51+ }

58− var root = Cons(xs._0, Nil);

52+ return lst

59− var curr = root;

60− xs = xs._1;

61− while (xs.ctor !== '[]') {

62− curr._1 = Cons(xs._0, Nil);

63− xs = xs._1;

64− curr = curr._1;

65 }

53 }

66− curr._1 = ys;

54+

67− return root;

55+ function append(xs,ys) {

68− }

56+ if (xs.isText) return Utils.txt(xs.concat(ys));

69−

57+ if (typeof xs === "string") return xs.concat(ys);

70− function head(v) { return v.ctor === '[]' ? throwError('head') : v._0; }

58+ if (xs.ctor === '[]') { return ys; }

71− function tail(v) { return v.ctor === '[]' ? throwError('tail') : v._1; }

59+ var root = Cons(xs._0, Nil);

72−

60+ var curr = root;

73− function last(xs) {

61+ xs = xs._1;

74− if (xs.ctor === '[]') { throwError('last'); }

62+ while (xs.ctor !== '[]') {

75− var out = xs._0;

63+ curr._1 = Cons(xs._0, Nil);

76− while (xs.ctor !== '[]') {

64+ xs = xs._1;

77− out = xs._0;

65+ curr = curr._1;

78− xs = xs._1;

66+ }

67+ curr._1 = ys;

68+ return root;

79 }

69 }

80− return out;

70+

81− }

71+ function head(v) { return v.ctor === '[]' ? throwError('head') : v._0; }

82−

72+ function tail(v) { return v.ctor === '[]' ? throwError('tail') : v._1; }

83− function map(f, xs) {

73+

84− var arr = [];

74+ function last(xs) {

85− while (xs.ctor !== '[]') {

75+ if (xs.ctor === '[]') { throwError('last'); }

86− arr.push(f(xs._0));

76+ var out = xs._0;

87− xs = xs._1;

77+ while (xs.ctor !== '[]') {

78+ out = xs._0;

79+ xs = xs._1;

80+ }

81+ return out;

88 }

82 }

89− return fromArray(arr);

83+

90− }

84+ function map(f, xs) {

91−

85+ var arr = [];

92− // f defined similarly for both foldl and foldr (NB: different from Haskell)

86+ while (xs.ctor !== '[]') {

93− // ie, foldl : (a -> b -> b) -> b -> [a] -> b

87+ arr.push(f(xs._0));

94− function foldl(f, b, xs) {

88+ xs = xs._1;

95− var acc = b;

89+ }

96− while (xs.ctor !== '[]') {

90+ return fromArray(arr);

97− acc = A2(f, xs._0, acc);

98− xs = xs._1;

99 }

91 }

100− return acc;

92+

101− }

93+ // f defined similarly for both foldl and foldr (NB: different from Haskell)

102−

94+ // ie, foldl : (a -> b -> b) -> b -> [a] -> b

103− function foldr(f, b, xs) {

95+ function foldl(f, b, xs) {

104− var arr = toArray(xs);

96+ var acc = b;

105− var acc = b;

97+ while (xs.ctor !== '[]') {

106− for (var i = arr.length; i--; ) {

98+ acc = A2(f, xs._0, acc);

107− acc = A2(f, arr[i], acc);

99+ xs = xs._1;

100+ }

101+ return acc;

108 }

102 }

109− return acc;

103+

110− }

104+ function foldr(f, b, xs) {

111−

105+ var arr = toArray(xs);

112− function foldl1(f, xs) {

106+ var acc = b;

113− return xs.ctor === '[]' ? throwError('foldl1') : foldl(f, xs._0, xs._1);

107+ for (var i = arr.length; i--; ) {

114− }

108+ acc = A2(f, arr[i], acc);

115−

109+ }

116− function foldr1(f, xs) {

110+ return acc;

117− if (xs.ctor === '[]') { throwError('foldr1'); }

118− var arr = toArray(xs);

119− var acc = arr.pop();

120− for (var i = arr.length; i--; ) {

121− acc = A2(f, arr[i], acc);

122 }

111 }

123− return acc;

112+

124− }

113+ function foldl1(f, xs) {

125−

114+ return xs.ctor === '[]' ? throwError('foldl1') : foldl(f, xs._0, xs._1);

126− function scanl(f, b, xs) {

127− var arr = toArray(xs);

128− arr.unshift(b);

129− var len = arr.length;

130− for (var i = 1; i < len; ++i) {

131− arr[i] = A2(f, arr[i], arr[i-1]);

132 }

115 }

133− return fromArray(arr);

116+

134− }

117+ function foldr1(f, xs) {

135−

118+ if (xs.ctor === '[]') { throwError('foldr1'); }

136− function scanl1(f, xs) {

119+ var arr = toArray(xs);

137− return xs.ctor === '[]' ? throwError('scanl1') : scanl(f, xs._0, xs._1);

120+ var acc = arr.pop();

138− }

121+ for (var i = arr.length; i--; ) {

139−

122+ acc = A2(f, arr[i], acc);

140− function filter(pred, xs) {

123+ }

141− var arr = [];

124+ return acc;

142− while (xs.ctor !== '[]') {

143− if (pred(xs._0)) { arr.push(xs._0); }

144− xs = xs._1;

145 }

125 }

146− return fromArray(arr);

126+

147− }

127+ function scanl(f, b, xs) {

148−

128+ var arr = toArray(xs);

149− function length(xs) {

129+ arr.unshift(b);

150− var out = 0;

130+ var len = arr.length;

151− while (xs.ctor !== '[]') {

131+ for (var i = 1; i < len; ++i) {

152− out += 1;

132+ arr[i] = A2(f, arr[i], arr[i-1]);

153− xs = xs._1;

133+ }

134+ return fromArray(arr);

154 }

135 }

155− return out;

156− }

157

136

158− function member(x, xs) {

137+ function scanl1(f, xs) {

159− while (xs.ctor !== '[]') {

138+ return xs.ctor === '[]' ? throwError('scanl1') : scanl(f, xs._0, xs._1);

160− if (Utils.eq(x,xs._0)) return true;

161− xs = xs._1;

162 }

139 }

163− return false;

140+

164− }

141+ function filter(pred, xs) {

165−

142+ var arr = [];

166− function reverse(xs) { return fromArray(toArray(xs).reverse()); }

143+ while (xs.ctor !== '[]') {

167−

144+ if (pred(xs._0)) { arr.push(xs._0); }

168− function concat(xss) {

145+ xs = xs._1;

169− if (xss.ctor === '[]') return xss;

146+ }

170− var arr = toArray(xss);

147+ return fromArray(arr);

171− var xs = arr[arr.length-1];

172− for (var i = arr.length-1; i--; ) {

173− xs = append(arr[i], xs);

174− }

175− return xs;

176− }

177−

178− function all(pred, xs) {

179− while (xs.ctor !== '[]') {

180− if (!pred(xs._0)) return false;

181− xs = xs._1;

182 }

148 }

183− return true;

184− }

185

149

186− function any(pred, xs) {

150+ function length(xs) {

187− while (xs.ctor !== '[]') {

151+ var out = 0;

188− if (pred(xs._0)) return true;

152+ while (xs.ctor !== '[]') {

189− xs = xs._1;

153+ out += 1;

154+ xs = xs._1;

155+ }

156+ return out;

190 }

157 }

191− return false;

158+

192− }

159+ function member(x, xs) {

193−

160+ while (xs.ctor !== '[]') {

194− function zipWith(f, xs, ys) {

161+ if (Utils.eq(x,xs._0)) return true;

195− var arr = [];

162+ xs = xs._1;

196− while (xs.ctor !== '[]' && ys.ctor !== '[]') {

163+ }

197− arr.push(A2(f, xs._0, ys._0));

164+ return false;

198− xs = xs._1;

199− ys = ys._1;

200 }

165 }

201− return fromArray(arr);

166+

202− }

167+ function reverse(xs) { return fromArray(toArray(xs).reverse()); }

203−

168+

204− function zip(xs, ys) {

169+ function concat(xss) {

205− var arr = [];

170+ if (xss.ctor === '[]') return xss;

206− while (xs.ctor !== '[]' && ys.ctor !== '[]') {

171+ var arr = toArray(xss);

207− arr.push(Utils.Tuple2(xs._0, ys._0));

172+ var xs = arr[arr.length-1];

208− xs = xs._1;

173+ for (var i = arr.length-1; i--; ) {

209− ys = ys._1;

174+ xs = append(arr[i], xs);

175+ }

176+ return xs;

210 }

177 }

211− return fromArray(arr);

212− }

213

178

214− function sort(xs) {

179+ function all(pred, xs) {

215− function cmp(a,b) {

180+ while (xs.ctor !== '[]') {

216− var ord = Utils.compare(a,b).ctor;

181+ if (!pred(xs._0)) return false;

217− return ord=== 'EQ' ? 0 : ord === 'LT' ? -1 : 1;

182+ xs = xs._1;

183+ }

184+ return true;

218 }

185 }

219− return fromArray(toArray(xs).sort(cmp));

186+

220− }

187+ function any(pred, xs) {

221−

188+ while (xs.ctor !== '[]') {

222− function nth(xs, n) {

189+ if (pred(xs._0)) return true;

223− return toArray(xs)[n];

190+ xs = xs._1;

224− }

191+ }

225−

192+ return false;

226− function take(n, xs) {

227− var arr = [];

228− while (xs.ctor !== '[]' && n > 0) {

229− arr.push(xs._0);

230− xs = xs._1;

231− --n;

232 }

193 }

233− return fromArray(arr);

234− }

235

194

236− function drop(n, xs) {

195+ function zipWith(f, xs, ys) {

237− while (xs.ctor !== '[]' && n > 0) {

196+ var arr = [];

238− xs = xs._1;

197+ while (xs.ctor !== '[]' && ys.ctor !== '[]') {

239− --n;

198+ arr.push(A2(f, xs._0, ys._0));

199+ xs = xs._1;

200+ ys = ys._1;

201+ }

202+ return fromArray(arr);

240 }

203 }

241− return xs;

204+

242− }

205+ function zip(xs, ys) {

243−

206+ var arr = [];

244− function join(sep, xss) {

207+ while (xs.ctor !== '[]' && ys.ctor !== '[]') {

245− if (typeof sep === 'string') return toArray(xss).join(sep);

208+ arr.push(Utils.Tuple2(xs._0, ys._0));

246− if (xss.ctor === '[]') return Nil;

209+ xs = xs._1;

247− var s = toArray(sep);

210+ ys = ys._1;

248− var out = toArray(xss._0);

211+ }

249− xss = xss._1;

212+ return fromArray(arr);

250− while (xss.ctor !== '[]') {

251− out = out.concat(s, toArray(xss._0));

252− xss = xss._1;

253 }

213 }

254− return fromArray(out);

214+

255− }

215+ function sort(xs) {

256−

216+ function cmp(a,b) {

257− function split(seperator, list) {

217+ var ord = Utils.compare(a,b).ctor;

258− var array = toArray(list);

218+ return ord=== 'EQ' ? 0 : ord === 'LT' ? -1 : 1;

259− var alen = array.length;

219+ }

260− if (alen === 0) {

220+ return fromArray(toArray(xs).sort(cmp));

261− // splitting an empty list is a list of lists: [[]]

262− return Cons(Nil,Nil);

263 }

221 }

264

222

265− var sep = toArray(seperator);

223+ function nth(xs, n) {

266− var seplen = sep.length;

224+ return toArray(xs)[n];

267− if (seplen === 0) {

268− // splitting with an empty sep is a list of all elements

269− // Same as (map (\x -> [x]) list)

270− var out = Nil;

271− for (var i = alen; i--; ) {

272− out = Cons(Cons(array[i],Nil), out);

273− }

274− return out;

275 }

225 }

276

226

277− var matches = [-seplen];

227+ function take(n, xs) {

278− var sepStart = sep[0];

228+ var arr = [];

279− var len = alen - seplen + 1;

229+ while (xs.ctor !== '[]' && n > 0) {

280− for (var i = 0; i < len; ++i) {

230+ arr.push(xs._0);

281− if (Utils.eq(array[i], sepStart)) {

231+ xs = xs._1;

282− var match = true;

232+ --n;

283− for (var j = seplen; --j; ) {

284− if (!Utils.eq(array[i+j], sep[j])) { match = false; break; }

285 }

233 }

286− if (match) {

234+ return fromArray(arr);

287− matches.push(i);

235+ }

288− i += seplen - 1;

236+

237+ function drop(n, xs) {

238+ while (xs.ctor !== '[]' && n > 0) {

239+ xs = xs._1;

240+ --n;

289 }

241 }

290− }

242+ return xs;

291 }

243 }

292

244

293− // shortcut in case of no matches

245+ function repeat(n, x) {

294− if (matches.length === 0) {

246+ var arr = [];

295− return Cons(list,Nil);

247+ var pattern = [x];

248+ while (n > 0) {

249+ if (n & 1) arr = arr.concat(pattern);

250+ n >>= 1, pattern = pattern.concat(pattern);

251+ }

252+ return fromArray(arr);

296 }

253 }

297

254

298− var out = Nil;

255+ function join(sep, xss) {

299− var index = alen - 1;

256+ if (sep.isText) return Utils.txt(toArray(xss).join(sep));

300− for (var i = matches.length; i--; ) {

257+ if (typeof sep === 'string') return toArray(xss).join(sep);

301− var temp = Nil;

258+ if (xss.ctor === '[]') return Nil;

302− var stop = matches[i] + seplen - 1;

259+ var s = toArray(sep);

303− for ( ; index > stop; --index ) {

260+ var out = toArray(xss._0);

304− temp = Cons(array[index], temp);

261+ xss = xss._1;

305− }

262+ while (xss.ctor !== '[]') {

306− out = Cons(temp,out);

263+ out = out.concat(s, toArray(xss._0));

307− index -= seplen;

264+ xss = xss._1;

265+ }

266+ return fromArray(out);

308 }

267 }

309− return out;

268+

310− }

269+ Elm.Native.List.values = {

311−

270+ Nil:Nil,

312− Elm.Native.List.values = {

271+ Cons:Cons,

313− Nil:Nil,

272+ cons:F2(Cons),

314− Cons:Cons,

273+ toArray:toArray,

315− cons:F2(Cons),

274+ fromArray:fromArray,

316− toArray:toArray,

275+ range:range,

317− fromArray:fromArray,

276+ append:append,

318− range:range,

277+

319− append:append,

278+ head:head,

320−

279+ tail:tail,

321− head:head,

280+ last:last,

322− tail:tail,

281+

323− last:last,

282+ map:F2(map),

324−

283+ foldl:F3(foldl),

325− map:F2(map),

284+ foldr:F3(foldr),

326− foldl:F3(foldl),

285+

327− foldr:F3(foldr),

286+ foldl1:F2(foldl1),

328−

287+ foldr1:F2(foldr1),

329− foldl1:F2(foldl1),

288+ scanl:F3(scanl),

330− foldr1:F2(foldr1),

289+ scanl1:F2(scanl1),

331− scanl:F3(scanl),

290+ filter:F2(filter),

332− scanl1:F2(scanl1),

291+ length:length,

333− filter:F2(filter),

292+ member:F2(member),

334− length:length,

293+ reverse:reverse,

335− member:F2(member),

294+ concat:concat,

336− reverse:reverse,

295+

337− concat:concat,

296+ all:F2(all),

338−

297+ any:F2(any),

339− all:F2(all),

298+ zipWith:F3(zipWith),

340− any:F2(any),

299+ zip:F2(zip),

341− zipWith:F3(zipWith),

300+ sort:sort,

342− zip:F2(zip),

301+ nth:F2(nth),

343− sort:sort,

302+ take:F2(take),

344− nth:F2(nth),

303+ drop:F2(drop),

345− take:F2(take),

304+ repeat:F2(repeat),

346− drop:F2(drop),

305+

347−

306+ join:F2(join)

348− join:F2(join),

307+ };

349− split:F2(split)

308+ return elm.Native.List.values = Elm.Native.List.values;

350− };

309+

351− return elm.Native.List = Elm.Native.List.values;

310+};

352−

353−};

libraries/Native/Prelude.js+10−9

@@ -1,11 +1,12 @@

1+Elm.Native.Prelude = {};

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

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

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

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

1

6

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

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

3− 'use strict';

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

4− if (elm.Native.Prelude) return elm.Native.Prelude;

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

5−

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

7− var Maybe = Elm.Maybe(elm);

8− var Char = Elm.Char(elm);

9

10

10 function readInt(str) {

11 function readInt(str) {

11 var s = JS.fromString(str);

12 var s = JS.fromString(str);

@@ -43,9 +44,9 @@ Elm.Native.Prelude = function(elm) {

43 return Maybe.Just(parseFloat(s));

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

44 }

45 }

45

46

46− return elm.Native.Prelude = {

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

47 readInt:readInt,

48 readInt:readInt,

48− readFloat:readFloat,

49+ readFloat:readFloat

49 };

50 };

50

51

51};

52};

libraries/Native/Show.js+35−40

@@ -1,29 +1,31 @@

1−

1+Elm.Native.Show = {};

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

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

3− 'use strict';

4−

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

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

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

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

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

7

6

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

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

9− var List = Elm.List(elm);

8+ var List = Elm.List.make(elm);

10− var Maybe = Elm.Maybe(elm);

9+ var Maybe = Elm.Maybe.make(elm);

11− var JS = Elm.JavaScript(elm);

10+ var JS = Elm.JavaScript.make(elm);

12− var Dict = Elm.Dict(elm);

11+ var Dict = Elm.Dict.make(elm);

13− var Json = Elm.Json(elm);

12+ var Json = Elm.Json.make(elm);

14− var Tuple2 = Elm.Native.Utils(elm).Tuple2;

13+ var Tuple2 = Elm.Native.Utils.make(elm).Tuple2;

15

14

16 var toString = function(v) {

15 var toString = function(v) {

17− if (typeof v === "function") {

16+ var type = typeof v;

17+ if (type === "function") {

18 var name = v.func ? v.func.name : v.name;

19 return '<function' + (name === '' ? '' : ': ') + name + '>';

20− } else if (typeof v === "boolean") {

20+ } else if (type === "boolean") {

21 return v ? "True" : "False";

22− } else if (typeof v === "number") {

22+ } else if (type === "number") {

23 return v+"";

24− } else if (typeof v === "string" && v.length < 2) {

24+ } else if (v.isChar && v instanceof String) {

25− return "'" + showChar(v) + "'";

25+ return "'" + addSlashes(v) + "'";

26− } else if (typeof v === "object" && '_' in v) {

26+ } else if (type === "string") {

27+ return '"' + addSlashes(v) + '"';

28+ } else if (type === "object" && '_' in v) {

27 var output = [];

29 var output = [];

28 for (var k in v._) {

30 for (var k in v._) {

29 for (var i = v._[k].length; i--; ) {

31 for (var i = v._[k].length; i--; ) {

@@ -36,7 +38,7 @@ Elm.Native.Show = function(elm) {

36 }

38 }

37 if (output.length === 0) return "{}";

39 if (output.length === 0) return "{}";

38 return "{ " + output.join(", ") + " }";

40 return "{ " + output.join(", ") + " }";

39− } else if (typeof v === "object" && 'ctor' in v) {

41+ } else if (type === "object" && 'ctor' in v) {

40 if (v.ctor.substring(0,6) === "_Tuple") {

42 if (v.ctor.substring(0,6) === "_Tuple") {

41 var output = [];

43 var output = [];

42 for (var k in v) {

44 for (var k in v) {

@@ -45,18 +47,13 @@ Elm.Native.Show = function(elm) {

45 }

47 }

46 return "(" + output.join(",") + ")";

48 return "(" + output.join(",") + ")";

47 } else if (v.ctor === "::") {

49 } else if (v.ctor === "::") {

48− var isStr = typeof v._0 === "string",

50+ var output = '[' + toString(v._0);

49− start = isStr ? '"' : "[",

50− end = isStr ? '"' : "]",

51− sep = isStr ? "" : ",",

52− f = !isStr ? toString : showChar;

53− var output = start + f(v._0);

54 v = v._1;

51 v = v._1;

55 while (v.ctor === "::") {

52 while (v.ctor === "::") {

56− output += sep + f(v._0);

53+ output += "," + toString(v._0);

57 v = v._1;

54 v = v._1;

58 }

55 }

59− return output + end;

56+ return output + ']';

60 } else if (v.ctor === "[]") {

57 } else if (v.ctor === "[]") {

61 return "[]";

58 return "[]";

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

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

@@ -79,22 +76,20 @@ Elm.Native.Show = function(elm) {

79 return v.ctor + output;

76 return v.ctor + output;

80 }

77 }

81 }

78 }

82− if (typeof v === 'object' && 'recv' in v) return '<signal>';

79+ if (type === 'object' && 'recv' in v) return '<signal>';

83 return "<internal structure>";

80 return "<internal structure>";

84 };

81 };

85− function show(v) { return NList.fromArray(toString(v)); }

86

82

87− function showChar (c) {

83+ function addSlashes(str) {

88− return c === '\n' ? '\\n' :

84+ return str.replace(/\\/g, '\\\\')

89− c === '\t' ? '\\t' :

85+ .replace(/\n/g, '\\n')

90− c === '\b' ? '\\b' :

86+ .replace(/\t/g, '\\t')

91− c === '\r' ? '\\r' :

87+ .replace(/\r/g, '\\r')

92− c === '\v' ? '\\v' :

88+ .replace(/\v/g, '\\v')

93− c === '\0' ? '\\0' :

89+ .replace(/\0/g, '\\0')

94− c === '\'' ? "\\'" :

90+ .replace(/\'/g, "\\'")

95− c === '\"' ? '\\"' :

91+ .replace(/\"/g, '\\"');

96− c === '\\' ? '\\\\' : c;

97 }

92 }

98

93

99− return elm.Native.Show = { show:show };

94+ return elm.Native.Show.values = { show:toString };

100};

95};

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

@@ -1,13 +1,14 @@

1+Elm.Native.Http = {};

2+Elm.Native.Http.make = function(elm) {

1

3

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

3− 'use strict';

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

5− if (elm.Native.Http) return elm.Native.Http;

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

6+ if (elm.Native.Http.values) return elm.Native.Http.values;

6

7

8

8− var JS = Elm.JavaScript(elm);

9+ var JS = Elm.JavaScript.make(elm);

9− var List = Elm.List(elm);

10+ var List = Elm.List.make(elm);

10− var Signal = Elm.Signal(elm);

11+ var Signal = Elm.Signal.make(elm);

11

12

13

13 function registerReq(queue,responses) { return function(req) {

14 function registerReq(queue,responses) { return function(req) {

@@ -50,12 +51,12 @@ Elm.Native.Http = function(elm) {

50 }

51 }

51

52

52 function send(requests) {

53 function send(requests) {

53− var responses = Signal.constant(elm.Http.Waiting);

54+ var responses = Signal.constant(elm.Http.values.Waiting);

54 var sender = A2( Signal.lift, registerReq([],responses), requests );

55 var sender = A2( Signal.lift, registerReq([],responses), requests );

55 function f(x) { return function(y) { return x; } }

56 function f(x) { return function(y) { return x; } }

56 return A3( Signal.lift2, f, responses, sender );

57 return A3( Signal.lift2, f, responses, sender );

57 }

58 }

58

59

59− return elm.Native.Http = {send:send};

60+ return elm.Native.Http.values = {send:send};

60

61

61};

62};

libraries/Native/Signal/Keyboard.js+14−10

@@ -1,8 +1,9 @@

1+Elm.Native.Keyboard = {};

2+Elm.Native.Keyboard.make = function(elm) {

1

3

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

3− 'use strict';

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

5− if (elm.Native.Keyboard) return elm.Native.Keyboard;

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

6+ if (elm.Native.Keyboard.values) return elm.Native.Keyboard.values;

6

7

7 // Duplicated from Native.Signal

8 // Duplicated from Native.Signal

8 function send(node, timestep, changed) {

9 function send(node, timestep, changed) {

@@ -12,9 +13,9 @@ Elm.Native.Keyboard = function(elm) {

12 }

13 }

14 }

14

15

15− var Signal = Elm.Signal(elm);

16+ var Signal = Elm.Signal.make(elm);

16− var NList = Elm.Native.List(elm);

17+ var NList = Elm.Native.List.make(elm);

17− var Utils = Elm.Native.Utils(elm);

18+ var Utils = Elm.Native.Utils.make(elm);

18

19

19 var downEvents = Signal.constant(0);

20 var downEvents = Signal.constant(0);

20 var upEvents = Signal.constant(0);

21 var upEvents = Signal.constant(0);

@@ -76,10 +77,13 @@ Elm.Native.Keyboard = function(elm) {

76

77

77 function keySignal(f) {

78 function keySignal(f) {

78 var signal = A2(Signal.lift, f, keysDown);

79 var signal = A2(Signal.lift, f, keysDown);

79− // what's the significance of these two following lines? -jpm

80+ // must set the default number of kids to make it possible to filter

81+ // these signals if they are not actually used.

80 keysDown.defaultNumberOfKids += 1;

82 keysDown.defaultNumberOfKids += 1;

81− signal.defaultNumberOfKids = 0;

83+ signal.defaultNumberOfKids = 1;

82− return signal;

84+ var filtered = Signal.dropRepeats(signal)

85+ filtered.defaultNumberOfKids = 0;

86+ return filtered;

83 }

87 }

84

88

85 function dir(up, down, left, right) {

89 function dir(up, down, left, right) {

@@ -103,7 +107,7 @@ Elm.Native.Keyboard = function(elm) {

103

107

104 var lastPressed = Signal.dropRepeats(downEvents);

108 var lastPressed = Signal.dropRepeats(downEvents);

105

109

106− return elm.Native.Keyboard = {

110+ return elm.Native.Keyboard.values = {

107 isDown:is,

111 isDown:is,

108 directions:F4(dir),

112 directions:F4(dir),

109 keysDown:keysDown,

113 keysDown:keysDown,

libraries/Native/Signal/Mouse.js+50−65

@@ -1,66 +1,51 @@

1−

1+Elm.Native.Mouse = {};

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

2+Elm.Native.Mouse.make = function(elm) {

3− 'use strict';

3+

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

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

5− if (elm.Native.Mouse) return elm.Native.Mouse;

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

6−

6+ if (elm.Native.Mouse.values) return elm.Native.Mouse.values;

7− var Signal = Elm.Signal(elm);

7+

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

8+ var Signal = Elm.Signal.make(elm);

9−

9+ var Utils = Elm.Native.Utils.make(elm);

10− var position = Signal.constant(Utils.Tuple2(0,0));

10+

11− position.defaultNumberOfKids = 2;

11+ var position = Signal.constant(Utils.Tuple2(0,0));

12−

12+ position.defaultNumberOfKids = 2;

13− // do not move x and y into Elm. By setting their default number

13+

14− // of kids, it is possible to detatch the mouse listeners if

14+ // do not move x and y into Elm. By setting their default number

15− // they are not needed.

15+ // of kids, it is possible to detatch the mouse listeners if

16− var x = A2( Signal.lift, function(p){return p._0}, position);

16+ // they are not needed.

17− x.defaultNumberOfKids = 0;

17+ var x = A2( Signal.lift, function(p){return p._0}, position);

18− var y = A2( Signal.lift, function(p){return p._1}, position);

18+ x.defaultNumberOfKids = 0;

19− y.defaultNumberOfKids = 0;

19+ var y = A2( Signal.lift, function(p){return p._1}, position);

20−

20+ y.defaultNumberOfKids = 0;

21− var isDown = Signal.constant(false);

21+

22− var isClicked = Signal.constant(false);

22+ var isDown = Signal.constant(false);

23− var clicks = Signal.constant(Utils.Tuple0);

23+ var isClicked = Signal.constant(false);

24−

24+ var clicks = Signal.constant(Utils.Tuple0);

25− function getXY(e) {

25+

26− var posx = 0;

26+ var node = elm.display === ElmRuntime.Display.FULLSCREEN ? document : elm.node;

27− var posy = 0;

27+

28− if (!e) e = window.event;

28+ elm.addListener([isClicked.id, clicks.id], node, 'click', function click() {

29− if (e.pageX || e.pageY) {

29+ elm.notify(isClicked.id, true);

30− posx = e.pageX;

30+ elm.notify(clicks.id, Utils.Tuple0);

31− posy = e.pageY;

31+ elm.notify(isClicked.id, false);

32− } else if (e.clientX || e.clientY) {

32+ });

33− posx = e.clientX + document.body.scrollLeft +

33+ elm.addListener([isDown.id], node, 'mousedown', function down() {

34− document.documentElement.scrollLeft;

34+ elm.notify(isDown.id, true);

35− posy = e.clientY + document.body.scrollTop +

35+ });

36− document.documentElement.scrollTop;

36+ elm.addListener([isDown.id], node, 'mouseup', function up() {

37− }

37+ elm.notify(isDown.id, false);

38− return Utils.Tuple2(posx-elm.node.offsetX, posy-elm.node.offsetY);

38+ });

39− }

39+ elm.addListener([position.id], node, 'mousemove', function move(e) {

40−

40+ elm.notify(position.id, Utils.getXY(e));

41− var node = elm.display === ElmRuntime.Display.FULLSCREEN ? document : elm.node;

41+ });

42−

42+

43− elm.addListener([isClicked.id, clicks.id], node, 'click', function click() {

43+ return elm.Native.Mouse.values = {

44− elm.notify(isClicked.id, true);

44+ position: position,

45− elm.notify(clicks.id, Utils.Tuple0);

45+ x:x,

46− elm.notify(isClicked.id, false);

46+ y:y,

47− });

47+ isClicked: isClicked,

48− elm.addListener([isDown.id], node, 'mousedown', function down() {

48+ isDown: isDown,

49− elm.notify(isDown.id, true);

49+ clicks: clicks

50− });

50+ };

51− elm.addListener([isDown.id], node, 'mouseup', function up() {

52− elm.notify(isDown.id, false);

53− });

54− elm.addListener([position.id], node, 'mousemove', function move(e) {

55− elm.notify(position.id, getXY(e));

56− });

57−

58− return elm.Native.Mouse = {

59− position: position,

60− x:x,

61− y:y,

62− isClicked: isClicked,

63− isDown: isDown,

64− clicks: clicks

65− };

66};

51};

libraries/Native/Signal/Random.js+32−16

@@ -1,23 +1,39 @@

1+Elm.Native.Random = {};

2+Elm.Native.Random.make = function(elm) {

1

3

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

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

3− 'use strict';

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

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

6+ if (elm.Native.Random.values) return elm.Native.Random.values;

5− if (elm.Native.Random) return elm.Native.Random;

6

7

7− var Signal = Elm.Signal(elm);

8+ var Signal = Elm.Signal.make(elm);

9+ var List = Elm.Native.List.make(elm);

8

10

9− function range(min, max, signal) {

11+ function range(min, max, signal) {

10− function f(x) { return Math.floor(Math.random() * (max-min+1)) + min; }

12+ function f(x) { return Math.floor(Math.random() * (max-min+1)) + min; }

11− return A2( Signal.lift, f, signal );

13+ return A2( Signal.lift, f, signal );

12− }

14+ }

13

15

14− function flt(signal) {

16+ function float_(signal) {

15− function f(x) { return Math.random(); }

17+ function f(x) { return Math.random(); }

16− return A2( Signal.lift, f, signal );

18+ return A2( Signal.lift, f, signal );

17− }

19+ }

18

20

19− elm.Native.Random = { range: F3(range) };

21+ function floatList(signal) {

20− elm.Native.Random['float'] = flt;

22+ function f(n) {

21− return elm.Native.Random;

23+ if (n < 0) return List.Nil;

24+ var arr = new Array(n);

25+ for (var i = n; i--; ) {

26+ arr[i] = Math.random();

27+ }

28+ return List.fromArray(arr);

29+ }

30+ return A2( Signal.lift, f, signal );

31+ }

32+

33+ return elm.Native.Random.values = {

34+ range: F3(range),

35+ float_: float_,

36+ floatList: floatList

37+ };

22

38

23};

39};

libraries/Native/Signal/Signal.js+8−7

@@ -1,12 +1,13 @@

1

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

2+Elm.Native.Signal = {};

3− 'use strict';

3+Elm.Native.Signal.make = function(elm) {

4

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

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

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

7+ if (elm.Native.Signal.values) return elm.Native.Signal.values;

7

8

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

9+ var Utils = Elm.Native.Utils.make(elm);

9− var foldl1 = Elm.List(elm).foldl1;

10+ var foldr1 = Elm.List.make(elm).foldr1;

10

11

11 function send(node, timestep, changed) {

12 function send(node, timestep, changed) {

12 var kids = node.kids;

13 var kids = node.kids;

@@ -201,9 +202,9 @@ Elm.Native.Signal = function(elm) {

201 }

202 }

202

203

203 function merge(s1,s2) { return new Merge(s1,s2); }

204 function merge(s1,s2) { return new Merge(s1,s2); }

204− function merges(ss) { return A2(foldl1, F2(merge), ss); }

205+ function merges(ss) { return A2(foldr1, F2(merge), ss); }

205

206

206− return elm.Native.Signal = {

207+ return elm.Native.Signal.values = {

207 constant : function(v) { return new Input(v); },

208 constant : function(v) { return new Input(v); },

208 lift : F2(lift ),

209 lift : F2(lift ),

209 lift2 : F3(lift2),

210 lift2 : F3(lift2),

libraries/Native/Signal/Time.js+10−7

@@ -1,11 +1,14 @@

1+Elm.Native.Time = {};

2+Elm.Native.Time.make = function(elm) {

1

3

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

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

3− 'use strict';

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

6+ if (elm.Native.Time.values) return elm.Native.Time.values;

4

7

5− var Signal = Elm.Signal(elm);

8+ var Signal = Elm.Signal.make(elm);

6− var NS = Elm.Native.Signal(elm);

9+ var NS = Elm.Native.Signal.make(elm);

7− var Maybe = Elm.Maybe(elm);

10+ var Maybe = Elm.Maybe.make(elm);

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

11+ var Utils = Elm.Native.Utils.make(elm);

9

12

10 function fpsWhen(desiredFPS, isOn) {

13 function fpsWhen(desiredFPS, isOn) {

11 var msPerFrame = 1000 / desiredFPS;

14 var msPerFrame = 1000 / desiredFPS;

@@ -50,7 +53,7 @@ Elm.Native.Time = function(elm) {

50 var t = Date.parse(s);

53 var t = Date.parse(s);

51 return isNaN(t) ? Maybe.Nothing : Maybe.Just(t);

54 return isNaN(t) ? Maybe.Nothing : Maybe.Just(t);

52 }

55 }

53− return elm.Native.Time = {

56+ return elm.Native.Time.values = {

54 fpsWhen : F2(fpsWhen),

57 fpsWhen : F2(fpsWhen),

55 fps : function(t) { return fpsWhen(t, Signal.constant(true)); },

58 fps : function(t) { return fpsWhen(t, Signal.constant(true)); },

56 every : function(t) { return everyWhen(t, Signal.constant(true)) },

59 every : function(t) { return everyWhen(t, Signal.constant(true)) },

libraries/Native/Signal/Touch.js+135−132

@@ -1,149 +1,152 @@

1+Elm.Native.Touch = {};

2+Elm.Native.Touch.make = function(elm) {

1

3

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

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

3− 'use strict';

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

6+ if (elm.Native.Touch.values) return elm.Native.Touch.values;

4

7

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

8+ var Signal = Elm.Signal.make(elm);

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

9+ var JS = Elm.JavaScript.make(elm);

10+ var Utils = Elm.Native.Utils.make(elm);

7

11

8− var Signal = Elm.Signal(elm);

12+ function Dict() {

9− var JS = Elm.JavaScript(elm);

10− var _ = Elm.Native.Utils(elm);

11−

12− function Dict() {

13− this.keys = [];

14− this.values = [];

15−

16− this.insert = function(key,value) {

17− this.keys.push(key);

18− this.values.push(value);

19− };

20− this.lookup = function(key) {

21− var i = this.keys.indexOf(key)

22− return i >= 0 ? this.values[i] : {x:0,y:0,t:0};

23− };

24− this.remove = function(key) {

25− var i = this.keys.indexOf(key);

26− if (i < 0) return;

27− var t = this.values[i];

28− this.keys.splice(i,1);

29− this.values.splice(i,1);

30− return t;

31− };

32− this.clear = function() {

33 this.keys = [];

13 this.keys = [];

34 this.values = [];

14 this.values = [];

35− };

36− }

37−

38− var root = Signal.constant([]),

39− tapTime = 500,

40− hasTap = false,

41− tap = {_:{},x:0,y:0},

42− dict = new Dict();

43

15

44− function touch(t) {

16+ this.insert = function(key,value) {

45− var r = dict.lookup(t.identifier);

17+ this.keys.push(key);

46− return {_ : {},

18+ this.values.push(value);

47− id: t.identifier,

19+ };

48− x : t.pageX - elm.node.offsetX,

20+ this.lookup = function(key) {

49− y : t.pageY - elm.node.offsetY,

21+ var i = this.keys.indexOf(key)

50− x0: r.x,

22+ return i >= 0 ? this.values[i] : {x:0,y:0,t:0};

51− y0: r.y,

23+ };

52− t0: r.t

24+ this.remove = function(key) {

53− };

25+ var i = this.keys.indexOf(key);

54− }

26+ if (i < 0) return;

27+ var t = this.values[i];

28+ this.keys.splice(i,1);

29+ this.values.splice(i,1);

30+ return t;

31+ };

32+ this.clear = function() {

33+ this.keys = [];

34+ this.values = [];

35+ };

36+ }

37+

38+ var root = Signal.constant([]),

39+ tapTime = 500,

40+ hasTap = false,

41+ tap = {_:{},x:0,y:0},

42+ dict = new Dict();

43+

44+ function touch(t) {

45+ var r = dict.lookup(t.identifier);

46+ var point = Utils.getXY(t);

47+ return {_ : {},

48+ id: t.identifier,

49+ x : point._0,

50+ y : point._1,

51+ x0: r.x,

52+ y0: r.y,

53+ t0: r.t

54+ };

55+ }

55

56

56− var node = elm.display === ElmRuntime.Display.FULLSCREEN ? document : elm.node;

57+ var node = elm.display === ElmRuntime.Display.FULLSCREEN ? document : elm.node;

57

58

58− function start(e) {

59+ function start(e) {

59− dict.insert(e.identifier,

60+ var point = Utils.getXY(e);

60− {x: e.pageX - elm.node.offsetX,

61+ dict.insert(e.identifier,

61− y: e.pageY - elm.node.offsetY,

62+ {x: point._0,

62− t: Date.now()});

63+ y: point._1,

63− }

64+ t: Date.now()});

64− function end(e) {

65− var t = dict.remove(e.identifier);

66− if (Date.now() - t.t < tapTime) {

67− hasTap = true;

68− tap = {_:{}, x:t.x, y:t.y};

69 }

65 }

70− }

66+ function end(e) {

71−

67+ var t = dict.remove(e.identifier);

72− function listen(name, f) {

68+ if (Date.now() - t.t < tapTime) {

73− function update(e) {

69+ hasTap = true;

74− for (var i = e.changedTouches.length; i--; ) { f(e.changedTouches[i]); }

70+ tap = {_:{}, x:t.x, y:t.y};

75− var ts = new Array(e.touches.length);

71+ }

76− for (var i = e.touches.length; i--; ) { ts[i] = touch(e.touches[i]); }

77− elm.notify(root.id, ts);

78− e.preventDefault();

79 }

72 }

80− elm.addListener([root.id], node, name, update);

81− }

82

73

83− listen("touchstart", start);

74+ function listen(name, f) {

84− listen("touchmove", function(_){});

75+ function update(e) {

85− listen("touchend", end);

76+ for (var i = e.changedTouches.length; i--; ) { f(e.changedTouches[i]); }

86− listen("touchcancel", end);

77+ var ts = new Array(e.touches.length);

87− listen("touchleave", end);

78+ for (var i = e.touches.length; i--; ) { ts[i] = touch(e.touches[i]); }

88−

79+ elm.notify(root.id, ts);

89− var mouseID = -1;

80+ e.preventDefault();

90− function move(e) {

81+ }

91− for (var i = root.value.length; i--; ) {

82+ elm.addListener([root.id], node, name, update);

92− if (root.value[i].id === mouseID) {

83+ }

93− root.value[i].x = e.pageX - elm.node.offsetX;

94− root.value[i].y = e.pageY - elm.node.offsetY;

95− elm.notify(root.id, root.value);

96− break;

97− }

98− }

99− }

100− elm.addListener([root.id], node, "mousedown", function down(e) {

101− node.addEventListener("mousemove", move);

102− e.identifier = mouseID;

103− start(e);

104− root.value.push(touch(e));

105− elm.notify(root.id, root.value);

106− });

107− elm.addListener([root.id], node, "mouseup", function up(e) {

108− node.removeEventListener("mousemove", move);

109− e.identifier = mouseID;

110− end(e);

111− for (var i = root.value.length; i--; ) {

112− if (root.value[i].id === mouseID) {

113− root.value.splice(i, 1);

114− --mouseID;

115− break;

116− }

117− }

118− elm.notify(root.id, root.value);

119− });

120− elm.addListener([root.id], node, "blur", function blur(e) {

121− node.removeEventListener("mousemove", move);

122− if (root.value.length > 0) {

123− elm.notify(root.id, []);

124− --mouseID;

125− }

126− dict.clear();

127− });

128

84

129− function dependency(f) {

85+ listen("touchstart", start);

130− var sig = A2( Signal.lift, f, root );

86+ listen("touchmove", function(_){});

131− root.defaultNumberOfKids += 1;

87+ listen("touchend", end);

132− sig.defaultNumberOfKids = 0;

88+ listen("touchcancel", end);

133− return sig;

89+ listen("touchleave", end);

134− }

90+

91+ var mouseID = -1;

92+ function move(e) {

93+ var point = Utils.getXY(e);

94+ for (var i = root.value.length; i--; ) {

95+ if (root.value[i].id === mouseID) {

96+ root.value[i].x = point._0;

97+ root.value[i].y = point._1;

98+ elm.notify(root.id, root.value);

99+ break;

100+ }

101+ }

102+ }

103+ elm.addListener([root.id], node, "mousedown", function down(e) {

104+ node.addEventListener("mousemove", move);

105+ e.identifier = mouseID;

106+ start(e);

107+ root.value.push(touch(e));

108+ elm.notify(root.id, root.value);

109+ });

110+ elm.addListener([root.id], node, "mouseup", function up(e) {

111+ node.removeEventListener("mousemove", move);

112+ e.identifier = mouseID;

113+ end(e);

114+ for (var i = root.value.length; i--; ) {

115+ if (root.value[i].id === mouseID) {

116+ root.value.splice(i, 1);

117+ --mouseID;

118+ break;

119+ }

120+ }

121+ elm.notify(root.id, root.value);

122+ });

123+ elm.addListener([root.id], node, "blur", function blur(e) {

124+ node.removeEventListener("mousemove", move);

125+ if (root.value.length > 0) {

126+ elm.notify(root.id, []);

127+ --mouseID;

128+ }

129+ dict.clear();

130+ });

131+

132+ function dependency(f) {

133+ var sig = A2( Signal.lift, f, root );

134+ root.defaultNumberOfKids += 1;

135+ sig.defaultNumberOfKids = 0;

136+ return sig;

137+ }

135

138

136− var touches = dependency(JS.toList);

139+ var touches = dependency(JS.toList);

137

140

138− var taps = function() {

141+ var taps = function() {

139− var sig = dependency(function(_) { return tap; });

142+ var sig = dependency(function(_) { return tap; });

140− sig.defaultNumberOfKids = 1;

143+ sig.defaultNumberOfKids = 1;

141− function pred(_) { var b = hasTap; hasTap = false; return b; }

144+ function pred(_) { var b = hasTap; hasTap = false; return b; }

142− var sig2 = A3( Signal.keepIf, pred, {_:{},x:0,y:0}, sig);

145+ var sig2 = A3( Signal.keepIf, pred, {_:{},x:0,y:0}, sig);

143− sig2.defaultNumberOfKids = 0;

146+ sig2.defaultNumberOfKids = 0;

144− return sig2;

147+ return sig2;

145− }();

148+ }();

146

149

147− return elm.Native.Touch = { touches: touches, taps: taps };

150+ return elm.Native.Touch.values = { touches: touches, taps: taps };

148

151

149};

152};

libraries/Native/Signal/WebSocket.js+8−8

@@ -1,13 +1,13 @@

1−

1+Elm.Native.WebSocket = {};

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

2+Elm.Native.WebSocket.make = function(elm) {

3− 'use strict';

4

3

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

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

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

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

6+ if (elm.Native.WebSocket.values) return elm.Native.WebSocket.values;

7

8− var Signal = Elm.Signal(elm);

8+ var Signal = Elm.Signal.make(elm);

9− var JS = Elm.JavaScript(elm);

9+ var JS = Elm.JavaScript.make(elm);

10− var List = Elm.Native.List(elm);

10+ var List = Elm.Native.List.make(elm);

11

12 function open(url, outgoing) {

13 var incoming = Signal.constant(List.Nil);

@@ -34,5 +34,5 @@ Elm.Native.WebSocket = function(elm) {

34 return A3(Signal.lift2, F2(take1), incoming, A2(Signal.lift, send, outgoing));

35 }

36

37− return elm.Native.WebSocket = { connect: F2(open) };

37+ return elm.Native.WebSocket.values = { connect: F2(open) };

38};

libraries/Native/Signal/Window.js+7−7

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

1−

1+Elm.Native.Window = {};

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

2+Elm.Native.Window.make = function(elm) {

3− 'use strict';

4

3

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

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

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

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

6+ if (elm.Native.Window.values) return elm.Native.Window.values;

7

8− var Signal = Elm.Signal(elm);

8+ var Signal = Elm.Signal.make(elm);

9− var Tuple2 = Elm.Native.Utils(elm).Tuple2;

9+ var Tuple2 = Elm.Native.Utils.make(elm).Tuple2;

10

11 function getWidth() { return elm.node.clientWidth; }

12 function getHeight() {

@@ -35,7 +35,7 @@ Elm.Native.Window = function(elm) {

35 }

36 elm.addListener([dimensions.id], window, 'resize', resizeIfNeeded);

37

38− return elm.Native.Window = {

38+ return elm.Native.Window.values = {

39 dimensions:dimensions,

40 width:width,

41 height:height,

libraries/Native/String.jsnew file+232

@@ -0,0 +1,232 @@

1+Elm.Native.String = {};

2+Elm.Native.String.make = function(elm) {

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

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

5+ if (elm.Native.String.values) return elm.Native.String.values;

6+ if ('values' in Elm.Native.String)

7+ return elm.Native.String.values = Elm.Native.String.values;

8+

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

10+ var Maybe = Elm.Maybe.make(elm);

11+ var JS = Elm.JavaScript.make(elm);

12+ var Utils = Elm.Native.Utils.make(elm);

13+

14+ function isEmpty(str) {

15+ return str.length === 0;

16+ }

17+ function cons(chr,str) {

18+ return chr + str;

19+ }

20+ function uncons(str) {

21+ var hd;

22+ return (hd = str[0]) ? Maybe.Just(Utils.Tuple2(Utils.chr(hd), str.slice(1)))

23+ : Maybe.Nothing;

24+ }

25+ function length(str) {

26+ return str.length;

27+ }

28+ function map(f,str) {

29+ return str.split('').map(f).join('');

30+ }

31+ function filter(pred,str) {

32+ return str.split('').filter(pred).join('');

33+ }

34+ function reverse(str) {

35+ return str.split('').reverse().join('');

36+ }

37+ function foldl(f,b,str) {

38+ var len = str.length;

39+ for (var i = 0; i < len; ++i) {

40+ b = A2(f, str[i], b);

41+ }

42+ return b;

43+ }

44+ function foldr(f,b,str) {

45+ for (var i = str.length; i--; ) {

46+ b = A2(f, str[i], b);

47+ }

48+ return b;

49+ }

50+

51+ function split(sep, str) {

52+ return JS.toList(str.split(sep));

53+ }

54+ function join(sep, strs) {

55+ return JS.fromList(strs).join(sep);

56+ }

57+ function repeat(n, str) {

58+ var result = '';

59+ while (n > 0) {

60+ if (n & 1) result += str;

61+ n >>= 1, str += str;

62+ }

63+ return result;

64+ }

65+

66+ function sub(start, end, str) {

67+ return str.slice(start,end);

68+ }

69+ function left(n, str) {

70+ return n < 1 ? "" : str.slice(0,n);

71+ }

72+ function right(n, str) {

73+ return n < 1 ? "" : str.slice(-n);

74+ }

75+ function dropLeft(n, str) {

76+ return n < 1 ? str : str.slice(n);

77+ }

78+ function dropRight(n, str) {

79+ return n < 1 ? str : str.slice(0,-n);

80+ }

81+

82+ function pad(n,chr,str) {

83+ var half = (n - str.length) / 2;

84+ return repeat(Math.ceil(half),chr) + str + repeat(half|0,chr);

85+ }

86+ function padRight(n,chr,str) {

87+ return str + repeat(n - str.length, chr);

88+ }

89+ function padLeft(n,chr,str) {

90+ return repeat(n - str.length, chr) + str;

91+ }

92+

93+ function trim(str) {

94+ return str.trim();

95+ }

96+ function trimLeft(str) {

97+ return str.trimLeft();

98+ }

99+ function trimRight(str) {

100+ return str.trimRight();

101+ }

102+

103+ function words(str) {

104+ return JS.toList(str.split(/\s+/g));

105+ }

106+ function lines(str) {

107+ return JS.toList(str.split(/\r\n|\r|\n/g));

108+ }

109+

110+ function toUpper(str) {

111+ return str.toUpperCase();

112+ }

113+ function toLower(str) {

114+ return str.toLowerCase();

115+ }

116+

117+ function any(pred, str) {

118+ for (var i = str.length; i--; ) {

119+ if (pred(str[i])) return true;

120+ }

121+ return false;

122+ }

123+ function all(pred, str) {

124+ for (var i = str.length; i--; ) {

125+ if (!pred(str[i])) return false;

126+ }

127+ return true;

128+ }

129+

130+ function contains(sub, str) {

131+ return str.indexOf(sub) > -1;

132+ }

133+ function startsWith(sub, str) {

134+ return str.indexOf(sub) === 0;

135+ }

136+ function endsWith(sub, str) {

137+ return str.lastIndexOf(sub) === str.length - sub.length;

138+ }

139+ function indexes(sub, str) {

140+ var subLen = sub.length;

141+ var i = 0;

142+ var is = [];

143+ while ((i = str.indexOf(sub, i)) > -1) {

144+ is.push(i);

145+ i = i + subLen;

146+ }

147+ return JS.toList(is);

148+ }

149+

150+ function toInt(str) {

151+ var s = JS.fromString(str);

152+ var len = s.length;

153+ if (len === 0) { return Maybe.Nothing; }

154+ var start = 0;

155+ if (s[0] == '-') {

156+ if (len === 1) { return Maybe.Nothing; }

157+ start = 1;

158+ }

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

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

161+ }

162+ return Maybe.Just(parseInt(s, 10));

163+ }

164+

165+ function toFloat(str) {

166+ var s = JS.fromString(str);

167+ var len = s.length;

168+ if (len === 0) { return Maybe.Nothing; }

169+ var start = 0;

170+ if (s[0] == '-') {

171+ if (len === 1) { return Maybe.Nothing; }

172+ start = 1;

173+ }

174+ var dotCount = 0;

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

176+ if (Char.isDigit(s[i])) { continue; }

177+ if (s[i] === '.') {

178+ dotCount += 1;

179+ if (dotCount <= 1) { continue; }

180+ }

181+ return Maybe.Nothing;

182+ }

183+ return Maybe.Just(parseFloat(s));

184+ }

185+

186+ return Elm.Native.String.values = {

187+ isEmpty: isEmpty,

188+ cons: F2(cons),

189+ uncons: uncons,

190+ length: length,

191+ map: F2(map),

192+ filter: F2(filter),

193+ reverse: reverse,

194+ foldl: F3(foldl),

195+ foldr: F3(foldr),

196+

197+ split: F2(split),

198+ join: F2(join),

199+ repeat: F2(repeat),

200+

201+ sub: F3(sub),

202+ left: F2(left),

203+ right: F2(right),

204+ dropLeft: F2(dropLeft),

205+ dropRight: F2(dropRight),

206+

207+ pad: F3(pad),

208+ padLeft: F3(padLeft),

209+ padRight: F3(padRight),

210+

211+ trim: trim,

212+ trimLeft: trimLeft,

213+ trimRight: trimRight,

214+

215+ words: words,

216+ lines: lines,

217+

218+ toUpper: toUpper,

219+ toLower: toLower,

220+

221+ any: F2(any),

222+ all: F2(all),

223+

224+ contains: F2(contains),

225+ startsWith: F2(startsWith),

226+ endsWith: F2(endsWith),

227+ indexes: F2(indexes),

228+

229+ toInt: toInt,

230+ toFloat: toFloat,

231+ };

232+};

libraries/Native/Text.js+122−122

@@ -1,136 +1,136 @@

1+Elm.Native.Text = {};

2+Elm.Native.Text.make = function(elm) {

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

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

5+ if (elm.Native.Text.values) return elm.Native.Text.values;

6+

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

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

9+ var Color = Elm.Native.Color.make(elm);

10+ var Element = Elm.Graphics.Element.make(elm);

11+ var show = Elm.Native.Show.make(elm).show;

12+

13+ function makeSpaces(s) {

14+ if (s.length == 0) { return s; }

15+ var arr = s.split('');

16+ if (arr[0] == ' ') { arr[0] = " " }

17+ for (var i = arr.length; --i; ) {

18+ if (arr[i][0] == ' ' && arr[i-1] == ' ') {

19+ arr[i-1] = arr[i-1] + arr[i];

20+ arr[i] = '';

21+ }

22+ }

23+ for (var i = arr.length; i--; ) {

24+ if (arr[i].length > 1 && arr[i][0] == ' ') {

25+ var spaces = arr[i].split('');

26+ for (var j = spaces.length - 2; j >= 0; j -= 2) {

27+ spaces[j] = ' ';

28+ }

29+ arr[i] = spaces.join('');

30+ }

31+ }

32+ arr = arr.join('');

33+ if (arr[arr.length-1] === " ") {

34+ return arr.slice(0,-1) + ' ';

35+ }

36+ return arr;

37+ }

1

38

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

39+ function properEscape(str) {

3− 'use strict';

40+ if (str.length == 0) return str;

4−

41+ str = str //.replace(/&/g, "&")

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

42+ .replace(/"/g, '"')

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

43+ .replace(/'/g, "'")

44+ .replace(/</g, "<")

45+ .replace(/>/g, ">")

46+ .replace(/\n/g, "<br/>");

47+ var arr = str.split('<br/>');

48+ for (var i = arr.length; i--; ) {

49+ arr[i] = makeSpaces(arr[i]);

50+ }

51+ return arr.join('<br/>');

52+ }

7

53

8− var JS = Elm.JavaScript(elm);

54+ function toText(str) { return Utils.txt(properEscape(JS.fromString(str))); }

9− var htmlHeight = Elm.Native.Utils(elm).htmlHeight;

10− var Color = Elm.Native.Color(elm);

11− var Element = Elm.Graphics.Element(elm);

12− var show = Elm.Native.Show(elm).show;

13

55

14− function makeSpaces(s) {

56+ function addTag(tag) {

15− if (s.length == 0) { return s; }

57+ return function(text) {

16− var arr = s.split('');

58+ return Utils.txt('<' + tag + '>' + text + '</' + tag + '>');

17− if (arr[0] == ' ') { arr[0] = " " }

18− for (var i = arr.length; --i; ) {

19− if (arr[i][0] == ' ' && arr[i-1] == ' ') {

20− arr[i-1] = arr[i-1] + arr[i];

21− arr[i] = '';

22− }

23− }

24− for (var i = arr.length; i--; ) {

25− if (arr[i].length > 1 && arr[i][0] == ' ') {

26− var spaces = arr[i].split('');

27− for (var j = spaces.length - 2; j >= 0; j -= 2) {

28− spaces[j] = ' ';

29 }

59 }

30− arr[i] = spaces.join('');

31− }

32 }

60 }

33− arr = arr.join('');

61+

34− if (arr[arr.length-1] === " ") {

62+ function addStyle(style, value, text) {

35− return arr.slice(0,-1) + ' ';

63+ return Utils.txt("<span style='" + style + ":" + value + "'>" + text + "</span>");

36 }

64 }

37− return arr;

38− }

39

65

40− function properEscape(str) {

66+ function typeface(name, text) {

41− if (str.length == 0) return str;

67+ return addStyle('font-family', JS.fromString(name), text);

42− str = str //.replace(/&/g, "&")

43− .replace(/"/g, /*"*/ '"')

44− .replace(/'/g, /*'*/ "'")

45− .replace(/</g, "<")

46− .replace(/>/g, ">")

47− .replace(/\n/g, "<br/>");

48− var arr = str.split('<br/>');

49− for (var i = arr.length; i--; ) {

50− arr[i] = makeSpaces(arr[i]);

51 }

68 }

52− return arr.join('<br/>');

69+ function monospace(text) {

53− }

70+ return addStyle('font-family', 'monospace', text);

54−

71+ }

55− function toText(str) { return properEscape(JS.fromString(str)); }

72+ function size(px, text) { return addStyle('font-size', px + 'px', text) }

56−

73+ var header = addTag('h1');

57− function addTag(tag) { return function(text) {

74+ function height(h, text) { return addStyle('font-size', h+'px', text) }

58− return '<' + tag + ' style="padding:0;margin:0">' + text + '</' + tag + '>';

75+ function italic(text) { return addStyle('font-style', 'italic', text) }

76+ var bold = addTag('b');

77+

78+ function extract(c) {

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

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

81+ }

82+ function color(c, text) {

83+ return addStyle('color', extract(c), text);

84+ }

85+ function underline(text) { return addStyle('text-decoration', 'underline', text) }

86+ function overline(text) { return addStyle('text-decoration', 'overline', text) }

87+ function strikeThrough(text) {

88+ return addStyle('text-decoration', 'line-through', text);

89+ }

90+ function link(href, text) {

91+ return Utils.txt("<a href='" + toText(href) + "'>" + text + "</a>");

59 }

92 }

60− }

61−

62− function addStyle(style, value, text) {

63− return "<span style='" + style + ":" + value + "'>" + text + "</span>";

64− }

65−

66− function typeface(name, text) {

67− return addStyle('font-family', JS.fromString(name), text);

68− }

69− function monospace(text) {

70− return addStyle('font-family', 'monospace', text);

71− }

72− function size(px, text) { return addStyle('font-size', px + 'px', text) }

73− var header = addTag('h1');

74− function height(h, text) { return addStyle('font-size', h+'px', text) }

75− function italic(text) { return addStyle('font-style', 'italic', text) }

76− var bold = addTag('b');

77−

78− function extract(c) {

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

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

81− }

82− function color(c, text) {

83− return addStyle('color', extract(c), text);

84− }

85− function underline(text) { return addStyle('text-decoration', 'underline', text) }

86− function overline(text) { return addStyle('text-decoration', 'overline', text) }

87− function strikeThrough(text) {

88− return addStyle('text-decoration', 'line-through', text);

89− }

90− function link(href, text) {

91− return "<a href='" + toText(href) + "'>" + text + "</a>";

92− }

93−

94− function position(pos) { return function(text) {

95− var e = {ctor:'RawHtml',

96− _0: '<div style="padding:0;margin:0;text-align:' +

97− pos + '">' + text + '</div>'

98− };

99− var p = A2(htmlHeight, 0, text);

100− return A3(Element.newElement, p._0, p._1, e);

101− }

102− }

103−

104− function asText(v) {

105− return position('left')(monospace(toText(show(v))));

106− }

107−

108− function plainText(v) {

109− return position('left')(toText(v));

110− }

111−

112− return elm.Native.Text = {

113− toText: toText,

114

93

115− header : header,

94+ function position(pos) {

116− height : F2(height),

95+ return function(text) {

117− italic : italic,

96+ var e = {ctor:'RawHtml',

118− bold : bold,

97+ _0: '<div style="padding:0;margin:0;text-align:' +

119− underline : underline,

98+ pos + '">' + text + '</div>'

120− overline : overline,

99+ };

121− strikeThrough : strikeThrough,

100+ var p = A2(Utils.htmlHeight, 0, text);

122− monospace : monospace,

101+ return A3(Element.newElement, p._0, p._1, e);

123− typeface : F2(typeface),

102+ }

124− color : F2(color),

103+ }

125− link : F2(link),

126

104

127− justified : position('justify'),

105+ function asText(v) {

128− centered : position('center'),

106+ return position('left')(monospace(toText(show(v))));

129− righted : position('right'),

107+ }

130− text : position('left'),

131− plainText : plainText,

132

108

133− asText : asText

109+ function plainText(v) {

134− };

110+ return position('left')(toText(v));

111+ }

135

112

113+ return elm.Native.Text.values = {

114+ toText: toText,

115+

116+ header : header,

117+ height : F2(height),

118+ italic : italic,

119+ bold : bold,

120+ underline : underline,

121+ overline : overline,

122+ strikeThrough : strikeThrough,

123+ monospace : monospace,

124+ typeface : F2(typeface),

125+ color : F2(color),

126+ link : F2(link),

127+

128+ justified : position('justify'),

129+ centered : position('center'),

130+ righted : position('right'),

131+ text : position('left'),

132+ plainText : plainText,

133+

134+ asText : asText

135+ };

136};

libraries/Native/Transform2D.js+5−5

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

1−

1+Elm.Native.Transform2D = {};

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

2+Elm.Native.Transform2D.make = function(elm) {

3− "use strict";

4

3

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

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

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

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

6+ if (elm.Native.Transform2D.values) return elm.Native.Transform2D.values;

7

8 var A;

9 if (typeof Float32Array === 'undefined') {

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

80 m21*ndx + m22*ndy + mdy]);

81 }

82

83− return elm.Native.Transform2D = {

83+ return elm.Native.Transform2D.values = {

84 identity:identity,

85 matrix:F6(matrix),

86 rotation:rotation,

libraries/Native/Utils.js+172−149

@@ -1,160 +1,183 @@

1+Elm.Native.Utils = {};

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

3+

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

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

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

7+

8+ function eq(x,y) {

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

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

11+ var c = 0;

12+ for (var i in x) { ++c; if (!eq(x[i],y[i])) return false; }

13+ return c === Object.keys(y).length;

14+ }

15+ if (typeof x === 'function') {

16+ throw new Error('Equality error: general function equality is ' +

17+ 'undecidable, and therefore, unsupported');

18+ }

19+ return x === y;

20+ }

21+

22+ // code in Generate/JavaScript.hs depends on the particular

23+ // integer values assigned to LT, EQ, and GT

24+ var LT = -1, EQ = 0, GT = 1, ord = ['LT','EQ','GT'];

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

26+ function cmp(x,y) {

27+ var ord;

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

29+

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

31+ while (true) {

32+ if (x.ctor === "[]" && y.ctor === "[]") return EQ;

33+ if (x.ctor !== y.ctor) return x.ctor === '[]' ? LT : GT;

34+ ord = cmp(x._0, y._0);

35+ if (ord !== EQ) return ord;

36+ x = x._1;

37+ y = y._1;

38+ }

39+ }

40+

41+ if (x.ctor.slice(0,6) === '_Tuple') {

42+ var n = x.ctor.slice(6) - 0;

43+ var err = 'cannot compare tuples with more than 6 elements.';

44+ if (n === 0) return EQ;

45+ if (n >= 1) { ord = cmp(x._0, y._0); if (ord !== EQ) return ord;

46+ if (n >= 2) { ord = cmp(x._1, y._1); if (ord !== EQ) return ord;

47+ if (n >= 3) { ord = cmp(x._2, y._2); if (ord !== EQ) return ord;

48+ if (n >= 4) { ord = cmp(x._3, y._3); if (ord !== EQ) return ord;

49+ if (n >= 5) { ord = cmp(x._4, y._4); if (ord !== EQ) return ord;

50+ if (n >= 6) { ord = cmp(x._5, y._5); if (ord !== EQ) return ord;

51+ if (n >= 7) throw new Error('Comparison error: ' + err); } } } } } }

52+ return EQ;

53+ }

54+ throw new Error('Comparison error: comparison is only defined on ints, ' +

55+ 'floats, times, chars, strings, lists of comparable values, ' +

56+ 'and tuples of comparable values.')

57+ }

1

58

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

3− 'use strict';

4

59

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

60+ var Tuple0 = { ctor: "_Tuple0" };

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

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

7

62

8− function eq(x,y) {

63+ function chr(c) {

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

64+ var x = new String(c);

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

65+ x.isChar = true;

11− var c = 0;

66+ return x;

12− for (var i in x) { ++c; if (!eq(x[i],y[i])) return false; }

13− return c === Object.keys(y).length;

14 }

67 }

15− if (typeof x === 'function') {

68+

16− throw new Error('Equality error: general function equality is ' +

69+ function txt(str) {

17− 'undecidable, and therefore, unsupported');

70+ var t = new String(str);

71+ t.isText = true;

72+ return t;

18 }

73 }

19− return x === y;

74+

20− }

75+ var count = 0;

21−

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

22− // code in Generate/JavaScript.hs depends on the particular

77+

23− // integer values assigned to LT, EQ, and GT

78+ function copy(r) {

24− var LT = -1, EQ = 0, GT = 1, ord = ['LT','EQ','GT'];

79+ var o = {};

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

80+ for (var i in r) { o[i] = r[i]; }

26− function cmp(x,y) {

81+ return o;

27− var ord;

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

29−

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

31− while (true) {

32− if (x.ctor === "[]" && y.ctor === "[]") return EQ;

33− if (x.ctor !== y.ctor) return x.ctor === '[]' ? LT : GT;

34− ord = cmp(x._0, y._0);

35− if (ord !== EQ) return ord;

36− x = x._1;

37− y = y._1;

38− }

39 }

82 }

40

83

41− if (x.ctor.slice(0,6) === '_Tuple') {

84+ function remove(x,r) {

42− var n = x.ctor.slice(6) - 0;

85+ var o = copy(r);

43− var err = 'cannot compare tuples with more than 6 elements.';

86+ if (x in o._) {

44− if (n === 0) return EQ;

87+ o[x] = o._[x][0];

45− if (n >= 1) { ord = cmp(x._0, y._0); if (ord !== EQ) return ord;

88+ o._[x] = o._[x].slice(1);

46− if (n >= 2) { ord = cmp(x._1, y._1); if (ord !== EQ) return ord;

89+ if (o._[x].length === 0) { delete o._[x]; }

47− if (n >= 3) { ord = cmp(x._2, y._2); if (ord !== EQ) return ord;

90+ } else {

48− if (n >= 4) { ord = cmp(x._3, y._3); if (ord !== EQ) return ord;

91+ delete o[x];

49− if (n >= 5) { ord = cmp(x._4, y._4); if (ord !== EQ) return ord;

92+ }

50− if (n >= 6) { ord = cmp(x._5, y._5); if (ord !== EQ) return ord;

93+ return o;

51− if (n >= 7) throw new Error('Comparison error: ' + err); } } } } } }

52− return EQ;

53 }

94 }

54− throw new Error('Comparison error: comparison is only defined on ints, ' +

95+

55− 'floats, times, chars, strings, lists of comparable values, ' +

96+ function replace(kvs,r) {

56− 'and tuples of comparable values.')

97+ var o = copy(r);

57− }

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

58−

99+ var kvsi = kvs[i];

59−

100+ o[kvsi[0]] = kvsi[1];

60− var Tuple0 = { ctor: "_Tuple0" };

101+ }

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

102+ return o;

62−

63− var count = 0;

64− function guid(_) { return count++ }

65−

66− function copy(r) {

67− var o = {};

68− for (var i in r) { o[i] = r[i]; }

69− return o;

70− }

71−

72− function remove(x,r) {

73− var o = copy(r);

74− if (x in o._) {

75− o[x] = o._[x][0];

76− o._[x] = o._[x].slice(1);

77− if (o._[x].length === 0) { delete o._[x]; }

78− } else {

79− delete o[x];

80 }

103 }

81− return o;

104+

82− }

105+ function insert(x,v,r) {

83−

106+ var o = copy(r);

84− function replace(kvs,r) {

107+ if (x in o) o._[x] = [o[x]].concat(x in o._ ? o._[x].slice(0) : []);

85− var o = copy(r);

108+ o[x] = v;

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

109+ return o;

87− var kvsi = kvs[i];

88− o[kvsi[0]] = kvsi[1];

89 }

110 }

90− return o;

111+

91− }

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

92−

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

93− function insert(x,v,r) {

114+

94− var o = copy(r);

115+ function mod(a,b) {

95− if (x in o) o._[x] = [o[x]].concat(x in o._ ? o._[x].slice(0) : []);

116+ if (b === 0) {

96− o[x] = v;

117+ throw new Error("Cannot perform mod 0. Division by zero error.");

97− return o;

118+ }

98− }

119+ var r = a % b;

99−

120+ var m = a === 0 ? 0 : (b > 0 ? (a >= 0 ? r : r+b) : -mod(-a,-b));

100− function max(a,b) { return a > b ? a : b }

121+

101− function min(a,b) { return a < b ? a : b }

122+ return m === b ? 0 : m;

102−

123+ }

103− function mod(a,b) {

124+

104− var r = a % b;

125+ function htmlHeight(width, html) {

105− var m = a === 0 ? 0 : (b > 0 ? (a >= 0 ? r : r+b) : -mod(-a,-b));

126+ var t = document.createElement('div');

106−

127+ t.innerHTML = html;

107− return m === b ? 0 : m;

128+ if (width > 0) { t.style.width = width + "px"; }

108− }

129+ t.style.visibility = "hidden";

109−

130+ t.style.styleFloat = "left";

110− function htmlHeight(width, html) {

131+ t.style.cssFloat = "left";

111− var t = document.createElement('div');

132+

112− t.innerHTML = html;

133+ document.body.appendChild(t);

113− if (width > 0) { t.style.width = width + "px"; }

134+ var style = window.getComputedStyle(t, null);

114− t.style.visibility = "hidden";

135+ var w = Math.ceil(style.getPropertyValue("width").slice(0,-2) - 0);

115− t.style.styleFloat = "left";

136+ var h = Math.ceil(style.getPropertyValue("height").slice(0,-2) - 0);

116− t.style.cssFloat = "left";

137+ document.body.removeChild(t);

117−

138+ return Tuple2(w,h);

118− elm.node.appendChild(t);

139+ }

119− var style = window.getComputedStyle(t, null);

140+

120− var w = Math.ceil(style.getPropertyValue("width").slice(0,-2) - 0);

141+ function getXY(e) {

121− var h = Math.ceil(style.getPropertyValue("height").slice(0,-2) - 0);

142+ var posx = 0;

122− elm.node.removeChild(t);

143+ var posy = 0;

123− return Tuple2(w,h);

144+ if (e.pageX || e.pageY) {

124− }

145+ posx = e.pageX;

125−

146+ posy = e.pageY;

126− function adjustOffset() {

147+ } else if (e.clientX || e.clientY) {

127− var node = elm.node;

148+ posx = e.clientX + document.body.scrollLeft + document.documentElement.scrollLeft;

128− var offsetX = 0, offsetY = 0;

149+ posy = e.clientY + document.body.scrollTop + document.documentElement.scrollTop;

129− if (node.offsetParent) {

150+ }

130− do {

151+

131− offsetX += node.offsetLeft;

152+ if (elm.display === ElmRuntime.Display.COMPONENT) {

132− offsetY += node.offsetTop;

153+ var rect = elm.node.getBoundingClientRect();

133− } while (node = node.offsetParent);

154+ var relx = rect.left + document.body.scrollLeft + document.documentElement.scrollLeft;

134− }

155+ var rely = rect.top + document.body.scrollTop + document.documentElement.scrollTop;

135− elm.node.offsetX = offsetX;

156+ // TODO: figure out if there is a way to avoid rounding here

136− elm.node.offsetY = offsetY;

157+ posx = posx - Math.round(relx) - elm.node.clientLeft;

137− }

158+ posy = posy - Math.round(rely) - elm.node.clientTop;

138−

159+ }

139− if (elm.display === ElmRuntime.Display.COMPONENT) {

160+ return Tuple2(posx, posy);

140− elm.addListener(elm.inputs, elm.node, 'mouseover', adjustOffset);

161+ }

141− }

162+

142−

163+ return elm.Native.Utils.values = {

143− return elm.Native.Utils = {

164+ eq:eq,

144− eq:eq,

165+ cmp:cmp,

145− cmp:cmp,

166+ compare:F2(compare),

146− compare:F2(compare),

167+ Tuple0:Tuple0,

147− Tuple0:Tuple0,

168+ Tuple2:Tuple2,

148− Tuple2:Tuple2,

169+ chr:chr,

149− copy: copy,

170+ txt:txt,

150− remove: remove,

171+ copy: copy,

151− replace: replace,

172+ remove: remove,

152− insert: insert,

173+ replace: replace,

153− guid: guid,

174+ insert: insert,

154− max : F2(max),

175+ guid: guid,

155− min : F2(min),

176+ max : F2(max),

156− mod : F2(mod),

177+ min : F2(min),

157− htmlHeight: F2(htmlHeight),

178+ mod : F2(mod),

158− toFloat: function(x){return x}

179+ htmlHeight: F2(htmlHeight),

159− };

180+ getXY: getXY,

181+ toFloat: function(x) { return +x; }

182+ };

160};

183};

libraries/Prelude.elm+1

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

1module Prelude where

2+{-| Everything that is automatically imported -}

2

3

3import Basics (String)

4import Basics (String)

4import Maybe (Maybe)

5import Maybe (Maybe)

libraries/Random.elm+21−7

@@ -1,16 +1,30 @@

1−

2module Random where

1module Random where

3

2

3+{-| Since the core of Elm is pure, randomness must be handled via signals.

4+

5+# Random Numbers

6+@docs range, float

7+-}

8+

4import Signal (Signal)

9import Signal (Signal)

5import Native.Random

10import Native.Random

6

11

7−-- Given a range from low to high and a signal of values, this produces

12+{-| Given a range from low to high and a signal of values, this produces

8−-- a new signal that changes whenever the input signal changes. The new

13+a new signal that changes whenever the input signal changes. The new

9−-- values are random number between 'low' and 'high' inclusive.

14+values are random number between 'low' and 'high' inclusive.

15+-}

10range : Int -> Int -> Signal a -> Signal Int

16range : Int -> Int -> Signal a -> Signal Int

11range = Native.Random.range

17range = Native.Random.range

12

18

13−-- Produces a new signal that changes whenever the input signal changes.

19+{-| Produces a new signal that changes whenever the input signal changes.

14−-- The new values are random numbers in [0..1).

20+The new values are random numbers in [0..1).

21+-}

15float : Signal a -> Signal Float

22float : Signal a -> Signal Float

16−float = Native.Random.float

23+float = Native.Random.float_

24+

25+{-| Produces a new signal of lists that changes whenever the input signal

26+changes. The input signal specifies the length of the random list. Each value is

27+a random number in [0..1).

28+-}

29+floatList : Signal Int -> Signal [Float]

30+floatList = Native.Random.floatList

libraries/Set.elm+38−14

@@ -6,61 +6,85 @@ module Set (empty,singleton,insert,remove

6 ,toList,fromList

7 ) where

8

9+{-| A set of unique values. The values can be any comparable type. This

10+includes `Int`, `Float`, `Time`, `Char`, `String`, and tuples or lists

11+of comparable types.

12+

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

14+

15+# Build

16+@docs empty, singleton, insert, remove

17+

18+# Query

19+@docs member

20+

21+# Combine

22+@docs union, intersect, diff

23+

24+# Lists

25+@docs toList, fromList

26+

27+# Transform

28+@docs map, foldl, foldr

29+

30+-}

31+

9import Maybe (Maybe)

32import Maybe (Maybe)

10import Dict as Dict

33import Dict as Dict

11import List as List

34import List as List

12

35

13type Set t = Dict.Dict t ()

36type Set t = Dict.Dict t ()

14

37

15−-- Create an empty set.

38+{-| Create an empty set. -}

16empty : Set comparable

39empty : Set comparable

17empty = Dict.empty

40empty = Dict.empty

18

41

19−-- Create a set with one value.

42+{-| Create a set with one value. -}

20singleton : comparable -> Set comparable

43singleton : comparable -> Set comparable

21singleton k = Dict.singleton k ()

44singleton k = Dict.singleton k ()

22

45

23−-- Insert a value into a set.

46+{-| Insert a value into a set. -}

24insert : comparable -> Set comparable -> Set comparable

47insert : comparable -> Set comparable -> Set comparable

25insert k = Dict.insert k ()

48insert k = Dict.insert k ()

26

49

27−-- Remove a value from a set. If the value is not found, no changes are made.

50+{-| Remove a value from a set. If the value is not found, no changes are made.

51+-}

28remove : comparable -> Set comparable -> Set comparable

52remove : comparable -> Set comparable -> Set comparable

29remove = Dict.remove

53remove = Dict.remove

30

54

31−-- Determine if a value is in a set.

55+{-| Determine if a value is in a set. -}

32member : comparable -> Set comparable -> Bool

56member : comparable -> Set comparable -> Bool

33member = Dict.member

57member = Dict.member

34

58

35−-- Get the union of two sets. Keep all values.

59+{-| Get the union of two sets. Keep all values. -}

36union : Set comparable -> Set comparable -> Set comparable

60union : Set comparable -> Set comparable -> Set comparable

37union = Dict.union

61union = Dict.union

38

62

39−-- Get the intersection of two sets. Keeps values that appear in both sets.

63+{-| Get the intersection of two sets. Keeps values that appear in both sets. -}

40intersect : Set comparable -> Set comparable -> Set comparable

64intersect : Set comparable -> Set comparable -> Set comparable

41intersect = Dict.intersect

65intersect = Dict.intersect

42

66

43−-- Get the difference between the first set and the second. Keeps values

67+{-| Get the difference between the first set and the second. Keeps values

44−-- that do not appear in the second set.

68+that do not appear in the second set. -}

45diff : Set comparable -> Set comparable -> Set comparable

69diff : Set comparable -> Set comparable -> Set comparable

46diff = Dict.diff

70diff = Dict.diff

47

71

48−-- Convert a set into a list.

72+{-| Convert a set into a list. -}

49toList : Set comparable -> [comparable]

73toList : Set comparable -> [comparable]

50toList = Dict.keys

74toList = Dict.keys

51

75

52−-- Convert a list into a set, removing any duplicates.

76+{-| Convert a list into a set, removing any duplicates. -}

53fromList : [comparable] -> Set comparable

77fromList : [comparable] -> Set comparable

54fromList xs = List.foldl insert empty xs

78fromList xs = List.foldl insert empty xs

55

79

56−-- Fold over the values in a set, in order from lowest to highest.

80+{-| Fold over the values in a set, in order from lowest to highest. -}

57foldl : (comparable -> b -> b) -> b -> Set comparable -> b

81foldl : (comparable -> b -> b) -> b -> Set comparable -> b

58foldl f b s = Dict.foldl (\k _ b -> f k b) b s

82foldl f b s = Dict.foldl (\k _ b -> f k b) b s

59

83

60−-- Fold over the values in a set, in order from highest to lowest.

84+{-| Fold over the values in a set, in order from highest to lowest. -}

61foldr : (comparable -> b -> b) -> b -> Set comparable -> b

85foldr : (comparable -> b -> b) -> b -> Set comparable -> b

62foldr f b s = Dict.foldr (\k _ b -> f k b) b s

86foldr f b s = Dict.foldr (\k _ b -> f k b) b s

63

87

64−-- Map a function onto a set, creating a new set with no duplicates.

88+{-| Map a function onto a set, creating a new set with no duplicates. -}

65map : (comparable -> comparable') -> Set comparable -> Set comparable'

89map : (comparable -> comparable') -> Set comparable -> Set comparable'

66map f s = fromList (List.map f (toList s))

90map f s = fromList (List.map f (toList s))

libraries/Signal.elm+84−59

@@ -1,32 +1,51 @@

1−

2−-- The library for general signal manipulation. Some useful functions for

3−-- working with time (e.g. setting FPS) and combining signals and time (e.g.

4−-- delaying updates, getting timestamps) can be found in the

5−-- [`Time`](/docs/Signal/Time.elm) library.

6−--

7−-- Note: There are lift functions up to `lift8`.

8module Signal where

1module Signal where

2+{-| The library for general signal manipulation. Includes lift functions up to

3+`lift8` and infix lift operators `<~` and `~`, combinations, filters, and

4+past-dependence.

5+

6+Signals are time-varying values. Lifted functions are reevaluated whenver any of

7+their input signals has an event. Signal events may be of the same value as the

8+previous value of the signal. Such signals are useful for timing and

9+past-dependence.

10+

11+Some useful functions for working with time (e.g. setting FPS) and combining

12+signals and time (e.g. delaying updates, getting timestamps) can be found in

13+the [`Time`](/docs/Signal/Time.elm) library.

14+

15+# Combine

16+@docs constant, lift, lift2, merge, merges, combine

17+

18+# Pretty Lift

19+@docs (<~), (~)

20+

21+# Past-Dependence

22+@docs foldp, count, countIf

23+

24+#Filters

25+@docs keepIf, dropIf, keepWhen, dropWhen, dropRepeats, sampleOn

26+

27+# Do you even lift?

28+@docs lift3, lift4, lift5, lift6, lift7, lift8

29+

30+-}

9

31

10import Native.Signal

32import Native.Signal

11import List (foldr)

33import List (foldr)

12

34

13data Signal a = Signal

35data Signal a = Signal

14−-- = Constant a

15−-- | Lift (a -> a) (Signal a)

16

36

17−-- Create a constant signal that never changes.

37+{-| Create a constant signal that never changes. -}

18constant : a -> Signal a

38constant : a -> Signal a

19constant = Native.Signal.constant

39constant = Native.Signal.constant

20

40

21−-- Transform a signal with a given function.

41+{-| Transform a signal with a given function. -}

22lift : (a -> b) -> Signal a -> Signal b

42lift : (a -> b) -> Signal a -> Signal b

23lift = Native.Signal.lift

43lift = Native.Signal.lift

24

44

25−-- Combine two signals with a given function.

45+{-| Combine two signals with a given function. -}

26lift2 : (a -> b -> c) -> Signal a -> Signal b -> Signal c

46lift2 : (a -> b -> c) -> Signal a -> Signal b -> Signal c

27lift2 = Native.Signal.lift2

47lift2 = Native.Signal.lift2

28

48

29−-- Combine three signals with a given function.

30lift3 : (a -> b -> c -> d) -> Signal a -> Signal b -> Signal c -> Signal d

49lift3 : (a -> b -> c -> d) -> Signal a -> Signal b -> Signal c -> Signal d

31lift3 = Native.Signal.lift3

50lift3 = Native.Signal.lift3

32

51

@@ -49,25 +68,25 @@ lift8 : (a -> b -> c -> d -> e -> f -> g -> h -> i)

49lift8 = Native.Signal.lift8

68lift8 = Native.Signal.lift8

50

69

51

70

52−-- Create a past-dependent signal. Each value given on the input signal will

71+{-| Create a past-dependent signal. Each value given on the input signal will

53−-- be accumulated, producing a new output value.

72+be accumulated, producing a new output value.

54−--

73+

55−-- For instance, `(foldp (\\arrows number -> number + arrows.y) 0 Keyboard.arrows)`

74+For instance, `foldp (+) 0 (fps 40)` is the time the program has been running,

56−-- increments or decrements the accumulated value (which starts at zero) when the up or down arrow keys are pressed.

75+updated 40 times a second. -}

57foldp : (a -> b -> b) -> b -> Signal a -> Signal b

76foldp : (a -> b -> b) -> b -> Signal a -> Signal b

58foldp = Native.Signal.foldp

77foldp = Native.Signal.foldp

59

78

60−-- Merge two signals into one, biased towards the first signal if both signals

79+{-| Merge two signals into one, biased towards the first signal if both signals

61−-- update at the same time.

80+update at the same time. -}

62merge : Signal a -> Signal a -> Signal a

81merge : Signal a -> Signal a -> Signal a

63merge = Native.Signal.merge

82merge = Native.Signal.merge

64

83

65−-- Merge many signals into one, biased towards the left-most signal if multiple

84+{-| Merge many signals into one, biased towards the left-most signal if multiple

66−-- signals update simultaneously.

85+signals update simultaneously. -}

67merges : [Signal a] -> Signal a

86merges : [Signal a] -> Signal a

68merges = Native.Signal.merges

87merges = Native.Signal.merges

69

88

70−-- Combine a list of signals into a signal of lists.

89+{-| Combine a list of signals into a signal of lists. -}

71combine : [Signal a] -> Signal [a]

90combine : [Signal a] -> Signal [a]

72combine = foldr (Native.Signal.lift2 (::)) (Native.Signal.constant [])

91combine = foldr (Native.Signal.lift2 (::)) (Native.Signal.constant [])

73

92

@@ -76,67 +95,73 @@ combine = foldr (Native.Signal.lift2 (::)) (Native.Signal.constant [])

76 -- fold over non-homogeneous inputs.

95 -- fold over non-homogeneous inputs.

77 -- mergeEither : Signal a -> Signal b -> Signal (Either a b)

96 -- mergeEither : Signal a -> Signal b -> Signal (Either a b)

78

97

79−-- Count the number of events that have occured.

98+{-| Count the number of events that have occured. -}

80count : Signal a -> Signal Int

99count : Signal a -> Signal Int

81count = Native.Signal.count

100count = Native.Signal.count

82

101

83−-- Count the number of events that have occured that satisfy a given predicate.

102+{-| Count the number of events that have occured that satisfy a given predicate.

103+-}

84countIf : (a -> Bool) -> Signal a -> Signal Int

104countIf : (a -> Bool) -> Signal a -> Signal Int

85countIf = Native.Signal.countIf

105countIf = Native.Signal.countIf

86

106

87−-- Keep only events that satisfy the given predicate. Elm does not allow

107+{-| Keep only events that satisfy the given predicate. Elm does not allow

88−-- undefined signals, so a base case must be provided in case the predicate is

108+undefined signals, so a base case must be provided in case the predicate is

89−-- never satisfied.

109+never satisfied. -}

90keepIf : (a -> Bool) -> a -> Signal a -> Signal a

110keepIf : (a -> Bool) -> a -> Signal a -> Signal a

91keepIf = Native.Signal.keepIf

111keepIf = Native.Signal.keepIf

92

112

93−-- Drop events that satisfy the given predicate. Elm does not allow undefined

113+{-| Drop events that satisfy the given predicate. Elm does not allow undefined

94−-- signals, so a base case must be provided in case the predicate is never

114+signals, so a base case must be provided in case the predicate is never

95−-- satisfied.

115+satisfied. -}

96dropIf : (a -> Bool) -> a -> Signal a -> Signal a

116dropIf : (a -> Bool) -> a -> Signal a -> Signal a

97dropIf = Native.Signal.dropIf

117dropIf = Native.Signal.dropIf

98

118

99−-- Keep events only when the first signal is true. When the first signal becomes

119+{-| Keep events only when the first signal is true. When the first signal

100−-- true, the most recent value of the second signal will be propagated. Until

120+becomes true, the most recent value of the second signal will be propagated.

101−-- the first signal becomes false again, all events will be propagated. Elm does

121+Until the first signal becomes false again, all events will be propagated. Elm

102−-- not allow undefined signals, so a base case must be provided in case the first

122+does not allow undefined signals, so a base case must be provided in case the

103−-- signal is never true.

123+first signal is never true. -}

104keepWhen : Signal Bool -> a -> Signal a -> Signal a

124keepWhen : Signal Bool -> a -> Signal a -> Signal a

105keepWhen = Native.Signal.keepWhen

125keepWhen = Native.Signal.keepWhen

106

126

107−-- Drop events when the first signal is true. When the first signal becomes false,

127+{-| Drop events when the first signal is true. When the first signal becomes

108−-- the most recent value of the second signal will be propagated. Until the first

128+false, the most recent value of the second signal will be propagated. Until the

109−-- signal becomes true again, all events will be propagated. Elm does not allow

129+first signal becomes true again, all events will be propagated. Elm does not

110−-- undefined signals, so a base case must be provided in case the first signal is

130+allow undefined signals, so a base case must be provided in case the first

111−-- always true.

131+signal is always true. -}

112dropWhen : Signal Bool -> a -> Signal a -> Signal a

132dropWhen : Signal Bool -> a -> Signal a -> Signal a

113dropWhen = Native.Signal.dropWhen

133dropWhen = Native.Signal.dropWhen

114

134

115−-- Drop sequential repeated values. For example, if a signal produces the

135+{-| Drop sequential repeated values. For example, if a signal produces the

116−-- sequence `[1,1,2,2,1]`, it becomes `[1,2,1]` by dropping the values that

136+sequence `[1,1,2,2,1]`, it becomes `[1,2,1]` by dropping the values that are the

117−-- are the same as the previous value.

137+same as the previous value. -}

118dropRepeats : Signal a -> Signal a

138dropRepeats : Signal a -> Signal a

119dropRepeats = Native.Signal.dropRepeats

139dropRepeats = Native.Signal.dropRepeats

120

140

121−-- Sample from the second input every time an event occurs on the first input.

141+{-| Sample from the second input every time an event occurs on the first input.

122−-- For example, `(sampleOn clicks (every second))` will give the approximate

142+For example, `(sampleOn clicks (every second))` will give the approximate time

123−-- time of the latest click.

143+of the latest click. -}

124sampleOn : Signal a -> Signal b -> Signal b

144sampleOn : Signal a -> Signal b -> Signal b

125sampleOn = Native.Signal.sampleOn

145sampleOn = Native.Signal.sampleOn

126

146

127−-- An alias for `lift`. A prettier way to apply a

147+{-| An alias for `lift`. A prettier way to apply a function to the current value

128−-- function to the current value of a signal.

148+of a signal. -}

129−--

130−-- lift f signal == f <~ signal

131(<~) : (a -> b) -> Signal a -> Signal b

149(<~) : (a -> b) -> Signal a -> Signal b

132f <~ s = Native.Signal.lift f s

150f <~ s = Native.Signal.lift f s

133

151

134−-- Signal application. This takes two signals, holding a function and

152+{-| Informally, an alias for `liftN`. Intersperse it between additional signal

135−-- a value. It applies the current function to the current value.

153+arguments of the lifted function.

136−--

154+

137−-- So the following expressions are equivalent:

155+Formally, signal application. This takes two signals, holding a function and

138−--

156+a value. It applies the current function to the current value.

139−-- scene <~ Window.dimensions ~ Mouse.position

157+

140−-- lift2 scene Window.dimensions Mouse.position

158+The following expressions are equivalent:

159+

160+ scene <~ Window.dimensions ~ Mouse.position

161+ lift2 scene Window.dimensions Mouse.position

162+-}

141(~) : Signal (a -> b) -> Signal a -> Signal b

163(~) : Signal (a -> b) -> Signal a -> Signal b

142−sf ~ s = Native.Signal.lift2 (\f x -> f x) sf s

164+sf ~ s = Native.Signal.lift2 (\f x -> f x) sf s

165+

166+infixl 4 <~

167+infixl 4 ~

libraries/String.elmnew file+274

@@ -0,0 +1,274 @@

1+module String where

2+{-| A built-in representation for efficient string manipulation. String literals

3+are enclosed in `"double quotes"`. Strings are *not* lists of characters.

4+

5+# Basics

6+@docs isEmpty, length, cons, uncons, reverse,

7+ map, filter, foldl, foldr, any, all, repeat

8+

9+# Split and Join

10+@docs split, join, words, lines

11+

12+# Get Substrings

13+@docs sub, left, right, dropLeft, dropRight

14+

15+# Check for Substrings

16+@docs contains, startsWith, endsWith, indexes, indices

17+

18+# Conversion To Numbers

19+@docs toInt, toFloat

20+

21+# Formatting

22+Cosmetic operations such as padding with extra characters or trimming whitespace.

23+

24+@docs toUpper, toLower,

25+ pad, padLeft, padRight,

26+ trim, trimLeft, trimRight

27+-}

28+

29+import Native.String

30+import Maybe (Maybe)

31+

32+{-| Check if a string is empty `(isEmpty "" == True)` -}

33+isEmpty : String

34+isEmpty = Native.String.isEmpty

35+

36+{-| Add a character to the beginning of a string -}

37+cons : Char -> String -> String

38+cons = Native.String.cons

39+

40+{-| Split a non-empty string into its head and tail. This lets you

41+pattern match on strings exactly as you would with lists.

42+

43+ uncons "abc" == Just ('a',"bc")

44+ uncons "" == Nothing

45+-}

46+uncons : String -> Maybe (Char, String)

47+uncons = Native.String.uncons

48+

49+{-| Get the length of a string `(length "innumerable" == 11)` -}

50+length : String -> Int

51+length = Native.String.length

52+

53+{-| Transform every character in a string

54+

55+ map (\c -> if c == '/' then '.' else c) "a/b/c" == "a.b.c"

56+-}

57+map : (Char -> Char) -> String -> String

58+map = Native.String.map

59+

60+{-| Keep only the characters that satisfy the predicate:

61+

62+ filter isDigit "R2-D2" == "22"

63+-}

64+filter : (Char -> Bool) -> String -> String

65+filter = Native.String.filter

66+

67+{-| Reverse a string. `(reverse "stressed" == "desserts")` -}

68+reverse : String -> String

69+reverse = Native.String.reverse

70+

71+{-|

72+-}

73+foldl : (Char -> b -> b) -> b -> String -> b

74+foldl = Native.String.foldl

75+

76+{-|

77+-}

78+foldr : (Char -> b -> b) -> b -> String -> b

79+foldr = Native.String.foldr

80+

81+{-| Split a string using a given separator.

82+

83+ split "," "cat,dog,cow" == ["cat","dog","cow"]

84+ split "/" "home/evan/Desktop/" == ["home","evan","Desktop"]

85+-}

86+split : String -> String -> [String]

87+split = Native.String.split

88+

89+{-| Put many strings together with a given separator.

90+

91+ join " " ["cat","dog","cow"] == "cat dog cow"

92+ join "/" ["home","evan","Desktop"] == "home/evan/Desktop"

93+-}

94+join : String -> [String] -> String

95+join = Native.String.join

96+

97+{-| Repeat a string N times `(repeat 3 "ha" == "hahaha")` -}

98+repeat : Int -> String -> String

99+repeat = Native.String.repeat

100+

101+{-| Take a substring given a start and end index. Negative indexes

102+are taken starting from the *end* of the list.

103+

104+ sub 7 9 "snakes on a plane!" == "on"

105+ sub 0 6 "snakes on a plane!" == "snakes"

106+ sub 0 -7 "snakes on a plane!" == "snakes on a"

107+ sub -6 -1 "snakes on a plane!" == "plane"

108+-}

109+sub : Int -> Int -> String -> String

110+sub = Native.String.sub

111+

112+{-| Take N characters from the left side of a string. -}

113+left : Int -> String -> String

114+left = Native.String.left

115+

116+{-| Take N characters from the right side of a string. -}

117+right : Int -> String -> String

118+right = Native.String.right

119+

120+{-| Drop N characters from the left side of a string. -}

121+dropLeft : Int -> String -> String

122+dropLeft = Native.String.dropLeft

123+

124+{-| Drop N characters from the right side of a string. -}

125+dropRight : Int -> String -> String

126+dropRight = Native.String.dropRight

127+

128+{-| Pad a string on both sides until it has a given length.

129+

130+ pad 5 ' ' "1" == " 1 "

131+ pad 5 ' ' "11" == " 11 "

132+ pad 5 ' ' "121" == " 121 "

133+-}

134+pad : Int -> Char -> String -> String

135+pad = Native.String.pad

136+

137+{-| Pad a string on the left until it has a given length.

138+

139+ pad 5 '.' "1" == "....1"

140+ pad 5 '.' "11" == "...11"

141+ pad 5 '.' "121" == "..121"

142+-}

143+padLeft : Int -> Char -> String -> String

144+padLeft = Native.String.padLeft

145+

146+{-| Pad a string on the right until it has a given length.

147+

148+ pad 5 '.' "1" == "1...."

149+ pad 5 '.' "11" == "11..."

150+ pad 5 '.' "121" == "121.."

151+-}

152+padRight : Int -> Char -> String -> String

153+padRight = Native.String.padRight

154+

155+{-| Get rid of whitespace on both sides of a string.

156+

157+ trim " hats \n" == "hats"

158+-}

159+trim : String -> String

160+trim = Native.String.trim

161+

162+{-| Get rid of whitespace on the left of a string.

163+

164+ trimLeft " hats \n" == "hats \n"

165+-}

166+trimLeft : String -> String

167+trimLeft = Native.String.trimLeft

168+

169+{-| Get rid of whitespace on the left of a string.

170+

171+ trimRight " hats \n" == " hats"

172+-}

173+trimRight : String -> String

174+trimRight = Native.String.trimRight

175+

176+{-| Break a string into words, splitting on chunks of whitespace.

177+

178+ words "How are \t you? \n Good?" == ["How","are","you?","Good?"]

179+-}

180+words : String -> [String]

181+words = Native.String.words

182+

183+{-| Break a string into lines, splitting on newlines.

184+

185+ lines "How are you?\nGood? == ["How are you?", "Good?"]

186+-}

187+lines : String -> [String]

188+lines = Native.String.lines

189+

190+{-| Convert a string to all upper case. Useful for case insensitive comparisons

191+and VIRTUAL YELLING.

192+-}

193+toUpper : String -> String

194+toUpper = Native.String.toUpper

195+

196+{-| Convert a string to all lower case. Useful for case insensitive comparisons. -}

197+toLower : String -> String

198+toLower = Native.String.toLower

199+

200+{-| Check to see if *any* characters satisfy a predicate.

201+

202+ any isDigit "90210" == True

203+ any isDigit "R2-D2" == True

204+ any isDigit "heart" == False

205+-}

206+any : (Char -> Bool) -> String -> Bool

207+any = Native.String.any

208+

209+{-| Check to see if *all* characters satisfy a predicate.

210+

211+ all isDigit "90210" == True

212+ all isDigit "R2-D2" == False

213+ any isDigit "heart" == False

214+-}

215+all : (Char -> Bool) -> String -> Bool

216+all = Native.String.all

217+

218+{-| See if a string contains another one.

219+

220+ contains "the" "theory" == True

221+ contains "hat" "theory" == False

222+ contains "THE" "theory" == False

223+-}

224+contains : String -> String -> Bool

225+contains = Native.String.contains

226+

227+{-| See if a string starts with another one.

228+

229+ startsWith "the" "theory" == True

230+ startsWith "ory" "theory" == False

231+-}

232+startsWith : String -> String -> Bool

233+startsWith = Native.String.startsWith

234+

235+{-| See if a string ends with another one.

236+

237+ endsWith "the" "theory" == False

238+ endsWith "ory" "theory" == True

239+-}

240+endsWith : String -> String -> Bool

241+endsWith = Native.String.endsWith

242+

243+{-| Get all of the indexes for a substring.

244+

245+ indexes "i" "Mississippi" == [1,4,7,10]

246+ indexes "ss" "Mississippi" == [2,5]

247+ indexes "needle" "haystack" == []

248+-}

249+indexes : String -> String -> [Int]

250+indexes = Native.String.indexes

251+

252+{-| Alias for `indexes` -}

253+indices : String -> String -> [Int]

254+indices = Native.String.indexes

255+

256+{-| Try to convert a string into an int, failing on improperly formatted strings.

257+

258+ toInt "123" == Just 123

259+ toInt "-42" == Just -42

260+ toInt "3.1" == Nothing

261+ toInt "31a" == Nothing

262+-}

263+toInt : String -> Maybe Int

264+toInt = Native.String.toInt

265+

266+{-| Try to convert a string into a float, failing on improperly formatted strings.

267+

268+ toFloat "123" == Just 123.0

269+ toFloat "-42" == Just -42.0

270+ toFloat "3.1" == Just 3.1

271+ toFloat "31a" == Nothing

272+-}

273+toFloat : String -> Maybe Float

274+toFloat = Native.String.toFloat

libraries/Text.elm+50−24

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

1

2module Text where

3

4+{-| Functions for displaying text

5+

6+# Creating Text

7+@docs toText

8+

9+# Creating Elements

10+@docs plainText, asText, text, centered, justified, righted

11+

12+# Formatting

13+@docs color, typeface, height, link

14+

15+# Simple Formatting

16+@docs monospace, header, bold, italic, underline, overline, strikeThrough

17+

18+-}

19+

4import open Basics

20import open Basics

5import Color (Color)

21import Color (Color)

6import Graphics.Element (Element, Three, Pos, ElementPrim, Properties)

22import Graphics.Element (Element, Three, Pos, ElementPrim, Properties)

@@ -10,80 +26,90 @@ import Native.Text

10

26

11data Text = Text

27data Text = Text

12

28

13−-- Convert a string into text which can be styled and displayed.

29+{-| Convert a string into text which can be styled and displayed. -}

14toText : String -> Text

30toText : String -> Text

15toText = Native.Text.toText

31toText = Native.Text.toText

16

32

17−-- Set the typeface of some text. The first argument should be a comma separated listing of the desired typefaces

33+{-| Set the typeface of some text. The first argument should be a comma

18−-- "helvetica, arial, sans-serif"

34+separated listing of the desired typefaces

19−-- Works the same as the CSS font-family property.

35+

36+ "helvetica, arial, sans-serif"

37+

38+Works the same as the CSS font-family property.

39+-}

20typeface : String -> Text -> Text

40typeface : String -> Text -> Text

21typeface = Native.Text.typeface

41typeface = Native.Text.typeface

22

42

23−-- Switch to a monospace typeface. Good for code snippets.

43+{-| Switch to a monospace typeface. Good for code snippets. -}

24monospace : Text -> Text

44monospace : Text -> Text

25monospace = Native.Text.monospace

45monospace = Native.Text.monospace

26

46

27−-- Make text big and noticable.

47+{-| Make text big and noticable. -}

28header : Text -> Text

48header : Text -> Text

29header = Native.Text.header

49header = Native.Text.header

30

50

31−-- Create a link.

51+{-| Create a link. -}

32link : String -> Text -> Text

52link : String -> Text -> Text

33link = Native.Text.link

53link = Native.Text.link

34

54

35−-- Set the height of text in pixels.

55+{-| Set the height of text in pixels. -}

36height : Float -> Text -> Text

56height : Float -> Text -> Text

37height = Native.Text.height

57height = Native.Text.height

38

58

39−-- Set the color of a string.

59+{-| Set the color of a string. -}

40color : Color -> Text -> Text

60color : Color -> Text -> Text

41color = Native.Text.color

61color = Native.Text.color

42

62

43−-- Make a string bold.

63+{-| Make a string bold. -}

44bold : Text -> Text

64bold : Text -> Text

45bold = Native.Text.bold

65bold = Native.Text.bold

46

66

47−-- Italicize a string.

67+{-| Italicize a string. -}

48italic : Text -> Text

68italic : Text -> Text

49italic = Native.Text.italic

69italic = Native.Text.italic

50

70

51−-- Draw a line above a string.

71+{-| Draw a line above a string. -}

52overline : Text -> Text

72overline : Text -> Text

53overline = Native.Text.overline

73overline = Native.Text.overline

54

74

55−-- Underline a string.

75+{-| Underline a string. -}

56underline : Text -> Text

76underline : Text -> Text

57underline = Native.Text.underline

77underline = Native.Text.underline

58

78

59−-- Draw a line through a string.

79+{-| Draw a line through a string. -}

60strikeThrough : Text -> Text

80strikeThrough : Text -> Text

61strikeThrough = Native.Text.strikeThrough

81strikeThrough = Native.Text.strikeThrough

62

82

63−-- Display justified, styled text.

83+{-| Display justified, styled text. -}

64justified : Text -> Element

84justified : Text -> Element

65justified = Native.Text.justified

85justified = Native.Text.justified

66

86

67−-- Display centered, styled text.

87+{-| Display centered, styled text. -}

68centered : Text -> Element

88centered : Text -> Element

69centered = Native.Text.centered

89centered = Native.Text.centered

70

90

71−-- Display right justified, styled text.

91+{-| Display right justified, styled text. -}

72righted : Text -> Element

92righted : Text -> Element

73righted = Native.Text.righted

93righted = Native.Text.righted

74

94

75−-- Display styled text.

95+{-| Display styled text. -}

76text : Text -> Element

96text : Text -> Element

77text = Native.Text.text

97text = Native.Text.text

78

98

79−-- Display a plain string.

99+{-| Display a plain string. -}

80plainText : String -> Element

100plainText : String -> Element

81plainText = Native.Text.plainText

101plainText = Native.Text.plainText

82

102

83−-- Convert anything to it's textual representation and make it displayable in browser

103+{-| for internal use only -}

84−--

104+markdown : Element

85−-- asText == text . monospace . show

105+markdown = Native.Text.markdown

86−--

106+

87−-- Excellent for debugging.

107+{-| Convert anything to it's textual representation and make it displayable in

108+browser

109+

110+ asText == text . monospace . show

111+

112+Excellent for debugging.

113+-}

88asText : a -> Element

114asText : a -> Element

89asText = Native.Text.asText

115asText = Native.Text.asText

libraries/Time.elm+46−28

@@ -1,17 +1,31 @@

1−-- Library for working with time. Type `Time` represents some number of milliseconds.

2module Time where

1module Time where

3

2

3+{-| Library for working with time.

4+

5+# Units

6+@docs Time, millisecond, second, minute, hour,

7+ inMilliseconds, inSeconds, inMinutes, inHours

8+

9+# Tickers

10+@docs fps, fpsWhen, every

11+

12+# Timing

13+@docs timestamp, delay, since

14+

15+-}

16+

4import open Basics

17import open Basics

5import Native.Time

18import Native.Time

6import Signal (Signal)

19import Signal (Signal)

7

20

8−-- Type alias to make it clearer when you are working with time values.

21+{-| Type alias to make it clearer when you are working with time values.

9−-- Using the `Time` constants instead of raw numbers is very highly recommended.

22+Using the `Time` constants instead of raw numbers is very highly recommended.

23+-}

10type Time = Float

24type Time = Float

11

25

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

26+{-| Units of time, making it easier to specify things like a half-second

13−-- half-second `(500 * milliseconds)` without remembering Elm’s

27+`(500 * milliseconds)` without remembering Elm’s underlying units of time.

14−-- underlying units of time.

28+-}

15millisecond : Time

29millisecond : Time

16millisecond = 1

30millisecond = 1

17

31

@@ -36,42 +50,46 @@ inMinutes t = t / minute

36inHours : Time -> Float

50inHours : Time -> Float

37inHours t = t / hour

51inHours t = t / hour

38

52

39−-- Takes desired number of frames per second (fps). The resulting signal

53+{-| Takes desired number of frames per second (fps). The resulting signal

40−-- gives a sequence of time deltas as quickly as possible until it reaches

54+gives a sequence of time deltas as quickly as possible until it reaches

41−-- the desired FPS. A time delta is the time between the last frame and the

55+the desired FPS. A time delta is the time between the last frame and the

42−-- current frame.

56+current frame.

57+-}

43fps : number -> Signal Time

58fps : number -> Signal Time

44fps = Native.Time.fps

59fps = Native.Time.fps

45

60

46−-- Same as the fps function, but you can turn it on and off. Allows you

61+{-| Same as the fps function, but you can turn it on and off. Allows you

47−-- to do brief animations based on user input without major inefficiencies.

62+to do brief animations based on user input without major inefficiencies.

48−-- The first time delta after a pause is always zero, no matter how long

63+The first time delta after a pause is always zero, no matter how long

49−-- the pause was. This way summing the deltas will actually give the amount

64+the pause was. This way summing the deltas will actually give the amount

50−-- of time that the output signal has been running.

65+of time that the output signal has been running.

66+-}

51fpsWhen : number -> Signal Bool -> Signal Time

67fpsWhen : number -> Signal Bool -> Signal Time

52fpsWhen = Native.Time.fpsWhen

68fpsWhen = Native.Time.fpsWhen

53

69

54−-- Takes a time interval t. The resulting signal is the current time,

70+{-| Takes a time interval t. The resulting signal is the current time, updated

55−-- updated every t.

71+every t.

72+-}

56every : Time -> Signal Time

73every : Time -> Signal Time

57every = Native.Time.every

74every = Native.Time.every

58

75

59−-- Takes a time `t` and any signal. The resulting boolean signal

76+{-| Takes a time `t` and any signal. The resulting boolean signal is true for

60−-- is true for time `t` after every event on the input signal.

77+time `t` after every event on the input signal. So ``(second `since`

61−-- So ``(second `since` Mouse.clicks)`` would result in a signal

78+Mouse.clicks)`` would result in a signal that is true for one second after

62−-- that is true for one second after each mouse click and false

79+each mouse click and false otherwise.

63−-- otherwise.

80+-}

64since : Time -> Signal a -> Signal Bool

81since : Time -> Signal a -> Signal Bool

65since = Native.Time.since

82since = Native.Time.since

66

83

67−-- Add a timestamp to any signal. Timestamps increase monotonically. Each

84+{-| Add a timestamp to any signal. Timestamps increase monotonically. Each

68−-- timestamp is related to a specfic event, so `Mouse.x` and `Mouse.y` will

85+timestamp is related to a specfic event, so `Mouse.x` and `Mouse.y` will always

69−-- always have the same timestamp because they both rely on the same

86+have the same timestamp because they both rely on the same underlying event.

70−-- underlying event.

87+-}

71timestamp : Signal a -> Signal (Time, a)

88timestamp : Signal a -> Signal (Time, a)

72timestamp = Native.Time.timestamp

89timestamp = Native.Time.timestamp

73

90

74−-- Delay a signal by a certain amount of time. So `(delay second Mouse.clicks)`

91+{-| Delay a signal by a certain amount of time. So `(delay second Mouse.clicks)`

75−-- will update one second later than any mouse click.

92+will update one second later than any mouse click.

93+-}

76delay : Time -> Signal a -> Signal a

94delay : Time -> Signal a -> Signal a

77delay = Native.Time.delay

95delay = Native.Time.delay

libraries/Touch.elm+22−12

@@ -1,24 +1,34 @@

1−-- This is an early version of the touch library. It will likely grow to

2−-- include gestures that would be useful for both games and web-pages.

3module Touch where

1module Touch where

4

2

3+{-| This is an early version of the touch library. It will likely grow to

4+include gestures that would be useful for both games and web-pages.

5+

6+# Touches

7+@docs Touch, touches

8+

9+# Gestures

10+@docs taps

11+-}

12+

5import Signal (Signal)

13import Signal (Signal)

6import Native.Touch

14import Native.Touch

7import Time (Time)

15import Time (Time)

8

16

9−-- Every `Touch` has `xy` coordinates. It also has an identifier `id` to

17+{-| Every `Touch` has `xy` coordinates. It also has an identifier

10−-- distinguish one touch from another.

18+`id` to distinguish one touch from another.

11−--

19+

12−-- A touch also keeps info about the intial point and time of contact:

20+A touch also keeps info about the initial point and time of contact:

13−-- `x0`, `y0`, and `t0`. This helps compute more complicated gestures

21+`x0`, `y0`, and `t0`. This helps compute more complicated gestures

14−-- like taps, drags, and swipes which need to know about timing or direction.

22+like taps, drags, and swipes which need to know about timing or direction.

23+-}

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

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

16

25

17−-- A list of ongoing touches.

26+{-| A list of ongoing touches. -}

18touches : Signal [Touch]

27touches : Signal [Touch]

19touches = Native.Touch.touches

28touches = Native.Touch.touches

20

29

21−-- The last position that was tapped. Default value is `{x=0,y=0}`.

30+{-| The last position that was tapped. Default value is `{x=0,y=0}`.

22−-- Updates whenever the user taps the screen.

31+Updates whenever the user taps the screen.

32+-}

23taps : Signal { x:Int, y:Int }

33taps : Signal { x:Int, y:Int }

24−taps = Native.Touch.taps

34+taps = Native.Touch.taps

libraries/Transform2D.elm+40−27

@@ -1,44 +1,57 @@

1−

2module Transform2D where

1module Transform2D where

2+{-| A library for performing [2D matrix transformations](http://en.wikipedia.org/wiki/Transformation_matrix#Affine_transformations).

3+It is used primarily with the `groupTransform` function from `Graphics.Collage` and

4+allows you to do things like rotation, scaling, translation, shearing, and reflection.

5+

6+# Basic Transforms

7+@docs identity, matrix, rotation

8+

9+# Multiplication

10+@docs multiply

11+-}

3

12

4import Native.Transform2D

13import Native.Transform2D

5

14

6data Transform2D = Transform2D

15data Transform2D = Transform2D

7

16

8−-- Create an identity transform. Transforming by the identity does

17+{-| Create an identity transform. Transforming by the identity does

9−-- not change anything, but it can come in handy as a default or

18+not change anything, but it can come in handy as a default or

10−-- base case.

19+base case.

11−--

20+

12−-- / 1 0 \\

21+ / 1 0 \

13−-- \\ 0 1 /

22+ \ 0 1 /

23+-}

14identity : Transform2D

24identity : Transform2D

15identity = Native.Transform2D.identity

25identity = Native.Transform2D.identity

16

26

17−-- Creates an arbitrary transformation matrix. This lets you create scales,

27+{-| Creates a transformation matrix. This lets you create transforms

18−-- shears, reflections, translations, or any other 2D transform.

28+such as scales, shears, reflections, and translations.

19−--

29+

20−-- matrix a b c d dx dy

30+ matrix a b c d dx dy

21−--

31+

22−-- / a b \\

32+ / a b \

23−-- \\ c d /

33+ \ c d /

24−--

34+

25−-- And `dx` and `dy` are the translation values.

35+And `dx` and `dy` are the translation values.

36+-}

26matrix : Float -> Float -> Float -> Float -> Float -> Float -> Transform2D

37matrix : Float -> Float -> Float -> Float -> Float -> Float -> Transform2D

27matrix = Native.Transform2D.matrix

38matrix = Native.Transform2D.matrix

28

39

29−-- Creates a [rotation matrix](http://en.wikipedia.org/wiki/Rotation_matrix).

40+{-| Creates a [rotation matrix](http://en.wikipedia.org/wiki/Rotation_matrix).

30−-- Given an angle t, it creates a counterclockwise rotation matrix:

41+Given an angle t, it creates a counterclockwise rotation matrix:

31−--

42+

32−-- / cos t -sin t \\

43+ / cos t -sin t \

33−-- \\ sin t cos t /

44+ \ sin t cos t /

45+-}

34rotation : Float -> Transform2D

46rotation : Float -> Transform2D

35rotation = Native.Transform2D.rotation

47rotation = Native.Transform2D.rotation

36

48

37−-- Multiplies two transforms together:

49+{-| Multiplies two transforms together:

38−--

50+

39−-- multiply a b

51+ multiply a b

40−--

52+

41−-- / a11 a12 \\ . / b11 b12 \\

53+ / a11 a12 \ . / b11 b12 \

42−-- \\ a21 a22 / \\ b21 b22 /

54+ \ a21 a22 / \ b21 b22 /

55+-}

43multiply : Transform2D -> Transform2D -> Transform2D

56multiply : Transform2D -> Transform2D -> Transform2D

44multiply = Native.Transform2D.multiply

57multiply = Native.Transform2D.multiply

libraries/WebSocket.elm+11−5

@@ -1,14 +1,20 @@

1−-- A library for low latency HTTP communication. See the HTTP library for

2−-- standard requests like GET, POST, etc.

3module WebSocket where

1module WebSocket where

2+{-| A library for low latency HTTP communication. See the HTTP library for

3+standard requests like GET, POST, etc. The API of this library is likely to

4+change to make it more flexible.

5+

6+# Open a Connection

7+@docs connect

8+-}

4

9

5import Signal (Signal)

10import Signal (Signal)

6import Basics (String)

11import Basics (String)

7import Native.WebSocket

12import Native.WebSocket

8

13

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

14+{-| Create a web-socket. The first argument is the URL of the desired

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

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

11−-- and the resulting signal contains the incoming ones.

16+and the resulting signal contains the incoming ones.

17+-}

12connect : String -> Signal String -> Signal String

18connect : String -> Signal String -> Signal String

13connect = Native.WebSocket.connect

19connect = Native.WebSocket.connect

14

20

libraries/Window.elm+13−4

@@ -1,18 +1,27 @@

1

2module Window where

3

4+{-| Provides information about the container that your Elm program lives in.

5+When you embed Elm in a `<div>` it gives the dimensions of the container, not

6+the whole window.

7+

8+# Dimensions

9+@docs dimensions, width, height

10+

11+-}

12+

4import Signal (Signal)

13import Signal (Signal)

5import Native.Window

14import Native.Window

6

15

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

16+{-| The current width and height of the window (i.e. the area viewable to the

8−-- user, not including scroll bars).

17+user, not including scroll bars). -}

9dimensions : Signal (Int,Int)

18dimensions : Signal (Int,Int)

10dimensions = Native.Window.dimensions

19dimensions = Native.Window.dimensions

11

20

12−-- The current width of the window.

21+{-| The current width of the window. -}

13width : Signal Int

22width : Signal Int

14width = Native.Window.width

23width = Native.Window.width

15

24

16−-- The current height of the window.

25+{-| The current height of the window. -}

17height : Signal Int

26height : Signal Int

18height = Native.Window.height

27height = Native.Window.height

runtime/Init.js+6−9

@@ -13,7 +13,7 @@ Elm.fullscreen = function(module) {

13 return init(ElmRuntime.Display.FULLSCREEN, container, module);

14};

15

16−Elm.domNode = function(container, module) {

16+Elm.embed = function(module, container) {

17 var tag = container.tagName;

18 if (tag !== 'DIV') {

19 throw new Error('Elm.node must be given a DIV, not a ' + tag + '.');

@@ -41,9 +41,6 @@ function init(display, container, module, moduleToReplace) {

41 return changed;

42 }

43

44− container.offsetX = 0;

45− container.offsetY = 0;

46−

47 var listeners = [];

44 var listeners = [];

48 function addListener(relevantInputs, domNode, eventName, func) {

45 function addListener(relevantInputs, domNode, eventName, func) {

49 domNode.addEventListener(eventName, func);

46 domNode.addEventListener(eventName, func);

@@ -99,10 +96,10 @@ function init(display, container, module, moduleToReplace) {

99 var Module = {};

96 var Module = {};

100 var reportAnyErrors = function() {};

97 var reportAnyErrors = function() {};

101 try {

98 try {

102− Module = module(elm);

99+ Module = module.make(elm);

103 } catch(e) {

100 } catch(e) {

104 var directions = "<br/>    Open the developer console for more details."

101 var directions = "<br/>    Open the developer console for more details."

105− Module.main = Elm.Text(elm).text('<code>' + e.message + directions + '</code>');

102+ Module.main = Elm.Text.make(elm).text('<code>' + e.message + directions + '</code>');

106 reportAnyErrors = function() { throw e; }

103 reportAnyErrors = function() { throw e; }

107 }

104 }

108 inputs = ElmRuntime.filterDeadInputs(inputs);

105 inputs = ElmRuntime.filterDeadInputs(inputs);

@@ -150,7 +147,7 @@ function initGraphics(elm, Module) {

150 var signalGraph = Module.main;

147 var signalGraph = Module.main;

151

148

152 // make sure the signal graph is actually a signal & extract the visual model

149 // make sure the signal graph is actually a signal & extract the visual model

153− var Signal = Elm.Signal(elm);

150+ var Signal = Elm.Signal.make(elm);

154 if (!('recv' in signalGraph)) {

151 if (!('recv' in signalGraph)) {

155 signalGraph = Signal.constant(signalGraph);

152 signalGraph = Signal.constant(signalGraph);

156 }

153 }

@@ -164,7 +161,7 @@ function initGraphics(elm, Module) {

164 function domUpdate(newScene, currentScene) {

161 function domUpdate(newScene, currentScene) {

165 ElmRuntime.draw(function(_) {

162 ElmRuntime.draw(function(_) {

166 Render.update(elm.node.firstChild, currentScene, newScene);

163 Render.update(elm.node.firstChild, currentScene, newScene);

167− if (elm.Native.Window) elm.Native.Window.resizeIfNeeded();

164+ if (elm.Native.Window) elm.Native.Window.values.resizeIfNeeded();

168 });

165 });

169 return newScene;

166 return newScene;

170 }

167 }

@@ -172,7 +169,7 @@ function initGraphics(elm, Module) {

172

169

173 // must check for resize after 'renderer' is created so

170 // must check for resize after 'renderer' is created so

174 // that changes show up.

171 // that changes show up.

175− if (elm.Native.Window) elm.Native.Window.resizeIfNeeded();

172+ if (elm.Native.Window) elm.Native.Window.values.resizeIfNeeded();

176

173

177 return renderer;

174 return renderer;

178}

175}

runtime/Render/Collage.js+9−5

@@ -1,9 +1,8 @@

1

2ElmRuntime.Render.Collage = function() {

3−'use strict';

4

3

5var Render = ElmRuntime.use(ElmRuntime.Render.Element);

4var Render = ElmRuntime.use(ElmRuntime.Render.Element);

6−var Transform = Elm.Transform2D({});

5+var Transform = Elm.Transform2D.make({});

7var Utils = ElmRuntime.use(ElmRuntime.Render.Utils);

6var Utils = ElmRuntime.use(ElmRuntime.Render.Utils);

8var newElement = Utils.newElement,

7var newElement = Utils.newElement,

9 extract = Utils.extract, fromList = Utils.fromList,

8 extract = Utils.extract, fromList = Utils.fromList,

@@ -167,6 +166,11 @@ function formToMatrix(form) {

167 return matrix;

166 return matrix;

168}

167}

169

168

169+function str(n) {

170+ if (n < 0.00001 && n > -0.00001) return 0;

171+ return n;

172+}

173+

170function makeTransform(w, h, form, matrices) {

174function makeTransform(w, h, form, matrices) {

171 var props = form.form._0.props;

175 var props = form.form._0.props;

172 var m = A6( Transform.matrix, 1, 0, 0, 1,

176 var m = A6( Transform.matrix, 1, 0, 0, 1,

@@ -176,9 +180,9 @@ function makeTransform(w, h, form, matrices) {

176 for (var i = 0; i < len; ++i) { m = A2( Transform.multiply, m, matrices[i] ); }

180 for (var i = 0; i < len; ++i) { m = A2( Transform.multiply, m, matrices[i] ); }

177 m = A2( Transform.multiply, m, formToMatrix(form) );

181 m = A2( Transform.multiply, m, formToMatrix(form) );

178

182

179− return 'matrix(' + m[0] + ',' + m[3] + ',' +

183+ return 'matrix(' + str( m[0]) + ',' + str( m[3]) + ',' +

180− (-m[1]) + ',' + (-m[4]) + ',' +

184+ str(-m[1]) + ',' + str(-m[4]) + ',' +

181− m[2] + ',' + m[5] + ')';

185+ str( m[2]) + ',' + str( m[5]) + ')';

182}

186}

183

187

184function stepperHelp(list) {

188function stepperHelp(list) {

runtime/Render/Element.js+8−16

@@ -124,19 +124,21 @@ function toPos(pos) {

124 }

125}

126

127+// must clear right, left, top, bottom, and transform

128+// before calling this function

127function setPos(pos,w,h,e) {

129function setPos(pos,w,h,e) {

128 e.style.position = 'absolute';

130 e.style.position = 'absolute';

129 e.style.margin = 'auto';

131 e.style.margin = 'auto';

130 var transform = '';

132 var transform = '';

131 switch(pos.horizontal.ctor) {

133 switch(pos.horizontal.ctor) {

132− case 'P': e.style.right = toPos(pos.x); break;

134+ case 'P': e.style.right = toPos(pos.x); e.style.removeProperty('left'); break;

133 case 'Z': transform = 'translateX(' + ((-w/2)|0) + 'px) ';

135 case 'Z': transform = 'translateX(' + ((-w/2)|0) + 'px) ';

134− case 'N': e.style.left = toPos(pos.x); break;

136+ case 'N': e.style.left = toPos(pos.x); e.style.removeProperty('right'); break;

135 }

137 }

136 switch(pos.vertical.ctor) {

138 switch(pos.vertical.ctor) {

137− case 'N': e.style.bottom = toPos(pos.y); break;

139+ case 'N': e.style.bottom = toPos(pos.y); e.style.removeProperty('top'); break;

138 case 'Z': transform += 'translateY(' + ((-h/2)|0) + 'px)';

140 case 'Z': transform += 'translateY(' + ((-h/2)|0) + 'px)';

139− case 'P': e.style.top = toPos(pos.y); break;

141+ case 'P': e.style.top = toPos(pos.y); e.style.removeProperty('bottom'); break;

140 }

142 }

141 if (transform !== '') addTransform(e.style, transform);

143 if (transform !== '') addTransform(e.style, transform);

142 return e;

144 return e;

@@ -220,18 +222,8 @@ function update(node, curr, next) {

220 }

222 }

221 break;

223 break;

222 case "Container":

224 case "Container":

223− var inner = node.firstChild;

225+ update(node.firstChild, currE._1, nextE._1)

224− if (!update(inner, currE._1, nextE._1)) {

226+ setPos(nextE._0, nextE._1.props.width, nextE._1.props.height, node.firstChild);

225− if (nextE._0.horizontal.ctor !== currE._0.horizontal.ctor) {

226− inner.style.left = inner.style.right = 'none';

227− removeTransform(inner.style);

228− }

229− if (nextE._0.vertical.ctor !== currE._0.vertical.ctor) {

230− inner.style.top = inner.style.bottom = 'none';

231− removeTransform(inner.style);

232− }

233− }

234− setPos(nextE._0, nextE._1.props.width, nextE._1.props.height, inner);

235 break;

227 break;

236 case "Custom":

228 case "Custom":

237 if (currE.type === nextE.type) {

229 if (currE.type === nextE.type) {

runtime/Render/Utils.js+2−3

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

1

2ElmRuntime.Render.Utils = function() {

3−'use strict';

4

3

5function newElement(elementType) {

4function newElement(elementType) {

6 var e = document.createElement(elementType);

5 var e = document.createElement(elementType);

@@ -34,7 +33,7 @@ function removeTransform(style) {

34 style.OTransform = 'none';

33 style.OTransform = 'none';

35}

34}

36

35

37−var List = Elm.Native.List({});

36+var List = Elm.Native.List.make({});

38

37

39return {addTo:addTo,

38return {addTo:addTo,

40 newElement:newElement,

39 newElement:newElement,

@@ -42,7 +41,7 @@ return {addTo:addTo,

42 fromList: List.toArray,

41 fromList: List.toArray,

43 fromString: function(s) { return List.toArray(s).join(''); },

42 fromString: function(s) { return List.toArray(s).join(''); },

44 toString: List.fromArray,

43 toString: List.fromArray,

45− eq: Elm.Native.Utils({}).eq,

44+ eq: Elm.Native.Utils.make({}).eq,

46 addTransform: addTransform,

45 addTransform: addTransform,

47 removeTransform: removeTransform

46 removeTransform: removeTransform

48 };

47 };

server/LICENSE+1−1

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

2

4

server/Server.hs+30−13

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

1−

2module Main where

1module Main where

3

2

4−import Control.Monad (msum,guard)

3+import Control.Monad (msum,guard,when)

5import Control.Monad.Trans (MonadIO(liftIO))

4import Control.Monad.Trans (MonadIO(liftIO))

6import Data.List (isPrefixOf, isSuffixOf, (\\))

5import Data.List (isPrefixOf, isSuffixOf, (\\))

7import Data.Version (showVersion)

6import Data.Version (showVersion)

@@ -34,24 +33,37 @@ serve portNumber libLoc = do

34pageTitle :: String -> String

33pageTitle :: String -> String

35pageTitle = dropExtension . takeBaseName

34pageTitle = dropExtension . takeBaseName

36

35

36+defaultCacheDirectory = "elm-server-cache"

37+

37serveElm :: FilePath -> ServerPartT IO Response

38serveElm :: FilePath -> ServerPartT IO Response

38serveElm fp = do

39serveElm fp = do

39− guard (takeExtension fp == ".elm")

40+ fileExists <- liftIO $ doesFileExist file

40− let file = tail fp

41+ guard $ fileExists && takeExtension fp == ".elm"

41− args = [ "--make" ,"--runtime=" ++ runtime, "--cache-dir=elm-server-cache", file ]

42+

42− (_, stdout, _, handle) <- liftIO $ createProcess $ (proc "elm" args) { std_out = CreatePipe }

43+ (_, stdout, _, handle) <- liftIO $ createProcess $

44+ (proc "elm" args) { std_out = CreatePipe }

43 exitCode <- liftIO $ waitForProcess handle

45 exitCode <- liftIO $ waitForProcess handle

44− liftIO $ removeDirectoryRecursive "elm-server-cache"

46+

47+ dirExists <- liftIO $ doesDirectoryExist defaultCacheDirectory

48+ when dirExists $ liftIO $ removeDirectoryRecursive defaultCacheDirectory

49+

45 case (exitCode, stdout) of

50 case (exitCode, stdout) of

51+ (ExitFailure 127, _) ->

52+ badRequest $ toResponse "Error: elm binary not found in your path."

46 (ExitFailure _, Just out) ->

53 (ExitFailure _, Just out) ->

47 do str <- liftIO $ hGetContents out

54 do str <- liftIO $ hGetContents out

48 badRequest $ toResponse str

55 badRequest $ toResponse str

49 (ExitFailure _, Nothing) ->

56 (ExitFailure _, Nothing) ->

50 badRequest $ toResponse "See command line for error message."

57 badRequest $ toResponse "See command line for error message."

51 (ExitSuccess, _) ->

58 (ExitSuccess, _) ->

52− serveFile (asContentType "text/html") ("build" </> replaceExtension file "html")

59+ serveFile

60+ (asContentType "text/html") ("build" </> replaceExtension file "html")

61+

62+ where file = tail fp

63+ args = [ "--make" ,"--runtime=" ++ runtime,

64+ "--cache-dir=" ++ defaultCacheDirectory, file ]

53

65

54−serveLib :: FilePath -> [Char] -> ServerPartT IO Response

66+serveLib :: FilePath -> String -> ServerPartT IO Response

55serveLib libLoc fp = do

67serveLib libLoc fp = do

56 guard (fp == runtime)

68 guard (fp == runtime)

57 serveFile (asContentType "application/javascript") libLoc

69 serveFile (asContentType "application/javascript") libLoc

@@ -63,9 +75,11 @@ parse :: [String] -> IO ()

63parse ("--help":_) = putStrLn usage

75parse ("--help":_) = putStrLn usage

64parse ("--version":_) = putStrLn ("The Elm Server " ++ showVersion version)

76parse ("--version":_) = putStrLn ("The Elm Server " ++ showVersion version)

65parse args =

77parse args =

66− case null remainingArgs of

78+ if null remainingArgs then

67− True -> serve portNumber =<< elmRuntime

79+ serve portNumber =<< elmRuntime

68− False -> putStrLn usageMini

80+ else

81+ putStrLn usageMini

82+

69 where

83 where

70 runtimeArg = filter (isPrefixOf "--runtime-location=") args

84 runtimeArg = filter (isPrefixOf "--runtime-location=") args

71 portArg = filter (isPrefixOf "--port=") args

85 portArg = filter (isPrefixOf "--port=") args

@@ -73,7 +87,10 @@ parse args =

73

87

74 argValue arg = tail $ dropWhile (/= '=') (head arg)

88 argValue arg = tail $ dropWhile (/= '=') (head arg)

75 portNumber = if null portArg then 8000 else read (argValue portArg) :: Int

89 portNumber = if null portArg then 8000 else read (argValue portArg) :: Int

76− elmRuntime = if null runtimeArg then Elm.runtime else return $ argValue runtimeArg

90+ elmRuntime = if null runtimeArg then

91+ Elm.runtime

92+ else

93+ return $ argValue runtimeArg

77

94

78usageMini :: String

95usageMini :: String

79usageMini =

96usageMini =

server/elm-server.cabal+1−1

@@ -10,7 +10,7 @@ License-file: LICENSE

10

11Author: Evan Czaplicki

12Maintainer: info@elm-lang.org

14

15Category: Compiler, Language

16