git.iko.soy/elk
on master help sign in
Merge branch 'make'
dc0c57aEvan Czaplicki
Elm.cabaldeleted−308
compare with master
unifiedsplit
@@ -1,308 +0,0 @@
1−Name: Elm
2−Version: 0.13
3−Synopsis: The Elm language module.
4−Description: Elm aims to make client-side web-development more pleasant.
5− It is a statically/strongly typed, functional reactive
6− language to HTML, CSS, and JS. This package provides a
7− library for Elm compilation in Haskell and a compiler
8− executable.
9−
10−Homepage: http://elm-lang.org
11−
12−License: BSD3
13−License-file: LICENSE
14−
15−Author: Evan Czaplicki
16−Maintainer: info@elm-lang.org
17−Copyright: Copyright: (c) 2011-2014 Evan Czaplicki
18−
19−Category: Compiler, Language
20−
21−Build-type: Custom
22−
23−Extra-source-files: changelog.md
24−Data-dir: data
25−Data-files: elm-runtime.js interfaces.data docs.json
26−Cabal-version: >=1.9
27−
28−source-repository head
29− type: git
30− location: git://github.com/elm-lang/Elm.git
31−
32−Library
33− exposed-modules: Elm.Internal.Dependencies,
34− Elm.Internal.Documentation,
35− Elm.Internal.Name,
36− Elm.Internal.Paths,
37− Elm.Internal.Utils,
38− Elm.Internal.Version
39− Hs-Source-Dirs: compiler
40− other-modules: AST.Annotation,
41− AST.Declaration,
42− AST.Expression.General,
43− AST.Expression.Source,
44− AST.Expression.Valid,
45− AST.Expression.Canonical,
46− AST.Helpers,
47− AST.Literal,
48− AST.Module,
49− AST.Pattern,
50− AST.PrettyPrint,
51− AST.Type,
52− AST.Variable,
53− Generate.JavaScript,
54− Generate.JavaScript.Helpers,
55− Generate.JavaScript.Ports,
56− Generate.JavaScript.Variable,
57− Generate.Markdown,
58− Generate.Html,
59− Generate.Cases,
60− Transform.Canonicalize,
61− Transform.Canonicalize.Environment,
62− Transform.Canonicalize.Setup,
63− Transform.Canonicalize.Type,
64− Transform.Canonicalize.Variable,
65− Transform.Check,
66− Transform.Expression,
67− Transform.Declaration,
68− Transform.Definition,
69− Transform.Interface,
70− Transform.SortDefinitions,
71− Transform.Substitute,
72− Metadata.Prelude,
73− Parse.Binop,
74− Parse.Declaration,
75− Parse.Expression,
76− Parse.Helpers,
77− Parse.Literal,
78− Parse.Module,
79− Parse.Parse,
80− Parse.Pattern,
81− Parse.Type,
82− Type.Constrain.Expression,
83− Type.Constrain.Literal,
84− Type.Constrain.Pattern,
85− Type.Environment,
86− Type.ExtraChecks,
87− Type.Fragment,
88− Type.Inference,
89− Type.PrettyPrint,
90− Type.Solve,
91− Type.State,
92− Type.Type,
93− Type.Unify,
94− Build.Dependencies,
95− Build.File,
96− Build.Flags,
97− Build.Interface,
98− Build.Print,
99− Build.Source,
100− Build.Utils,
101− Paths_Elm
102−
103− Build-depends: aeson >= 0.7 && < 0.9,
104− aeson-pretty >= 0.7 && < 0.8,
105− base >=4.2 && <5,
106− binary >= 0.7.0.0 && < 0.8,
107− blaze-html >= 0.5 && < 0.8,
108− blaze-markup >= 0.5.1 && < 0.7,
109− bytestring >= 0.9 && < 0.11,
110− cheapskate >= 0.1 && < 0.2,
111− cmdargs >= 0.7 && < 0.11,
112− containers >= 0.3 && < 0.6,
113− directory >= 1.0 && < 2.0,
114− filepath >= 1 && < 2.0,
115− highlighting-kate >= 0.5 && < 0.6,
116− indents >= 0.3 && < 0.4,
117− language-ecmascript >=0.15 && < 0.17,
118− language-glsl >= 0.0.2 && < 0.2,
119− mtl >= 2 && < 3,
120− parsec >= 3.1.1 && < 3.5,
121− pretty >= 1.0 && < 2.0,
122− text >= 1 && < 2,
123− transformers >= 0.2 && < 0.5,
124− union-find >= 0.2 && < 0.3,
125− unordered-containers >= 0.1 && < 0.3
126−
127−Executable elm
128− Main-is: Compiler.hs
129− ghc-options: -threaded -O2
130− Hs-Source-Dirs: compiler
131− other-modules: AST.Annotation,
132− AST.Declaration,
133− AST.Expression.General,
134− AST.Expression.Source,
135− AST.Expression.Valid,
136− AST.Expression.Canonical,
137− AST.Helpers,
138− AST.Literal,
139− AST.Module,
140− AST.Pattern,
141− AST.PrettyPrint,
142− AST.Type,
143− AST.Variable,
144− Generate.JavaScript,
145− Generate.JavaScript.Helpers,
146− Generate.JavaScript.Ports,
147− Generate.JavaScript.Variable,
148− Generate.Markdown,
149− Generate.Html,
150− Generate.Cases,
151− Transform.Canonicalize,
152− Transform.Canonicalize.Environment,
153− Transform.Canonicalize.Setup,
154− Transform.Canonicalize.Type,
155− Transform.Canonicalize.Variable,
156− Transform.Check,
157− Transform.Expression,
158− Transform.Declaration,
159− Transform.Definition,
160− Transform.Interface,
161− Transform.SortDefinitions,
162− Transform.Substitute,
163− Metadata.Prelude,
164− Parse.Binop,
165− Parse.Declaration,
166− Parse.Expression,
167− Parse.Helpers,
168− Parse.Literal,
169− Parse.Module,
170− Parse.Parse,
171− Parse.Pattern,
172− Parse.Type,
173− Type.Constrain.Expression,
174− Type.Constrain.Literal,
175− Type.Constrain.Pattern,
176− Type.Environment,
177− Type.ExtraChecks,
178− Type.Fragment,
179− Type.Inference,
180− Type.PrettyPrint,
181− Type.Solve,
182− Type.State,
183− Type.Type,
184− Type.Unify,
185− Build.Dependencies,
186− Build.File,
187− Build.Flags,
188− Build.Interface,
189− Build.Print,
190− Build.Source,
191− Build.Utils,
192− Paths_Elm
193−
194− Build-depends: aeson >= 0.7 && < 0.9,
195− aeson-pretty >= 0.7 && < 0.8,
196− base >=4.2 && <5,
197− binary >= 0.7.0.0 && < 0.8,
198− blaze-html >= 0.5 && < 0.8,
199− blaze-markup >= 0.5.1 && < 0.7,
200− bytestring >= 0.9 && < 0.11,
201− cheapskate >= 0.1 && < 0.2,
202− cmdargs >= 0.7 && < 0.11,
203− containers >= 0.3 && < 0.6,
204− directory >= 1.0 && < 2.0,
205− filepath >= 1 && < 2.0,
206− highlighting-kate >= 0.5 && < 0.6,
207− indents >= 0.3 && < 0.4,
208− language-ecmascript >=0.15 && < 0.17,
209− language-glsl >= 0.0.2 && < 0.2,
210− mtl >= 2 && < 3,
211− parsec >= 3.1.1 && < 3.5,
212− pretty >= 1.0 && < 2.0,
213− text >= 1 && < 2,
214− transformers >= 0.2 && < 0.5,
215− union-find >= 0.2 && < 0.3,
216− unordered-containers >= 0.1 && < 0.3
217−
218−Executable elm-doc
219− Main-is: Docs.hs
220− Hs-Source-Dirs: compiler
221− other-modules: AST.Annotation,
222− AST.Declaration,
223− AST.Expression.General,
224− AST.Helpers,
225− AST.Literal,
226− AST.Module,
227− AST.Pattern,
228− AST.PrettyPrint,
229− AST.Type,
230− AST.Variable,
231− Parse.Binop,
232− Parse.Declaration,
233− Parse.Expression,
234− Parse.Helpers,
235− Parse.Literal,
236− Parse.Module,
237− Parse.Pattern,
238− Parse.Type
239−
240− Build-depends: aeson >= 0.7 && < 0.9,
241− aeson-pretty >= 0.7 && < 0.8,
242− base >=4.2 && <5,
243− binary >= 0.7.0.0 && < 0.8,
244− bytestring >= 0.9 && < 0.11,
245− cmdargs >= 0.7 && < 0.11,
246− containers >= 0.3 && < 0.6,
247− directory >= 1.0 && < 2.0,
248− filepath >= 1 && < 2.0,
249− indents >= 0.3 && < 0.4,
250− language-glsl >= 0.0.2 && < 0.2,
251− mtl >= 2 && < 3,
252− parsec >= 3.1.1 && < 3.5,
253− pretty >= 1.0 && < 2.0,
254− text >= 1 && < 2,
255− transformers >= 0.2 && < 0.5,
256− union-find >= 0.2 && < 0.3
257−
258−Test-Suite compiler-tests
259− Type: exitcode-stdio-1.0
260− Hs-Source-Dirs: tests/compiler, compiler
261− Main-is: CompilerTest.hs
262− other-modules: Tests.Compiler
263− Tests.Property
264− Tests.Property.Arbitrary
265− AST.Helpers
266− AST.Literal
267− AST.PrettyPrint
268− build-depends: test-framework > 0.8 && < 0.9,
269− test-framework-hunit >= 0.3 && < 0.4,
270− test-framework-quickcheck2 >= 0.3 && < 0.4,
271− HUnit >= 1.1 && < 2,
272− QuickCheck >= 2 && < 3,
273− aeson >= 0.7 && < 0.9,
274− aeson-pretty >= 0.7 && < 0.8,
275− base >=4.2 && <5,
276− binary >= 0.7.0.0 && < 0.8,
277− blaze-html >= 0.5 && < 0.8,
278− blaze-markup >= 0.5.1 && < 0.7,
279− bytestring >= 0.9 && < 0.11,
280− cheapskate >= 0.1 && < 0.2,
281− cmdargs >= 0.7 && < 0.11,
282− containers >= 0.3 && < 0.6,
283− directory >= 1.0 && < 2.0,
284− Elm,
285− filemanip >= 0.3.5 && < 0.4,
286− filepath >= 1 && < 2.0,
287− highlighting-kate >= 0.5 && < 0.6,
288− indents >= 0.3 && < 0.4,
289− language-ecmascript >=0.15 && < 0.17,
290− language-glsl >= 0.0.2 && < 0.2,
291− mtl >= 2 && < 3,
292− parsec >= 3.1.1 && < 3.5,
293− pretty >= 1.0 && < 2.0,
294− process,
295− text >= 1 && < 2,
296− transformers >= 0.2 && < 0.5,
297− union-find >= 0.2 && < 0.3,
298− unordered-containers >= 0.1 && < 0.3
299−
300−Test-Suite library-tests
301− Type: exitcode-stdio-1.0
302− Hs-Source-Dirs: tests/libraries
303− Main-is: LibraryTest.hs
304− build-depends: base >= 4.2 && <5,
305− directory >= 1.0 && < 2.0,
306− Elm,
307− filepath >= 1 && < 2.0,
308− process >= 1 && < 2.0
Setup.hsdeleted−147
@@ -1,147 +0,0 @@
1−{-# OPTIONS_GHC -W #-}
2−import Distribution.Simple
3−import Distribution.Simple.LocalBuildInfo
4−import Distribution.Simple.Setup
5−import Distribution.PackageDescription
6−
7−import System.Directory
8−import System.FilePath
9−import System.IO
10−import System.Process
11−
12−import qualified Data.Binary as Binary
13−import qualified Data.ByteString.Lazy as BS
14−import qualified Data.List as List
15−
16−-- OVERVIEW
17−-- --------
18−-- Add a post-build callout that compiles the standard libraries with the new
19−-- compiler before cabal copies static files to actually install things.
20−
21−assetsDir :: FilePath
22−assetsDir = "data"
23−
24−tempDir :: FilePath
25−tempDir = "temp"
26−
27−-- The runtime is called:
28−runtime :: FilePath
29−runtime = assetsDir </> "elm-runtime.js"
30−
31−-- The runtime is called:
32−docs :: FilePath
33−docs = assetsDir </> "docs.json"
34−
35−-- The interfaces for the Standard Libraries live in:
36−interfaces :: FilePath
37−interfaces = assetsDir </> "interfaces.data"
38−
39−elm :: LocalBuildInfo -> FilePath
40−elm lbi = buildDir lbi </> "elm" </> "elm"
41−
42−document :: LocalBuildInfo -> FilePath
43−document lbi = buildDir lbi </> "elm-doc" </> "elm-doc"
44−
45−-- Care! This appears to be based on an unstable API
46−-- See: http://www.haskell.org/cabal/release/cabal-latest/doc/API/Cabal/Distribution-Simple.html#2
47−
48−
49−main :: IO ()
50−main = defaultMainWithHooks simpleUserHooks { postBuild = myPostBuild }
51−
52−
53−
54−-- Post Build
55−
56−myPostBuild :: Args -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO ()
57−myPostBuild args flags packageDescription lbi = do
58− putStrLn "Custom build step: compiling standard libraries"
59− (elmos, elmis) <- compileLibraries lbi
60− putStrLn "Custom build step: build interfaces.data"
61− buildInterfaces elmis
62− putStrLn "Custom build step: build elm-runtime.js"
63− buildRuntime elmos
64− putStrLn "Custom build step: build docs.json"
65− buildDocs
66− removeDirectoryRecursive tempDir
67− removeDirectoryRecursive ("libraries" </> "docs")
68− postBuild simpleUserHooks args flags packageDescription lbi
69−
70−
71−compileLibraries lbi = do
72− createDirectoryIfMissing True tempDir
73− createDirectoryIfMissing True assetsDir
74− out_c <- canonicalizePath tempDir -- temp (root folder)
75− elm_c <- canonicalizePath (elm lbi) -- dist/build/elm/elm
76− doc_c <- canonicalizePath (document lbi) -- dist/build/elm-doc/elm-doc
77− rtd_c <- canonicalizePath assetsDir -- data
78−
79− let make file = do
80− let args =
81− [ "--only-js"
82− , "--make"
83− , "--no-prelude"
84− , "--cache-dir=" ++ out_c
85− , "--build-dir=" ++ out_c
86− , file
87− ]
88− let arg = Just [("Elm_datadir", rtd_c)]
89− handle <- runProcess elm_c args Nothing arg Nothing Nothing Nothing
90− _exitCode <- waitForProcess handle
91− return ( out_c </> replaceExtension file "elmo"
92− , out_c </> replaceExtension file "elmi"
93− )
94−
95− setCurrentDirectory "libraries"
96− paths <- getFiles ".elm" "."
97− files <- unzip `fmap` mapM make paths
98− mapM_ (\path -> rawSystem doc_c [path]) paths
99− setCurrentDirectory ".."
100− return files
101−
102−buildInterfaces :: [FilePath] -> IO ()
103−buildInterfaces elmis = do
104− createDirectoryIfMissing True assetsDir
105− ifaceHandle <- openBinaryFile interfaces WriteMode
106− BS.hPut ifaceHandle (Binary.encode (length elmis))
107− let append file = do
108− handle <- openBinaryFile file ReadMode
109− bits <- hGetContents handle
110− length bits `seq` hPutStr ifaceHandle bits
111− hClose handle
112− mapM_ append elmis
113− hClose ifaceHandle
114−
115−buildRuntime :: [FilePath] -> IO ()
116−buildRuntime elmos = do
117− createDirectoryIfMissing True assetsDir
118− writeFile runtime
119− "'use strict';\n\
120− \var Elm = {}; Elm.Native = {}; Elm.Native.Graphics = {};\n\
121− \var ElmRuntime = {}; ElmRuntime.Render = {};\n"
122− mapM_ (appendTo runtime) =<< getFiles ".js" "libraries"
123− mapM_ (appendTo runtime) elmos
124− mapM_ (appendTo runtime) =<< getFiles ".js" "runtime"
125−
126−buildDocs :: IO ()
127−buildDocs = do
128− createDirectoryIfMissing True assetsDir
129− writeFile docs "[\n"
130− json <- getFiles ".json" ("libraries" </> "docs")
131− let appends = map (appendTo docs) json
132− addCommas = List.intersperse (appendFile docs ",\n")
133− sequence_ (addCommas appends)
134− appendFile docs "\n]"
135−
136−getFiles ext dir = do
137− contents <- map (dir </>) `fmap` getDirectoryContents dir
138− let files = filter (\f -> takeExtension f == ext) contents
139− dirs = filter (not . hasExtension) contents
140− filess <- mapM (getFiles ext) dirs
141− return (files ++ concat filess)
142−
143−appendTo :: FilePath -> FilePath -> IO ()
144−appendTo destination source = do
145− str <- readFile source
146− length str `seq` return ()
147− appendFile destination str
changelog.md+7
@@ -1,4 +1,11 @@
1
1
2+## 0.14
3+
4+#### Breaking Changes
5+
6+ * Keyword `data` renamed to `type`
7+ * Keyword `type` renamed to `type alias`
8+
2## 0.13
9## 0.13
3
10
4#### Improvements:
11#### Improvements:
compiler/Build/Dependencies.hsdeleted−158
@@ -1,158 +0,0 @@
1−{-# OPTIONS_GHC -W #-}
2−module Build.Dependencies (Recipe(..), getBuildRecipe, readDeps) where
3−
4−import Control.Monad.Error
5−import qualified Control.Monad.State as State
6−import qualified Data.Graph as Graph
7−import qualified Data.List as List
8−import qualified Data.Map as Map
9−import qualified Data.Set as Set
10−import System.Directory
11−import System.FilePath as FP
12−
13−import qualified AST.Module as Module
14−import qualified Parse.Parse as Parse
15−import qualified Elm.Internal.Paths as Path
16−import qualified Elm.Internal.Name as N
17−import qualified Elm.Internal.Version as V
18−import qualified Elm.Internal.Dependencies as Deps
19−
20−data Recipe = Recipe
21− { _elmFiles :: [FilePath]
22− , _jsFiles :: [FilePath]
23− }
24−
25−getBuildRecipe :: [FilePath] -> Module.Interfaces -> FilePath -> ErrorT String IO Recipe
26−getBuildRecipe srcDirs builtIns root =
27− do directories <- getDependencies
28− jsFiles <- nativeFiles ("." : directories)
29− let allSrcDirs = srcDirs ++ directories
30− nodes <- collectDependencies allSrcDirs builtIns root
31− elmFiles <- sortElmFiles nodes
32− return (Recipe elmFiles jsFiles)
33−
34−-- | Based on the projects elm_dependencies.json, find all of the paths and
35−-- dependency information we might need.
36−getDependencies :: ErrorT String IO [FilePath]
37−getDependencies =
38− do exists <- liftIO $ doesFileExist Path.dependencyFile
39− if not exists then return [] else getPaths
40− where
41− getPaths :: ErrorT String IO [FilePath]
42− getPaths =
43− Deps.withDeps Path.dependencyFile $ \deps ->
44− mapM getPath (Deps.dependencies deps)
45−
46− getPath :: (N.Name, V.Version) -> ErrorT String IO FilePath
47− getPath (name,version) = do
48− let path = Path.dependencyDirectory </> N.toFilePath name </> show version
49− exists <- liftIO $ doesDirectoryExist path
50− if exists
51− then return path
52− else throwError (notFound name version)
53−
54− notFound :: N.Name -> V.Version -> String
55− notFound name version =
56− unlines
57− [ "Your " ++ Path.dependencyFile ++ " file says you depend on library"
58− , show name ++ " " ++ show version ++ " but it was not found."
59− , "You may need to install it with:"
60− , ""
61− , " elm-get install " ++ show name ++ " " ++ show version ]
62−
63−nativeFiles :: [FilePath] -> ErrorT String IO [FilePath]
64−nativeFiles directories =
65− do exists <- liftIO $ doesFileExist Path.dependencyFile
66− if not exists
67− then return []
68− else concat `fmap` mapM getNativeFiles directories
69− where
70− getNativeFiles dir =
71− Deps.withDeps (dir </> Path.dependencyFile) $ \deps ->
72− return (map (toPath dir) (Deps.native deps))
73−
74− toPath dir moduleName =
75− dir </> joinPath (split moduleName) <.> "js"
76−
77−split :: String -> [String]
78−split moduleName = go [] moduleName
79− where
80− go paths str =
81− case break (=='.') str of
82− (path, _:rest) -> go (paths ++ [path]) rest
83− (path, []) -> paths ++ [path]
84−
85−type DependencyNode = (FilePath, String, [String])
86−
87−sortElmFiles :: [DependencyNode] -> ErrorT String IO [FilePath]
88−sortElmFiles depends =
89− if null mistakes
90− then return (concat sccs)
91− else throwError $ msg ++ unlines (map show mistakes)
92− where
93− sccs = map Graph.flattenSCC $ Graph.stronglyConnComp depends
94−
95− mistakes = filter (\scc -> length scc > 1) sccs
96− msg = "A cyclical module dependency or was detected in:\n"
97−
98−collectDependencies :: [FilePath] -> Module.Interfaces -> FilePath
99− -> ErrorT String IO [DependencyNode]
100−collectDependencies srcDirs rawBuiltIns filePath =
101− State.evalStateT (go Nothing filePath) Set.empty
102− where
103− builtIns :: Set.Set String
104− builtIns = Set.fromList $ Map.keys rawBuiltIns
105−
106− go :: Maybe String -> FilePath -> State.StateT (Set.Set String) (ErrorT String IO) [DependencyNode]
107− go parentModuleName filePath = do
108− filePath' <- lift $ findSrcFile parentModuleName srcDirs filePath
109− (moduleName, deps) <- lift $ readDeps filePath'
110− seen <- State.get
111− let realDeps = Set.difference (Set.fromList deps) builtIns
112− newDeps = Set.difference (Set.filter (not . isNative) realDeps) seen
113− State.put (Set.insert moduleName (Set.union newDeps seen))
114− rest <- mapM (go (Just moduleName) . toFilePath) (Set.toList newDeps)
115− return ((makeRelative "." filePath', moduleName, Set.toList realDeps) : concat rest)
116−
117−readDeps :: FilePath -> ErrorT String IO (String, [String])
118−readDeps path = do
119− txt <- lift $ readFile path
120− case Parse.dependencies txt of
121− Right o -> return o
122− Left err -> throwError $ msg ++ show err
123− where msg = "Error resolving dependencies in " ++ path ++ ":\n"
124−
125−findSrcFile :: Maybe String -> [FilePath] -> FilePath -> ErrorT String IO FilePath
126−findSrcFile parentModuleName dirs path =
127− foldr tryDir notFound dirs
128− where
129− tryDir dir next = do
130− let path' = dir </> path
131− exists <- liftIO $ doesFileExist path'
132− if exists
133− then return path'
134− else next
135−
136− parentModuleName' =
137− case parentModuleName of
138− Just name -> "module '" ++ name ++ "'"
139− Nothing -> "the main module"
140−
141− notFound = throwError $ unlines
142− [ "When finding the imports declared in " ++ parentModuleName' ++ ", could not find file: " ++ path
143− , " If you created this module, but it is in a subdirectory that does not"
144− , " exactly match the module name, you may need to use the --src-dir flag."
145− , ""
146− , " If it is part of a 3rd party library, it needs to be declared"
147− , " as a dependency in your project's " ++ Path.dependencyFile ++ " file."
148− ]
149−
150−isNative :: String -> Bool
151−isNative name = List.isPrefixOf "Native." name
152−
153−toFilePath :: String -> FilePath
154−toFilePath name = map swapDots name ++ ext
155− where
156− swapDots '.' = '/'
157− swapDots c = c
158− ext = if isNative name then ".js" else ".elm"
compiler/Build/File.hsdeleted−176
@@ -1,176 +0,0 @@
1−{-# OPTIONS_GHC -W #-}
2−module Build.File (build) where
3−
4−import Control.Applicative ((<$>))
5−import Control.Monad.Error (runErrorT)
6−import Control.Monad.RWS.Strict
7−import System.Directory
8−import System.Exit
9−import System.FilePath
10−import System.IO
11−
12−import qualified Data.Binary as Binary
13−import qualified Data.List as List
14−import qualified Data.Maybe as Maybe
15−import qualified Data.Map as Map
16−import qualified Data.ByteString.Lazy as L
17−
18−import qualified Build.Dependencies as Deps
19−import qualified Build.Flags as Flag
20−import qualified Build.Interface as Interface
21−import qualified Build.Print as Print
22−import qualified Build.Source as Source
23−import qualified Build.Utils as Utils
24−import qualified Generate.JavaScript as JS
25−import qualified Parse.Module as Parser
26−import qualified AST.Module as Module
27−
28−-- Reader: Runtime flags, always accessible
29−-- Writer: Remember the last module to be accessed
30−-- State: Build up a map of the module interfaces
31−type BuildT m a = RWST Flag.Flags (Last String) BInterfaces m a
32−type Build a = BuildT IO a
33−
34−-- Interfaces, remembering if something was recompiled
35−type BInterfaces = Map.Map String (Bool, Module.Interface)
36−
37−evalBuild :: Flag.Flags -> Module.Interfaces -> Build ()
38− -> IO (Map.Map String Module.Interface, Maybe String)
39−evalBuild flags interfaces build =
40− do (ifaces, moduleNames) <- execRWST build flags (fmap notUpdated interfaces)
41− return (fmap snd ifaces, getLast moduleNames)
42− where
43− notUpdated iface = (False, iface)
44−
45−-- | Builds a list of files, returning the moduleName of the last one.
46−-- Returns \"\" if the list is empty
47−build :: Flag.Flags -> Module.Interfaces -> [FilePath] -> IO String
48−build flags interfaces files =
49− do (ifaces, topName) <- evalBuild flags interfaces (buildAll files)
50− let removeTopName = Maybe.maybe id Map.delete topName
51− mapM_ (checkPorts topName) (Map.toList $ removeTopName ifaces)
52− return $ Maybe.fromMaybe "" topName
53− where
54− checkPorts topName (name,iface)
55− | null ports = return ()
56− | otherwise = Print.failure msg
57− where
58− ports = Module.iPorts iface
59− msg = concat
60− [ "Port Error: ports may only appear in the main module, but\n"
61− , " sub-module ", name, " declares the following port"
62− , if length ports == 1 then "" else "s", ": "
63− , List.intercalate ", " ports
64− , case topName of
65− Nothing -> ""
66− Just tname -> "\n All ports must appear in module " ++ tname
67− ]
68−
69−buildAll :: [FilePath] -> Build ()
70−buildAll fs = mapM_ (uncurry build1) (zip [1..] fs)
71− where build1 :: Integer -> FilePath -> Build ()
72− build1 num fname = do
73− shouldCompile <- shouldBeCompiled fname
74− if shouldCompile
75− then compile number fname
76− else retrieve fname
77−
78− where number = join ["[", show num, " of ", show total, "]"]
79−
80− total = length fs
81−
82−shouldBeCompiled :: FilePath -> Build Bool
83−shouldBeCompiled filePath = do
84− flags <- ask
85− let alreadyCompiled = liftIO $ do
86− existsi <- doesFileExist (Utils.elmi flags filePath)
87− existso <- doesFileExist (Utils.elmo flags filePath)
88− return $ existsi && existso
89−
90− outDated = liftIO $ do
91− tsrc <- getModificationTime filePath
92− tint <- getModificationTime (Utils.elmo flags filePath)
93− return (tsrc > tint)
94−
95− dependenciesUpdated = do
96− eDeps <- liftIO . runErrorT $ Deps.readDeps filePath
97− case eDeps of
98− -- Should never actually reach here
99− Left err -> liftIO $ Print.failure err
100− Right (_, deps) -> anyM wasCompiled deps
101−
102−
103− in (not <$> alreadyCompiled) `orM` outDated `orM` dependenciesUpdated
104−
105−wasCompiled :: String -> Build Bool
106−wasCompiled modul = maybe False fst . Map.lookup modul <$> get
107−
108−-- Short-circuiting monadic (||)
109−infixr 2 `orM`
110−orM :: (Monad m) => m Bool -> m Bool -> m Bool
111−orM m1 m2 = do b1 <- m1
112− if b1
113− then return b1
114− else m2
115−
116−anyM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool
117−anyM f = foldr (orM . f) (return False)
118−
119−retrieve :: FilePath -> Build ()
120−retrieve filePath = do
121− flags <- ask
122− iface <- liftIO $ Interface.load (Utils.elmi flags filePath)
123− case Interface.isValid filePath iface of
124− Right (name, interface) ->
125− do liftIO $ when (Flag.print_types flags) (Print.types (Module.iTypes interface))
126− update name interface False
127−
128− Left err -> liftIO $ Print.failure err
129−
130−compile :: String -> FilePath -> Build ()
131−compile number filePath =
132− do flags <- ask
133− binterfaces <- get
134− source <- liftIO $ readFile filePath
135− let interfaces = snd <$> binterfaces
136− name = getName source
137− liftIO $ do
138− printStatus name
139− createDirectoryIfMissing True (Flag.cache_dir flags)
140− createDirectoryIfMissing True (Flag.build_dir flags)
141−
142− canonicalModule <-
143− liftIO $ case Source.build (Flag.no_prelude flags) interfaces source of
144− Right modul -> return modul
145− Left errors -> do Print.errors errors
146− exitFailure
147−
148− liftIO $ when (Flag.print_types flags) $ do
149− Print.types (Module.types (Module.body canonicalModule))
150−
151− let newInters = Module.toInterface canonicalModule
152− generateCache name newInters canonicalModule
153− update name newInters True
154−
155− where
156− getName source = case Parser.getModuleName source of
157− Just n -> n
158− Nothing -> "Main"
159−
160− printStatus name =
161− hPutStrLn stdout $ concat [ number, " Compiling ", name
162− , replicate (max 1 (20 - length name)) ' '
163− , "( " ++ filePath ++ " )" ]
164−
165− generateCache name interfs canonicalModule = do
166− flags <- ask
167− liftIO $ do
168− createDirectoryIfMissing True . dropFileName $ Utils.elmi flags filePath
169− writeFile (Utils.elmo flags filePath) (JS.generate canonicalModule)
170− withBinaryFile (Utils.elmi flags filePath) WriteMode $ \handle ->
171− L.hPut handle (Binary.encode (name, interfs))
172−
173−update :: String -> Module.Interface -> Bool -> Build ()
174−update name inter wasUpdated =
175− do modify (Map.insert name (wasUpdated, inter))
176− tell (Last . Just $ name)
compiler/Build/Interface.hsdeleted−41
@@ -1,41 +0,0 @@
1−{-# OPTIONS_GHC -W #-}
2−module Build.Interface (load,isValid) where
3−
4−import qualified Data.ByteString.Lazy as L
5−import qualified Data.Binary as Binary
6−
7−import qualified Build.Print as Print
8−import qualified Elm.Internal.Version as Version
9−import System.Directory (doesFileExist)
10−import AST.Module as Module
11−
12−load :: Binary.Binary a => FilePath -> IO a
13−load filePath =
14− do exists <- doesFileExist filePath
15− case exists of
16− False -> Print.failure $ "Unable to find file " ++ filePath ++ " for deserialization!"
17− True -> do
18− bytes <- L.readFile filePath
19− case Binary.decodeOrFail bytes of
20− Right (_, _, binaryInfo) -> return binaryInfo
21− Left (_, offset, err) -> Print.failure $ msg offset err
22−
23− where
24− msg offset err = concat
25− [ "Error reading build artifact: ", filePath, "\n"
26− , " '", err, "' at offset ", show offset, "\n"
27− , " The file was generated by a previous build and may be outdated or corrupt.\n"
28− , " Please remove the file and try again."
29− ]
30−
31−isValid :: FilePath -> (String, Module.Interface) -> Either String (String, Module.Interface)
32−isValid filePath (name, interface) =
33− let version = iVersion interface in
34− if version == Version.elmVersion
35− then Right (name, interface)
36− else Left $ concat
37− [ "Error reading build artifact: ", filePath, "\n"
38− , " It was generated by version ", show version, " of the compiler,\n"
39− , " but you are using version ", show Version.elmVersion, "\n"
40− , " Please remove the file and try again.\n"
41− ]
compiler/Build/Utils.hsdeleted−64
@@ -1,64 +0,0 @@
1−{-# OPTIONS_GHC -W #-}
2−module Build.Utils where
3−
4−import Control.Monad.Error
5−import System.Directory (doesFileExist)
6−import System.Environment (getEnv)
7−import System.FilePath ((</>), replaceExtension)
8−import System.IO.Error (tryIOError)
9−import qualified Build.Flags as Flag
10−import qualified Build.Print as Print
11−import qualified Paths_Elm as This
12−
13−buildPath :: Flag.Flags -> FilePath -> String -> FilePath
14−buildPath flags filePath ext =
15− Flag.build_dir flags </> replaceExtension filePath ext
16−
17−cachePath :: Flag.Flags -> FilePath -> String -> FilePath
18−cachePath flags filePath ext =
19− Flag.cache_dir flags </> replaceExtension filePath ext
20−
21−elmo :: Flag.Flags -> FilePath -> FilePath
22−elmo flags filePath =
23− cachePath flags filePath "elmo"
24−
25−elmi :: Flag.Flags -> FilePath -> FilePath
26−elmi flags filePath =
27− cachePath flags filePath "elmi"
28−
29−-- |The absolute path to a data file
30−getDataFile :: FilePath -> IO FilePath
31−getDataFile name = do
32− path <- This.getDataFileName name
33− exists <- doesFileExist path
34− if exists
35− then return path
36− else do
37− environment <- tryIOError (getEnv "ELM_HOME")
38− case environment of
39− Right env -> return (env </> "compiler" </> name)
40− Left _ ->
41− fail $ unlines
42− [ "Unable to find the ELM_HOME environment variable when searching"
43− , "for the " ++ name ++ " file."
44− , ""
45− , "If you installed Elm Platform with the Mac or Windows installer, it looks like"
46− , "ELM_HOME was not set automatically. Look up how to set environment variables"
47− , "on your platform and set ELM_HOME to the directory that contains Elm's static"
48− , "files:"
49− , ""
50− , " * On Mac it is /usr/local/share/elm"
51− , " * On Windows it is one of the following:"
52− , " C:/Program Files/Elm Platform/0.13/share"
53− , " C:/Program Files (x86)/Elm Platform/0.13/share"
54− , ""
55− , "If it seems like a more complex issue, please report it here:"
56− , " <https://github.com/elm-lang/elm-platform/issues>"
57− ]
58−
59−run :: ErrorT String IO a -> IO a
60−run command = do
61− either <- runErrorT command
62− case either of
63− Left err -> Print.failure err
64− Right result -> return result
compiler/Docs.hsdeleted−224
@@ -1,224 +0,0 @@
1−{-# OPTIONS_GHC -W #-}
2−{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-}
3−module Main where
4−
5−import System.Console.CmdArgs
6−import System.Directory
7−import System.FilePath
8−import System.Exit
9−import System.IO
10−
11−import Control.Applicative ((<$>))
12−import Control.Arrow (second)
13−import Data.Aeson
14−import Data.Aeson.Encode.Pretty
15−import Data.Aeson.Types (Pair)
16−import qualified Data.List as List
17−import qualified Data.Map as Map
18−import qualified Data.ByteString.Lazy as BS
19−import qualified Data.Text as Text
20−
21−import qualified AST.Helpers as Help
22−import qualified AST.Type as T
23−import qualified AST.Declaration as D
24−import qualified AST.Expression.Source as Src
25−import qualified AST.Variable as Var
26−
27−import Text.Parsec hiding (newline,spaces)
28−import Parse.Declaration (typeDecl,infixDecl)
29−import Parse.Expression (typeAnnotation)
30−import Parse.Helpers
31−import Parse.Module (moduleDef)
32−
33−data Flags = Flags
34− { files :: [FilePath] }
35− deriving (Data,Typeable,Show,Eq)
36−
37−defaultFlags :: Flags
38−defaultFlags = Flags
39− { files = def &= args &= typ "FILES"
40− } &= help "Generate documentation for Elm"
41− &= summary ("Generate documentation for Elm, (c) Evan Czaplicki")
42−
43−main :: IO ()
44−main = do
45− flags <- cmdArgs defaultFlags
46− mapM_ parseFile (files flags)
47−
48−config :: Config
49−config = Config { confIndent = 2, confCompare = keyOrder keys }
50− where
51− keys = ["tag","name","document","comment","raw","aliases","datatypes"
52− ,"values","typeVariables","type","constructors"]
53−
54−parseFile :: FilePath -> IO ()
55−parseFile path = do
56− source <- readFile path
57− case iParse docs source of
58− Right json -> do
59− putStrLn $ "Documenting " ++ path
60− let docPath = "docs" </> replaceExtension path ".json"
61− createDirectoryIfMissing True (dropFileName docPath)
62− BS.writeFile docPath (encodePretty' config json)
63− Left err -> do
64− hPutStrLn stderr $ "Parse error in " ++ path ++ " at " ++ show err
65− exitFailure
66−
67−docs :: IParser Value
68−docs = do
69− (name, _exports, structure) <- moduleDocs
70− things <- document
71− return $ documentToJson name structure things
72−
73−docComment :: IParser String
74−docComment = do
75− try (string "{-|")
76− contents <- closeComment
77− let reversed = dropWhile (`elem` " \n\r") . drop 2 $ reverse contents
78− return $ dropWhile (==' ') (reverse reversed)
79−
80−moduleDocs :: IParser (String, Var.Listing Var.Value, String)
81−moduleDocs = do
82− optional freshLine
83− (names,exports) <- moduleDef
84− manyTill (string " " <|> newline <?> "more whitespace")
85− (lookAhead (string "{-|") <?> "module documentation comment")
86− structure <- docComment
87− return (List.intercalate "." names, exports, structure)
88−
89−document :: IParser [(String, D.SourceDecl, String)]
90−document = onFreshLines (\t ts -> ts ++ [t]) [] docThing
91−
92−docThing :: IParser (String, D.SourceDecl, String)
93−docThing = uncommentable <|> commented <|> uncommented ""
94− where
95− uncommentable = do
96− ifx <- infixDecl
97− return ("", ifx, "")
98−
99− commented = do
100− comment <- docComment
101− freshLine
102− uncommented comment
103−
104− uncommented comment = do
105− (src,def) <- withSource $ choice [ typeDecl, D.Definition <$> typeAnnotation ]
106− return (comment, def, src)
107−
108−
109−documentToJson :: String -> String -> [(String, D.SourceDecl, String)] -> Value
110−documentToJson name structure things =
111− object
112− [ "name" .= name
113− , "document" .= structure
114− , "values" .= toList values
115− , "aliases" .= toList aliases
116− , "datatypes" .= toList adts
117− ]
118− where
119− (values, aliases, adts) =
120− collect Map.empty Map.empty Map.empty Map.empty things
121−
122− toList :: Map.Map String [Pair] -> [Value]
123− toList dict =
124− map object (Map.elems dict)
125−
126−type Pairs = Map.Map String [Pair]
127−
128−collect :: Map.Map String (D.Assoc, Int) -> Pairs -> Pairs -> Pairs
129− -> [(String, D.SourceDecl, String)]
130− -> (Pairs, Pairs, Pairs)
131−collect infixes types aliases adts things =
132− case things of
133− [] -> (Map.union customOps nonCustomOps, aliases, adts)
134− where
135− nonCustomOps = Map.mapWithKey addDefaultInfix $ Map.difference types infixes
136− addDefaultInfix name pairs
137− | all Help.isSymbol name = addInfix (D.L, 9 :: Int) pairs
138− | otherwise = pairs
139−
140− customOps = Map.intersectionWith addInfix infixes types
141− addInfix (assoc,prec) pairs =
142− [ "associativity" .= show assoc, "precedence" .= prec ] ++ pairs
143−
144− (comment, decl, source) : rest ->
145− let insert name fields dict = Map.insert name (obj name fields) dict
146− obj name fields =
147− [ "name" .= name
148− , "raw" .= source
149− , "comment" .= comment
150− ] ++ fields
151− in
152− case decl of
153− D.Definition def ->
154− case def of
155− Src.TypeAnnotation name tipe ->
156− collect infixes (insert name [ "type" .= tipe ] types) aliases adts rest
157−
158− Src.Definition _ _ ->
159− collect infixes types aliases adts rest
160−
161− D.Datatype name vars ctors ->
162− let tipe = T.App (T.Type (Var.Raw name)) (map T.Var vars)
163− fields = [ "typeVariables" .= vars
164− , "constructors" .= map (ctorToJson tipe) ctors
165− ]
166− in collect infixes types aliases (insert name fields adts) rest
167−
168− D.TypeAlias name vars tipe ->
169− let fields = [ "typeVariables" .= vars, "type" .= tipe ]
170− in collect infixes types (insert name fields aliases) adts rest
171−
172− D.Port _ ->
173− collect infixes types aliases adts rest
174−
175− D.Fixity assoc prec name ->
176− collect (Map.insert name (assoc,prec) infixes) types aliases adts rest
177−
178−
179−instance Var.ToString var => ToJSON (T.Type var) where
180− toJSON tipe =
181− object (getFields tipe)
182− where
183− getFields tipe =
184− case tipe of
185− T.Lambda _ _ ->
186− let tipes = T.collectLambdas tipe in
187− [ "tag" .= ("function" :: Text.Text)
188− , "args" .= toJSON (init tipes)
189− , "result" .= toJSON (last tipes)
190− ]
191−
192− T.Var x ->
193− [ "tag" .= ("var" :: Text.Text)
194− , "name" .= toJSON x
195− ]
196−
197− T.Type name ->
198− [ "tag" .= ("adt" :: Text.Text)
199− , "name" .= toJSON (Var.toString name)
200− , "args" .= ([] :: [()])
201− ]
202−
203− T.App (T.Type name) ts ->
204− [ "tag" .= ("adt" :: Text.Text)
205− , "name" .= toJSON (Var.toString name)
206− , "args" .= map toJSON ts
207− ]
208−
209− T.App _ _ -> error "This is an unexpected error with elm-doc, please report it at <https://github.com/elm-lang/Elm/issues>"
210−
211− T.Record fields ext ->
212− [ "tag" .= ("record" :: Text.Text)
213− , "fields" .= toJSON (map (toJSON . second toJSON) fields)
214− , "extension" .= toJSON ext
215− ]
216−
217− T.Aliased _ t ->
218− getFields t
219−
220−ctorToJson :: T.RawType -> (String, [T.RawType]) -> Value
221−ctorToJson tipe (ctor, tipes) =
222− object [ "name" .= ctor
223− , "type" .= foldr T.Lambda tipe tipes
224− ]
compiler/Elm/Internal/Dependencies.hsdeleted−156
@@ -1,156 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−module Elm.Internal.Dependencies where
3−
4−import Control.Applicative
5−import Control.Arrow (first)
6−import Control.Monad.Error
7−import qualified Control.Exception as E
8−import Data.Aeson
9−import Data.Aeson.Types (Parser)
10−import Data.Aeson.Encode.Pretty
11−import Data.Maybe (fromMaybe)
12−import qualified Data.List as List
13−import qualified Data.ByteString.Lazy as BS
14−import qualified Data.HashMap.Strict as Map
15−import qualified Data.Text as T
16−
17−import qualified Elm.Internal.Name as N
18−import qualified Elm.Internal.Version as V
19−import qualified Elm.Internal.Paths as Path
20−
21−data Deps = Deps
22− { name :: N.Name
23− , version :: V.Version
24− , summary :: String
25− , description :: String
26− , license :: String
27− , repo :: String
28− , exposed :: [String]
29− , native :: [String]
30− , elmVersion :: V.Version
31− , dependencies :: [(N.Name,V.Version)]
32− } deriving (Show, Eq, Ord)
33−
34−instance ToJSON Deps where
35− toJSON d =
36− object $
37− [ "version" .= version d
38− , "summary" .= summary d
39− , "description" .= description d
40− , "license" .= license d
41− , "repository" .= repo d
42− , "exposed-modules" .= exposed d
43− , "elm-version" .= elmVersion d
44− , "dependencies" .= (jsonDeps . dependencies $ d)
45− ] ++ nativeModules
46− where
47− jsonDeps = Map.fromList . map (first (T.pack . show))
48− nativeModules
49− | null (native d) = []
50− | otherwise = [ "native-modules" .= native d ]
51−
52−instance FromJSON Deps where
53− parseJSON (Object obj) =
54− do version <- get obj "version" "your projects version number"
55−
56− summary <- get obj "summary" "a short summary of your project"
57− when (length summary >= 80) $
58− fail "'summary' must be less than 80 characters"
59−
60− desc <- get obj "description" "an extended description of your project \
61− \and how to get started with it."
62− license <- get obj "license" "license information (BSD3 is recommended)"
63−
64− repo <- get obj "repository" "a link to the project's GitHub repo"
65− name <- case repoToName repo of
66− Left err -> fail err
67− Right nm -> return nm
68−
69− exposed <- get obj "exposed-modules" "a list of modules exposed to users"
70−
71− native <- fromMaybe [] <$> (obj .:? "native-modules")
72−
73− elmVersion <- get obj "elm-version" "the version of the Elm compiler you are using"
74−
75− deps <- getDependencies obj
76−
77− return $ Deps name version summary desc license repo exposed native elmVersion deps
78−
79− parseJSON _ = mzero
80−
81−getDependencies :: Object -> Parser [(N.Name, V.Version)]
82−getDependencies obj =
83− toDeps =<< get obj "dependencies" "a listing of your project's dependencies"
84− where
85− toDeps deps =
86− forM (Map.toList deps) $ \(f,v) ->
87− case (N.fromString f, V.fromString v) of
88− (Just name, Just version) -> return (name,version)
89− (Nothing, _) -> fail $ N.errorMsg f
90− (_, Nothing) -> fail $ "invalid version number " ++ v
91−
92−get :: FromJSON a => Object -> T.Text -> String -> Parser a
93−get obj field desc =
94− do maybe <- obj .:? field
95− case maybe of
96− Just value -> return value
97− Nothing -> fail $ "Missing field " ++ show field ++ ", " ++ desc ++ ".\n" ++
98− " Check out an example " ++ Path.dependencyFile ++ " file here:" ++
99− " <https://github.com/evancz/automaton/blob/master/elm_dependencies.json>"
100−
101−repoToName :: String -> Either String N.Name
102−repoToName repo
103− | not (end `List.isSuffixOf` repo) = Left msg
104− | otherwise =
105− do path <- getPath
106− let raw = take (length path - length end) path
107− case N.fromString raw of
108− Nothing -> Left msg
109− Just name -> Right name
110− where
111− getPath | http `List.isPrefixOf` repo = Right $ drop (length http ) repo
112− | https `List.isPrefixOf` repo = Right $ drop (length https) repo
113− | otherwise = Left msg
114− http = "http://github.com/"
115− https = "https://github.com/"
116− end = ".git"
117− msg = "the 'repository' field must point to a GitHub project for now, something\n\
118− \like <https://github.com/USER/PROJECT.git> where USER is your GitHub name\n\
119− \and PROJECT is the repo you want to upload."
120−
121−withDeps :: FilePath -> (Deps -> ErrorT String IO a) -> ErrorT String IO a
122−withDeps path handle =
123− do json <- readPath
124− case eitherDecode json of
125− Left err -> throwError $ "Error reading file " ++ path ++ ":\n " ++ err
126− Right ds -> handle ds
127− where
128− readPath :: ErrorT String IO BS.ByteString
129− readPath = do
130− result <- liftIO $ E.catch (Right <$> BS.readFile path)
131− (\err -> return $ Left (err :: IOError))
132− case result of
133− Right bytes -> return bytes
134− Left _ -> throwError $
135− "could not find " ++ path ++ " file. You may need to create one.\n" ++
136− " For an example of how to fill in the dependencies file, check out\n" ++
137− " <https://github.com/evancz/automaton/blob/master/elm_dependencies.json>"
138−
139−depsAt :: FilePath -> ErrorT String IO Deps
140−depsAt filePath = withDeps filePath return
141−
142−-- | Encode dependencies in a canonical JSON format
143−prettyJSON :: Deps -> BS.ByteString
144−prettyJSON = encodePretty' config
145− where config = defConfig { confCompare = order }
146− order = keyOrder [ "name"
147− , "version"
148− , "summary"
149− , "description"
150− , "license"
151− , "repo"
152− , "exposed-modules"
153− , "native-modules"
154− , "elm-version"
155− , "dependencies"
156− ]
compiler/Elm/Internal/Documentation.hsdeleted−41
@@ -1,41 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−module Elm.Internal.Documentation where
3−
4−import Control.Applicative ((<$>),(<*>))
5−import Control.Monad
6−import Data.Aeson
7−
8−data Document = Doc
9− { moduleName :: String
10− , structure :: String
11− , entries :: [Entry]
12− } deriving (Show)
13−
14−data Entry = Entry
15− { name :: String
16− , comment :: String
17− , raw :: String
18− , assocPrec :: Maybe (String,Int)
19− } deriving (Show)
20−
21−instance FromJSON Document where
22− parseJSON (Object v) =
23− Doc <$> v .: "name"
24− <*> v .: "document"
25− <*> (concat <$> sequence [ v .: "aliases", v .: "datatypes", v .: "values" ])
26−
27− parseJSON _ = fail "Conversion to Document was expecting an object"
28−
29−instance FromJSON Entry where
30− parseJSON (Object v) =
31− Entry <$> v .: "name"
32− <*> v .: "comment"
33− <*> v .: "raw"
34− <*> (liftM2 (,) <$> v .:? "associativity"
35− <*> v .:? "precedence")
36−
37− parseJSON _ = fail "Conversion to Entry was expecting an object"
38−
39−data Content = Markdown String | Value String
40− deriving Show
41−
compiler/Elm/Internal/Name.hsdeleted−51
@@ -1,51 +0,0 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2−module Elm.Internal.Name where
3−
4−import Control.Applicative
5−import Control.Monad.Error
6−import Data.Aeson
7−import Data.Binary
8−import qualified Data.Text as T
9−import qualified Data.Maybe as Maybe
10−import Data.Typeable
11−
12−data Name = Name { user :: String, project :: String }
13− deriving (Typeable,Eq, Ord)
14−
15−instance Binary Name where
16− get = Name <$> get <*> get
17− put (Name user project) =
18− put user >> put project
19−
20−instance Show Name where
21− show name = user name ++ "/" ++ project name
22−
23−toFilePath :: Name -> FilePath
24−toFilePath name = user name ++ "-" ++ project name
25−
26−fromString :: String -> Maybe Name
27−fromString string =
28− case break (=='/') string of
29− ( user@(_:_), '/' : project@(_:_) )
30− | all (/='/') project -> Just (Name user project)
31− _ -> Nothing
32−
33−fromString' :: String -> ErrorT String IO Name
34−fromString' string =
35− Maybe.maybe (throwError $ errorMsg string) return (fromString string)
36−
37−instance FromJSON Name where
38− parseJSON (String text) =
39− let string = T.unpack text in
40− Maybe.maybe (fail $ errorMsg string) return (fromString string)
41−
42− parseJSON _ = fail "Project name must be a string."
43−
44−instance ToJSON Name where
45− toJSON name = toJSON (show name)
46−
47−errorMsg string =
48− unlines
49− [ "Dependency file has an invalid name: " ++ string
50− , "Must have format user/project and match a public github project."
51− ]
compiler/Elm/Internal/Paths.hsdeleted−24
@@ -1,24 +0,0 @@
1−{-# OPTIONS_GHC -Wall #-}
2−module Elm.Internal.Paths where
3−
4−import Build.Utils (getDataFile)
5−import System.IO.Unsafe (unsafePerformIO)
6−
7−-- |Name of directory for all of a project's dependencies.
8−dependencyDirectory :: FilePath
9−dependencyDirectory = "elm_dependencies"
10−
11−-- |Name of the dependency file, specifying dependencies and
12−-- other metadata for building and sharing projects.
13−dependencyFile :: FilePath
14−dependencyFile = "elm_dependencies.json"
15−
16−{-# NOINLINE runtime #-}
17−-- |The absolute path to Elm's runtime system.
18−runtime :: FilePath
19−runtime = unsafePerformIO $ getDataFile "elm-runtime.js"
20−
21−{-# NOINLINE docs #-}
22−-- |The absolute path to Elm's core library documentation.
23−docs :: FilePath
24−docs = unsafePerformIO $ getDataFile "docs.json"
compiler/Elm/Internal/Utils.hsdeleted−35
@@ -1,35 +0,0 @@
1−{- | This module exports functions for compiling Elm to JS.
2−-}
3−module Elm.Internal.Utils (compile, moduleName, nameAndImports) where
4−
5−import qualified Data.List as List
6−import qualified Generate.JavaScript as JS
7−import qualified Build.Source as Source
8−import qualified Parse.Module as Parser
9−import qualified AST.Module as M
10−import Parse.Parse (dependencies)
11−import qualified Text.PrettyPrint as P
12−import qualified Metadata.Prelude as Prelude
13−import System.IO.Unsafe
14−
15−-- |This function compiles Elm code to JavaScript. It will return either
16−-- an error message or the compiled JS code.
17−compile :: String -> Either String String
18−compile source =
19− case Source.build False interfaces source of
20− Left docs -> Left . unlines . List.intersperse "" $ map P.render docs
21− Right modul -> Right $ JS.generate modul
22−
23−{-# NOINLINE interfaces #-}
24−interfaces :: M.Interfaces
25−interfaces = unsafePerformIO $ Prelude.interfaces False
26−
27−-- |This function extracts the module name of a given source program.
28−moduleName :: String -> Maybe String
29−moduleName = Parser.getModuleName
30−
31−-- |This function extracts the module name and imported modules from a given
32−-- source program.
33−nameAndImports :: String -> Maybe (String, [String])
34−nameAndImports src =
35− either (const Nothing) Just (dependencies src)
compiler/Elm/Internal/Version.hsdeleted−73
@@ -1,73 +0,0 @@
1−{-# LANGUAGE DeriveDataTypeable, TemplateHaskell #-}
2−module Elm.Internal.Version where
3−
4−import Control.Applicative
5−import Data.Aeson
6−import Data.Binary
7−import Data.Char (isDigit)
8−import qualified Data.List as List
9−import Data.Typeable
10−import qualified Data.Text as T
11−import qualified Paths_Elm as This
12−import qualified Data.Version as Version
13−
14−elmVersion :: Version
15−elmVersion = V ns ""
16− where (Version.Version ns _) = This.version
17−
18−-- Data representation
19−
20−data Version = V [Int] String
21− deriving (Typeable,Eq)
22−
23−instance Ord Version where
24− compare (V ns tag) (V ns' tag') =
25− case compare ns ns' of
26− EQ -> compare tag' tag -- reverse comparison to favor ""
27− cmp -> cmp
28−
29−instance Show Version where
30− show (V ns tag) =
31− List.intercalate "." (map show ns) ++ if null tag then "" else "-" ++ tag
32−
33−instance Binary Version where
34− get = V <$> get <*> get
35− put (V ns tag) = do put ns
36− put tag
37−
38−tagless :: Version -> Bool
39−tagless (V _ tag) = null tag
40−
41−fromString :: String -> Maybe Version
42−fromString version = V <$> splitNumbers possibleNumbers <*> tag
43− where
44− (possibleNumbers, possibleTag) = break (=='-') version
45−
46− tag = case possibleTag of
47− "" -> Just ""
48− '-':rest -> Just rest
49− _ -> Nothing
50−
51− splitNumbers :: String -> Maybe [Int]
52− splitNumbers ns =
53− case span isDigit ns of
54− ("", _) -> Nothing
55− (number, []) -> Just [read number]
56− (number, '.':rest) -> (read number :) <$> splitNumbers rest
57− _ -> Nothing
58−
59−instance FromJSON Version where
60− parseJSON (String text) =
61− let string = T.unpack text in
62− case fromString string of
63− Just v -> return v
64− Nothing -> fail $ unlines
65− [ "Dependency file has an invalid version number: " ++ string
66− , "Must have format 0.1.2 or 0.1.2-tag"
67− ]
68−
69− parseJSON _ = fail "Version number must be stored as a string."
70−
71−instance ToJSON Version where
72− toJSON version = toJSON (show version)
73−
compiler/Metadata/Prelude.hsdeleted−126
@@ -1,126 +0,0 @@
1−{-# OPTIONS_GHC -W #-}
2−module Metadata.Prelude (interfaces, add) where
3−
4−import qualified Data.Map as Map
5−import qualified Data.Set as Set
6−import qualified Control.Exception as E
7−import System.Exit
8−import System.IO
9−import AST.Module as Module
10−import qualified AST.Variable as Var
11−import qualified Build.Interface as Interface
12−import Build.Utils (getDataFile)
13−
14−
15−-- DEFINITION OF THE PRELUDE
16−
17−type ImportDict =
18− Map.Map String ([String], Var.Listing Var.Value)
19−
20−prelude :: ImportDict
21−prelude = Map.unions [ string, text, maybe, openImports ]
22− where
23− importing :: String -> [Var.Value] -> ImportDict
24− importing name values =
25− Map.singleton name ([], Var.Listing values False)
26−
27− openImports :: ImportDict
28− openImports =
29− Map.fromList $ map (\name -> (name, ([], Var.openListing))) $
30− [ "Basics", "Signal", "List", "Time", "Color"
31− , "Graphics.Element", "Graphics.Collage"
32− , "Native.Ports", "Native.Json"
33− ]
34−
35− maybe :: ImportDict
36− maybe = importing "Maybe" [ Var.ADT "Maybe" Var.openListing ]
37−
38− string :: ImportDict
39− string = importing "String" [Var.Value "show"]
40−
41− text :: ImportDict
42− text = importing "Text" (Var.ADT "Text" (Var.Listing [] False) : values)
43− where
44− values =
45− map Var.Value
46− [ "toText", "leftAligned", "rightAligned", "centered", "justified"
47− , "plainText", "asText", "typeface", "monospace", "bold", "italic"
48− ]
49−
50−
51−-- ADDING PRELUDE TO A MODULE
52−
53−add :: Bool -> Module exs body -> Module exs body
54−add noPrelude (Module moduleName path exports imports decls) =
55− Module moduleName path exports ammendedImports decls
56− where
57− ammendedImports =
58− importDictToList $
59− foldr addImport (if noPrelude then Map.empty else prelude) imports
60−
61−importDictToList :: ImportDict -> [(String, ImportMethod)]
62−importDictToList dict =
63− concatMap toImports (Map.toList dict)
64− where
65− toImports (name, (qualifiers, listing@(Var.Listing explicits open))) =
66− map (\qualifier -> (name, As qualifier)) qualifiers
67− ++
68− if open || not (null explicits)
69− then [(name, Open listing)]
70− else []
71−
72−addImport :: (String, ImportMethod) -> ImportDict -> ImportDict
73−addImport (name, method) importDict =
74− Map.alter mergeMethods name importDict
75− where
76− mergeMethods :: Maybe ([String], Var.Listing Var.Value)
77− -> Maybe ([String], Var.Listing Var.Value)
78− mergeMethods entry =
79− let (qualifiers, listing) =
80− case entry of
81− Nothing -> ([], Var.Listing [] False)
82− Just v -> v
83− in
84− case method of
85− As qualifier -> Just (qualifier : qualifiers, listing)
86− Open newListing ->
87− Just (qualifiers, mergeListings newListing listing)
88−
89− mergeListings (Var.Listing explicits1 open1) (Var.Listing explicits2 open2) =
90− Var.Listing
91− (Set.toList (Set.fromList (explicits1 ++ explicits2)))
92− (open1 || open2)
93−
94−
95−-- EXTRACT INTERFACES FROM STATIC FILE
96−
97−interfaces :: Bool -> IO Interfaces
98−interfaces noPrelude =
99− if noPrelude
100− then return Map.empty
101− else safeReadDocs =<< getDataFile "interfaces.data"
102−
103−safeReadDocs :: FilePath -> IO Interfaces
104−safeReadDocs name =
105− E.catch (readDocs name) $ \err -> do
106− let _ = err :: IOError
107− hPutStrLn stderr $ unlines $
108− [ "Error reading types for standard library from file " ++ name
109− , " If you are using a stable version of Elm, please report an issue at"
110− , " <http://github.com/elm-lang/Elm/issues> specifying version numbers for"
111− , " Elm and your OS." ]
112− exitFailure
113−
114−readDocs :: FilePath -> IO Interfaces
115−readDocs filePath = do
116− interfaces <- Interface.load filePath
117− case mapM (Interface.isValid filePath) (interfaces :: [(String, Module.Interface)]) of
118− Left err -> do
119− hPutStrLn stderr err
120− exitFailure
121−
122− Right [] -> do
123− hPutStrLn stderr "No interfaces found in serialized Prelude!"
124− exitFailure
125−
126− Right ifaces -> return $ Map.fromList ifaces
compiler/Parse/Module.hsdeleted−76
@@ -1,76 +0,0 @@
1−module Parse.Module (moduleDef, getModuleName, imports) where
2−
3−import Control.Applicative ((<$>), (<*>))
4−import Data.List (intercalate)
5−import Text.Parsec hiding (newline,spaces)
6−
7−import Parse.Helpers
8−import AST.Module (ImportMethod(..))
9−import AST.Variable (Listing(..), Value(..), openListing)
10−
11−getModuleName :: String -> Maybe String
12−getModuleName source =
13− case iParse getModuleName source of
14− Right name -> Just name
15− Left _ -> Nothing
16− where
17− getModuleName = do
18− optional freshLine
19− (names, _) <- moduleDef
20− return (intercalate "." names)
21−
22−moduleDef :: IParser ([String], Listing Value)
23−moduleDef = do
24− try (reserved "module")
25− whitespace
26− names <- dotSep1 capVar <?> "name of module"
27− whitespace
28− exports <- option (Listing [] True) (listing value)
29− whitespace <?> "reserved word 'where'"
30− reserved "where"
31− return (names, exports)
32−
33−imports :: IParser [(String, ImportMethod)]
34−imports = option [] ((:) <$> import' <*> many (try (freshLine >> import')))
35−
36−import' :: IParser (String, ImportMethod)
37−import' =
38− do reserved "import"
39− whitespace
40− name <- intercalate "." <$> dotSep1 capVar
41− (,) name <$> option (As name) method
42− where
43− method :: IParser ImportMethod
44− method = as' <|> importing'
45−
46− as' :: IParser ImportMethod
47− as' = do
48− try (whitespace >> reserved "as")
49− whitespace
50− As <$> capVar <?> "alias for module"
51−
52− importing' :: IParser ImportMethod
53− importing' = Open <$> listing value
54−
55−listing :: IParser a -> IParser (Listing a)
56−listing item =
57− do try (whitespace >> char '(')
58− whitespace
59− listing <- choice [ const openListing <$> string ".."
60− , Listing <$> commaSep1 item <*> return False
61− ] <?> "listing of values (x,y,z)"
62− whitespace
63− char ')'
64− return listing
65−
66−value :: IParser Value
67−value = val <|> tipe
68− where
69− val = Value <$> (lowVar <|> parens symOp)
70−
71− tipe = do
72− name <- capVar
73− maybeCtors <- optionMaybe (listing capVar)
74− case maybeCtors of
75− Nothing -> return (Alias name)
76− Just ctors -> return (ADT name ctors)
compiler/Type/Inference.hsdeleted−93
@@ -1,93 +0,0 @@
1−{-# OPTIONS_GHC -W #-}
2−module Type.Inference where
3−
4−import qualified Data.Map as Map
5−
6−import qualified Type.Type as T
7−import qualified Type.Environment as Env
8−import qualified Type.Constrain.Expression as TcExpr
9−import qualified Type.Solve as Solve
10−
11−import qualified AST.Annotation as A
12−import AST.Module as Module
13−import AST.Type (CanonicalType)
14−import qualified AST.Variable as Var
15−import Text.PrettyPrint
16−import qualified Type.State as TS
17−import qualified Type.ExtraChecks as Check
18−import Control.Arrow (first, second)
19−import Control.Monad.State (execStateT, forM)
20−import Control.Monad.Error (ErrorT, runErrorT, liftIO, throwError)
21−
22−import System.IO.Unsafe -- Possible to switch over to the ST monad instead of
23− -- the IO monad. I don't think that'd be worthwhile.
24−
25−
26−infer :: Interfaces -> CanonicalModule -> Either [Doc] (Map.Map String CanonicalType)
27−infer interfaces modul = unsafePerformIO $ runErrorT $ do
28− (header, constraint) <- genConstraints interfaces modul
29−
30− state <- liftIO $ execStateT (Solve.solve constraint) TS.initialState
31−
32− () <- case TS.sErrors state of
33− errors@(_:_) -> throwError errors
34− [] -> return ()
35−
36− () <- Check.portTypes (program (body modul))
37−
38− let header' = Map.delete "::" header
39− types = Map.difference (TS.sSavedEnv state) header'
40−
41− Check.mainType types
42−
43−
44−genConstraints :: Interfaces -> CanonicalModule
45− -> ErrorT [Doc] IO (Env.TypeDict, T.TypeConstraint)
46−genConstraints interfaces modul = do
47− env <- liftIO $ Env.initialEnvironment (canonicalizeAdts interfaces modul)
48−
49− ctors <- forM (Map.keys (Env.constructor env)) $ \name -> do
50− (_, vars, args, result) <- liftIO $ Env.freshDataScheme env name
51− return (name, (vars, foldr (T.==>) result args))
52−
53− importedVars <- mapM (canonicalizeValues env) (Map.toList interfaces)
54−
55− let allTypes = concat (ctors : importedVars)
56− vars = concatMap (fst . snd) allTypes
57− header = Map.map snd (Map.fromList allTypes)
58− environ = A.noneNoDocs . T.CLet [ T.Scheme vars [] (A.noneNoDocs T.CTrue) header ]
59−
60− fvar <- liftIO $ T.variable T.Flexible
61− c <- TcExpr.constrain env (program (body modul)) (T.varN fvar)
62− return (header, environ c)
63−
64−
65−canonicalizeValues :: Env.Environment -> (String, Interface)
66− -> ErrorT [Doc] IO [(String, ([T.Variable], T.Type))]
67−canonicalizeValues env (moduleName, iface) =
68− forM (Map.toList (iTypes iface)) $ \(name,tipe) -> do
69− tipe' <- Env.instantiateType env tipe Map.empty
70− return (moduleName ++ "." ++ name, tipe')
71−
72−canonicalizeAdts :: Interfaces -> CanonicalModule -> [CanonicalAdt]
73−canonicalizeAdts interfaces modul =
74− localAdts ++ importedAdts
75− where
76− localAdts :: [CanonicalAdt]
77− localAdts = format (Module.getName modul, datatypes (body modul))
78−
79− importedAdts :: [CanonicalAdt]
80− importedAdts = concatMap (format . second iAdts) (Map.toList interfaces)
81−
82− format :: (String, Module.ADTs) -> [CanonicalAdt]
83− format (home, adts) =
84− map canonical (Map.toList adts)
85− where
86− canonical :: (String, AdtInfo String) -> CanonicalAdt
87− canonical (name, (tvars, ctors)) =
88− ( toVar name
89− , (tvars, map (first toVar) ctors)
90− )
91−
92− toVar :: String -> Var.Canonical
93− toVar = Var.Canonical (Var.Module home)
elm-compiler.cabalnew file+332
@@ -0,0 +1,332 @@
1+
2+Name: elm-compiler
3+Version: 0.13
4+
5+Synopsis:
6+ Values to help with elm-package, elm-make, and elm-lang.org.
7+
8+Description:
9+ Elm aims to make client-side web-development pleasant. It is a
10+ statically/strongly typed, functional reactive language that compiles to
11+ HTML, CSS, and JS. This package provides a couple helpful values that are
12+ intended for use in packages such as elm-package and elm-make.
13+
14+Homepage: http://elm-lang.org
15+
16+License: BSD3
17+License-file: LICENSE
18+
19+Author: Evan Czaplicki
20+Maintainer: info@elm-lang.org
21+Copyright: Copyright (c) 2011-2014 Evan Czaplicki
22+
23+Category: Compiler, Language
24+
25+Extra-source-files: changelog.md
26+
27+Cabal-version: >=1.9
28+Build-type: Simple
29+
30+source-repository head
31+ type: git
32+ location: git://github.com/elm-lang/Elm.git
33+
34+
35+Library
36+ ghc-options:
37+ -threaded -O2 -W
38+
39+ Hs-Source-Dirs:
40+ src
41+
42+ exposed-modules:
43+ Elm.Compiler,
44+ Elm.Compiler.Module,
45+ Elm.Docs
46+
47+ other-modules:
48+ Elm.Compiler.Version,
49+ AST.Annotation,
50+ AST.Declaration,
51+ AST.Expression.General,
52+ AST.Expression.Source,
53+ AST.Expression.Valid,
54+ AST.Expression.Canonical,
55+ AST.Helpers,
56+ AST.Literal,
57+ AST.Module,
58+ AST.Pattern,
59+ AST.PrettyPrint,
60+ AST.Type,
61+ AST.Variable,
62+ Generate.JavaScript,
63+ Generate.JavaScript.Helpers,
64+ Generate.JavaScript.Ports,
65+ Generate.JavaScript.Variable,
66+ Generate.Markdown,
67+ Generate.Html,
68+ Generate.Cases,
69+ Transform.Canonicalize,
70+ Transform.Canonicalize.Environment,
71+ Transform.Canonicalize.Setup,
72+ Transform.Canonicalize.Type,
73+ Transform.Canonicalize.Variable,
74+ Transform.Check,
75+ Transform.Expression,
76+ Transform.Declaration,
77+ Transform.Definition,
78+ Transform.Interface,
79+ Transform.SortDefinitions,
80+ Transform.Substitute,
81+ Metadata.Prelude,
82+ Parse.Binop,
83+ Parse.Declaration,
84+ Parse.Expression,
85+ Parse.Helpers,
86+ Parse.Literal,
87+ Parse.Module,
88+ Parse.Parse,
89+ Parse.Pattern,
90+ Parse.Type,
91+ Type.Constrain.Expression,
92+ Type.Constrain.Literal,
93+ Type.Constrain.Pattern,
94+ Type.Environment,
95+ Type.ExtraChecks,
96+ Type.Fragment,
97+ Type.Inference,
98+ Type.PrettyPrint,
99+ Type.Solve,
100+ Type.State,
101+ Type.Type,
102+ Type.Unify,
103+ Build.Flags,
104+ Build.Print,
105+ Build.Source,
106+ Paths_elm_compiler
107+
108+ Build-depends:
109+ aeson >= 0.7 && < 0.9,
110+ aeson-pretty >= 0.7 && < 0.8,
111+ base >=4.2 && <5,
112+ binary >= 0.7.0.0 && < 0.8,
113+ blaze-html >= 0.5 && < 0.8,
114+ blaze-markup >= 0.5.1 && < 0.7,
115+ bytestring >= 0.9 && < 0.11,
116+ cheapskate >= 0.1 && < 0.2,
117+ cmdargs >= 0.7 && < 0.11,
118+ containers >= 0.3 && < 0.6,
119+ directory >= 1.0 && < 2.0,
120+ filepath >= 1 && < 2.0,
121+ highlighting-kate >= 0.5 && < 0.6,
122+ indents >= 0.3 && < 0.4,
123+ language-ecmascript >=0.15 && < 0.17,
124+ language-glsl >= 0.0.2 && < 0.2,
125+ mtl >= 2 && < 3,
126+ parsec >= 3.1.1 && < 3.5,
127+ pretty >= 1.0 && < 2.0,
128+ text >= 1 && < 2,
129+ transformers >= 0.2 && < 0.5,
130+ union-find >= 0.2 && < 0.3,
131+ unordered-containers >= 0.1 && < 0.3
132+
133+
134+Executable elm-compiler
135+ ghc-options:
136+ -threaded -O2 -W
137+
138+ Hs-Source-Dirs:
139+ src
140+
141+ Main-is:
142+ Compiler.hs
143+
144+ other-modules:
145+ Elm.Compiler.Version,
146+ AST.Annotation,
147+ AST.Declaration,
148+ AST.Expression.General,
149+ AST.Expression.Source,
150+ AST.Expression.Valid,
151+ AST.Expression.Canonical,
152+ AST.Helpers,
153+ AST.Literal,
154+ AST.Module,
155+ AST.Pattern,
156+ AST.PrettyPrint,
157+ AST.Type,
158+ AST.Variable,
159+ Generate.JavaScript,
160+ Generate.JavaScript.Helpers,
161+ Generate.JavaScript.Ports,
162+ Generate.JavaScript.Variable,
163+ Generate.Markdown,
164+ Generate.Html,
165+ Generate.Cases,
166+ Transform.Canonicalize,
167+ Transform.Canonicalize.Environment,
168+ Transform.Canonicalize.Setup,
169+ Transform.Canonicalize.Type,
170+ Transform.Canonicalize.Variable,
171+ Transform.Check,
172+ Transform.Expression,
173+ Transform.Declaration,
174+ Transform.Definition,
175+ Transform.Interface,
176+ Transform.SortDefinitions,
177+ Transform.Substitute,
178+ Metadata.Prelude,
179+ Parse.Binop,
180+ Parse.Declaration,
181+ Parse.Expression,
182+ Parse.Helpers,
183+ Parse.Literal,
184+ Parse.Module,
185+ Parse.Parse,
186+ Parse.Pattern,
187+ Parse.Type,
188+ Type.Constrain.Expression,
189+ Type.Constrain.Literal,
190+ Type.Constrain.Pattern,
191+ Type.Environment,
192+ Type.ExtraChecks,
193+ Type.Fragment,
194+ Type.Inference,
195+ Type.PrettyPrint,
196+ Type.Solve,
197+ Type.State,
198+ Type.Type,
199+ Type.Unify,
200+ Build.Flags,
201+ Build.Print,
202+ Build.Source,
203+ Paths_elm_compiler
204+
205+ Build-depends:
206+ aeson >= 0.7 && < 0.9,
207+ aeson-pretty >= 0.7 && < 0.8,
208+ base >=4.2 && <5,
209+ binary >= 0.7.0.0 && < 0.8,
210+ blaze-html >= 0.5 && < 0.8,
211+ blaze-markup >= 0.5.1 && < 0.7,
212+ bytestring >= 0.9 && < 0.11,
213+ cheapskate >= 0.1 && < 0.2,
214+ cmdargs >= 0.7 && < 0.11,
215+ containers >= 0.3 && < 0.6,
216+ directory >= 1.0 && < 2.0,
217+ filepath >= 1 && < 2.0,
218+ highlighting-kate >= 0.5 && < 0.6,
219+ indents >= 0.3 && < 0.4,
220+ language-ecmascript >=0.15 && < 0.17,
221+ language-glsl >= 0.0.2 && < 0.2,
222+ mtl >= 2 && < 3,
223+ parsec >= 3.1.1 && < 3.5,
224+ pretty >= 1.0 && < 2.0,
225+ text >= 1 && < 2,
226+ transformers >= 0.2 && < 0.5,
227+ union-find >= 0.2 && < 0.3,
228+ unordered-containers >= 0.1 && < 0.3
229+
230+
231+Executable elm-doc
232+ ghc-options:
233+ -threaded -O2 -W
234+
235+ Hs-Source-Dirs:
236+ src
237+
238+ Main-is:
239+ Docs.hs
240+
241+ other-modules:
242+ Elm.Compiler.Version,
243+ AST.Annotation,
244+ AST.Declaration,
245+ AST.Expression.General,
246+ AST.Helpers,
247+ AST.Literal,
248+ AST.Module,
249+ AST.Pattern,
250+ AST.PrettyPrint,
251+ AST.Type,
252+ AST.Variable,
253+ Parse.Binop,
254+ Parse.Declaration,
255+ Parse.Expression,
256+ Parse.Helpers,
257+ Parse.Literal,
258+ Parse.Module,
259+ Parse.Pattern,
260+ Parse.Type
261+
262+ Build-depends:
263+ aeson >= 0.7 && < 0.9,
264+ aeson-pretty >= 0.7 && < 0.8,
265+ base >=4.2 && <5,
266+ binary >= 0.7.0.0 && < 0.8,
267+ bytestring >= 0.9 && < 0.11,
268+ cmdargs >= 0.7 && < 0.11,
269+ containers >= 0.3 && < 0.6,
270+ directory >= 1.0 && < 2.0,
271+ filepath >= 1 && < 2.0,
272+ indents >= 0.3 && < 0.4,
273+ language-glsl >= 0.0.2 && < 0.2,
274+ mtl >= 2 && < 3,
275+ parsec >= 3.1.1 && < 3.5,
276+ pretty >= 1.0 && < 2.0,
277+ text >= 1 && < 2,
278+ transformers >= 0.2 && < 0.5,
279+ union-find >= 0.2 && < 0.3
280+
281+
282+Test-Suite compiler-tests
283+ Type:
284+ exitcode-stdio-1.0
285+
286+ Hs-Source-Dirs:
287+ tests/compiler, src
288+
289+ Main-is:
290+ CompilerTest.hs
291+
292+ other-modules:
293+ Tests.Compiler
294+ Tests.Property
295+ Tests.Property.Arbitrary
296+ AST.Helpers
297+ AST.Literal
298+ AST.PrettyPrint
299+
300+ build-depends:
301+ test-framework > 0.8 && < 0.9,
302+ test-framework-hunit >= 0.3 && < 0.4,
303+ test-framework-quickcheck2 >= 0.3 && < 0.4,
304+ HUnit >= 1.1 && < 2,
305+ QuickCheck >= 2 && < 3,
306+ aeson >= 0.7 && < 0.9,
307+ aeson-pretty >= 0.7 && < 0.8,
308+ base >=4.2 && <5,
309+ binary >= 0.7.0.0 && < 0.8,
310+ blaze-html >= 0.5 && < 0.8,
311+ blaze-markup >= 0.5.1 && < 0.7,
312+ bytestring >= 0.9 && < 0.11,
313+ cheapskate >= 0.1 && < 0.2,
314+ cmdargs >= 0.7 && < 0.11,
315+ containers >= 0.3 && < 0.6,
316+ directory >= 1.0 && < 2.0,
317+ Elm,
318+ filemanip >= 0.3.5 && < 0.4,
319+ filepath >= 1 && < 2.0,
320+ highlighting-kate >= 0.5 && < 0.6,
321+ indents >= 0.3 && < 0.4,
322+ language-ecmascript >=0.15 && < 0.17,
323+ language-glsl >= 0.0.2 && < 0.2,
324+ mtl >= 2 && < 3,
325+ parsec >= 3.1.1 && < 3.5,
326+ pretty >= 1.0 && < 2.0,
327+ process,
328+ text >= 1 && < 2,
329+ transformers >= 0.2 && < 0.5,
330+ union-find >= 0.2 && < 0.3,
331+ unordered-containers >= 0.1 && < 0.3
332+
libraries/Array.elmdeleted−198
@@ -1,198 +0,0 @@
1−module Array where
2−
3−{-| A library for fast immutable arrays. The elements in an array must have the
4−same type. The arrays are implemented in Relaxed Radix Balanced-Trees for fast
5−reads, updates, and appends.
6−
7−# Creating Arrays
8−@docs empty, repeat, initialize, fromList
9−
10−# Basics
11−@docs length, push, append
12−
13−# Get and Set
14−@docs get, getOrElse, getOrFail, set
15−
16−# Taking Arrays Apart
17−@docs slice, toList, toIndexedList
18−
19−# Mapping and Folding
20−@docs map, indexedMap, foldl, foldr
21−-}
22−
23−import Native.Array
24−import Basics (..)
25−import Maybe (..)
26−import List
27−
28−type Array a = Array
29−
30−{-| Initialize an array. `initialize n f` creates an array of length `n` with
31−the element at index `i` initialized to the result of `(f i)`.
32−
33− initialize 4 identity == fromList [0,1,2,3]
34− initialize 4 (\n -> n*n) == fromList [0,1,4,9]
35− initialize 4 (always 0) == fromList [0,0,0,0]
36−-}
37−initialize : Int -> (Int -> a) -> Array a
38−initialize = Native.Array.initialize
39−
40−{-| Creates an array with a given length, filled with a default element.
41−
42− repeat 5 0 == fromList [0,0,0,0,0]
43− repeat 3 "cat" == fromList ["cat","cat","cat"]
44−
45−Notice that `repeat 3 x` is the same as `initialize 3 (always x)`.
46−-}
47−repeat : Int -> a -> Array a
48−repeat n e = initialize n (always e)
49−
50−{-| Create an array from a list. -}
51−fromList : [a] -> Array a
52−fromList = Native.Array.fromList
53−
54−{-| Create a list of elements from an array.
55−
56− toList (fromList [3,5,8]) == [3,5,8]
57−-}
58−toList : Array a -> [a]
59−toList = Native.Array.toList
60−
61−-- TODO: make this a native function.
62−{-| Create an indexed list from an array. Each element of the array will be
63−paired with its index.
64−
65− toIndexedList (fromList ["cat","dog"]) == [(0,"cat"), (1,"dog")]
66−-}
67−toIndexedList : Array a -> [(Int, a)]
68−toIndexedList array =
69− List.zip [ 0 .. Native.Array.length array - 1 ] (Native.Array.toList array)
70−
71−{-| Apply a function on every element in an array.
72−
73− map sqrt (fromList [1,4,9]) == fromList [1,2,3]
74−-}
75−map : (a -> b) -> Array a -> Array b
76−map = Native.Array.map
77−
78−{-| Apply a function on every element with its index as first argument.
79−
80− indexedMap (*) (fromList [5,5,5]) == fromList [0,5,10]
81−-}
82−indexedMap : (Int -> a -> b) -> Array a -> Array b
83−indexedMap = Native.Array.indexedMap
84−
85−{-| Reduce an array from the left. Read `foldl` as &ldquo;fold from the left&rdquo;.
86−
87− foldl (::) [] (fromList [1,2,3]) == [3,2,1]
88−-}
89−foldl : (a -> b -> b) -> b -> Array a -> b
90−foldl = Native.Array.foldl
91−
92−{-| Reduce an array from the right. Read `foldr` as &ldquo;fold from the right&rdquo;.
93−
94− foldr (+) 0 (repeat 3 5) == 15
95−-}
96−foldr : (a -> b -> b) -> b -> Array a -> b
97−foldr = Native.Array.foldr
98−
99−{-| Keep only elements that satisfy the predicate:
100−
101− filter isEven (fromList [1..6]) == (fromList [2,4,6])
102−-}
103−filter : (a -> Bool) -> Array a -> Array a
104−filter isOkay arr =
105− let update x xs = if isOkay x then Native.Array.push x xs else xs
106− in
107− Native.Array.foldl update Native.Array.empty arr
108−
109−{-| Return an empty array.
110−
111− length empty == 0
112−-}
113−empty : Array a
114−empty = Native.Array.empty
115−
116−{-| Push an element to the end of an array.
117−
118− push 3 (fromList [1,2]) == fromList [1,2,3]
119−-}
120−push : a -> Array a -> Array a
121−push = Native.Array.push
122−
123−{-| Get the element at a particular index.
124−
125− getOrFail 0 (A.fromList [0,1,2]) == 0
126−
127−Warning: this function will result in a runtime error if the index is not found,
128−so it is best to use `get` or `getOrElse` unless you are sure the index will be
129−found.
130−-}
131−getOrFail : Int -> Array a -> a
132−getOrFail = Native.Array.get
133−
134−{-| Return Just the element at the index or Nothing if the index is out of range.
135−
136− get 0 (fromList [0,1,2]) == Just 0
137− get 2 (fromList [0,1,2]) == Just 2
138− get 5 (fromList [0,1,2]) == Nothing
139− get -1 (fromList [0,1,2]) == Nothing
140−-}
141−get : Int -> Array a -> Maybe a
142−get i array =
143− if 0 <= i && i < Native.Array.length array
144− then Just (Native.Array.get i array)
145− else Nothing
146−
147−{-| Get the element at the index. Or if the index is out of range, a default
148−value is returned.
149−
150− getOrElse 0 2 (fromList [0,1,2]) == 2
151− getOrElse 0 5 (fromList [0,1,2]) == 0
152−-}
153−getOrElse : a -> Int -> Array a -> a
154−getOrElse default i array =
155− if 0 <= i && i < Native.Array.length array
156− then Native.Array.get i array
157− else default
158−
159−{-| Set the element at a particular index. Returns an updated array.
160−If the index is out of range, the array is unaltered.
161−
162− set 1 7 (fromList [1,2,3]) == fromList [1,7,3]
163−-}
164−set : Int -> a -> Array a -> Array a
165−set = Native.Array.set
166−
167−{-| Get a sub-section of an array: `(slice start end array)`. The `start` is a
168−zero-based index where we will start our slice. The `end` is a zero-based index
169−that indicates the end of the slice. The slice extracts up to but not including
170−`end`.
171−
172− slice 0 3 (fromList [0,1,2,3,4]) == fromList [0,1,2]
173− slice 1 4 (fromList [0,1,2,3,4]) == fromList [1,2,3]
174−
175−Both the `start` and `end` indexes can be negative, indicating an offset from
176−the end of the array.
177−
178− slice 1 -1 (fromList [0,1,2,3,4]) == fromList [1,2,3]
179− slice -2 5 (fromList [0,1,2,3,4]) == fromList [3,4]
180−
181−This makes it pretty easy to `pop` the last element off of an array: `slice 0 -1 array`
182−-}
183−slice : Int -> Int -> Array a -> Array a
184−slice = Native.Array.slice
185−
186−{-| Return the length of an array.
187−
188− length (fromList [1,2,3]) == 3
189−-}
190−length : Array a -> Int
191−length = Native.Array.length
192−
193−{-| Append two arrays to a new one.
194−
195− append (repeat 2 42) (repeat 3 81) == fromList [42,42,81,81,81]
196−-}
197−append : Array a -> Array a -> Array a
198−append = Native.Array.append
libraries/Basics.elmdeleted−431
@@ -1,431 +0,0 @@
1−
2−module Basics where
3−
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 (+), (-), (*), (/), (^), (//), rem, (%), negate, 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
32−
33−# Angle Conversions
34−All angle conversions result in &ldquo;standard Elm angles&rdquo;
35−which happen to be radians.
36−
37−@docs degrees, radians, turns
38−
39−# Polar Coordinates
40−@docs toPolar, fromPolar
41−
42−# Floating Point Checks
43−@docs isNaN, isInfinite
44−
45−# Tuples
46−@docs fst, snd
47−
48−# Higher-Order Helpers
49−@docs identity, always, (<|), (|>), (<<), (>>), flip, curry, uncurry
50−
51−-}
52−
53−import Native.Basics
54−
55−{-| Convert radians to standard Elm angles (radians). -}
56−radians : Float -> Float
57−radians t = t
58−
59−{-| Convert degrees to standard Elm angles (radians). -}
60−degrees : Float -> Float
61−degrees = Native.Basics.degrees
62−
63−{-| Convert turns to standard Elm angles (radians).
64−One turn is equal to 360&deg;.
65−-}
66−turns : Float -> Float
67−turns = Native.Basics.turns
68−
69−{-| Convert polar coordinates (r,&theta;) to cartesian coordinates (x,y). -}
70−fromPolar : (Float,Float) -> (Float,Float)
71−fromPolar = Native.Basics.fromPolar
72−
73−{-| Convert cartesian coordinates (x,y) to polar coordinates (r,&theta;). -}
74−toPolar : (Float,Float) -> (Float,Float)
75−toPolar = Native.Basics.toPolar
76−
77−(+) : number -> number -> number
78−(+) = Native.Basics.add
79−
80−(-) : number -> number -> number
81−(-) = Native.Basics.sub
82−
83−(*) : number -> number -> number
84−(*) = Native.Basics.mul
85−
86−{-| Floating point division. -}
87−(/) : Float -> Float -> Float
88−(/) = Native.Basics.floatDiv
89−
90−infixl 6 +
91−infixl 6 -
92−infixl 7 *
93−infixl 7 /
94−infixl 8 ^
95−
96−infixl 7 //
97−infixl 7 %
98−infixl 7 `rem`
99−
100−{-| Integer division. The remainder is discarded. -}
101−(//) : Int -> Int -> Int
102−(//) = Native.Basics.div
103−
104−{-| Find the remainder after dividing one number by another.
105−
106− 7 `rem` 2 == 1
107− -1 `rem` 4 == -1
108−-}
109−rem : Int -> Int -> Int
110−rem = Native.Basics.rem
111−
112−{-| Perform [modular arithmetic](http://en.wikipedia.org/wiki/Modular_arithmetic).
113−
114− 7 % 2 == 1
115− -1 % 4 == 3
116−-}
117−(%) : Int -> Int -> Int
118−(%) = Native.Basics.mod
119−
120−{-| Exponentiation
121−
122− 3^2 == 9`
123−-}
124−(^) : number -> number -> number
125−(^) = Native.Basics.exp
126−
127−cos : Float -> Float
128−cos = Native.Basics.cos
129−
130−sin : Float -> Float
131−sin = Native.Basics.sin
132−
133−tan : Float -> Float
134−tan = Native.Basics.tan
135−
136−acos : Float -> Float
137−acos = Native.Basics.acos
138−
139−asin : Float -> Float
140−asin = Native.Basics.asin
141−
142−{-| You probably do not want to use this. It takes `(y/x)` as the
143−argument, so there is no way to know whether the negative signs comes from
144−the `y` or `x`. Thus, the resulting angle is always between &pi;/2 and -&pi;/2
145−(in quadrants I and IV). You probably want to use `atan2` instead.
146−-}
147−atan : Float -> Float
148−atan = Native.Basics.atan
149−
150−{-| This helps you find the angle of a cartesian coordinate.
151−You will almost certainly want to use this instead of `atan`.
152−So `atan2 y x` computes *atan(y/x)* but also keeps track of which
153−quadrant the angle should really be in. The result will be between
154−&pi; and -&pi;, giving you the full range of angles.
155−-}
156−atan2 : Float -> Float -> Float
157−atan2 = Native.Basics.atan2
158−
159−{-| Take the square root of a number. -}
160−sqrt : Float -> Float
161−sqrt = Native.Basics.sqrt
162−
163−{-| Negate a number.
164−
165− negate 42 == -42
166− negate -42 == 42
167− negate 0 == 0
168−-}
169−negate : number -> number
170−negate = Native.Basics.negate
171−
172−{-| Take the absolute value of a number. -}
173−abs : number -> number
174−abs = Native.Basics.abs
175−
176−{-| Calculate the logarithm of a number with a given base.
177−
178− logBase 10 100 == 2
179− logBase 2 256 == 8
180−-}
181−logBase : Float -> Float -> Float
182−logBase = Native.Basics.logBase
183−
184−{-| Clamps a number within a given range. With the expression
185−`clamp 100 200 x` the results are as follows:
186−
187− 100 if x < 100
188− x if 100 <= x < 200
189− 200 if 200 <= x
190−-}
191−clamp : number -> number -> number -> number
192−clamp = Native.Basics.clamp
193−
194−{-| An approximation of pi. -}
195−pi : Float
196−pi = Native.Basics.pi
197−
198−{-| An approximation of e. -}
199−e : Float
200−e = Native.Basics.e
201−
202−(==) : a -> a -> Bool
203−(==) = Native.Basics.eq
204−
205−(/=) : a -> a -> Bool
206−(/=) = Native.Basics.neq
207−
208−(<) : comparable -> comparable -> Bool
209−(<) = Native.Basics.lt
210−
211−(>) : comparable -> comparable -> Bool
212−(>) = Native.Basics.gt
213−
214−(<=) : comparable -> comparable -> Bool
215−(<=) = Native.Basics.le
216−
217−(>=) : comparable -> comparable -> Bool
218−(>=) = Native.Basics.ge
219−
220−infix 4 ==
221−infix 4 /=
222−infix 4 <
223−infix 4 >
224−infix 4 <=
225−infix 4 >=
226−
227−{-| Compare any two comparable values. Comparable values include `String`, `Char`,
228−`Int`, `Float`, `Time`, or a list or tuple containing comparable values.
229−These are also the only values that work as `Dict` keys or `Set` members.
230−-}
231−compare : comparable -> comparable -> Order
232−compare = Native.Basics.compare
233−
234−{-| Represents the relative ordering of two things.
235−The relations are less than, equal to, and greater than.
236−-}
237−type Order = LT | EQ | GT
238−
239−{-| Find the smaller of two comparables. -}
240−min : comparable -> comparable -> comparable
241−min = Native.Basics.min
242−
243−{-| Find the larger of two comparables. -}
244−max : comparable -> comparable -> comparable
245−max = Native.Basics.max
246−
247−{-| The logical AND operator. `True` if both inputs are `True`.
248−This operator short-circuits to `False` if the first argument is `False`.
249−-}
250−(&&) : Bool -> Bool -> Bool
251−(&&) = Native.Basics.and
252−
253−{-| The logical OR operator. `True` if one or both inputs are `True`.
254−This operator short-circuits to `True` if the first argument is True.
255−-}
256−(||) : Bool -> Bool -> Bool
257−(||) = Native.Basics.or
258−
259−infixr 3 &&
260−infixr 2 ||
261−
262−{-| The exclusive-or operator. `True` if exactly one input is `True`. -}
263−xor : Bool -> Bool -> Bool
264−xor = Native.Basics.xor
265−
266−{-| Negate a boolean value.
267−
268− not True == False
269− not False == True
270−-}
271−not : Bool -> Bool
272−not = Native.Basics.not
273−
274−{-| Equal to `True`. Useful as the last case of a multi-way-if. -}
275−otherwise : Bool
276−otherwise = True
277−
278−
279−-- Conversions
280−
281−{-| Round a number to the nearest integer. -}
282−round : Float -> Int
283−round = Native.Basics.round
284−
285−{-| Truncate a number, rounding towards zero. -}
286−truncate : Float -> Int
287−truncate = Native.Basics.truncate
288−
289−{-| Floor function, rounding down. -}
290−floor : Float -> Int
291−floor = Native.Basics.floor
292−
293−{-| Ceiling function, rounding up. -}
294−ceiling : Float -> Int
295−ceiling = Native.Basics.ceiling
296−
297−{-| Convert an integer into a float. -}
298−toFloat : Int -> Float
299−toFloat = Native.Basics.toFloat
300−
301−{- | Determine whether a float is an undefined or unrepresentable number.
302−NaN stands for *not a number* and it is [a standardized part of floating point
303−numbers](http://en.wikipedia.org/wiki/NaN).
304−
305− isNaN (0/0) == True
306− isNaN (sqrt -1) == True
307− isNaN (1/0) == False -- infinity is a number
308− isNaN 1 == False
309−-}
310−isNaN : Float -> Bool
311−isNaN = Native.Basics.isNaN
312−
313−{- | Determine whether a float is positive or negative infinity.
314−
315− isInfinite (0/0) == False
316− isInfinite (sqrt -1) == False
317− isInfinite (1/0) == True
318− isInfinite 1 == False
319−
320−Notice that NaN is not infinite! For float `n` to be finite implies that
321−`not (isInfinite n || isNaN n)` evaluates to `True`.
322−-}
323−isInfinite : Float -> Bool
324−isInfinite = Native.Basics.isInfinite
325−
326−-- Function Helpers
327−
328−{-| Function composition, passing results along in the suggested direction. For
329−example, the following code checks if the square root of a number is odd:
330−
331− not << isEven << sqrt
332−
333−You can think of this operator as equivalent to the following:
334−
335− (g << f) == (\x -> g (f x))
336−
337−So our example expands out to something like this:
338−
339− \n -> not (isEven (sqrt n))
340−-}
341−(<<) : (b -> c) -> (a -> b) -> (a -> c)
342−(<<) g f x = g (f x)
343−
344−{-| Function composition, passing results along in the suggested direction. For
345−example, the following code checks if the square root of a number is odd:
346−
347− sqrt >> isEven >> not
348−
349−This direction of function composition seems less pleasant than `(<<)` which
350−reads nicely in expressions like: `filter (not << isRegistered) students`
351−-}
352−(>>) : (a -> b) -> (b -> c) -> (a -> c)
353−(>>) f g x = g (f x)
354−
355−{-| Forward function application `x |> f == f x`. This function is useful
356−for avoiding parenthesis and writing code in a more natural way.
357−Consider the following code to create a pentagon:
358−
359− scale 2 (move (10,10) (filled blue (ngon 5 30)))
360−
361−This can also be written as:
362−
363− ngon 5 30 |> filled blue
364− |> move (10,10)
365− |> scale 2
366−-}
367−(|>) : a -> (a -> b) -> b
368−x |> f = f x
369−
370−{-| Backward function application `f <| x == f x`. This function is useful for
371−avoiding parenthesis. Consider the following code to create a text element:
372−
373− text (monospace (toText "code"))
374−
375−This can also be written as:
376−
377− text . monospace <| toText "code"
378−-}
379−(<|) : (a -> b) -> a -> b
380−f <| x = f x
381−
382−infixr 9 <<
383−infixl 9 >>
384−infixr 0 <|
385−infixl 0 |>
386−
387−{-| Given a value, returns exactly the same value. This is called
388−[the identity function](http://en.wikipedia.org/wiki/Identity_function).
389−-}
390−identity : a -> a
391−identity x = x
392−
393−{-| Create a [constant function](http://en.wikipedia.org/wiki/Constant_function),
394−a function that *always* returns the same value regardless of what input you give.
395−It is defined as:
396−
397− always a b = a
398−
399−It totally ignores the second argument, so `always 42` is a function that always
400−returns 42. When you are dealing with higher-order functions, this comes in
401−handy more often than you might expect. For example, creating a zeroed out list
402−of length ten would be:
403−
404− map (always 0) [0..9]
405−-}
406−always : a -> b -> a
407−always a _ = a
408−
409−{-| Given a 2-tuple, returns the first value. -}
410−fst : (a,b) -> a
411−fst (a,_) = a
412−
413−{-| Given a 2-tuple, returns the second value. -}
414−snd : (a,b) -> b
415−snd (_,b) = b
416−
417−{-| Flip the order of the first two arguments to a function. -}
418−flip : (a -> b -> c) -> (b -> a -> c)
419−flip f b a = f a b
420−
421−{-| Change how arguments are passed to a function.
422−This splits paired arguments into two separate arguments.
423−-}
424−curry : ((a,b) -> c) -> a -> b -> c
425−curry f a b = f (a,b)
426−
427−{-| Change how arguments are passed to a function.
428−This combines two arguments into a single pair.
429−-}
430−uncurry : (a -> b -> c) -> (a,b) -> c
431−uncurry f (a,b) = f a b
libraries/Bitwise.elmdeleted−74
@@ -1,74 +0,0 @@
1−module Bitwise where
2−
3−{-| Library for [bitwise operations](http://en.wikipedia.org/wiki/Bitwise_operation).
4−
5−# Basic Operations
6−
7−@docs and, or, xor, complement
8−
9−# Bit Shifts
10−
11−@docs shiftLeft, shiftRight, shiftRightLogical
12−-}
13−
14−import Native.Bitwise
15−
16−{-| Bitwise AND
17−-}
18−and : Int -> Int -> Int
19−and = Native.Bitwise.and
20−
21−{-| Bitwise OR
22−-}
23−or : Int -> Int -> Int
24−or = Native.Bitwise.or
25−
26−{-| Bitwise XOR
27−-}
28−xor : Int -> Int -> Int
29−xor = Native.Bitwise.xor
30−
31−{-| Flip each bit individually, often called bitwise NOT
32−-}
33−complement : Int -> Int
34−complement = Native.Bitwise.complement
35−
36−{-| Shift bits to the left by a given offset, filling new bits with zeros.
37−This can be used to multiply numbers by powers of two.
38−
39− 8 `shiftLeft` 1 == 16
40− 8 `shiftLeft` 2 == 32
41−-}
42−shiftLeft : Int -> Int -> Int
43−shiftLeft = Native.Bitwise.shiftLeft
44−
45−{-| Shift bits to the right by a given offset, filling new bits with
46−whatever is the topmost bit. This can be used to divide numbers by powers of two.
47−
48− 32 `shiftRight` 1 == 16
49− 32 `shiftRight` 2 == 8
50− -32 `shiftRight` 1 == -16
51−
52−This is called an [arithmatic right
53−shift](http://en.wikipedia.org/wiki/Bitwise_operation#Arithmetic_shift),
54−often written (>>), and sometimes called a sign-propagating
55−right shift because it fills empty spots with copies of the highest bit.
56−-}
57−shiftRight : Int -> Int -> Int
58−shiftRight = Native.Bitwise.shiftRightArithmatic
59−
60−{-| Shift bits to the right by a given offset, filling new bits with
61−zeros.
62−
63− 32 `shiftRightLogical` 1 == 16
64− 32 `shiftRightLogical` 2 == 8
65− -32 `shiftRightLogical` 1 == 2147483632
66−
67−This is called an [logical right
68−shift](http://en.wikipedia.org/wiki/Bitwise_operation#Logical_shift), often written (>>>),
69−and sometimes called a zero-fill right shift because it fills empty spots
70−with zeros.
71−-}
72−shiftRightLogical : Int -> Int -> Int
73−shiftRightLogical = Native.Bitwise.shiftRightLogical
74−
libraries/Char.elmdeleted−62
@@ -1,62 +0,0 @@
1−
2−module 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−
15−import Native.Char
16−
17−{-| True for upper case letters. -}
18−isUpper : Char -> Bool
19−isUpper = Native.Char.isUpper
20−
21−{-| True for lower case letters. -}
22−isLower : Char -> Bool
23−isLower = Native.Char.isLower
24−
25−{-| True for ASCII digits `[0-9]`. -}
26−isDigit : Char -> Bool
27−isDigit = Native.Char.isDigit
28−
29−{-| True for ASCII octal digits `[0-7]`. -}
30−isOctDigit : Char -> Bool
31−isOctDigit = Native.Char.isOctDigit
32−
33−{-| True for ASCII hexadecimal digits `[0-9a-fA-F]`. -}
34−isHexDigit : Char -> Bool
35−isHexDigit = Native.Char.isHexDigit
36−
37−{-| Convert to upper case. -}
38−toUpper : Char -> Char
39−toUpper = Native.Char.toUpper
40−
41−{-| Convert to lower case. -}
42−toLower : Char -> Char
43−toLower = Native.Char.toLower
44−
45−{-| Convert to upper case, according to any locale-specific case mappings. -}
46−toLocaleUpper : Char -> Char
47−toLocaleUpper = Native.Char.toLocaleUpper
48−
49−{-| Convert to lower case, according to any locale-specific case mappings. -}
50−toLocaleLower : Char -> Char
51−toLocaleLower = Native.Char.toLocaleLower
52−
53−type alias KeyCode = Int
54−
55−{-| Convert to unicode. Used with the `Keyboard` library, which expects the
56−input to be uppercase. -}
57−toCode : Char -> KeyCode
58−toCode = Native.Char.toCode
59−
60−{-| Convert from unicode. -}
61−fromCode : KeyCode -> Char
62−fromCode = Native.Char.fromCode
libraries/Color.elmdeleted−272
@@ -1,272 +0,0 @@
1−module Color where
2−
3−{-| Library for working with colors. Includes
4−[RGB](https://en.wikipedia.org/wiki/RGB_color_model) and
5−[HSL](http://en.wikipedia.org/wiki/HSL_and_HSV) creation, gradients, and
6−built-in names.
7−
8−# Creation
9−@docs rgb, rgba, hsl, hsla, greyscale, grayscale, complement
10−
11−# Gradients
12−@docs linear, radial
13−
14−# Extracting Colors
15−@docs toRgb, toHsl
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, lightBrown
28−
29−### Dark
30−@docs darkRed, darkOrange, darkYellow, darkGreen, darkBlue, darkPurple, darkBrown
31−
32−### Eight Shades of Grey
33−These colors are a compatible series of shades of grey, fitting nicely
34−with the Tango palette.
35−@docs white, lightGrey, grey, darkGrey, lightCharcoal, charcoal, darkCharcoal, black
36−
37−These are identical to the *grey* versions. It seems the spelling is regional, but
38−that has never helped me remember which one I should be writing.
39−@docs lightGray, gray, darkGray
40−
41−-}
42−
43−import Basics (..)
44−
45−type Color
46− = RGBA Int Int Int Float
47− | HSLA Float Float Float Float
48−
49−{-| Create RGB colors with an alpha component for transparency.
50−The alpha component is specified with numbers between 0 and 1. -}
51−rgba : Int -> Int -> Int -> Float -> Color
52−rgba = RGBA
53−
54−{-| Create RGB colors from numbers between 0 and 255 inclusive. -}
55−rgb : Int -> Int -> Int -> Color
56−rgb r g b = RGBA r g b 1
57−
58−{-| Create [HSL colors](http://en.wikipedia.org/wiki/HSL_and_HSV)
59−with an alpha component for transparency.
60−-}
61−hsla : Float -> Float -> Float -> Float -> Color
62−hsla hue saturation lightness alpha =
63− HSLA (hue - turns (toFloat (floor (hue / (2*pi))))) saturation lightness alpha
64−
65−{-| Create [HSL colors](http://en.wikipedia.org/wiki/HSL_and_HSV). This gives
66−you access to colors more like a color wheel, where all hues are aranged in a
67−circle that you specify with standard Elm angles (radians).
68−
69− red = hsl (degrees 0) 1 0.5
70− green = hsl (degrees 120) 1 0.5
71− blue = hsl (degrees 240) 1 0.5
72−
73− pastelRed = hsl (degrees 0) 0.7 0.7
74−
75−To cycle through all colors, just cycle through degrees. The saturation level
76−is how vibrant the color is, like a dial between grey and bright colors. The
77−lightness level is a dial between white and black.
78−-}
79−hsl : Float -> Float -> Float -> Color
80−hsl hue saturation lightness =
81− hsla hue saturation lightness 1
82−
83−{-| Produce a gray based on the input. 0 is white, 1 is black. -}
84−grayscale : Float -> Color
85−grayscale p = HSLA 0 0 (1-p) 1
86−
87−greyscale : Float -> Color
88−greyscale p = HSLA 0 0 (1-p) 1
89−
90−{-| Produce a &ldquo;complementary color&rdquo;. The two colors will
91−accent each other. This is the same as rotating the hue by 180&deg;.
92−-}
93−complement : Color -> Color
94−complement color =
95− case color of
96− HSLA h s l a -> hsla (h + degrees 180) s l a
97− RGBA r g b a -> let (h,s,l) = rgbToHsl r g b
98− in hsla (h + degrees 180) s l a
99−
100−{-| Extract the components of a color in the HSL format.
101−-}
102−toHsl : Color -> { hue:Float, saturation:Float, lightness:Float, alpha:Float }
103−toHsl color =
104− case color of
105− HSLA h s l a -> { hue=h, saturation=s, lightness=l, alpha=a }
106− RGBA r g b a ->
107− let (h,s,l) = rgbToHsl r g b
108− in { hue=h, saturation=s, lightness=l, alpha=a }
109−
110−{-| Extract the components of a color in the RGB format.
111−-}
112−toRgb : Color -> { red:Int, green:Int, blue:Int, alpha:Float }
113−toRgb color =
114− case color of
115− RGBA r g b a -> { red=r, green=g, blue=b, alpha=a }
116− HSLA h s l a ->
117− let (r,g,b) = hslToRgb h s l
118− in { red = round (255 * r)
119− , green = round (255 * g)
120− , blue = round (255 * b)
121− , alpha = a
122− }
123−
124−fmod : Float -> Int -> Float
125−fmod f n =
126− let integer = floor f
127− in toFloat (integer % n) + f - toFloat integer
128−
129−rgbToHsl : Int -> Int -> Int -> (Float,Float,Float)
130−rgbToHsl red green blue =
131− let r = toFloat red / 255
132− g = toFloat green / 255
133− b = toFloat blue / 255
134−
135− cMax = max (max r g) b
136− cMin = min (min r g) b
137−
138− c = cMax - cMin
139−
140− hue = degrees 60 * if | cMax == r -> ((g - b) / c) `fmod` 6
141− | cMax == g -> ((b - r) / c) + 2
142− | cMax == b -> ((r - g) / c) + 4
143−
144− lightness = (cMax + cMin) / 2
145−
146− saturation =
147− if lightness == 0
148− then 0
149− else c / (1 - abs (2 * lightness - 1))
150− in
151− (hue, saturation, lightness)
152−
153−hslToRgb : Float -> Float -> Float -> (Float,Float,Float)
154−hslToRgb hue saturation lightness =
155− let chroma = (1 - abs (2 * lightness - 1)) * saturation
156− hue' = hue / degrees 60
157−
158− x = chroma * (1 - abs (fmod hue' 2 - 1))
159−
160− (r,g,b) = if | hue' < 0 -> (0, 0, 0)
161− | hue' < 1 -> (chroma, x, 0)
162− | hue' < 2 -> (x, chroma, 0)
163− | hue' < 3 -> (0, chroma, x)
164− | hue' < 4 -> (0, x, chroma)
165− | hue' < 5 -> (x, 0, chroma)
166− | hue' < 6 -> (chroma, 0, x)
167− | otherwise -> (0, 0, 0)
168−
169− m = lightness - chroma / 2
170− in
171− (r + m, g + m, b + m)
172−
173−--toV3 : Color -> V3
174−
175−--toV4 : Color -> V4
176−
177−type Gradient
178− = Linear (Float,Float) (Float,Float) [(Float,Color)]
179− | Radial (Float,Float) Float (Float,Float) Float [(Float,Color)]
180−
181−{-| Create a linear gradient. Takes a start and end point and then a series of
182−&ldquo;color stops&rdquo; that indicate how to interpolate between the start and
183−end points. See [this example](http://elm-lang.org/edit/examples/Elements/LinearGradient.elm) for a
184−more visual explanation. -}
185−linear : (number, number) -> (number, number) -> [(Float,Color)] -> Gradient
186−linear = Linear
187−
188−{-| Create a radial gradient. First takes a start point and inner radius. Then
189−takes an end point and outer radius. It then takes a series of &ldquo;color
190−stops&rdquo; that indicate how to interpolate between the inner and outer
191−circles. See [this example](http://elm-lang.org/edit/examples/Elements/RadialGradient.elm) for a
192−more visual explanation. -}
193−radial : (number,number) -> number -> (number,number) -> number -> [(Float,Color)] -> Gradient
194−radial = Radial
195−
196−
197−-- BUILT-IN COLORS
198−
199−lightRed : Color
200−lightRed = RGBA 239 41 41 1
201−red : Color
202−red = RGBA 204 0 0 1
203−darkRed : Color
204−darkRed = RGBA 164 0 0 1
205−
206−lightOrange : Color
207−lightOrange = RGBA 252 175 62 1
208−orange : Color
209−orange = RGBA 245 121 0 1
210−darkOrange : Color
211−darkOrange = RGBA 206 92 0 1
212−
213−lightYellow : Color
214−lightYellow = RGBA 255 233 79 1
215−yellow : Color
216−yellow = RGBA 237 212 0 1
217−darkYellow : Color
218−darkYellow = RGBA 196 160 0 1
219−
220−lightGreen : Color
221−lightGreen = RGBA 138 226 52 1
222−green : Color
223−green = RGBA 115 210 22 1
224−darkGreen : Color
225−darkGreen = RGBA 78 154 6 1
226−
227−lightBlue : Color
228−lightBlue = RGBA 114 159 207 1
229−blue : Color
230−blue = RGBA 52 101 164 1
231−darkBlue : Color
232−darkBlue = RGBA 32 74 135 1
233−
234−lightPurple : Color
235−lightPurple = RGBA 173 127 168 1
236−purple : Color
237−purple = RGBA 117 80 123 1
238−darkPurple : Color
239−darkPurple = RGBA 92 53 102 1
240−
241−lightBrown : Color
242−lightBrown = RGBA 233 185 110 1
243−brown : Color
244−brown = RGBA 193 125 17 1
245−darkBrown : Color
246−darkBrown = RGBA 143 89 2 1
247−
248−black : Color
249−black = RGBA 0 0 0 1
250−white : Color
251−white = RGBA 255 255 255 1
252−
253−lightGrey : Color
254−lightGrey = RGBA 238 238 236 1
255−grey : Color
256−grey = RGBA 211 215 207 1
257−darkGrey : Color
258−darkGrey = RGBA 186 189 182 1
259−
260−lightGray : Color
261−lightGray = RGBA 238 238 236 1
262−gray : Color
263−gray = RGBA 211 215 207 1
264−darkGray : Color
265−darkGray = RGBA 186 189 182 1
266−
267−lightCharcoal : Color
268−lightCharcoal = RGBA 136 138 133 1
269−charcoal : Color
270−charcoal = RGBA 85 87 83 1
271−darkCharcoal : Color
272−darkCharcoal = RGBA 46 52 54 1
libraries/Date.elmdeleted−77
@@ -1,77 +0,0 @@
1−
2−module Date where
3−
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, fromTime
9−
10−# Extractions
11−@docs year, month, Month, day, dayOfWeek, Day, hour, minute, second
12−
13−-}
14−
15−import Native.Date
16−import Time (Time)
17−import Maybe (Maybe)
18−
19−type Date = Date
20−
21−{-| Represents the days of the week. -}
22−type Day = Mon | Tue | Wed | Thu | Fri | Sat | Sun
23−
24−{-| Represents the month of the year. -}
25−type Month
26− = Jan | Feb | Mar | Apr
27− | May | Jun | Jul | Aug
28− | Sep | Oct | Nov | Dec
29−
30−{-| Attempt to read a date from a string. -}
31−read : String -> Maybe Date
32−read = Native.Date.read
33−
34−{-| Convert a date into a time since midnight (UTC) of 1 January 1990 (i.e.
35−[UNIX time](http://en.wikipedia.org/wiki/Unix_time)). Given the date 23 June
36−1990 at 11:45AM this returns the corresponding time. -}
37−toTime : Date -> Time
38−toTime = Native.Date.toTime
39−
40−{-| Take a UNIX time and convert it to a `Date`. -}
41−fromTime : Time -> Date
42−fromTime = Native.Date.fromTime
43−
44−{-| Extract the year of a given date. Given the date 23 June 1990 at 11:45AM
45−this returns the integer `1990`. -}
46−year : Date -> Int
47−year = Native.Date.year
48−
49−{-| Extract the month of a given date. Given the date 23 June 1990 at 11:45AM
50−this returns the Month `Jun` as defined below. -}
51−month : Date -> Month
52−month = Native.Date.month
53−
54−{-| Extract the day of a given date. Given the date 23 June 1990 at 11:45AM
55−this returns the integer `23`. -}
56−day : Date -> Int
57−day = Native.Date.day
58−
59−{-| Extract the day of the week for a given date. Given the date 23 June
60−1990 at 11:45AM this returns the Day `Thu` as defined below. -}
61−dayOfWeek : Date -> Day
62−dayOfWeek = Native.Date.dayOfWeek
63−
64−{-| Extract the hour of a given date. Given the date 23 June 1990 at 11:45AM
65−this returns the integer `11`. -}
66−hour : Date -> Int
67−hour = Native.Date.hour
68−
69−{-| Extract the minute of a given date. Given the date 23 June 1990 at 11:45AM
70−this returns the integer `45`. -}
71−minute : Date -> Int
72−minute = Native.Date.minute
73−
74−{-| Extract the second of a given date. Given the date 23 June 1990 at 11:45AM
75−this returns the integer `0`. -}
76−second : Date -> Int
77−second = Native.Date.second
libraries/Debug.elmdeleted−88
@@ -1,88 +0,0 @@
1−module Debug where
2−{-| This library is for investigating bugs or performance problems. It should
3−*not* be used in production code.
4−
5−# Console Debugging
6−@docs log, crash
7−
8−# Time-Travel Debugging
9−@docs watch, watchSummary, trace
10−-}
11−
12−import Graphics.Collage (Form)
13−import Native.Debug
14−import Native.Error
15−
16−{-| Log a tagged value on the developer console, and then return the value.
17−
18− 1 + log "number" 1 -- equals 2, logs "number: 1"
19− length (log "start" []) -- equals 0, logs "start: []"
20−
21−Notice that `log` is not a pure function! It should *only* be used for
22−investigating bugs or performance problems.
23−-}
24−log : String -> a -> a
25−log = Native.Debug.log
26−
27−{-| Crash the program with an error message. This is an uncatchable error,
28−intended for code that is soon-to-be-implemented. For example, if you are
29−working with a large ADT and have partially completed a case expression, it may
30−make sense to do this:
31−
32− data Entity = Ship | Fish | Captain | Seagull
33−
34− drawEntity entity =
35− case entity of
36− Ship -> ...
37− Fish -> ...
38− _ -> Debug.crash ("drawEntity not implemented for " ++ show entity ++ " yet!")
39−
40−Note that incomplete pattern matches are *very* bad practice! They are one of
41−the very few ways to crash an Elm program, and they are completely avoidable.
42−Production code should not have incomplete pattern matches!
43−
44−**Use this if** you want to do some testing while you are partway through
45−writing a function.
46−
47−**Do not use this if** you want to do some typical try-catch exception handling.
48−Use the `Maybe` or `Either` libraries instead.
49−-}
50−crash : String -> a
51−crash = Native.Error.raise
52−
53−{-| Watch a particular value in the debugger. Say we want to know the value of
54−a variable called `velocity` because it may not be updated correctly. Adding
55−`Debug.watch` allows us to name the value and show it with the debugger.
56−
57− Debug.watch "velocity" velocity == velocity
58−
59−Notice that the result of evaluating this expression is exactly the same as
60−not having the expression at all. That means it's easy to add to any value.
61−-}
62−watch : String -> a -> a
63−watch = Native.Debug.watch
64−
65−{-| Watch a summary of a particular value in the debugger. This function is
66−pretty much the same as `watch` but it lets you specify a way to summarize
67−the value you are interested in. For example, maybe you only want to see part
68−of a record:
69−
70− Debug.watchSummary "velocity" .velocity object
71−
72−This is the same as just writing `object`, but it creates a watch that *only*
73−looks at the value of `object.velocity`. You can also show summary statistics
74−like length of a list:
75−
76− Debug.watchSummary "Number of clicks" length clicks
77−
78−Again, this evaluates to `clicks` but we get to see how long that list is in
79−the debugger.
80−-}
81−watchSummary : String -> (a -> b) -> a -> a
82−watchSummary = Native.Debug.watchSummary
83−
84−{-| Trace all past positions of a `Form` in the debugger. Add this to a `Form`
85−and you will see a line tracing its entire history.
86−-}
87−trace : String -> Form -> Form
88−trace = Native.Debug.tracePath
libraries/Dict.elmdeleted−416
@@ -1,416 +0,0 @@
1−module Dict
2− ( Dict
3− , empty, singleton, insert, update
4− , get, getOrElse, getOrFail
5− , remove, member
6− , filter
7− , partition
8− , foldl, foldr, map
9− , union, intersect, diff
10− , keys, values
11− , toList, fromList
12− ) where
13−
14−{-| A dictionary mapping unique keys to values. The keys can be any comparable
15−type. This includes `Int`, `Float`, `Time`, `Char`, `String`, and tuples or
16−lists of comparable types.
17−
18−Insert, remove, and query operations all take *O(log n)* time.
19−
20−# Build
21−@docs empty, singleton, insert, update, remove
22−
23−# Query
24−@docs member, get, getOrElse, getOrFail
25−
26−# Combine
27−@docs union, intersect, diff
28−
29−# Lists
30−@docs keys, values, toList, fromList
31−
32−# Transform
33−@docs map, foldl, foldr, filter, partition
34−
35−-}
36−
37−
38−import Basics (..)
39−import Maybe (..)
40−import Native.Error
41−import List
42−import List ((::))
43−import Native.Utils
44−
45−
46−-- BBlack and NBlack should only be used during the deletion
47−-- algorithm. Any other occurrence is a bug and should fail an assert.
48−type NColor
49− = Red
50− | Black
51− | BBlack -- Double Black, counts as 2 blacks for the invariant
52− | NBlack -- Negative Black, counts as -1 blacks for the invariant
53−
54−
55−showNColor : NColor -> String
56−showNColor c =
57− case c of
58− Red -> "Red"
59− Black -> "Black"
60− BBlack -> "BBlack"
61− NBlack -> "NBlack"
62−
63−type LeafColor
64− = LBlack
65− | LBBlack -- Double Black, counts as 2
66−
67−showLColor : LeafColor -> String
68−showLColor c = case c of
69− LBlack -> "LBlack"
70− LBBlack -> "LBBlack"
71−
72−type Dict k v
73− = RBNode NColor k v (Dict k v) (Dict k v)
74− | RBEmpty LeafColor
75−
76−{-| Create an empty dictionary. -}
77−empty : Dict comparable v
78−empty = RBEmpty LBlack
79−
80−min : Dict k v -> (k,v)
81−min t =
82− case t of
83− RBNode _ k v (RBEmpty LBlack) _ -> (k,v)
84− RBNode _ _ _ l _ -> min l
85− RBEmpty LBlack -> Native.Error.raise "(min Empty) is not defined"
86−
87−max : Dict k v -> (k, v)
88−max t =
89− case t of
90− RBNode _ k v _ (RBEmpty _) -> (k,v)
91− RBNode _ _ _ _ r -> max r
92− RBEmpty _ -> Native.Error.raise "(max Empty) is not defined"
93−
94−{-| Get the value associated with a key. If the key is not found, return
95−`Nothing`. This is useful when you are not sure if a key will be in the
96−dictionary.
97−
98− animals = fromList [ ("Tom", Cat), ("Jerry", Mouse) ]
99−
100− get "Tom" animals == Just Cat
101− get "Mouse" animals == Just Mouse
102− get "Spike" animals == Nothing
103−
104−The `getOrElse` and `getOrFail` are built-in ways to handle common ways of
105−using the resulting `Maybe`.
106−-}
107−get : comparable -> Dict comparable v -> Maybe v
108−get k t =
109− case t of
110− RBEmpty LBlack -> Nothing
111− RBNode _ k' v l r ->
112− case Native.Utils.compare k k' of
113− LT -> get k l
114− EQ -> Just v
115− GT -> get k r
116−
117−{-| Get the value associated with a key. If the key is not found,
118−return a default value.
119−
120− animals = fromList [ ("Tom", Cat), ("Jerry", Mouse) ]
121−
122− getOrElse Dog "Tom" animals == Cat
123− getOrElse Dog "Mouse" animals == Mouse
124− getOrElse Dog "Spike" animals == Dog
125−-}
126−getOrElse : v -> comparable -> Dict comparable v -> v
127−getOrElse base k t =
128− case t of
129− RBEmpty LBlack -> base
130− RBNode _ k' v l r ->
131− case Native.Utils.compare k k' of
132− LT -> getOrElse base k l
133− EQ -> v
134− GT -> getOrElse base k r
135−
136−{-| Get the value associated with a key.
137−
138− animals = fromList [ ("Tom", Cat), ("Jerry", Mouse) ]
139−
140− getOrFail "Tom" animals == Cat
141− getOrFail "Mouse" animals == Mouse
142− getOrFail "Spike" animals == -- Runtime Error!
143−
144−Warning: this function will result in a runtime error if the key is not found,
145−so it is best to use `get` or `getOrElse` unless you are sure the key will be
146−found.
147−-}
148−getOrFail : comparable -> Dict comparable v -> v
149−getOrFail k t =
150− case t of
151− RBEmpty LBlack -> Native.Error.raise "key not found when using 'getOrFail'"
152− RBNode _ k' v l r ->
153− case Native.Utils.compare k k' of
154− LT -> getOrFail k l
155− EQ -> v
156− GT -> getOrFail k r
157−
158−{-| Determine if a key is in a dictionary. -}
159−member : comparable -> Dict comparable v -> Bool
160−member k t = isJust <| get k t
161−
162−ensureBlackRoot : Dict k v -> Dict k v
163−ensureBlackRoot t =
164− case t of
165− RBNode Red k v l r -> RBNode Black k v l r
166− RBNode Black _ _ _ _ -> t
167− RBEmpty LBlack -> t
168−
169−{-| Insert a key-value pair into a dictionary. Replaces value when there is
170−a collision. -}
171−insert : comparable -> v -> Dict comparable v -> Dict comparable v
172−insert k v t = let u _ = Just v in
173− update k u t
174−
175−{-| Remove a key-value pair from a dictionary. If the key is not found,
176−no changes are made. -}
177−remove : comparable -> Dict comparable v -> Dict comparable v
178−remove k t = let u _ = Nothing in
179− update k u t
180−
181−type Flag = Insert | Remove | Same
182−
183−showFlag : Flag -> String
184−showFlag f = case f of
185− Insert -> "Insert"
186− Remove -> "Remove"
187− Same -> "Same"
188−
189−{-| Update the value of a dictionary for a specific key with a given function. -}
190−update : comparable -> (Maybe v -> Maybe v) -> Dict comparable v -> Dict comparable v
191−update k u t =
192− let up t = case t of
193− RBEmpty LBlack -> case u Nothing of
194− Nothing -> (Same, empty)
195− Just v -> (Insert, RBNode Red k v empty empty)
196− RBNode c k' v l r -> case Native.Utils.compare k k' of
197− EQ -> case u (Just v) of
198− Nothing -> (Remove, rem c l r)
199− Just v' -> (Same, RBNode c k' v' l r)
200− LT -> let (fl, l') = up l in
201− case fl of
202− Same -> (Same, RBNode c k' v l' r)
203− Insert -> (Insert, balance c k' v l' r)
204− Remove -> (Remove, bubble c k' v l' r)
205− GT -> let (fl, r') = up r in
206− case fl of
207− Same -> (Same, RBNode c k' v l r')
208− Insert -> (Insert, balance c k' v l r')
209− Remove -> (Remove, bubble c k' v l r')
210− (fl, t') = up t
211− in case fl of
212− Same -> t'
213− Insert -> ensureBlackRoot t'
214− Remove -> blacken t'
215−
216−{-| Create a dictionary with one key-value pair. -}
217−singleton : comparable -> v -> Dict comparable v
218−singleton k v = insert k v (RBEmpty LBlack)
219−
220−isBBlack : Dict k v -> Bool
221−isBBlack t = case t of
222− RBNode BBlack _ _ _ _ -> True
223− RBEmpty LBBlack -> True
224− _ -> False
225−
226−moreBlack : NColor -> NColor
227−moreBlack c = case c of
228− Black -> BBlack
229− Red -> Black
230− NBlack -> Red
231− BBlack -> Native.Error.raise "Can't make a double black node more black!"
232−
233−lessBlack : NColor -> NColor
234−lessBlack c = case c of
235− BBlack -> Black
236− Black -> Red
237− Red -> NBlack
238− NBlack -> Native.Error.raise "Can't make a negative black node less black!"
239−
240−lessBlackTree : Dict k v -> Dict k v
241−lessBlackTree t = case t of
242− RBNode c k v l r -> RBNode (lessBlack c) k v l r
243− RBEmpty LBBlack -> RBEmpty LBlack
244−
245−reportRemBug : String -> NColor -> String -> String -> a
246−reportRemBug msg c lgot rgot =
247− Native.Error.raise <| List.concat [
248− "Internal red-black tree invariant violated, expected ",
249− msg,
250− "and got",
251− showNColor c,
252− " ",
253− lgot,
254− " ",
255− rgot,
256− "\nPlease report this bug to https://github.com/elm-lang/Elm/issues"
257− ]
258−
259−-- Remove the top node from the tree, may leave behind BBlacks
260−rem : NColor -> Dict k v -> Dict k v -> Dict k v
261−rem c l r = case (l, r) of
262− ((RBEmpty _), (RBEmpty _)) -> case c of
263− Red -> RBEmpty LBlack
264− Black -> RBEmpty LBBlack
265− ((RBEmpty cl), (RBNode cr k' v' l' r')) ->
266− case (c, cl, cr) of
267− (Black, LBlack, Red) -> RBNode Black k' v' l' r'
268− _ -> reportRemBug "Black, LBlack, Red" c (showLColor cl) (showNColor cr)
269− ((RBNode cl k' v' l' r'), (RBEmpty cr)) ->
270− case (c, cl, cr) of
271− (Black, Red, LBlack) -> RBNode Black k' v' l' r'
272− _ -> reportRemBug "Black, Red, LBlack" c (showNColor cl) (showLColor cr)
273− -- l and r are both RBNodes
274− ((RBNode cl kl vl ll rl), (RBNode cr kr vr lr rr)) ->
275− let l = RBNode cl kl vl ll rl
276− r = RBNode cr kr vr lr rr
277− (k, v) = max l
278− l' = remove_max cl kl vl ll rl
279− in bubble c k v l' r
280−
281−-- Kills a BBlack or moves it upward, may leave behind NBlack
282−bubble : NColor -> k -> v -> Dict k v -> Dict k v -> Dict k v
283−bubble c k v l r = if isBBlack l || isBBlack r
284− then balance (moreBlack c) k v (lessBlackTree l) (lessBlackTree r)
285− else RBNode c k v l r
286−
287−-- Removes rightmost node, may leave root as BBlack
288−remove_max : NColor -> k -> v -> Dict k v -> Dict k v -> Dict k v
289−remove_max c k v l r = case r of
290− RBEmpty _ -> rem c l r
291− RBNode cr kr vr lr rr
292− -> bubble c k v l (remove_max cr kr vr lr rr)
293−
294−-- generalized tree balancing act
295−balance : NColor -> k -> v -> Dict k v -> Dict k v -> Dict k v
296−balance c k v l r =
297−
298− balance_node (RBNode c k v l r)
299−
300−blackish : Dict k v -> Bool
301−blackish t = case t of
302− RBNode c _ _ _ _ -> c == Black || c == BBlack
303− RBEmpty _ -> True
304−
305−balance_node : Dict k v -> Dict k v
306−balance_node t =
307− let assemble col xk xv yk yv zk zv a b c d =
308− RBNode (lessBlack col) yk yv (RBNode Black xk xv a b) (RBNode Black zk zv c d)
309− in
310− if blackish t
311− then case t of
312− RBNode col zk zv (RBNode Red yk yv (RBNode Red xk xv a b) c) d ->
313− assemble col xk xv yk yv zk zv a b c d
314− RBNode col zk zv (RBNode Red xk xv a (RBNode Red yk yv b c)) d ->
315− assemble col xk xv yk yv zk zv a b c d
316− RBNode col xk xv a (RBNode Red zk zv (RBNode Red yk yv b c) d) ->
317− assemble col xk xv yk yv zk zv a b c d
318− RBNode col xk xv a (RBNode Red yk yv b (RBNode Red zk zv c d)) ->
319− assemble col xk xv yk yv zk zv a b c d
320−
321− RBNode BBlack xk xv a (RBNode NBlack zk zv (RBNode Black yk yv b c) d) ->
322− case d of
323− (RBNode Black _ _ _ _) ->
324− RBNode Black yk yv (RBNode Black xk xv a b) (balance Black zk zv c (redden d))
325− _ -> t
326−
327− RBNode BBlack zk zv (RBNode NBlack xk xv a (RBNode Black yk yv b c)) d ->
328− case a of
329− (RBNode Black _ _ _ _) ->
330− RBNode Black yk yv (balance Black xk xv (redden a) b) (RBNode Black zk zv c d)
331− _ -> t
332− _ -> t
333− else t
334−
335−-- make the top node black
336−blacken : Dict k v -> Dict k v
337−blacken t = case t of
338− RBEmpty _ -> RBEmpty LBlack
339− RBNode _ k v l r -> RBNode Black k v l r
340−
341−-- make the top node red
342−redden : Dict k v -> Dict k v
343−redden t = case t of
344− RBEmpty _ -> Native.Error.raise "can't make a Leaf red"
345− RBNode _ k v l r -> RBNode Red k v l r
346−
347−{-| Apply a function to all values in a dictionary. -}
348−map : (a -> b) -> Dict comparable a -> Dict comparable b
349−map f t =
350− case t of
351− RBEmpty LBlack -> RBEmpty LBlack
352− RBNode c k v l r -> RBNode c k (f v) (map f l) (map f r)
353−
354−{-| Fold over the key-value pairs in a dictionary, in order from lowest
355−key to highest key. -}
356−foldl : (comparable -> v -> b -> b) -> b -> Dict comparable v -> b
357−foldl f acc t =
358− case t of
359− RBEmpty LBlack -> acc
360− RBNode _ k v l r -> foldl f (f k v (foldl f acc l)) r
361−
362−{-| Fold over the key-value pairs in a dictionary, in order from highest
363−key to lowest key. -}
364−foldr : (comparable -> v -> b -> b) -> b -> Dict comparable v -> b
365−foldr f acc t =
366− case t of
367− RBEmpty LBlack -> acc
368− RBNode _ k v l r -> foldr f (f k v (foldr f acc r)) l
369−
370−{-| Combine two dictionaries. If there is a collision, preference is given
371−to the first dictionary. -}
372−union : Dict comparable v -> Dict comparable v -> Dict comparable v
373−union t1 t2 = foldl insert t2 t1
374−
375−{-| Keep a key-value pair when its key appears in the second dictionary.
376−Preference is given to values in the first dictionary. -}
377−intersect : Dict comparable v -> Dict comparable v -> Dict comparable v
378−intersect t1 t2 = filter (\k _ -> k `member` t2) t1
379−
380−{-| Keep a key-value pair when its key does not appear in the second dictionary.
381−Preference is given to the first dictionary. -}
382−diff : Dict comparable v -> Dict comparable v -> Dict comparable v
383−diff t1 t2 = foldl (\k v t -> remove k t) t1 t2
384−
385−{-| Get all of the keys in a dictionary. -}
386−keys : Dict comparable v -> [comparable]
387−keys t = foldr (\k v acc -> k :: acc) [] t
388−
389−{-| Get all of the values in a dictionary. -}
390−values : Dict comparable v -> [v]
391−values t = foldr (\k v acc -> v :: acc) [] t
392−
393−{-| Convert a dictionary into an association list of key-value pairs. -}
394−toList : Dict comparable v -> [(comparable,v)]
395−toList t = foldr (\k v acc -> (k,v) :: acc) [] t
396−
397−{-| Convert an association list into a dictionary. -}
398−fromList : [(comparable,v)] -> Dict comparable v
399−fromList assocs = List.foldl (\(k,v) d -> insert k v d) empty assocs
400−
401−{-| Keep a key-value pair when it satisfies a predicate. -}
402−filter : (comparable -> v -> Bool) -> Dict comparable v -> Dict comparable v
403−filter p dict =
404− let add k v t = if p k v then insert k v t else t
405− in foldl add empty dict
406−
407−{-| Partition a dictionary according to a predicate. The first dictionary
408−contains all key-value pairs which satisfy the predicate, and the second
409−contains the rest.
410−-}
411−partition : (comparable -> v -> Bool) -> Dict comparable v -> (Dict comparable v, Dict comparable v)
412−partition p dict =
413− let add k v (t1, t2) = if p k v
414− then (insert k v t1, t2)
415− else (t1, insert k v t2)
416− in foldl add (empty, empty) dict
libraries/Either.elmdeleted−93
@@ -1,93 +0,0 @@
1−module Either where
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−
16−import List
17−import List ((::))
18−
19−{-| Represents any data that can take two forms. For example, a user ID may be
20−either an `Int` or a `String`.
21−
22−This can also be used for error handling `(Either String a)` where
23−error messages are stored on the left, and the correct values
24−(&ldquo;right&rdquo; values) are stored on the right.
25−-}
26−type Either a b
27− = Left a
28− | Right b
29−
30−{-| Apply the first function to a `Left` and the second function to a `Right`.
31−This allows the extraction of a value from an `Either`.
32−
33− either (\n -> n + 1) sqrt (Left 4) == 5
34− either (\n -> n + 1) sqrt (Right 4) == 2
35−
36− map : (a -> b) -> Either err a -> Either err b
37− map f e = either Left (\x -> Right (f x)) e
38−-}
39−either : (a -> c) -> (b -> c) -> Either a b -> c
40−either f g e = case e of { Left x -> f x ; Right y -> g y }
41−
42−{-| True if the value is a `Left`.
43−
44− isLeft (Left "Cat") == True
45− isLeft (Right 1123) == False
46−-}
47−isLeft : Either a b -> Bool
48−isLeft e = case e of { Left _ -> True ; _ -> False }
49−
50−{-| True if the value is a `Right`.
51−
52− isRight (Left "Cat") == False
53− isRight (Right 1123) == True
54−-}
55−isRight : Either a b -> Bool
56−isRight e = case e of { Right _ -> True ; _ -> False }
57−
58−{-| Keep only the values held in `Left` values.
59−
60− lefts [Left 3, Right 'a', Left 5, Right "eight"] == [3,5]
61−-}
62−lefts : [Either a b] -> [a]
63−lefts es = List.foldr consLeft [] es
64−
65−{-| Keep only the values held in `Right` values.
66−
67− rights [Left 3, Right 'a', Left 5, Right 'b'] == ['a','b']
68−-}
69−rights : [Either a b] -> [b]
70−rights es = List.foldr consRight [] es
71−
72−{-| Split into two lists, lefts on the left and rights on the right. So we
73−have the equivalence: `(partition es == (lefts es, rights es))`
74−
75− partition [Left 3, Right 'a', Left 5, Right 'b'] == ([3,5],['a','b'])
76−-}
77−partition : [Either a b] -> ([a],[b])
78−partition es = List.foldr consEither ([],[]) es
79−
80−consLeft e vs =
81− case e of
82− Left v -> v::vs
83− Right _ -> vs
84−
85−consRight e vs =
86− case e of
87− Left _ -> vs
88− Right v -> v::vs
89−
90−consEither e (ls,rs) =
91− case e of
92− Left l -> (l::ls,rs)
93− Right r -> (ls,r::rs)
libraries/Graphics/Collage.elmdeleted−261
@@ -1,261 +0,0 @@
1−module Graphics.Collage where
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−
33−import Basics (..)
34−import List
35−import Either (Either(Left, Right))
36−import Transform2D (Transform2D)
37−import Transform2D as T
38−import Native.Graphics.Collage
39−import Graphics.Element (Element)
40−import Color (Color, black, Gradient)
41−import Maybe (Maybe)
42−
43−type alias Form =
44− { theta : Float
45− , scale : Float
46− , x : Float
47− , y : Float
48− , alpha : Float
49− , form : BasicForm
50− }
51−
52−type FillStyle
53− = Solid Color
54− | Texture String
55− | Grad Gradient
56−
57−{-| The shape of the ends of a line. -}
58−type LineCap = Flat | Round | Padded
59−
60−{-| The shape of the &ldquo;joints&rdquo; of a line, where each line segment
61−meets. `Sharp` takes an argument to limit the length of the joint. This
62−defaults to 10.
63−-}
64−type LineJoin = Smooth | Sharp Float | Clipped
65−
66−{-| All of the attributes of a line style. This lets you build up a line style
67−however you want. You can also update existing line styles with record updates.
68−-}
69−type alias LineStyle =
70− { color : Color
71− , width : Float
72− , cap : LineCap
73− , join : LineJoin
74− , dashing : [Int]
75− , dashOffset : Int
76− }
77−
78−{-| The default line style, which is solid black with flat caps and sharp joints.
79−You can use record updates to build the line style you
80−want. For example, to make a thicker line, you could say:
81−
82− { defaultLine | width <- 10 }
83−-}
84−defaultLine : LineStyle
85−defaultLine =
86− { color = black
87− , width = 1
88− , cap = Flat
89− , join = Sharp 10
90− , dashing = []
91− , dashOffset = 0
92− }
93−
94−{-| Create a solid line style with a given color. -}
95−solid : Color -> LineStyle
96−solid clr = { defaultLine | color <- clr }
97−
98−{-| Create a dashed line style with a given color. Dashing equals `[8,4]`. -}
99−dashed : Color -> LineStyle
100−dashed clr = { defaultLine | color <- clr, dashing <- [8,4] }
101−
102−{-| Create a dotted line style with a given color. Dashing equals `[3,3]`. -}
103−dotted : Color -> LineStyle
104−dotted clr = { defaultLine | color <- clr, dashing <- [3,3] }
105−
106−type BasicForm
107− = FPath LineStyle Path
108− | FShape (Either LineStyle FillStyle) Shape
109− | FImage Int Int (Int,Int) String
110− | FElement Element
111− | FGroup Transform2D [Form]
112−
113−form : BasicForm -> Form
114−form f = { theta=0, scale=1, x=0, y=0, alpha=1, form=f }
115−
116−fill style shape = form (FShape (Right style) shape)
117−
118−{-| Create a filled in shape. -}
119−filled : Color -> Shape -> Form
120−filled color shape = fill (Solid color) shape
121−
122−{-| Create a textured shape. The texture is described by some url and is
123−tiled to fill the entire shape.
124−-}
125−textured : String -> Shape -> Form
126−textured src shape = fill (Texture src) shape
127−
128−{-| Fill a shape with a [gradient](/library/Color.elm#linear). -}
129−gradient : Gradient -> Shape -> Form
130−gradient grad shape = fill (Grad grad) shape
131−
132−{-| Outline a shape with a given line style. -}
133−outlined : LineStyle -> Shape -> Form
134−outlined style shape = form (FShape (Left style) shape)
135−
136−{-| Trace a path with a given line style. -}
137−traced : LineStyle -> Path -> Form
138−traced style path = form (FPath style path)
139−
140−{-| Create a sprite from a sprite sheet. It cuts out a rectangle
141−at a given position.
142−-}
143−sprite : Int -> Int -> (Int,Int) -> String -> Form
144−sprite w h pos src = form (FImage w h pos src)
145−
146−{-| Turn any `Element` into a `Form`. This lets you use text, gifs, and video
147−in your collage. This means you can move, rotate, and scale
148−an `Element` however you want.
149−-}
150−toForm : Element -> Form
151−toForm e = form (FElement e)
152−
153−{-| Flatten many forms into a single `Form`. This lets you move and rotate them
154−as a single unit, making it possible to build small, modular components.
155−-}
156−group : [Form] -> Form
157−group fs = form (FGroup T.identity fs)
158−
159−{-| Flatten many forms into a single `Form` and then apply a matrix
160−transformation.
161−-}
162−groupTransform : Transform2D -> [Form] -> Form
163−groupTransform matrix fs = form (FGroup matrix fs)
164−
165−{-| Move a form by the given amount. This is a relative translation so
166−`(move (10,10) form)` would move `form` ten pixels up and ten pixels to the
167−right.
168−-}
169−move : (Float,Float) -> Form -> Form
170−move (x,y) f = { f | x <- f.x + x, y <- f.y + y }
171−
172−{-| Move a shape in the x direction. This is relative so `(moveX 10 form)` moves
173−`form` 10 pixels to the right.
174−-}
175−moveX : Float -> Form -> Form
176−moveX x f = { f | x <- f.x + x }
177−
178−{-| Move a shape in the y direction. This is relative so `(moveY 10 form)` moves
179−`form` upwards by 10 pixels.
180−-}
181−moveY : Float -> Form -> Form
182−moveY y f = { f | y <- f.y + y }
183−
184−{-| Scale a form by a given factor. Scaling by 2 doubles the size.
185−-}
186−scale : Float -> Form -> Form
187−scale s f = { f | scale <- f.scale * s }
188−
189−{-| Rotate a form by a given angle. Rotate takes standard Elm angles (radians)
190−and turns things counterclockwise. So to turn `form` 30&deg; to the left
191−you would say, `(rotate (degrees 30) form)`.
192−-}
193−rotate : Float -> Form -> Form
194−rotate t f = { f | theta <- f.theta + t }
195−
196−{-| Set the alpha of a `Form`. The default is 1, and 0 is totally transparent. -}
197−alpha : Float -> Form -> Form
198−alpha a f = { f | alpha <- a }
199−
200−{-| A collage is a collection of 2D forms. There are no strict positioning
201−relationships between forms, so you are free to do all kinds of 2D graphics.
202−-}
203−collage : Int -> Int -> [Form] -> Element
204−collage = Native.Graphics.Collage.collage
205−
206−
207−type alias Path = [(Float,Float)]
208−
209−{-| Create a path that follows a sequence of points. -}
210−path : [(Float,Float)] -> Path
211−path ps = ps
212−
213−{-| Create a path along a given line segment. -}
214−segment : (Float,Float) -> (Float,Float) -> Path
215−segment p1 p2 = [p1,p2]
216−
217−type alias Shape = [(Float,Float)]
218−
219−{-| Create an arbitrary polygon by specifying its corners in order.
220−`polygon` will automatically close all shapes, so the given list
221−of points does not need to start and end with the same position.
222−-}
223−polygon : [(Float,Float)] -> Shape
224−polygon points = points
225−
226−{-| A rectangle with a given width and height. -}
227−rect : Float -> Float -> Shape
228−rect w h = let hw = w/2
229− hh = h/2
230− in [ (0-hw,0-hh), (0-hw,hh), (hw,hh), (hw,0-hh) ]
231−
232−{-| A square with a given edge length. -}
233−square : Float -> Shape
234−square n = rect n n
235−
236−{-| An oval with a given width and height. -}
237−oval : Float -> Float -> Shape
238−oval w h =
239− let n = 50
240− t = 2 * pi / n
241− hw = w/2
242− hh = h/2
243− f i = (hw * cos (t*i), hh * sin (t*i))
244− in List.map f [0..n-1]
245−
246−{-| A circle with a given radius. -}
247−circle : Float -> Shape
248−circle r = oval (2*r) (2*r)
249−
250−{-| A regular polygon with N sides. The first argument specifies the number
251−of sides and the second is the radius. So to create a pentagon with radius
252−30 you would say:
253−
254− ngon 5 30
255−-}
256−ngon : Int -> Float -> Shape
257−ngon n r =
258− let m = toFloat n
259− t = 2 * pi / m
260− f i = ( r * cos (t*i), r * sin (t*i) )
261− in List.map f [0..m-1]
libraries/Graphics/Element.elmdeleted−320
@@ -1,320 +0,0 @@
1−module 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 empty, 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−-}
39−
40−import Basics (..)
41−import Native.Utils
42−import List as List
43−import Color (..)
44−import Maybe ( Maybe(..) )
45−
46−type alias Properties = {
47− id : Int,
48− width : Int,
49− height : Int,
50− opacity : Float,
51− color : Maybe Color,
52− href : String,
53− tag : String,
54− hover : (),
55− click : ()
56− }
57−
58−type alias Element =
59− { props : Properties
60− , element : ElementPrim
61− }
62−
63−{-| An Element that takes up no space. Good for things that appear conditionally:
64−
65− flow down [ img1, if showMore then img2 else empty ]
66−-}
67−empty : Element
68−empty = spacer 0 0
69−
70−{-| Get the width of an Element -}
71−widthOf : Element -> Int
72−widthOf e = e.props.width
73−
74−{-| Get the height of an Element -}
75−heightOf : Element -> Int
76−heightOf e = e.props.height
77−
78−{-| Get the width and height of an Element -}
79−sizeOf : Element -> (Int,Int)
80−sizeOf e = (e.props.width, e.props.height)
81−
82−{-| Create an `Element` with a given width. -}
83−width : Int -> Element -> Element
84−width nw e =
85− let p = e.props
86− props = case e.element of
87− Image _ w h _ -> {p| height <- round (toFloat h / toFloat w * toFloat nw) }
88− RawHtml -> {p| height <- snd (Native.Utils.htmlHeight nw e.element) }
89− _ -> p
90− in { element=e.element, props={ props | width <- nw } }
91−
92−{-| Create an `Element` with a given height. -}
93−height : Int -> Element -> Element
94−height nh e =
95− let p = e.props
96− props = case e.element of
97− Image _ w h _ -> {p| width <- round (toFloat w / toFloat h * toFloat nh) }
98− _ -> p
99− in { element=e.element, props={ p | height <- nh} }
100−
101−{-| Create an `Element` with a new width and height. -}
102−size : Int -> Int -> Element -> Element
103−size w h e = height h (width w e)
104−
105−{-| Create an `Element` with a given opacity. Opacity is a number between 0 and 1
106−where 0 means totally clear.
107−-}
108−opacity : Float -> Element -> Element
109−opacity o e = let p = e.props in { element=e.element, props={p| opacity <- o} }
110−
111−{-| Create an `Element` with a given background color. -}
112−color : Color -> Element -> Element
113−color c e = let p = e.props in
114− { element = e.element
115− , props = { p | color <- Just c}
116− }
117−
118−{-| Create an `Element` with a tag. This lets you link directly to it.
119−The element `(tag "all-about-badgers" thirdParagraph)` can be reached
120−with a link like this: `/facts-about-animals.elm#all-about-badgers`
121−-}
122−tag : String -> Element -> Element
123−tag name e = let p = e.props in
124− { element=e.element, props={p | tag <- name} }
125−
126−{-| Create an `Element` that is a hyper-link. -}
127−link : String -> Element -> Element
128−link href e = let p = e.props in
129− { element=e.element, props={p | href <- href} }
130−
131−newElement w h e =
132− { props = Properties (Native.Utils.guid ()) w h 1 Nothing "" "" () ()
133− , element = e
134− }
135−
136−type ElementPrim
137− = Image ImageStyle Int Int String
138− | Container Position Element
139− | Flow Direction [Element]
140− | Spacer
141− | RawHtml
142− | Custom -- for custom Elements implemented in JS, see collage for example
143−
144−type ImageStyle = Plain | Fitted | Cropped (Int,Int) | Tiled
145−
146−{-| Create an image given a width, height, and image source. -}
147−image : Int -> Int -> String -> Element
148−image w h src = newElement w h (Image Plain w h src)
149−
150−{-| Create a fitted image given a width, height, and image source.
151−This will crop the picture to best fill the given dimensions.
152−-}
153−fittedImage : Int -> Int -> String -> Element
154−fittedImage w h src = newElement w h (Image Fitted w h src)
155−
156−{-| Create a cropped image. Take a rectangle out of the picture starting
157−at the given top left coordinate. If you have a 140-by-140 image,
158−the following will cut a 100-by-100 square out of the middle of it.
159−
160− croppedImage (20,20) 100 100 "yogi.jpg"
161−-}
162−croppedImage : (Int,Int) -> Int -> Int -> String -> Element
163−croppedImage pos w h src =
164− newElement w h (Image (Cropped pos) w h src)
165−
166−tiledImage : Int -> Int -> String -> Element
167−tiledImage w h src =
168− newElement w h (Image Tiled w h src)
169−
170−type Three = P | Z | N
171−type Pos = Absolute Int | Relative Float
172−type alias Position =
173− { horizontal : Three
174− , vertical : Three
175− , x : Pos
176− , y : Pos
177− }
178−
179−{-| Put an element in a container. This lets you position the element really
180−easily, and there are tons of ways to set the `Position`.
181−To center `element` exactly in a 300-by-300 square you would say:
182−
183− container 300 300 middle element
184−
185−By setting the color of the container, you can create borders.
186−-}
187−container : Int -> Int -> Position -> Element -> Element
188−container w h pos e = newElement w h (Container pos e)
189−
190−{-| Create an empty box. This is useful for getting your spacing right and
191−for making borders.
192−-}
193−spacer : Int -> Int -> Element
194−spacer w h = newElement w h Spacer
195−
196−type Direction = DUp | DDown | DLeft | DRight | DIn | DOut
197−
198−{-| Have a list of elements flow in a particular direction.
199−The `Direction` starts from the first element in the list.
200−
201− flow right [a,b,c]
202−
203− +---+---+---+
204− | a | b | c |
205− +---+---+---+
206−-}
207−flow : Direction -> [Element] -> Element
208−flow dir es =
209− let ws = List.map widthOf es
210− hs = List.map heightOf es
211− newFlow w h = newElement w h (Flow dir es)
212− in
213− if es == [] then empty else
214− case dir of
215− DUp -> newFlow (List.maximum ws) (List.sum hs)
216− DDown -> newFlow (List.maximum ws) (List.sum hs)
217− DLeft -> newFlow (List.sum ws) (List.maximum hs)
218− DRight -> newFlow (List.sum ws) (List.maximum hs)
219− DIn -> newFlow (List.maximum ws) (List.maximum hs)
220− DOut -> newFlow (List.maximum ws) (List.maximum hs)
221−
222−{-| Stack elements vertically.
223−To put `a` above `b` you would say: ``a `above` b``
224−-}
225−above : Element -> Element -> Element
226−above hi lo =
227− newElement (max (widthOf hi) (widthOf lo))
228− (heightOf hi + heightOf lo)
229− (Flow DDown [hi,lo])
230−
231−{-| Stack elements vertically.
232−To put `a` below `b` you would say: ``a `below` b``
233−-}
234−below : Element -> Element -> Element
235−below lo hi =
236− newElement (max (widthOf hi) (widthOf lo))
237− (heightOf hi + heightOf lo)
238− (Flow DDown [hi,lo])
239−
240−{-| Put elements beside each other horizontally.
241−To put `a` beside `b` you would say: ``a `beside` b``
242−-}
243−beside : Element -> Element -> Element
244−beside lft rht =
245− newElement (widthOf lft + widthOf rht)
246− (max (heightOf lft) (heightOf rht))
247− (Flow right [lft,rht])
248−
249−{-| Layer elements on top of each other, starting from the bottom:
250−`layers == flow outward`
251−-}
252−layers : [Element] -> Element
253−layers es =
254− let ws = List.map widthOf es
255− hs = List.map heightOf es
256− in newElement (List.maximum ws) (List.maximum hs) (Flow DOut es)
257−
258−
259−-- Repetitive things --
260−
261−absolute : Int -> Pos
262−absolute = Absolute
263−relative : Float -> Pos
264−relative = Relative
265−
266−middle : Position
267−middle = { horizontal=Z, vertical=Z, x=Relative 0.5, y=Relative 0.5 }
268−topLeft : Position
269−topLeft = { horizontal=N, vertical=P, x=Absolute 0, y=Absolute 0 }
270−topRight : Position
271−topRight = { topLeft | horizontal <- P }
272−bottomLeft : Position
273−bottomLeft = { topLeft | vertical <- N }
274−bottomRight : Position
275−bottomRight = { bottomLeft | horizontal <- P }
276−midLeft : Position
277−midLeft = { middle | horizontal <- N, x <- Absolute 0 }
278−midRight : Position
279−midRight = { midLeft | horizontal <- P }
280−midTop : Position
281−midTop = { middle | vertical <- P, y <- Absolute 0 }
282−midBottom : Position
283−midBottom = { midTop | vertical <- N }
284−
285−middleAt : Pos -> Pos -> Position
286−middleAt x y = { horizontal = Z, vertical = Z, x = x, y = y }
287−topLeftAt : Pos -> Pos -> Position
288−topLeftAt x y = { horizontal = N, vertical = P, x = x, y = y }
289−topRightAt : Pos -> Pos -> Position
290−topRightAt x y = { horizontal = P, vertical = P, x = x, y = y }
291−bottomLeftAt : Pos -> Pos -> Position
292−bottomLeftAt x y = { horizontal = N, vertical = N, x = x, y = y }
293−bottomRightAt : Pos -> Pos -> Position
294−bottomRightAt x y = { horizontal = P, vertical = N, x = x, y = y }
295−midLeftAt : Pos -> Pos -> Position
296−midLeftAt x y = { horizontal = N, vertical = Z, x = x, y = y }
297−midRightAt : Pos -> Pos -> Position
298−midRightAt x y = { horizontal = P, vertical = Z, x = x, y = y }
299−midTopAt : Pos -> Pos -> Position
300−midTopAt x y = { horizontal = Z, vertical = P, x = x, y = y }
301−midBottomAt : Pos -> Pos -> Position
302−midBottomAt x y = { horizontal = Z, vertical = N, x = x, y = y }
303−
304−up : Direction
305−up = DUp
306−
307−down : Direction
308−down = DDown
309−
310−left : Direction
311−left = DLeft
312−
313−right : Direction
314−right = DRight
315−
316−inward : Direction
317−inward = DIn
318−
319−outward : Direction
320−outward = DOut
libraries/Graphics/Input.elmdeleted−178
@@ -1,178 +0,0 @@
1−module Graphics.Input where
2−{-| This module is for creating standard input widgets such as buttons and
3−text fields. All functions in this library follow a general pattern in which
4−you create an `Input` that many elements can report to:
5−
6−```haskell
7−clicks : Input ()
8−clicks = input ()
9−
10−clickableYogi : Element
11−clickableYogi = clickable clicks.handle () (image 40 40 "/yogi.jpg")
12−```
13−
14−Whenever the user clicks on the resulting `clickableYogi` element, it sends an
15−update to the `clicks` input. You will see this pattern again and again in
16−examples in this library, so just read on to get a better idea of how it works!
17−
18−# Creating Inputs
19−@docs Input, input
20−
21−# Basic Input Elements
22−
23−To learn about text fields, see the
24−[`Graphics.Input.Field`](Graphics-Input-Field) library.
25−
26−@docs button, customButton, checkbox, dropDown
27−
28−# Clicks and Hovers
29−@docs clickable, hoverable
30−
31−-}
32−
33−import Signal (Signal)
34−import Graphics.Element (Element)
35−import Native.Graphics.Input
36−
37−{-| This is the key abstraction of this library. An `Input` is a record
38−of two fields:
39−
40− 1. `signal` &mdash; all values coming to this input from &ldquo;the world&rdquo;
41− 2. `handle` &mdash; a way to refer to this particular input and send it values
42−
43−This will make more sense as you see more examples.
44−-}
45−type alias Input a = { signal : Signal a, handle : Handle a }
46−
47−type Handle a = Handle
48−
49−{-| This creates a new `Input`. You provide a single argument that will serve
50−as the initial value of the input&rsquo;s `signal`. For example:
51−
52− numbers : Input Int
53− numbers = input 42
54−
55−The initial value of `numbers.signal` is 42, and you will be able
56−to pipe updates to the input using `numbers.handle`.
57−
58−Note: This is an inherently impure function. Specifically, `(input ())` and
59−`(input ())` are actually two different inputs with different signals and handles.
60−-}
61−input : a -> Input a
62−input = Native.Graphics.Input.input
63−
64−{-| Create a standard button. The following example begins making a basic
65−calculator:
66−
67− data Keys = Number Int | Plus | Minus | Clear
68−
69− keys : Input Keys
70− keys = input Clear
71−
72− calculator : Element
73− calculator =
74− flow right [ button keys.handle (Number 1) "1"
75− , button keys.handle (Number 2) "2"
76− , button keys.handle Plus "+"
77− ]
78−
79−If the user presses the "+" button, `keys.signal` will update to `Plus`. If the
80−users presses "2", `keys.signal` will update to `(Number 2)`.
81−-}
82−button : Handle a -> a -> String -> Element
83−button = Native.Graphics.Input.button
84−
85−{-| Same as `button` but lets you customize buttons to look however you want.
86−
87− click : Input ()
88− click = input ()
89−
90− prettyButton : Element
91− prettyButton =
92− customButton click.handle ()
93− (image 100 40 "/button_up.jpg")
94− (image 100 40 "/button_hover.jpg")
95− (image 100 40 "/button_down.jpg")
96−-}
97−customButton : Handle a -> a -> Element -> Element -> Element -> Element
98−customButton = Native.Graphics.Input.customButton
99−
100−{-| Create a checkbox. The following example creates three synced checkboxes:
101−
102− check : Input Bool
103− check = input False
104−
105− boxes : Bool -> Element
106− boxes checked =
107− let box = container 40 40 middle (checkbox check.handle identity checked)
108− in flow right [ box, box, box ]
109−
110− main : Signal Element
111− main = boxes <~ check.signal
112−-}
113−checkbox : Handle a -> (Bool -> a) -> Bool -> Element
114−checkbox = Native.Graphics.Input.checkbox
115−
116−{-| Create a drop-down menu. The following drop-down lets you choose your
117−favorite British sport:
118−
119− data Sport = Football | Cricket | Snooker
120−
121− sport : Input (Maybe Sport)
122− sport = input Nothing
123−
124− sportDropDown : Element
125− sportDropDown =
126− dropDown sport.handle
127− [ ("" , Nothing)
128− , ("Football", Just Football)
129− , ("Cricket" , Just Cricket)
130− , ("Snooker" , Just Snooker)
131− ]
132−
133−If the user selects "Football" from the drop down menue, `sport.signal`
134−will update to `Just Football`.
135−-}
136−dropDown : Handle a -> [(String,a)] -> Element
137−dropDown = Native.Graphics.Input.dropDown
138−
139−{-| Detect mouse hovers over a specific `Element`. In the following example,
140−we will create a hoverable picture called `cat`.
141−
142− hover : Input Bool
143− hover = input False
144−
145− cat : Element
146− cat = image 30 30 "/cat.jpg"
147− |> hoverable hover.handle id
148−
149−When the mouse hovers above the `cat` element, `hover.signal` will become
150−`True`. When the mouse leaves it, `hover.signal` will become `False`.
151−-}
152−hoverable : Handle a -> (Bool -> a) -> Element -> Element
153−hoverable = Native.Graphics.Input.hoverable
154−
155−{-| Detect mouse clicks on a specific `Element`. In the following example,
156−we will create a clickable picture called `cat`.
157−
158− data Picture = Cat | Hat
159−
160− picture : Input Picture
161− picture = input Cat
162−
163− cat : Element
164− cat = image 30 30 "/cat.jpg"
165− |> clickable picture.handle Cat
166−
167− hat : Element
168− hat = image 30 30 "/hat.jpg"
169− |> clickable picture.handle Hat
170−
171−When the user clicks on the `cat` element, `picture.signal` receives
172−an update containing the value `Cat`. When the user clicks on the `hat` element,
173−`picture.signal` receives an update containing the value `Hat`. This lets you
174−distinguish which element was clicked. In a more complex example, they could be
175−distinguished with IDs or more complex data structures.
176−-}
177−clickable : Handle a -> a -> Element -> Element
178−clickable = Native.Graphics.Input.clickable
libraries/Graphics/Input/Field.elmdeleted−189
@@ -1,189 +0,0 @@
1−module Graphics.Input.Field where
2−{-| This library provides an API for creating and updating text fields.
3−Text fields use exactly the same approach as [`Graphics.Input`](Graphics-Input)
4−for modelling user input, allowing you to keep track of new events and update
5−text fields programmatically.
6−
7−# Create Fields
8−@docs field, password, email
9−
10−# Field Content
11−@docs Content, Selection, Direction, noContent
12−
13−# Field Style
14−@docs defaultStyle, Style, Outline, noOutline, Highlight, noHighlight, Dimensions, uniformly
15−-}
16−
17−import Color (Color)
18−import Color
19−import Graphics.Element (Element)
20−import Graphics.Input (Input, Handle)
21−import Native.Graphics.Input
22−import Text
23−
24−{-| Create uniform dimensions:
25−
26− uniformly 4 == { left=4, right=4, top=4, bottom=4 }
27−
28−The following example creates an outline where the left, right, top, and bottom
29−edges all have width 1:
30−
31− Outline grey (uniformly 1) 4
32−-}
33−uniformly : Int -> Dimensions
34−uniformly n = Dimensions n n n n
35−
36−{-| For setting dimensions of a field's padding or outline. The left, right,
37−top, and bottom may all have different sizes. The following example creates
38−dimensions such that the left and right are twice as wide as the top and bottom:
39−
40− myDimensions : Int -> Dimensions
41− myDimensions n = { left = 2 * n, right = 2 * n, top = n, bottom = n }
42−-}
43−type alias Dimensions =
44− { left:Int
45− , right:Int
46− , top:Int
47− , bottom:Int
48− }
49−
50−{-| A field can have a outline around it. This lets you set its color, width,
51−and radius. The radius allows you to round the corners of your field. Set the
52−width to zero to make it invisible. Here is an example outline that is grey
53−and thin with slightly rounded corners:
54−
55− { color = grey, width = uniformly 1, radius = 4 }
56−-}
57−type alias Outline =
58− { color:Color
59− , width:Dimensions
60− , radius:Int
61− }
62−
63−{-| An outline with zero width, so you cannot see it. -}
64−noOutline : Outline
65−noOutline = Outline Color.grey (uniformly 0) 0
66−
67−{-| When a field has focus, it has a blue highlight around it by default. The
68−`Highlight` lets you set the `color` and `width` of this highlight. Set the
69−`width` to zero to turn the highlight off. Here is an example highlight that
70−is blue and thin:
71−
72− { color = blue, width = 1 }
73−-}
74−type alias Highlight =
75− { color:Color
76− , width:Int
77− }
78−
79−{-| An highlight with zero width, so you cannot see it. -}
80−noHighlight : Highlight
81−noHighlight = Highlight Color.blue 0
82−
83−{-| Describe the style of a text box. `style` describes the style of the text
84−itself using [`Text.Style`](/Text#Style). `highlight` describes the glowing blue
85−highlight that shows up when the field has focus. `outline` describes the line
86−surrounding the text field, and `padding` adds whitespace between the `outline`
87−and the text.
88−
89−The width and height of the text box *includes* the `padding` and `outline`.
90−Say we have a text box that is 40 pixels tall. It has a uniform outline of
91−1 pixel and a uniform padding of 5 pixels. Both of these must be subtracted
92−from the total height to determine how much room there is for text. The
93−`padding` and `outline` appear on the top and bottom, so there will be 28
94−vertical pixels remaining for the text (40 - 1 - 5 - 5 - 1).
95−-}
96−type alias Style =
97− { padding : Dimensions
98− , outline : Outline
99− , highlight : Highlight
100− , style : Text.Style
101− }
102−
103−{-| The default style for a text field. The outline is `Color.grey` with width
104−1 and radius 2. The highlight is `Color.blue` with width 1, and the default
105−text color is black.
106−-}
107−defaultStyle : Style
108−defaultStyle =
109− { padding = uniformly 4
110− , outline = Outline Color.grey (uniformly 1) 2
111− , highlight = Highlight Color.blue 1
112− , style = Text.defaultStyle
113− }
114−
115−{-| Represents the current content of a text field. For example:
116−
117− content = Content "She sells sea shells" (Selection 0 3 Backward)
118−
119−This means the user highlighted the substring `"She"` backwards. The value of
120−`content.string` is `"She sells sea shells"`.
121−-}
122−type alias Content =
123− { string:String
124− , selection:Selection
125− }
126−
127−{-| The selection within a text field. `start` is never greater than `end`:
128−
129− Selection 0 0 Forward -- cursor precedes all characters
130−
131− Selection 5 9 Backward -- highlighting characters starting after
132− -- the 5th and ending after the 9th
133−-}
134−type alias Selection =
135− { start:Int
136− , end:Int
137− , direction:Direction
138− }
139−
140−{-| The direction of selection. When the user highlights a selection in a text
141−field, they must do it in a particular direction. This determines which end of
142−the selection moves when they change the selection by pressing Shift-Left or
143−Shift-Right.
144−-}
145−type Direction = Forward | Backward
146−
147−{-| A field with no content:
148−
149− Content "" (Selection 0 0 Forward)
150−-}
151−noContent : Content
152−noContent = Content "" (Selection 0 0 Forward)
153−
154−{-| Create a text field. The following example creates a time-varying element
155−called `nameField`. As the user types their name, the field will be updated
156−to match what they have entered.
157−
158− name : Input Content
159− name = input noContent
160−
161− nameField : Signal Element
162− nameField = field defaultStyle name.handle identity "Name" <~ name.signal
163−
164−When we use the `field` function, we first give it a visual style. This is
165−the first argument so that it is easier to define your own custom field
166−(`myField = field myStyle`). The next two arguments are a `Handle` and a
167−handler function that processes or augments events before sending them along
168−to the associated `Input`. In the example above we use the `id` function to
169−pass events along unchanged to the `name` `Input`. We then provide the
170−place-holder message to use when no input has been provided yet. Finally,
171−we give the current `Content` of the field. This argument is last because
172−it is most likely to change frequently, making function composition easier.
173−-}
174−field : Style -> Handle a -> (Content -> a) -> String -> Content -> Element
175−field = Native.Graphics.Input.field
176−
177−{-| Same as `field` but the UI element blocks out each characters. -}
178−password : Style -> Handle a -> (Content -> a) -> String -> Content -> Element
179−password = Native.Graphics.Input.password
180−
181−{-| Same as `field` but it adds an annotation that this field is for email
182−addresses. This is helpful for auto-complete and for mobile users who may
183−get a custom keyboard with an `@` and `.com` button.
184−-}
185−email : Style -> Handle a -> (Content -> a) -> String -> Content -> Element
186−email = Native.Graphics.Input.email
187−
188−-- area : Handle a -> (Content -> a) -> Handle b -> ((Int,Int) -> b) -> (Int,Int) -> String -> Content -> Element
189−-- area = Native.Graphics.Input.area
libraries/Http.elmdeleted−57
@@ -1,57 +0,0 @@
1−module Http where
2−{-| A library for asynchronous HTTP requests. See the `WebSocket`
3−library if you have very strict latency requirements.
4−
5−# Sending Requests
6−@docs send, sendGet
7−
8−# Creating Requests
9−@docs get, post, request
10−
11−# Responses
12−@docs Response
13−-}
14−
15−import Signal (..)
16−import Native.Http
17−
18−{-| The datatype for responses. Success contains only the returned message.
19−Failures contain both an error code and an error message.
20−-}
21−type Response a
22− = Success a
23− | Waiting
24− | Failure Int String
25−
26−type alias Request a = {
27− verb : String,
28− url : String,
29− body : a,
30− headers : [(String,String)]
31− }
32−
33−{-| Create a customized request. Arguments are request type (get, post, put,
34−delete, etc.), target url, data, and a list of additional headers.
35−-}
36−request : String -> String -> String -> [(String,String)] -> Request String
37−request = Request
38−
39−{-| Create a GET request to the given url. -}
40−get : String -> Request String
41−get url = Request "GET" url "" []
42−
43−{-| Create a POST request to the given url, carrying the given data. -}
44−post : String -> String -> Request String
45−post url body = Request "POST" url body []
46−
47−{-| Performs an HTTP request with the given requests. Produces a signal
48−that carries the responses.
49−-}
50−send : Signal (Request a) -> Signal (Response String)
51−send = Native.Http.send
52−
53−{-| Performs an HTTP GET request with the given urls. Produces a signal
54−that carries the responses.
55−-}
56−sendGet : Signal String -> Signal (Response String)
57−sendGet reqs = send (lift get reqs)
libraries/JavaScript/Experimental.elmdeleted−56
@@ -1,56 +0,0 @@
1−module 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−-}
10−
11−import Native.JavaScript
12−import Native.Json
13−import Json
14−
15−type RawObject = RawObject
16−
17−{-| Turn arbitrary JavaScript objects into Elm records.
18−Arrays are converted into lists, nested objects are allowed.
19−No `null` values or non-homogeneous arrays.
20−
21− -- OK objects
22− { student:"Steve", scores:[83,94,99,72] }
23− { errorLevel:10, critical:true }
24−
25− -- BAD objects
26− { answer:null }
27− { info:[true,42,'what'] }
28−-}
29−toRecord : RawObject -> a
30−toRecord = Native.JavaScript.toRecord
31−
32−{-| Turn arbitrary Elm records into JavaScript objects.
33−Lists become arrays, nested records are allowed. No ADTs.
34−
35− -- OK records
36− { student="Steve", scores=[83,94,99,72] }
37− { errorLevel=10, critical=True }
38−
39− -- BAD records
40− { answer = Nothing }
41− { result = Left "An error occurred" }
42−-}
43−fromRecord : a -> RawObject
44−fromRecord = Native.JavaScript.fromRecord
45−
46−{-| Turn a raw JavaScript object into a `Json.Value` as described in the
47−`Json` library.
48−-}
49−toJson : RawObject -> Json.Value
50−toJson = Native.Json.fromJS
51−
52−{-| Turn a `Json.Value` (as described in the `Json` library) into a raw
53−JavaScript object.
54−-}
55−fromJson : Json.Value -> RawObject
56−fromJson = Native.Json.toJS
libraries/Json.elmdeleted−49
@@ -1,49 +0,0 @@
1−
2−module Json where
3−
4−{-| Library for working with [JSON](https://en.wikipedia.org/wiki/JSON) values.
5−
6−@docs Value, fromString, toString
7−
8−-}
9−
10−import Dict
11−import Maybe (Maybe)
12−import Native.Json
13−
14−{-| This datatype can represent all valid JSON values. A `Value` can be sent
15−through ports, and the runtime will do a conversion like this:
16−
17− [2,'abc',null] == Array [Number 2, String "abc", Null]
18−
19−JSON is an intentional subset of JavaScript values which excludes functions.
20−This ensures that impure functions cannot sneak into Elm through ports.
21−-}
22−type Value
23− = String String
24− | Number Float
25− | Boolean Bool
26− | Null
27− | Array [Value]
28− | Object (Dict.Dict String Value)
29−
30−
31−{-| Convert a `Value` into a prettified string.
32−The first argument is a separator token (e.g. \" \", \"\\n\", etc.) that will
33−be used for indentation in the prettified string version of the JSON.
34−
35− toString "" Null == "null"
36− toString "" (Number 4.0) == "4.0"
37−-}
38−toString : String -> Value -> String
39−toString sep value = Native.Json.toString sep value
40−
41−{-| Parse a string representation of a proper JSON object into
42−its Elm representation.
43−
44− fromString "null" == Just Null
45− fromString "[true,3]" == Just (Array [Boolean True, Number 3])
46− fromString "{'abc':4}" == Just (Object (Dict.fromList [("abc", Number 4)]))
47−-}
48−fromString : String -> Maybe Value
49−fromString str = Native.Json.fromString str
libraries/Keyboard.elmdeleted−82
@@ -1,82 +0,0 @@
1−module Keyboard where
2−{-| Library for working with keyboard input.
3−
4−# Representing Keys
5−@docs KeyCode
6−
7−# Directions
8−@docs arrows, wasd, directions
9−
10−# Specific Keys
11−The following signals are `True` when the particular key is pressed and `False`
12−otherwise.
13−
14−@docs enter, space, ctrl, shift, alt, meta
15−
16−# General Keypresses
17−@docs isDown, keysDown, lastPressed
18−
19−-}
20−
21−import Signal (Signal)
22−import Native.Keyboard
23−
24−{-| Type alias to make it clearer what integers are supposed to represent
25−in this library. Use `Char.toCode` and `Char.fromCode` to convert key codes
26−to characters. Use the uppercase character with `toCode`.
27−-}
28−type alias KeyCode = Int
29−
30−{-| Custom key directions to support different locales. The order is up, down,
31−left, right.
32−-}
33−directions : KeyCode -> KeyCode -> KeyCode -> KeyCode -> Signal { x:Int, y:Int }
34−directions = Native.Keyboard.directions
35−
36−{-| A signal of records indicating which arrow keys are pressed.
37−
38−`{ x = 0, y = 0 }` when pressing no arrows.<br>
39−`{ x =-1, y = 0 }` when pressing the left arrow.<br>
40−`{ x = 1, y = 1 }` when pressing the up and right arrows.<br>
41−`{ x = 0, y =-1 }` when pressing the down, left, and right arrows.
42−-}
43−arrows : Signal { x:Int, y:Int }
44−arrows = directions 38 40 37 39
45−
46−{-| Just like the arrows signal, but this uses keys w, a, s, and d,
47−which are common controls for many computer games.
48−-}
49−wasd : Signal { x:Int, y:Int }
50−wasd = directions 87 83 65 68
51−
52−{-| Whether an arbitrary key is pressed. -}
53−isDown : KeyCode -> Signal Bool
54−isDown = Native.Keyboard.isDown
55−
56−alt : Signal Bool
57−alt = Native.Keyboard.alt
58−
59−ctrl : Signal Bool
60−ctrl = isDown 17
61−
62−{-| The meta key is the Windows key on Windows and the Command key on Mac.
63−-}
64−meta : Signal Bool
65−meta = Native.Keyboard.meta
66−
67−shift : Signal Bool
68−shift = isDown 16
69−
70−space : Signal Bool
71−space = isDown 32
72−
73−enter : Signal Bool
74−enter = isDown 13
75−
76−{-| List of keys that are currently down. -}
77−keysDown : Signal [KeyCode]
78−keysDown = Native.Keyboard.keysDown
79−
80−{-| The latest key that has been pressed. -}
81−lastPressed : Signal KeyCode
82−lastPressed = Native.Keyboard.lastPressed
libraries/List.elmdeleted−379
@@ -1,379 +0,0 @@
1−module List where
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, join, intersperse, zip, zipWith, repeat
14−
15−# Taking Lists Apart
16−@docs partition, unzip
17−
18−# Folds
19−@docs foldr, foldl
20−
21−# Special Maps
22−@docs filterMap, concatMap, indexedMap
23−
24−# Special Folds
25−@docs sum, product, maximum, minimum, all, any, foldr1, foldl1, scanl, scanl1
26−
27−# Sorting
28−@docs sort, sortBy, sortWith
29−
30−# Additional Zips
31−@docs zip3, zip4, zip5, zipWith3, zipWith4, zipWith5
32−
33−If you can think of a legitimate use of `zipN` or `zipWithN` where `N` is 6 or
34−more, please let us know on [the
35−list](https://groups.google.com/forum/#!forum/elm-discuss). The current
36−sentiment is that it is already quite error prone once you get to 4 and
37−possibly should be approached another way.
38−-}
39−
40−import Basics (..)
41−import Maybe ( Maybe(Just,Nothing) )
42−import Native.List
43−
44−{-| Add an element to the front of a list. Pronounced *cons*.
45−
46− 1 :: [2,3] == [1,2,3]
47− 1 :: [] == [1]
48−-}
49−(::) : a -> [a] -> [a]
50−(::) = Native.List.cons
51−
52−{-| Put two appendable things together.
53−
54− [1,1] ++ [2,3] == [1,1,2,3]
55− "abc" ++ "123" == "abc123"
56−-}
57−(++) : appendable -> appendable -> appendable
58−(++) = Native.List.append
59−
60−infixr 5 ::
61−infixr 5 ++
62−
63−{-| Extract the first element of a list. List must be non-empty.
64−
65− head [1,2,3] == 1
66−-}
67−head : [a] -> a
68−head = Native.List.head
69−
70−{-| Extract the elements after the head of the list. List must be non-empty.
71−
72− tail [1,2,3] == [2,3]
73−-}
74−tail : [a] -> [a]
75−tail = Native.List.tail
76−
77−{-| Extract the last element of a list. List must be non-empty.
78−
79− last [1,2,3] == 3
80−-}
81−last : [a] -> a
82−last = Native.List.last
83−
84−{-| Determine if a list is empty.
85−
86− isEmpty [] == True
87−-}
88−isEmpty : [a] -> Bool
89−isEmpty xs =
90− case xs of
91− [] -> True
92− _ -> False
93−
94−{-| Apply a function to every element of a list.
95−
96− map sqrt [1,4,9] == [1,2,3]
97−-}
98−map : (a -> b) -> [a] -> [b]
99−map = Native.List.map
100−
101−{-| Same as `map` but the function is also applied to the index of each
102−element (starting at zero).
103−
104− indexedMap (,) ["Tom","Sue","Bob"] == [ (0,"Tom"), (1,"Sue"), (2,"Bob") ]
105−-}
106−indexedMap : (Int -> a -> b) -> [a] -> [b]
107−indexedMap f xs =
108− zipWith f [ 0 .. length xs - 1 ] xs
109−
110−{-| Reduce a list from the left.
111−
112− foldl (::) [] [1,2,3] == [3,2,1]
113−-}
114−foldl : (a -> b -> b) -> b -> [a] -> b
115−foldl = Native.List.foldl
116−
117−{-| Reduce a list from the right.
118−
119− foldr (+) 0 [1,2,3] == 6
120−-}
121−foldr : (a -> b -> b) -> b -> [a] -> b
122−foldr = Native.List.foldr
123−
124−{-| Reduce a list from the left without a base case. List must be non-empty. -}
125−foldl1 : (a -> a -> a) -> [a] -> a
126−foldl1 = Native.List.foldl1
127−
128−{-| Reduce a list from the right without a base case. List must be non-empty. -}
129−foldr1 : (a -> a -> a) -> [a] -> a
130−foldr1 = Native.List.foldr1
131−
132−{-| Reduce a list from the left, building up all of the intermediate results into a list.
133−
134− scanl (+) 0 [1,2,3,4] == [0,1,3,6,10]
135−-}
136−scanl : (a -> b -> b) -> b -> [a] -> [b]
137−scanl = Native.List.scanl
138−
139−{-| Same as scanl but it doesn't require a base case. List must be non-empty.
140−
141− scanl1 (+) [1,2,3,4] == [1,3,6,10]
142−-}
143−scanl1 : (a -> a -> a) -> [a] -> [a]
144−scanl1 = Native.List.scanl1
145−
146−{-| Keep only elements that satisfy the predicate.
147−
148− filter isEven [1..6] == [2,4,6]
149−-}
150−filter : (a -> Bool) -> [a] -> [a]
151−filter = Native.List.filter
152−
153−{-| Apply a function that may succeed to all values in the list, but only keep
154−the successes.
155−
156− String.toInt : String -> Maybe Int
157−
158− filterMap String.toInt ["3", "4.0", "5", "hats"] == [3,5]
159−-}
160−filterMap : (a -> Maybe b) -> [a] -> [b]
161−filterMap f xs = foldr (maybeCons f) [] xs
162−
163−maybeCons : (a -> Maybe b) -> a -> [b] -> [b]
164−maybeCons f mx xs =
165− case f mx of
166− Just x -> x :: xs
167− Nothing -> xs
168−
169−{-| Determine the length of a list.
170−
171− length [1,2,3] == 3
172−-}
173−length : [a] -> Int
174−length = Native.List.length
175−
176−{-| Reverse a list.
177−
178− reverse [1..4] == [4,3,2,1]
179−-}
180−reverse : [a] -> [a]
181−reverse = Native.List.reverse
182−
183−{-| Determine if all elements satisfy the predicate.
184−
185− all isEven [2,4] == True
186− all isEven [2,3] == False
187− all isEven [] == True
188−-}
189−all : (a -> Bool) -> [a] -> Bool
190−all = Native.List.all
191−
192−{-| Determine if any elements satisfy the predicate.
193−
194− any isEven [2,3] == True
195− any isEven [1,3] == False
196− any isEven [] == False
197−-}
198−any : (a -> Bool) -> [a] -> Bool
199−any = Native.List.any
200−
201−{-| Concatenate a list of appendable things:
202−
203− concat [[1,2],[3],[4,5]] == [1,2,3,4,5]
204− concat ["tree","house"] == "treehouse"
205−-}
206−concat : [appendable] -> appendable
207−concat = Native.List.concat
208−
209−{-| Map a given function onto a list and flatten the resulting lists.
210−
211− concatMap f xs == concat (map f xs)
212−-}
213−concatMap : (a -> appendable) -> [a] -> appendable
214−concatMap f list = concat (map f list)
215−
216−{-| Get the sum of the list elements.
217−
218− sum [1..4] == 10
219−-}
220−sum : [number] -> number
221−sum = foldl (+) 0
222−
223−{-| Get the product of the list elements.
224− product [1..4] == 24
225−-}
226−product : [number] -> number
227−product = foldl (*) 1
228−
229−{-| Find the maximum element in a non-empty list.
230− maximum [1,4,2] == 4
231−-}
232−maximum : [comparable] -> comparable
233−maximum = foldl1 max
234−
235−{-| Find the minimum element in a non-empty list.
236− minimum [3,2,1] == 1
237−-}
238−minimum : [comparable] -> comparable
239−minimum = foldl1 min
240−
241−{-| Partition a list based on a predicate. The first list contains all values
242−that satisfy the predicate, and the second list contains all the value that do
243−not.
244−
245− partition (\x -> x < 3) [0..5] == ([0,1,2], [3,4,5])
246− partition isEven [0..5] == ([0,2,4], [1,3,5])
247−-}
248−partition : (a -> Bool) -> [a] -> ([a],[a])
249−partition pred =
250− let step x (ts, fs) = if pred x
251− then (x::ts, fs)
252− else (ts, x::fs)
253− in foldr step ([],[])
254−
255−{-| Combine two lists, combining them into tuples pairwise.
256−If one list is longer, the extra elements are dropped.
257−
258− zip [1,2,3] [6,7] == [(1,6),(2,7)]
259− zip == zipWith (,)
260−-}
261−zip : [a] -> [b] -> [(a,b)]
262−zip = Native.List.zip
263−
264−zip3 : [a] -> [b] -> [c] -> [(a,b,c)]
265−zip3 = Native.List.zipWith3 (,,)
266−
267−zip4 : [a] -> [b] -> [c] -> [d] -> [(a,b,c,d)]
268−zip4 = Native.List.zipWith4 (,,,)
269−
270−zip5 : [a] -> [b] -> [c] -> [d] -> [e] -> [(a,b,c,d,e)]
271−zip5 = Native.List.zipWith5 (,,,,)
272−
273−{-| Combine two lists, combining them with the given function.
274−If one list is longer, the extra elements are dropped.
275−
276− zipWith (+) [1,2,3] [1,2,3,4] == [2,4,6]
277−-}
278−zipWith : (a -> b -> c) -> [a] -> [b] -> [c]
279−zipWith = Native.List.zipWith
280−
281−zipWith3 : (a -> b -> c -> x) -> [a] -> [b] -> [c] -> [x]
282−zipWith3 = Native.List.zipWith3
283−
284−zipWith4 : (a -> b -> c -> d -> x) -> [a] -> [b] -> [c] -> [d] -> [x]
285−zipWith4 = Native.List.zipWith4
286−
287−zipWith5 : (a -> b -> c -> d -> e -> x) -> [a] -> [b] -> [c] -> [d] -> [e] -> [x]
288−zipWith5 = Native.List.zipWith5
289−
290−{-| Decompose a list of tuples into a tuple of lists.
291−
292− unzip [(0, True), (17, False), (1337, True)] == ([0,17,1337], [True,False,True])
293−-}
294−unzip : [(a,b)] -> ([a],[b])
295−unzip =
296− let step (x,y) (xs, ys) = (x::xs, y::ys)
297− in foldr step ([], [])
298−
299−{-| Place a value between all elements in a list and concatenates the result.
300−
301− join "a" ["H","w","ii","n"] == "Hawaiian"
302−-}
303−join : appendable -> [appendable] -> appendable
304−join = Native.List.join
305−
306−{-| Places the given value between all members of the given list.
307−
308− intersperse "on" ["turtles","turtles","turtles"] == ["turtles","on","turtles","on","turtles"]
309−-}
310−intersperse : a -> [a] -> [a]
311−intersperse sep xs =
312− case xs of
313− [] -> []
314− hd::tl ->
315− let step x rest = sep :: x :: rest
316− spersed = foldr step [] tl
317− in hd :: spersed
318−
319−{-| Take the first *n* members of a list.
320−
321− take 2 [1,2,3,4] == [1,2]
322−-}
323−take : Int -> [a] -> [a]
324−take = Native.List.take
325−
326−{-| Drop the first *n* members of a list.
327−
328− drop 2 [1,2,3,4] == [3,4]
329−-}
330−drop : Int -> [a] -> [a]
331−drop = Native.List.drop
332−
333−{-| Create a list with *n* copies of a value:
334−
335− repeat 3 (0,0) == [(0,0),(0,0),(0,0)]
336−-}
337−repeat : Int -> a -> [a]
338−repeat = Native.List.repeat
339−
340−{-| Sort values from lowest to highest
341−
342− sort [3,1,5] == [1,3,5]
343−-}
344−sort : [comparable] -> [comparable]
345−sort = Native.List.sort
346−
347−{-| Sort values by a derived property.
348−
349−```haskell
350−alice = { name="Alice", height=1.62 }
351−bob = { name="Bob" , height=1.85 }
352−chuck = { name="Chuck", height=1.76 }
353−
354−sortBy .name [chuck,alice,bob] == [alice,bob,chuck]
355−sortBy .height [chuck,alice,bob] == [alice,chuck,bob]
356−
357−sortBy String.length ["mouse","cat"] == ["cat","mouse"]
358−```
359−-}
360−sortBy : (a -> comparable) -> [a] -> [a]
361−sortBy = Native.List.sortBy
362−
363−{-| Sort values with a custom comparison function.
364−
365−```haskell
366−sortWith flippedComparison [1..5] == [5,4,3,2,1]
367−
368−flippedComparison a b =
369− case compare a b of
370− LT -> GT
371− EQ -> EQ
372− GT -> LT
373−```
374−
375−This is also the most general sort function, allowing you
376−to define any other: `sort == sortWith compare`
377−-}
378−sortWith : (a -> a -> Order) -> [a] -> [a]
379−sortWith = Native.List.sortWith
libraries/Maybe.elmdeleted−61
@@ -1,61 +0,0 @@
1−module Maybe (Maybe(..), maybe, isJust, isNothing, map) where
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−# Map
12−@docs map
13−-}
14−
15−{-| The Maybe datatype. Useful when a computation may or may not
16−result in a value (e.g. logarithm is defined only for positive
17−numbers).
18−-}
19−type Maybe a = Just a | Nothing
20−
21−{-| Provide a default value and a function to extract the contents of a `Maybe`.
22−When given `Nothing` you get the default, when given a `Just` you apply the
23−function to the associated value.
24−
25− isPositive : Maybe Int -> Bool
26− isPositive maybeInt = maybe False (\n -> n > 0) maybeInt
27−-}
28−maybe : b -> (a -> b) -> Maybe a -> b
29−maybe b f m =
30− case m of
31− Just v -> f v
32− Nothing -> b
33−
34−{-| Check if a maybe happens to be a `Just`.
35−
36− isJust (Just 42) == True
37− isJust (Just []) == True
38− isJust Nothing == False
39−-}
40−isJust : Maybe a -> Bool
41−isJust = maybe False (\_ -> True)
42−
43−{-| Check if constructed with `Nothing`.
44−
45− isNothing (Just 42) == False
46− isNothing (Just []) == False
47− isNothing Nothing == True
48−-}
49−isNothing : Maybe a -> Bool
50−isNothing = maybe True (\_ -> False)
51−
52−{-| Transform the contents of a `Maybe` with a given function:
53−
54− map sqrt (Just 9) == Just 3
55− map sqrt Nothing == Nothing
56−-}
57−map : (a -> b) -> Maybe a -> Maybe b
58−map f maybe =
59− case maybe of
60− Just v -> Just (f v)
61− Nothing -> Nothing
libraries/Mouse.elmdeleted−36
@@ -1,36 +0,0 @@
1−
2−module 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
11−
12−-}
13−
14−import Signal (Signal)
15−import Native.Mouse
16−
17−{-| The current mouse position. -}
18−position : Signal (Int,Int)
19−position = Native.Mouse.position
20−
21−{-| The current x-coordinate of the mouse. -}
22−x : Signal Int
23−x = Native.Mouse.x
24−
25−{-| The current y-coordinate of the mouse. -}
26−y : Signal Int
27−y = Native.Mouse.y
28−
29−{-| The current state of the left mouse-button.
30−True when the button is down, and false otherwise. -}
31−isDown : Signal Bool
32−isDown = Native.Mouse.isDown
33−
34−{-| Always equal to unit. Event triggers on every mouse click. -}
35−clicks : Signal ()
36−clicks = Native.Mouse.clicks
libraries/Native/Array.jsdeleted−711
@@ -1,711 +0,0 @@
1−Elm.Native.Array = {};
2−Elm.Native.Array.make = function(elm) {
3− elm.Native = elm.Native || {};
4− elm.Native.Array = elm.Native.Array || {};
5− if (elm.Native.Array.values) return elm.Native.Array.values;
6− if ('values' in Elm.Native.Array)
7− return elm.Native.Array.values = Elm.Native.Array.values;
8−
9− var List = Elm.Native.List.make(elm);
10−
11− // A RRB-Tree has two distinct data types.
12− // Leaf -> "height" is always 0
13− // "table" is an array of elements
14− // Node -> "height" is always greater than 0
15− // "table" is an array of child nodes
16− // "lengths" is an array of accumulated lengths of the child nodes
17−
18− // M is the maximal table size. 32 seems fast. E is the allowed increase
19− // of search steps when concatting to find an index. Lower values will
20− // decrease balancing, but will increase search steps.
21− var M = 32;
22− var E = 2;
23−
24− // An empty array.
25− var empty = { ctor:"_Array", height:0, table:new Array() };
26−
27− function get(i, array) {
28− if (i < 0 || i >= length(array)) {
29− throw new Error("Index " + i + " is out of range. Check the length of " +
30− "your array first or use getMaybe or getWithDefault.");
31− }
32− return unsafeGet(i, array);
33− }
34−
35− function unsafeGet(i, array) {
36− for (var x = array.height; x > 0; x--) {
37− var slot = i >> (x * 5);
38− while (array.lengths[slot] <= i) {
39− slot++;
40− }
41− if (slot > 0) {
42− i -= array.lengths[slot - 1];
43− }
44− array = array.table[slot];
45− }
46− return array.table[i];
47− }
48−
49− // Sets the value at the index i. Only the nodes leading to i will get
50− // copied and updated.
51− function set(i, item, array) {
52− if (i < 0 || length(array) <= i) {
53− return array;
54− }
55− return unsafeSet(i, item, array);
56− }
57−
58− function unsafeSet(i, item, array) {
59− array = nodeCopy(array);
60−
61− if (array.height == 0) {
62− array.table[i] = item;
63− } else {
64− var slot = getSlot(i, array);
65− if (slot > 0) {
66− i -= array.lengths[slot - 1];
67− }
68− array.table[slot] = unsafeSet(i, item, array.table[slot]);
69− }
70− return array;
71− }
72−
73− function initialize(len, f) {
74− if (len == 0) { return empty; }
75− var h = Math.floor(Math.log(len)/Math.log(M));
76− return initialize_(f, h, 0, len);
77− }
78−
79− function initialize_(f, h, from, to) {
80− if (h == 0) {
81− var table = new Array((to - from) % (M + 1));
82− for (var i = 0; i < table.length; i++) {
83− table[i] = f(from + i);
84− }
85− return { ctor:"_Array", height:0, table:table };
86− }
87−
88− var step = Math.pow(M, h);
89− var table = new Array(Math.ceil((to - from) / step));
90− var lengths = new Array(table.length);
91− for (var i = 0; i < table.length; i++) {
92− table[i] = initialize_( f, h - 1, from + (i * step)
93− , Math.min(from + ((i + 1) * step), to));
94− lengths[i] = length(table[i]) + (i > 0 ? lengths[i-1] : 0);
95− }
96− return { ctor:"_Array", height:h, table:table, lengths:lengths };
97− }
98−
99− function fromList(list) {
100− if (list == List.Nil) { return empty; }
101−
102− // Allocate M sized blocks (table) and write list elements to it.
103− var table = new Array(M);
104− var nodes = new Array();
105− var i = 0;
106−
107− while (list.ctor !== '[]') {
108− table[i] = list._0;
109− list = list._1;
110− i++;
111−
112− // table is full, so we can push a leaf containing it into the
113− // next node.
114− if (i == M) {
115− fromListPush({ ctor:"_Array", height:0, table:table }
116− , nodes);
117− table = new Array(M);
118− i = 0;
119− }
120− }
121−
122− // Maybe there is something left on the table.
123− if (i > 0) {
124− fromListPush({ ctor:"_Array", height:0, table:table.splice(0,i) }
125− , nodes);
126− }
127−
128− // Go through all of the nodes and eventually push them into higher nodes.
129− for (var h = 0; h < nodes.length - 1; h++) {
130− if (nodes[h].table.length > 0) {
131− fromListPush(nodes[h], nodes);
132− }
133− }
134−
135− var head = nodes[nodes.length - 1];
136− if (head.height > 0 && head.table.length == 1) {
137− return head.table[0];
138− } else {
139− return head;
140− }
141− }
142−
143− // Push a node into a higher node as a child.
144− function fromListPush(toPush, nodes) {
145− var h = toPush.height;
146−
147− // Maybe the node on this height does not exist.
148− if (nodes.length == h) {
149− nodes.push({ ctor:"_Array", height:h + 1
150− , table:new Array()
151− , lengths:new Array() });
152− }
153−
154− nodes[h].table.push(toPush);
155− var len = length(toPush);
156− if (nodes[h].lengths.length > 0) {
157− len += nodes[h].lengths[nodes[h].lengths.length - 1];
158− }
159− nodes[h].lengths.push(len);
160−
161− if (nodes[h].table.length == M) {
162− fromListPush(nodes[h], nodes);
163− nodes[h] = { ctor:"_Array", height:h + 1
164− , table:new Array()
165− , lengths:new Array() };
166− }
167− }
168−
169− // Pushes an item via push_ to the bottom right of a tree.
170− function push(item, a) {
171− var pushed = push_(item, a);
172− if (pushed !== null) {
173− return pushed;
174− }
175−
176− var newTree = create(item, a.height);
177− return siblise(a, newTree);
178− }
179−
180− // Recursively tries to push an item to the bottom-right most
181− // tree possible. If there is no space left for the item,
182− // null will be returned.
183− function push_(item, a) {
184− // Handle resursion stop at leaf level.
185− if (a.height == 0) {
186− if (a.table.length < M) {
187− var newA = { ctor:"_Array", height:0, table:a.table.slice() };
188− newA.table.push(item);
189− return newA;
190− } else {
191− return null;
192− }
193− }
194−
195− // Recursively push
196− var pushed = push_(item, botRight(a));
197−
198− // There was space in the bottom right tree, so the slot will
199− // be updated.
200− if (pushed != null) {
201− var newA = nodeCopy(a);
202− newA.table[newA.table.length - 1] = pushed;
203− newA.lengths[newA.lengths.length - 1]++;
204− return newA
205− }
206−
207− // When there was no space left, check if there is space left
208− // for a new slot with a tree which contains only the item
209− // at the bottom.
210− if (a.table.length < M) {
211− var newSlot = create(item, a.height - 1);
212− var newA = nodeCopy(a);
213− newA.table.push(newSlot);
214− newA.lengths.push(newA.lengths[newA.lengths.length - 1] + length(newSlot));
215− return newA
216− } else {
217− return null;
218− }
219− }
220−
221− // Converts an array into a list of elements.
222− function toList(a) {
223− return toList_(List.Nil, a);
224− }
225−
226− function toList_(list, a) {
227− for (var i = a.table.length - 1; i >= 0; i--) {
228− list = a.height == 0 ? List.Cons(a.table[i], list) : toList_(list, a.table[i]);
229− }
230− return list;
231− }
232−
233− // Maps a function over the elements of an array.
234− function map(f, a) {
235− var newA = { ctor:"_Array", height:a.height, table:new Array(a.table) };
236− if (a.height > 0) { newA.lengths = a.lengths; }
237− for (var i = 0; i < a.table.length; i++) {
238− newA.table[i] = a.height == 0 ? f(a.table[i]) : map(f, a.table[i]);
239− }
240− return newA;
241− }
242−
243− // Maps a function over the elements with their index as first argument.
244− function indexedMap(f, a) {
245− return indexedMap_(f, a, 0);
246− }
247−
248− function indexedMap_(f, a, from) {
249− var newA = { ctor:"_Array", height:a.height, table:new Array(a.table) };
250− if (a.height > 0) { newA.lengths = a.lengths; }
251− for (var i = 0; i < a.table.length; i++) {
252− newA.table[i] = a.height == 0 ? A2(f, from + i, a.table[i])
253− : indexedMap_( f, a.table[i]
254− , i == 0 ? 0 : a.lengths[i - 1]);
255− }
256− return newA;
257− }
258−
259− function foldl(f, b, a) {
260− if (a.height == 0) {
261− for (var i = 0; i < a.table.length; i++) {
262− b = A2(f, a.table[i], b);
263− }
264− } else {
265− for (var i = 0; i < a.table.length; i++) {
266− b = foldl(f, b, a.table[i]);
267− }
268− }
269− return b;
270− }
271−
272− function foldr(f, b, a) {
273− if (a.height == 0) {
274− for (var i = a.table.length; i--; ) {
275− b = A2(f, a.table[i], b);
276− }
277− } else {
278− for (var i = a.table.length; i--; ) {
279− b = foldl(f, b, a.table[i]);
280− }
281− }
282− return b;
283− }
284−
285− // TODO: currently, it slices the right, then the left. This can be
286− // optimized.
287− function slice(from, to, a) {
288− if (from < 0) { from += length(a); }
289− if (to < 0) { to += length(a); }
290− return sliceLeft(from, sliceRight(to, a));
291− }
292−
293− function sliceRight(to, a) {
294− if (to == length(a)) {
295− return a;
296− }
297−
298− // Handle leaf level.
299− if (a.height == 0) {
300− var newA = { ctor:"_Array", height:0 };
301− newA.table = a.table.slice(0, to);
302− return newA;
303− }
304−
305− // Slice the right recursively.
306− var right = getSlot(to, a);
307− var sliced = sliceRight(to - (right > 0 ? a.lengths[right - 1] : 0), a.table[right]);
308−
309− // Maybe the a node is not even needed, as sliced contains the whole slice.
310− if (right == 0) {
311− return sliced;
312− }
313−
314− // Create new node.
315− var newA = { ctor:"_Array", height:a.height
316− , table:a.table.slice(0, right)
317− , lengths:a.lengths.slice(0, right) };
318− if (sliced.table.length > 0) {
319− newA.table[right] = sliced;
320− newA.lengths[right] = length(sliced) + (right > 0 ? newA.lengths[right - 1] : 0);
321− }
322− return newA;
323− }
324−
325− function sliceLeft(from, a) {
326− if (from == 0) {
327− return a;
328− }
329−
330− // Handle leaf level.
331− if (a.height == 0) {
332− var newA = { ctor:"_Array", height:0 };
333− newA.table = a.table.slice(from, a.table.length + 1);
334− return newA;
335− }
336−
337− // Slice the left recursively.
338− var left = getSlot(from, a);
339− var sliced = sliceLeft(from - (left > 0 ? a.lengths[left - 1] : 0), a.table[left]);
340−
341− // Maybe the a node is not even needed, as sliced contains the whole slice.
342− if (left == a.table.length - 1) {
343− return sliced;
344− }
345−
346− // Create new node.
347− var newA = { ctor:"_Array", height:a.height
348− , table:a.table.slice(left, a.table.length + 1)
349− , lengths:new Array(a.table.length - left) };
350− newA.table[0] = sliced;
351− var len = 0;
352− for (var i = 0; i < newA.table.length; i++) {
353− len += length(newA.table[i]);
354− newA.lengths[i] = len;
355− }
356−
357− return newA;
358− }
359−
360− // Appends two trees.
361− function append(a,b) {
362− if (a.table.length === 0) {
363− return b;
364− }
365− if (b.table.length === 0) {
366− return a;
367− }
368−
369− var c = append_(a, b);
370−
371− // Check if both nodes can be crunshed together.
372− if (c[0].table.length + c[1].table.length <= M) {
373− if (c[0].table.length === 0) {
374− return c[1];
375− }
376− if (c[1].table.length === 0) {
377− return c[0];
378− }
379−
380− // Adjust .table and .lengths
381− c[0].table = c[0].table.concat(c[1].table);
382− if (c[0].height > 0) {
383− var len = length(c[0]);
384− for (var i = 0; i < c[1].lengths.length; i++) {
385− c[1].lengths[i] += len;
386− }
387− c[0].lengths = c[0].lengths.concat(c[1].lengths);
388− }
389−
390− return c[0];
391− }
392−
393− if (c[0].height > 0) {
394− var toRemove = calcToRemove(a, b);
395− if (toRemove > E) {
396− c = shuffle(c[0], c[1], toRemove);
397− }
398− }
399−
400− return siblise(c[0], c[1]);
401− }
402−
403− // Returns an array of two nodes; right and left. One node _may_ be empty.
404− function append_(a, b) {
405− if (a.height === 0 && b.height === 0) {
406− return [a, b];
407− }
408−
409− if (a.height !== 1 || b.height !== 1) {
410− if (a.height === b.height) {
411− a = nodeCopy(a);
412− b = nodeCopy(b);
413− var appended = append_(botRight(a), botLeft(b));
414−
415− insertRight(a, appended[1]);
416− insertLeft(b, appended[0]);
417− } else if (a.height > b.height) {
418− a = nodeCopy(a);
419− var appended = append_(botRight(a), b);
420−
421− insertRight(a, appended[0]);
422− b = parentise(appended[1], appended[1].height + 1);
423− } else {
424− b = nodeCopy(b);
425− var appended = append_(a, botLeft(b));
426−
427− var left = appended[0].table.length === 0 ? 0 : 1;
428− var right = left === 0 ? 1 : 0;
429− insertLeft(b, appended[left]);
430− a = parentise(appended[right], appended[right].height + 1);
431− }
432− }
433−
434− // Check if balancing is needed and return based on that.
435− if (a.table.length === 0 || b.table.length === 0) {
436− return [a,b];
437− }
438−
439− var toRemove = calcToRemove(a, b);
440− if (toRemove <= E) {
441− return [a,b];
442− }
443− return shuffle(a, b, toRemove);
444− }
445−
446− // Helperfunctions for append_. Replaces a child node at the side of the parent.
447− function insertRight(parent, node) {
448− var index = parent.table.length - 1;
449− parent.table[index] = node;
450− parent.lengths[index] = length(node)
451− parent.lengths[index] += index > 0 ? parent.lengths[index - 1] : 0;
452− }
453−
454− function insertLeft(parent, node) {
455− if (node.table.length > 0) {
456− parent.table[0] = node;
457− parent.lengths[0] = length(node);
458−
459− var len = length(parent.table[0]);
460− for (var i = 1; i < parent.lengths.length; i++) {
461− len += length(parent.table[i]);
462− parent.lengths[i] = len;
463− }
464− } else {
465− parent.table.shift();
466− for (var i = 1; i < parent.lengths.length; i++) {
467− parent.lengths[i] = parent.lengths[i] - parent.lengths[0];
468− }
469− parent.lengths.shift();
470− }
471− }
472−
473− // Returns the extra search steps for E. Refer to the paper.
474− function calcToRemove(a, b) {
475− var subLengths = 0;
476− for (var i = 0; i < a.table.length; i++) {
477− subLengths += a.table[i].table.length;
478− }
479− for (var i = 0; i < b.table.length; i++) {
480− subLengths += b.table[i].table.length;
481− }
482−
483− var toRemove = a.table.length + b.table.length
484− return toRemove - (Math.floor((subLengths - 1) / M) + 1);
485− }
486−
487− // get2, set2 and saveSlot are helpers for accessing elements over two arrays.
488− function get2(a, b, index) {
489− return index < a.length ? a[index] : b[index - a.length];
490− }
491−
492− function set2(a, b, index, value) {
493− if (index < a.length) {
494− a[index] = value;
495− } else {
496− b[index - a.length] = value;
497− }
498− }
499−
500− function saveSlot(a, b, index, slot) {
501− set2(a.table, b.table, index, slot);
502−
503− var l = (index == 0 || index == a.lengths.length) ?
504− 0 : get2(a.lengths, a.lengths, index - 1);
505− set2(a.lengths, b.lengths, index, l + length(slot));
506− }
507−
508− // Creates a node or leaf with a given length at their arrays for perfomance.
509− // Is only used by shuffle.
510− function createNode(h, length) {
511− if (length < 0) { length = 0; }
512− var a = { ctor:"_Array", height:h, table:new Array(length) };
513− if (h > 0) {
514− a.lengths = new Array(length);
515− }
516− return a;
517− }
518−
519− // Returns an array of two balanced nodes.
520− function shuffle(a, b, toRemove) {
521− var newA = createNode(a.height, Math.min(M, a.table.length + b.table.length - toRemove));
522− var newB = createNode(a.height, newA.table.length - (a.table.length + b.table.length - toRemove));
523−
524− // Skip the slots with size M. More precise: copy the slot references
525− // to the new node
526− var read = 0;
527− while (get2(a.table, b.table, read).table.length % M == 0) {
528− set2(newA.table, newB.table, read, get2(a.table, b.table, read));
529− set2(newA.lengths, newB.lengths, read, get2(a.lengths, b.lengths, read));
530− read++;
531− }
532−
533− // Pulling items from left to right, caching in a slot before writing
534− // it into the new nodes.
535− var write = read;
536− var slot = new createNode(a.height - 1, 0);
537− var from = 0;
538−
539− // If the current slot is still containing data, then there will be at
540− // least one more write, so we do not break this loop yet.
541− while (read - write - (slot.table.length > 0 ? 1 : 0) < toRemove) {
542− // Find out the max possible items for copying.
543− var source = get2(a.table, b.table, read);
544− var to = Math.min(M - slot.table.length, source.table.length)
545−
546− // Copy and adjust size table.
547− slot.table = slot.table.concat(source.table.slice(from, to));
548− if (slot.height > 0) {
549− var len = slot.lengths.length;
550− for (var i = len; i < len + to - from; i++) {
551− slot.lengths[i] = length(slot.table[i]);
552− slot.lengths[i] += (i > 0 ? slot.lengths[i - 1] : 0);
553− }
554− }
555−
556− from += to;
557−
558− // Only proceed to next slots[i] if the current one was
559− // fully copied.
560− if (source.table.length <= to) {
561− read++; from = 0;
562− }
563−
564− // Only create a new slot if the current one is filled up.
565− if (slot.table.length == M) {
566− saveSlot(newA, newB, write, slot);
567− slot = createNode(a.height - 1,0);
568− write++;
569− }
570− }
571−
572− // Cleanup after the loop. Copy the last slot into the new nodes.
573− if (slot.table.length > 0) {
574− saveSlot(newA, newB, write, slot);
575− write++;
576− }
577−
578− // Shift the untouched slots to the left
579− while (read < a.table.length + b.table.length ) {
580− saveSlot(newA, newB, write, get2(a.table, b.table, read));
581− read++; write++;
582− }
583−
584− return [newA, newB];
585− }
586−
587− // Navigation functions
588− function botRight(a) { return a.table[a.table.length - 1]; }
589− function botLeft(a) { return a.table[0]; }
590−
591− // Copies a node for updating. Note that you should not use this if
592− // only updating only one of "table" or "lengths" for performance reasons.
593− function nodeCopy(a) {
594− var newA = { ctor:"_Array", height:a.height
595− , table:a.table.slice() };
596− if (a.height > 0) { newA.lengths = a.lengths.slice(); }
597− return newA;
598− }
599−
600− // Returns how many items are in the tree.
601− function length(array) {
602− if (array.height == 0) {
603− return array.table.length;
604− } else {
605− return array.lengths[array.lengths.length - 1];
606− }
607− }
608−
609− // Calculates in which slot of "table" the item probably is, then
610− // find the exact slot via forward searching in "lengths". Returns the index.
611− function getSlot(i, a) {
612− var slot = i >> (5 * a.height);
613− while (a.lengths[slot] <= i) {
614− slot++;
615− }
616− return slot;
617− }
618−
619− // Recursively creates a tree with a given height containing
620− // only the given item.
621− function create(item, h) {
622− if (h == 0) {
623− return { ctor:"_Array", height:0
624− , table:[item] };
625− } else {
626− return { ctor:"_Array", height:h
627− , table:[create(item, h - 1)]
628− , lengths:[1] };
629− }
630− }
631−
632− // Recursively creates a tree that contains the given tree.
633− function parentise(tree, h) {
634− if (h == tree.height) {
635− return tree;
636− } else {
637− return { ctor:"_Array", height:h
638− , table:[parentise(tree, h - 1)]
639− , lengths:[length(tree)] };
640− }
641− }
642−
643− // Emphasizes blood brotherhood beneath two trees.
644− function siblise(a, b) {
645− return { ctor:"_Array", height:a.height + 1
646− , table:[a, b]
647− , lengths:[length(a), length(a) + length(b)] };
648− }
649−
650− function toJSArray(a) {
651− var jsArray = new Array(length(a));
652− toJSArray_(jsArray, 0, a);
653− return jsArray;
654− }
655−
656− function toJSArray_(jsArray, i, a) {
657− for (var t = 0; t < a.table.length; t++) {
658− if (a.height == 0) {
659− jsArray[i + t] = a.table[t];
660− } else {
661− var inc = t == 0 ? 0 : a.lengths[t - 1];
662− toJSArray_(jsArray, i + inc, a.table[t]);
663− }
664− }
665− }
666−
667− function fromJSArray(jsArray) {
668− if (jsArray.length == 0) { return empty; }
669− var h = Math.floor(Math.log(jsArray.length) / Math.log(M));
670− return fromJSArray_(jsArray, h, 0, jsArray.length);
671− }
672−
673− function fromJSArray_(jsArray, h, from, to) {
674− if (h == 0) {
675− return { ctor:"_Array", height:0
676− , table:jsArray.slice(from, to) };
677− }
678−
679− var step = Math.pow(M, h);
680− var table = new Array(Math.ceil((to - from) / step));
681− var lengths = new Array(table.length);
682− for (var i = 0; i < table.length; i++) {
683− table[i] = fromJSArray_( jsArray, h - 1, from + (i * step)
684− , Math.min(from + ((i + 1) * step), to));
685− lengths[i] = length(table[i]) + (i > 0 ? lengths[i-1] : 0);
686− }
687− return { ctor:"_Array", height:h, table:table, lengths:lengths };
688− }
689−
690− Elm.Native.Array.values = {
691− empty:empty,
692− fromList:fromList,
693− toList:toList,
694− initialize:F2(initialize),
695− append:F2(append),
696− push:F2(push),
697− slice:F3(slice),
698− get:F2(get),
699− set:F3(set),
700− map:F2(map),
701− indexedMap:F2(indexedMap),
702− foldl:F3(foldl),
703− foldr:F3(foldr),
704− length:length,
705−
706− toJSArray:toJSArray,
707− fromJSArray:fromJSArray
708− };
709−
710− return elm.Native.Array.values = Elm.Native.Array.values;
711−}
libraries/Native/Basics.jsdeleted−111
@@ -1,111 +0,0 @@
1−
2−Elm.Native.Basics = {};
3−Elm.Native.Basics.make = function(elm) {
4− elm.Native = elm.Native || {};
5− elm.Native.Basics = elm.Native.Basics || {};
6− if (elm.Native.Basics.values) return elm.Native.Basics.values;
7−
8− var JS = Elm.Native.JavaScript.make(elm);
9− var Utils = Elm.Native.Utils.make(elm);
10−
11− function div(a, b) {
12− return (a/b)|0;
13− }
14− function rem(a, b) {
15− return a % b;
16− }
17− var mod = Utils.mod;
18− function logBase(base, n) {
19− return Math.log(n) / Math.log(base);
20− }
21− function negate(n) {
22− return -n;
23− }
24− function abs(n) {
25− return n < 0 ? -n : n;
26− }
27−
28− function min(a, b) {
29− return Utils.cmp(a,b) < 0 ? a : b;
30− }
31− function max(a, b) {
32− return Utils.cmp(a,b) > 0 ? a : b;
33− }
34− function clamp(lo, hi, n) {
35− return Utils.cmp(n,lo) < 0 ? lo : Utils.cmp(n,hi) > 0 ? hi : n;
36− }
37−
38− function xor(a, b) {
39− return a !== b;
40− }
41− function not(b) {
42− return !b;
43− }
44− function isInfinite(n) {
45− return n === Infinity || n === -Infinity
46− }
47−
48− function truncate(n) {
49− return n|0;
50− }
51−
52− function degrees(d) {
53− return d * Math.PI / 180;
54− }
55− function turns(t) {
56− return 2 * Math.PI * t;
57− }
58− function fromPolar(point) {
59− var r = point._0;
60− var t = point._1;
61− return Utils.Tuple2(r * Math.cos(t), r * Math.sin(t));
62− }
63− function toPolar(point) {
64− var x = point._0;
65− var y = point._1;
66− return Utils.Tuple2(Math.sqrt(x * x + y * y), Math.atan2(y,x));
67− }
68−
69− var basics = {
70− div: F2(div),
71− rem: F2(rem),
72− mod: mod,
73−
74− pi: Math.PI,
75− e: Math.E,
76− cos: Math.cos,
77− sin: Math.sin,
78− tan: Math.tan,
79− acos: Math.acos,
80− asin: Math.asin,
81− atan: Math.atan,
82− atan2: F2(Math.atan2),
83−
84− degrees: degrees,
85− turns: turns,
86− fromPolar: fromPolar,
87− toPolar: toPolar,
88−
89− sqrt: Math.sqrt,
90− logBase: F2(logBase),
91− negate: negate,
92− abs: abs,
93− min: F2(min),
94− max: F2(max),
95− clamp: F3(clamp),
96− compare: Utils.compare,
97−
98− xor: F2(xor),
99− not: not,
100−
101− truncate: truncate,
102− ceiling: Math.ceil,
103− floor: Math.floor,
104− round: Math.round,
105− toFloat: function(x) { return x; },
106− isNaN: isNaN,
107− isInfinite: isInfinite
108− };
109−
110− return elm.Native.Basics.values = basics;
111−};
libraries/Native/Bitwise.jsdeleted−25
@@ -1,25 +0,0 @@
1−Elm.Native.Bitwise = {};
2−Elm.Native.Bitwise.make = function(elm) {
3− elm.Native = elm.Native || {};
4− elm.Native.Bitwise = elm.Native.Bitwise || {};
5− if (elm.Native.Bitwise.values) return elm.Native.Bitwise.values;
6−
7− function and(a,b) { return a & b; }
8− function or (a,b) { return a | b; }
9− function xor(a,b) { return a ^ b; }
10− function not(a) { return ~a; }
11− function sll(a,offset) { return a << offset; }
12− function sra(a,offset) { return a >> offset; }
13− function srl(a,offset) { return a >>> offset; }
14−
15− return elm.Native.Bitwise.values = {
16− and: F2(and),
17− or : F2(or ),
18− xor: F2(xor),
19− complement: not,
20− shiftLeft : F2(sll),
21− shiftRightArithmatic: F2(sra),
22− shiftRightLogical : F2(srl)
23− };
24−
25−};
libraries/Native/Char.jsdeleted−31
@@ -1,31 +0,0 @@
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;
6−
7− var Utils = Elm.Native.Utils.make(elm);
8−
9− function isBetween(lo,hi) { return function(chr) {
10− var c = chr.charCodeAt(0);
11− return lo <= c && c <= hi;
12− };
13− }
14− var isDigit = isBetween('0'.charCodeAt(0),'9'.charCodeAt(0));
15− var chk1 = isBetween('a'.charCodeAt(0),'f'.charCodeAt(0));
16− var chk2 = isBetween('A'.charCodeAt(0),'F'.charCodeAt(0));
17−
18− return elm.Native.Char.values = {
19− fromCode : function(c) { return String.fromCharCode(c); },
20− toCode : function(c) { return c.toUpperCase().charCodeAt(0); },
21− toUpper : function(c) { return Utils.chr(c.toUpperCase()); },
22− toLower : function(c) { return Utils.chr(c.toLowerCase()); },
23− toLocaleUpper : function(c) { return Utils.chr(c.toLocaleUpperCase()); },
24− toLocaleLower : function(c) { return Utils.chr(c.toLocaleLowerCase()); },
25− isLower : isBetween('a'.charCodeAt(0),'z'.charCodeAt(0)),
26− isUpper : isBetween('A'.charCodeAt(0),'Z'.charCodeAt(0)),
27− isDigit : isDigit,
28− isOctDigit : isBetween('0'.charCodeAt(0),'7'.charCodeAt(0)),
29− isHexDigit : function(c) { return isDigit(c) || chk1(c) || chk2(c); }
30− };
31−};
libraries/Native/Color.jsdeleted−32
@@ -1,32 +0,0 @@
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;
6−
7− var Utils = Elm.Native.Utils.make(elm);
8−
9− function toCss(c) {
10− var format = '';
11− var colors = '';
12− if (c.ctor === 'RGBA') {
13− format = 'rgb';
14− colors = c._0 + ', ' + c._1 + ', ' + c._2;
15− } else {
16− format = 'hsl';
17− colors = (c._0 * 180 / Math.PI) + ', ' +
18− (c._1 * 100) + '%, ' +
19− (c._2 * 100) + '%';
20− }
21− if (c._3 === 1) {
22− return format + '(' + colors + ')';
23− } else {
24− return format + 'a(' + colors + ', ' + c._3 + ')';
25− }
26− }
27−
28− return elm.Native.Color.values = {
29− toCss:toCss
30− };
31−
32−};
libraries/Native/Date.jsdeleted−33
@@ -1,33 +0,0 @@
1−Elm.Native.Date = {};
2−Elm.Native.Date.make = function(elm) {
3− elm.Native = elm.Native || {};
4− elm.Native.Date = elm.Native.Date || {};
5− if (elm.Native.Date.values) return elm.Native.Date.values;
6−
7− var Maybe = Elm.Maybe.make(elm);
8−
9− function dateNow() { return new window.Date; }
10− function readDate(str) {
11− var d = new window.Date(str);
12− if (isNaN(d.getTime())) return Maybe.Nothing;
13− return Maybe.Just(d);
14− }
15−
16− var dayTable = ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"];
17− var monthTable = ["Jan", "Feb", "Mar", "Apr", "May", "Jun",
18− "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"];
19−
20− return elm.Native.Date.values = {
21− read : readDate,
22− year : function(d) { return d.getFullYear(); },
23− month : function(d) { return { ctor:monthTable[d.getMonth()] }; },
24− day : function(d) { return d.getDate(); },
25− hour : function(d) { return d.getHours(); },
26− minute : function(d) { return d.getMinutes(); },
27− second : function(d) { return d.getSeconds(); },
28− toTime : function(d) { return d.getTime(); },
29− fromTime: function(t) { return new window.Date(t); },
30− dayOfWeek : function(d) { return { ctor:dayTable[d.getDay()] }; }
31− };
32−
33−};
libraries/Native/Debug.jsdeleted−60
@@ -1,60 +0,0 @@
1−Elm.Native.Debug = {};
2−Elm.Native.Debug.make = function(elm) {
3− elm.Native = elm.Native || {};
4− elm.Native.Debug = elm.Native.Debug || {};
5− if (elm.Native.Debug.values) return elm.Native.Debug.values;
6− if ('values' in Elm.Native.Debug)
7− return elm.Native.Debug.values = Elm.Native.Debug.values;
8−
9− var show = Elm.Native.Show.make(elm).show;
10− var replace = Elm.Native.Utils.make(elm).replace;
11−
12− function log(tag, value) {
13− var msg = tag + ': ' + show(value);
14− var process = process || {};
15− if (process.stdout) {
16− process.stdout.write(msg);
17− } else {
18− console.log(msg);
19− }
20− return value;
21− }
22−
23− function tracePath(debugId, form) {
24− return replace([["debugTracePathId",debugId]], form);
25− }
26−
27− function WatchTracker() {
28− this.frames = [{}];
29− this.clear = function() {
30− this.watches = {};
31− };
32− this.pushFrame = function() {
33− var lastFrame = this.frames[this.frames.length - 1];
34− this.frames.push(lastFrame);
35− }
36− this.notify = function(tag, value) {
37− this.frames[this.frames.length - 1][tag] = value;
38− };
39− }
40− var watchTracker = new WatchTracker();
41−
42− function watch(tag, value) {
43− watchTracker.notify(tag, value);
44− return value;
45− }
46−
47− function watchSummary(tag, f, value) {
48− watchTracker.notify(tag, f(value));
49− return value;
50− }
51−
52− Elm.Native.Debug.values = {
53− tracePath: F2(tracePath),
54− log: F2(log),
55− watch: F2(watch),
56− watchSummary:F3(watchSummary),
57− watchTracker: watchTracker
58− };
59− return elm.Native.Debug.values = Elm.Native.Debug.values;
60−};
libraries/Native/Error.jsdeleted−30
@@ -1,30 +0,0 @@
1−Elm.Native.Error = {};
2−Elm.Native.Error.make = function(elm) {
3− elm.Native = elm.Native || {};
4− elm.Native.Error = elm.Native.Error || {};
5− if (elm.Native.Error.values) return elm.Native.Error.values;
6−
7− function indent(lines) {
8− var msg = '';
9− for (var i = 0; i < lines.length; ++i) {
10− msg += '<br/>&nbsp; &nbsp; ' + lines[i];
11− }
12− return msg;
13− }
14−
15− function Case(moduleName, span) {
16− var msg = indent(['Non-exhaustive pattern match in case-expression.',
17− 'Make sure your patterns cover every case!']);
18− throw new Error('Runtime error in module ' + moduleName + ' (' + span + '):' + msg);
19− }
20−
21− function If(moduleName, span) {
22− var msg = indent(['Non-exhaustive pattern match in multi-way-if expression.',
23− 'It is best to use \'otherwise\' as the last branch of multi-way-if.']);
24− throw new Error('Runtime error in module ' + moduleName + ' (' + span + '):' + msg);
25− }
26−
27− function raise(str) { throw new Error(str); }
28−
29− return elm.Native.Error.values = { Case: Case, If: If, raise: raise };
30−};
libraries/Native/Function.jsdeleted−101
@@ -1,101 +0,0 @@
1−
2−function F2(fun) {
3− function wrapper(a) { return function(b) { return fun(a,b) } }
4− wrapper.arity = 2;
5− wrapper.func = fun;
6− return wrapper;
7−}
8−
9−function F3(fun) {
10− function wrapper(a) {
11− return function(b) { return function(c) { return fun(a,b,c) }}
12− }
13− wrapper.arity = 3;
14− wrapper.func = fun;
15− return wrapper;
16−}
17−
18−function F4(fun) {
19− function wrapper(a) { return function(b) { return function(c) {
20− return function(d) { return fun(a,b,c,d) }}}
21− }
22− wrapper.arity = 4;
23− wrapper.func = fun;
24− return wrapper;
25−}
26−
27−function F5(fun) {
28− function wrapper(a) { return function(b) { return function(c) {
29− return function(d) { return function(e) { return fun(a,b,c,d,e) }}}}
30− }
31− wrapper.arity = 5;
32− wrapper.func = fun;
33− return wrapper;
34−}
35−
36−function F6(fun) {
37− function wrapper(a) { return function(b) { return function(c) {
38− return function(d) { return function(e) { return function(f) {
39− return fun(a,b,c,d,e,f) }}}}}
40− }
41− wrapper.arity = 6;
42− wrapper.func = fun;
43− return wrapper;
44−}
45−
46−function F7(fun) {
47− function wrapper(a) { return function(b) { return function(c) {
48− return function(d) { return function(e) { return function(f) {
49− return function(g) { return fun(a,b,c,d,e,f,g) }}}}}}
50− }
51− wrapper.arity = 7;
52− wrapper.func = fun;
53− return wrapper;
54−}
55−
56−function F8(fun) {
57− function wrapper(a) { return function(b) { return function(c) {
58− return function(d) { return function(e) { return function(f) {
59− return function(g) { return function(h) {return fun(a,b,c,d,e,f,g,h)}}}}}}}
60− }
61− wrapper.arity = 8;
62− wrapper.func = fun;
63− return wrapper;
64−}
65−
66−function F9(fun) {
67− function wrapper(a) { return function(b) { return function(c) {
68− return function(d) { return function(e) { return function(f) {
69− return function(g) { return function(h) { return function(i) {
70− return fun(a,b,c,d,e,f,g,h,i) }}}}}}}}
71− }
72− wrapper.arity = 9;
73− wrapper.func = fun;
74− return wrapper;
75−}
76−
77−function A2(fun,a,b) {
78− return fun.arity === 2 ? fun.func(a,b) : fun(a)(b);
79−}
80−function A3(fun,a,b,c) {
81− return fun.arity === 3 ? fun.func(a,b,c) : fun(a)(b)(c);
82−}
83−function A4(fun,a,b,c,d) {
84− return fun.arity === 4 ? fun.func(a,b,c,d) : fun(a)(b)(c)(d);
85−}
86−function A5(fun,a,b,c,d,e) {
87− return fun.arity === 5 ? fun.func(a,b,c,d,e) : fun(a)(b)(c)(d)(e);
88−}
89−function A6(fun,a,b,c,d,e,f) {
90− return fun.arity === 6 ? fun.func(a,b,c,d,e,f) : fun(a)(b)(c)(d)(e)(f);
91−}
92−function A7(fun,a,b,c,d,e,f,g) {
93− return fun.arity === 7 ? fun.func(a,b,c,d,e,f,g) : fun(a)(b)(c)(d)(e)(f)(g);
94−}
95−function A8(fun,a,b,c,d,e,f,g,h) {
96− return fun.arity === 8 ? fun.func(a,b,c,d,e,f,g,h) : fun(a)(b)(c)(d)(e)(f)(g)(h);
97−}
98−function A9(fun,a,b,c,d,e,f,g,h,i) {
99− return fun.arity === 9 ? fun.func(a,b,c,d,e,f,g,h,i)
100− : fun(a)(b)(c)(d)(e)(f)(g)(h)(i);
101−}
libraries/Native/Graphics/Collage.jsdeleted−23
@@ -1,23 +0,0 @@
1−Elm.Native.Graphics.Collage = {};
2−Elm.Native.Graphics.Collage.make = function(elm) {
3−
4− elm.Native = elm.Native || {};
5− elm.Native.Graphics = elm.Native.Graphics || {};
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.make(elm).newElement;
10− var C = ElmRuntime.use(ElmRuntime.Render.Collage);
11−
12− function collage(w,h,forms) {
13− return A3(newElement, w, h, {
14− ctor: 'Custom',
15− type: 'Collage',
16− render: C.render,
17− update: C.update,
18− model: {w:w, h:h, forms:forms}
19− });
20− }
21− return elm.Native.Graphics.Collage.values = { collage:F3(collage) };
22−
23−};
libraries/Native/Graphics/Input.jsdeleted−410
@@ -1,410 +0,0 @@
1−Elm.Native.Graphics.Input = {};
2−Elm.Native.Graphics.Input.make = function(elm) {
3− elm.Native = elm.Native || {};
4− elm.Native.Graphics = elm.Native.Graphics || {};
5− elm.Native.Graphics.Input = elm.Native.Graphics.Input || {};
6− if (elm.Native.Graphics.Input.values) return elm.Native.Graphics.Input.values;
7−
8− var Render = ElmRuntime.use(ElmRuntime.Render.Element);
9− var newNode = ElmRuntime.use(ElmRuntime.Render.Utils).newElement;
10−
11− var toCss = Elm.Native.Color.make(elm).toCss;
12− var Text = Elm.Native.Text.make(elm);
13− var Signal = Elm.Signal.make(elm);
14− var newElement = Elm.Graphics.Element.make(elm).newElement;
15− var List = Elm.Native.List.make(elm);
16− var Utils = Elm.Native.Utils.make(elm);
17− var Tuple2 = Utils.Tuple2;
18−
19− function input(initialValue) {
20− var signal = Signal.constant(initialValue);
21− return { _:{}, signal:signal, handle:signal };
22− }
23−
24− function renderDropDown(model) {
25− var drop = newNode('select');
26− drop.style.border = '0 solid';
27− drop.style.pointerEvents = 'auto';
28− drop.style.display = 'block';
29−
30− drop.elm_signal = model.signal;
31− drop.elm_values = List.toArray(model.values);
32− var values = drop.elm_values;
33−
34− for (var i = 0; i < values.length; ++i) {
35− var option = newNode('option');
36− var name = values[i]._0;
37− option.value = name;
38− option.innerHTML = name;
39− drop.appendChild(option);
40− }
41− drop.addEventListener('change', function() {
42− elm.notify(drop.elm_signal.id, drop.elm_values[drop.selectedIndex]._1);
43− });
44−
45− return drop;
46− }
47−
48− function updateDropDown(node, oldModel, newModel) {
49− node.elm_signal = newModel.signal;
50− node.elm_values = List.toArray(newModel.values);
51−
52− var values = node.elm_values;
53− var kids = node.childNodes;
54− var kidsLength = kids.length;
55−
56− var i = 0;
57− for (; i < kidsLength && i < values.length; ++i) {
58− var option = kids[i];
59− var name = values[i]._0;
60− option.value = name;
61− option.innerHTML = name;
62− }
63− for (; i < kidsLength; ++i) {
64− node.removeChild(node.lastChild);
65− }
66− for (; i < values.length; ++i) {
67− var option = newNode('option');
68− var name = values[i]._0;
69− option.value = name;
70− option.innerHTML = name;
71− node.appendChild(option);
72− }
73− }
74−
75− function dropDown(signal, values) {
76− return A3(newElement, 100, 24, {
77− ctor: 'Custom',
78− type: 'DropDown',
79− render: renderDropDown,
80− update: updateDropDown,
81− model: {
82− signal: signal,
83− values: values
84− }
85− });
86− }
87−
88− function renderButton(model) {
89− var node = newNode('button');
90− node.style.display = 'block';
91− node.style.pointerEvents = 'auto';
92− node.elm_signal = model.signal;
93− node.elm_value = model.value;
94− function click() {
95− elm.notify(node.elm_signal.id, node.elm_value);
96− }
97− node.addEventListener('click', click);
98− node.innerHTML = model.text;
99− return node;
100− }
101−
102− function updateButton(node, oldModel, newModel) {
103− node.elm_signal = newModel.signal;
104− node.elm_value = newModel.value;
105− var txt = newModel.text;
106− if (oldModel.text !== txt) node.innerHTML = txt;
107− }
108−
109− function button(signal, value, text) {
110− return A3(newElement, 100, 40, {
111− ctor: 'Custom',
112− type: 'Button',
113− render: renderButton,
114− update: updateButton,
115− model: { signal:signal, value:value, text:text }
116− });
117− }
118−
119− function renderCustomButton(model) {
120− var btn = newNode('div');
121− btn.style.pointerEvents = 'auto';
122− btn.elm_signal = model.signal;
123− btn.elm_value = model.value;
124−
125− btn.elm_up = Render.render(model.up);
126− btn.elm_hover = Render.render(model.hover);
127− btn.elm_down = Render.render(model.down);
128−
129− btn.elm_up.style.display = 'block';
130− btn.elm_hover.style.display = 'none';
131− btn.elm_down.style.display = 'none';
132−
133− btn.appendChild(btn.elm_up);
134− btn.appendChild(btn.elm_hover);
135− btn.appendChild(btn.elm_down);
136−
137− function swap(visibleNode, hiddenNode1, hiddenNode2) {
138− visibleNode.style.display = 'block';
139− hiddenNode1.style.display = 'none';
140− hiddenNode2.style.display = 'none';
141− }
142−
143− var overCount = 0;
144− function over(e) {
145− if (overCount++ > 0) return;
146− swap(btn.elm_hover, btn.elm_down, btn.elm_up);
147− }
148− function out(e) {
149− if (btn.contains(e.toElement || e.relatedTarget)) return;
150− overCount = 0;
151− swap(btn.elm_up, btn.elm_down, btn.elm_hover);
152− }
153− function up() {
154− swap(btn.elm_hover, btn.elm_down, btn.elm_up);
155− elm.notify(btn.elm_signal.id, btn.elm_value);
156− }
157− function down() {
158− swap(btn.elm_down, btn.elm_hover, btn.elm_up);
159− }
160−
161− btn.addEventListener('mouseover', over);
162− btn.addEventListener('mouseout' , out);
163− btn.addEventListener('mousedown', down);
164− btn.addEventListener('mouseup' , up);
165−
166− return btn;
167− }
168−
169− function updateCustomButton(node, oldModel, newModel) {
170− node.elm_signal = newModel.signal;
171− node.elm_value = newModel.value;
172−
173− var kids = node.childNodes;
174− var styleUp = kids[0].style.display;
175− var styleHover = kids[1].style.display;
176− var styleDown = kids[2].style.display;
177−
178− Render.update(kids[0], oldModel.up, newModel.up);
179− Render.update(kids[1], oldModel.hover, newModel.hover);
180− Render.update(kids[2], oldModel.down, newModel.down);
181−
182− var kids = node.childNodes;
183− kids[0].style.display = styleUp;
184− kids[1].style.display = styleHover;
185− kids[2].style.display = styleDown;
186− }
187−
188− function max3(a,b,c) {
189− var ab = a > b ? a : b;
190− return ab > c ? ab : c;
191− }
192−
193− function customButton(signal, value, up, hover, down) {
194− return A3(newElement,
195− max3(up.props.width, hover.props.width, down.props.width),
196− max3(up.props.height, hover.props.height, down.props.height),
197− { ctor: 'Custom',
198− type: 'CustomButton',
199− render: renderCustomButton,
200− update: updateCustomButton,
201− model: { signal:signal, value:value, up:up, hover:hover, down:down }
202− });
203− }
204−
205− function renderCheckbox(model) {
206− var node = newNode('input');
207− node.type = 'checkbox';
208− node.checked = model.checked;
209− node.style.display = 'block';
210− node.style.pointerEvents = 'auto';
211− node.elm_signal = model.signal;
212− node.elm_handler = model.handler;
213− function change() {
214− elm.notify(node.elm_signal.id, node.elm_handler(node.checked));
215− }
216− node.addEventListener('change', change);
217− return node;
218− }
219−
220− function updateCheckbox(node, oldModel, newModel) {
221− node.elm_signal = newModel.signal;
222− node.elm_handler = newModel.handler;
223− node.checked = newModel.checked;
224− return true;
225− }
226−
227− function checkbox(signal, handler, checked) {
228− return A3(newElement, 13, 13, {
229− ctor: 'Custom',
230− type: 'CheckBox',
231− render: renderCheckbox,
232− update: updateCheckbox,
233− model: { signal:signal, handler:handler, checked:checked }
234− });
235− }
236−
237− function setRange(node, start, end, dir) {
238− if (node.parentNode) {
239− node.setSelectionRange(start, end, dir);
240− } else {
241− setTimeout(function(){node.setSelectionRange(start, end, dir);}, 0);
242− }
243− }
244−
245− function updateIfNeeded(css, attribute, latestAttribute) {
246− if (css[attribute] !== latestAttribute) {
247− css[attribute] = latestAttribute;
248− }
249− }
250− function cssDimensions(dimensions) {
251− return dimensions.top + 'px ' +
252− dimensions.right + 'px ' +
253− dimensions.bottom + 'px ' +
254− dimensions.left + 'px';
255− }
256− function updateFieldStyle(css, style) {
257− updateIfNeeded(css, 'padding', cssDimensions(style.padding));
258−
259− var outline = style.outline;
260− updateIfNeeded(css, 'border-width', cssDimensions(outline.width));
261− updateIfNeeded(css, 'border-color', toCss(outline.color));
262− updateIfNeeded(css, 'border-radius', outline.radius + 'px');
263−
264− var highlight = style.highlight;
265− if (highlight.width === 0) {
266− css.outline = 'none';
267− } else {
268− updateIfNeeded(css, 'outline-width', highlight.width + 'px');
269− updateIfNeeded(css, 'outline-color', toCss(highlight.color));
270− }
271−
272− var textStyle = style.style;
273− updateIfNeeded(css, 'color', toCss(textStyle.color));
274− if (textStyle.typeface.ctor !== '[]') {
275− updateIfNeeded(css, 'font-family', Text.toTypefaces(textStyle.typeface));
276− }
277− if (textStyle.height.ctor !== "Nothing") {
278− updateIfNeeded(css, 'font-size', textStyle.height._0 + 'px');
279− }
280− updateIfNeeded(css, 'font-weight', textStyle.bold ? 'bold' : 'normal');
281− updateIfNeeded(css, 'font-style', textStyle.italic ? 'italic' : 'normal');
282− if (textStyle.line.ctor !== 'Nothing') {
283− updateIfNeeded(css, 'text-decoration', Text.toLine(textStyle.line._0));
284− }
285− }
286−
287− function renderField(model) {
288− var field = newNode('input');
289− updateFieldStyle(field.style, model.style);
290− field.style.borderStyle = 'solid';
291− field.style.pointerEvents = 'auto';
292−
293− field.type = model.type;
294− field.placeholder = model.placeHolder;
295− field.value = model.content.string;
296−
297− field.elm_signal = model.signal;
298− field.elm_handler = model.handler;
299− field.elm_old_value = field.value;
300−
301− function inputUpdate(event) {
302− var curr = field.elm_old_value;
303− var next = field.value;
304− if (curr === next) {
305− return;
306− }
307−
308− var direction = field.selectionDirection === 'forward' ? 'Forward' : 'Backward';
309− var start = field.selectionStart;
310− var end = field.selectionEnd;
311− field.value = field.elm_old_value;
312−
313− elm.notify(field.elm_signal.id, field.elm_handler({
314− _:{},
315− string: next,
316− selection: {
317− _:{},
318− start: start,
319− end: end,
320− direction: { ctor: direction }
321− }
322− }));
323− }
324−
325− field.addEventListener('input', inputUpdate);
326− field.addEventListener('focus', function() {
327− field.elm_hasFocus = true;
328− });
329− field.addEventListener('blur', function() {
330− field.elm_hasFocus = false;
331− });
332−
333− return field;
334− }
335−
336− function updateField(field, oldModel, newModel) {
337− if (oldModel.style !== newModel.style) {
338− updateFieldStyle(field.style, newModel.style);
339− }
340− field.elm_signal = newModel.signal;
341− field.elm_handler = newModel.handler;
342−
343− field.type = newModel.type;
344− field.placeholder = newModel.placeHolder;
345− var value = newModel.content.string;
346− field.value = value;
347− field.elm_old_value = value;
348− if (field.elm_hasFocus) {
349− var selection = newModel.content.selection;
350− var direction = selection.direction.ctor === 'Forward' ? 'forward' : 'backward';
351− setRange(field, selection.start, selection.end, direction);
352− }
353− }
354−
355− function mkField(type) {
356− function field(style, signal, handler, placeHolder, content) {
357− var padding = style.padding;
358− var outline = style.outline.width;
359− var adjustWidth = padding.left + padding.right + outline.left + outline.right;
360− var adjustHeight = padding.top + padding.bottom + outline.top + outline.bottom;
361− return A3(newElement, 200, 30, {
362− ctor: 'Custom',
363− type: type + 'Field',
364− adjustWidth: adjustWidth,
365− adjustHeight: adjustHeight,
366− render: renderField,
367− update: updateField,
368− model: {
369− signal:signal,
370− handler:handler,
371− placeHolder:placeHolder,
372− content:content,
373− style:style,
374− type:type
375− }
376− });
377− }
378− return F5(field);
379− }
380−
381− function hoverable(signal, handler, elem) {
382− function onHover(bool) {
383− elm.notify(signal.id, handler(bool));
384− }
385− var props = Utils.replace([['hover',onHover]], elem.props);
386− return { props:props, element:elem.element };
387− }
388−
389− function clickable(signal, value, elem) {
390− function onClick(bool) {
391− elm.notify(signal.id, value);
392− }
393− var props = Utils.replace([['click',onClick]], elem.props);
394− return { props:props, element:elem.element };
395− }
396−
397− return elm.Native.Graphics.Input.values = {
398− input:input,
399− button:F3(button),
400− customButton:F5(customButton),
401− checkbox:F3(checkbox),
402− dropDown:F2(dropDown),
403− field:mkField('text'),
404− email:mkField('email'),
405− password:mkField('password'),
406− hoverable:F3(hoverable),
407− clickable:F3(clickable)
408− };
409−
410−};
libraries/Native/JavaScript.jsdeleted−68
@@ -1,68 +0,0 @@
1−Elm.Native.JavaScript = {};
2−Elm.Native.JavaScript.make = function(elm) {
3− elm.Native = elm.Native || {};
4− elm.Native.JavaScript = elm.Native.JavaScript || {};
5− if (elm.Native.JavaScript.values) return elm.Native.JavaScript.values;
6−
7− var List = Elm.Native.List.make(elm);
8− var Render = ElmRuntime.use(ElmRuntime.Render.Element);
9−
10− function fromJS(v) {
11− var type = typeof v;
12− if (type === 'number' ) return v;
13− if (type === 'boolean') return v;
14− if (type === 'string' ) return v;
15− if (v instanceof Array) {
16− var arr = [];
17− var len = v.length;
18− for (var i = 0; i < len; ++i) {
19− var x = fromJS(v[i]);
20− if (x !== null) arr.push(x);
21− }
22− return List.fromArray(arr);
23− }
24− if (type === 'object') {
25− var rec = { _:{} };
26− for (var f in v) {
27− var x = fromJS(v[f]);
28− if (x !== null) rec[f] = x;
29− }
30− return rec;
31− }
32− return null;
33− }
34−
35− function toJS(v) {
36− var type = typeof v;
37− if (type === 'number' || type === 'boolean' || type === 'string') return v;
38− if (type === 'object' && '_' in v) {
39− var obj = {};
40− for (var k in v) {
41− var x = toJS(v[k]);
42− if (x !== null) obj[k] = x;
43− }
44− return obj;
45− }
46− if (type === 'object' && (v.ctor === '::' || v.ctor === '[]')) {
47− var array = List.toArray(v);
48− for (var i = array.length; i--; ) {
49− array[i] = toJS(array[i]);
50− }
51− return array;
52− }
53− return null;
54− }
55−
56− function fromRecord(r) {
57− if (typeof r === 'object' && '_' in r) {
58− return toJS(r);
59− }
60− throw new Error("'fromRecord' must be called on a record.");
61− }
62−
63− return elm.Native.JavaScript.values = {
64− toRecord : fromJS,
65− fromRecord : fromRecord
66− };
67−
68−};
libraries/Native/Json.jsdeleted−85
@@ -1,85 +0,0 @@
1−Elm.Native.Json = {};
2−Elm.Native.Json.make = function(elm) {
3−
4− elm.Native = elm.Native || {};
5− elm.Native.Json = elm.Native.Json || {};
6− if (elm.Native.Json.values) return elm.Native.Json.values;
7−
8− var Maybe = Elm.Maybe.make(elm);
9− var Dict = Elm.Dict.make(elm);
10− var List = Elm.Native.List.make(elm);
11− var Utils = Elm.Native.Utils.make(elm);
12−
13− function toJS(v) {
14− switch (v.ctor) {
15− case 'Null' : return null;
16− case 'String' : return v._0;
17− case 'Number' : return v._0;
18− case 'Boolean': return v._0;
19− case 'Object' :
20− var obj = {};
21− var array = List.toArray(Dict.toList(v._0));
22− for (var i = array.length; i--; ) {
23− var entry = array[i];
24− obj[entry._0] = toJS(entry._1);
25− }
26− return obj;
27− case 'Array' :
28− var array = List.toArray(v._0);
29− for (var i = array.length; i--; ) {
30− array[i] = toJS(array[i]);
31− }
32− return array;
33− }
34− }
35−
36− function toString(sep, value) {
37− return JSON.stringify(toJS(value), null, sep);
38− }
39−
40− function fromJS(v) {
41− switch (typeof v) {
42− case 'string' : return { ctor:"String" , _0: v };
43− case 'number' : return { ctor:"Number" , _0: v };
44− case 'boolean': return { ctor:"Boolean", _0: v };
45− case 'object' :
46− if (v === null) return { ctor:"Null" };
47− if (v instanceof Array) {
48− var array = new Array(v.length);
49− for (var i = v.length; i--; ) {
50− array[i] = fromJS(v[i]);
51− }
52− return {
53− ctor:"Array",
54− _0: List.fromArray(array)
55− };
56− }
57− var array = [];
58− for (var key in v) {
59− var value = fromJS(v[key]);
60− array.push(Utils.Tuple2(key, value));
61− }
62− var list = List.fromArray(array);
63− return {
64− ctor:"Object",
65− _0: Dict.fromList(list)
66− };
67− }
68− }
69−
70− function fromString(str) {
71− try {
72− return Maybe.Just(fromJS(JSON.parse(str)));
73− } catch (e) {
74− return Maybe.Nothing;
75− }
76− }
77−
78− return elm.Native.Json.values = {
79− toString : F2(toString),
80− fromString : fromString,
81− fromJS : fromJS,
82− toJS : toJS
83− };
84−
85−};
libraries/Native/List.jsdeleted−395
@@ -1,395 +0,0 @@
1−Elm.Native.List = {};
2−Elm.Native.List.make = function(elm) {
3− elm.Native = elm.Native || {};
4− elm.Native.List = elm.Native.List || {};
5− if (elm.Native.List.values) return elm.Native.List.values;
6− if ('values' in Elm.Native.List)
7− return elm.Native.List.values = Elm.Native.List.values;
8−
9− var Utils = Elm.Native.Utils.make(elm);
10−
11− // TODO: Improve Nil handling
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.
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).
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)
18− // (on firefox 19)
19−
20− var Nil = { ctor:'[]' };
21−
22− // using freeze for every cons would be nice but is a huge (9x on firefox 19)
23− // performance penalty
24− function Cons(hd,tl) { return { ctor:"::", _0:hd, _1:tl }; }
25−
26− function throwError(f) {
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− }
36− return out;
37− }
38−
39− function fromArray(arr) {
40− var out = Nil;
41− for (var i = arr.length; i--; ) {
42− out = Cons(arr[i], out);
43− }
44− return out;
45− }
46−
47− function range(lo,hi) {
48− var lst = Nil;
49− if (lo <= hi) {
50− do { lst = Cons(hi,lst) } while (hi-->lo);
51− }
52− return lst
53− }
54−
55− function append(xs,ys) {
56− // append Text
57− if (xs.text || ys.text) {
58− return Utils.txt(Utils.makeText(xs) + Utils.makeText(ys));
59− }
60−
61− // append Strings
62− if (typeof xs === "string") return xs + ys;
63−
64− // append Lists
65− if (xs.ctor === '[]') { return ys; }
66− var root = Cons(xs._0, Nil);
67− var curr = root;
68− xs = xs._1;
69− while (xs.ctor !== '[]') {
70− curr._1 = Cons(xs._0, Nil);
71− xs = xs._1;
72− curr = curr._1;
73− }
74− curr._1 = ys;
75− return root;
76− }
77−
78− function head(v) { return v.ctor === '[]' ? throwError('head') : v._0; }
79− function tail(v) { return v.ctor === '[]' ? throwError('tail') : v._1; }
80−
81− function last(xs) {
82− if (xs.ctor === '[]') { throwError('last'); }
83− var out = xs._0;
84− while (xs.ctor !== '[]') {
85− out = xs._0;
86− xs = xs._1;
87− }
88− return out;
89− }
90−
91− function map(f, xs) {
92− var arr = [];
93− while (xs.ctor !== '[]') {
94− arr.push(f(xs._0));
95− xs = xs._1;
96− }
97− return fromArray(arr);
98− }
99−
100− // f defined similarly for both foldl and foldr (NB: different from Haskell)
101− // ie, foldl : (a -> b -> b) -> b -> [a] -> b
102− function foldl(f, b, xs) {
103− var acc = b;
104− while (xs.ctor !== '[]') {
105− acc = A2(f, xs._0, acc);
106− xs = xs._1;
107− }
108− return acc;
109− }
110−
111− function foldr(f, b, xs) {
112− var arr = toArray(xs);
113− var acc = b;
114− for (var i = arr.length; i--; ) {
115− acc = A2(f, arr[i], acc);
116− }
117− return acc;
118− }
119−
120− function foldl1(f, xs) {
121− return xs.ctor === '[]' ? throwError('foldl1') : foldl(f, xs._0, xs._1);
122− }
123−
124− function foldr1(f, xs) {
125− if (xs.ctor === '[]') { throwError('foldr1'); }
126− var arr = toArray(xs);
127− var acc = arr.pop();
128− for (var i = arr.length; i--; ) {
129− acc = A2(f, arr[i], acc);
130− }
131− return acc;
132− }
133−
134− function scanl(f, b, xs) {
135− var arr = toArray(xs);
136− arr.unshift(b);
137− var len = arr.length;
138− for (var i = 1; i < len; ++i) {
139− arr[i] = A2(f, arr[i], arr[i-1]);
140− }
141− return fromArray(arr);
142− }
143−
144− function scanl1(f, xs) {
145− return xs.ctor === '[]' ? throwError('scanl1') : scanl(f, xs._0, xs._1);
146− }
147−
148− function filter(pred, xs) {
149− var arr = [];
150− while (xs.ctor !== '[]') {
151− if (pred(xs._0)) { arr.push(xs._0); }
152− xs = xs._1;
153− }
154− return fromArray(arr);
155− }
156−
157− function length(xs) {
158− var out = 0;
159− while (xs.ctor !== '[]') {
160− out += 1;
161− xs = xs._1;
162− }
163− return out;
164− }
165−
166− function member(x, xs) {
167− while (xs.ctor !== '[]') {
168− if (Utils.eq(x,xs._0)) return true;
169− xs = xs._1;
170− }
171− return false;
172− }
173−
174− function reverse(xs) { return fromArray(toArray(xs).reverse()); }
175−
176− function concat(xss) {
177− if (xss.ctor === '[]') return xss;
178− var arr = toArray(xss);
179− var xs = arr[arr.length-1];
180− for (var i = arr.length-1; i--; ) {
181− xs = append(arr[i], xs);
182− }
183− return xs;
184− }
185−
186− function all(pred, xs) {
187− while (xs.ctor !== '[]') {
188− if (!pred(xs._0)) return false;
189− xs = xs._1;
190− }
191− return true;
192− }
193−
194− function any(pred, xs) {
195− while (xs.ctor !== '[]') {
196− if (pred(xs._0)) return true;
197− xs = xs._1;
198− }
199− return false;
200− }
201−
202− function zip(xs, ys) {
203− var arr = [];
204− while (xs.ctor !== '[]' && ys.ctor !== '[]') {
205− arr.push(Utils.Tuple2(xs._0, ys._0));
206− xs = xs._1;
207− ys = ys._1;
208− }
209− return fromArray(arr);
210− }
211−
212− function zipWith(f, xs, ys) {
213− var arr = [];
214− while (xs.ctor !== '[]' && ys.ctor !== '[]') {
215− arr.push(A2(f, xs._0, ys._0));
216− xs = xs._1;
217− ys = ys._1;
218− }
219− return fromArray(arr);
220− }
221−
222− function zipWith3(f, xs, ys, zs) {
223− var arr = [];
224− while (xs.ctor !== '[]' && ys.ctor !== '[]' && zs.ctor !== '[]') {
225− arr.push(A3(f, xs._0, ys._0, zs._0));
226− xs = xs._1;
227− ys = ys._1;
228− zs = zs._1;
229− }
230− return fromArray(arr);
231− }
232−
233− function zipWith4(f, ws, xs, ys, zs) {
234− var arr = [];
235− while ( ws.ctor !== '[]'
236− && xs.ctor !== '[]'
237− && ys.ctor !== '[]'
238− && zs.ctor !== '[]')
239− {
240− arr.push(A4(f, ws._0, xs._0, ys._0, zs._0));
241− ws = ws._1;
242− xs = xs._1;
243− ys = ys._1;
244− zs = zs._1;
245− }
246− return fromArray(arr);
247− }
248−
249− function zipWith5(f, vs, ws, xs, ys, zs) {
250− var arr = [];
251− while ( vs.ctor !== '[]'
252− && ws.ctor !== '[]'
253− && xs.ctor !== '[]'
254− && ys.ctor !== '[]'
255− && zs.ctor !== '[]')
256− {
257− arr.push(A5(f, vs._0, ws._0, xs._0, ys._0, zs._0));
258− vs = vs._1;
259− ws = ws._1;
260− xs = xs._1;
261− ys = ys._1;
262− zs = zs._1;
263− }
264− return fromArray(arr);
265− }
266−
267− function sort(xs) {
268− return fromArray(toArray(xs).sort(Utils.cmp));
269− }
270−
271− function sortBy(f, xs) {
272− return fromArray(toArray(xs).sort(function(a,b){
273− return Utils.cmp(f(a), f(b));
274− }));
275− }
276−
277− function sortWith(f, xs) {
278− return fromArray(toArray(xs).sort(function(a,b){
279− var ord = f(a)(b).ctor;
280− return ord === 'EQ' ? 0 : ord === 'LT' ? -1 : 1;
281− }));
282− }
283−
284− function nth(xs, n) {
285− return toArray(xs)[n];
286− }
287−
288− function take(n, xs) {
289− var arr = [];
290− while (xs.ctor !== '[]' && n > 0) {
291− arr.push(xs._0);
292− xs = xs._1;
293− --n;
294− }
295− return fromArray(arr);
296− }
297−
298− function drop(n, xs) {
299− while (xs.ctor !== '[]' && n > 0) {
300− xs = xs._1;
301− --n;
302− }
303− return xs;
304− }
305−
306− function repeat(n, x) {
307− var arr = [];
308− var pattern = [x];
309− while (n > 0) {
310− if (n & 1) arr = arr.concat(pattern);
311− n >>= 1, pattern = pattern.concat(pattern);
312− }
313− return fromArray(arr);
314− }
315−
316− function join(sep, xss) {
317− if (sep.text) {
318− sep = Utils.makeText(sep);
319− xss = toArray(xss);
320− for (var i = xss.length; i--; ) {
321− xss[i] = Utils.makeText(xss[i]);
322− }
323− return Utils.txt(xss.join(sep));
324− }
325− if (typeof sep === 'string') return toArray(xss).join(sep);
326− if (xss.ctor === '[]') return Nil;
327− var s = toArray(sep);
328− var out = toArray(xss._0);
329− xss = xss._1;
330− while (xss.ctor !== '[]') {
331− out = out.concat(s, toArray(xss._0));
332− xss = xss._1;
333− }
334− return fromArray(out);
335− }
336−
337− /*
338− * Only to be used internally; do some side effects for each elem
339− */
340− function each(action, xs) {
341− while(xs.ctor !== '[]') {
342− action(xs._0);
343− xs = xs._1;
344− }
345− }
346−
347− Elm.Native.List.values = {
348− Nil:Nil,
349− Cons:Cons,
350− cons:F2(Cons),
351− toArray:toArray,
352− fromArray:fromArray,
353− range:range,
354− append:append,
355−
356− head:head,
357− tail:tail,
358− last:last,
359−
360− map:F2(map),
361− foldl:F3(foldl),
362− foldr:F3(foldr),
363−
364− foldl1:F2(foldl1),
365− foldr1:F2(foldr1),
366− scanl:F3(scanl),
367− scanl1:F2(scanl1),
368− filter:F2(filter),
369− length:length,
370− member:F2(member),
371− reverse:reverse,
372− concat:concat,
373−
374− all:F2(all),
375− any:F2(any),
376− zipWith :F3(zipWith ),
377− zipWith3:F4(zipWith3),
378− zipWith4:F5(zipWith4),
379− zipWith5:F6(zipWith5),
380− zip:F2(zip),
381− sort:sort,
382− sortBy:F2(sortBy),
383− sortWith:F2(sortWith),
384− nth:F2(nth),
385− take:F2(take),
386− drop:F2(drop),
387− repeat:F2(repeat),
388−
389− join:F2(join),
390−
391− each:each
392− };
393− return elm.Native.List.values = Elm.Native.List.values;
394−
395−};
libraries/Native/Ports.jsdeleted−83
@@ -1,83 +0,0 @@
1−Elm.Native.Ports = {};
2−Elm.Native.Ports.make = function(elm) {
3− elm.Native = elm.Native || {};
4− elm.Native.Ports = elm.Native.Ports || {};
5− if (elm.Native.Ports.values) return elm.Native.Ports.values;
6−
7− var Signal = Elm.Signal.make(elm);
8−
9− function incomingSignal(converter) {
10− converter.isSignal = true;
11− return converter;
12− }
13−
14− function outgoingSignal(converter) {
15− return function(signal) {
16− var subscribers = []
17− function subscribe(handler) {
18− subscribers.push(handler);
19− }
20− function unsubscribe(handler) {
21− subscribers.pop(subscribers.indexOf(handler));
22− }
23− A2( Signal.lift, function(value) {
24− var val = converter(value);
25− var len = subscribers.length;
26− for (var i = 0; i < len; ++i) {
27− subscribers[i](val);
28− }
29− }, signal);
30− return { subscribe:subscribe, unsubscribe:unsubscribe };
31− }
32− }
33−
34− function portIn(name, converter) {
35− var jsValue = elm.ports.incoming[name];
36− if (jsValue === undefined) {
37− throw new Error("Initialization Error: port '" + name +
38− "' was not given an input!");
39− }
40− elm.ports.uses[name] += 1;
41− try {
42− var elmValue = converter(jsValue);
43− } catch(e) {
44− throw new Error("Initialization Error on port '" + name + "': \n" + e.message);
45− }
46−
47− // just return a static value if it is not a signal
48− if (!converter.isSignal) {
49− return elmValue;
50− }
51−
52− // create a signal if necessary
53− var signal = Signal.constant(elmValue);
54− function send(jsValue) {
55− try {
56− var elmValue = converter(jsValue);
57− } catch(e) {
58− throw new Error("Error sending to port '" + name + "': \n" + e.message);
59− }
60− setTimeout(function() {
61− elm.notify(signal.id, elmValue);
62− }, 0);
63− }
64− elm.ports.outgoing[name] = { send:send };
65− return signal;
66− }
67−
68− function portOut(name, converter, value) {
69− try {
70− elm.ports.outgoing[name] = converter(value);
71− } catch(e) {
72− throw new Error("Initialization Error on port '" + name + "': \n" + e.message);
73− }
74− return value;
75− }
76−
77− return elm.Native.Ports.values = {
78− incomingSignal: incomingSignal,
79− outgoingSignal: outgoingSignal,
80− portOut: portOut,
81− portIn: portIn
82− };
83−};
libraries/Native/Regex.jsdeleted−103
@@ -1,103 +0,0 @@
1−Elm.Native.Regex = {};
2−Elm.Native.Regex.make = function(elm) {
3− elm.Native = elm.Native || {};
4− elm.Native.Regex = elm.Native.Regex || {};
5− if (elm.Native.Regex.values) return elm.Native.Regex.values;
6− if ('values' in Elm.Native.Regex)
7− return elm.Native.Regex.values = Elm.Native.Regex.values;
8−
9− var List = Elm.Native.List.make(elm);
10− var Maybe = Elm.Maybe.make(elm);
11−
12− function escape(str) {
13− return str.replace(/[-\/\\^$*+?.()|[\]{}]/g, '\\$&');
14− }
15− function caseInsensitive(re) {
16− return new RegExp(re.source, 'gi');
17− }
18− function regex(raw) {
19− return new RegExp(raw, 'g');
20− }
21−
22− function contains(re, string) {
23− return string.match(re) !== null;
24− }
25−
26− function find(n, re, str) {
27− n = n.ctor === "All" ? Infinity : n._0;
28− var out = [];
29− var number = 0;
30− var string = str;
31− var result;
32− while (number++ < n && (result = re.exec(string))) {
33− var i = result.length - 1;
34− var subs = new Array(i);
35− while (i > 0) {
36− var submatch = result[i];
37− subs[--i] = submatch === undefined
38− ? Maybe.Nothing
39− : Maybe.Just(submatch);
40− }
41− out.push({
42− _:{},
43− match: result[0],
44− submatches: List.fromArray(subs),
45− index: result.index,
46− number: number
47− });
48− }
49− return List.fromArray(out);
50− }
51−
52− function replace(n, re, replacer, string) {
53− n = n.ctor === "All" ? Infinity : n._0;
54− var count = 0;
55− function jsReplacer(match) {
56− if (count++ > n) return match;
57− var i = arguments.length-3;
58− var submatches = new Array(i);
59− while (i > 0) {
60− var submatch = arguments[i];
61− submatches[--i] = submatch === undefined
62− ? Maybe.Nothing
63− : Maybe.Just(submatch);
64− }
65− return replacer({
66− _:{},
67− match:match,
68− submatches:List.fromArray(submatches),
69− index:arguments[i-1],
70− number:count
71− });
72− }
73− return string.replace(re, jsReplacer);
74− }
75−
76− function split(n, re, str) {
77− if (n === Infinity) {
78− return List.fromArray(string.split(re));
79− }
80− var string = str;
81− var result;
82− var out = [];
83− var start = re.lastIndex;
84− while (n--) {
85− if (!(result = re.exec(string))) break;
86− out.push(string.slice(start, result.index));
87− start = re.lastIndex;
88− }
89− out.push(string.slice(start));
90− return List.fromArray(out);
91− }
92−
93− return Elm.Native.Regex.values = {
94− regex: regex,
95− caseInsensitive: caseInsensitive,
96− escape: escape,
97−
98− contains: F2(contains),
99− find: F3(find),
100− replace: F4(replace),
101− split: F3(split)
102− };
103−};
libraries/Native/Show.jsdeleted−132
@@ -1,132 +0,0 @@
1−Elm.Native.Show = {};
2−Elm.Native.Show.make = function(elm) {
3− elm.Native = elm.Native || {};
4− elm.Native.Show = elm.Native.Show || {};
5− if (elm.Native.Show.values) return elm.Native.Show.values;
6−
7− var NList = Elm.Native.List.make(elm);
8− var Array = Elm.Array.make(elm);
9− var List = Elm.List.make(elm);
10− var Dict = Elm.Dict.make(elm);
11− var Tuple2 = Elm.Native.Utils.make(elm).Tuple2;
12−
13− var toString = function(v) {
14− var type = typeof v;
15− if (type === "function") {
16− var name = v.func ? v.func.name : v.name;
17− return '<function' + (name === '' ? '' : ': ') + name + '>';
18− }
19− else if (type === "boolean") {
20− return v ? "True" : "False";
21− }
22− else if (type === "number") {
23− return v + "";
24− }
25− else if ((v instanceof String) && v.isChar) {
26− return "'" + addSlashes(v) + "'";
27− }
28− else if (type === "string") {
29− return '"' + addSlashes(v) + '"';
30− }
31− else if (type === "object" && '_' in v && probablyPublic(v)) {
32− var output = [];
33− for (var k in v._) {
34− for (var i = v._[k].length; i--; ) {
35− output.push(k + " = " + toString(v._[k][i]));
36− }
37− }
38− for (var k in v) {
39− if (k === '_') continue;
40− output.push(k + " = " + toString(v[k]));
41− }
42− if (output.length === 0) {
43− return "{}";
44− }
45− return "{ " + output.join(", ") + " }";
46− }
47− else if (type === "object" && 'ctor' in v) {
48− if (v.ctor.substring(0,6) === "_Tuple") {
49− var output = [];
50− for (var k in v) {
51− if (k === 'ctor') continue;
52− output.push(toString(v[k]));
53− }
54− return "(" + output.join(",") + ")";
55− }
56− else if (v.ctor === "_Array") {
57− var list = Array.toList(v);
58− return "Array.fromList " + toString(list);
59− }
60− else if (v.ctor === "::") {
61− var output = '[' + toString(v._0);
62− v = v._1;
63− while (v.ctor === "::") {
64− output += "," + toString(v._0);
65− v = v._1;
66− }
67− return output + ']';
68− }
69− else if (v.ctor === "[]") {
70− return "[]";
71− }
72− else if (v.ctor === "RBNode" || v.ctor === "RBEmpty") {
73− var cons = F3(function(k,v,acc){return NList.Cons(Tuple2(k,v),acc)});
74− var list = A3(Dict.foldr, cons, NList.Nil, v);
75− var name = "Dict";
76− if (list.ctor === "::" && list._0._1.ctor === "_Tuple0") {
77− name = "Set";
78− list = A2(List.map, function(x){return x._0}, list);
79− }
80− return name + ".fromList " + toString(list);
81− }
82− else {
83− var output = "";
84− for (var i in v) {
85− if (i === 'ctor') continue;
86− var str = toString(v[i]);
87− var parenless = str[0] === '{' || str[0] === '<' || str.indexOf(' ') < 0;
88− output += ' ' + (parenless ? str : '(' + str + ')');
89− }
90− return v.ctor + output;
91− }
92− }
93− if (type === 'object' && 'recv' in v) {
94− return '<signal>';
95− }
96− return "<internal structure>";
97− };
98−
99− function addSlashes(str) {
100− return str.replace(/\\/g, '\\\\')
101− .replace(/\n/g, '\\n')
102− .replace(/\t/g, '\\t')
103− .replace(/\r/g, '\\r')
104− .replace(/\v/g, '\\v')
105− .replace(/\0/g, '\\0')
106− .replace(/\'/g, "\\'")
107− .replace(/\"/g, '\\"');
108− }
109−
110− function probablyPublic(v) {
111− var keys = Object.keys(v);
112− var len = keys.length;
113− if (len === 3
114− && 'props' in v
115− && 'element' in v) return false;
116− if (len === 5
117− && 'horizontal' in v
118− && 'vertical' in v
119− && 'x' in v
120− && 'y' in v) return false;
121− if (len === 7
122− && 'theta' in v
123− && 'scale' in v
124− && 'x' in v
125− && 'y' in v
126− && 'alpha' in v
127− && 'form' in v) return false;
128− return true;
129− }
130−
131− return elm.Native.Show.values = { show:toString };
132−};
libraries/Native/Signal/Http.jsdeleted−63
@@ -1,63 +0,0 @@
1−Elm.Native.Http = {};
2−Elm.Native.Http.make = function(elm) {
3−
4− elm.Native = elm.Native || {};
5− elm.Native.Http = elm.Native.Http || {};
6− if (elm.Native.Http.values) return elm.Native.Http.values;
7−
8− var List = Elm.List.make(elm);
9− var Signal = Elm.Signal.make(elm);
10−
11− function registerReq(queue,responses) {
12− return function(req) {
13− if (req.url.length > 0) {
14− sendReq(queue,responses,req);
15− }
16− };
17− }
18−
19− function updateQueue(queue,responses) {
20− if (queue.length > 0) {
21− elm.notify(responses.id, queue[0].value);
22− if (queue[0].value.ctor !== 'Waiting') {
23− queue.shift();
24− setTimeout(function() { updateQueue(queue,responses); }, 0);
25− }
26− }
27− }
28−
29− function sendReq(queue,responses,req) {
30− var response = { value: { ctor:'Waiting' } };
31− queue.push(response);
32−
33− var request = (window.ActiveXObject
34− ? new ActiveXObject("Microsoft.XMLHTTP")
35− : new XMLHttpRequest());
36−
37− request.onreadystatechange = function(e) {
38− if (request.readyState === 4) {
39− response.value = (request.status >= 200 && request.status < 300 ?
40− { ctor:'Success', _0:request.responseText } :
41− { ctor:'Failure', _0:request.status, _1:request.statusText });
42− setTimeout(function() { updateQueue(queue,responses); }, 0);
43− }
44− };
45− request.open(req.verb, req.url, true);
46− function setHeader(pair) {
47− request.setRequestHeader( pair._0, pair._1 );
48− }
49− A2( List.map, setHeader, req.headers );
50− request.send(req.body);
51− }
52−
53− function send(requests) {
54− var responses = Signal.constant(elm.Http.values.Waiting);
55− var sender = A2( Signal.lift, registerReq([],responses), requests );
56− function f(x) { return function(y) { return x; } }
57− return A3( Signal.lift2, f, responses, sender );
58− }
59−
60− return elm.Native.Http.values = {
61− send:send
62− };
63−};
libraries/Native/Signal/Keyboard.jsdeleted−154
@@ -1,154 +0,0 @@
1−Elm.Native.Keyboard = {};
2−Elm.Native.Keyboard.make = function(elm) {
3−
4− elm.Native = elm.Native || {};
5− elm.Native.Keyboard = elm.Native.Keyboard || {};
6− if (elm.Native.Keyboard.values) return elm.Native.Keyboard.values;
7−
8− // Duplicated from Native.Signal
9− function send(node, timestep, changed) {
10− var kids = node.kids;
11− for (var i = kids.length; i--; ) {
12− kids[i].recv(timestep, changed, node.id);
13− }
14− }
15−
16− var Signal = Elm.Signal.make(elm);
17− var NList = Elm.Native.List.make(elm);
18− var Utils = Elm.Native.Utils.make(elm);
19−
20− var downEvents = Signal.constant(null);
21− var upEvents = Signal.constant(null);
22− var blurEvents = Signal.constant(null);
23−
24− elm.addListener([downEvents.id], document, 'keydown', function down(e) {
25− elm.notify(downEvents.id, e);
26− });
27−
28− elm.addListener([upEvents.id], document, 'keyup', function up(e) {
29− elm.notify(upEvents.id, e);
30− });
31−
32− elm.addListener([blurEvents.id], window, 'blur', function blur(e) {
33− elm.notify(blurEvents.id, null);
34− });
35−
36− function state(alt, meta, keyCodes) {
37− return {
38− alt: alt,
39− meta: meta,
40− keyCodes: keyCodes
41− };
42− }
43− var emptyState = state(false, false, NList.Nil);
44−
45− function KeyMerge(down, up, blur) {
46− var args = [down,up,blur];
47− this.id = Utils.guid();
48− // Ignore starting values here
49− this.value = emptyState;
50− this.kids = [];
51−
52− var n = args.length;
53− var count = 0;
54− var isChanged = false;
55−
56− this.recv = function(timestep, changed, parentID) {
57− ++count;
58− if (changed) {
59− // We know this a change must only be one of the following cases
60− if (parentID === down.id && !A2(NList.member, down.value.keyCode, this.value.keyCodes)) {
61− isChanged = true;
62− var v = down.value;
63− var newCodes = NList.Cons(v.keyCode, this.value.keyCodes);
64− this.value = state(v.altKey, v.metaKey, newCodes);
65− }
66− else if (parentID === up.id) {
67− isChanged = true;
68− var v = up.value;
69− var notEq = function(kc) { return kc !== v.keyCode };
70− var newCodes = A2(NList.filter, notEq, this.value.keyCodes);
71− this.value = state(v.altKey, v.metaKey, newCodes);
72− }
73− else if (parentID === blur.id) {
74− isChanged = true;
75− this.value = emptyState;
76− }
77− }
78− if (count == n) {
79− send(this, timestep, isChanged);
80− isChanged = false;
81− count = 0;
82− }
83− };
84−
85− for (var i = n; i--; ) {
86− args[i].kids.push(this);
87− args[i].defaultNumberOfKids += 1;
88− }
89− }
90−
91− var keyMerge = new KeyMerge(downEvents,upEvents,blurEvents);
92−
93− // select a part of a keyMerge and dropRepeats the result
94− function keySignal(f) {
95− var signal = A2(Signal.lift, f, keyMerge);
96− // must set the default number of kids to make it possible to filter
97− // these signals if they are not actually used.
98− keyMerge.defaultNumberOfKids += 1;
99− signal.defaultNumberOfKids = 1;
100− var filtered = Signal.dropRepeats(signal);
101− filtered.defaultNumberOfKids = 0;
102− return filtered;
103− }
104−
105− // break keyMerge into parts
106− var keysDown = keySignal(function getKeyCodes(v) {
107− return v.keyCodes;
108− });
109− var alt = keySignal(function getKeyCodes(v) {
110− return v.alt;
111− });
112− var meta = keySignal(function getKeyCodes(v) {
113− return v.meta;
114− });
115−
116− function dir(up, down, left, right) {
117− function toDirections(state) {
118− var keyCodes = state.keyCodes;
119− var x = 0, y = 0;
120− while (keyCodes.ctor === "::") {
121− switch (keyCodes._0) {
122− case left : --x; break;
123− case right: ++x; break;
124− case up : ++y; break;
125− case down : --y; break;
126− }
127− keyCodes = keyCodes._1;
128− }
129− return { _:{}, x:x, y:y };
130− }
131− return keySignal(toDirections);
132− }
133−
134− function is(key) {
135− return keySignal(function(v) {
136− return A2( NList.member, key, v.keyCodes );
137− });
138− }
139−
140− var lastPressed = A2(Signal.lift, function(e) {
141− return e ? e.keyCode : 0;
142− }, downEvents);
143− downEvents.defaultNumberOfKids += 1;
144−
145− return elm.Native.Keyboard.values = {
146− isDown:is,
147− alt: alt,
148− meta: meta,
149− directions:F4(dir),
150− keysDown:keysDown,
151− lastPressed:lastPressed
152− };
153−
154−};
libraries/Native/Signal/Mouse.jsdeleted−47
@@ -1,47 +0,0 @@
1−Elm.Native.Mouse = {};
2−Elm.Native.Mouse.make = function(elm) {
3−
4− elm.Native = elm.Native || {};
5− elm.Native.Mouse = elm.Native.Mouse || {};
6− if (elm.Native.Mouse.values) return elm.Native.Mouse.values;
7−
8− var Signal = Elm.Signal.make(elm);
9− var Utils = Elm.Native.Utils.make(elm);
10−
11− var position = Signal.constant(Utils.Tuple2(0,0));
12− position.defaultNumberOfKids = 2;
13−
14− // do not move x and y into Elm. By setting their default number
15− // of kids, it is possible to detatch the mouse listeners if
16− // they are not needed.
17− var x = A2( Signal.lift, function(p){return p._0}, position);
18− x.defaultNumberOfKids = 0;
19− var y = A2( Signal.lift, function(p){return p._1}, position);
20− y.defaultNumberOfKids = 0;
21−
22− var isDown = Signal.constant(false);
23− var clicks = Signal.constant(Utils.Tuple0);
24−
25− var node = elm.display === ElmRuntime.Display.FULLSCREEN ? document : elm.node;
26−
27− elm.addListener([clicks.id], node, 'click', function click() {
28− elm.notify(clicks.id, Utils.Tuple0);
29− });
30− elm.addListener([isDown.id], node, 'mousedown', function down() {
31− elm.notify(isDown.id, true);
32− });
33− elm.addListener([isDown.id], node, 'mouseup', function up() {
34− elm.notify(isDown.id, false);
35− });
36− elm.addListener([position.id], node, 'mousemove', function move(e) {
37− elm.notify(position.id, Utils.getXY(e));
38− });
39−
40− return elm.Native.Mouse.values = {
41− position: position,
42− x:x,
43− y:y,
44− isDown: isDown,
45− clicks: clicks
46− };
47−};
libraries/Native/Signal/Random.jsdeleted−39
@@ -1,39 +0,0 @@
1−Elm.Native.Random = {};
2−Elm.Native.Random.make = function(elm) {
3−
4− elm.Native = elm.Native || {};
5− elm.Native.Random = elm.Native.Random || {};
6− if (elm.Native.Random.values) return elm.Native.Random.values;
7−
8− var Signal = Elm.Signal.make(elm);
9− var List = Elm.Native.List.make(elm);
10−
11− function range(min, max, signal) {
12− function f(x) { return Math.floor(Math.random() * (max-min+1)) + min; }
13− return A2( Signal.lift, f, signal );
14− }
15−
16− function float_(signal) {
17− function f(x) { return Math.random(); }
18− return A2( Signal.lift, f, signal );
19− }
20−
21− function floatList(signal) {
22− function f(n) {
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− };
38−
39−};
libraries/Native/Signal/Signal.jsdeleted−227
@@ -1,227 +0,0 @@
1−
2−Elm.Native.Signal = {};
3−Elm.Native.Signal.make = function(elm) {
4−
5− elm.Native = elm.Native || {};
6− elm.Native.Signal = elm.Native.Signal || {};
7− if (elm.Native.Signal.values) return elm.Native.Signal.values;
8−
9− var Utils = Elm.Native.Utils.make(elm);
10− var foldr1 = Elm.List.make(elm).foldr1;
11−
12− function send(node, timestep, changed) {
13− var kids = node.kids;
14− for (var i = kids.length; i--; ) {
15− kids[i].recv(timestep, changed, node.id);
16− }
17− }
18−
19− function Input(base) {
20− this.id = Utils.guid();
21− this.value = base;
22− this.kids = [];
23− this.defaultNumberOfKids = 0;
24− this.recv = function(timestep, eid, v) {
25− var changed = eid === this.id;
26− if (changed) { this.value = v; }
27− send(this, timestep, changed);
28− return changed;
29− };
30− elm.inputs.push(this);
31− }
32−
33− function LiftN(update, args) {
34− this.id = Utils.guid();
35− this.value = update();
36− this.kids = [];
37−
38− var n = args.length;
39− var count = 0;
40− var isChanged = false;
41−
42− this.recv = function(timestep, changed, parentID) {
43− ++count;
44− if (changed) { isChanged = true; }
45− if (count == n) {
46− if (isChanged) { this.value = update(); }
47− send(this, timestep, isChanged);
48− isChanged = false;
49− count = 0;
50− }
51− };
52− for (var i = n; i--; ) { args[i].kids.push(this); }
53− }
54−
55− function lift(func, a) {
56− function update() { return func(a.value); }
57− return new LiftN(update, [a]);
58− }
59− function lift2(func, a, b) {
60− function update() { return A2( func, a.value, b.value ); }
61− return new LiftN(update, [a,b]);
62− }
63− function lift3(func, a, b, c) {
64− function update() { return A3( func, a.value, b.value, c.value ); }
65− return new LiftN(update, [a,b,c]);
66− }
67− function lift4(func, a, b, c, d) {
68− function update() { return A4( func, a.value, b.value, c.value, d.value ); }
69− return new LiftN(update, [a,b,c,d]);
70− }
71− function lift5(func, a, b, c, d, e) {
72− function update() { return A5( func, a.value, b.value, c.value, d.value, e.value ); }
73− return new LiftN(update, [a,b,c,d,e]);
74− }
75− function lift6(func, a, b, c, d, e, f) {
76− function update() { return A6( func, a.value, b.value, c.value, d.value, e.value, f.value ); }
77− return new LiftN(update, [a,b,c,d,e,f]);
78− }
79− function lift7(func, a, b, c, d, e, f, g) {
80− function update() { return A7( func, a.value, b.value, c.value, d.value, e.value, f.value, g.value ); }
81− return new LiftN(update, [a,b,c,d,e,f,g]);
82− }
83− function lift8(func, a, b, c, d, e, f, g, h) {
84− function update() { return A8( func, a.value, b.value, c.value, d.value, e.value, f.value, g.value, h.value ); }
85− return new LiftN(update, [a,b,c,d,e,f,g,h]);
86− }
87−
88− function Foldp(step, state, input) {
89− this.id = Utils.guid();
90− this.value = state;
91− this.kids = [];
92−
93− this.recv = function(timestep, changed, parentID) {
94− if (changed) {
95− this.value = A2( step, input.value, this.value );
96− }
97− send(this, timestep, changed);
98− };
99− input.kids.push(this);
100− }
101−
102− function foldp(step, state, input) {
103− return new Foldp(step, state, input);
104− }
105−
106− function DropIf(pred,base,input) {
107− this.id = Utils.guid();
108− this.value = pred(input.value) ? base : input.value;
109− this.kids = [];
110− this.recv = function(timestep, changed, parentID) {
111− var chng = changed && !pred(input.value);
112− if (chng) { this.value = input.value; }
113− send(this, timestep, chng);
114− };
115− input.kids.push(this);
116− }
117−
118− function DropRepeats(input) {
119− this.id = Utils.guid();
120− this.value = input.value;
121− this.kids = [];
122− this.recv = function(timestep, changed, parentID) {
123− var chng = changed && !Utils.eq(this.value,input.value);
124− if (chng) { this.value = input.value; }
125− send(this, timestep, chng);
126− };
127− input.kids.push(this);
128− }
129−
130− function timestamp(a) {
131− function update() { return Utils.Tuple2(elm.timer.now(), a.value); }
132− return new LiftN(update, [a]);
133− }
134−
135− function SampleOn(s1,s2) {
136− this.id = Utils.guid();
137− this.value = s2.value;
138− this.kids = [];
139−
140− var count = 0;
141− var isChanged = false;
142−
143− this.recv = function(timestep, changed, parentID) {
144− if (parentID === s1.id) isChanged = changed;
145− ++count;
146− if (count == 2) {
147− if (isChanged) { this.value = s2.value; }
148− send(this, timestep, isChanged);
149− count = 0;
150− isChanged = false;
151− }
152− };
153− s1.kids.push(this);
154− s2.kids.push(this);
155− }
156−
157− function sampleOn(s1,s2) { return new SampleOn(s1,s2); }
158−
159− function delay(t,s) {
160− var delayed = new Input(s.value);
161− var firstEvent = true;
162− function update(v) {
163− if (firstEvent) { firstEvent = false; return; }
164− setTimeout(function() { elm.notify(delayed.id, v); }, t);
165− }
166− function first(a,b) { return a; }
167− return new SampleOn(delayed, lift2(F2(first), delayed, lift(update,s)));
168− }
169−
170− function Merge(s1,s2) {
171− this.id = Utils.guid();
172− this.value = s1.value;
173− this.kids = [];
174−
175− var next = null;
176− var count = 0;
177− var isChanged = false;
178−
179− this.recv = function(timestep, changed, parentID) {
180− ++count;
181− if (changed) {
182− isChanged = true;
183− if (parentID == s2.id && next === null) { next = s2.value; }
184− if (parentID == s1.id) { next = s1.value; }
185− }
186−
187− if (count == 2) {
188− if (isChanged) { this.value = next; next = null; }
189− send(this, timestep, isChanged);
190− isChanged = false;
191− count = 0;
192− }
193− };
194− s1.kids.push(this);
195− s2.kids.push(this);
196− }
197−
198− function merge(s1,s2) { return new Merge(s1,s2); }
199− function merges(ss) { return A2(foldr1, F2(merge), ss); }
200−
201− return elm.Native.Signal.values = {
202− input: function(v) { return new Input(v); },
203− constant : function(v) { return new Input(v); },
204− lift : F2(lift ),
205− lift2 : F3(lift2),
206− lift3 : F4(lift3),
207− lift4 : F5(lift4),
208− lift5 : F6(lift5),
209− lift6 : F7(lift6),
210− lift7 : F8(lift7),
211− lift8 : F9(lift8),
212− foldp : F3(foldp),
213− delay : F2(delay),
214− merge : F2(merge),
215− merges : merges,
216− count : function(s) { return foldp(F2(function(_,c) { return c+1; }), 0, s); },
217− countIf : F2(function(pred,s) {
218− return foldp(F2(function(x,c){
219− return pred(x) ? c+1 : c; }), 0, s)}),
220− keepIf : F3(function(pred,base,sig) {
221− return new DropIf(function(x) {return !pred(x);},base,sig); }),
222− dropIf : F3(function(pred,base,sig) { return new DropIf(pred,base,sig); }),
223− dropRepeats : function(s) { return new DropRepeats(s);},
224− sampleOn : F2(sampleOn),
225− timestamp : timestamp
226− };
227−};
libraries/Native/Signal/Time.jsdeleted−70
@@ -1,70 +0,0 @@
1−Elm.Native.Time = {};
2−Elm.Native.Time.make = function(elm) {
3−
4− elm.Native = elm.Native || {};
5− elm.Native.Time = elm.Native.Time || {};
6− if (elm.Native.Time.values) return elm.Native.Time.values;
7−
8− var Signal = Elm.Signal.make(elm);
9− var NS = Elm.Native.Signal.make(elm);
10− var Maybe = Elm.Maybe.make(elm);
11− var Utils = Elm.Native.Utils.make(elm);
12−
13− function fpsWhen(desiredFPS, isOn) {
14− var msPerFrame = 1000 / desiredFPS;
15− var prev = elm.timer.now(), curr = prev, diff = 0, wasOn = true;
16− var ticker = NS.input(diff);
17− function tick(zero) {
18− return function() {
19− curr = elm.timer.now();
20− diff = zero ? 0 : curr - prev;
21− if (prev > curr) {
22− diff = 0;
23− }
24− prev = curr;
25− elm.notify(ticker.id, diff);
26− };
27− }
28− var timeoutID = 0;
29− function f(isOn, t) {
30− if (isOn) {
31− timeoutID = elm.setTimeout(tick(!wasOn && isOn), msPerFrame);
32− } else if (wasOn) {
33− clearTimeout(timeoutID);
34− }
35− wasOn = isOn;
36− return t;
37− }
38− return A3( Signal.lift2, F2(f), isOn, ticker );
39− }
40−
41− function every(t) {
42− var clock = NS.input(elm.timer.now());
43− function tellTime() {
44− elm.notify(clock.id, elm.timer.now());
45− }
46− setInterval(tellTime, t);
47− return clock;
48− }
49−
50− function since(t, s) {
51− function cmp(a,b) { return !Utils.eq(a,b); }
52− var dcount = Signal.count(A2(NS.delay, t, s));
53− return A3( Signal.lift2, F2(cmp), Signal.count(s), dcount );
54− }
55− function read(s) {
56− var t = Date.parse(s);
57− return isNaN(t) ? Maybe.Nothing : Maybe.Just(t);
58− }
59− return elm.Native.Time.values = {
60− fpsWhen : F2(fpsWhen),
61− fps : function(t) { return fpsWhen(t, Signal.constant(true)); },
62− every : every,
63− delay : NS.delay,
64− timestamp : NS.timestamp,
65− since : F2(since),
66− toDate : function(t) { return new window.Date(t); },
67− read : read
68− };
69−
70−};
libraries/Native/Signal/Touch.jsdeleted−152
@@ -1,152 +0,0 @@
1−Elm.Native.Touch = {};
2−Elm.Native.Touch.make = function(elm) {
3−
4− elm.Native = elm.Native || {};
5− elm.Native.Touch = elm.Native.Touch || {};
6− if (elm.Native.Touch.values) return elm.Native.Touch.values;
7−
8− var Signal = Elm.Signal.make(elm);
9− var List = Elm.Native.List.make(elm);
10− var Utils = Elm.Native.Utils.make(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 = [];
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− }
56−
57− var node = elm.display === ElmRuntime.Display.FULLSCREEN ? document : elm.node;
58−
59− function start(e) {
60− var point = Utils.getXY(e);
61− dict.insert(e.identifier,
62− {x: point._0,
63− y: point._1,
64− t: elm.timer.now()});
65− }
66− function end(e) {
67− var t = dict.remove(e.identifier);
68− if (elm.timer.now() - t.t < tapTime) {
69− hasTap = true;
70− tap = {_:{}, x:t.x, y:t.y};
71− }
72− }
73−
74− function listen(name, f) {
75− function update(e) {
76− for (var i = e.changedTouches.length; i--; ) { f(e.changedTouches[i]); }
77− var ts = new Array(e.touches.length);
78− for (var i = e.touches.length; i--; ) { ts[i] = touch(e.touches[i]); }
79− elm.notify(root.id, ts);
80− e.preventDefault();
81− }
82− elm.addListener([root.id], node, name, update);
83− }
84−
85− listen("touchstart", start);
86− listen("touchmove", function(_){});
87− listen("touchend", end);
88− listen("touchcancel", end);
89− listen("touchleave", end);
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], document, "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− }
138−
139− var touches = dependency(List.fromArray);
140−
141− var taps = function() {
142− var sig = dependency(function(_) { return tap; });
143− sig.defaultNumberOfKids = 1;
144− function pred(_) { var b = hasTap; hasTap = false; return b; }
145− var sig2 = A3( Signal.keepIf, pred, {_:{},x:0,y:0}, sig);
146− sig2.defaultNumberOfKids = 0;
147− return sig2;
148− }();
149−
150− return elm.Native.Touch.values = { touches: touches, taps: taps };
151−
152−};
libraries/Native/Signal/WebSocket.jsdeleted−36
@@ -1,36 +0,0 @@
1−Elm.Native.WebSocket = {};
2−Elm.Native.WebSocket.make = function(elm) {
3−
4− elm.Native = elm.Native || {};
5− elm.Native.WebSocket = elm.Native.WebSocket || {};
6− if (elm.Native.WebSocket.values) return elm.Native.WebSocket.values;
7−
8− var Signal = Elm.Signal.make(elm);
9− var List = Elm.Native.List.make(elm);
10−
11− function open(url, outgoing) {
12− var incoming = Signal.constant("");
13− var ws = new WebSocket(url);
14−
15− var pending = [];
16− var ready = false;
17−
18− ws.onopen = function(e) {
19− var len = pending.length;
20− for (var i = 0; i < len; ++i) { ws.send(pending[i]); }
21− ready = true;
22− };
23− ws.onmessage = function(event) {
24− elm.notify(incoming.id, event.data);
25− };
26−
27− function send(msg) {
28− ready ? ws.send(msg) : pending.push(msg);
29− }
30−
31− function take1(x,y) { return x }
32− return A3(Signal.lift2, F2(take1), incoming, A2(Signal.lift, send, outgoing));
33− }
34−
35− return elm.Native.WebSocket.values = { connect: F2(open) };
36−};
libraries/Native/Signal/Window.jsdeleted−57
@@ -1,57 +0,0 @@
1−Elm.Native.Window = {};
2−Elm.Native.Window.make = function(elm) {
3−
4− elm.Native = elm.Native || {};
5− elm.Native.Window = elm.Native.Window || {};
6− if (elm.Native.Window.values) return elm.Native.Window.values;
7−
8− var Signal = Elm.Signal.make(elm);
9− var NS = Elm.Native.Signal.make(elm);
10− var Tuple2 = Elm.Native.Utils.make(elm).Tuple2;
11−
12− function getWidth() { return elm.node.clientWidth; }
13− function getHeight() {
14− if (elm.display === ElmRuntime.Display.FULLSCREEN) {
15− return window.innerHeight;
16− }
17− return elm.node.clientHeight;
18− }
19−
20− var dimensions = NS.input(Tuple2(getWidth(), getHeight()));
21− dimensions.defaultNumberOfKids = 2;
22−
23− // Do not move width and height into Elm. By setting the default number of kids,
24− // the resize listener can be detached.
25− var width = A2(Signal.lift, function(p){return p._0;}, dimensions);
26− width.defaultNumberOfKids = 0;
27−
28− var height = A2(Signal.lift, function(p){return p._1;}, dimensions);
29− height.defaultNumberOfKids = 0;
30−
31− function resizeIfNeeded() {
32− // Do not trigger event if the dimensions have not changed.
33− // This should be most of the time.
34− var w = getWidth();
35− var h = getHeight();
36− if (dimensions.value._0 === w && dimensions.value._1 === h) return;
37−
38− setTimeout(function () {
39− // Check again to see if the dimensions have changed.
40− // It is conceivable that the dimensions have changed
41− // again while some other event was being processed.
42− var w = getWidth();
43− var h = getHeight();
44− if (dimensions.value._0 === w && dimensions.value._1 === h) return;
45− elm.notify(dimensions.id, Tuple2(w,h));
46− }, 0);
47− }
48− elm.addListener([dimensions.id], window, 'resize', resizeIfNeeded);
49−
50− return elm.Native.Window.values = {
51− dimensions:dimensions,
52− width:width,
53− height:height,
54− resizeIfNeeded:resizeIfNeeded
55− };
56−
57−};
libraries/Native/String.jsdeleted−252
@@ -1,252 +0,0 @@
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 List = Elm.Native.List.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 append(a,b) {
26− return a + b;
27− }
28− function concat(strs) {
29− return List.toArray(strs).join('');
30− }
31− function length(str) {
32− return str.length;
33− }
34− function map(f,str) {
35− var out = str.split('');
36− for (var i = out.length; i--; ) {
37− out[i] = f(Utils.chr(out[i]));
38− }
39− return out.join('');
40− }
41− function filter(pred,str) {
42− return str.split('').map(Utils.chr).filter(pred).join('');
43− }
44− function reverse(str) {
45− return str.split('').reverse().join('');
46− }
47− function foldl(f,b,str) {
48− var len = str.length;
49− for (var i = 0; i < len; ++i) {
50− b = A2(f, Utils.chr(str[i]), b);
51− }
52− return b;
53− }
54− function foldr(f,b,str) {
55− for (var i = str.length; i--; ) {
56− b = A2(f, Utils.chr(str[i]), b);
57− }
58− return b;
59− }
60−
61− function split(sep, str) {
62− return List.fromArray(str.split(sep));
63− }
64− function join(sep, strs) {
65− return List.toArray(strs).join(sep);
66− }
67− function repeat(n, str) {
68− var result = '';
69− while (n > 0) {
70− if (n & 1) result += str;
71− n >>= 1, str += str;
72− }
73− return result;
74− }
75−
76− function slice(start, end, str) {
77− return str.slice(start,end);
78− }
79− function left(n, str) {
80− return n < 1 ? "" : str.slice(0,n);
81− }
82− function right(n, str) {
83− return n < 1 ? "" : str.slice(-n);
84− }
85− function dropLeft(n, str) {
86− return n < 1 ? str : str.slice(n);
87− }
88− function dropRight(n, str) {
89− return n < 1 ? str : str.slice(0,-n);
90− }
91−
92− function pad(n,chr,str) {
93− var half = (n - str.length) / 2;
94− return repeat(Math.ceil(half),chr) + str + repeat(half|0,chr);
95− }
96− function padRight(n,chr,str) {
97− return str + repeat(n - str.length, chr);
98− }
99− function padLeft(n,chr,str) {
100− return repeat(n - str.length, chr) + str;
101− }
102−
103− function trim(str) {
104− return str.trim();
105− }
106− function trimLeft(str) {
107− return str.trimLeft();
108− }
109− function trimRight(str) {
110− return str.trimRight();
111− }
112−
113− function words(str) {
114− return List.fromArray(str.trim().split(/\s+/g));
115− }
116− function lines(str) {
117− return List.fromArray(str.split(/\r\n|\r|\n/g));
118− }
119−
120− function toUpper(str) {
121− return str.toUpperCase();
122− }
123− function toLower(str) {
124− return str.toLowerCase();
125− }
126−
127− function any(pred, str) {
128− for (var i = str.length; i--; ) {
129− if (pred(Utils.chr(str[i]))) return true;
130− }
131− return false;
132− }
133− function all(pred, str) {
134− for (var i = str.length; i--; ) {
135− if (!pred(Utils.chr(str[i]))) return false;
136− }
137− return true;
138− }
139−
140− function contains(sub, str) {
141− return str.indexOf(sub) > -1;
142− }
143− function startsWith(sub, str) {
144− return str.indexOf(sub) === 0;
145− }
146− function endsWith(sub, str) {
147− return str.length >= sub.length &&
148− str.lastIndexOf(sub) === str.length - sub.length;
149− }
150− function indexes(sub, str) {
151− var subLen = sub.length;
152− var i = 0;
153− var is = [];
154− while ((i = str.indexOf(sub, i)) > -1) {
155− is.push(i);
156− i = i + subLen;
157− }
158− return List.fromArray(is);
159− }
160−
161− function toInt(s) {
162− var len = s.length;
163− if (len === 0) { return Maybe.Nothing; }
164− var start = 0;
165− if (s[0] == '-') {
166− if (len === 1) { return Maybe.Nothing; }
167− start = 1;
168− }
169− for (var i = start; i < len; ++i) {
170− if (!Char.isDigit(s[i])) { return Maybe.Nothing; }
171− }
172− return Maybe.Just(parseInt(s, 10));
173− }
174−
175− function toFloat(s) {
176− var len = s.length;
177− if (len === 0) { return Maybe.Nothing; }
178− var start = 0;
179− if (s[0] == '-') {
180− if (len === 1) { return Maybe.Nothing; }
181− start = 1;
182− }
183− var dotCount = 0;
184− for (var i = start; i < len; ++i) {
185− if (Char.isDigit(s[i])) { continue; }
186− if (s[i] === '.') {
187− dotCount += 1;
188− if (dotCount <= 1) { continue; }
189− }
190− return Maybe.Nothing;
191− }
192− return Maybe.Just(parseFloat(s));
193− }
194−
195− function toList(str) {
196− return List.fromArray(str.split('').map(Utils.chr));
197− }
198− function fromList(chars) {
199− return List.toArray(chars).join('');
200− }
201−
202− return Elm.Native.String.values = {
203− isEmpty: isEmpty,
204− cons: F2(cons),
205− uncons: uncons,
206− append: F2(append),
207− concat: concat,
208− length: length,
209− map: F2(map),
210− filter: F2(filter),
211− reverse: reverse,
212− foldl: F3(foldl),
213− foldr: F3(foldr),
214−
215− split: F2(split),
216− join: F2(join),
217− repeat: F2(repeat),
218−
219− slice: F3(slice),
220− left: F2(left),
221− right: F2(right),
222− dropLeft: F2(dropLeft),
223− dropRight: F2(dropRight),
224−
225− pad: F3(pad),
226− padLeft: F3(padLeft),
227− padRight: F3(padRight),
228−
229− trim: trim,
230− trimLeft: trimLeft,
231− trimRight: trimRight,
232−
233− words: words,
234− lines: lines,
235−
236− toUpper: toUpper,
237− toLower: toLower,
238−
239− any: F2(any),
240− all: F2(all),
241−
242− contains: F2(contains),
243− startsWith: F2(startsWith),
244− endsWith: F2(endsWith),
245− indexes: F2(indexes),
246−
247− toInt: toInt,
248− toFloat: toFloat,
249− toList: toList,
250− fromList: fromList
251− };
252−};
libraries/Native/Text.jsdeleted−167
@@ -1,167 +0,0 @@
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 toCss = Elm.Native.Color.make(elm).toCss;
8− var Element = Elm.Graphics.Element.make(elm);
9− var List = Elm.Native.List.make(elm);
10− var Utils = Elm.Native.Utils.make(elm);
11−
12− function makeSpaces(s) {
13− if (s.length == 0) { return s; }
14− var arr = s.split('');
15− if (arr[0] == ' ') { arr[0] = "&nbsp;" }
16− for (var i = arr.length; --i; ) {
17− if (arr[i][0] == ' ' && arr[i-1] == ' ') {
18− arr[i-1] = arr[i-1] + arr[i];
19− arr[i] = '';
20− }
21− }
22− for (var i = arr.length; i--; ) {
23− if (arr[i].length > 1 && arr[i][0] == ' ') {
24− var spaces = arr[i].split('');
25− for (var j = spaces.length - 2; j >= 0; j -= 2) {
26− spaces[j] = '&nbsp;';
27− }
28− arr[i] = spaces.join('');
29− }
30− }
31− arr = arr.join('');
32− if (arr[arr.length-1] === " ") {
33− return arr.slice(0,-1) + '&nbsp;';
34− }
35− return arr;
36− }
37−
38− function properEscape(str) {
39− if (str.length == 0) return str;
40− str = str //.replace(/&/g, "&#38;")
41− .replace(/"/g, '&#34;')
42− .replace(/'/g, "&#39;")
43− .replace(/</g, "&#60;")
44− .replace(/>/g, "&#62;")
45− .replace(/\n/g, "<br/>");
46− var arr = str.split('<br/>');
47− for (var i = arr.length; i--; ) {
48− arr[i] = makeSpaces(arr[i]);
49− }
50− return arr.join('<br/>');
51− }
52−
53− function toText(str) { return Utils.txt(properEscape(str)); }
54−
55− // conversions from Elm values to CSS
56− function toTypefaces(list) {
57− var typefaces = List.toArray(list);
58− for (var i = typefaces.length; i--; ) {
59− var typeface = typefaces[i];
60− if (typeface.indexOf(' ') > -1) {
61− typefaces[i] = "'" + typeface + "'";
62− }
63− }
64− return typefaces.join(',');
65− }
66− function toLine(line) {
67− var ctor = line.ctor;
68− return ctor === 'Under' ? 'underline' :
69− ctor === 'Over' ? 'overline' : 'line-through';
70− }
71−
72− // setting styles of Text
73− function style(style, text) {
74− var newText = '<span style="color:' + toCss(style.color) + ';'
75− if (style.typeface.ctor !== '[]') {
76− newText += 'font-family:' + toTypefaces(style.typeface) + ';'
77− }
78− if (style.height.ctor !== "Nothing") {
79− newText += 'font-size:' + style.height._0 + 'px;';
80− }
81− if (style.bold) {
82− newText += 'font-weight:bold;';
83− }
84− if (style.italic) {
85− newText += 'font-style:italic;';
86− }
87− if (style.line.ctor !== 'Nothing') {
88− newText += 'text-decoration:' + toLine(style.line._0) + ';';
89− }
90− newText += '">' + Utils.makeText(text) + '</span>'
91− return Utils.txt(newText);
92− }
93− function height(px, text) {
94− return { style: 'font-size:' + px + 'px;', text:text }
95− }
96− function typeface(names, text) {
97− return { style: 'font-family:' + toTypefaces(names) + ';', text:text }
98− }
99− function monospace(text) {
100− return { style: 'font-family:monospace;', text:text }
101− }
102− function italic(text) {
103− return { style: 'font-style:italic;', text:text }
104− }
105− function bold(text) {
106− return { style: 'font-weight:bold;', text:text }
107− }
108− function link(href, text) {
109− return { href: toText(href), text:text };
110− }
111− function line(line, text) {
112− return { style: 'text-decoration:' + toLine(line) + ';', text:text };
113− }
114−
115− function color(color, text) {
116− return { style: 'color:' + toCss(color) + ';', text:text };
117− }
118−
119− function block(align) {
120− return function(text) {
121− var raw = {
122− ctor :'RawHtml',
123− html : Utils.makeText(text),
124− align: align,
125− guid : null,
126− args : []
127− };
128− var pos = A2(Utils.htmlHeight, 0, raw);
129− return A3(Element.newElement, pos._0, pos._1, raw);
130− }
131− }
132−
133− function markdown(text, guid) {
134− var raw = {
135− ctor:'RawHtml',
136− html: text,
137− align: null,
138− guid: guid,
139− args: []
140− };
141− var pos = A2(Utils.htmlHeight, 0, raw);
142− return A3(Element.newElement, pos._0, pos._1, raw);
143− }
144−
145− return elm.Native.Text.values = {
146− toText: toText,
147−
148− height : F2(height),
149− italic : italic,
150− bold : bold,
151− line : F2(line),
152− monospace : monospace,
153− typeface : F2(typeface),
154− color : F2(color),
155− link : F2(link),
156− style : F2(style),
157−
158− leftAligned : block('left'),
159− rightAligned : block('right'),
160− centered : block('center'),
161− justified : block('justify'),
162− markdown : markdown,
163−
164− toTypefaces:toTypefaces,
165− toLine:toLine
166− };
167−};
libraries/Native/Trampoline.jsdeleted−24
@@ -1,24 +0,0 @@
1−Elm.Native.Trampoline = {};
2−Elm.Native.Trampoline.make = function(elm) {
3− elm.Native = elm.Native || {};
4− elm.Native.Trampoline = elm.Native.Trampoline || {};
5− if (elm.Native.Trampoline.values) return elm.Native.Trampoline.values;
6−
7− // trampoline : Trampoline a -> a
8− function trampoline(t) {
9− var tramp = t;
10− while(true) {
11− switch(tramp.ctor) {
12− case "Done":
13− return tramp._0;
14− case "Continue":
15− tramp = tramp._0({ctor: "_Tuple0"});
16− continue;
17− }
18− }
19− }
20−
21− return elm.Native.Trampoline.values = {
22− trampoline:trampoline
23− };
24−};
libraries/Native/Transform2D.jsdeleted−99
@@ -1,99 +0,0 @@
1−Elm.Native.Transform2D = {};
2−Elm.Native.Transform2D.make = function(elm) {
3−
4− elm.Native = elm.Native || {};
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') {
10− A = function(arr) {
11− this.length = arr.length;
12− this[0] = arr[0];
13− this[1] = arr[1];
14− this[2] = arr[2];
15− this[3] = arr[3];
16− this[4] = arr[4];
17− this[5] = arr[5];
18− };
19− } else {
20− A = Float32Array;
21− }
22−
23− // layout of matrix in an array is
24− //
25− // | m11 m12 dx |
26− // | m21 m22 dy |
27− // | 0 0 1 |
28− //
29− // new A([ m11, m12, dx, m21, m22, dy ])
30−
31− var identity = new A([1,0,0,0,1,0]);
32− function matrix(m11, m12, m21, m22, dx, dy) {
33− return new A([m11, m12, dx, m21, m22, dy]);
34− }
35− function rotation(t) {
36− var c = Math.cos(t);
37− var s = Math.sin(t);
38− return new A([c, -s, 0, s, c, 0]);
39− }
40− function rotate(t,m) {
41− var c = Math.cos(t);
42− var s = Math.sin(t);
43− var m11 = m[0], m12 = m[1], m21 = m[3], m22 = m[4];
44− return new A([m11*c + m12*s, -m11*s + m12*c, m[2],
45− m21*c + m22*s, -m21*s + m22*c, m[5]]);
46− }
47− /*
48− function move(xy,m) {
49− var x = xy._0;
50− var y = xy._1;
51− var m11 = m[0], m12 = m[1], m21 = m[3], m22 = m[4];
52− return new A([m11, m12, m11*x + m12*y + m[2],
53− m21, m22, m21*x + m22*y + m[5]]);
54− }
55− function scale(s,m) { return new A([m[0]*s, m[1]*s, m[2], m[3]*s, m[4]*s, m[5]]); }
56− function scaleX(x,m) { return new A([m[0]*x, m[1], m[2], m[3]*x, m[4], m[5]]); }
57− function scaleY(y,m) { return new A([m[0], m[1]*y, m[2], m[3], m[4]*y, m[5]]); }
58− function reflectX(m) { return new A([-m[0], m[1], m[2], -m[3], m[4], m[5]]); }
59− function reflectY(m) { return new A([m[0], -m[1], m[2], m[3], -m[4], m[5]]); }
60−
61− function transform(m11, m21, m12, m22, mdx, mdy, n) {
62− var n11 = n[0], n12 = n[1], n21 = n[3], n22 = n[4], ndx = n[2], ndy = n[5];
63− return new A([m11*n11 + m12*n21,
64− m11*n12 + m12*n22,
65− m11*ndx + m12*ndy + mdx,
66− m21*n11 + m22*n21,
67− m21*n12 + m22*n22,
68− m21*ndx + m22*ndy + mdy]);
69− }
70− */
71− function multiply(m, n) {
72− var m11 = m[0], m12 = m[1], m21 = m[3], m22 = m[4], mdx = m[2], mdy = m[5];
73− var n11 = n[0], n12 = n[1], n21 = n[3], n22 = n[4], ndx = n[2], ndy = n[5];
74− return new A([m11*n11 + m12*n21,
75− m11*n12 + m12*n22,
76− m11*ndx + m12*ndy + mdx,
77− m21*n11 + m22*n21,
78− m21*n12 + m22*n22,
79− m21*ndx + m22*ndy + mdy]);
80− }
81−
82− return elm.Native.Transform2D.values = {
83− identity:identity,
84− matrix:F6(matrix),
85− rotation:rotation,
86− multiply:F2(multiply)
87− /*
88− transform:F7(transform),
89− rotate:F2(rotate),
90− move:F2(move),
91− scale:F2(scale),
92− scaleX:F2(scaleX),
93− scaleY:F2(scaleY),
94− reflectX:reflectX,
95− reflectY:reflectY
96− */
97− };
98−
99−};
libraries/Native/Utils.jsdeleted−267
@@ -1,267 +0,0 @@
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(l,r) {
9− var stack = [{'x': l, 'y': r}]
10− while (stack.length > 0) {
11− var front = stack.pop();
12− var x = front.x;
13− var y = front.y;
14− if (x === y) continue;
15− if (typeof x === "object") {
16− var c = 0;
17− for (var i in x) {
18− ++c;
19− if (i in y) {
20− if (i !== 'ctor') {
21− stack.push({ 'x': x[i], 'y': y[i] });
22− }
23− } else {
24− return false;
25− }
26− }
27− if ('ctor' in x) {
28− stack.push({'x': x.ctor, 'y': y.ctor});
29− }
30− if (c !== Object.keys(y).length) {
31− return false;
32− };
33− } else if (typeof x === 'function') {
34− throw new Error('Equality error: general function equality is ' +
35− 'undecidable, and therefore, unsupported');
36− } else {
37− return false;
38− }
39− }
40− return true;
41− }
42−
43− // code in Generate/JavaScript.hs depends on the particular
44− // integer values assigned to LT, EQ, and GT
45− var LT = -1, EQ = 0, GT = 1, ord = ['LT','EQ','GT'];
46− function compare(x,y) { return { ctor: ord[cmp(x,y)+1] } }
47− function cmp(x,y) {
48− var ord;
49− if (typeof x !== 'object'){
50− return x === y ? EQ : x < y ? LT : GT;
51− }
52− else if (x.isChar){
53− var a = x.toString();
54− var b = y.toString();
55− return a === b ? EQ : a < b ? LT : GT;
56− }
57− else if (x.ctor === "::" || x.ctor === "[]") {
58− while (true) {
59− if (x.ctor === "[]" && y.ctor === "[]") return EQ;
60− if (x.ctor !== y.ctor) return x.ctor === '[]' ? LT : GT;
61− ord = cmp(x._0, y._0);
62− if (ord !== EQ) return ord;
63− x = x._1;
64− y = y._1;
65− }
66− }
67− else if (x.ctor.slice(0,6) === '_Tuple') {
68− var n = x.ctor.slice(6) - 0;
69− var err = 'cannot compare tuples with more than 6 elements.';
70− if (n === 0) return EQ;
71− if (n >= 1) { ord = cmp(x._0, y._0); if (ord !== EQ) return ord;
72− if (n >= 2) { ord = cmp(x._1, y._1); if (ord !== EQ) return ord;
73− if (n >= 3) { ord = cmp(x._2, y._2); if (ord !== EQ) return ord;
74− if (n >= 4) { ord = cmp(x._3, y._3); if (ord !== EQ) return ord;
75− if (n >= 5) { ord = cmp(x._4, y._4); if (ord !== EQ) return ord;
76− if (n >= 6) { ord = cmp(x._5, y._5); if (ord !== EQ) return ord;
77− if (n >= 7) throw new Error('Comparison error: ' + err); } } } } } }
78− return EQ;
79− }
80− else {
81− throw new Error('Comparison error: comparison is only defined on ints, ' +
82− 'floats, times, chars, strings, lists of comparable values, ' +
83− 'and tuples of comparable values.');
84− }
85− }
86−
87−
88− var Tuple0 = { ctor: "_Tuple0" };
89− function Tuple2(x,y) { return { ctor:"_Tuple2", _0:x, _1:y } }
90−
91− function chr(c) {
92− var x = new String(c);
93− x.isChar = true;
94− return x;
95− }
96−
97− function txt(str) {
98− var t = new String(str);
99− t.text = true;
100− return t;
101− }
102−
103− function makeText(text) {
104− var style = '';
105− var href = '';
106− while (true) {
107− if (text.style) {
108− style += text.style;
109− text = text.text;
110− continue;
111− }
112− if (text.href) {
113− href = text.href;
114− text = text.text;
115− continue;
116− }
117− if (href) text = '<a href="' + href + '">' + text + '</a>';
118− if (style) text = '<span style="' + style + '">' + text + '</span>';
119− return text;
120− }
121− }
122−
123− var count = 0;
124− function guid(_) { return count++ }
125−
126− function copy(oldRecord) {
127− var newRecord = {};
128− for (var key in oldRecord) {
129− var value = key === '_'
130− ? copy(oldRecord._)
131− : oldRecord[key]
132− ;
133− newRecord[key] = value;
134− }
135− return newRecord;
136− }
137−
138− function remove(key, oldRecord) {
139− var record = copy(oldRecord);
140− if (key in record._) {
141− record[key] = record._[key][0];
142− record._[key] = record._[key].slice(1);
143− if (record._[key].length === 0) {
144− delete record._[key];
145− }
146− } else {
147− delete record[key];
148− }
149− return record;
150− }
151−
152− function replace(keyValuePairs, oldRecord) {
153− var record = copy(oldRecord);
154− for (var i = keyValuePairs.length; i--; ) {
155− var pair = keyValuePairs[i];
156− record[pair[0]] = pair[1];
157− }
158− return record;
159− }
160−
161− function insert(key, value, oldRecord) {
162− var newRecord = copy(oldRecord);
163− if (key in newRecord) {
164− var values = newRecord._[key];
165− var copiedValues = values ? values.slice(0) : [];
166− newRecord._[key] = [newRecord[key]].concat(copiedValues);
167− }
168− newRecord[key] = value;
169− return newRecord;
170− }
171−
172− function max(a,b) { return a > b ? a : b }
173− function min(a,b) { return a < b ? a : b }
174−
175− function mod(a,b) {
176− if (b === 0) {
177− throw new Error("Cannot perform mod 0. Division by zero error.");
178− }
179− var r = a % b;
180− var m = a === 0 ? 0 : (b > 0 ? (a >= 0 ? r : r+b) : -mod(-a,-b));
181−
182− return m === b ? 0 : m;
183− }
184−
185− function htmlHeight(width, rawHtml) {
186− // create dummy node
187− var html = rawHtml.html;
188− var t = document.createElement('div');
189− t.innerHTML = html;
190− if (width > 0) { t.style.width = width + "px"; }
191− t.style.visibility = "hidden";
192− t.style.styleFloat = "left";
193− t.style.cssFloat = "left";
194−
195− document.body.appendChild(t);
196−
197− // insert interpolated values
198− var args = rawHtml.args;
199− var guid = rawHtml.guid;
200− for (var i = args.length; i--; ) {
201− var arg = args[i];
202− var span = document.getElementById('md-' + guid + '-' + i);
203− if (arg.isElement) {
204− span.style.width = arg.props.width + 'px';
205− span.style.height = arg.props.height + 'px';
206− } else {
207− span.innerHTML = arg;
208− }
209− }
210−
211− // get dimensions
212− var style = window.getComputedStyle(t, null);
213− var w = Math.ceil(style.getPropertyValue("width").slice(0,-2) - 0);
214− var h = Math.ceil(style.getPropertyValue("height").slice(0,-2) - 0);
215− document.body.removeChild(t);
216− return Tuple2(w,h);
217− }
218−
219− function getXY(e) {
220− var posx = 0;
221− var posy = 0;
222− if (e.pageX || e.pageY) {
223− posx = e.pageX;
224− posy = e.pageY;
225− } else if (e.clientX || e.clientY) {
226− posx = e.clientX + document.body.scrollLeft + document.documentElement.scrollLeft;
227− posy = e.clientY + document.body.scrollTop + document.documentElement.scrollTop;
228− }
229−
230− if (elm.display === ElmRuntime.Display.COMPONENT) {
231− var rect = elm.node.getBoundingClientRect();
232− var relx = rect.left + document.body.scrollLeft + document.documentElement.scrollLeft;
233− var rely = rect.top + document.body.scrollTop + document.documentElement.scrollTop;
234− // TODO: figure out if there is a way to avoid rounding here
235− posx = posx - Math.round(relx) - elm.node.clientLeft;
236− posy = posy - Math.round(rely) - elm.node.clientTop;
237− }
238− return Tuple2(posx, posy);
239− }
240−
241− function isJSArray(a) {
242− return a instanceof Array;
243− }
244−
245− return elm.Native.Utils.values = {
246− eq:eq,
247− cmp:cmp,
248− compare:F2(compare),
249− Tuple0:Tuple0,
250− Tuple2:Tuple2,
251− chr:chr,
252− txt:txt,
253− makeText:makeText,
254− copy: copy,
255− remove: remove,
256− replace: replace,
257− insert: insert,
258− guid: guid,
259− max : F2(max),
260− min : F2(min),
261− mod : F2(mod),
262− htmlHeight: F2(htmlHeight),
263− getXY: getXY,
264− isJSArray: isJSArray,
265− toFloat: function(x) { return +x; }
266− };
267−};
libraries/Random.elmdeleted−30
@@ -1,30 +0,0 @@
1−module Random where
2−
3−{-| Since the core of Elm is pure, randomness must be handled via signals.
4−
5−# Random Numbers
6−@docs range, float, floatList
7−-}
8−
9−import Signal (Signal)
10−import Native.Random
11−
12−{-| Given a range from low to high and a signal of values, this produces
13−a new signal that changes whenever the input signal changes. The new
14−values are random number between 'low' and 'high' inclusive.
15−-}
16−range : Int -> Int -> Signal a -> Signal Int
17−range = Native.Random.range
18−
19−{-| Produces a new signal that changes whenever the input signal changes.
20−The new values are random numbers in [0..1).
21−-}
22−float : Signal a -> Signal 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/Regex.elmdeleted−131
@@ -1,131 +0,0 @@
1−module Regex where
2−{-| A library for working with regular expressions. It uses [the
3−same kind of regular expressions accepted by JavaScript](https://developer.mozilla.org/en/docs/Web/JavaScript/Guide/Regular_Expressions).
4−
5−# Create
6−@docs regex, escape, caseInsensitive
7−
8−# Helpful Data Structures
9−
10−These data structures are needed to help define functions like [`find`](#find)
11−and [`replace`](#replace).
12−
13−@docs HowMany, Match
14−
15−# Use
16−@docs contains, find, replace, split
17−
18−-}
19−
20−import Maybe (Maybe)
21−import Native.Regex
22−
23−type Regex = Regex
24−
25−{-| Escape strings to be regular expressions, making all special characters
26−safe. So `regex (escape "^a+")` will match exactly `"^a+"` instead of a series
27−of `a`&rsquo;s that start at the beginning of the line.
28−-}
29−escape : String -> String
30−escape = Native.Regex.escape
31−
32−{-| Create a Regex that matches patterns [as specified in JavaScript](https://developer.mozilla.org/en/docs/Web/JavaScript/Guide/Regular_Expressions#Writing_a_Regular_Expression_Pattern).
33−
34−Be careful to escape backslashes properly! For example, `"\w"` is escaping the
35−letter `w` which is probably not what you want. You probably want `"\\w"`
36−instead, which escapes the backslash.
37−-}
38−regex : String -> Regex
39−regex = Native.Regex.regex
40−
41−
42−{-| Make a regex case insensitive -}
43−caseInsensitive : Regex -> Regex
44−caseInsensitive = Native.Regex.caseInsensitive
45−
46−{-| Check to see if a Regex is contained in a string.
47−
48−```haskell
49− contains (regex "123") "12345" == True
50− contains (regex "b+") "aabbcc" == True
51−
52− contains (regex "789") "12345" == False
53− contains (regex "z+") "aabbcc" == False
54−```
55−-}
56−contains : Regex -> String -> Bool
57−contains = Native.Regex.contains
58−
59−{-| A `Match` represents all of the details about a particular match in a string.
60−Here are details on each field:
61−
62− * `match` &mdash; the full string of the match.
63− * `submatches` &mdash; a regex might have [subpatterns, surrounded by
64− parentheses](https://developer.mozilla.org/en/docs/Web/JavaScript/Guide/Regular_Expressions#Using_Parenthesized_Substring_Matches).
65− If there are N subpatterns, there will be N elements in the `submatches` list.
66− Each submatch in this list is a `Maybe` because not all subpatterns may trigger.
67− For example, `(regex "(a+)|(b+)")` will either match many `a`&rsquo;s or
68− many `b`&rsquo;s, but never both.
69− * `index` &mdash; the index of the match in the original string.
70− * `number` &mdash; if you find many matches, you can think of each one
71− as being labeled with a `number` starting at one. So the first time you
72− find a match, that is match `number` one. Second time is match `number` two.
73− This is useful when paired with `replace All` if replacement is dependent on how
74− many times a pattern has appeared before.
75−-}
76−type alias Match =
77− { match : String
78− , submatches : [Maybe String]
79− , index : Int
80− , number : Int
81− }
82−
83−{-| `HowMany` is used to specify how many matches you want to make. So
84−`replace All` would replace every match, but `replace (AtMost 2)` would
85−replace at most two matches (i.e. zero, one, two, but never three or more).
86−-}
87−type HowMany = All | AtMost Int
88−
89−{-| Find matches in a string:
90−
91−```haskell
92− findTwoCommas = find (AtMost 2) (regex ",")
93−
94− -- map .index (findTwoCommas "a,b,c,d,e") == [1,3]
95− -- map .index (findTwoCommas "a b c d e") == []
96−
97− places = find All (regex "[oi]n a (\\w+)") "I am on a boat in a lake."
98−
99− -- map .match places == ["on a boat", "in a lake"]
100− -- map .submatches places == [ [Just "boat"], [Just "lake"] ]
101−```
102−-}
103−find : HowMany -> Regex -> String -> [Match]
104−find = Native.Regex.find
105−
106−{-| Replace matches. The function from `Match` to `String` lets
107−you use the details of a specific match when making replacements.
108−
109−```haskell
110− devowel = replace All (regex "[aeiou]") (\_ -> "")
111−
112− -- devowel "The quick brown fox" == "Th qck brwn fx"
113−
114− reverseWords = replace All (regex "\\w+") (\{match} -> String.reverse match)
115−
116− -- reverseWords "deliver mined parts" == "reviled denim strap"
117−```
118−-}
119−replace : HowMany -> Regex -> (Match -> String) -> String -> String
120−replace = Native.Regex.replace
121−
122−{-| Split a string, using the regex as the separator.
123−
124−```haskell
125− split (AtMost 1) (regex ",") "tom,99,90,85" == ["tom","99,90,85"]
126−
127− split All (regex ",") "a,b,c,d" == ["a","b","c","d"]
128−```
129−-}
130−split : HowMany -> Regex -> String -> [String]
131−split = Native.Regex.split
libraries/Set.elmdeleted−102
@@ -1,102 +0,0 @@
1−
2−module Set
3− ( Set
4− , empty, singleton, insert, remove
5− , member
6− , foldl, foldr, map
7− , filter, partition
8− , union, intersect, diff
9− , toList, fromList
10− ) where
11−
12−{-| A set of unique values. The values can be any comparable type. This
13−includes `Int`, `Float`, `Time`, `Char`, `String`, and tuples or lists
14−of comparable types.
15−
16−Insert, remove, and query operations all take *O(log n)* time.
17−
18−# Build
19−@docs empty, singleton, insert, remove
20−
21−# Query
22−@docs member
23−
24−# Combine
25−@docs union, intersect, diff
26−
27−# Lists
28−@docs toList, fromList
29−
30−# Transform
31−@docs map, foldl, foldr, filter, partition
32−
33−-}
34−
35−import Maybe (Maybe)
36−import Dict as Dict
37−import List as List
38−
39−type alias Set t = Dict.Dict t ()
40−
41−{-| Create an empty set. -}
42−empty : Set comparable
43−empty = Dict.empty
44−
45−{-| Create a set with one value. -}
46−singleton : comparable -> Set comparable
47−singleton k = Dict.singleton k ()
48−
49−{-| Insert a value into a set. -}
50−insert : comparable -> Set comparable -> Set comparable
51−insert k = Dict.insert k ()
52−
53−{-| Remove a value from a set. If the value is not found, no changes are made.
54−-}
55−remove : comparable -> Set comparable -> Set comparable
56−remove = Dict.remove
57−
58−{-| Determine if a value is in a set. -}
59−member : comparable -> Set comparable -> Bool
60−member = Dict.member
61−
62−{-| Get the union of two sets. Keep all values. -}
63−union : Set comparable -> Set comparable -> Set comparable
64−union = Dict.union
65−
66−{-| Get the intersection of two sets. Keeps values that appear in both sets. -}
67−intersect : Set comparable -> Set comparable -> Set comparable
68−intersect = Dict.intersect
69−
70−{-| Get the difference between the first set and the second. Keeps values
71−that do not appear in the second set. -}
72−diff : Set comparable -> Set comparable -> Set comparable
73−diff = Dict.diff
74−
75−{-| Convert a set into a list. -}
76−toList : Set comparable -> [comparable]
77−toList = Dict.keys
78−
79−{-| Convert a list into a set, removing any duplicates. -}
80−fromList : [comparable] -> Set comparable
81−fromList xs = List.foldl insert empty xs
82−
83−{-| Fold over the values in a set, in order from lowest to highest. -}
84−foldl : (comparable -> b -> b) -> b -> Set comparable -> b
85−foldl f b s = Dict.foldl (\k _ b -> f k b) b s
86−
87−{-| Fold over the values in a set, in order from highest to lowest. -}
88−foldr : (comparable -> b -> b) -> b -> Set comparable -> b
89−foldr f b s = Dict.foldr (\k _ b -> f k b) b s
90−
91−{-| Map a function onto a set, creating a new set with no duplicates. -}
92−map : (comparable -> comparable') -> Set comparable -> Set comparable'
93−map f s = fromList (List.map f (toList s))
94−
95−{-| Create a new set consisting only of elements which satisfy a predicate. -}
96−filter : (comparable -> Bool) -> Set comparable -> Set comparable
97−filter p set = Dict.filter (\k _ -> p k) set
98−
99−{-| Create two new sets; the first consisting of elements which satisfy a
100−predicate, the second consisting of elements which do not. -}
101−partition : (comparable -> Bool) -> Set comparable -> (Set comparable, Set comparable)
102−partition p set = Dict.partition (\k _ -> p k) set
libraries/Signal.elmdeleted−170
@@ -1,170 +0,0 @@
1−module 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 whenever 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` library.
14−
15−# Combine
16−@docs constant, lift, lift2, merge, merges, combine
17−
18−# Past-Dependence
19−@docs foldp, count, countIf
20−
21−#Filters
22−@docs keepIf, dropIf, keepWhen, dropWhen, dropRepeats, sampleOn
23−
24−# Pretty Lift
25−@docs (<~), (~)
26−
27−# Do you even lift?
28−@docs lift3, lift4, lift5, lift6, lift7, lift8
29−
30−-}
31−
32−import Native.Signal
33−import List (foldr, (::))
34−import Basics (fst, snd, not)
35−
36−type Signal a = Signal
37−
38−{-| Create a constant signal that never changes. -}
39−constant : a -> Signal a
40−constant = Native.Signal.constant
41−
42−{-| Transform a signal with a given function. -}
43−lift : (a -> b) -> Signal a -> Signal b
44−lift = Native.Signal.lift
45−
46−{-| Combine two signals with a given function. -}
47−lift2 : (a -> b -> c) -> Signal a -> Signal b -> Signal c
48−lift2 = Native.Signal.lift2
49−
50−lift3 : (a -> b -> c -> d) -> Signal a -> Signal b -> Signal c -> Signal d
51−lift3 = Native.Signal.lift3
52−
53−lift4 : (a -> b -> c -> d -> e) -> Signal a -> Signal b -> Signal c -> Signal d -> Signal e
54−lift4 = Native.Signal.lift4
55−
56−lift5 : (a -> b -> c -> d -> e -> f) -> Signal a -> Signal b -> Signal c -> Signal d -> Signal e -> Signal f
57−lift5 = Native.Signal.lift5
58−
59−lift6 : (a -> b -> c -> d -> e -> f -> g)
60− -> Signal a -> Signal b -> Signal c -> Signal d -> Signal e -> Signal f -> Signal g
61−lift6 = Native.Signal.lift6
62−
63−lift7 : (a -> b -> c -> d -> e -> f -> g -> h)
64− -> Signal a -> Signal b -> Signal c -> Signal d -> Signal e -> Signal f -> Signal g -> Signal h
65−lift7 = Native.Signal.lift7
66−
67−lift8 : (a -> b -> c -> d -> e -> f -> g -> h -> i)
68− -> Signal a -> Signal b -> Signal c -> Signal d -> Signal e -> Signal f -> Signal g -> Signal h -> Signal i
69−lift8 = Native.Signal.lift8
70−
71−
72−{-| Create a past-dependent signal. Each value given on the input signal will
73−be accumulated, producing a new output value.
74−
75−For instance, `foldp (+) 0 (fps 40)` is the time the program has been running,
76−updated 40 times a second. -}
77−foldp : (a -> b -> b) -> b -> Signal a -> Signal b
78−foldp = Native.Signal.foldp
79−
80−{-| Merge two signals into one, biased towards the first signal if both signals
81−update at the same time. -}
82−merge : Signal a -> Signal a -> Signal a
83−merge = Native.Signal.merge
84−
85−{-| Merge many signals into one, biased towards the left-most signal if multiple
86−signals update simultaneously. -}
87−merges : [Signal a] -> Signal a
88−merges = Native.Signal.merges
89−
90−{-| Combine a list of signals into a signal of lists. -}
91−combine : [Signal a] -> Signal [a]
92−combine = foldr (Native.Signal.lift2 (::)) (Native.Signal.constant [])
93−
94− -- Merge two signals into one, but distinguishing the values by marking the first
95− -- signal as `Left` and the second signal as `Right`. This allows you to easily
96− -- fold over non-homogeneous inputs.
97− -- mergeEither : Signal a -> Signal b -> Signal (Either a b)
98−
99−{-| Count the number of events that have occurred. -}
100−count : Signal a -> Signal Int
101−count = Native.Signal.count
102−
103−{-| Count the number of events that have occurred that satisfy a given predicate.
104−-}
105−countIf : (a -> Bool) -> Signal a -> Signal Int
106−countIf = Native.Signal.countIf
107−
108−{-| Keep only events that satisfy the given predicate. Elm does not allow
109−undefined signals, so a base case must be provided in case the predicate is
110−not satisfied initially. -}
111−keepIf : (a -> Bool) -> a -> Signal a -> Signal a
112−keepIf = Native.Signal.keepIf
113−
114−{-| Drop events that satisfy the given predicate. Elm does not allow undefined
115−signals, so a base case must be provided in case the predicate is satisfied
116−initially. -}
117−dropIf : (a -> Bool) -> a -> Signal a -> Signal a
118−dropIf = Native.Signal.dropIf
119−
120−{-| Keep events only when the first signal is true. Elm does not allow undefined
121−signals, so a base case must be provided in case the first signal is not true
122−initially.
123−-}
124−keepWhen : Signal Bool -> a -> Signal a -> Signal a
125−keepWhen bs def sig =
126− snd <~ (keepIf fst (False, def) ((,) <~ (sampleOn sig bs) ~ sig))
127−
128−{-| Drop events when the first signal is true. Elm does not allow undefined
129−signals, so a base case must be provided in case the first signal is true
130−initially.
131−-}
132−dropWhen : Signal Bool -> a -> Signal a -> Signal a
133−dropWhen bs = keepWhen (not <~ bs)
134−
135−{-| Drop updates that repeat the current value of the signal.
136−
137−Imagine a signal `numbers` has initial value
138−0 and then updates with values 0, 0, 1, 1, and 2. `dropRepeats numbers`
139−is a signal that has initial value 0 and updates as follows: ignore 0,
140−ignore 0, update to 1, ignore 1, update to 2. -}
141−dropRepeats : Signal a -> Signal a
142−dropRepeats = Native.Signal.dropRepeats
143−
144−{-| Sample from the second input every time an event occurs on the first input.
145−For example, `(sampleOn clicks (every second))` will give the approximate time
146−of the latest click. -}
147−sampleOn : Signal a -> Signal b -> Signal b
148−sampleOn = Native.Signal.sampleOn
149−
150−{-| An alias for `lift`. A prettier way to apply a function to the current value
151−of a signal. -}
152−(<~) : (a -> b) -> Signal a -> Signal b
153−f <~ s = Native.Signal.lift f s
154−
155−{-| Informally, an alias for `liftN`. Intersperse it between additional signal
156−arguments of the lifted function.
157−
158−Formally, signal application. This takes two signals, holding a function and
159−a value. It applies the current function to the current value.
160−
161−The following expressions are equivalent:
162−
163− scene <~ Window.dimensions ~ Mouse.position
164− lift2 scene Window.dimensions Mouse.position
165−-}
166−(~) : Signal (a -> b) -> Signal a -> Signal b
167−sf ~ s = Native.Signal.lift2 (\f x -> f x) sf s
168−
169−infixl 4 <~
170−infixl 4 ~
libraries/String.elmdeleted−340
@@ -1,340 +0,0 @@
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, reverse, repeat
7−
8−# Building and Splitting
9−@docs cons, uncons, append, concat, split, join, words, lines
10−
11−# Get Substrings
12−@docs slice, left, right, dropLeft, dropRight
13−
14−# Check for Substrings
15−@docs contains, startsWith, endsWith, indexes, indices
16−
17−# Conversions
18−@docs show, toInt, toFloat, toList, fromList
19−
20−# Formatting
21−Cosmetic operations such as padding with extra characters or trimming whitespace.
22−
23−@docs toUpper, toLower,
24− pad, padLeft, padRight,
25− trim, trimLeft, trimRight
26−
27−# Higher-Order Functions
28−@docs map, filter, foldl, foldr, any, all
29−-}
30−
31−import Native.Show
32−import Native.String
33−import Maybe (Maybe)
34−
35−{-| Determine if a string is empty.
36−
37− isEmpty "" == True
38− isEmpty "the world" == False
39−-}
40−isEmpty : String -> Bool
41−isEmpty = Native.String.isEmpty
42−
43−{-| Add a character to the beginning of a string. -}
44−cons : Char -> String -> String
45−cons = Native.String.cons
46−
47−{-| Split a non-empty string into its head and tail. This lets you
48−pattern match on strings exactly as you would with lists.
49−
50− uncons "abc" == Just ('a',"bc")
51− uncons "" == Nothing
52−-}
53−uncons : String -> Maybe (Char, String)
54−uncons = Native.String.uncons
55−
56−{-| Append two strings. You can also use [the `(++)` operator](/library/List.elm#++)
57−to do this.
58−
59− append "butter" "fly" == "butterfly"
60−-}
61−append : String -> String -> String
62−append = Native.String.append
63−
64−{-| Concatenate many strings into one.
65−
66− concat ["never","the","less"] == "nevertheless"
67−-}
68−concat : [String] -> String
69−concat = Native.String.concat
70−
71−{-| Get the length of a string.
72−
73− length "innumerable" == 11
74− length "" == 0
75−
76−-}
77−length : String -> Int
78−length = Native.String.length
79−
80−{-| Transform every character in a string
81−
82− map (\c -> if c == '/' then '.' else c) "a/b/c" == "a.b.c"
83−-}
84−map : (Char -> Char) -> String -> String
85−map = Native.String.map
86−
87−{-| Keep only the characters that satisfy the predicate.
88−
89− filter isDigit "R2-D2" == "22"
90−-}
91−filter : (Char -> Bool) -> String -> String
92−filter = Native.String.filter
93−
94−{-| Reverse a string.
95−
96− reverse "stressed" == "desserts"
97−-}
98−reverse : String -> String
99−reverse = Native.String.reverse
100−
101−{-| Reduce a string from the left.
102−
103− foldl cons "" "time" == "emit"
104−-}
105−foldl : (Char -> b -> b) -> b -> String -> b
106−foldl = Native.String.foldl
107−
108−{-| Reduce a string from the right.
109−
110− foldr cons "" "time" == "time"
111−-}
112−foldr : (Char -> b -> b) -> b -> String -> b
113−foldr = Native.String.foldr
114−
115−{-| Split a string using a given separator.
116−
117− split "," "cat,dog,cow" == ["cat","dog","cow"]
118− split "/" "home/evan/Desktop/" == ["home","evan","Desktop", ""]
119−
120−Use `Regex.split` if you need something more flexible.
121−-}
122−split : String -> String -> [String]
123−split = Native.String.split
124−
125−{-| Put many strings together with a given separator.
126−
127− join "a" ["H","w","ii","n"] == "Hawaiian"
128− join " " ["cat","dog","cow"] == "cat dog cow"
129− join "/" ["home","evan","Desktop"] == "home/evan/Desktop"
130−-}
131−join : String -> [String] -> String
132−join = Native.String.join
133−
134−{-| Repeat a string *n* times.
135−
136− repeat 3 "ha" == "hahaha"
137−-}
138−repeat : Int -> String -> String
139−repeat = Native.String.repeat
140−
141−{-| Take a substring given a start and end index. Negative indexes
142−are taken starting from the *end* of the list.
143−
144− slice 7 9 "snakes on a plane!" == "on"
145− slice 0 6 "snakes on a plane!" == "snakes"
146− slice 0 -7 "snakes on a plane!" == "snakes on a"
147− slice -6 -1 "snakes on a plane!" == "plane"
148−-}
149−slice : Int -> Int -> String -> String
150−slice = Native.String.slice
151−
152−{-| Take *n* characters from the left side of a string. -}
153−left : Int -> String -> String
154−left = Native.String.left
155−
156−{-| Take *n* characters from the right side of a string. -}
157−right : Int -> String -> String
158−right = Native.String.right
159−
160−{-| Drop *n* characters from the left side of a string. -}
161−dropLeft : Int -> String -> String
162−dropLeft = Native.String.dropLeft
163−
164−{-| Drop *n* characters from the right side of a string. -}
165−dropRight : Int -> String -> String
166−dropRight = Native.String.dropRight
167−
168−{-| Pad a string on both sides until it has a given length.
169−
170− pad 5 ' ' "1" == " 1 "
171− pad 5 ' ' "11" == " 11 "
172− pad 5 ' ' "121" == " 121 "
173−-}
174−pad : Int -> Char -> String -> String
175−pad = Native.String.pad
176−
177−{-| Pad a string on the left until it has a given length.
178−
179− padLeft 5 '.' "1" == "....1"
180− padLeft 5 '.' "11" == "...11"
181− padLeft 5 '.' "121" == "..121"
182−-}
183−padLeft : Int -> Char -> String -> String
184−padLeft = Native.String.padLeft
185−
186−{-| Pad a string on the right until it has a given length.
187−
188− padRight 5 '.' "1" == "1...."
189− padRight 5 '.' "11" == "11..."
190− padRight 5 '.' "121" == "121.."
191−-}
192−padRight : Int -> Char -> String -> String
193−padRight = Native.String.padRight
194−
195−{-| Get rid of whitespace on both sides of a string.
196−
197− trim " hats \n" == "hats"
198−-}
199−trim : String -> String
200−trim = Native.String.trim
201−
202−{-| Get rid of whitespace on the left of a string.
203−
204− trimLeft " hats \n" == "hats \n"
205−-}
206−trimLeft : String -> String
207−trimLeft = Native.String.trimLeft
208−
209−{-| Get rid of whitespace on the right of a string.
210−
211− trimRight " hats \n" == " hats"
212−-}
213−trimRight : String -> String
214−trimRight = Native.String.trimRight
215−
216−{-| Break a string into words, splitting on chunks of whitespace.
217−
218− words "How are \t you? \n Good?" == ["How","are","you?","Good?"]
219−-}
220−words : String -> [String]
221−words = Native.String.words
222−
223−{-| Break a string into lines, splitting on newlines.
224−
225− lines "How are you?\nGood?" == ["How are you?", "Good?"]
226−-}
227−lines : String -> [String]
228−lines = Native.String.lines
229−
230−{-| Convert a string to all upper case. Useful for case insensitive comparisons
231−and VIRTUAL YELLING.
232−-}
233−toUpper : String -> String
234−toUpper = Native.String.toUpper
235−
236−{-| Convert a string to all lower case. Useful for case insensitive comparisons. -}
237−toLower : String -> String
238−toLower = Native.String.toLower
239−
240−{-| Determine whether *any* characters satisfy a predicate.
241−
242− any isDigit "90210" == True
243− any isDigit "R2-D2" == True
244− any isDigit "heart" == False
245−-}
246−any : (Char -> Bool) -> String -> Bool
247−any = Native.String.any
248−
249−{-| Determine whether *all* characters satisfy a predicate.
250−
251− all isDigit "90210" == True
252− all isDigit "R2-D2" == False
253− all isDigit "heart" == False
254−-}
255−all : (Char -> Bool) -> String -> Bool
256−all = Native.String.all
257−
258−{-| See if the second string contains the first one.
259−
260− contains "the" "theory" == True
261− contains "hat" "theory" == False
262− contains "THE" "theory" == False
263−
264−Use `Regex.contains` if you need something more flexible.
265−-}
266−contains : String -> String -> Bool
267−contains = Native.String.contains
268−
269−{-| See if the second string starts with the first one.
270−
271− startsWith "the" "theory" == True
272− startsWith "ory" "theory" == False
273−-}
274−startsWith : String -> String -> Bool
275−startsWith = Native.String.startsWith
276−
277−{-| See if the second string ends with the first one.
278−
279− endsWith "the" "theory" == False
280− endsWith "ory" "theory" == True
281−-}
282−endsWith : String -> String -> Bool
283−endsWith = Native.String.endsWith
284−
285−{-| Get all of the indexes for a substring in another string.
286−
287− indexes "i" "Mississippi" == [1,4,7,10]
288− indexes "ss" "Mississippi" == [2,5]
289− indexes "needle" "haystack" == []
290−-}
291−indexes : String -> String -> [Int]
292−indexes = Native.String.indexes
293−
294−{-| Alias for `indexes` -}
295−indices : String -> String -> [Int]
296−indices = Native.String.indexes
297−
298−{-| Turn any kind of value into a string.
299−
300− show 42 == "42"
301− show [1,2] == "[1,2]"
302−-}
303−show : a -> String
304−show = Native.Show.show
305−
306−{-| Try to convert a string into an int, failing on improperly formatted strings.
307−
308− toInt "123" == Just 123
309− toInt "-42" == Just -42
310− toInt "3.1" == Nothing
311− toInt "31a" == Nothing
312−-}
313−toInt : String -> Maybe Int
314−toInt = Native.String.toInt
315−
316−{-| Try to convert a string into a float, failing on improperly formatted strings.
317−
318− toFloat "123" == Just 123.0
319− toFloat "-42" == Just -42.0
320− toFloat "3.1" == Just 3.1
321− toFloat "31a" == Nothing
322−-}
323−toFloat : String -> Maybe Float
324−toFloat = Native.String.toFloat
325−
326−{-| Convert a string to a list of characters.
327−
328− toList "abc" == ['a','b','c']
329−-}
330−toList : String -> [Char]
331−toList = Native.String.toList
332−
333−{-| Convert a list of characters into a String. Can be useful if you
334−want to create a string primarly by consing, perhaps for decoding
335−something.
336−
337− fromList ['a','b','c'] == "abc"
338−-}
339−fromList : [Char] -> String
340−fromList = Native.String.fromList
libraries/Text.elmdeleted−218
@@ -1,218 +0,0 @@
1−module Text where
2−{-| A library for styling and displaying text. Whlie the `String` library
3−focuses on representing and manipulating strings of character strings, the
4−`Text` library focuses on how those strings should look on screen. It lets
5−you make text bold or italic, set the typeface, set the text size, etc.
6−
7−# Creating Text
8−@docs toText
9−
10−# Creating Elements
11−
12−Each of the following functions places `Text` into a box. The function you use
13−determines the alignment of the text.
14−
15−@docs leftAligned, rightAligned, centered, justified
16−
17−# Links and Style
18−@docs link, Style, style, defaultStyle, Line
19−
20−# Convenience Functions
21−
22−There are two convenience functions for creating an `Element` which can be
23−useful when debugging or prototyping:
24−
25−@docs plainText, asText
26−
27−There are also a bunch of functions to set parts of a `Style` individually:
28−
29−@docs typeface, monospace, height, color, bold, italic, line
30−
31−-}
32−
33−import Basics (..)
34−import String
35−import Color (Color, black)
36−import Graphics.Element (Element, Three, Pos, ElementPrim, Properties)
37−import Maybe (Maybe(Nothing))
38−import Native.Show
39−import Native.Text
40−
41−type Text = Text
42−
43−{-| Styles for lines on text. This allows you to add an underline, an overline,
44−or a strike out text:
45−
46− line Under (toText "underline")
47− line Over (toText "overline")
48− line Through (toText "strike out")
49−-}
50−type Line = Under | Over | Through
51−
52−{-| Represents all the ways you can style `Text`. If the `typeface` list is
53−empty or the `height` is `Nothing`, the users will fall back on their browser's
54−default settings. The following `Style` is black, 16 pixel tall, underlined, and
55−Times New Roman (assuming that typeface is available on the user's computer):
56−
57− { typeface = [ "Times New Roman", "serif" ]
58− , height = Just 16
59− , color = black
60− , bold = False
61− , italic = False
62− , line = Just Under
63− }
64−-}
65−type alias Style =
66− { typeface : [String]
67− , height : Maybe Float
68− , color : Color
69− , bold : Bool
70− , italic : Bool
71− , line : Maybe Line
72− }
73−
74−{-| Plain black text. It uses the browsers default typeface and text height.
75−No decorations are used.
76−
77− { typeface = []
78− , height = Nothing
79− , color = black
80− , bold = False
81− , italic = False
82− , line = Nothing
83− }
84−-}
85−defaultStyle : Style
86−defaultStyle =
87− { typeface = []
88− , height = Nothing
89− , color = black
90− , bold = False
91− , italic = False
92− , line = Nothing
93− }
94−
95−{-| Convert a string into text which can be styled and displayed. To show the
96−string `"Hello World!"` on screen in italics, you could say:
97−
98− main = leftAligned (italic (toText "Hello World!"))
99−-}
100−toText : String -> Text
101−toText = Native.Text.toText
102−
103−{-| Set the style of some text. For example, if you design a `Style` called
104−`footerStyle` that is specifically for the bottom of your page, you could apply
105−it to text like this:
106−
107− style footerStyle (toText "the old prince / 2007")
108−-}
109−style : Style -> Text -> Text
110−style = Native.Text.style
111−
112−{-| Provide a list of prefered typefaces for some text.
113−
114− ["helvetica","arial","sans-serif"]
115−
116−Not every browser has access to the same typefaces, so rendering will use the
117−first typeface in the list that is found on the user's computer. If there are
118−no matches, it will use their default typeface. This works the same as the CSS
119−font-family property.
120−-}
121−typeface : [String] -> Text -> Text
122−typeface = Native.Text.typeface
123−
124−{-| Switch to a monospace typeface. Good for code snippets.
125−
126− monospace (toText "foldl (+) 0 [1,2,3]")
127−-}
128−monospace : Text -> Text
129−monospace = Native.Text.monospace
130−
131−{-| Create a link by providing a URL and the text of the link.
132−
133− link "http://elm-lang.org" (toText "Elm Website")
134−-}
135−link : String -> Text -> Text
136−link = Native.Text.link
137−
138−{-| Set the height of some text.
139−
140− height 40 (toText "Title")
141−-}
142−height : Float -> Text -> Text
143−height = Native.Text.height
144−
145−{-| Set the color of some text.
146−
147− color red (toText "Red")
148−-}
149−color : Color -> Text -> Text
150−color = Native.Text.color
151−
152−{-| Make text bold.
153−
154− toText "sometimes you want " ++ bold (toText "emphasis")
155−-}
156−bold : Text -> Text
157−bold = Native.Text.bold
158−
159−{-| Make text italic.
160−
161− toText "make it " ++ italic (toText "important")
162−-}
163−italic : Text -> Text
164−italic = Native.Text.italic
165−
166−{-| Put lines on text.
167−
168− line Under (toText "underlined")
169− line Over (toText "overlined")
170− line Through (toText "strike out")
171−-}
172−line : Line -> Text -> Text
173−line = Native.Text.line
174−
175−{-| Align text along the left side of the text block. This is sometimes known as
176−*ragged right*.
177−-}
178−leftAligned : Text -> Element
179−leftAligned = Native.Text.leftAligned
180−
181−{-| Align text along the right side of the text block. This is sometimes known
182−as *ragged left*.
183−-}
184−rightAligned : Text -> Element
185−rightAligned = Native.Text.rightAligned
186−
187−{-| Center text in the text block. There is equal spacing on either side of a
188−line of text.
189−-}
190−centered : Text -> Element
191−centered = Native.Text.centered
192−
193−{-| Align text along the left and right sides of the text block. Word spacing is
194−adjusted to make this possible.
195−-}
196−justified : Text -> Element
197−justified = Native.Text.justified
198−
199−{-| Display a string with no styling.
200−
201− plainText string = leftAligned (toText string)
202−-}
203−plainText : String -> Element
204−plainText str =
205− leftAligned (toText str)
206−
207−{-| for internal use only -}
208−markdown : Element
209−markdown = Native.Text.markdown
210−
211−{-| Convert anything to its textual representation and make it displayable in
212−the browser. Excellent for debugging.
213−
214− asText value = leftAligned (monospace (toText (show value)))
215−-}
216−asText : a -> Element
217−asText value =
218− leftAligned (monospace (toText (Native.Show.show value)))
libraries/Time.elmdeleted−99
@@ -1,99 +0,0 @@
1−module Time where
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−
17−import Basics (..)
18−import Native.Time
19−import Signal (Signal)
20−
21−{-| Type alias to make it clearer when you are working with time values.
22−Using the `Time` constants instead of raw numbers is very highly recommended.
23−-}
24−type alias Time = Float
25−
26−{-| Units of time, making it easier to specify things like a half-second
27−`(500 * milliseconds)` without remembering Elm&rsquo;s underlying units of time.
28−-}
29−millisecond : Time
30−millisecond = 1
31−
32−second : Time
33−second = 1000 * millisecond
34−
35−minute : Time
36−minute = 60 * second
37−
38−hour : Time
39−hour = 60 * minute
40−
41−inMilliseconds : Time -> Float
42−inMilliseconds t = t
43−
44−inSeconds : Time -> Float
45−inSeconds t = t / second
46−
47−inMinutes : Time -> Float
48−inMinutes t = t / minute
49−
50−inHours : Time -> Float
51−inHours t = t / hour
52−
53−{-| Takes desired number of frames per second (fps). The resulting signal
54−gives a sequence of time deltas as quickly as possible until it reaches
55−the desired FPS. A time delta is the time between the last frame and the
56−current frame.
57−-}
58−fps : number -> Signal Time
59−fps = Native.Time.fps
60−
61−{-| Same as the fps function, but you can turn it on and off. Allows you
62−to do brief animations based on user input without major inefficiencies.
63−The first time delta after a pause is always zero, no matter how long
64−the pause was. This way summing the deltas will actually give the amount
65−of time that the output signal has been running.
66−-}
67−fpsWhen : number -> Signal Bool -> Signal Time
68−fpsWhen = Native.Time.fpsWhen
69−
70−{-| Takes a time interval t. The resulting signal is the current time, updated
71−every t.
72−-}
73−every : Time -> Signal Time
74−every = Native.Time.every
75−
76−{-| Takes a time `t` and any signal. The resulting boolean signal is true for
77−time `t` after every event on the input signal. So ``(second `since`
78−Mouse.clicks)`` would result in a signal that is true for one second after
79−each mouse click and false otherwise.
80−-}
81−since : Time -> Signal a -> Signal Bool
82−since = Native.Time.since
83−
84−{-| Add a timestamp to any signal. Timestamps increase monotonically. When you
85−create `(timestamp Mouse.x)`, an initial timestamp is produced. The timestamp
86−updates whenever `Mouse.x` updates.
87−
88−Timestamp updates are tied to individual events, so
89−`(timestamp Mouse.x)` and `(timestamp Mouse.y)` will always have the same
90−timestamp because they rely on the same underlying event (`Mouse.position`).
91−-}
92−timestamp : Signal a -> Signal (Time, a)
93−timestamp = Native.Time.timestamp
94−
95−{-| Delay a signal by a certain amount of time. So `(delay second Mouse.clicks)`
96−will update one second later than any mouse click.
97−-}
98−delay : Time -> Signal a -> Signal a
99−delay = Native.Time.delay
libraries/Touch.elmdeleted−41
@@ -1,41 +0,0 @@
1−module Touch where
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−
13−import Signal (Signal)
14−import Native.Touch
15−import Time (Time)
16−
17−{-| Every `Touch` has `xy` coordinates. It also has an identifier
18−`id` to distinguish one touch from another.
19−
20−A touch also keeps info about the initial point and time of contact:
21−`x0`, `y0`, and `t0`. This helps compute more complicated gestures
22−like taps, drags, and swipes which need to know about timing or direction.
23−-}
24−type alias Touch =
25− { x:Int
26− , y:Int
27− , id:Int
28− , x0:Int
29− , y0:Int
30− , t0:Time
31− }
32−
33−{-| A list of ongoing touches. -}
34−touches : Signal [Touch]
35−touches = Native.Touch.touches
36−
37−{-| The last position that was tapped. Default value is `{x=0,y=0}`.
38−Updates whenever the user taps the screen.
39−-}
40−taps : Signal { x:Int, y:Int }
41−taps = Native.Touch.taps
libraries/Trampoline.elmdeleted−51
@@ -1,51 +0,0 @@
1−module Trampoline where
2−{-| A [trampoline](http://en.wikipedia.org/wiki/Tail-recursive_function#Through_trampolining)
3−makes it possible to recursively call a function without growing the stack.
4−
5−Popular JavaScript implementations do not perform any tail-call elimination, so
6−recursive functions can cause a stack overflow if they go to deep. Trampolines
7−permit unbounded recursion despite limitations in JavaScript.
8−
9−This strategy may create many intermediate closures, which is very expensive in
10−JavaScript, so use this library only when it is essential that you recurse deeply.
11−
12−# Trampolines
13−@docs trampoline, Trampoline
14−-}
15−
16−import Native.Trampoline
17−
18−{-| A way to build computations that may be deeply recursive. We will take an
19−example of a tail-recursive function and rewrite it in a way that lets us use
20−a trampoline:
21−
22− length : [a] -> Int
23− length list = length' 0 list
24−
25− length' : Int -> [a] -> Int
26− length' accum list =
27− case list of
28− [] -> accum
29− hd::tl -> length' (accum+1) tl
30−
31−This finds the length of a list, but if the list is too long, it may cause a
32−stack overflow. We can rewrite it as follows:
33−
34− length : [a] -> Int
35− length list = trampoline (length' 0 list)
36−
37− length' : Int -> [a] -> Trampoline Int
38− length' accum list =
39− case list of
40− [] -> Done accum
41− hd::tl -> Continue (\() -> length' (accum+1) tl)
42−
43−Now it uses a trampoline and can recurse without growing the stack!
44−-}
45−type Trampoline a
46− = Done a
47− | Continue (() -> Trampoline a)
48−
49−{-| Evaluate a trampolined value in constant space. -}
50−trampoline : Trampoline a -> a
51−trampoline = Native.Trampoline.trampoline
libraries/Transform2D.elmdeleted−98
@@ -1,98 +0,0 @@
1−module Transform2D ( Transform2D
2− , identity, matrix, multiply
3− , rotation, translation
4− , scale, scaleX, scaleY
5− ) where
6−{-| A library for performing [2D matrix transformations][affine].
7−It is used primarily with the `groupTransform` function from `Graphics.Collage` and
8−allows you to do things like rotation, scaling, translation, shearing, and reflection.
9−
10−Note that all the matrices in this library are 3x3 matrices of homogeneous
11−coordinates, used for [affine transformations][affine]. Since the bottom row as
12−always `0 0 1` in these matrices, it is omitted in the diagrams below.
13−
14− [affine]: http://en.wikipedia.org/wiki/Transformation_matrix#Affine_transformations
15−
16−# Transforms
17−@docs identity, matrix, rotation, translation, scale, scaleX, scaleY
18−
19−# Multiplication
20−@docs multiply
21−-}
22−
23−import Native.Transform2D
24−
25−type Transform2D = Transform2D
26−
27−{-| Create an identity transform. Transforming by the identity does
28−not change anything, but it can come in handy as a default or
29−base case.
30−
31− / 1 0 0 \
32− \ 0 1 0 /
33−-}
34−identity : Transform2D
35−identity = Native.Transform2D.identity
36−
37−{-| Create a transformation matrix. This lets you create transforms
38−such as scales, shears, reflections, and translations.
39−
40− matrix a b c d x y
41−
42− / a b x \
43− \ c d y /
44−
45−Note that `x` and `y` are the translation values.
46−-}
47−matrix : Float -> Float -> Float -> Float -> Float -> Float -> Transform2D
48−matrix = Native.Transform2D.matrix
49−
50−{-| Create a [rotation matrix](http://en.wikipedia.org/wiki/Rotation_matrix).
51−Given an angle t, it creates a counterclockwise rotation matrix:
52−
53− rotation t
54−
55− / cos t -sin t 0 \
56− \ sin t cos t 0 /
57−-}
58−rotation : Float -> Transform2D
59−rotation = Native.Transform2D.rotation
60−
61−{-| Create a transformation matrix for translation.
62−
63− translation x y
64−
65− / 1 0 x \
66− \ 0 1 y /
67−-}
68−translation : Float -> Float -> Transform2D
69−translation x y = matrix 1 0 0 1 x y
70−
71−{-| Creates a transformation matrix for scaling by a all directions.
72−
73− scale s
74−
75− / s 0 0 \
76− \ 0 s 0 /
77−-}
78−scale : Float -> Transform2D
79−scale s = matrix s 0 0 s 0 0
80−
81−{-| Create a transformation for horizontal scaling. -}
82−scaleX : Float -> Transform2D
83−scaleX x = matrix x 0 0 1 0 0
84−
85−{-| Create a transformation for vertical scaling. -}
86−scaleY : Float -> Transform2D
87−scaleY y = matrix 1 0 0 y 0 0
88−
89−{-| Multiply two transforms together.
90−
91− multiply m n
92−
93− / ma mb mx \ / na nb nx \
94− | mc md my | . | nc nd ny |
95− \ 0 0 1 / \ 0 0 1 /
96−-}
97−multiply : Transform2D -> Transform2D -> Transform2D
98−multiply = Native.Transform2D.multiply
libraries/WebSocket.elmdeleted−21
@@ -1,21 +0,0 @@
1−module 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−-}
9−
10−import Signal (Signal)
11−import Native.WebSocket
12−
13−{-| Create a web-socket. The first argument is the URL of the desired
14−web-socket server. The input signal holds the outgoing messages,
15−and the resulting signal contains the incoming ones.
16−-}
17−connect : String -> Signal String -> Signal String
18−connect = Native.WebSocket.connect
19−
20−-- data Action = Open String | Close String | Send String String
21−-- connections : Signal Action -> Signal String
libraries/Window.elmdeleted−27
@@ -1,27 +0,0 @@
1−
2−module 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−
13−import Signal (Signal)
14−import Native.Window
15−
16−{-| The current width and height of the window (i.e. the area viewable to the
17−user, not including scroll bars). -}
18−dimensions : Signal (Int,Int)
19−dimensions = Native.Window.dimensions
20−
21−{-| The current width of the window. -}
22−width : Signal Int
23−width = Native.Window.width
24−
25−{-| The current height of the window. -}
26−height : Signal Int
27−height = Native.Window.height
libraries/elm_dependencies.jsondeleted−42
@@ -1,42 +0,0 @@
1−{ "version": "0.13"
2−, "summary": "Elm's standard libraries"
3−, "description": "The full set of standard libraries for Elm. This library is pegged to the version number of the compiler, so if you are using Elm 0.13, you should be using version 0.13 of the standard libraries."
4−, "license": "BSD3"
5−, "repository": "http://github.com/elm-lang/Elm.git"
6−, "elm-version": "0.13"
7−, "dependencies": {}
8−, "exposed-modules":
9− [ "Array"
10− , "Basics"
11− , "Bitwise"
12− , "Char"
13− , "Color"
14− , "Date"
15− , "Debug"
16− , "Dict"
17− , "Either"
18− , "Graphics.Element"
19− , "Graphics.Collage"
20− , "Graphics.Input"
21− , "Graphics.Input.Field"
22− , "Http"
23− , "JavaScript.Experimental"
24− , "Json"
25− , "Keyboard"
26− , "List"
27− , "Maybe"
28− , "Mouse"
29− , "Random"
30− , "Regex"
31− , "Set"
32− , "Signal"
33− , "String"
34− , "Text"
35− , "Time"
36− , "Touch"
37− , "Trampoline"
38− , "Transform2D"
39− , "WebSocket"
40− , "Window"
41− ]
42−}
runtime/Render/Collage.jsdeleted−355
@@ -1,355 +0,0 @@
1−
2−ElmRuntime.Render.Collage = function() {
3−
4−var Render = ElmRuntime.use(ElmRuntime.Render.Element);
5−var Transform = Elm.Transform2D.make({});
6−var Utils = ElmRuntime.use(ElmRuntime.Render.Utils);
7−var newElement = Utils.newElement,
8− colorToCss = Utils.colorToCss, fromList = Utils.fromList,
9− fromString = Utils.fromString, addTransform = Utils.addTransform;
10−
11−function trace(ctx, path) {
12− var points = fromList(path);
13− var i = points.length - 1;
14− if (i <= 0) return;
15− ctx.moveTo(points[i]._0, points[i]._1);
16− while (i--) { ctx.lineTo(points[i]._0, points[i]._1); }
17− if (path.closed) {
18− i = points.length - 1;
19− ctx.lineTo(points[i]._0, points[i]._1);
20− }
21−}
22−
23−function line(ctx,style,path) {
24− style.dashing.ctor === '[]' ? trace(ctx, path) : customLineHelp(ctx, style, path);
25− ctx.scale(1,-1);
26− ctx.stroke();
27−}
28−
29−function customLineHelp(ctx, style, path) {
30− var points = fromList(path);
31− if (path.closed) points.push(points[0]);
32− var pattern = fromList(style.dashing);
33− var i = points.length - 1;
34− if (i <= 0) return;
35− var x0 = points[i]._0, y0 = points[i]._1;
36− var x1=0, y1=0, dx=0, dy=0, remaining=0, nx=0, ny=0;
37− var pindex = 0, plen = pattern.length;
38− var draw = true, segmentLength = pattern[0];
39− ctx.moveTo(x0,y0);
40− while (i--) {
41− x1 = points[i]._0; y1 = points[i]._1;
42− dx = x1 - x0; dy = y1 - y0;
43− remaining = Math.sqrt(dx * dx + dy * dy);
44− while (segmentLength <= remaining) {
45− x0 += dx * segmentLength / remaining;
46− y0 += dy * segmentLength / remaining;
47− ctx[draw ? 'lineTo' : 'moveTo'](x0, y0);
48− // update starting position
49− dx = x1 - x0; dy = y1 - y0;
50− remaining = Math.sqrt(dx * dx + dy * dy);
51− // update pattern
52− draw = !draw;
53− pindex = (pindex + 1) % plen;
54− segmentLength = pattern[pindex];
55− }
56− if (remaining > 0) {
57− ctx[draw ? 'lineTo' : 'moveTo'](x1, y1);
58− segmentLength -= remaining;
59− }
60− x0 = x1; y0 = y1;
61− }
62−}
63−
64−function drawLine(ctx, style, path) {
65− ctx.lineWidth = style.width;
66− var cap = style.cap.ctor;
67− ctx.lineCap = cap === 'Flat' ? 'butt' :
68− cap === 'Round' ? 'round' : 'square';
69− var join = style.join.ctor;
70− ctx.lineJoin = join === 'Smooth' ? 'round' :
71− join === 'Sharp' ? 'miter' : 'bevel';
72− ctx.miterLimit = style.join._0 || 10;
73− ctx.strokeStyle = colorToCss(style.color);
74− return line(ctx, style, path);
75−}
76−
77−function texture(redo, ctx, src) {
78− var img = new Image();
79− img.src = fromString(src);
80− img.onload = redo;
81− return ctx.createPattern(img, 'repeat');
82−}
83−
84−function gradient(ctx, grad) {
85− var g;
86− var stops = [];
87− if (grad.ctor === 'Linear') {
88− var p0 = grad._0, p1 = grad._1;
89− g = ctx.createLinearGradient(p0._0, -p0._1, p1._0, -p1._1);
90− stops = fromList(grad._2);
91− } else {
92− var p0 = grad._0, p2 = grad._2;
93− g = ctx.createRadialGradient(p0._0, -p0._1, grad._1, p2._0, -p2._1, grad._3);
94− stops = fromList(grad._4);
95− }
96− var len = stops.length;
97− for (var i = 0; i < len; ++i) {
98− var stop = stops[i];
99− g.addColorStop(stop._0, colorToCss(stop._1));
100− }
101− return g;
102−}
103−
104−function drawShape(redo, ctx, style, path) {
105− trace(ctx, path);
106− var sty = style.ctor;
107− ctx.fillStyle =
108− sty === 'Solid' ? colorToCss(style._0) :
109− sty === 'Texture' ? texture(redo, ctx, style._0) : gradient(ctx, style._0);
110− ctx.scale(1,-1);
111− ctx.fill();
112−}
113−
114−function drawImage(redo, ctx, form) {
115− var img = new Image();
116− img.onload = redo;
117− img.src = fromString(form._3);
118− var w = form._0,
119− h = form._1,
120− pos = form._2,
121− srcX = pos._0,
122− srcY = pos._1,
123− srcW = w,
124− srcH = h,
125− destX = -w/2,
126− destY = -h/2,
127− destW = w,
128− destH = h;
129−
130− ctx.scale(1,-1);
131− ctx.drawImage(img, srcX, srcY, srcW, srcH, destX, destY, destW, destH);
132−}
133−
134−function renderForm(redo, ctx, form) {
135− ctx.save();
136− var x = form.x, y = form.y, theta = form.theta, scale = form.scale;
137− if (x !== 0 || y !== 0) ctx.translate(x, y);
138− if (theta !== 0) ctx.rotate(theta);
139− if (scale !== 1) ctx.scale(scale,scale);
140− if (form.alpha !== 1) ctx.globalAlpha = ctx.globalAlpha * form.alpha;
141− ctx.beginPath();
142− var f = form.form;
143− switch(f.ctor) {
144− case 'FPath' : drawLine(ctx, f._0, f._1); break;
145− case 'FImage': drawImage(redo, ctx, f); break;
146− case 'FShape':
147− if (f._0.ctor === 'Left') {
148− f._1.closed = true;
149− drawLine(ctx, f._0._0, f._1);
150− } else {
151− drawShape(redo, ctx, f._0._0, f._1);
152− }
153− break;
154− }
155− ctx.restore();
156−}
157−
158−function formToMatrix(form) {
159− var scale = form.scale;
160− var matrix = A6( Transform.matrix, scale, 0, 0, scale, form.x, form.y );
161−
162− var theta = form.theta
163− if (theta !== 0)
164− matrix = A2( Transform.multiply, matrix, Transform.rotation(theta) );
165−
166− return matrix;
167−}
168−
169−function str(n) {
170− if (n < 0.00001 && n > -0.00001) return 0;
171− return n;
172−}
173−
174−function makeTransform(w, h, form, matrices) {
175− var props = form.form._0.props;
176− var m = A6( Transform.matrix, 1, 0, 0, -1,
177− (w - props.width ) / 2,
178− (h - props.height) / 2 );
179− var len = matrices.length;
180− for (var i = 0; i < len; ++i) { m = A2( Transform.multiply, m, matrices[i] ); }
181− m = A2( Transform.multiply, m, formToMatrix(form) );
182−
183− return 'matrix(' + str( m[0]) + ', ' + str( m[3]) + ', ' +
184− str(-m[1]) + ', ' + str(-m[4]) + ', ' +
185− str( m[2]) + ', ' + str( m[5]) + ')';
186−}
187−
188−function stepperHelp(list) {
189− var arr = fromList(list);
190− var i = 0;
191− function peekNext() {
192− return i < arr.length ? arr[i].form.ctor : '';
193− }
194− // assumes that there is a next element
195− function next() {
196− var out = arr[i];
197− ++i;
198− return out;
199− }
200− return { peekNext:peekNext, next:next };
201−}
202−
203−function formStepper(forms) {
204− var ps = [stepperHelp(forms)];
205− var matrices = [];
206− var alphas = [];
207− function peekNext() {
208− var len = ps.length;
209− var formType = '';
210− for (var i = 0; i < len; ++i ) {
211− if (formType = ps[i].peekNext()) return formType;
212− }
213− return '';
214− }
215− // assumes that there is a next element
216− function next(ctx) {
217− while (!ps[0].peekNext()) {
218− ps.shift();
219− matrices.pop();
220− alphas.shift();
221− if (ctx) { ctx.restore(); }
222− }
223− var out = ps[0].next();
224− var f = out.form;
225− if (f.ctor === 'FGroup') {
226− ps.unshift(stepperHelp(f._1));
227− var m = A2(Transform.multiply, f._0, formToMatrix(out));
228− ctx.save();
229− ctx.transform(m[0], m[3], m[1], m[4], m[2], m[5]);
230− matrices.push(m);
231−
232− var alpha = (alphas[0] || 1) * out.alpha;
233− alphas.unshift(alpha);
234− ctx.globalAlpha = alpha;
235− }
236− return out;
237− }
238− function transforms() { return matrices; }
239− function alpha() { return alphas[0] || 1; }
240− return { peekNext:peekNext, next:next, transforms:transforms, alpha:alpha };
241−}
242−
243−function makeCanvas(w,h) {
244− var canvas = newElement('canvas');
245− canvas.style.width = w + 'px';
246− canvas.style.height = h + 'px';
247− canvas.style.display = "block";
248− canvas.style.position = "absolute";
249− canvas.width = w;
250− canvas.height = h;
251− return canvas;
252−}
253−
254−function render(model) {
255− var div = newElement('div');
256− div.style.overflow = 'hidden';
257− div.style.position = 'relative';
258− update(div, model, model);
259− return div;
260−}
261−
262−function nodeStepper(w,h,div) {
263− var kids = div.childNodes;
264− var i = 0;
265− function transform(transforms, ctx) {
266− ctx.translate(w/2, h/2);
267− ctx.scale(1,-1);
268− var len = transforms.length;
269− for (var i = 0; i < len; ++i) {
270− var m = transforms[i];
271− ctx.save();
272− ctx.transform(m[0], m[3], m[1], m[4], m[2], m[5]);
273− }
274− return ctx;
275− }
276− function nextContext(transforms) {
277− while (i < kids.length) {
278− var node = kids[i];
279− if (node.getContext) {
280− node.width = w;
281− node.height = h;
282− node.style.width = w + 'px';
283− node.style.height = h + 'px';
284− ++i;
285− return transform(transforms, node.getContext('2d'));
286− }
287− div.removeChild(node);
288− }
289− var canvas = makeCanvas(w,h);
290− div.appendChild(canvas);
291− // we have added a new node, so we must step our position
292− ++i;
293− return transform(transforms, canvas.getContext('2d'));
294− }
295− function addElement(matrices, alpha, form) {
296− var kid = kids[i];
297− var elem = form.form._0;
298−
299− var node = (!kid || kid.getContext)
300− ? Render.render(elem)
301− : (Render.update(kid, kid.oldElement, elem), kids[i]);
302−
303− node.style.position = 'absolute';
304− node.style.opacity = alpha * form.alpha * elem.props.opacity;
305− addTransform(node.style, makeTransform(w, h, form, matrices));
306− node.oldElement = elem;
307− ++i;
308− if (!kid) {
309− div.appendChild(node);
310− } else if (kid.getContext) {
311− div.insertBefore(node, kid);
312− }
313− }
314− function clearRest() {
315− while (i < kids.length) {
316− div.removeChild(kids[i]);
317− }
318− }
319− return { nextContext:nextContext, addElement:addElement, clearRest:clearRest };
320−}
321−
322−
323−function update(div, _, model) {
324− var w = model.w;
325− var h = model.h;
326−
327− var forms = formStepper(model.forms);
328− var nodes = nodeStepper(w,h,div);
329− var ctx = null;
330− var formType = '';
331−
332− while (formType = forms.peekNext()) {
333− // make sure we have context if we need it
334− if (ctx === null && formType !== 'FElement') {
335− ctx = nodes.nextContext(forms.transforms());
336− ctx.globalAlpha = forms.alpha();
337− }
338−
339− var form = forms.next(ctx);
340− // if it is FGroup, all updates are made within formStepper when next is called.
341− if (formType === 'FElement') {
342− // update or insert an element, get a new context
343− nodes.addElement(forms.transforms(), forms.alpha(), form);
344− ctx = null;
345− } else if (formType !== 'FGroup') {
346− renderForm(function() { update(div, model, model); }, ctx, form);
347− }
348− }
349− nodes.clearRest();
350− return false;
351−}
352−
353−return { render:render, update:update };
354−
355−};
runtime/Render/Element.jsdeleted−469
@@ -1,469 +0,0 @@
1−
2−ElmRuntime.Render.Element = function() {
3−'use strict';
4−
5−var Utils = ElmRuntime.use(ElmRuntime.Render.Utils);
6−var newElement = Utils.newElement;
7−var colorToCss = Utils.colorToCss;
8−var addTransform = Utils.addTransform;
9−var removeTransform = Utils.removeTransform;
10−var fromList = Utils.fromList;
11−var eq = Utils.eq;
12−
13−function setProps(elem, node) {
14− var props = elem.props;
15−
16− var element = elem.element;
17− var width = props.width - (element.adjustWidth || 0);
18− var height = props.height - (element.adjustHeight || 0);
19− node.style.width = (width |0) + 'px';
20− node.style.height = (height|0) + 'px';
21−
22− if (props.opacity !== 1) {
23− node.style.opacity = props.opacity;
24− }
25−
26− if (props.color.ctor === 'Just') {
27− node.style.backgroundColor = colorToCss(props.color._0);
28− }
29−
30− if (props.tag !== '') {
31− node.id = props.tag;
32− }
33−
34− if (props.hover.ctor !== '_Tuple0') {
35− addHover(node, props.hover);
36− }
37−
38− if (props.click.ctor !== '_Tuple0') {
39− addClick(node, props.click);
40− }
41−
42− if (props.href !== '') {
43− var anchor = newElement('a');
44− anchor.href = props.href;
45− anchor.style.display = 'block';
46− anchor.style.pointerEvents = 'auto';
47− anchor.appendChild(node);
48− node = anchor;
49− }
50−
51− return node;
52−}
53−
54−function addClick(e, handler) {
55− e.style.pointerEvents = 'auto';
56− e.elm_click_handler = handler;
57− function trigger(ev) {
58− e.elm_click_handler(Utils.Tuple0);
59− ev.stopPropagation();
60− }
61− e.elm_click_trigger = trigger;
62− e.addEventListener('click', trigger);
63−}
64−
65−function removeClick(e, handler) {
66− if (e.elm_click_trigger) {
67− e.removeEventListener('click', e.elm_click_trigger);
68− e.elm_click_trigger = null;
69− e.elm_click_handler = null;
70− }
71−}
72−
73−function addHover(e, handler) {
74− e.style.pointerEvents = 'auto';
75− e.elm_hover_handler = handler;
76− e.elm_hover_count = 0;
77−
78− function over(evt) {
79− if (e.elm_hover_count++ > 0) return;
80− e.elm_hover_handler(true);
81− evt.stopPropagation();
82− }
83− function out(evt) {
84− if (e.contains(evt.toElement || evt.relatedTarget)) return;
85− e.elm_hover_count = 0;
86− e.elm_hover_handler(false);
87− evt.stopPropagation();
88− }
89− e.elm_hover_over = over;
90− e.elm_hover_out = out;
91− e.addEventListener('mouseover', over);
92− e.addEventListener('mouseout', out);
93−}
94−
95−function removeHover(e) {
96− e.elm_hover_handler = null;
97− if (e.elm_hover_over) {
98− e.removeEventListener('mouseover', e.elm_hover_over);
99− e.elm_hover_over = null;
100− }
101− if (e.elm_hover_out) {
102− e.removeEventListener('mouseout', e.elm_hover_out);
103− e.elm_hover_out = null;
104− }
105−}
106−
107−function image(props, img) {
108− switch (img._0.ctor) {
109− case 'Plain': return plainImage(img._3);
110− case 'Fitted': return fittedImage(props.width, props.height, img._3);
111− case 'Cropped': return croppedImage(img,props.width,props.height,img._3);
112− case 'Tiled': return tiledImage(img._3);
113− }
114−}
115−
116−function plainImage(src) {
117− var img = newElement('img');
118− img.src = src;
119− img.name = src;
120− img.style.display = "block";
121− return img;
122−}
123−
124−function tiledImage(src) {
125− var div = newElement('div');
126− div.style.backgroundImage = 'url(' + src + ')';
127− return div;
128−}
129−
130−function fittedImage(w, h, src) {
131− var div = newElement('div');
132− div.style.background = 'url(' + src + ') no-repeat center';
133− div.style.webkitBackgroundSize = 'cover';
134− div.style.MozBackgroundSize = 'cover';
135− div.style.OBackgroundSize = 'cover';
136− div.style.backgroundSize = 'cover';
137− return div;
138−}
139−
140−function croppedImage(elem, w, h, src) {
141− var pos = elem._0._0;
142− var e = newElement('div');
143− e.style.overflow = "hidden";
144−
145− var img = newElement('img');
146− img.onload = function() {
147− var sw = w / elem._1, sh = h / elem._2;
148− img.style.width = ((this.width * sw)|0) + 'px';
149− img.style.height = ((this.height * sh)|0) + 'px';
150− img.style.marginLeft = ((- pos._0 * sw)|0) + 'px';
151− img.style.marginTop = ((- pos._1 * sh)|0) + 'px';
152− };
153− img.src = src;
154− img.name = src;
155− e.appendChild(img);
156− return e;
157−}
158−
159−function goOut(e) { e.style.position = 'absolute'; return e; }
160−function goDown(e) { return e }
161−function goRight(e) { e.style.styleFloat = e.style.cssFloat = "left"; return e; }
162−
163−var directionTable = {
164− DUp : goDown,
165− DDown : goDown,
166− DLeft : goRight,
167− DRight : goRight,
168− DIn : goOut,
169− DOut : goOut
170−};
171−function needsReversal(dir) {
172− return dir == 'DUp' || dir == 'DLeft' || dir == 'DIn';
173−}
174−
175−function flow(dir,elist) {
176− var array = fromList(elist);
177− var container = newElement('div');
178− var goDir = directionTable[dir];
179− if (goDir == goOut) {
180− container.style.pointerEvents = 'none';
181− }
182− if (needsReversal(dir)) {
183− array.reverse();
184− }
185− var len = array.length;
186− for (var i = 0; i < len; ++i) {
187− container.appendChild(goDir(render(array[i])));
188− }
189− return container;
190−}
191−
192−function toPos(pos) {
193− switch(pos.ctor) {
194− case "Absolute": return pos._0 + "px";
195− case "Relative": return (pos._0 * 100) + "%";
196− }
197−}
198−
199−// must clear right, left, top, bottom, and transform
200−// before calling this function
201−function setPos(pos,elem,e) {
202− var element = elem.element;
203− var props = elem.props;
204− var w = props.width + (element.adjustWidth ? element.adjustWidth : 0);
205− var h = props.height + (element.adjustHeight ? element.adjustHeight : 0);
206−
207− e.style.position = 'absolute';
208− e.style.margin = 'auto';
209− var transform = '';
210− switch(pos.horizontal.ctor) {
211− case 'P': e.style.right = toPos(pos.x); e.style.removeProperty('left'); break;
212− case 'Z': transform = 'translateX(' + ((-w/2)|0) + 'px) ';
213− case 'N': e.style.left = toPos(pos.x); e.style.removeProperty('right'); break;
214− }
215− switch(pos.vertical.ctor) {
216− case 'N': e.style.bottom = toPos(pos.y); e.style.removeProperty('top'); break;
217− case 'Z': transform += 'translateY(' + ((-h/2)|0) + 'px)';
218− case 'P': e.style.top = toPos(pos.y); e.style.removeProperty('bottom'); break;
219− }
220− if (transform !== '') addTransform(e.style, transform);
221− return e;
222−}
223−
224−function container(pos,elem) {
225− var e = render(elem);
226− setPos(pos, elem, e);
227− var div = newElement('div');
228− div.style.position = 'relative';
229− div.style.overflow = 'hidden';
230− div.appendChild(e);
231− return div;
232−}
233−
234−function rawHtml(elem) {
235− var html = elem.html;
236− var args = elem.args;
237− var guid = elem.guid;
238− var align = elem.align;
239−
240− var div = newElement('div');
241− div.innerHTML = html;
242− div.style.visibility = "hidden";
243− if (align) div.style.textAlign = align;
244− document.body.appendChild(div);
245−
246− for (var i = args.length; i--; ) {
247− var arg = args[i];
248− var span = document.getElementById('md-' + guid + '-' + i);
249− if (arg.isText) {
250− span.innerHTML = arg;
251− } else {
252− span.style.display = 'block';
253− span.style.width = arg.props.width + 'px';
254− span.style.height = arg.props.height + 'px';
255− span.appendChild(render(arg));
256− }
257− }
258− document.body.removeChild(div);
259− div.style.visibility = 'visible';
260− div.style.pointerEvents = 'auto';
261− return div;
262−}
263−
264−function render(elem) {
265− return setProps(elem, makeElement(elem));
266−}
267−function makeElement(e) {
268− var elem = e.element;
269− switch(elem.ctor) {
270− case 'Image': return image(e.props, elem);
271− case 'Flow': return flow(elem._0.ctor, elem._1);
272− case 'Container': return container(elem._0, elem._1);
273− case 'Spacer': return newElement('div');
274− case 'RawHtml': return rawHtml(elem);
275− case 'Custom': return elem.render(elem.model);
276− }
277−}
278−
279−function update(node, curr, next) {
280− if (node.tagName === 'A') {
281− node = node.firstChild;
282− }
283− if (curr.props.id === next.props.id) {
284− return updateProps(node, curr, next);
285− }
286− if (curr.element.ctor !== next.element.ctor) {
287− node.parentNode.replaceChild(render(next),node);
288− return true;
289− }
290− var nextE = next.element, currE = curr.element;
291− switch(nextE.ctor) {
292− case "Spacer": break;
293− case "RawHtml":
294− // only markdown blocks have guids, so this must be a text block
295− if (nextE.guid === null) {
296− if(currE.html.valueOf() !== nextE.html.valueOf()) {
297− node.innerHTML = nextE.html;
298− }
299− break;
300− }
301− if (nextE.guid !== currE.guid) {
302− node.parentNode.replaceChild(render(next),node);
303− return true;
304− }
305− var nargs = nextE.args;
306− var cargs = currE.args;
307− for (var i = nargs.length; i--; ) {
308− var narg = nargs[i];
309− var carg = cargs[i]
310− if (narg == carg) continue;
311− var span = document.getElementById('md-' + currE.guid + '-' + i);
312− if (narg.isElement) {
313− if (carg.isElement) {
314− update(span, carg, narg);
315− } else {
316− span.style.display = 'block';
317− var e = render(narg);
318− span.innerHTML = '';
319− span.appendChild(e);
320− }
321− } else {
322− span.style.display = 'inline';
323− span.innerHTML = narg;
324− }
325− }
326− break;
327− case "Image":
328− if (nextE._0.ctor === 'Plain') {
329− if (nextE._3 !== currE._3) node.src = nextE._3;
330− } else if (!eq(nextE,currE) ||
331− next.props.width !== curr.props.width ||
332− next.props.height !== curr.props.height) {
333− node.parentNode.replaceChild(render(next),node);
334− return true;
335− }
336− break;
337− case "Flow":
338− var arr = fromList(nextE._1);
339− for (var i = arr.length; i--; ) { arr[i] = arr[i].element.ctor; }
340− if (nextE._0.ctor !== currE._0.ctor) {
341− node.parentNode.replaceChild(render(next),node);
342− return true;
343− }
344− var nexts = fromList(nextE._1);
345− var kids = node.childNodes;
346− if (nexts.length !== kids.length) {
347− node.parentNode.replaceChild(render(next),node);
348− return true;
349− }
350− var currs = fromList(currE._1);
351− var dir = nextE._0.ctor;
352− var goDir = directionTable[dir];
353− var toReverse = needsReversal(dir);
354− var len = kids.length;
355− for (var i = len; i-- ;) {
356− update(kids[toReverse ? len - i - 1 : i],currs[i],nexts[i]);
357− goDir(kids[i]);
358− }
359− break;
360− case "Container":
361− update(node.firstChild, currE._1, nextE._1);
362− setPos(nextE._0, nextE._1, node.firstChild);
363− break;
364− case "Custom":
365− if (currE.type === nextE.type) {
366− var done = nextE.update(node, currE.model, nextE.model);
367− if (done) return;
368− } else {
369− return node.parentNode.replaceChild(render(next), node);
370− }
371− }
372− updateProps(node, curr, next);
373−}
374−
375−function updateProps(node, curr, next) {
376− var nextProps = next.props;
377− var currProps = curr.props;
378−
379− var element = next.element;
380− var width = nextProps.width - (element.adjustWidth || 0);
381− var height = nextProps.height - (element.adjustHeight || 0);
382− if (width !== currProps.width) {
383− node.style.width = (width|0) + 'px';
384− }
385− if (height !== currProps.height) {
386− node.style.height = (height|0) + 'px';
387− }
388−
389− if (nextProps.opacity !== currProps.opacity) {
390− node.style.opacity = nextProps.opacity;
391− }
392−
393− var nextColor = nextProps.color.ctor === 'Just'
394− ? colorToCss(nextProps.color._0)
395− : '';
396− if (node.style.backgroundColor !== nextColor) {
397− node.style.backgroundColor = nextColor;
398− }
399−
400− if (nextProps.tag !== currProps.tag) {
401− node.id = nextProps.tag;
402− }
403−
404− if (nextProps.href !== currProps.href) {
405− if (currProps.href === '') {
406− // add a surrounding href
407− var anchor = newElement('a');
408− anchor.href = nextProps.href;
409− anchor.style.display = 'block';
410− anchor.style.pointerEvents = 'auto';
411−
412− node.parentNode.replaceChild(anchor, node);
413− anchor.appendChild(node);
414− } else if (nextProps.href === '') {
415− // remove the surrounding href
416− var anchor = node.parentNode;
417− anchor.parentNode.replaceChild(node, anchor);
418− } else {
419− // just update the link
420− node.parentNode.href = nextProps.href;
421− }
422− }
423−
424− // update click and hover handlers
425− var removed = false;
426−
427− // update hover handlers
428− if (currProps.hover.ctor === '_Tuple0') {
429− if (nextProps.hover.ctor !== '_Tuple0') {
430− addHover(node, nextProps.hover);
431− }
432− }
433− else {
434− if (nextProps.hover.ctor === '_Tuple0') {
435− removed = true;
436− removeHover(node);
437− }
438− else {
439− node.elm_hover_handler = nextProps.hover;
440− }
441− }
442−
443− // update click handlers
444− if (currProps.click.ctor === '_Tuple0') {
445− if (nextProps.click.ctor !== '_Tuple0') {
446− addClick(node, nextProps.click);
447− }
448− }
449− else {
450− if (nextProps.click.ctor === '_Tuple0') {
451− removed = true;
452− removeClick(node);
453− } else {
454− node.elm_click_handler = nextProps.click;
455− }
456− }
457−
458− // stop capturing clicks if
459− if (removed
460− && nextProps.hover.ctor === '_Tuple0'
461− && nextProps.click.ctor === '_Tuple0')
462− {
463− node.style.pointerEvents = 'none';
464− }
465−}
466−
467−return { render:render, update:update };
468−
469−};
runtime/Render/Utils.jsdeleted−40
@@ -1,40 +0,0 @@
1−ElmRuntime.Render.Utils = function() {
2− function newElement(elementType) {
3− var e = document.createElement(elementType);
4− e.style.padding = "0";
5− e.style.margin = "0";
6− return e;
7− }
8−
9− function addTo(container, elem) {
10− container.appendChild(elem);
11− }
12−
13− function addTransform(style, trans) {
14− style.transform = trans;
15− style.msTransform = trans;
16− style.MozTransform = trans;
17− style.webkitTransform = trans;
18− style.OTransform = trans;
19− }
20−
21− function removeTransform(style) {
22− style.transform = 'none';
23− style.msTransform = 'none';
24− style.MozTransform = 'none';
25− style.webkitTransform = 'none';
26− style.OTransform = 'none';
27− }
28−
29− var List = Elm.Native.List.make({});
30−
31− return {addTo:addTo,
32− newElement: newElement,
33− colorToCss: Elm.Native.Color.make({}).toCss,
34− fromList: List.toArray,
35− fromString: function(s) { return s; },
36− toString: function(s) { return s; },
37− eq: Elm.Native.Utils.make({}).eq,
38− addTransform: addTransform,
39− removeTransform: removeTransform};
40−};
compiler/AST/Annotation.hs → src/AST/Annotation.hsrenamed−1
@@ -1,4 +1,3 @@
1−{-# OPTIONS_GHC -W #-}
2module AST.Annotation where
1module AST.Annotation where
3
2
4import qualified Text.Parsec.Pos as Parsec
3import qualified Text.Parsec.Pos as Parsec
compiler/AST/Declaration.hs → src/AST/Declaration.hsrenamed+10−9
@@ -16,20 +16,21 @@ data Declaration' port def var
16 | TypeAlias String [String] (T.Type var)
16 | TypeAlias String [String] (T.Type var)
17 | Port port
17 | Port port
18 | Fixity Assoc Int String
18 | Fixity Assoc Int String
19− deriving (Show)
19+
20
20
21data Assoc = L | N | R
21data Assoc = L | N | R
22 deriving (Eq)
22 deriving (Eq)
23
23
24+
24data RawPort
25data RawPort
25 = PPAnnotation String T.RawType
26 = PPAnnotation String T.RawType
26 | PPDef String Source.Expr
27 | PPDef String Source.Expr
27− deriving (Show)
28+
28
29
29data Port expr var
30data Port expr var
30 = Out String expr (T.Type var)
31 = Out String expr (T.Type var)
31 | In String (T.Type var)
32 | In String (T.Type var)
32− deriving (Show)
33+
33
34
34type SourceDecl = Declaration' RawPort Source.Def Var.Raw
35type SourceDecl = Declaration' RawPort Source.Def Var.Raw
35type ValidDecl = Declaration' (Port Valid.Expr Var.Raw) Valid.Def Var.Raw
36type ValidDecl = Declaration' (Port Valid.Expr Var.Raw) Valid.Def Var.Raw
@@ -43,12 +44,12 @@ portName port =
43 Out name _ _ -> name
44 Out name _ _ -> name
44 In name _ -> name
45 In name _ -> name
45
46
46−instance Show Assoc where
47+assocToString :: Assoc -> String
47− show assoc =
48+assocToString assoc =
48− case assoc of
49+ case assoc of
49− L -> "left"
50+ L -> "left"
50− N -> "non"
51+ N -> "non"
51− R -> "right"
52+ R -> "right"
52
53
53instance Binary Assoc where
54instance Binary Assoc where
54 get = do n <- getWord8
55 get = do n <- getWord8
compiler/AST/Expression/Canonical.hs → src/AST/Expression/Canonical.hsrenamed

The content is the same.

compiler/AST/Expression/General.hs → src/AST/Expression/General.hsrenamed

The content is the same.

compiler/AST/Expression/Source.hs → src/AST/Expression/Source.hsrenamed

The content is the same.

compiler/AST/Expression/Valid.hs → src/AST/Expression/Valid.hsrenamed

The content is the same.

compiler/AST/Helpers.hs → src/AST/Helpers.hsrenamed

The content is the same.

compiler/AST/Literal.hs → src/AST/Literal.hsrenamed

The content is the same.

compiler/AST/Module.hs → src/AST/Module.hsrenamed+70−30
@@ -1,4 +1,3 @@
1−{-# OPTIONS_GHC -W #-}
2module AST.Module where
1module AST.Module where
3
2
4import Data.Binary
3import Data.Binary
@@ -10,24 +9,43 @@ import qualified AST.Expression.Canonical as Canonical
10import qualified AST.Declaration as Decl
9import qualified AST.Declaration as Decl
11import qualified AST.Type as Type
10import qualified AST.Type as Type
12import qualified AST.Variable as Var
11import qualified AST.Variable as Var
13−
14import AST.PrettyPrint
12import AST.PrettyPrint
13+import qualified Elm.Compiler.Version as Compiler
15import Text.PrettyPrint as P
14import Text.PrettyPrint as P
16
15
17−import qualified Elm.Internal.Version as Version
18
16
17+-- HELPFUL TYPE ALIASES
18+
19+type Interfaces = Map.Map Name Interface
20+
21+type Types = Map.Map String Type.CanonicalType
22+type Aliases = Map.Map String ([String], Type.CanonicalType)
23+type ADTs = Map.Map String (AdtInfo String)
24+
25+type AdtInfo v = ( [String], [(v, [Type.CanonicalType])] )
26+type CanonicalAdt = (Var.Canonical, AdtInfo Var.Canonical)
27+
28+
29+-- MODULES
30+
31+type SourceModule =
32+ Module (Var.Listing Var.Value) [Decl.SourceDecl]
33+
34+type ValidModule =
35+ Module (Var.Listing Var.Value) [Decl.ValidDecl]
36+
37+type CanonicalModule =
38+ Module [Var.Value] CanonicalBody
39+
40+
19−data Module exs body = Module
41+data Module exports body = Module
20− { names :: [String]
42+ { names :: Name
21 , path :: FilePath
43 , path :: FilePath
22− , exports :: exs
44+ , exports :: exports
23− , imports :: [(String, ImportMethod)]
45+ , imports :: [(Name, ImportMethod)]
24 , body :: body
46 , body :: body
25 }
47 }
26
48
27−getName :: Module exs body -> String
28−getName modul =
29− List.intercalate "." (names modul)
30−
31data CanonicalBody = CanonicalBody
49data CanonicalBody = CanonicalBody
32 { program :: Canonical.Expr
50 { program :: Canonical.Expr
33 , types :: Types
51 , types :: Types
@@ -37,24 +55,37 @@ data CanonicalBody = CanonicalBody
37 , ports :: [String]
55 , ports :: [String]
38 }
56 }
39
57
40−type SourceModule = Module (Var.Listing Var.Value) [Decl.SourceDecl]
41−type ValidModule = Module (Var.Listing Var.Value) [Decl.ValidDecl]
42−type CanonicalModule = Module [Var.Value] CanonicalBody
43
58
44−type Interfaces = Map.Map String Interface
59+-- HEADERS
45
60
46−type Types = Map.Map String Type.CanonicalType
61+{-| Basic info needed to identify modules and determine dependencies. -}
47−type Aliases = Map.Map String ( [String], Type.CanonicalType )
62+data HeaderAndImports = HeaderAndImports
48−type ADTs = Map.Map String (AdtInfo String)
63+ { _names :: Name
64+ , _exports :: Var.Listing Var.Value
65+ , _imports :: [(Name, ImportMethod)]
66+ }
67+
68+type Name = [String] -- must be non-empty
69+
70+nameToString :: Name -> String
71+nameToString = List.intercalate "."
72+
73+nameIsNative :: Name -> Bool
74+nameIsNative name =
75+ case name of
76+ "Native" : _ -> True
77+ _ -> False
49
78
50−type AdtInfo v = ( [String], [(v, [Type.CanonicalType])] )
51−type CanonicalAdt = (Var.Canonical, AdtInfo Var.Canonical)
52
79
80+
81+-- INTERFACES
82+
83+{-| Key facts about a module, used when reading info from .elmi files. -}
53data Interface = Interface
84data Interface = Interface
54− { iVersion :: Version.Version
85+ { iVersion :: String
55 , iExports :: [Var.Value]
86 , iExports :: [Var.Value]
56 , iTypes :: Types
87 , iTypes :: Types
57− , iImports :: [(String, ImportMethod)]
88+ , iImports :: [(Name, ImportMethod)]
58 , iAdts :: ADTs
89 , iAdts :: ADTs
59 , iAliases :: Aliases
90 , iAliases :: Aliases
60 , iFixities :: [(Decl.Assoc, Int, String)]
91 , iFixities :: [(Decl.Assoc, Int, String)]
@@ -65,7 +96,7 @@ toInterface :: CanonicalModule -> Interface
65toInterface modul =
96toInterface modul =
66 let body' = body modul in
97 let body' = body modul in
67 Interface
98 Interface
68− { iVersion = Version.elmVersion
99+ { iVersion = Compiler.version
69 , iExports = exports modul
100 , iExports = exports modul
70 , iTypes = types body'
101 , iTypes = types body'
71 , iImports = imports modul
102 , iImports = imports modul
@@ -87,6 +118,9 @@ instance Binary Interface where
87 put (iFixities modul)
118 put (iFixities modul)
88 put (iPorts modul)
119 put (iPorts modul)
89
120
121+
122+-- IMPORT METHOD
123+
90data ImportMethod
124data ImportMethod
91 = As !String
125 = As !String
92 | Open !(Var.Listing Var.Value)
126 | Open !(Var.Listing Var.Value)
@@ -109,6 +143,9 @@ instance Binary ImportMethod where
109 1 -> Open <$> get
143 1 -> Open <$> get
110 _ -> error "Error reading valid ImportMethod type from serialized string"
144 _ -> error "Error reading valid ImportMethod type from serialized string"
111
145
146+
147+-- PRETTY PRINTING
148+
112instance (Pretty exs, Pretty body) => Pretty (Module exs body) where
149instance (Pretty exs, Pretty body) => Pretty (Module exs body) where
113 pretty (Module names _ exs ims body) =
150 pretty (Module names _ exs ims body) =
114 P.vcat [modul, P.text "", prettyImports, P.text "", pretty body]
151 P.vcat [modul, P.text "", prettyImports, P.text "", pretty body]
@@ -116,13 +153,16 @@ instance (Pretty exs, Pretty body) => Pretty (Module exs body) where
116 modul = P.text "module" <+> name <+> pretty exs <+> P.text "where"
153 modul = P.text "module" <+> name <+> pretty exs <+> P.text "where"
117 name = P.text (List.intercalate "." names)
154 name = P.text (List.intercalate "." names)
118
155
156+ prettyImports =
119− prettyImports = P.vcat $ map prettyMethod ims
157+ P.vcat $ map prettyMethod ims
120
158
159+
121−prettyMethod :: (String, ImportMethod) -> Doc
160+prettyMethod :: (Name, ImportMethod) -> Doc
122−prettyMethod (name, method) =
161+prettyMethod import' =
123− case method of
162+ case import' of
124− As alias
163+ ([name], As alias)
125 | name == alias -> P.empty
164 | name == alias -> P.empty
126− | otherwise -> P.text "as" <+> P.text alias
127
165
166+ (_, As alias) -> P.text "as" <+> P.text alias
167+
128− Open listing -> pretty listing
168+ (_, Open listing) -> pretty listing
compiler/AST/Pattern.hs → src/AST/Pattern.hsrenamed

The content is the same.

compiler/AST/PrettyPrint.hs → src/AST/PrettyPrint.hsrenamed

The content is the same.

compiler/AST/Type.hs → src/AST/Type.hsrenamed−1
@@ -1,4 +1,3 @@
1−{-# OPTIONS_GHC -W #-}
2module AST.Type where
1module AST.Type where
3
2
4import Control.Applicative ((<$>), (<*>))
3import Control.Applicative ((<$>), (<*>))
compiler/AST/Variable.hs → src/AST/Variable.hsrenamed+12−11
@@ -1,8 +1,8 @@
1−{-# OPTIONS_GHC -W #-}
2module AST.Variable where
1module AST.Variable where
3
2
4−import Data.Binary
5import Control.Applicative ((<$>), (<*>))
3import Control.Applicative ((<$>), (<*>))
4+import Data.Binary
5+import qualified Data.List as List
6import Text.PrettyPrint as P
6import Text.PrettyPrint as P
7import qualified AST.Helpers as Help
7import qualified AST.Helpers as Help
8import AST.PrettyPrint
8import AST.PrettyPrint
@@ -12,7 +12,7 @@ newtype Raw = Raw String
12
12
13data Home
13data Home
14 = BuiltIn
14 = BuiltIn
15− | Module !String
15+ | Module [String]
16 | Local
16 | Local
17 deriving (Eq,Ord,Show)
17 deriving (Eq,Ord,Show)
18
18
@@ -28,24 +28,25 @@ builtin :: String -> Canonical
28builtin x = Canonical BuiltIn x
28builtin x = Canonical BuiltIn x
29
29
30-- To help with pattern matching on some common canonical variables:
30-- To help with pattern matching on some common canonical variables:
31−is :: String -> String -> Canonical -> Bool
31+is :: [String] -> String -> Canonical -> Bool
32is home name var =
32is home name var =
33 var == Canonical (Module home) name
33 var == Canonical (Module home) name
34
34
35isJson :: Canonical -> Bool
35isJson :: Canonical -> Bool
36−isJson = is "Json" "Value"
36+isJson = is ["Json"] "Value"
37
37
38isMaybe :: Canonical -> Bool
38isMaybe :: Canonical -> Bool
39−isMaybe = is "Maybe" "Maybe"
39+isMaybe = is ["Maybe"] "Maybe"
40
40
41isArray :: Canonical -> Bool
41isArray :: Canonical -> Bool
42−isArray = is "Array" "Array"
42+isArray = is ["Array"] "Array"
43
43
44isSignal :: Canonical -> Bool
44isSignal :: Canonical -> Bool
45−isSignal = is "Signal" "Signal"
45+isSignal = is ["Signal"] "Signal"
46
46
47isList :: Canonical -> Bool
47isList :: Canonical -> Bool
48+isList v =
48−isList v = v == Canonical BuiltIn "_List"
49+ v == Canonical BuiltIn "_List"
49
50
50isTuple :: Canonical -> Bool
51isTuple :: Canonical -> Bool
51isTuple v =
52isTuple v =
@@ -66,7 +67,7 @@ isPrim prim v =
66 _ -> False
67 _ -> False
67
68
68isText :: Canonical -> Bool
69isText :: Canonical -> Bool
69−isText = is "Text" "Text"
70+isText = is ["Text"] "Text"
70
71
71class ToString a where
72class ToString a where
72 toString :: a -> String
73 toString :: a -> String
@@ -78,7 +79,7 @@ instance ToString Canonical where
78 toString (Canonical home name) =
79 toString (Canonical home name) =
79 case home of
80 case home of
80 BuiltIn -> name
81 BuiltIn -> name
81− Module path -> path ++ "." ++ name
82+ Module path -> List.intercalate "." (path ++ [name])
82 Local -> name
83 Local -> name
83
84
84-- | A listing of values. Something like (a,b,c) or (..) or (a,b,..)
85-- | A listing of values. Something like (a,b,c) or (..) or (a,b,..)
compiler/Build/Flags.hs → src/Build/Flags.hsrenamed+4−3
@@ -1,9 +1,10 @@
1{-# LANGUAGE DeriveDataTypeable #-}
1{-# LANGUAGE DeriveDataTypeable #-}
2module Build.Flags where
2module Build.Flags where
3
3
4−import qualified Elm.Internal.Version as Version
4+import qualified Elm.Compiler.Version as Compiler
5import System.Console.CmdArgs
5import System.Console.CmdArgs
6
6
7+
7data Flags = Flags
8data Flags = Flags
8 { make :: Bool
9 { make :: Bool
9 , files :: [FilePath]
10 , files :: [FilePath]
@@ -59,5 +60,5 @@ flags = Flags
59
60
60 } &= help "Compile Elm programs to HTML, CSS, and JavaScript."
61 } &= help "Compile Elm programs to HTML, CSS, and JavaScript."
61 &= helpArg [explicit, name "help", name "h"]
62 &= helpArg [explicit, name "help", name "h"]
62− &= versionArg [explicit, name "version", name "v", summary (show Version.elmVersion)]
63+ &= versionArg [explicit, name "version", name "v", summary Compiler.version]
63− &= summary ("The Elm Compiler " ++ show Version.elmVersion ++ ", (c) Evan Czaplicki 2011-2014")
64+ &= summary ("The Elm Compiler " ++ Compiler.version ++ ", (c) Evan Czaplicki 2011-2014")
compiler/Build/Print.hs → src/Build/Print.hsrenamed

The content is the same.

compiler/Build/Source.hs → src/Build/Source.hsrenamed−1
@@ -1,4 +1,3 @@
1−{-# OPTIONS_GHC -W #-}
2module Build.Source (build) where
1module Build.Source (build) where
3
2
4import qualified Data.Map as Map
3import qualified Data.Map as Map
compiler/Compiler.hs → src/Compiler.hsrenamed+9−21
@@ -1,32 +1,19 @@
1−{-# OPTIONS_GHC -W #-}
1+{-# OPTIONS_GHC -Wall #-}
2module Main where
2module Main where
3
3
4−import Control.Monad (foldM, when)
4+import GHC.Conc (getNumProcessors, setNumCapabilities)
5−import qualified Data.Maybe as Maybe
6−import Text.Blaze.Html.Renderer.String (renderHtml)
7−import qualified Data.ByteString.Lazy.Char8 as BS
8−import qualified System.Console.CmdArgs as CmdArgs
9−import System.Directory
10−import System.Exit (exitSuccess)
11−import System.FilePath
12−import GHC.Conc
13
5
14−import Build.Dependencies (getBuildRecipe, Recipe(..))
15−import qualified Generate.Html as Html
16−import qualified Metadata.Prelude as Prelude
17−import qualified Build.Utils as Utils
18−import qualified Build.Flags as Flag
19−import qualified Build.File as File
20−import qualified Elm.Internal.Paths as Path
21
6
22main :: IO ()
7main :: IO ()
8+main =
23−main = do setNumCapabilities =<< getNumProcessors
9+ do setNumCapabilities =<< getNumProcessors
24− compileArgs =<< CmdArgs.cmdArgs Flag.flags
10+ error "currently out of order"
25
11
12+{--
26compileArgs :: Flag.Flags -> IO ()
13compileArgs :: Flag.Flags -> IO ()
27compileArgs flags =
14compileArgs flags =
28 do when (Flag.get_runtime flags) $ do
15 do when (Flag.get_runtime flags) $ do
29− putStrLn Path.runtime
16+ putStrLn Utils.runtime
30 exitSuccess
17 exitSuccess
31 case Flag.files flags of
18 case Flag.files flags of
32 [] -> putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
19 [] -> putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
@@ -67,7 +54,7 @@ build flags rootFile =
67
54
68 getRuntime :: IO Html.JSSource
55 getRuntime :: IO Html.JSSource
69 getRuntime =
56 getRuntime =
70− let runtimePath = Maybe.fromMaybe Path.runtime (Flag.set_runtime flags) in
57+ let runtimePath = Maybe.fromMaybe Utils.runtime (Flag.set_runtime flags) in
71 case Flag.bundle_runtime flags of
58 case Flag.bundle_runtime flags of
72 False -> return (Html.Link runtimePath)
59 False -> return (Html.Link runtimePath)
73 True -> Html.Source `fmap` BS.readFile runtimePath
60 True -> Html.Source `fmap` BS.readFile runtimePath
@@ -87,3 +74,4 @@ build flags rootFile =
87 sources js = map Html.Link (Flag.scripts flags) ++ [ Html.Source js ]
74 sources js = map Html.Link (Flag.scripts flags) ++ [ Html.Source js ]
88 html runtime =
75 html runtime =
89 Html.generate runtime (takeBaseName rootFile) (sources js) moduleName ""
76 Html.generate runtime (takeBaseName rootFile) (sources js) moduleName ""
77+--}
src/Docs.hsnew file+229
@@ -0,0 +1,229 @@
1+{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-}
2+module Main where
3+
4+import System.Console.CmdArgs
5+import System.Directory
6+import System.FilePath
7+import System.Exit
8+import System.IO
9+
10+import Control.Applicative ((<$>))
11+import Control.Arrow (second)
12+import qualified Data.Aeson.Encode.Pretty as Json
13+import qualified Data.Map as Map
14+import qualified Data.ByteString.Lazy.Char8 as BS
15+
16+import qualified AST.Type as Type
17+import qualified AST.Declaration as Decl
18+import qualified AST.Expression.Source as Source
19+import qualified AST.Variable as Var
20+
21+import Text.Parsec hiding (newline, spaces)
22+import qualified Parse.Declaration as Parse (typeDecl, infixDecl)
23+import qualified Parse.Expression as Parse (typeAnnotation)
24+import qualified Parse.Helpers as Parse
25+import qualified Parse.Module as Parse (header)
26+import qualified Elm.Compiler.Module as Module
27+import qualified Elm.Docs as Docs
28+
29+
30+-- FLAGS
31+
32+data Flags = Flags
33+ { input :: FilePath
34+ , output :: Maybe FilePath
35+ }
36+ deriving (Data,Typeable,Show,Eq)
37+
38+
39+defaultFlags :: Flags
40+defaultFlags = Flags
41+ { input = def &= args &= typ "FILE"
42+
43+ , output = Nothing &= typFile
44+ &= help "file name for generated JSON documentation"
45+
46+ } &= help "Generate documentation for Elm"
47+ &= summary "Generate documentation for Elm, (c) Evan Czaplicki"
48+
49+
50+-- GENERATE DOCUMENTATION
51+
52+main :: IO ()
53+main =
54+ do flags <- cmdArgs defaultFlags
55+ source <- readFile (input flags)
56+ case Parse.iParse documentation source of
57+ Right docs ->
58+ let json = Json.encodePretty' config docs in
59+ case output flags of
60+ Nothing -> BS.putStrLn json
61+ Just docPath ->
62+ do createDirectoryIfMissing True (dropFileName docPath)
63+ BS.writeFile docPath json
64+
65+ Left err ->
66+ do hPutStrLn stderr (show err)
67+ exitFailure
68+
69+
70+config :: Json.Config
71+config =
72+ Json.Config
73+ { Json.confIndent = 2
74+ , Json.confCompare = Json.keyOrder keys
75+ }
76+ where
77+ keys =
78+ [ "tag", "name", "comment", "aliases", "types"
79+ , "values", "func", "args", "type", "cases"
80+ ]
81+
82+
83+-- PARSE DOCUMENTATION
84+
85+documentation :: Parse.IParser Docs.Documentation
86+documentation =
87+ do optional Parse.freshLine
88+ (names, _exports) <- Parse.header
89+
90+ manyTill (string " " <|> Parse.newline <?> "more whitespace")
91+ (lookAhead (string "{-|") <?> "module documentation comment")
92+
93+ overview <- docComment
94+
95+ decls <- allDeclarations
96+
97+ let (aliases, unions, values) = categorizeDeclarations decls
98+
99+ return (Docs.Documentation (Module.Name names) overview aliases unions values)
100+
101+
102+docComment :: Parse.IParser String
103+docComment =
104+ do try (string "{-|")
105+ contents <- Parse.closeComment
106+
107+ let reversed =
108+ dropWhile (`elem` " \n\r") . drop 2 $ reverse contents
109+
110+ return $ dropWhile (==' ') (reverse reversed)
111+
112+
113+allDeclarations :: Parse.IParser [(String, Decl.SourceDecl)]
114+allDeclarations =
115+ Parse.onFreshLines (:) [] declaration
116+
117+
118+declaration :: Parse.IParser (String, Decl.SourceDecl)
119+declaration =
120+ uncommentable <|> commented <|> uncommented ""
121+ where
122+ uncommentable =
123+ (,) "" <$> Parse.infixDecl
124+
125+ commented =
126+ do comment <- docComment
127+ Parse.freshLine
128+ uncommented comment
129+
130+ uncommented comment =
131+ (,) comment
132+ <$> choice [ Parse.typeDecl, Decl.Definition <$> Parse.typeAnnotation ]
133+
134+
135+-- CATEGORIZE DECLARATIONS
136+
137+data CategoryInfo = CategoryInfo
138+ { aliases :: [Docs.Alias]
139+ , unions :: [Docs.Union]
140+ , values :: Map.Map String Docs.Value
141+ , infixes :: Map.Map String (String, Int)
142+ }
143+
144+
145+emptyInfo :: CategoryInfo
146+emptyInfo =
147+ CategoryInfo [] [] Map.empty Map.empty
148+
149+
150+categorizeDeclarations :: [(String, Decl.SourceDecl)] -> ([Docs.Alias], [Docs.Union], [Docs.Value])
151+categorizeDeclarations decls =
152+ (aliases, unions, Map.elems values)
153+ where
154+ (CategoryInfo aliases unions rawValues infixes) =
155+ foldr collectInfo emptyInfo decls
156+
157+ values =
158+ Map.union
159+ (Map.intersectionWith addInfixInfo rawValues infixes)
160+ rawValues
161+
162+
163+addInfixInfo :: Docs.Value -> (String, Int) -> Docs.Value
164+addInfixInfo value infixInfo =
165+ value { Docs.valueAssocPrec = Just infixInfo }
166+
167+
168+collectInfo :: (String, Decl.SourceDecl) -> CategoryInfo -> CategoryInfo
169+collectInfo (comment, decl) info =
170+ case decl of
171+ Decl.Definition def ->
172+ case def of
173+ Source.Definition _ _ -> error errorMessage
174+ Source.TypeAnnotation name tipe ->
175+ let value = Docs.Value name comment (toDocType tipe) Nothing
176+ in
177+ info { values = Map.insert name value (values info) }
178+
179+ Decl.Datatype name args cases ->
180+ let cases' = map (second (map toDocType)) cases
181+ union = Docs.Union name comment args cases'
182+ in
183+ info { unions = union : unions info }
184+
185+ Decl.TypeAlias name args tipe ->
186+ let alias = Docs.Alias name comment args (toDocType tipe)
187+ in
188+ info { aliases = alias : aliases info }
189+
190+ Decl.Fixity assoc prec name ->
191+ let infixInfo = (Decl.assocToString assoc, prec)
192+ in
193+ info { infixes = Map.insert name infixInfo (infixes info) }
194+
195+ Decl.Port _ ->
196+ error errorMessage
197+
198+
199+errorMessage :: String
200+errorMessage =
201+ "there appears to be a bug in this tool.\n" ++
202+ "Please report it to <https://github.com/elm-lang/Elm/issues>"
203+
204+
205+-- AST TYPE TO DOC TYPE
206+
207+toDocType :: Type.Type Var.Raw -> Docs.Type
208+toDocType astType =
209+ case astType of
210+ Type.Lambda t1 t2 ->
211+ Docs.Lambda (toDocType t1) (toDocType t2)
212+
213+ Type.Var x ->
214+ Docs.Var x
215+
216+ Type.Type (Var.Raw name) ->
217+ Docs.Type name
218+
219+ Type.App t ts ->
220+ Docs.App (toDocType t) (map toDocType ts)
221+
222+ Type.Record fields ext ->
223+ Docs.Record (map (second toDocType) fields) (fmap toDocType ext)
224+
225+ Type.Aliased _ t ->
226+ toDocType t
227+
228+
229+
compiler/Dummy.cabal → src/Dummy.cabalrenamed

The content is the same.

src/Elm/Compiler.hsnew file+58
@@ -0,0 +1,58 @@
1+{-# OPTIONS_GHC -Wall #-}
2+{-# LANGUAGE FlexibleContexts #-}
3+module Elm.Compiler (version, parseDependencies, compile) where
4+
5+import Control.Monad.Error (MonadError, MonadIO, liftIO, throwError)
6+import qualified Data.List as List
7+import qualified Data.Map as Map
8+import qualified Text.PrettyPrint as P
9+
10+import qualified AST.Module as Module (HeaderAndImports(HeaderAndImports), Interfaces, toInterface)
11+import qualified Build.Source as Source
12+import qualified Elm.Compiler.Module as PublicModule
13+import qualified Elm.Compiler.Version as Version
14+import qualified Generate.JavaScript as JS
15+import qualified Metadata.Prelude as Prelude
16+import qualified Parse.Helpers as Help
17+import qualified Parse.Module as Parse
18+
19+
20+-- VERSION
21+
22+version :: String
23+version =
24+ Version.version
25+
26+
27+-- DEPENDENCIES
28+
29+parseDependencies
30+ :: (MonadError String m)
31+ => String
32+ -> m (PublicModule.Name, [PublicModule.Name])
33+parseDependencies src =
34+ case Help.iParse Parse.headerAndImports src of
35+ Left msg ->
36+ throwError (show msg)
37+
38+ Right (Module.HeaderAndImports names _exports imports) ->
39+ return
40+ ( PublicModule.Name names
41+ , map (PublicModule.Name . fst) imports
42+ )
43+
44+
45+-- COMPILATION
46+
47+{-| Compiles Elm source code to JavaScript. -}
48+compile
49+ :: String
50+ -> Map.Map PublicModule.Name PublicModule.Interface
51+ -> Either String (PublicModule.Interface, String)
52+compile source interfaces =
53+ case Source.build True unwrappedInterfaces source of
54+ Left docs -> Left . unlines . List.intersperse "" $ map P.render docs
55+ Right modul -> Right (Module.toInterface modul, JS.generate modul)
56+ where
57+ unwrappedInterfaces =
58+ Map.mapKeysMonotonic (\(PublicModule.Name name) -> name) interfaces
src/Elm/Compiler/Module.hsnew file+63
@@ -0,0 +1,63 @@
1+module Elm.Compiler.Module
2+ ( Interface, Name(Name)
3+ , nameToPath, nameToString, nameFromString
4+ )
5+ where
6+
7+import Control.Monad (mzero)
8+import qualified Data.Aeson as Json
9+import qualified Data.Char as Char
10+import qualified Data.List as List
11+import qualified Data.Text as Text
12+import System.FilePath ((</>))
13+import qualified AST.Module as Module
14+
15+
16+type Interface = Module.Interface
17+
18+newtype Name = Name [String]
19+ deriving (Eq, Ord)
20+
21+
22+nameToPath :: Name -> FilePath
23+nameToPath (Name names) =
24+ List.foldl1 (</>) names
25+
26+
27+nameToString :: Name -> String
28+nameToString (Name names) =
29+ List.intercalate "." names
30+
31+
32+nameFromString :: String -> Maybe Name
33+nameFromString raw =
34+ Name `fmap` mapM isLegit names
35+ where
36+ names =
37+ filter (/= ".") (List.groupBy (\a b -> a /= '.' && b /= '.') raw)
38+
39+ isLegit name =
40+ case name of
41+ [] -> Nothing
42+ char:rest ->
43+ if Char.isUpper char && all legitChar rest
44+ then Just name
45+ else Nothing
46+
47+ legitChar char =
48+ Char.isAlphaNum char || char `elem` "_'"
49+
50+
51+instance Json.ToJSON Name where
52+ toJSON name =
53+ Json.toJSON (nameToString name)
54+
55+
56+instance Json.FromJSON Name where
57+ parseJSON (Json.String text) =
58+ let rawName = Text.unpack text in
59+ case nameFromString rawName of
60+ Nothing -> fail (rawName ++ " is not a valid module name")
61+ Just name -> return name
62+
63+ parseJSON _ = mzero
src/Elm/Compiler/Version.hsnew file+10
@@ -0,0 +1,10 @@
1+{-# OPTIONS_GHC -Wall #-}
2+module Elm.Compiler.Version (version) where
3+
4+import qualified Data.Version as Version
5+import qualified Paths_elm_compiler as This
6+
7+
8+version :: String
9+version =
10+ Version.showVersion This.version
src/Elm/Docs.hsnew file+220
@@ -0,0 +1,220 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Elm.Docs where
3+
4+import Control.Applicative ((<$>),(<*>))
5+import Control.Arrow (second)
6+import Control.Monad
7+import Data.Aeson ((.:), (.:?), (.=))
8+import qualified Data.Aeson as Json
9+import qualified Data.ByteString.Lazy.Char8 as BS
10+import qualified Data.Text as Text
11+
12+import qualified Elm.Compiler.Module as Module
13+
14+
15+data Documentation = Documentation
16+ { moduleName :: Module.Name
17+ , overview :: String
18+ , aliases :: [Alias]
19+ , types :: [Union]
20+ , values :: [Value]
21+ }
22+
23+
24+data Alias = Alias
25+ { aliasName :: String
26+ , aliasComment :: String
27+ , aliasArgs :: [String]
28+ , aliasType :: Type
29+ }
30+
31+
32+data Union = Union
33+ { unionName :: String
34+ , unionComment :: String
35+ , unionArgs :: [String]
36+ , unionCases :: [(String, [Type])]
37+ }
38+
39+
40+data Value = Value
41+ { valueName :: String
42+ , valueComment :: String
43+ , valueTipe :: Type
44+ , valueAssocPrec :: Maybe (String,Int)
45+ }
46+
47+
48+data Type
49+ = Lambda Type Type
50+ | Var String
51+ | Type String
52+ | App Type [Type]
53+ | Record [(String, Type)] (Maybe Type)
54+
55+
56+-- JSON for DOCUMENTATION
57+
58+instance Json.ToJSON Documentation where
59+ toJSON (Documentation name comment aliases types values) =
60+ Json.object
61+ [ "name" .= name
62+ , "comment" .= comment
63+ , "aliases" .= aliases
64+ , "types" .= types
65+ , "values" .= values
66+ ]
67+
68+instance Json.FromJSON Documentation where
69+ parseJSON (Json.Object obj) =
70+ Documentation
71+ <$> obj .: "name"
72+ <*> obj .: "comment"
73+ <*> obj .: "aliases"
74+ <*> obj .: "types"
75+ <*> obj .: "values"
76+
77+ parseJSON value =
78+ fail $ "Cannot decode Documentation from: " ++ BS.unpack (Json.encode value)
79+
80+
81+-- JSON for ALIAS
82+
83+instance Json.ToJSON Alias where
84+ toJSON (Alias name comment args tipe) =
85+ Json.object
86+ [ "name" .= name
87+ , "comment" .= comment
88+ , "args" .= args
89+ , "type" .= tipe
90+ ]
91+
92+instance Json.FromJSON Alias where
93+ parseJSON (Json.Object obj) =
94+ Alias
95+ <$> obj .: "name"
96+ <*> obj .: "comment"
97+ <*> obj .: "args"
98+ <*> obj .: "type"
99+
100+ parseJSON value =
101+ fail $ "Cannot decode Alias from: " ++ BS.unpack (Json.encode value)
102+
103+
104+-- JSON for UNION
105+
106+instance Json.ToJSON Union where
107+ toJSON (Union name comment args cases) =
108+ Json.object
109+ [ "name" .= name
110+ , "comment" .= comment
111+ , "args" .= args
112+ , "cases" .= cases
113+ ]
114+
115+instance Json.FromJSON Union where
116+ parseJSON (Json.Object obj) =
117+ Union
118+ <$> obj .: "name"
119+ <*> obj .: "comment"
120+ <*> obj .: "args"
121+ <*> obj .: "cases"
122+
123+ parseJSON value =
124+ fail $ "Cannot decode Union from: " ++ BS.unpack (Json.encode value)
125+
126+
127+-- JSON for VALUE
128+
129+instance Json.ToJSON Value where
130+ toJSON (Value name comment tipe assocPrec) =
131+ Json.object (fields ++ possibleFields)
132+ where
133+ fields =
134+ [ "name" .= name
135+ , "comment" .= comment
136+ , "type" .= tipe
137+ ]
138+
139+ possibleFields =
140+ case assocPrec of
141+ Nothing -> []
142+ Just (assoc, prec) ->
143+ [ "associativity" .= assoc
144+ , "precedence" .= prec
145+ ]
146+
147+
148+instance Json.FromJSON Value where
149+ parseJSON (Json.Object obj) =
150+ Value
151+ <$> obj .: "name"
152+ <*> obj .: "comment"
153+ <*> obj .: "type"
154+ <*> (liftM2 (,) <$> obj .:? "associativity" <*> obj .:? "precedence")
155+
156+ parseJSON value =
157+ fail $ "Cannot decode Value from: " ++ BS.unpack (Json.encode value)
158+
159+
160+-- JSON for TYPE
161+
162+instance Json.ToJSON Type where
163+ toJSON tipe =
164+ Json.object (getFields tipe)
165+ where
166+ getFields tipe =
167+ case tipe of
168+ Lambda t1 t2 ->
169+ [ "tag" .= ("lambda" :: Text.Text)
170+ , "in" .= Json.toJSON t1
171+ , "out" .= Json.toJSON t2
172+ ]
173+
174+ Var x ->
175+ [ "tag" .= ("var" :: Text.Text)
176+ , "name" .= Json.toJSON x
177+ ]
178+
179+ Type name ->
180+ [ "tag" .= ("type" :: Text.Text)
181+ , "name" .= Json.toJSON name
182+ ]
183+
184+ App t ts ->
185+ [ "tag" .= ("app" :: Text.Text)
186+ , "func" .= Json.toJSON t
187+ , "args" .= Json.toJSON ts
188+ ]
189+
190+ Record fields ext ->
191+ [ "tag" .= ("record" :: Text.Text)
192+ , "fields" .= Json.toJSON (map (Json.toJSON . second Json.toJSON) fields)
193+ , "extension" .= Json.toJSON ext
194+ ]
195+
196+instance Json.FromJSON Type where
197+ parseJSON (Json.Object obj) =
198+ do tag <- obj .: "tag"
199+ case (tag :: String) of
200+ "lambda" ->
201+ Lambda <$> obj .: "in" <*> obj .: "out"
202+
203+ "var" ->
204+ Var <$> obj .: "name"
205+
206+ "type" ->
207+ Type <$> obj .: "name"
208+
209+ "app" ->
210+ App <$> obj .: "func" <*> obj .: "arg"
211+
212+ "record" ->
213+ Record <$> obj .: "fields" <*> obj .: "extension"
214+
215+ _ ->
216+ fail $ "Error when decoding type with tag: " ++ tag
217+
218+
219+ parseJSON value =
220+ fail $ "Cannot decode Value from: " ++ BS.unpack (Json.encode value)
compiler/Generate/Cases.hs → src/Generate/Cases.hsrenamed−1
@@ -1,4 +1,3 @@
1−{-# OPTIONS_GHC -W #-}
2module Generate.Cases (toMatch, Match (..), Clause (..), matchSubst, newVar) where
1module Generate.Cases (toMatch, Match (..), Clause (..), matchSubst, newVar) where
3
2
4import Control.Applicative ((<$>))
3import Control.Applicative ((<$>))
compiler/Generate/Html.hs → src/Generate/Html.hsrenamed

The content is the same.

compiler/Generate/JavaScript.hs → src/Generate/JavaScript.hsrenamed+16−17
@@ -1,4 +1,3 @@
1−{-# OPTIONS_GHC -W #-}
2module Generate.JavaScript (generate) where
1module Generate.JavaScript (generate) where
3
2
4import Control.Applicative ((<$>),(<*>))
3import Control.Applicative ((<$>),(<*>))
@@ -30,14 +29,14 @@ varDecl :: String -> Expression () -> VarDecl ()
30varDecl x expr =
29varDecl x expr =
31 VarDecl () (var x) (Just expr)
30 VarDecl () (var x) (Just expr)
32
31
33−internalImports :: String -> [VarDecl ()]
32+internalImports :: Module.Name -> [VarDecl ()]
34internalImports name =
33internalImports name =
35 [ varDecl "_N" (obj ["Elm","Native"])
34 [ varDecl "_N" (obj ["Elm","Native"])
36 , include "_U" "Utils"
35 , include "_U" "Utils"
37 , include "_L" "List"
36 , include "_L" "List"
38 , include "_A" "Array"
37 , include "_A" "Array"
39 , include "_E" "Error"
38 , include "_E" "Error"
40− , varDecl Help.localModuleName (string name)
39+ , varDecl Help.localModuleName (string (Module.nameToString name))
41 ]
40 ]
42 where
41 where
43 include :: String -> String -> VarDecl ()
42 include :: String -> String -> VarDecl ()
@@ -149,7 +148,7 @@ expression (A region expr) =
149 MultiIf branches ->
148 MultiIf branches ->
150 do branches' <- forM branches $ \(b,e) -> (,) <$> expression b <*> expression e
149 do branches' <- forM branches $ \(b,e) -> (,) <$> expression b <*> expression e
151 return $ case last branches of
150 return $ case last branches of
152− (A _ (Var (Var.Canonical (Var.Module "Basics") "otherwise")), _) ->
151+ (A _ (Var (Var.Canonical (Var.Module ["Basics"]) "otherwise")), _) ->
153 safeIfs branches'
152 safeIfs branches'
154 (A _ (Literal (Boolean True)), _) -> safeIfs branches'
153 (A _ (Literal (Boolean True)), _) -> safeIfs branches'
155 _ -> ifs branches' (throw "If" region)
154 _ -> ifs branches' (throw "If" region)
@@ -183,7 +182,7 @@ expression (A region expr) =
183
182
184 Markdown uid doc es ->
183 Markdown uid doc es ->
185 do es' <- mapM expression es
184 do es' <- mapM expression es
186− return $ Var.value "Text" "markdown" `call` (string md : string uid : es')
185+ return $ Var.value ["Text"] "markdown" `call` (string md : string uid : es')
187 where
186 where
188 pad = "<div style=\"height:0;width:0;\">&nbsp;</div>"
187 pad = "<div style=\"height:0;width:0;\">&nbsp;</div>"
189 md = pad ++ MD.toHtml doc ++ pad
188 md = pad ++ MD.toHtml doc ++ pad
@@ -192,12 +191,12 @@ expression (A region expr) =
192 return $ ObjectLit () [(PropString () "src", literal (Str src))]
191 return $ ObjectLit () [(PropString () "src", literal (Str src))]
193
192
194 PortIn name tipe ->
193 PortIn name tipe ->
195− return $ Var.value "Native.Ports" "portIn" `call`
194+ return $ Var.value ["Native","Ports"] "portIn" `call`
196 [ string name, Port.incoming tipe ]
195 [ string name, Port.incoming tipe ]
197
196
198 PortOut name tipe value ->
197 PortOut name tipe value ->
199 do value' <- expression value
198 do value' <- expression value
200− return $ Var.value "Native.Ports" "portOut" `call`
199+ return $ Var.value ["Native","Ports"] "portOut" `call`
201 [ string name, Port.outgoing tipe, value' ]
200 [ string name, Port.outgoing tipe, value' ]
202
201
203definition :: Canonical.Def -> State Int [Statement ()]
202definition :: Canonical.Def -> State Int [Statement ()]
@@ -326,17 +325,17 @@ generate modul =
326
325
327 localVars :: [VarDecl ()]
326 localVars :: [VarDecl ()]
328 localVars = varDecl "_op" (ObjectLit () []) :
327 localVars = varDecl "_op" (ObjectLit () []) :
329− internalImports (Module.getName modul) ++
328+ internalImports (Module.names modul) ++
330 explicitImports
329 explicitImports
331 where
330 where
332 explicitImports :: [VarDecl ()]
331 explicitImports :: [VarDecl ()]
333 explicitImports =
332 explicitImports =
334 map jsImport . Set.toList . Set.fromList . map fst $ Module.imports modul
333 map jsImport . Set.toList . Set.fromList . map fst $ Module.imports modul
335
334
336− jsImport :: String -> VarDecl ()
335+ jsImport :: Module.Name -> VarDecl ()
337 jsImport name =
336 jsImport name =
338 varDecl (Var.moduleName name) $
337 varDecl (Var.moduleName name) $
339− obj ("Elm" : Help.splitDots name ++ ["make"]) <| ref "_elm"
338+ obj ("Elm" : name ++ ["make"]) <| ref "_elm"
340
339
341 body :: [Statement ()]
340 body :: [Statement ()]
342 body = concat $ evalState defs 0
341 body = concat $ evalState defs 0
@@ -369,20 +368,20 @@ binop :: Region -> Var.Canonical -> Canonical.Expr -> Canonical.Expr
369 -> State Int (Expression ())
368 -> State Int (Expression ())
370binop region func@(Var.Canonical home op) e1 e2 =
369binop region func@(Var.Canonical home op) e1 e2 =
371 case (home, op) of
370 case (home, op) of
372− (Var.Module "Basics", ">>") ->
371+ (Var.Module ["Basics"], ">>") ->
373 do es <- mapM expression (collectLeftAssoc [e2] e1)
372 do es <- mapM expression (collectLeftAssoc [e2] e1)
374 return $ ["$"] ==> List.foldl' (\e f -> f <| e) (ref "$") es
373 return $ ["$"] ==> List.foldl' (\e f -> f <| e) (ref "$") es
375
374
376− (Var.Module "Basics", "<<") ->
375+ (Var.Module ["Basics"], "<<") ->
377 do es <- mapM expression (e1 : collectRightAssoc [] e2)
376 do es <- mapM expression (e1 : collectRightAssoc [] e2)
378 return $ ["$"] ==> foldr (<|) (ref "$") es
377 return $ ["$"] ==> foldr (<|) (ref "$") es
379
378
380− (Var.Module "Basics", "<|") ->
379+ (Var.Module ["Basics"], "<|") ->
381 do e2' <- expression e2
380 do e2' <- expression e2
382 es <- mapM expression (collectRightAssoc [] e1)
381 es <- mapM expression (collectRightAssoc [] e1)
383 return $ foldr (<|) e2' es
382 return $ foldr (<|) e2' es
384
383
385− (Var.Module "List", "++") ->
384+ (Var.Module ["List"], "++") ->
386 do e1' <- expression e1
385 do e1' <- expression e1
387 e2' <- expression e2
386 e2' <- expression e2
388 return $ _List "append" `call` [e1', e2']
387 return $ _List "append" `call` [e1', e2']
@@ -390,7 +389,7 @@ binop region func@(Var.Canonical home op) e1 e2 =
390 (Var.BuiltIn, "::") ->
389 (Var.BuiltIn, "::") ->
391 expression (A region (Data "::" [e1,e2]))
390 expression (A region (Data "::" [e1,e2]))
392
391
393− (Var.Module "Basics", _) ->
392+ (Var.Module ["Basics"], _) ->
394 do e1' <- expression e1
393 do e1' <- expression e1
395 e2' <- expression e2
394 e2' <- expression e2
396 return $ case Map.lookup op basicOps of
395 return $ case Map.lookup op basicOps of
@@ -405,13 +404,13 @@ binop region func@(Var.Canonical home op) e1 e2 =
405 where
404 where
406 collectRightAssoc es e =
405 collectRightAssoc es e =
407 case e of
406 case e of
408− A _ (Binop (Var.Canonical (Var.Module "Basics") "<<") e1 e2) ->
407+ A _ (Binop (Var.Canonical (Var.Module ["Basics"]) "<<") e1 e2) ->
409 collectRightAssoc (es ++ [e1]) e2
408 collectRightAssoc (es ++ [e1]) e2
410 _ -> es ++ [e]
409 _ -> es ++ [e]
411
410
412 collectLeftAssoc es e =
411 collectLeftAssoc es e =
413 case e of
412 case e of
414− A _ (Binop (Var.Canonical (Var.Module "Basics") ">>") e1 e2) ->
413+ A _ (Binop (Var.Canonical (Var.Module ["Basics"]) ">>") e1 e2) ->
415 collectLeftAssoc (e2 : es) e1
414 collectLeftAssoc (e2 : es) e1
416 _ -> e : es
415 _ -> e : es
417
416
compiler/Generate/JavaScript/Helpers.hs → src/Generate/JavaScript/Helpers.hsrenamed−1
@@ -1,4 +1,3 @@
1−{-# OPTIONS_GHC -W #-}
2module Generate.JavaScript.Helpers where
1module Generate.JavaScript.Helpers where
3
2
4import AST.Annotation (Region)
3import AST.Annotation (Region)
compiler/Generate/JavaScript/Ports.hs → src/Generate/JavaScript/Ports.hsrenamed+6−7
@@ -1,4 +1,3 @@
1−{-# OPTIONS_GHC -W #-}
2module Generate.JavaScript.Ports (incoming, outgoing) where
1module Generate.JavaScript.Ports (incoming, outgoing) where
3
2
4import Generate.JavaScript.Helpers
3import Generate.JavaScript.Helpers
@@ -31,7 +30,7 @@ incoming tipe =
31 Aliased _ t -> incoming t
30 Aliased _ t -> incoming t
32
31
33 App (Type v) [t]
32 App (Type v) [t]
34− | Var.isSignal v -> V.value "Native.Ports" "incomingSignal" <| incoming t
33+ | Var.isSignal v -> V.value ["Native","Ports"] "incomingSignal" <| incoming t
35
34
36 _ -> ["v"] ==> inc tipe (ref "v")
35 _ -> ["v"] ==> inc tipe (ref "v")
37
36
@@ -52,7 +51,7 @@ inc tipe x =
52 from checks = check x checks x
51 from checks = check x checks x
53
52
54 Type name
53 Type name
55− | Var.isJson name -> V.value "Native.Json" "fromJS" <| x
54+ | Var.isJson name -> V.value ["Native","Json"] "fromJS" <| x
56 | Var.isTuple name -> incomingTuple [] x
55 | Var.isTuple name -> incomingTuple [] x
57 | otherwise -> error "bad type got to incoming port generation code"
56 | otherwise -> error "bad type got to incoming port generation code"
58
57
@@ -62,8 +61,8 @@ inc tipe x =
62 | Var.isMaybe name ->
61 | Var.isMaybe name ->
63 CondExpr ()
62 CondExpr ()
64 (equal x (NullLit ()))
63 (equal x (NullLit ()))
65− (V.value "Maybe" "Nothing")
64+ (V.value ["Maybe"] "Nothing")
66− (V.value "Maybe" "Just" <| inc t x)
65+ (V.value ["Maybe"] "Just" <| inc t x)
67
66
68 | Var.isList name ->
67 | Var.isList name ->
69 check x JSArray (obj ["_L","fromArray"] <| array)
68 check x JSArray (obj ["_L","fromArray"] <| array)
@@ -107,7 +106,7 @@ outgoing tipe =
107 Aliased _ t -> outgoing t
106 Aliased _ t -> outgoing t
108
107
109 App (Type v) [t]
108 App (Type v) [t]
110− | Var.isSignal v -> V.value "Native.Ports" "outgoingSignal" <| outgoing t
109+ | Var.isSignal v -> V.value ["Native","Ports"] "outgoingSignal" <| outgoing t
111
110
112 _ -> ["v"] ==> out tipe (ref "v")
111 _ -> ["v"] ==> out tipe (ref "v")
113
112
@@ -137,7 +136,7 @@ out tipe x =
137 | name `elem` ["Int","Float","Bool","String"] -> x
136 | name `elem` ["Int","Float","Bool","String"] -> x
138
137
139 Type name
138 Type name
140− | Var.isJson name -> V.value "Native.Json" "toJS" <| x
139+ | Var.isJson name -> V.value ["Native","Json"] "toJS" <| x
141 | Var.isTuple name -> ArrayLit () []
140 | Var.isTuple name -> ArrayLit () []
142 | otherwise -> error "bad type got to outgoing port generation code"
141 | otherwise -> error "bad type got to outgoing port generation code"
143
142
compiler/Generate/JavaScript/Variable.hs → src/Generate/JavaScript/Variable.hsrenamed+6−4
@@ -1,8 +1,9 @@
1−{-# OPTIONS_GHC -W #-}
2module Generate.JavaScript.Variable where
1module Generate.JavaScript.Variable where
3
2
4import qualified AST.Helpers as Help
3import qualified AST.Helpers as Help
4+import qualified AST.Module as Module
5import qualified AST.Variable as Var
5import qualified AST.Variable as Var
6+import qualified Data.List as List
6import qualified Data.Set as Set
7import qualified Data.Set as Set
7import qualified Generate.JavaScript.Helpers as JS
8import qualified Generate.JavaScript.Helpers as JS
8import qualified Language.ECMAScript3.Syntax as JS
9import qualified Language.ECMAScript3.Syntax as JS
@@ -22,15 +23,16 @@ canonical (Var.Canonical home name) =
22 Var.BuiltIn -> []
23 Var.BuiltIn -> []
23 Var.Module path -> [ moduleName path ]
24 Var.Module path -> [ moduleName path ]
24
25
25−moduleName :: String -> String
26+moduleName :: Module.Name -> String
26−moduleName x = '$' : map (swap '.' '$') x
27+moduleName name =
28+ '$' : List.intercalate "$" name
27
29
28varName :: String -> String
30varName :: String -> String
29varName x = map (swap '\'' '$') x'
31varName x = map (swap '\'' '$') x'
30 where
32 where
31 x' = if Set.member x jsReserveds then '$' : x else x
33 x' = if Set.member x jsReserveds then '$' : x else x
32
34
33−value :: String -> String -> JS.Expression ()
35+value :: Module.Name -> String -> JS.Expression ()
34value home name =
36value home name =
35 canonical (Var.Canonical (Var.Module home) name)
37 canonical (Var.Canonical (Var.Module home) name)
36
38
compiler/Generate/Markdown.hs → src/Generate/Markdown.hsrenamed+1−2
@@ -1,13 +1,12 @@
1+{-# OPTIONS_GHC -Wall #-}
1module Generate.Markdown where
2module Generate.Markdown where
2
3
3import qualified Cheapskate as CS
4import qualified Cheapskate as CS
4import qualified Cheapskate.Html as CS
5import qualified Cheapskate.Html as CS
5−import qualified Data.Set as Set
6import qualified Data.Text as Text
6import qualified Data.Text as Text
7import qualified Text.Blaze.Html.Renderer.String as Blaze
7import qualified Text.Blaze.Html.Renderer.String as Blaze
8import qualified Text.Highlighting.Kate as Kate
8import qualified Text.Highlighting.Kate as Kate
9
9
10−import Debug.Trace
11
10
12(|>) :: a -> (a -> b) -> b
11(|>) :: a -> (a -> b) -> b
13x |> f = f x
12x |> f = f x
src/Metadata/Prelude.hsnew file+94
@@ -0,0 +1,94 @@
1+{-# LANGUAGE FlexibleContexts #-}
2+module Metadata.Prelude (add) where
3+
4+import qualified Data.Map as Map
5+import qualified Data.Set as Set
6+
7+import qualified AST.Module as Module
8+import qualified AST.Variable as Var
9+
10+
11+-- DEFINITION OF THE PRELUDE
12+
13+type ImportDict =
14+ Map.Map Module.Name ([String], Var.Listing Var.Value)
15+
16+
17+prelude :: ImportDict
18+prelude =
19+ Map.unions [ string, text, maybe, openImports ]
20+ where
21+ importing :: Module.Name -> [Var.Value] -> ImportDict
22+ importing name values =
23+ Map.singleton name ([], Var.Listing values False)
24+
25+ openImports :: ImportDict
26+ openImports =
27+ Map.fromList $ map (\name -> (name, ([], Var.openListing))) $
28+ [ ["Basics"], ["Signal"], ["List"], ["Time"], ["Color"]
29+ , ["Graphics","Element"], ["Graphics","Collage"]
30+ , ["Native","Ports"], ["Native","Json"]
31+ ]
32+
33+ maybe :: ImportDict
34+ maybe = importing ["Maybe"] [ Var.ADT "Maybe" Var.openListing ]
35+
36+ string :: ImportDict
37+ string = importing ["String"] [Var.Value "show"]
38+
39+ text :: ImportDict
40+ text = importing ["Text"] (Var.ADT "Text" (Var.Listing [] False) : values)
41+ where
42+ values =
43+ map Var.Value
44+ [ "toText", "leftAligned", "rightAligned", "centered", "justified"
45+ , "plainText", "asText", "typeface", "monospace", "bold", "italic"
46+ ]
47+
48+
49+-- ADDING PRELUDE TO A MODULE
50+
51+add :: Bool -> Module.Module exs body -> Module.Module exs body
52+add noPrelude (Module.Module moduleName path exports imports decls) =
53+ Module.Module moduleName path exports ammendedImports decls
54+ where
55+ ammendedImports =
56+ importDictToList $
57+ foldr addImport (if noPrelude then Map.empty else prelude) imports
58+
59+
60+importDictToList :: ImportDict -> [(Module.Name, Module.ImportMethod)]
61+importDictToList dict =
62+ concatMap toImports (Map.toList dict)
63+ where
64+ toImports (name, (qualifiers, listing@(Var.Listing explicits open))) =
65+ map (\qualifier -> (name, Module.As qualifier)) qualifiers
66+ ++
67+ if open || not (null explicits)
68+ then [(name, Module.Open listing)]
69+ else []
70+
71+
72+addImport :: (Module.Name, Module.ImportMethod) -> ImportDict -> ImportDict
73+addImport (name, method) importDict =
74+ Map.alter mergeMethods name importDict
75+ where
76+ mergeMethods :: Maybe ([String], Var.Listing Var.Value)
77+ -> Maybe ([String], Var.Listing Var.Value)
78+ mergeMethods entry =
79+ let (qualifiers, listing) =
80+ case entry of
81+ Nothing -> ([], Var.Listing [] False)
82+ Just v -> v
83+ in
84+ case method of
85+ Module.As qualifier ->
86+ Just (qualifier : qualifiers, listing)
87+
88+ Module.Open newListing ->
89+ Just (qualifiers, mergeListings newListing listing)
90+
91+ mergeListings (Var.Listing explicits1 open1) (Var.Listing explicits2 open2) =
92+ Var.Listing
93+ (Set.toList (Set.fromList (explicits1 ++ explicits2)))
94+ (open1 || open2)
compiler/Parse/Binop.hs → src/Parse/Binop.hsrenamed+3−4
@@ -1,17 +1,16 @@
1−{-# OPTIONS_GHC -W #-}
2module Parse.Binop (binops, OpTable) where
1module Parse.Binop (binops, OpTable) where
3
2
4import Control.Applicative ((<$>))
3import Control.Applicative ((<$>))
5import qualified Data.List as List
4import qualified Data.List as List
6import qualified Data.Map as Map
5import qualified Data.Map as Map
6+import Text.Parsec ((<|>), choice, getState, try)
7
7
8import AST.Annotation (merge)
8import AST.Annotation (merge)
9−import AST.Declaration (Assoc(..))
9+import AST.Declaration (Assoc(L, N, R))
10import AST.Expression.General (Expr'(Binop))
10import AST.Expression.General (Expr'(Binop))
11import qualified AST.Expression.Source as Source
11import qualified AST.Expression.Source as Source
12import qualified AST.Variable as Var
12import qualified AST.Variable as Var
13−import Text.Parsec
13+import Parse.Helpers (IParser, OpTable, commitIf, failure, whitespace)
14−import Parse.Helpers
15
14
16opLevel :: OpTable -> String -> Int
15opLevel :: OpTable -> String -> Int
17opLevel table op = fst $ Map.findWithDefault (9,L) op table
16opLevel table op = fst $ Map.findWithDefault (9,L) op table
compiler/Parse/Declaration.hs → src/Parse/Declaration.hsrenamed+5−4
@@ -2,16 +2,17 @@
2module Parse.Declaration where
2module Parse.Declaration where
3
3
4import Control.Applicative ((<$>))
4import Control.Applicative ((<$>))
5−import Text.Parsec hiding (newline,spaces)
5+import Text.Parsec ((<|>), (<?>), choice, digit, optionMaybe, string, try)
6
6
7−import Parse.Helpers
7+import qualified AST.Declaration as D
8import qualified Parse.Expression as Expr
8import qualified Parse.Expression as Expr
9+import Parse.Helpers
9import qualified Parse.Type as Type
10import qualified Parse.Type as Type
10−import qualified AST.Declaration as D
11
11
12
12
13declaration :: IParser D.SourceDecl
13declaration :: IParser D.SourceDecl
14+declaration =
14−declaration = typeDecl <|> infixDecl <|> port <|> definition
15+ typeDecl <|> infixDecl <|> port <|> definition
15
16
16
17
17definition :: IParser D.SourceDecl
18definition :: IParser D.SourceDecl
compiler/Parse/Expression.hs → src/Parse/Expression.hsrenamed+44−38
@@ -1,18 +1,19 @@
1module Parse.Expression (def,term,typeAnnotation,expr) where
1module Parse.Expression (def,term,typeAnnotation,expr) where
2
2
3import Control.Applicative ((<$>), (<*>))
3import Control.Applicative ((<$>), (<*>))
4−import Data.List (foldl')
4+import qualified Data.List as List
5−import Text.Parsec hiding (newline,spaces)
5+import Text.Parsec hiding (newline, spaces)
6−import Text.Parsec.Indent
6+import Text.Parsec.Indent (block, withPos)
7−
7+
8−import Parse.Binop
8+import qualified Parse.Binop as Binop
9+import Parse.Helpers
9−import Parse.Helpers as Help
10+import qualified Parse.Helpers as Help
10−import Parse.Literal
11+import qualified Parse.Literal as Literal
11import qualified Parse.Pattern as Pattern
12import qualified Parse.Pattern as Pattern
12import qualified Parse.Type as Type
13import qualified Parse.Type as Type
13
14
14−import AST.Annotation as Annotation
15+import qualified AST.Annotation as Annotation
15−import AST.Expression.General
16+import qualified AST.Expression.General as E
16import qualified AST.Expression.Source as Source
17import qualified AST.Expression.Source as Source
17import qualified AST.Literal as L
18import qualified AST.Literal as L
18import qualified AST.Pattern as P
19import qualified AST.Pattern as P
@@ -25,45 +26,47 @@ varTerm :: IParser Source.Expr'
25varTerm = toVar <$> var <?> "variable"
26varTerm = toVar <$> var <?> "variable"
26
27
27toVar :: String -> Source.Expr'
28toVar :: String -> Source.Expr'
29+toVar v =
30+ case v of
28−toVar v = case v of "True" -> Literal (L.Boolean True)
31+ "True" -> E.Literal (L.Boolean True)
29− "False" -> Literal (L.Boolean False)
32+ "False" -> E.Literal (L.Boolean False)
30− _ -> rawVar v
33+ _ -> E.rawVar v
31
34
32accessor :: IParser Source.Expr'
35accessor :: IParser Source.Expr'
33accessor = do
36accessor = do
34 (start, lbl, end) <- located (try (string "." >> rLabel))
37 (start, lbl, end) <- located (try (string "." >> rLabel))
35 let loc e = Annotation.at start end e
38 let loc e = Annotation.at start end e
36− return (Lambda (P.Var "_") (loc $ Access (loc $ rawVar "_") lbl))
39+ return (E.Lambda (P.Var "_") (loc $ E.Access (loc $ E.rawVar "_") lbl))
37
40
38negative :: IParser Source.Expr'
41negative :: IParser Source.Expr'
39negative = do
42negative = do
40 (start, nTerm, end) <-
43 (start, nTerm, end) <-
41 located (try (char '-' >> notFollowedBy (char '.' <|> char '-')) >> term)
44 located (try (char '-' >> notFollowedBy (char '.' <|> char '-')) >> term)
42 let loc e = Annotation.at start end e
45 let loc e = Annotation.at start end e
43− return (Binop (Var.Raw "-") (loc $ Literal (L.IntNum 0)) nTerm)
46+ return (E.Binop (Var.Raw "-") (loc $ E.Literal (L.IntNum 0)) nTerm)
44
47
45
48
46-------- Complex Terms --------
49-------- Complex Terms --------
47
50
48listTerm :: IParser Source.Expr'
51listTerm :: IParser Source.Expr'
49−listTerm = markdown' <|> shader' <|> braces (try range <|> ExplicitList <$> commaSep expr)
52+listTerm = markdown' <|> shader' <|> braces (try range <|> E.ExplicitList <$> commaSep expr)
50 where
53 where
51 range = do
54 range = do
52 lo <- expr
55 lo <- expr
53 padded (string "..")
56 padded (string "..")
54− Range lo <$> expr
57+ E.Range lo <$> expr
55
58
56 markdown' = do
59 markdown' = do
57 pos <- getPosition
60 pos <- getPosition
58 let uid = show (sourceLine pos) ++ ":" ++ show (sourceColumn pos)
61 let uid = show (sourceLine pos) ++ ":" ++ show (sourceColumn pos)
59 (rawText, exprs) <- Help.markdown (interpolation uid)
62 (rawText, exprs) <- Help.markdown (interpolation uid)
60− return (Markdown uid (filter (/='\r') rawText) exprs)
63+ return (E.Markdown uid (filter (/='\r') rawText) exprs)
61
64
62 shader' = do
65 shader' = do
63 pos <- getPosition
66 pos <- getPosition
64 let uid = show (sourceLine pos) ++ ":" ++ show (sourceColumn pos)
67 let uid = show (sourceLine pos) ++ ":" ++ show (sourceColumn pos)
65 (rawSrc, tipe) <- Help.shader
68 (rawSrc, tipe) <- Help.shader
66− return $ GLShader uid (filter (/='\r') rawSrc) tipe
69+ return $ E.GLShader uid (filter (/='\r') rawSrc) tipe
67
70
68 span uid index =
71 span uid index =
69 "<span id=\"md-" ++ uid ++ "-" ++ show index ++
72 "<span id=\"md-" ++ uid ++ "-" ++ show index ++
@@ -81,22 +84,22 @@ parensTerm = try (parens opFn) <|> parens (tupleFn <|> parened)
81 opFn = do
84 opFn = do
82 (start, op, end) <- located anyOp
85 (start, op, end) <- located anyOp
83 let loc = Annotation.at start end
86 let loc = Annotation.at start end
84− return . loc . Lambda (P.Var "x") . loc . Lambda (P.Var "y") . loc $
87+ return . loc . E.Lambda (P.Var "x") . loc . E.Lambda (P.Var "y") . loc $
85− Binop (Var.Raw op) (loc (rawVar "x")) (loc (rawVar "y"))
88+ E.Binop (Var.Raw op) (loc (E.rawVar "x")) (loc (E.rawVar "y"))
86
89
87 tupleFn = do
90 tupleFn = do
88 let comma = char ',' <?> "comma ','"
91 let comma = char ',' <?> "comma ','"
89 (start, commas, end) <- located (comma >> many (whitespace >> comma))
92 (start, commas, end) <- located (comma >> many (whitespace >> comma))
90 let vars = map (('v':) . show) [ 0 .. length commas + 1 ]
93 let vars = map (('v':) . show) [ 0 .. length commas + 1 ]
91 loc = Annotation.at start end
94 loc = Annotation.at start end
92− return $ foldr (\x e -> loc $ Lambda x e)
95+ return $ foldr (\x e -> loc $ E.Lambda x e)
93− (loc . tuple $ map (loc . rawVar) vars) (map P.Var vars)
96+ (loc . E.tuple $ map (loc . E.rawVar) vars) (map P.Var vars)
94
97
95 parened = do
98 parened = do
96 (start, es, end) <- located (commaSep expr)
99 (start, es, end) <- located (commaSep expr)
97 return $ case es of
100 return $ case es of
98 [e] -> e
101 [e] -> e
99− _ -> Annotation.at start end (tuple es)
102+ _ -> Annotation.at start end (E.tuple es)
100
103
101recordTerm :: IParser Source.Expr
104recordTerm :: IParser Source.Expr
102recordTerm = brackets $ choice [ misc, addLocation record ]
105recordTerm = brackets $ choice [ misc, addLocation record ]
@@ -108,24 +111,24 @@ recordTerm = brackets $ choice [ misc, addLocation record ]
108 body <- expr
111 body <- expr
109 return (label, makeFunction patterns body)
112 return (label, makeFunction patterns body)
110
113
111− record = Record <$> commaSep field
114+ record = E.Record <$> commaSep field
112
115
113 change = do
116 change = do
114 lbl <- rLabel
117 lbl <- rLabel
115 padded (string "<-")
118 padded (string "<-")
116 (,) lbl <$> expr
119 (,) lbl <$> expr
117
120
118− remove r = addLocation (string "-" >> whitespace >> Remove r <$> rLabel)
121+ remove r = addLocation (string "-" >> whitespace >> E.Remove r <$> rLabel)
119
122
120 insert r = addLocation $ do
123 insert r = addLocation $ do
121 string "|" >> whitespace
124 string "|" >> whitespace
122− Insert r <$> rLabel <*> (padded equals >> expr)
125+ E.Insert r <$> rLabel <*> (padded equals >> expr)
123
126
124 modify r =
127 modify r =
125− addLocation (string "|" >> whitespace >> Modify r <$> commaSep1 change)
128+ addLocation (string "|" >> whitespace >> E.Modify r <$> commaSep1 change)
126
129
127 misc = try $ do
130 misc = try $ do
128− record <- addLocation (rawVar <$> rLabel)
131+ record <- addLocation (E.rawVar <$> rLabel)
129 opt <- padded (optionMaybe (remove record))
132 opt <- padded (optionMaybe (remove record))
130 case opt of
133 case opt of
131 Just e -> try (insert e) <|> return e
134 Just e -> try (insert e) <|> return e
@@ -133,7 +136,7 @@ recordTerm = brackets $ choice [ misc, addLocation record ]
133
136
134
137
135term :: IParser Source.Expr
138term :: IParser Source.Expr
136−term = addLocation (choice [ Literal <$> literal, listTerm, accessor, negative ])
139+term = addLocation (choice [ E.Literal <$> Literal.literal, listTerm, accessor, negative ])
137 <|> accessible (addLocation varTerm <|> parensTerm <|> recordTerm)
140 <|> accessible (addLocation varTerm <|> parensTerm <|> recordTerm)
138 <?> "basic term (4, x, 'c', etc.)"
141 <?> "basic term (4, x, 'c', etc.)"
139
142
@@ -146,12 +149,12 @@ appExpr = do
146 if null str then notFollowedBy (char '-') else return ()
149 if null str then notFollowedBy (char '-') else return ()
147 return $ case ts of
150 return $ case ts of
148 [] -> t
151 [] -> t
149− _ -> foldl' (\f x -> Annotation.merge f x $ App f x) t ts
152+ _ -> List.foldl' (\f x -> Annotation.merge f x $ E.App f x) t ts
150
153
151-------- Normal Expressions --------
154-------- Normal Expressions --------
152
155
153binaryExpr :: IParser Source.Expr
156binaryExpr :: IParser Source.Expr
154−binaryExpr = binops appExpr lastExpr anyOp
157+binaryExpr = Binop.binops appExpr lastExpr anyOp
155 where lastExpr = addLocation (choice [ ifExpr, letExpr, caseExpr ])
158 where lastExpr = addLocation (choice [ ifExpr, letExpr, caseExpr ])
156 <|> lambdaExpr
159 <|> lambdaExpr
157
160
@@ -164,9 +167,12 @@ ifExpr = reserved "if" >> whitespace >> (normal <|> multiIf)
164 thenBranch <- expr
167 thenBranch <- expr
165 whitespace <?> "an 'else' branch" ; reserved "else" <?> "an 'else' branch" ; whitespace
168 whitespace <?> "an 'else' branch" ; reserved "else" <?> "an 'else' branch" ; whitespace
166 elseBranch <- expr
169 elseBranch <- expr
170+ return $ E.MultiIf
167− return $ MultiIf [(bool, thenBranch),
171+ [ (bool, thenBranch)
168− (Annotation.sameAs elseBranch (Literal . L.Boolean $ True), elseBranch)]
172+ , (Annotation.sameAs elseBranch (E.Literal . L.Boolean $ True), elseBranch)
173+ ]
174+
169− multiIf = MultiIf <$> spaceSep1 iff
175+ multiIf = E.MultiIf <$> spaceSep1 iff
170 where iff = do string "|" ; whitespace
176 where iff = do string "|" ; whitespace
171 b <- expr ; padded arrow
177 b <- expr ; padded arrow
172 (,) b <$> expr
178 (,) b <$> expr
@@ -187,12 +193,12 @@ letExpr = do
187 reserved "let" ; whitespace
193 reserved "let" ; whitespace
188 defs <- defSet
194 defs <- defSet
189 padded (reserved "in")
195 padded (reserved "in")
190− Let defs <$> expr
196+ E.Let defs <$> expr
191
197
192caseExpr :: IParser Source.Expr'
198caseExpr :: IParser Source.Expr'
193caseExpr = do
199caseExpr = do
194 reserved "case"; e <- padded expr; reserved "of"; whitespace
200 reserved "case"; e <- padded expr; reserved "of"; whitespace
195− Case e <$> (with <|> without)
201+ E.Case e <$> (with <|> without)
196 where case_ = do p <- Pattern.expr
202 where case_ = do p <- Pattern.expr
197 padded arrow
203 padded arrow
198 (,) p <$> expr
204 (,) p <$> expr
@@ -226,8 +232,8 @@ defStart =
226 else [ P.Var (o:p), p1, p2 ]
232 else [ P.Var (o:p), p1, p2 ]
227
233
228makeFunction :: [P.RawPattern] -> Source.Expr -> Source.Expr
234makeFunction :: [P.RawPattern] -> Source.Expr -> Source.Expr
229−makeFunction args body@(A ann _) =
235+makeFunction args body@(Annotation.A ann _) =
230− foldr (\arg body' -> A ann $ Lambda arg body') body args
236+ foldr (\arg body' -> Annotation.A ann $ E.Lambda arg body') body args
231
237
232definition :: IParser Source.Def
238definition :: IParser Source.Def
233definition = withPos $ do
239definition = withPos $ do
compiler/Parse/Helpers.hs → src/Parse/Helpers.hsrenamed+57−40
@@ -1,25 +1,24 @@
1−{-# OPTIONS_GHC -W #-}
2module Parse.Helpers where
1module Parse.Helpers where
3
2
4import Prelude hiding (until)
3import Prelude hiding (until)
5import Control.Applicative ((<$>),(<*>))
4import Control.Applicative ((<$>),(<*>))
6−import Control.Monad
5+import Control.Monad (guard, join, mzero)
7−import Control.Monad.State
6+import Control.Monad.State (State)
8import Data.Char (isUpper)
7import Data.Char (isUpper)
9import qualified Data.Map as Map
8import qualified Data.Map as Map
10import qualified Language.GLSL.Parser as GLP
9import qualified Language.GLSL.Parser as GLP
11−import Language.GLSL.Syntax as GLS
10+import qualified Language.GLSL.Syntax as GLS
12import Text.Parsec hiding (newline,spaces,State)
11import Text.Parsec hiding (newline,spaces,State)
13−import Text.Parsec.Indent
12+import Text.Parsec.Indent (indented, runIndent)
14import qualified Text.Parsec.Token as T
13import qualified Text.Parsec.Token as T
15
14
16−import AST.Annotation as Annotation
15+import qualified AST.Annotation as Annotation
17−import AST.Declaration (Assoc)
16+import qualified AST.Declaration as Decl
18−import AST.Expression.General
17+import qualified AST.Expression.General as E
19import qualified AST.Expression.Source as Source
18import qualified AST.Expression.Source as Source
20−import AST.Helpers as Help
19+import qualified AST.Helpers as Help
21−import AST.Literal as Literal
20+import qualified AST.Literal as L
22−import AST.PrettyPrint
21+import qualified AST.PrettyPrint as P
23import qualified AST.Variable as Variable
22import qualified AST.Variable as Variable
24
23
25reserveds :: [String]
24reserveds :: [String]
@@ -36,7 +35,7 @@ reserveds =
36
35
37expecting = flip (<?>)
36expecting = flip (<?>)
38
37
39−type OpTable = Map.Map String (Int, Assoc)
38+type OpTable = Map.Map String (Int, Decl.Assoc)
40type SourceM = State SourcePos
39type SourceM = State SourcePos
41type IParser a = ParsecT String OpTable SourceM a
40type IParser a = ParsecT String OpTable SourceM a
42
41
@@ -173,7 +172,7 @@ parens = surround '(' ')' "paren"
173brackets :: IParser a -> IParser a
172brackets :: IParser a -> IParser a
174brackets = surround '{' '}' "bracket"
173brackets = surround '{' '}' "bracket"
175
174
176−addLocation :: (Pretty a) => IParser a -> IParser (Annotation.Located a)
175+addLocation :: (P.Pretty a) => IParser a -> IParser (Annotation.Located a)
177addLocation expr = do
176addLocation expr = do
178 (start, e, end) <- located expr
177 (start, e, end) <- located expr
179 return (Annotation.at start end e)
178 return (Annotation.at start end e)
@@ -188,7 +187,7 @@ located p = do
188accessible :: IParser Source.Expr -> IParser Source.Expr
187accessible :: IParser Source.Expr -> IParser Source.Expr
189accessible expr = do
188accessible expr = do
190 start <- getPosition
189 start <- getPosition
191− ce@(A _ e) <- expr
190+ ce@(Annotation.A _ e) <- expr
192 let rest f = do
191 let rest f = do
193 let dot = char '.' >> notFollowedBy (char '.')
192 let dot = char '.' >> notFollowedBy (char '.')
194 access <- optionMaybe (try dot <?> "field access (e.g. List.map)")
193 access <- optionMaybe (try dot <?> "field access (e.g. List.map)")
@@ -199,10 +198,10 @@ accessible expr = do
199 end <- getPosition
198 end <- getPosition
200 return (Annotation.at start end (f v))
199 return (Annotation.at start end (f v))
201 case e of
200 case e of
202− Var (Variable.Raw (c:cs))
201+ E.Var (Variable.Raw (c:cs))
203− | isUpper c -> rest (\v -> rawVar (c:cs ++ '.':v))
202+ | isUpper c -> rest (\v -> E.rawVar (c:cs ++ '.':v))
204− | otherwise -> rest (Access ce)
203+ | otherwise -> rest (E.Access ce)
205− _ -> rest (Access ce)
204+ _ -> rest (E.Access ce)
206
205
207
206
208spaces :: IParser String
207spaces :: IParser String
@@ -309,7 +308,7 @@ markdown interpolation =
309 closeMarkdown (markdownBuilder . (c:)) stuff
308 closeMarkdown (markdownBuilder . (c:)) stuff
310 ]
309 ]
311
310
312−shader :: IParser (String, Literal.GLShaderTipe)
311+shader :: IParser (String, L.GLShaderTipe)
313shader =
312shader =
314 do try (string "[glsl|")
313 do try (string "[glsl|")
315 rawSrc <- closeShader id
314 rawSrc <- closeShader id
@@ -324,35 +323,53 @@ shader =
324 closeShader (builder . (c:))
323 closeShader (builder . (c:))
325 ]
324 ]
326
325
327−glSource :: String -> Either ParseError Literal.GLShaderTipe
326+glSource :: String -> Either ParseError L.GLShaderTipe
328glSource src =
327glSource src =
329 case GLP.parse src of
328 case GLP.parse src of
330− Right (TranslationUnit decls) ->
329+ Right (GLS.TranslationUnit decls) ->
331 Right . foldr addGLinput emptyDecls . join . map extractGLinputs $ decls
330 Right . foldr addGLinput emptyDecls . join . map extractGLinputs $ decls
332 Left e -> Left e
331 Left e -> Left e
333 where
332 where
334− emptyDecls = Literal.GLShaderTipe Map.empty Map.empty Map.empty
333+ emptyDecls = L.GLShaderTipe Map.empty Map.empty Map.empty
334+
335− addGLinput (qual,tipe,name) glDecls = case qual of
335+ addGLinput (qual,tipe,name) glDecls =
336+ case qual of
337+ GLS.Attribute ->
336− Attribute -> glDecls { attribute = Map.insert name tipe $ attribute glDecls }
338+ glDecls { L.attribute = Map.insert name tipe $ L.attribute glDecls }
339+
340+ GLS.Uniform ->
337− Uniform -> glDecls { uniform = Map.insert name tipe $ uniform glDecls }
341+ glDecls { L.uniform = Map.insert name tipe $ L.uniform glDecls }
342+
343+ GLS.Varying ->
338− Varying -> glDecls { varying = Map.insert name tipe $ varying glDecls }
344+ glDecls { L.varying = Map.insert name tipe $ L.varying glDecls }
345+
339 _ -> error "Should never happen due to below filter"
346 _ -> error "Should never happen due to below filter"
347+
340− extractGLinputs decl = case decl of
348+ extractGLinputs decl =
349+ case decl of
350+ GLS.Declaration
351+ (GLS.InitDeclaration
352+ (GLS.TypeDeclarator
353+ (GLS.FullType
354+ (Just (GLS.TypeQualSto qual))
341− Declaration (InitDeclaration (TypeDeclarator (FullType (Just (TypeQualSto qual)) (TypeSpec _prec (TypeSpecNoPrecision tipe _mexpr1)))) [InitDecl name _mexpr2 _mexpr3]) ->
355+ (GLS.TypeSpec _prec (GLS.TypeSpecNoPrecision tipe _mexpr1))))
356+ [GLS.InitDecl name _mexpr2 _mexpr3]
357+ ) ->
342− if elem qual [Attribute, Varying, Uniform]
358+ case elem qual [GLS.Attribute, GLS.Varying, GLS.Uniform] of
359+ False -> []
360+ True ->
343− then case tipe of
361+ case tipe of
344− GLS.Int -> return (qual,Literal.Int,name)
362+ GLS.Int -> return (qual, L.Int,name)
345− GLS.Float -> return (qual,Literal.Float,name)
363+ GLS.Float -> return (qual, L.Float,name)
346− GLS.Vec2 -> return (qual,V2,name)
364+ GLS.Vec2 -> return (qual, L.V2,name)
347− GLS.Vec3 -> return (qual,V3,name)
365+ GLS.Vec3 -> return (qual, L.V3,name)
348− GLS.Vec4 -> return (qual,V4,name)
366+ GLS.Vec4 -> return (qual, L.V4,name)
349− GLS.Mat4 -> return (qual,M4,name)
367+ GLS.Mat4 -> return (qual, L.M4,name)
350− GLS.Sampler2D -> return (qual,Texture,name)
368+ GLS.Sampler2D -> return (qual, L.Texture,name)
351− _ -> []
369+ _ -> []
352− else []
353 _ -> []
370 _ -> []
354
371
355−--str :: IParser String
372+str :: IParser String
356str = expecting "String" $ do
373str = expecting "String" $ do
357 s <- choice [ multiStr, singleStr ]
374 s <- choice [ multiStr, singleStr ]
358 processAs T.stringLiteral . sandwich '\"' $ concat s
375 processAs T.stringLiteral . sandwich '\"' $ concat s
compiler/Parse/Literal.hs → src/Parse/Literal.hsrenamed+7−8
@@ -1,20 +1,19 @@
1−{-# OPTIONS_GHC -W #-}
2module Parse.Literal (literal) where
1module Parse.Literal (literal) where
3
2
4import Control.Applicative ((<$>))
3import Control.Applicative ((<$>))
5import Text.Parsec hiding (newline,spaces)
4import Text.Parsec hiding (newline,spaces)
6−import Parse.Helpers
5+import Parse.Helpers (IParser, chr, str)
7−import AST.Literal
6+import qualified AST.Literal as L
8
7
9−literal :: IParser Literal
8+literal :: IParser L.Literal
10−literal = num <|> (Str <$> str) <|> (Chr <$> chr) <?> "literal"
9+literal = num <|> (L.Str <$> str) <|> (L.Chr <$> chr) <?> "literal"
11
10
12−num :: IParser Literal
11+num :: IParser L.Literal
13num = toLit <$> (number <?> "number")
12num = toLit <$> (number <?> "number")
14 where
13 where
15 toLit n
14 toLit n
16− | any (`elem` ".eE") n = FloatNum (read n)
15+ | any (`elem` ".eE") n = L.FloatNum (read n)
17− | otherwise = IntNum (read n)
16+ | otherwise = L.IntNum (read n)
18
17
19 number = concat <$> sequence
18 number = concat <$> sequence
20 [ option "" minus
19 [ option "" minus
src/Parse/Module.hsnew file+88
@@ -0,0 +1,88 @@
1+module Parse.Module (header, headerAndImports, getModuleName) where
2+
3+import Control.Applicative ((<$>), (<*>))
4+import Data.List (intercalate)
5+import Text.Parsec hiding (newline, spaces)
6+
7+import Parse.Helpers
8+import qualified AST.Module as Module
9+import qualified AST.Variable as Var
10+
11+getModuleName :: String -> Maybe String
12+getModuleName source =
13+ case iParse getModuleName source of
14+ Right name -> Just name
15+ Left _ -> Nothing
16+ where
17+ getModuleName = do
18+ optional freshLine
19+ (names, _) <- header
20+ return (intercalate "." names)
21+
22+headerAndImports :: IParser Module.HeaderAndImports
23+headerAndImports =
24+ do optional freshLine
25+ (names, exports) <-
26+ option (["Main"], Var.openListing) (header `followedBy` freshLine)
27+ imports' <- commitToImports <|> return []
28+ return $ Module.HeaderAndImports names exports imports'
29+ where
30+ commitToImports =
31+ do try (lookAhead $ reserved "import")
32+ imports `followedBy` freshLine
33+
34+header :: IParser ([String], Var.Listing Var.Value)
35+header = do
36+ try (reserved "module")
37+ whitespace
38+ names <- dotSep1 capVar <?> "name of module"
39+ whitespace
40+ exports <- option Var.openListing (listing value)
41+ whitespace <?> "reserved word 'where'"
42+ reserved "where"
43+ return (names, exports)
44+
45+imports :: IParser [(Module.Name, Module.ImportMethod)]
46+imports = option [] ((:) <$> import' <*> many (try (freshLine >> import')))
47+
48+import' :: IParser (Module.Name, Module.ImportMethod)
49+import' =
50+ do reserved "import"
51+ whitespace
52+ names <- dotSep1 capVar
53+ (,) names <$> option (Module.As (intercalate "." names)) method
54+ where
55+ method :: IParser Module.ImportMethod
56+ method = as' <|> importing'
57+
58+ as' :: IParser Module.ImportMethod
59+ as' = do
60+ try (whitespace >> reserved "as")
61+ whitespace
62+ Module.As <$> capVar <?> "alias for module"
63+
64+ importing' :: IParser Module.ImportMethod
65+ importing' = Module.Open <$> listing value
66+
67+listing :: IParser a -> IParser (Var.Listing a)
68+listing item =
69+ do try (whitespace >> char '(')
70+ whitespace
71+ listing <- choice [ const Var.openListing <$> string ".."
72+ , Var.Listing <$> commaSep1 item <*> return False
73+ ] <?> "listing of values (x,y,z)"
74+ whitespace
75+ char ')'
76+ return listing
77+
78+value :: IParser Var.Value
79+value = val <|> tipe
80+ where
81+ val = Var.Value <$> (lowVar <|> parens symOp)
82+
83+ tipe = do
84+ name <- capVar
85+ maybeCtors <- optionMaybe (listing capVar)
86+ case maybeCtors of
87+ Nothing -> return (Var.Alias name)
88+ Just ctors -> return (Var.ADT name ctors)
compiler/Parse/Parse.hs → src/Parse/Parse.hsrenamed+11−24
@@ -1,18 +1,16 @@
1−{-# OPTIONS_GHC -W #-}
2−module Parse.Parse (program, dependencies) where
1+module Parse.Parse (program) where
3
2
4−import Control.Applicative ((<$>), (<*>))
3+import Control.Applicative ((<$>))
5import qualified Data.List as List
4import qualified Data.List as List
6import qualified Data.Map as Map
5import qualified Data.Map as Map
7−import Text.Parsec hiding (newline,spaces)
6+import Text.Parsec hiding (newline, spaces)
8import qualified Text.PrettyPrint as P
7import qualified Text.PrettyPrint as P
9
8
10import qualified AST.Declaration as D
9import qualified AST.Declaration as D
11import qualified AST.Module as M
10import qualified AST.Module as M
12−import qualified AST.Variable as Var
13import Parse.Helpers
11import Parse.Helpers
14import Parse.Declaration (infixDecl)
12import Parse.Declaration (infixDecl)
15−import Parse.Module
13+import qualified Parse.Module as Module
16import qualified Parse.Declaration as Decl
14import qualified Parse.Declaration as Decl
17import Transform.Declaration (combineAnnotations)
15import Transform.Declaration (combineAnnotations)
18
16
@@ -25,30 +23,19 @@ decls = do d <- Decl.declaration <?> "at least one datatype or variable definiti
25
23
26program :: OpTable -> String -> Either [P.Doc] M.ValidModule
24program :: OpTable -> String -> Either [P.Doc] M.ValidModule
27program table src =
25program table src =
28− do (M.Module names filePath exs ims parseDecls) <-
26+ do (M.Module names filePath exs ims sourceDecls) <-
29 setupParserWithTable table programParser src
27 setupParserWithTable table programParser src
28+
30 decls <-
29 decls <-
31− either (\err -> Left [P.text err]) Right (combineAnnotations parseDecls)
30+ either (\err -> Left [P.text err]) Right (combineAnnotations sourceDecls)
32 return $ M.Module names filePath exs ims decls
31 return $ M.Module names filePath exs ims decls
33
32
34programParser :: IParser M.SourceModule
33programParser :: IParser M.SourceModule
35programParser =
34programParser =
36− do optional freshLine
35+ do (M.HeaderAndImports names exports imports) <- Module.headerAndImports
37− (names,exports) <-
38− option (["Main"], Var.openListing) (moduleDef `followedBy` freshLine)
39− is <- (do try (lookAhead $ reserved "import")
40− imports `followedBy` freshLine) <|> return []
41− declarations <- decls
36+ declarations <- decls
42− optional freshLine ; optional spaces ; eof
37+ optional freshLine ; optional spaces ; eof
43− return $ M.Module names "" exports is declarations
38+ return $ M.Module names "" exports imports declarations
44−
45−dependencies :: String -> Either [P.Doc] (String, [String])
46−dependencies =
47− let getName = List.intercalate "." . fst in
48− setupParser $ do
49− optional freshLine
50− (,) <$> option "Main" (getName <$> moduleDef `followedBy` freshLine)
51− <*> option [] (map fst <$> imports `followedBy` freshLine)
52
39
53setupParserWithTable :: OpTable -> IParser a -> String -> Either [P.Doc] a
40setupParserWithTable :: OpTable -> IParser a -> String -> Either [P.Doc] a
54setupParserWithTable table p source =
41setupParserWithTable table p source =
compiler/Parse/Pattern.hs → src/Parse/Pattern.hsrenamed+14−13
@@ -1,28 +1,29 @@
1−{-# OPTIONS_GHC -W #-}
2module Parse.Pattern (term, expr) where
1module Parse.Pattern (term, expr) where
3
2
4import Control.Applicative ((<$>))
3import Control.Applicative ((<$>))
5import Data.Char (isUpper)
4import Data.Char (isUpper)
6import qualified Data.List as List
5import qualified Data.List as List
7−import Text.Parsec hiding (newline,spaces,State)
6+import Text.Parsec ((<|>), (<?>), char, choice, optionMaybe, try)
8
7
9import Parse.Helpers
8import Parse.Helpers
10−import Parse.Literal
9+import qualified Parse.Literal as Literal
11−import AST.Literal
10+import qualified AST.Literal as L
12import qualified AST.Pattern as P
11import qualified AST.Pattern as P
13import qualified AST.Variable as Var
12import qualified AST.Variable as Var
14
13
15basic :: IParser P.RawPattern
14basic :: IParser P.RawPattern
16basic = choice
15basic = choice
17 [ char '_' >> return P.Anything
16 [ char '_' >> return P.Anything
18− , do v <- var
17+ , stringToPattern <$> var
19− return $ case v of
20− "True" -> P.Literal (Boolean True)
21− "False" -> P.Literal (Boolean False)
22− c:_ | isUpper c -> P.Data (Var.Raw v) []
23− _ -> P.Var v
24− , P.Literal <$> literal
18+ , P.Literal <$> Literal.literal
25 ]
19 ]
20+ where
21+ stringToPattern v =
22+ case v of
23+ "True" -> P.Literal (L.Boolean True)
24+ "False" -> P.Literal (L.Boolean False)
25+ c:_ | isUpper c -> P.Data (Var.Raw v) []
26+ _ -> P.Var v
26
27
27asPattern :: P.RawPattern -> IParser P.RawPattern
28asPattern :: P.RawPattern -> IParser P.RawPattern
28asPattern pattern = do
29asPattern pattern = do
@@ -52,8 +53,8 @@ patternConstructor :: IParser P.RawPattern
52patternConstructor = do
53patternConstructor = do
53 v <- List.intercalate "." <$> dotSep1 capVar
54 v <- List.intercalate "." <$> dotSep1 capVar
54 case v of
55 case v of
55− "True" -> return $ P.Literal (Boolean True)
56+ "True" -> return $ P.Literal (L.Boolean True)
56− "False" -> return $ P.Literal (Boolean False)
57+ "False" -> return $ P.Literal (L.Boolean False)
57 _ -> P.Data (Var.Raw v) <$> spacePrefix term
58 _ -> P.Data (Var.Raw v) <$> spacePrefix term
58
59
59expr :: IParser P.RawPattern
60expr :: IParser P.RawPattern
compiler/Parse/Type.hs → src/Parse/Type.hsrenamed+1−1
@@ -3,7 +3,7 @@ module Parse.Type where
3
3
4import Control.Applicative ((<$>),(<*>),(<*))
4import Control.Applicative ((<$>),(<*>),(<*))
5import Data.List (intercalate)
5import Data.List (intercalate)
6−import Text.Parsec
6+import Text.Parsec ((<|>), (<?>), char, many, optionMaybe, string, try)
7
7
8import qualified AST.Type as T
8import qualified AST.Type as T
9import qualified AST.Variable as Var
9import qualified AST.Variable as Var
compiler/Paths_Elm → src/Paths_Elmrenamed

The content is the same.

compiler/Transform/Canonicalize.hs → src/Transform/Canonicalize.hsrenamed+99−66
@@ -1,4 +1,3 @@
1−{-# OPTIONS_GHC -W #-}
2module Transform.Canonicalize (module') where
1module Transform.Canonicalize (module') where
3
2
4import Control.Applicative ((<$>),(<*>))
3import Control.Applicative ((<$>),(<*>))
@@ -30,6 +29,7 @@ import qualified Transform.Canonicalize.Variable as Canonicalize
30import qualified Transform.SortDefinitions as Transform
29import qualified Transform.SortDefinitions as Transform
31import qualified Transform.Declaration as Transform
30import qualified Transform.Declaration as Transform
32
31
32+
33module' :: Module.Interfaces -> Module.ValidModule -> Either [Doc] Module.CanonicalModule
33module' :: Module.Interfaces -> Module.ValidModule -> Either [Doc] Module.CanonicalModule
34module' interfaces modul =
34module' interfaces modul =
35 filterImports <$> modul'
35 filterImports <$> modul'
@@ -41,15 +41,17 @@ module' interfaces modul =
41 let used (name,_) = Set.member name usedModules
41 let used (name,_) = Set.member name usedModules
42 in m { Module.imports = filter used (Module.imports m) }
42 in m { Module.imports = filter used (Module.imports m) }
43
43
44+
44moduleHelp :: Module.Interfaces -> Module.ValidModule
45moduleHelp :: Module.Interfaces -> Module.ValidModule
45 -> Canonicalizer [Doc] Module.CanonicalModule
46 -> Canonicalizer [Doc] Module.CanonicalModule
46moduleHelp interfaces modul@(Module.Module _ _ exports _ decls) =
47moduleHelp interfaces modul@(Module.Module _ _ exports _ decls) =
47− do env <- Setup.environment interfaces modul
48+ do env <- Setup.environment interfaces modul
48− canonicalDecls <- mapM (declaration env) decls
49+ canonicalDecls <- mapM (declaration env) decls
49− exports' <- resolveExports locals exports
50+ exports' <- resolveExports locals exports
51+ return $ modul
50− return $ modul { Module.exports = exports'
52+ { Module.exports = exports'
51− , Module.body = body canonicalDecls
53+ , Module.body = body canonicalDecls
52− }
54+ }
53 where
55 where
54 locals :: [Var.Value]
56 locals :: [Var.Value]
55 locals = concatMap declToValue decls
57 locals = concatMap declToValue decls
@@ -58,7 +60,7 @@ moduleHelp interfaces modul@(Module.Module _ _ exports _ decls) =
58 body decls =
60 body decls =
59 Module.CanonicalBody
61 Module.CanonicalBody
60 { program =
62 { program =
61− let expr = Transform.toExpr (Module.getName modul) decls
63+ let expr = Transform.toExpr (Module.names modul) decls
62 in Transform.sortDefs (dummyLet expr)
64 in Transform.sortDefs (dummyLet expr)
63 , types = Map.empty
65 , types = Map.empty
64 , datatypes =
66 , datatypes =
@@ -71,6 +73,7 @@ moduleHelp interfaces modul@(Module.Module _ _ exports _ decls) =
71 [ D.portName port | D.Port port <- decls ]
73 [ D.portName port | D.Port port <- decls ]
72 }
74 }
73
75
76+
74resolveExports :: [Var.Value] -> Var.Listing Var.Value -> Canonicalizer [Doc] [Var.Value]
77resolveExports :: [Var.Value] -> Var.Listing Var.Value -> Canonicalizer [Doc] [Var.Value]
75resolveExports fullList (Var.Listing partialList open) =
78resolveExports fullList (Var.Listing partialList open) =
76 if open
79 if open
@@ -121,6 +124,7 @@ resolveExports fullList (Var.Listing partialList open) =
121 commaSep (map pretty xs)
124 commaSep (map pretty xs)
122 ]
125 ]
123
126
127+
124{-| Split a list of values into categories so we can work with them
128{-| Split a list of values into categories so we can work with them
125independently.
129independently.
126-}
130-}
@@ -131,8 +135,12 @@ splitValues mixedValues =
131 x:xs ->
135 x:xs ->
132 let (values, aliases, adts) = splitValues xs in
136 let (values, aliases, adts) = splitValues xs in
133 case x of
137 case x of
138+ Var.Value name ->
134− Var.Value name -> (name : values, aliases, adts)
139+ (name : values, aliases, adts)
140+
141+ Var.Alias name ->
135− Var.Alias name -> (values, name : aliases, adts)
142+ (values, name : aliases, adts)
143+
136 Var.ADT name listing ->
144 Var.ADT name listing ->
137 (values, aliases, (name, listing) : adts)
145 (values, aliases, (name, listing) : adts)
138
146
@@ -155,6 +163,7 @@ declToValue decl =
155
163
156 _ -> []
164 _ -> []
157
165
166+
158declaration :: Environment -> D.ValidDecl -> Canonicalizer [Doc] D.CanonicalDecl
167declaration :: Environment -> D.ValidDecl -> Canonicalizer [Doc] D.CanonicalDecl
159declaration env decl =
168declaration env decl =
160 let canonicalize kind context pattern env v =
169 let canonicalize kind context pattern env v =
@@ -165,103 +174,127 @@ declaration env decl =
165 in
174 in
166 case decl of
175 case decl of
167 D.Definition (Valid.Definition p e t) ->
176 D.Definition (Valid.Definition p e t) ->
168− do p' <- canonicalize pattern "definition" p env p
177+ do p' <- canonicalize pattern "definition" p env p
169− e' <- expression env e
178+ e' <- expression env e
170− t' <- T.traverse (canonicalize Canonicalize.tipe "definition" p env) t
179+ t' <- T.traverse (canonicalize Canonicalize.tipe "definition" p env) t
171− return $ D.Definition (Canonical.Definition p' e' t')
180+ return $ D.Definition (Canonical.Definition p' e' t')
172
181
173 D.Datatype name tvars ctors ->
182 D.Datatype name tvars ctors ->
174 D.Datatype name tvars <$> mapM canonicalize' ctors
183 D.Datatype name tvars <$> mapM canonicalize' ctors
175− where
184+ where
176− canonicalize' (ctor,args) =
185+ canonicalize' (ctor,args) =
177− (,) ctor <$> mapM (canonicalize Canonicalize.tipe "datatype" name env) args
186+ (,) ctor <$> mapM (canonicalize Canonicalize.tipe "datatype" name env) args
178
187
179 D.TypeAlias name tvars expanded ->
188 D.TypeAlias name tvars expanded ->
180− do expanded' <- canonicalize Canonicalize.tipe "type alias" name env expanded
189+ do expanded' <- canonicalize Canonicalize.tipe "type alias" name env expanded
181− return (D.TypeAlias name tvars expanded')
190+ return (D.TypeAlias name tvars expanded')
182−
191+
183− D.Port port -> do
192+ D.Port port ->
184− Env.uses "Native.Ports"
193+ do Env.uses ["Native","Ports"]
185− Env.uses "Native.Json"
194+ Env.uses ["Native","Json"]
195+ D.Port <$>
186− D.Port <$> case port of
196+ case port of
187− D.In name t ->
197+ D.In name t ->
188− do t' <- canonicalize Canonicalize.tipe "port" name env t
198+ do t' <- canonicalize Canonicalize.tipe "port" name env t
189− return (D.In name t')
199+ return (D.In name t')
190− D.Out name e t ->
200+ D.Out name e t ->
191− do e' <- expression env e
201+ do e' <- expression env e
192− t' <- canonicalize Canonicalize.tipe "port" name env t
202+ t' <- canonicalize Canonicalize.tipe "port" name env t
193− return (D.Out name e' t')
203+ return (D.Out name e' t')
194−
204+
205+ D.Fixity assoc prec op ->
195− D.Fixity assoc prec op -> return $ D.Fixity assoc prec op
206+ return $ D.Fixity assoc prec op
196
207
197
208
198expression :: Environment -> Valid.Expr -> Canonicalizer [Doc] Canonical.Expr
209expression :: Environment -> Valid.Expr -> Canonicalizer [Doc] Canonical.Expr
199expression env (A.A ann expr) =
210expression env (A.A ann expr) =
200 let go = expression env
211 let go = expression env
201 tipe' environ = format . Canonicalize.tipe environ
212 tipe' environ = format . Canonicalize.tipe environ
213+ throw err =
214+ P.vcat
202− throw err = P.vcat [ P.text "Error" <+> pretty ann <> P.colon
215+ [ P.text "Error" <+> pretty ann <> P.colon
203− , P.text err ]
216+ , P.text err
217+ ]
204 format = Env.onError throw
218 format = Env.onError throw
205 in
219 in
206 A.A ann <$>
220 A.A ann <$>
207 case expr of
221 case expr of
222+ Literal lit ->
208− Literal lit -> return (Literal lit)
223+ return (Literal lit)
209
224
225+ Range e1 e2 ->
210− Range e1 e2 -> Range <$> go e1 <*> go e2
226+ Range <$> go e1 <*> go e2
211
227
228+ Access e x ->
212− Access e x -> Access <$> go e <*> return x
229+ Access <$> go e <*> return x
213
230
231+ Remove e x ->
214− Remove e x -> flip Remove x <$> go e
232+ flip Remove x <$> go e
215
233
234+ Insert e x v ->
216− Insert e x v -> flip Insert x <$> go e <*> go v
235+ flip Insert x <$> go e <*> go v
217
236
218 Modify e fs ->
237 Modify e fs ->
219 Modify <$> go e <*> mapM (\(k,v) -> (,) k <$> go v) fs
238 Modify <$> go e <*> mapM (\(k,v) -> (,) k <$> go v) fs
220
239
240+ Record fs ->
221− Record fs -> Record <$> mapM (\(k,v) -> (,) k <$> go v) fs
241+ Record <$> mapM (\(k,v) -> (,) k <$> go v) fs
222
242
223 Binop (Var.Raw op) e1 e2 ->
243 Binop (Var.Raw op) e1 e2 ->
224− do op' <- format (Canonicalize.variable env op)
244+ do op' <- format (Canonicalize.variable env op)
225− Binop op' <$> go e1 <*> go e2
245+ Binop op' <$> go e1 <*> go e2
226
246
227 Lambda p e ->
247 Lambda p e ->
228 let env' = update p env in
248 let env' = update p env in
229 Lambda <$> format (pattern env' p) <*> expression env' e
249 Lambda <$> format (pattern env' p) <*> expression env' e
230
250
251+ App e1 e2 ->
231− App e1 e2 -> App <$> go e1 <*> go e2
252+ App <$> go e1 <*> go e2
232
253
254+ MultiIf ps ->
233− MultiIf ps -> MultiIf <$> mapM go' ps
255+ MultiIf <$> mapM go' ps
256+ where
234− where go' (b,e) = (,) <$> go b <*> go e
257+ go' (b,e) = (,) <$> go b <*> go e
235
258
259+ Let defs e ->
236− Let defs e -> Let <$> mapM rename' defs <*> expression env' e
260+ Let <$> mapM rename' defs <*> expression env' e
237− where
261+ where
238− env' = foldr update env $ map (\(Valid.Definition p _ _) -> p) defs
262+ env' = foldr update env $ map (\(Valid.Definition p _ _) -> p) defs
239− rename' (Valid.Definition p body mtipe) =
263+ rename' (Valid.Definition p body mtipe) =
240− Canonical.Definition
264+ Canonical.Definition
241− <$> format (pattern env' p)
265+ <$> format (pattern env' p)
242− <*> expression env' body
266+ <*> expression env' body
243− <*> T.traverse (tipe' env') mtipe
267+ <*> T.traverse (tipe' env') mtipe
244
268
269+ Var (Var.Raw x) ->
245− Var (Var.Raw x) -> Var <$> format (Canonicalize.variable env x)
270+ Var <$> format (Canonicalize.variable env x)
246
271
272+ Data name es ->
247− Data name es -> Data name <$> mapM go es
273+ Data name <$> mapM go es
248
274
275+ ExplicitList es ->
249− ExplicitList es -> ExplicitList <$> mapM go es
276+ ExplicitList <$> mapM go es
250
277
278+ Case e cases ->
251− Case e cases -> Case <$> go e <*> mapM branch cases
279+ Case <$> go e <*> mapM branch cases
252− where
280+ where
281+ branch (p,b) =
253− branch (p,b) = (,) <$> format (pattern env p)
282+ (,) <$> format (pattern env p)
254− <*> expression (update p env) b
283+ <*> expression (update p env) b
255
284
256 Markdown uid md es ->
285 Markdown uid md es ->
257− do Env.uses "Text"
286+ do Env.uses ["Text"]
258− Markdown uid md <$> mapM go es
287+ Markdown uid md <$> mapM go es
288+
289+ PortIn name st ->
290+ PortIn name <$> tipe' env st
259
291
292+ PortOut name st signal ->
260− PortIn name st -> PortIn name <$> tipe' env st
293+ PortOut name <$> tipe' env st <*> go signal
261
294
262− PortOut name st signal -> PortOut name <$> tipe' env st <*> go signal
295+ GLShader uid src tipe ->
296+ return (GLShader uid src tipe)
263
297
264− GLShader uid src tipe -> return (GLShader uid src tipe)
265
298
266pattern :: Environment -> P.RawPattern -> Canonicalizer String P.CanonicalPattern
299pattern :: Environment -> P.RawPattern -> Canonicalizer String P.CanonicalPattern
267pattern env ptrn =
300pattern env ptrn =
compiler/Transform/Canonicalize/Environment.hs → src/Transform/Canonicalize/Environment.hsrenamed+13−6
@@ -8,23 +8,29 @@ import qualified Data.Map as Map
8import qualified Data.Set as Set
8import qualified Data.Set as Set
9
9
10import AST.Expression.General (saveEnvName)
10import AST.Expression.General (saveEnvName)
11+import qualified AST.Module as Module
11import qualified AST.Pattern as P
12import qualified AST.Pattern as P
12import qualified AST.Type as Type
13import qualified AST.Type as Type
13import qualified AST.Variable as Var
14import qualified AST.Variable as Var
14
15
15import Text.PrettyPrint (Doc)
16import Text.PrettyPrint (Doc)
16
17
18+
17type Dict a = Map.Map String [a]
19type Dict a = Map.Map String [a]
18
20
19dict :: [(String,a)] -> Dict a
21dict :: [(String,a)] -> Dict a
22+dict pairs =
20−dict pairs = Map.fromList $ map (second (:[])) pairs
23+ Map.fromList $ map (second (:[])) pairs
21
24
22insert :: String -> a -> Dict a -> Dict a
25insert :: String -> a -> Dict a -> Dict a
26+insert key value =
23−insert key value = Map.insertWith (++) key [value]
27+ Map.insertWith (++) key [value]
28+
24
29
30+type Canonicalizer err a =
25−type Canonicalizer err a = Error.ErrorT err (State.State (Set.Set String)) a
31+ Error.ErrorT err (State.State (Set.Set Module.Name)) a
26
32
27−uses :: (Error.Error e) => String -> Canonicalizer e ()
33+uses :: (Error.Error e) => Module.Name -> Canonicalizer e ()
28uses home =
34uses home =
29 Error.lift (State.modify (Set.insert home))
35 Error.lift (State.modify (Set.insert home))
30
36
@@ -46,15 +52,16 @@ onError handler canonicalizer =
46 Left err -> Error.throwError [handler err]
52 Left err -> Error.throwError [handler err]
47 Right x -> return x
53 Right x -> return x
48
54
55+
49data Environment = Env
56data Environment = Env
50− { _home :: String
57+ { _home :: Module.Name
51 , _values :: Dict Var.Canonical
58 , _values :: Dict Var.Canonical
52 , _adts :: Dict Var.Canonical
59 , _adts :: Dict Var.Canonical
53 , _aliases :: Dict (Var.Canonical, [String], Type.CanonicalType)
60 , _aliases :: Dict (Var.Canonical, [String], Type.CanonicalType)
54 , _patterns :: Dict Var.Canonical
61 , _patterns :: Dict Var.Canonical
55 }
62 }
56
63
57−builtIns :: String -> Environment
64+builtIns :: Module.Name -> Environment
58builtIns home =
65builtIns home =
59 Env { _home = home
66 Env { _home = home
60 , _values = builtIn (tuples ++ [saveEnvName])
67 , _values = builtIn (tuples ++ [saveEnvName])
compiler/Transform/Canonicalize/Setup.hs → src/Transform/Canonicalize/Setup.hsrenamed+14−11
@@ -23,10 +23,11 @@ import Transform.Canonicalize.Environment as Env
23import qualified Transform.Canonicalize.Type as Canonicalize
23import qualified Transform.Canonicalize.Type as Canonicalize
24import qualified Transform.Interface as Interface
24import qualified Transform.Interface as Interface
25
25
26+
26environment :: Module.Interfaces -> Module.ValidModule -> Canonicalizer [Doc] Environment
27environment :: Module.Interfaces -> Module.ValidModule -> Canonicalizer [Doc] Environment
27environment interfaces modul@(Module.Module _ _ _ imports decls) =
28environment interfaces modul@(Module.Module _ _ _ imports decls) =
28 do () <- allImportsAvailable
29 do () <- allImportsAvailable
29− let moduleName = Module.getName modul
30+ let moduleName = Module.names modul
30 nonLocalEnv <- foldM (addImports moduleName interfaces) (builtIns moduleName) imports
31 nonLocalEnv <- foldM (addImports moduleName interfaces) (builtIns moduleName) imports
31 let (aliases, env) = List.foldl' (addDecl moduleName) ([], nonLocalEnv) decls
32 let (aliases, env) = List.foldl' (addDecl moduleName) ([], nonLocalEnv) decls
32 addTypeAliases moduleName aliases env
33 addTypeAliases moduleName aliases env
@@ -39,18 +40,19 @@ environment interfaces modul@(Module.Module _ _ _ imports decls) =
39 where
40 where
40 modules = map fst imports
41 modules = map fst imports
41
42
42− found m = Map.member m interfaces || List.isPrefixOf "Native." m
43+ found m = Map.member m interfaces || Module.nameIsNative m
43
44
44 missingModuleError missings =
45 missingModuleError missings =
45 concat [ "The following imports were not found: "
46 concat [ "The following imports were not found: "
46− , List.intercalate ", " missings
47+ , List.intercalate ", " (map Module.nameToString missings)
47 , "\n You may need to compile with the --make "
48 , "\n You may need to compile with the --make "
48 , "flag to detect modules you have written." ]
49 , "flag to detect modules you have written." ]
49
50
51+
50−addImports :: String -> Module.Interfaces -> Environment -> (String, Module.ImportMethod)
52+addImports :: Module.Name -> Module.Interfaces -> Environment -> (Module.Name, Module.ImportMethod)
51 -> Canonicalizer [Doc] Environment
53 -> Canonicalizer [Doc] Environment
52addImports moduleName interfaces environ (name, method)
54addImports moduleName interfaces environ (name, method)
53− | List.isPrefixOf "Native." name = return environ
55+ | Module.nameIsNative name = return environ
54 | otherwise =
56 | otherwise =
55 case method of
57 case method of
56 Module.As name' ->
58 Module.As name' ->
@@ -82,10 +84,11 @@ addImports moduleName interfaces environ (name, method)
82
84
83 ctors = concatMap (map (pair . fst) . snd . snd) (Map.toList (iAdts interface))
85 ctors = concatMap (map (pair . fst) . snd . snd) (Map.toList (iAdts interface))
84
86
85−addValue :: String -> Module.Interface -> Environment -> Var.Value
87+addValue :: Module.Name -> Module.Interface -> Environment -> Var.Value
86 -> Canonicalizer [Doc] Environment
88 -> Canonicalizer [Doc] Environment
87−addValue name interface env value =
89+addValue moduleName interface env value =
90+ let name = Module.nameToString moduleName
88− let insert' x = insert x (Var.Canonical (Var.Module name) x)
91+ insert' x = insert x (Var.Canonical (Var.Module moduleName) x)
89 msg x = "Import Error: Could not import value '" ++ name ++ "." ++ x ++
92 msg x = "Import Error: Could not import value '" ++ name ++ "." ++ x ++
90 "'.\n It is not exported by module " ++ name ++ "."
93 "'.\n It is not exported by module " ++ name ++ "."
91 notFound x = throwError [ P.text (msg x) ]
94 notFound x = throwError [ P.text (msg x) ]
@@ -104,7 +107,7 @@ addValue name interface env value =
104 , _values = updatedValues
107 , _values = updatedValues
105 }
108 }
106 where
109 where
107− v = (Var.Canonical (Var.Module name) x, tvars, t)
110+ v = (Var.Canonical (Var.Module moduleName) x, tvars, t)
108 updatedValues =
111 updatedValues =
109 if Map.member x (iTypes interface)
112 if Map.member x (iTypes interface)
110 then insert' x (_values env)
113 then insert' x (_values env)
@@ -147,7 +150,7 @@ node name tvars alias = ((name, tvars, alias), name, edges alias)
147 Type.Record fs ext -> maybe [] edges ext ++ concatMap (edges . snd) fs
150 Type.Record fs ext -> maybe [] edges ext ++ concatMap (edges . snd) fs
148 Type.Aliased _ t -> edges t
151 Type.Aliased _ t -> edges t
149
152
150−addTypeAliases :: String -> [Node] -> Environment -> Canonicalizer [Doc] Environment
153+addTypeAliases :: Module.Name -> [Node] -> Environment -> Canonicalizer [Doc] Environment
151addTypeAliases moduleName nodes environ =
154addTypeAliases moduleName nodes environ =
152 foldM addTypeAlias environ (Graph.stronglyConnComp nodes)
155 foldM addTypeAlias environ (Graph.stronglyConnComp nodes)
153 where
156 where
@@ -193,7 +196,7 @@ addTypeAliases moduleName nodes environ =
193-- When canonicalizing, all _values should be Local, but all _adts and _patterns
196-- When canonicalizing, all _values should be Local, but all _adts and _patterns
194-- should be fully namespaced. With _adts, they may appear in types that can
197-- should be fully namespaced. With _adts, they may appear in types that can
195-- escape the module.
198-- escape the module.
196−addDecl :: String -> ([Node], Environment) -> D.ValidDecl -> ([Node], Environment)
199+addDecl :: Module.Name -> ([Node], Environment) -> D.ValidDecl -> ([Node], Environment)
197addDecl moduleName info@(nodes,env) decl =
200addDecl moduleName info@(nodes,env) decl =
198 let namespacedVar = Var.Canonical (Var.Module moduleName)
201 let namespacedVar = Var.Canonical (Var.Module moduleName)
199 addLocal x e = insert x (Var.local x) e
202 addLocal x e = insert x (Var.local x) e
compiler/Transform/Canonicalize/Type.hs → src/Transform/Canonicalize/Type.hsrenamed

The content is the same.

compiler/Transform/Canonicalize/Variable.hs → src/Transform/Canonicalize/Variable.hsrenamed+7−6
@@ -7,6 +7,7 @@ import qualified Data.Map as Map
7import Data.Maybe (fromMaybe)
7import Data.Maybe (fromMaybe)
8
8
9import AST.Helpers as Help
9import AST.Helpers as Help
10+import qualified AST.Module as Module
10import qualified AST.Type as Type
11import qualified AST.Type as Type
11import qualified AST.Variable as Var
12import qualified AST.Variable as Var
12import Transform.Canonicalize.Environment as Env
13import Transform.Canonicalize.Environment as Env
@@ -14,10 +15,9 @@ import Transform.Canonicalize.Environment as Env
14variable :: Environment -> String -> Canonicalizer String Var.Canonical
15variable :: Environment -> String -> Canonicalizer String Var.Canonical
15variable env var =
16variable env var =
16 case modul of
17 case modul of
17− Just ms@(m:_)
18+ Just name
19+ | Module.nameIsNative name ->
18− | m == "Native" -> Env.using (Var.Canonical home name)
20+ Env.using (Var.Canonical (Var.Module name) varName)
19− where
20− home = Var.Module (List.intercalate "." ms)
21
21
22 _ ->
22 _ ->
23 case Map.lookup var (_values env) of
23 case Map.lookup var (_values env) of
@@ -25,7 +25,7 @@ variable env var =
25 Just vs -> preferLocals env "variable" vs var
25 Just vs -> preferLocals env "variable" vs var
26 Nothing -> notFound "variable" (Map.keys (_values env)) var
26 Nothing -> notFound "variable" (Map.keys (_values env)) var
27 where
27 where
28− (modul, name) =
28+ (modul, varName) =
29 case Help.splitDots var of
29 case Help.splitDots var of
30 [x] -> (Nothing, x)
30 [x] -> (Nothing, x)
31 xs -> (Just (init xs), last xs)
31 xs -> (Just (init xs), last xs)
@@ -83,7 +83,8 @@ preferLocals' env extract kind possibilities var =
83 case home of
83 case home of
84 Var.Local -> True
84 Var.Local -> True
85 Var.BuiltIn -> False
85 Var.BuiltIn -> False
86+ Var.Module name ->
86− Var.Module name -> name == Env._home env
87+ name == Env._home env
87
88
88 ambiguous possibleVars =
89 ambiguous possibleVars =
89 throwError msg
90 throwError msg
compiler/Transform/Check.hs → src/Transform/Check.hsrenamed

The content is the same.

compiler/Transform/Declaration.hs → src/Transform/Declaration.hsrenamed+3−2
@@ -9,6 +9,7 @@ import qualified AST.Expression.General as E
9import qualified AST.Expression.Source as Source
9import qualified AST.Expression.Source as Source
10import qualified AST.Expression.Valid as Valid
10import qualified AST.Expression.Valid as Valid
11import qualified AST.Expression.Canonical as Canonical
11import qualified AST.Expression.Canonical as Canonical
12+import qualified AST.Module as Module
12import qualified AST.Pattern as P
13import qualified AST.Pattern as P
13import qualified AST.Type as T
14import qualified AST.Type as T
14import qualified AST.Variable as Var
15import qualified AST.Variable as Var
@@ -70,10 +71,10 @@ combineAnnotations = go
70 _ -> (:) (D.Port (D.In name tipe)) <$> go portRest
71 _ -> (:) (D.Port (D.In name tipe)) <$> go portRest
71
72
72
73
73−toExpr :: String -> [D.CanonicalDecl] -> [Canonical.Def]
74+toExpr :: Module.Name -> [D.CanonicalDecl] -> [Canonical.Def]
74toExpr moduleName = concatMap (toDefs moduleName)
75toExpr moduleName = concatMap (toDefs moduleName)
75
76
76−toDefs :: String -> D.CanonicalDecl -> [Canonical.Def]
77+toDefs :: Module.Name -> D.CanonicalDecl -> [Canonical.Def]
77toDefs moduleName decl =
78toDefs moduleName decl =
78 let typeVar = Var.Canonical (Var.Module moduleName) in
79 let typeVar = Var.Canonical (Var.Module moduleName) in
79 case decl of
80 case decl of
compiler/Transform/Definition.hs → src/Transform/Definition.hsrenamed

The content is the same.

compiler/Transform/Expression.hs → src/Transform/Expression.hsrenamed

The content is the same.

compiler/Transform/Interface.hs → src/Transform/Interface.hsrenamed−1
@@ -1,4 +1,3 @@
1−{-# OPTIONS_GHC -W #-}
2module Transform.Interface (filterExports) where
1module Transform.Interface (filterExports) where
3
2
4import qualified Data.Map as Map
3import qualified Data.Map as Map
compiler/Transform/SortDefinitions.hs → src/Transform/SortDefinitions.hsrenamed

The content is the same.

compiler/Transform/Substitute.hs → src/Transform/Substitute.hsrenamed

The content is the same.

compiler/Type/Constrain/Expression.hs → src/Type/Constrain/Expression.hsrenamed−1
@@ -1,4 +1,3 @@
1−{-# OPTIONS_GHC -W #-}
2module Type.Constrain.Expression where
1module Type.Constrain.Expression where
3
2
4import Control.Applicative ((<$>))
3import Control.Applicative ((<$>))
compiler/Type/Constrain/Literal.hs → src/Type/Constrain/Literal.hsrenamed−1
@@ -1,4 +1,3 @@
1−{-# OPTIONS_GHC -W #-}
2module Type.Constrain.Literal where
1module Type.Constrain.Literal where
3
2
4import AST.Annotation
3import AST.Annotation
compiler/Type/Constrain/Pattern.hs → src/Type/Constrain/Pattern.hsrenamed−1
@@ -1,4 +1,3 @@
1−{-# OPTIONS_GHC -W #-}
2{-# LANGUAGE FlexibleInstances #-}
1{-# LANGUAGE FlexibleInstances #-}
3module Type.Constrain.Pattern where
2module Type.Constrain.Pattern where
4
3
compiler/Type/Environment.hs → src/Type/Environment.hsrenamed−1
@@ -1,4 +1,3 @@
1−{-# OPTIONS_GHC -W #-}
2module Type.Environment where
1module Type.Environment where
3
2
4import Control.Applicative ((<$>), (<*>))
3import Control.Applicative ((<$>), (<*>))
compiler/Type/ExtraChecks.hs → src/Type/ExtraChecks.hsrenamed

The content is the same.

compiler/Type/Fragment.hs → src/Type/Fragment.hsrenamed−1
@@ -4,7 +4,6 @@ import qualified Data.List as List
4import qualified Data.Map as Map
4import qualified Data.Map as Map
5
5
6import Type.Type
6import Type.Type
7−import AST.Pattern
8import AST.Annotation (noneNoDocs)
7import AST.Annotation (noneNoDocs)
9
8
10data Fragment = Fragment
9data Fragment = Fragment
src/Type/Inference.hsnew file+98
@@ -0,0 +1,98 @@
1+module Type.Inference where
2+
3+import qualified Data.Map as Map
4+
5+import qualified Type.Type as T
6+import qualified Type.Environment as Env
7+import qualified Type.Constrain.Expression as TcExpr
8+import qualified Type.Solve as Solve
9+
10+import qualified AST.Annotation as A
11+import AST.Module as Module
12+import AST.Type (CanonicalType)
13+import qualified AST.Variable as Var
14+import Text.PrettyPrint
15+import qualified Type.State as TS
16+import qualified Type.ExtraChecks as Check
17+import Control.Arrow (first, second)
18+import Control.Monad.State (execStateT, forM)
19+import Control.Monad.Error (ErrorT, runErrorT, liftIO, throwError)
20+
21+import System.IO.Unsafe -- Possible to switch over to the ST monad instead of
22+ -- the IO monad. I don't think that'd be worthwhile.
23+
24+
25+infer :: Interfaces -> CanonicalModule -> Either [Doc] (Map.Map String CanonicalType)
26+infer interfaces modul =
27+ unsafePerformIO $ runErrorT $
28+ do (header, constraint) <- genConstraints interfaces modul
29+
30+ state <- liftIO $ execStateT (Solve.solve constraint) TS.initialState
31+
32+ () <- case TS.sErrors state of
33+ errors@(_:_) -> throwError errors
34+ [] -> return ()
35+
36+ () <- Check.portTypes (program (body modul))
37+
38+ let header' = Map.delete "::" header
39+ types = Map.difference (TS.sSavedEnv state) header'
40+
41+ Check.mainType types
42+
43+
44+genConstraints
45+ :: Interfaces
46+ -> CanonicalModule
47+ -> ErrorT [Doc] IO (Env.TypeDict, T.TypeConstraint)
48+genConstraints interfaces modul =
49+ do env <- liftIO $ Env.initialEnvironment (canonicalizeAdts interfaces modul)
50+
51+ ctors <- forM (Map.keys (Env.constructor env)) $ \name -> do
52+ (_, vars, args, result) <- liftIO $ Env.freshDataScheme env name
53+ return (name, (vars, foldr (T.==>) result args))
54+
55+ importedVars <- mapM (canonicalizeValues env) (Map.toList interfaces)
56+
57+ let allTypes = concat (ctors : importedVars)
58+ vars = concatMap (fst . snd) allTypes
59+ header = Map.map snd (Map.fromList allTypes)
60+ environ = A.noneNoDocs . T.CLet [ T.Scheme vars [] (A.noneNoDocs T.CTrue) header ]
61+
62+ fvar <- liftIO $ T.variable T.Flexible
63+ c <- TcExpr.constrain env (program (body modul)) (T.varN fvar)
64+ return (header, environ c)
65+
66+
67+canonicalizeValues
68+ :: Env.Environment
69+ -> (Module.Name, Interface)
70+ -> ErrorT [Doc] IO [(String, ([T.Variable], T.Type))]
71+canonicalizeValues env (moduleName, iface) =
72+ forM (Map.toList (iTypes iface)) $ \(name,tipe) ->
73+ do tipe' <- Env.instantiateType env tipe Map.empty
74+ return (Module.nameToString moduleName ++ "." ++ name, tipe')
75+
76+
77+canonicalizeAdts :: Interfaces -> CanonicalModule -> [CanonicalAdt]
78+canonicalizeAdts interfaces modul =
79+ localAdts ++ importedAdts
80+ where
81+ localAdts :: [CanonicalAdt]
82+ localAdts = format (Module.names modul, datatypes (body modul))
83+
84+ importedAdts :: [CanonicalAdt]
85+ importedAdts = concatMap (format . second iAdts) (Map.toList interfaces)
86+
87+ format :: (Module.Name, Module.ADTs) -> [CanonicalAdt]
88+ format (home, adts) =
89+ map canonical (Map.toList adts)
90+ where
91+ canonical :: (String, AdtInfo String) -> CanonicalAdt
92+ canonical (name, (tvars, ctors)) =
93+ ( toVar name
94+ , (tvars, map (first toVar) ctors)
95+ )
96+
97+ toVar :: String -> Var.Canonical
98+ toVar = Var.Canonical (Var.Module home)
compiler/Type/PrettyPrint.hs → src/Type/PrettyPrint.hsrenamed+9−5
@@ -1,16 +1,20 @@
1−
2module Type.PrettyPrint where
1module Type.PrettyPrint where
3
2
4import Text.PrettyPrint
3import Text.PrettyPrint
5−import qualified AST.PrettyPrint as Src
4+
6
5
7data ParensWhen = Fn | App | Never
6data ParensWhen = Fn | App | Never
8
7
8+
9class PrettyType a where
9class PrettyType a where
10− pretty :: ParensWhen -> a -> Doc
10+ pretty :: ParensWhen -> a -> Doc
11+
11
12
12commaSep :: [Doc] -> Doc
13commaSep :: [Doc] -> Doc
14+commaSep docs =
13−commaSep docs = sep (punctuate comma docs)
15+ sep (punctuate comma docs)
16+
14
17
15parensIf :: Bool -> Doc -> Doc
18parensIf :: Bool -> Doc -> Doc
19+parensIf bool doc =
16−parensIf bool doc = if bool then parens doc else doc
20+ if bool then parens doc else doc
compiler/Type/Solve.hs → src/Type/Solve.hsrenamed−1
@@ -1,4 +1,3 @@
1−{-# OPTIONS_GHC -W #-}
2module Type.Solve (solve) where
1module Type.Solve (solve) where
3
2
4import Control.Monad
3import Control.Monad
compiler/Type/State.hs → src/Type/State.hsrenamed−1
@@ -1,4 +1,3 @@
1−{-# OPTIONS_GHC -W #-}
2module Type.State where
1module Type.State where
3
2
4import Control.Applicative ( (<$>), (<*>), Applicative, (<|>) )
3import Control.Applicative ( (<$>), (<*>), Applicative, (<|>) )
compiler/Type/Type.hs → src/Type/Type.hsrenamed−1
@@ -1,4 +1,3 @@
1−{-# OPTIONS_GHC -W #-}
2module Type.Type where
1module Type.Type where
3
2
4import qualified Data.Char as Char
3import qualified Data.Char as Char
compiler/Type/Unify.hs → src/Type/Unify.hsrenamed−1
@@ -1,4 +1,3 @@
1−{-# OPTIONS_GHC -W #-}
2module Type.Unify (unify) where
1module Type.Unify (unify) where
3
2
4import Control.Applicative ((<|>))
3import Control.Applicative ((<|>))