git.iko.soy/elk
on master help sign in
Merge branch 'dev' into topic/webgl
6785c5cJohn P Mayer Jr
Elm.cabal+28−7
compare with master
unifiedsplit
@@ -30,7 +30,12 @@ source-repository head
30 location: git://github.com/evancz/Elm.git
30 location: git://github.com/evancz/Elm.git
31
31
32Library
32Library
33− exposed-modules: Language.Elm
33+ exposed-modules: Elm.Internal.Dependencies,
34+ Elm.Internal.Documentation,
35+ Elm.Internal.Name,
36+ Elm.Internal.Paths,
37+ Elm.Internal.Utils,
38+ Elm.Internal.Version
34 Hs-Source-Dirs: compiler
39 Hs-Source-Dirs: compiler
35 other-modules: SourceSyntax.Declaration,
40 other-modules: SourceSyntax.Declaration,
36 SourceSyntax.Expression,
41 SourceSyntax.Expression,
@@ -54,7 +59,6 @@ Library
54 Transform.Substitute,
59 Transform.Substitute,
55 Transform.Optimize,
60 Transform.Optimize,
56 Metadata.Prelude,
61 Metadata.Prelude,
57− Initialize,
58 InterfaceSerialization,
62 InterfaceSerialization,
59 Parse.Binop,
63 Parse.Binop,
60 Parse.Declaration,
64 Parse.Declaration,
@@ -79,9 +83,16 @@ Library
79 Type.State,
83 Type.State,
80 Type.Type,
84 Type.Type,
81 Type.Unify,
85 Type.Unify,
86+ Build.Dependencies,
87+ Build.File,
88+ Build.Flags,
89+ Build.Print,
90+ Build.Source,
91+ Build.Utils,
82 Paths_Elm
92 Paths_Elm
83
93
84− Build-depends: base >=4.2 && <5,
94+ Build-depends: aeson,
95+ base >=4.2 && <5,
85 binary >= 0.6.4.0,
96 binary >= 0.6.4.0,
86 blaze-html == 0.5.* || == 0.6.*,
97 blaze-html == 0.5.* || == 0.6.*,
87 blaze-markup,
98 blaze-markup,
@@ -97,9 +108,11 @@ Library
97 pandoc >= 1.10,
108 pandoc >= 1.10,
98 parsec >= 3.1.1,
109 parsec >= 3.1.1,
99 pretty,
110 pretty,
111+ text,
100 transformers >= 0.2,
112 transformers >= 0.2,
101 union-find,
113 union-find,
102− uniplate
114+ uniplate,
115+ unordered-containers
103
116
104Executable elm
117Executable elm
105 Main-is: Compiler.hs
118 Main-is: Compiler.hs
@@ -126,7 +139,6 @@ Executable elm
126 Transform.Substitute,
139 Transform.Substitute,
127 Transform.Optimize,
140 Transform.Optimize,
128 Metadata.Prelude,
141 Metadata.Prelude,
129− Initialize,
130 InterfaceSerialization,
142 InterfaceSerialization,
131 Parse.Binop,
143 Parse.Binop,
132 Parse.Declaration,
144 Parse.Declaration,
@@ -151,9 +163,16 @@ Executable elm
151 Type.State,
163 Type.State,
152 Type.Type,
164 Type.Type,
153 Type.Unify,
165 Type.Unify,
166+ Build.Dependencies,
167+ Build.File,
168+ Build.Flags,
169+ Build.Print,
170+ Build.Source,
171+ Build.Utils,
154 Paths_Elm
172 Paths_Elm
155
173
156− Build-depends: base >=4.2 && <5,
174+ Build-depends: aeson,
175+ base >=4.2 && <5,
157 binary >= 0.6.4.0,
176 binary >= 0.6.4.0,
158 blaze-html == 0.5.* || == 0.6.*,
177 blaze-html == 0.5.* || == 0.6.*,
159 blaze-markup == 0.5.1.*,
178 blaze-markup == 0.5.1.*,
@@ -169,9 +188,11 @@ Executable elm
169 pandoc >= 1.10,
188 pandoc >= 1.10,
170 parsec >= 3.1.1,
189 parsec >= 3.1.1,
171 pretty,
190 pretty,
191+ text,
172 transformers >= 0.2,
192 transformers >= 0.2,
173 union-find,
193 union-find,
174− uniplate
194+ uniplate,
195+ unordered-containers
175
196
176Executable elm-doc
197Executable elm-doc
177 Main-is: Docs.hs
198 Main-is: Docs.hs
compiler/Build/Dependencies.hsnew file+131
@@ -0,0 +1,131 @@
1+module Build.Dependencies (getSortedDependencies) where
2+
3+import Data.Data
4+import Control.Applicative
5+import Control.Monad.Error
6+import qualified Control.Monad.State as State
7+import qualified Data.Aeson as Json
8+import qualified Data.ByteString.Lazy.Char8 as BSC
9+import qualified Data.Char as Char
10+import qualified Data.Graph as Graph
11+import qualified Data.List as List
12+import qualified Data.Map as Map
13+import qualified Data.Maybe as Maybe
14+import qualified Data.Set as Set
15+import System.Directory
16+import System.Exit
17+import System.FilePath as FP
18+import System.IO
19+import Text.PrettyPrint (Doc)
20+
21+import SourceSyntax.Everything
22+import qualified SourceSyntax.Type as Type
23+import qualified Parse.Parse as Parse
24+import qualified Metadata.Prelude as Prelude
25+import qualified Transform.Check as Check
26+import qualified Transform.SortDefinitions as SD
27+import qualified Type.Inference as TI
28+import qualified Type.Constrain.Declaration as TcDecl
29+import qualified Transform.Canonicalize as Canonical
30+import qualified Elm.Internal.Paths as Path
31+import qualified Elm.Internal.Name as N
32+import qualified Elm.Internal.Version as V
33+import qualified Elm.Internal.Dependencies as Deps
34+
35+getSortedDependencies :: [FilePath] -> Interfaces -> FilePath -> IO [String]
36+getSortedDependencies srcDirs builtIns root =
37+ do extras <- extraDependencies
38+ let allSrcDirs = srcDirs ++ Maybe.fromMaybe [] extras
39+ result <- runErrorT $ readDeps allSrcDirs builtIns root
40+ case result of
41+ Right deps -> sortDeps deps
42+ Left err -> failure $ err ++ if Maybe.isJust extras then "" else msg
43+ where msg = "\nYou may need to create a " ++
44+ Path.dependencyFile ++
45+ " file if you\nare trying to use a 3rd party library."
46+
47+failure msg = hPutStrLn stderr msg >> exitFailure
48+
49+extraDependencies :: IO (Maybe [FilePath])
50+extraDependencies =
51+ do exists <- doesFileExist Path.dependencyFile
52+ if not exists then return Nothing else Just <$> getPaths
53+ where
54+ getPaths = do
55+ raw <- BSC.readFile Path.dependencyFile
56+ case Json.eitherDecode raw of
57+ Right (Deps.Mini deps) -> mapM validate deps
58+ Left err ->
59+ failure $ "Error reading the " ++ Path.dependencyFile ++ " file:\n" ++ err
60+
61+ validate (name,version) = do
62+ let path = Path.dependencyDirectory </> toPath name version
63+ exists <- doesDirectoryExist path
64+ if exists then return path else failure (notFound name version)
65+
66+ toPath name version = N.toFilePath name </> show version
67+
68+ notFound name version =
69+ unlines
70+ [ "Your " ++ Path.dependencyFile ++ " file says you depend on library"
71+ , show name ++ " " ++ show version ++ " but it was not found."
72+ , "You may need to install it with:"
73+ , ""
74+ , " elm-get install " ++ show name ++ " " ++ show version ]
75+
76+type Deps = (FilePath, String, [String])
77+
78+sortDeps :: [Deps] -> IO [String]
79+sortDeps depends =
80+ if null mistakes
81+ then return (concat sccs)
82+ else failure $ msg ++ unlines (map show mistakes)
83+ where
84+ sccs = map Graph.flattenSCC $ Graph.stronglyConnComp depends
85+
86+ mistakes = filter (\scc -> length scc > 1) sccs
87+ msg = "A cyclical module dependency or was detected in:\n"
88+
89+readDeps :: [FilePath] -> Interfaces -> FilePath -> ErrorT String IO [Deps]
90+readDeps srcDirs builtIns root = do
91+ let ifaces = (Set.fromList . Map.keys) builtIns
92+ State.evalStateT (go ifaces root) Set.empty
93+ where
94+ go :: Set.Set String -> FilePath -> State.StateT (Set.Set String) (ErrorT String IO) [Deps]
95+ go builtIns root = do
96+ (root', txt) <- lift $ getFile srcDirs root
97+ case Parse.dependencies txt of
98+ Left err -> throwError $ msg ++ show err
99+ where msg = "Error resolving dependencies in " ++ root' ++ ":\n"
100+
101+ Right (name,deps) ->
102+ do seen <- State.get
103+ let realDeps = Set.difference (Set.fromList deps) builtIns
104+ newDeps = Set.difference (Set.filter (not . isNative) realDeps) seen
105+ State.put (Set.insert name (Set.union newDeps seen))
106+ rest <- mapM (go builtIns . toFilePath) (Set.toList newDeps)
107+ return ((makeRelative "." root', name, Set.toList realDeps) : concat rest)
108+
109+getFile :: [FilePath] -> FilePath -> ErrorT String IO (FilePath,String)
110+getFile [] path =
111+ throwError $ unlines
112+ [ "Could not find file: " ++ path
113+ , " If it is not in the root directory of your project, use"
114+ , " --src-dir to declare additional locations for source files."
115+ , " If it is part of a 3rd party library, it needs to be declared"
116+ , " as a dependency in the " ++ Path.dependencyFile ++ " file." ]
117+
118+getFile (dir:dirs) path = do
119+ let path' = dir </> path
120+ exists <- liftIO $ doesFileExist path'
121+ case exists of
122+ True -> (,) path' `fmap` liftIO (readFile path')
123+ False -> getFile dirs path
124+
125+isNative name = List.isPrefixOf "Native." name
126+
127+toFilePath :: String -> FilePath
128+toFilePath name = map swapDots name ++ ext
129+ where swapDots '.' = '/'
130+ swapDots c = c
131+ ext = if isNative name then ".js" else ".elm"
compiler/Build/File.hsnew file+106
@@ -0,0 +1,106 @@
1+module Build.File (build) where
2+
3+import Control.Monad (when)
4+import qualified Data.Binary as Binary
5+import qualified Data.List as List
6+import qualified Data.Map as Map
7+import System.Directory
8+import System.Exit
9+import System.FilePath
10+import System.IO
11+
12+import qualified Transform.Canonicalize as Canonical
13+
14+import qualified Data.ByteString.Lazy as L
15+
16+import qualified Build.Utils as Utils
17+import qualified Build.Flags as Flag
18+import qualified Build.Source as Source
19+import qualified Build.Print as Print
20+import qualified Generate.JavaScript as JS
21+import qualified InterfaceSerialization as IS
22+import qualified Parse.Module as Parser
23+import qualified SourceSyntax.Module as M
24+
25+build :: Flag.Flags -> Int -> M.Interfaces -> String -> [FilePath]
26+ -> IO (String, M.Interfaces)
27+build _ _ interfaces moduleName [] =
28+ return (moduleName, interfaces)
29+build flags numModules interfaces _ (filePath:rest) =
30+ do (name,interface) <-
31+ build1 flags (numModules - length rest) numModules interfaces filePath
32+ let interfaces' = Map.insert name interface interfaces
33+ build flags numModules interfaces' name rest
34+
35+
36+build1 :: Flag.Flags -> Int -> Int -> M.Interfaces -> FilePath
37+ -> IO (String, M.ModuleInterface)
38+build1 flags moduleNum numModules interfaces filePath =
39+ do compiled <- alreadyCompiled flags filePath
40+ case compiled of
41+ False -> compile flags number interfaces filePath
42+ True -> retrieve flags interfaces filePath
43+ where
44+ number = "[" ++ show moduleNum ++ " of " ++ show numModules ++ "]"
45+
46+
47+alreadyCompiled :: Flag.Flags -> FilePath -> IO Bool
48+alreadyCompiled flags filePath = do
49+ existsi <- doesFileExist (Utils.elmi flags filePath)
50+ existso <- doesFileExist (Utils.elmo flags filePath)
51+ if not existsi || not existso
52+ then return False
53+ else do tsrc <- getModificationTime filePath
54+ tint <- getModificationTime (Utils.elmo flags filePath)
55+ return (tsrc <= tint)
56+
57+retrieve :: Flag.Flags -> Map.Map String M.ModuleInterface -> FilePath
58+ -> IO (String, M.ModuleInterface)
59+retrieve flags interfaces filePath = do
60+ bytes <- IS.loadInterface (Utils.elmi flags filePath)
61+ let binary = IS.interfaceDecode (Utils.elmi flags filePath) =<< bytes
62+ case IS.validVersion filePath =<< binary of
63+ Right (name, interface) ->
64+ do when (Flag.print_types flags) (Print.interfaceTypes interfaces interface)
65+ return (name, interface)
66+ Left err ->
67+ do hPutStrLn stderr err
68+ exitFailure
69+
70+compile :: Flag.Flags -> String -> M.Interfaces -> FilePath
71+ -> IO (String, M.ModuleInterface)
72+compile flags number interfaces filePath =
73+ do source <- readFile filePath
74+ let name = getName source
75+ printStatus name
76+
77+ createDirectoryIfMissing True (Flag.cache_dir flags)
78+ createDirectoryIfMissing True (Flag.build_dir flags)
79+
80+ metaModule <-
81+ case Source.build (Flag.no_prelude flags) interfaces source of
82+ Right modul -> return modul
83+ Left errors -> do Print.errors errors
84+ exitFailure
85+
86+ when (Flag.print_types flags) $ Print.metaTypes interfaces metaModule
87+
88+ let intermediate = (name, Canonical.interface name $ M.metaToInterface metaModule)
89+ generateCache intermediate metaModule
90+ return intermediate
91+
92+ where
93+ getName source = case Parser.getModuleName source of
94+ Just n -> n
95+ Nothing -> "Main"
96+
97+ printStatus name =
98+ hPutStrLn stdout $ concat [ number, " Compiling ", name
99+ , replicate (max 1 (20 - length name)) ' '
100+ , "( " ++ filePath ++ " )" ]
101+
102+ generateCache intermediate metaModule = do
103+ createDirectoryIfMissing True . dropFileName $ Utils.elmi flags filePath
104+ writeFile (Utils.elmo flags filePath) (JS.generate metaModule)
105+ withBinaryFile (Utils.elmi flags filePath) WriteMode $ \handle ->
106+ L.hPut handle (Binary.encode intermediate)
compiler/Build/Flags.hsnew file+44
@@ -0,0 +1,44 @@
1+{-# LANGUAGE DeriveDataTypeable #-}
2+module Build.Flags where
3+
4+import qualified Elm.Internal.Version as Version
5+import System.Console.CmdArgs
6+
7+data Flags = Flags
8+ { make :: Bool
9+ , files :: [FilePath]
10+ , runtime :: Maybe FilePath
11+ , only_js :: Bool
12+ , print_types :: Bool
13+ , scripts :: [FilePath]
14+ , no_prelude :: Bool
15+ , cache_dir :: FilePath
16+ , build_dir :: FilePath
17+ , src_dir :: [FilePath]
18+ }
19+ deriving (Data,Typeable,Show,Eq)
20+
21+flags = Flags
22+ { files = def &= args &= typ "FILES"
23+ , make = False
24+ &= help "automatically compile dependencies."
25+ , only_js = False
26+ &= help "Compile only to JavaScript."
27+ , no_prelude = False
28+ &= help "Do not import Prelude by default, used only when compiling standard libraries."
29+ , scripts = [] &= typFile
30+ &= help "Load JavaScript files in generated HTML. Files will be included in the given order."
31+ , runtime = Nothing &= typFile
32+ &= help "Specify a custom location for Elm's runtime system."
33+ , cache_dir = "cache" &= typFile
34+ &= help "Directory for files cached to make builds faster. Defaults to cache/ directory."
35+ , build_dir = "build" &= typFile
36+ &= help "Directory for generated HTML and JS files. Defaults to build/ directory."
37+ , src_dir = ["."] &= typFile
38+ &= help "Additional source directories besides project root. Searched when using --make"
39+ , print_types = False
40+ &= help "Print out infered types of top-level definitions."
41+ } &= help "Compile Elm programs to HTML, CSS, and JavaScript."
42+ &= helpArg [explicit, name "help", name "h"]
43+ &= versionArg [explicit, name "version", name "v", summary (show Version.elmVersion)]
44+ &= summary ("The Elm Compiler " ++ show Version.elmVersion ++ ", (c) Evan Czaplicki 2011-2013")
compiler/Build/Print.hsnew file+32
@@ -0,0 +1,32 @@
1+module Build.Print where
2+
3+import qualified Data.Map as Map
4+import qualified Data.List as List
5+import qualified SourceSyntax.Module as M
6+import qualified SourceSyntax.PrettyPrint as Pretty
7+import qualified Type.Alias as Alias
8+import qualified Text.PrettyPrint as P
9+
10+metaTypes :: Map.Map String M.ModuleInterface -> M.MetadataModule () () -> IO ()
11+metaTypes interfaces meta =
12+ types interfaces (M.types meta) (M.aliases meta) (M.imports meta)
13+
14+interfaceTypes :: Map.Map String M.ModuleInterface -> M.ModuleInterface -> IO ()
15+interfaceTypes interfaces iface =
16+ types interfaces (M.iTypes iface) (M.iAliases iface) (M.iImports iface)
17+
18+types interfaces types' aliases imports =
19+ do putStrLn ""
20+ mapM_ printType (Map.toList types')
21+ putStrLn ""
22+ where
23+ rules = Alias.rules interfaces aliases imports
24+
25+ printType (n,t) = do
26+ print $ P.hsep [ Pretty.variable n
27+ , P.text ":"
28+ , Pretty.pretty (Alias.realias rules t) ]
29+
30+errors :: [P.Doc] -> IO ()
31+errors errs =
32+ mapM_ print (List.intersperse (P.text " ") errs)
compiler/Build/Source.hsnew file+63
@@ -0,0 +1,63 @@
1+module Build.Source (build) where
2+
3+import Data.Data
4+import Control.Monad.State
5+import qualified Data.Graph as Graph
6+import qualified Data.List as List
7+import qualified Data.Map as Map
8+import qualified Data.Set as Set
9+import System.Directory
10+import System.Exit
11+import System.FilePath as FP
12+import Text.PrettyPrint (Doc)
13+
14+import SourceSyntax.Everything
15+import qualified SourceSyntax.Type as Type
16+import qualified Parse.Parse as Parse
17+import qualified Metadata.Prelude as Prelude
18+import qualified Transform.Check as Check
19+import qualified Transform.SortDefinitions as SD
20+import qualified Type.Inference as TI
21+import qualified Type.Constrain.Declaration as TcDecl
22+import qualified Transform.Canonicalize as Canonical
23+
24+build :: Bool -> Interfaces -> String -> Either [Doc] (MetadataModule () ())
25+build noPrelude interfaces source =
26+ do let add = if noPrelude then id else Prelude.add
27+ infixes = Map.fromList . map (\(assoc,lvl,op) -> (op,(lvl,assoc)))
28+ . concatMap iFixities $ Map.elems interfaces
29+
30+ modul@(Module _ _ _ decls') <- add `fmap` Parse.program infixes source
31+
32+ -- check for structural errors
33+ Module names exs ims decls <-
34+ case Check.mistakes decls' of
35+ [] -> return modul
36+ ms -> Left ms
37+
38+ let exports'
39+ | null exs =
40+ let get = Set.toList . SD.boundVars in
41+ concat [ get pattern | Definition (Def pattern _) <- decls ] ++
42+ concat [ map fst ctors | Datatype _ _ ctors <- decls ] ++
43+ [ name | TypeAlias name _ (Type.Record _ _) <- decls ]
44+ | otherwise = exs
45+
46+ metaModule <- Canonical.metadataModule interfaces $ MetadataModule {
47+ names = names,
48+ path = FP.joinPath names,
49+ exports = exports',
50+ imports = ims,
51+ -- reorder AST into strongly connected components
52+ program = SD.sortDefs . dummyLet $ TcDecl.toExpr decls,
53+ types = Map.empty,
54+ datatypes = [ (name,vars,ctors) | Datatype name vars ctors <- decls ],
55+ fixities = [ (assoc,level,op) | Fixity assoc level op <- decls ],
56+ aliases = [ (name,tvs,tipe) | TypeAlias name tvs tipe <- decls ],
57+ foreignImports = [ (evt,v,name,typ) | ImportEvent evt v name typ <- decls ],
58+ foreignExports = [ (evt,name,typ) | ExportEvent evt name typ <- decls ]
59+ }
60+
61+ types <- TI.infer interfaces metaModule
62+
63+ return $ metaModule { types = types }
compiler/Build/Utils.hsnew file+20
@@ -0,0 +1,20 @@
1+module Build.Utils where
2+
3+import System.FilePath ((</>), replaceExtension)
4+import qualified Build.Flags as Flag
5+
6+buildPath :: Flag.Flags -> FilePath -> String -> FilePath
7+buildPath flags filePath ext =
8+ Flag.build_dir flags </> replaceExtension filePath ext
9+
10+cachePath :: Flag.Flags -> FilePath -> String -> FilePath
11+cachePath flags filePath ext =
12+ Flag.cache_dir flags </> replaceExtension filePath ext
13+
14+elmo :: Flag.Flags -> FilePath -> FilePath
15+elmo flags filePath =
16+ cachePath flags filePath "elmo"
17+
18+elmi :: Flag.Flags -> FilePath -> FilePath
19+elmi flags filePath =
20+ cachePath flags filePath "elmi"
compiler/Compiler.hs+42−199
@@ -1,225 +1,68 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2module Main where
1module Main where
3
2
4−import Control.Monad
3+import Control.Monad (foldM)
5import qualified Data.Map as Map
4import qualified Data.Map as Map
6−import qualified Data.List as List
5+import qualified Data.Maybe as Maybe
6+import Text.Blaze.Html.Renderer.String (renderHtml)
7−import qualified Data.Binary as Binary
7+import qualified Data.ByteString.Lazy.Char8 as BS
8−import Data.Version (showVersion)
9−import System.Console.CmdArgs hiding (program)
8+import qualified System.Console.CmdArgs as CmdArgs
10import System.Directory
9import System.Directory
11−import System.Exit
12import System.FilePath
10import System.FilePath
13−import System.IO
14import GHC.Conc
11import GHC.Conc
15
12
16−import Text.Blaze.Html.Renderer.Pretty (renderHtml)
13+import Build.Dependencies (getSortedDependencies)
17−import qualified Data.ByteString.Lazy.Char8 as BS
14+import qualified Generate.Html as Html
18−import qualified Data.ByteString.Lazy as L
19−
20import qualified Metadata.Prelude as Prelude
15import qualified Metadata.Prelude as Prelude
21−import qualified Transform.Canonicalize as Canonical
16+import qualified Build.Utils as Utils
22−import SourceSyntax.Module
23−import Parse.Module (getModuleName)
24−import Initialize (buildFromSource, getSortedDependencies)
25−import Generate.JavaScript (jsModule)
26−import Generate.Html (createHtml, JSSource(..))
27−import qualified InterfaceSerialization as IS
17+import qualified Build.Flags as Flag
28−import Paths_Elm
29−
30−import SourceSyntax.PrettyPrint (pretty, variable)
31−import Text.PrettyPrint as P
32−import qualified Type.Type as Type
18+import qualified Build.File as File
33−import qualified Type.Alias as Alias
19+import qualified Elm.Internal.Paths as Path
34−
35−data Flags =
36− Flags { make :: Bool
37− , files :: [FilePath]
38− , runtime :: Maybe FilePath
39− , only_js :: Bool
40− , print_types :: Bool
41− , scripts :: [FilePath]
42− , no_prelude :: Bool
43− , cache_dir :: FilePath
44− , build_dir :: FilePath
45− , src_dir :: [FilePath]
46− }
47− deriving (Data,Typeable,Show,Eq)
48−
49−flags = Flags
50− { files = def &= args &= typ "FILES"
51− , make = False
52− &= help "automatically compile dependencies."
53− , only_js = False
54− &= help "Compile only to JavaScript."
55− , no_prelude = False
56− &= help "Do not import Prelude by default, used only when compiling standard libraries."
57− , scripts = [] &= typFile
58− &= help "Load JavaScript files in generated HTML. Files will be included in the given order."
59− , runtime = Nothing &= typFile
60− &= help "Specify a custom location for Elm's runtime system."
61− , cache_dir = "cache" &= typFile
62− &= help "Directory for files cached to make builds faster. Defaults to cache/ directory."
63− , build_dir = "build" &= typFile
64− &= help "Directory for generated HTML and JS files. Defaults to build/ directory."
65− , src_dir = ["."] &= typFile
66− &= help "Additional source directories besides project root. Searched when using --make"
67− , print_types = False
68− &= help "Print out infered types of top-level definitions."
69− } &= help "Compile Elm programs to HTML, CSS, and JavaScript."
70− &= helpArg [explicit, name "help", name "h"]
71− &= versionArg [explicit, name "version", name "v", summary (showVersion version)]
72− &= summary ("The Elm Compiler " ++ showVersion version ++ ", (c) Evan Czaplicki 2011-2013")
73
20
74main :: IO ()
21main :: IO ()
75main = do setNumCapabilities =<< getNumProcessors
22main = do setNumCapabilities =<< getNumProcessors
76− compileArgs =<< cmdArgs flags
23+ compileArgs =<< CmdArgs.cmdArgs Flag.flags
77
24
78−compileArgs :: Flags -> IO ()
25+compileArgs :: Flag.Flags -> IO ()
79compileArgs flags =
26compileArgs flags =
80− case files flags of
27+ case Flag.files flags of
81 [] -> putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
28 [] -> putStrLn "Usage: elm [OPTIONS] [FILES]\nFor more help: elm --help"
82 fs -> mapM_ (build flags) fs
29 fs -> mapM_ (build flags) fs
83
30
31+build :: Flag.Flags -> FilePath -> IO ()
32+build flags rootFile =
33+ do let noPrelude = Flag.no_prelude flags
34+ builtIns <- if noPrelude then return Map.empty else Prelude.interfaces
84
35
85−buildPath :: Flags -> FilePath -> String -> FilePath
86−buildPath flags filePath ext = build_dir flags </> replaceExtension filePath ext
87−
88−cachePath :: Flags -> FilePath -> String -> FilePath
89−cachePath flags filePath ext = cache_dir flags </> replaceExtension filePath ext
90−
91−elmo :: Flags -> FilePath -> FilePath
92−elmo flags filePath = cachePath flags filePath "elmo"
93−
94−elmi :: Flags -> FilePath -> FilePath
95−elmi flags filePath = cachePath flags filePath "elmi"
96−
97−buildFile :: Flags -> Int -> Int -> Interfaces -> FilePath -> IO (String, ModuleInterface)
98−buildFile flags moduleNum numModules interfaces filePath = do
99− compiled <- alreadyCompiled
100− if not compiled then compile else do
101− bytes <- IS.loadInterface (elmi flags filePath)
102− let binary = IS.interfaceDecode (elmi flags filePath) =<< bytes
103− case IS.validVersion filePath =<< binary of
104− Left err -> do
105− hPutStrLn stderr err
106− exitFailure
107−
108− Right (name, interface) -> do
109− when (print_types flags) $
110− printTypes interfaces
111− (iTypes interface)
112− (iAliases interface)
113− (iImports interface)
114−
115− return (name, interface)
116−
117− where
118− alreadyCompiled :: IO Bool
119− alreadyCompiled = do
120− existsi <- doesFileExist (elmi flags filePath)
121− existso <- doesFileExist (elmo flags filePath)
122− if not existsi || not existso
123− then return False
124− else do tsrc <- getModificationTime filePath
125− tint <- getModificationTime (elmo flags filePath)
126− return (tsrc <= tint)
127−
128− number :: String
129− number = "[" ++ show moduleNum ++ " of " ++ show numModules ++ "]"
130−
131− compile :: IO (String,ModuleInterface)
132− compile = do
133− source <- readFile filePath
134− let name = case getModuleName source of
135− Just n -> n
136− Nothing -> "Main"
137− putStrLn $ concat [ number, " Compiling ", name
138− , replicate (max 1 (20 - length name)) ' '
139− , "( " ++ filePath ++ " )" ]
140−
141− createDirectoryIfMissing True (cache_dir flags)
142− createDirectoryIfMissing True (build_dir flags)
143−
144− metaModule <-
145− case buildFromSource (no_prelude flags) interfaces source of
146− Left errors -> do
147− mapM print (List.intersperse (P.text " ") errors)
148− exitFailure
149− Right modul -> return modul
150−
151− when (print_types flags)
152− (printTypes interfaces
153− (types metaModule) (aliases metaModule) (imports metaModule))
154−
155− let interface = Canonical.interface name $ ModuleInterface {
156− iVersion = showVersion version,
157− iTypes = types metaModule,
158− iImports = imports metaModule,
159− iAdts = datatypes metaModule,
160− iAliases = aliases metaModule,
161− iFixities = fixities metaModule
162− }
163−
164− createDirectoryIfMissing True . dropFileName $ elmi flags filePath
165− handle <- openBinaryFile (elmi flags filePath) WriteMode
166− L.hPut handle (Binary.encode (name,interface))
167− hClose handle
168− writeFile (elmo flags filePath) (jsModule metaModule)
169− return (name,interface)
170−
171−printTypes interfaces moduleTypes moduleAliases moduleImports = do
172− putStrLn ""
173− let rules = Alias.rules interfaces moduleAliases moduleImports
174− forM_ (Map.toList moduleTypes) $ \(n,t) -> do
175− print $ variable n <+> P.text ":" <+> pretty (Alias.realias rules t)
176− putStrLn ""
177−
178−getRuntime :: Flags -> IO FilePath
179−getRuntime flags =
180− case runtime flags of
181− Just fp -> return fp
182− Nothing -> getDataFileName "elm-runtime.js"
183−
184−build :: Flags -> FilePath -> IO ()
185−build flags rootFile = do
186− let noPrelude = no_prelude flags
187− builtIns <- if noPrelude then return Map.empty else Prelude.interfaces
188−
189− files <- if make flags
36+ files <- if Flag.make flags
190− then getSortedDependencies (src_dir flags) builtIns rootFile
37+ then getSortedDependencies (Flag.src_dir flags) builtIns rootFile
191− else return [rootFile]
38+ else return [rootFile]
192
39
40+ (moduleName, interfaces) <-
193− (moduleName, interfaces) <- buildFiles flags (length files) builtIns "" files
41+ File.build flags (length files) builtIns "" files
194
42
195− js <- foldM appendToOutput BS.empty files
43+ js <- foldM appendToOutput BS.empty files
196
44
197− (extension, code) <- case only_js flags of
45+ (extension, code) <-
198− True -> do
46+ if Flag.only_js flags
199− putStr "Generating JavaScript ... "
47+ then do putStr "Generating JavaScript ... "
200− return ("js", js)
48+ return ("js", js)
201− False -> do
202− putStr "Generating HTML ... "
49+ else do putStr "Generating HTML ... "
203− rtsPath <- getRuntime flags
50+ return (makeHtml js moduleName)
204− return ("html", BS.pack . renderHtml $
205− createHtml rtsPath (takeBaseName rootFile) (sources js) moduleName "")
206
51
207− let targetFile = buildPath flags rootFile extension
52+ let targetFile = Utils.buildPath flags rootFile extension
208− createDirectoryIfMissing True (takeDirectory targetFile)
53+ createDirectoryIfMissing True (takeDirectory targetFile)
209− BS.writeFile targetFile code
54+ BS.writeFile targetFile code
210− putStrLn "Done"
55+ putStrLn "Done"
211
56
212 where
57 where
213 appendToOutput :: BS.ByteString -> FilePath -> IO BS.ByteString
58 appendToOutput :: BS.ByteString -> FilePath -> IO BS.ByteString
214− appendToOutput js filePath =
59+ appendToOutput js filePath = do
215− do src <- BS.readFile (elmo flags filePath)
60+ src <- BS.readFile (Utils.elmo flags filePath)
216− return (BS.append src js)
61+ return (BS.append src js)
217
62
218− sources js = map Link (scripts flags) ++ [ Source js ]
63+ sources js = map Html.Link (Flag.scripts flags) ++ [ Html.Source js ]
219
64
220−buildFiles :: Flags -> Int -> Interfaces -> String -> [FilePath] -> IO (String, Interfaces)
65+ makeHtml js moduleName = ("html", BS.pack $ renderHtml html)
221−buildFiles _ _ interfaces moduleName [] = return (moduleName, interfaces)
66+ where
222−buildFiles flags numModules interfaces _ (filePath:rest) = do
67+ rtsPath = Maybe.fromMaybe Path.runtime (Flag.runtime flags)
223− (name,interface) <- buildFile flags (numModules - length rest) numModules interfaces filePath
68+ html = Html.generate rtsPath (takeBaseName rootFile) (sources js) moduleName ""
224− let interfaces' = Map.insert name interface interfaces
225− buildFiles flags numModules interfaces' name rest
compiler/Elm/Internal/Dependencies.hsnew file+119
@@ -0,0 +1,119 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Elm.Internal.Dependencies where
3+
4+import Control.Applicative
5+import Control.Monad.Error
6+import qualified Control.Exception as E
7+import Data.Aeson
8+import qualified Data.List as List
9+import qualified Data.ByteString.Lazy as BS
10+import qualified Data.HashMap.Strict as Map
11+import qualified Elm.Internal.Name as N
12+import qualified Elm.Internal.Version as V
13+
14+data Deps = Deps
15+ { name :: N.Name
16+ , version :: V.Version
17+ , summary :: String
18+ , description :: String
19+ , license :: String
20+ , repo :: String
21+ , exposed :: [String]
22+ , elmVersion :: V.Version
23+ , dependencies :: [(N.Name,V.Version)]
24+ } deriving Show
25+
26+data MiniDeps = Mini [(N.Name,V.Version)]
27+
28+instance FromJSON MiniDeps where
29+ parseJSON (Object obj) = Mini <$> getDependencies obj
30+ parseJSON _ = mzero
31+
32+instance FromJSON Deps where
33+ parseJSON (Object obj) =
34+ do version <- get obj "version" "your projects version number"
35+
36+ summary <- get obj "summary" "a short summary of your project"
37+ when (length summary >= 80) $
38+ fail "'summary' must be less than 80 characters"
39+
40+ desc <- get obj "description" "an extended description of your project \
41+ \and how to get started with it."
42+ license <- get obj "license" "license information (BSD3 is recommended)"
43+
44+ repo <- get obj "repository" "a link to the project's GitHub repo"
45+ name <- case repoToName repo of
46+ Left err -> fail err
47+ Right nm -> return nm
48+
49+ exposed <- get obj "exposed-modules" "a list of modules exposed to users"
50+ when (null exposed) $
51+ fail "there are no 'exposed-modules'.\n\
52+ \At least one module must be exposed \
53+ \for anyone to use this library!"
54+
55+ elmVersion <- get obj "elm-version" "the version of the Elm compiler you are using"
56+
57+ deps <- getDependencies obj
58+
59+ return $ Deps name version summary desc license repo exposed elmVersion deps
60+
61+ parseJSON _ = mzero
62+
63+getDependencies obj =
64+ toDeps =<< get obj "dependencies" "a listing of your project's dependencies"
65+ where
66+ toDeps deps =
67+ forM (Map.toList deps) $ \(f,v) ->
68+ case (N.fromString f, V.fromString v) of
69+ (Just name, Just version) -> return (name,version)
70+ (Nothing, _) -> fail $ N.errorMsg f
71+ (_, Nothing) -> fail $ "invalid version number " ++ v
72+
73+
74+get obj field desc =
75+ do maybe <- obj .:? field
76+ case maybe of
77+ Just value -> return value
78+ Nothing -> fail $ "Missing field " ++ show field ++ ", " ++ desc ++ ".\n" ++
79+ " <https://github.com/evancz/rainbow-palette/blob/master/elm_dependencies.json>"
80+
81+repoToName :: String -> Either String N.Name
82+repoToName repo
83+ | not (end `List.isSuffixOf` repo) = Left msg
84+ | otherwise =
85+ do path <- getPath
86+ let raw = take (length path - length end) path
87+ case N.fromString raw of
88+ Nothing -> Left msg
89+ Just name -> Right name
90+ where
91+ getPath | http `List.isPrefixOf` repo = Right $ drop (length http ) repo
92+ | https `List.isPrefixOf` repo = Right $ drop (length https) repo
93+ | otherwise = Left msg
94+ http = "http://github.com/"
95+ https = "https://github.com/"
96+ end = ".git"
97+ msg = "the 'repository' field must point to a GitHub project for now, something\n\
98+ \like <https://github.com/USER/PROJECT.git> where USER is your GitHub name\n\
99+ \and PROJECT is the repo you want to upload."
100+
101+withDeps :: (Deps -> a) -> FilePath -> ErrorT String IO a
102+withDeps handle path =
103+ do json <- readPath
104+ case eitherDecode json of
105+ Left err -> throwError $ "Error reading file " ++ path ++ ":\n " ++ err
106+ Right ds -> return (handle ds)
107+ where
108+ readPath :: ErrorT String IO BS.ByteString
109+ readPath = do
110+ result <- liftIO $ E.catch (Right <$> BS.readFile path)
111+ (\err -> return $ Left (err :: IOError))
112+ case result of
113+ Right bytes -> return bytes
114+ Left _ -> throwError $
115+ "could not find file " ++ path ++
116+ "\n You may need to create a dependency file for your project."
117+
118+depsAt :: FilePath -> ErrorT String IO Deps
119+depsAt = withDeps id
compiler/Elm/Internal/Documentation.hsnew file+41
@@ -0,0 +1,41 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+module Elm.Internal.Documentation where
3+
4+import Control.Applicative ((<$>),(<*>))
5+import Control.Monad
6+import Data.Aeson
7+
8+data Document = Doc
9+ { moduleName :: String
10+ , structure :: String
11+ , entries :: [Entry]
12+ } deriving (Show)
13+
14+data Entry = Entry
15+ { name :: String
16+ , comment :: String
17+ , raw :: String
18+ , assocPrec :: Maybe (String,Int)
19+ } deriving (Show)
20+
21+instance FromJSON Document where
22+ parseJSON (Object v) =
23+ Doc <$> v .: "name"
24+ <*> v .: "document"
25+ <*> (concat <$> sequence [ v .: "aliases", v .: "datatypes", v .: "values" ])
26+
27+ parseJSON _ = fail "Conversion to Document was expecting an object"
28+
29+instance FromJSON Entry where
30+ parseJSON (Object v) =
31+ Entry <$> v .: "name"
32+ <*> v .: "comment"
33+ <*> v .: "raw"
34+ <*> (liftM2 (,) <$> v .:? "associativity"
35+ <*> v .:? "precedence")
36+
37+ parseJSON _ = fail "Conversion to Entry was expecting an object"
38+
39+data Content = Markdown String | Value String
40+ deriving Show
41+
compiler/Elm/Internal/Name.hsnew file+51
@@ -0,0 +1,51 @@
1+{-# LANGUAGE DeriveDataTypeable #-}
2+module Elm.Internal.Name where
3+
4+import Control.Applicative
5+import Control.Monad.Error
6+import Data.Aeson
7+import Data.Binary
8+import qualified Data.Text as T
9+import qualified Data.Maybe as Maybe
10+import Data.Typeable
11+
12+data Name = Name { user :: String, project :: String }
13+ deriving (Typeable,Eq)
14+
15+instance Binary Name where
16+ get = Name <$> get <*> get
17+ put (Name user project) =
18+ put user >> put project
19+
20+instance Show Name where
21+ show name = user name ++ "/" ++ project name
22+
23+toFilePath :: Name -> FilePath
24+toFilePath name = user name ++ "-" ++ project name
25+
26+fromString :: String -> Maybe Name
27+fromString string =
28+ case break (=='/') string of
29+ ( user@(_:_), '/' : project@(_:_) )
30+ | all (/='/') project -> Just (Name user project)
31+ _ -> Nothing
32+
33+fromString' :: String -> ErrorT String IO Name
34+fromString' string =
35+ Maybe.maybe (throwError $ errorMsg string) return (fromString string)
36+
37+instance FromJSON Name where
38+ parseJSON (String text) =
39+ let string = T.unpack text in
40+ Maybe.maybe (fail $ errorMsg string) return (fromString string)
41+
42+ parseJSON _ = fail "Project name must be a string."
43+
44+instance ToJSON Name where
45+ toJSON name = toJSON (show name)
46+
47+errorMsg string =
48+ unlines
49+ [ "Dependency file has an invalid name: " ++ string
50+ , "Must have format user/project and match a public github project."
51+ ]
compiler/Elm/Internal/Paths.hsnew file+23
@@ -0,0 +1,23 @@
1+module Elm.Internal.Paths where
2+
3+import System.IO.Unsafe
4+import qualified Paths_Elm as This
5+
6+-- |Name of directory for all of a project's dependencies.
7+dependencyDirectory :: FilePath
8+dependencyDirectory = "elm_dependencies"
9+
10+-- |Name of the dependency file, specifying dependencies and
11+-- other metadata for building and sharing projects.
12+dependencyFile :: FilePath
13+dependencyFile = "elm_dependencies.json"
14+
15+{-# NOINLINE runtime #-}
16+-- |The absolute path to Elm's runtime system.
17+runtime :: FilePath
18+runtime = unsafePerformIO $ This.getDataFileName "elm-runtime.js"
19+
20+{-# NOINLINE docs #-}
21+-- |The absolute path to Elm's core library documentation.
22+docs :: FilePath
23+docs = unsafePerformIO $ This.getDataFileName "docs.json"
compiler/Elm/Internal/Utils.hsnew file+28
@@ -0,0 +1,28 @@
1+{- | This module exports functions for compiling Elm to JS.
2+-}
3+module Elm.Internal.Utils (compile, moduleName) where
4+
5+import qualified Data.List as List
6+import qualified Generate.JavaScript as JS
7+import qualified Build.Source as Source
8+import qualified Parse.Module as Parser
9+import qualified SourceSyntax.Module as M
10+import qualified Text.PrettyPrint as P
11+import qualified Metadata.Prelude as Prelude
12+import System.IO.Unsafe
13+
14+-- |This function compiles Elm code to JavaScript. It will return either
15+-- an error message or the compiled JS code.
16+compile :: String -> Either String String
17+compile source =
18+ case Source.build False interfaces source of
19+ Left docs -> Left . unlines . List.intersperse "" $ map P.render docs
20+ Right modul -> Right $ JS.generate modul
21+
22+{-# NOINLINE interfaces #-}
23+interfaces :: M.Interfaces
24+interfaces = unsafePerformIO $ Prelude.interfaces
25+
26+-- |This function extracts the module name of a given source program.
27+moduleName :: String -> Maybe String
28+moduleName = Parser.getModuleName
compiler/Elm/Internal/Version.hsnew file+73
@@ -0,0 +1,73 @@
1+{-# LANGUAGE DeriveDataTypeable, TemplateHaskell #-}
2+module Elm.Internal.Version where
3+
4+import Control.Applicative
5+import Data.Aeson
6+import Data.Binary
7+import Data.Char (isDigit)
8+import qualified Data.List as List
9+import Data.Typeable
10+import qualified Data.Text as T
11+import qualified Paths_Elm as This
12+import qualified Data.Version as Version
13+
14+elmVersion :: Version
15+elmVersion = V ns ""
16+ where (Version.Version ns _) =This.version
17+
18+-- Data representation
19+
20+data Version = V [Int] String
21+ deriving (Typeable,Eq)
22+
23+instance Ord Version where
24+ compare (V ns tag) (V ns' tag') =
25+ case compare ns ns' of
26+ EQ -> compare tag' tag -- reverse comparison to favor ""
27+ cmp -> cmp
28+
29+instance Show Version where
30+ show (V ns tag) =
31+ List.intercalate "." (map show ns) ++ if null tag then "" else "-" ++ tag
32+
33+instance Binary Version where
34+ get = V <$> get <*> get
35+ put (V ns tag) = do put ns
36+ put tag
37+
38+tagless :: Version -> Bool
39+tagless (V _ tag) = null tag
40+
41+fromString :: String -> Maybe Version
42+fromString version = V <$> splitNumbers possibleNumbers <*> tag
43+ where
44+ (possibleNumbers, possibleTag) = break (=='-') version
45+
46+ tag = case possibleTag of
47+ "" -> Just ""
48+ '-':rest -> Just rest
49+ _ -> Nothing
50+
51+ splitNumbers :: String -> Maybe [Int]
52+ splitNumbers ns =
53+ case span isDigit ns of
54+ ("", _) -> Nothing
55+ (number, []) -> Just [read number]
56+ (number, '.':rest) -> (read number :) <$> splitNumbers rest
57+ _ -> Nothing
58+
59+instance FromJSON Version where
60+ parseJSON (String text) =
61+ let string = T.unpack text in
62+ case fromString string of
63+ Just v -> return v
64+ Nothing -> fail $ unlines
65+ [ "Dependency file has an invalid version number: " ++ string
66+ , "Must have format 0.1.2 or 0.1.2-tag"
67+ ]
68+
69+ parseJSON _ = fail "Version number must be stored as a string."
70+
71+instance ToJSON Version where
72+ toJSON version = toJSON (show version)
73+
compiler/Generate/Html.hs+3−10
@@ -1,8 +1,5 @@
1{-# LANGUAGE OverloadedStrings #-}
1{-# LANGUAGE OverloadedStrings #-}
2−module Generate.Html
2+module Generate.Html (generate, JSSource(..)) where
3− (createHtml,
4− JSSource (..)
5− ) where
6
3
7import Text.Blaze (preEscapedToMarkup)
4import Text.Blaze (preEscapedToMarkup)
8import qualified Text.Blaze.Html5 as H
5import qualified Text.Blaze.Html5 as H
@@ -10,10 +7,6 @@ import Text.Blaze.Html5 ((!))
10import qualified Text.Blaze.Html5.Attributes as A
7import qualified Text.Blaze.Html5.Attributes as A
11import qualified Data.ByteString.Lazy.Char8 as BS
8import qualified Data.ByteString.Lazy.Char8 as BS
12
9
13−import Initialize (buildFromSource)
14−import Generate.JavaScript
15−import Generate.Noscript
16−
17data JSSource = Link String | Source BS.ByteString
10data JSSource = Link String | Source BS.ByteString
18
11
19makeScript :: JSSource -> H.Html
12makeScript :: JSSource -> H.Html
@@ -24,8 +17,8 @@ makeScript source =
24 H.script ! A.type_ "text/javascript" $
17 H.script ! A.type_ "text/javascript" $
25 preEscapedToMarkup $ BS.unpack src
18 preEscapedToMarkup $ BS.unpack src
26
19
27−createHtml :: FilePath -> String -> [JSSource] -> String -> String -> H.Html
20+generate :: FilePath -> String -> [JSSource] -> String -> String -> H.Html
28−createHtml libLoc title scripts moduleName noscript =
21+generate libLoc title scripts moduleName noscript =
29 H.docTypeHtml $ do
22 H.docTypeHtml $ do
30 H.head $ do
23 H.head $ do
31 H.meta ! A.charset "UTF-8"
24 H.meta ! A.charset "UTF-8"
compiler/Generate/JavaScript.hs+17−17
@@ -52,7 +52,7 @@ varDecl x expr =
52 VarDecl () (var x) (Just expr)
52 VarDecl () (var x) (Just expr)
53
53
54include alias moduleName =
54include alias moduleName =
55− varDecl alias (obj (moduleName ++ ".make") <| ref "elm")
55+ varDecl alias (obj (moduleName ++ ".make") <| ref "_elm")
56
56
57internalImports name =
57internalImports name =
58 VarDeclStmt ()
58 VarDeclStmt ()
@@ -296,14 +296,14 @@ clause span variable (Case.Clause value vars mtch) =
296 is -> drop (last is + 1) name
296 is -> drop (last is + 1) name
297
297
298
298
299−jsModule :: MetadataModule () () -> String
299+generate :: MetadataModule () () -> String
300−jsModule modul =
300+generate modul =
301 show . prettyPrint $ setup (Just "Elm") (names modul ++ ["make"]) ++
301 show . prettyPrint $ setup (Just "Elm") (names modul ++ ["make"]) ++
302− [ assign ("Elm" : names modul ++ ["make"]) (function ["elm"] programStmts) ]
302+ [ assign ("Elm" : names modul ++ ["make"]) (function ["_elm"] programStmts) ]
303 where
303 where
304− thisModule = dotSep ("elm" : names modul ++ ["values"])
304+ thisModule = dotSep ("_elm" : names modul ++ ["values"])
305 programStmts =
305 programStmts =
306− concat [ setup (Just "elm") (names modul ++ ["values"])
306+ concat [ setup (Just "_elm") (names modul ++ ["values"])
307 , [ IfSingleStmt () thisModule (ReturnStmt () (Just thisModule)) ]
307 , [ IfSingleStmt () thisModule (ReturnStmt () (Just thisModule)) ]
308 , [ internalImports (List.intercalate "." (names modul)) ]
308 , [ internalImports (List.intercalate "." (names modul)) ]
309 , concatMap jsImport (imports modul)
309 , concatMap jsImport (imports modul)
@@ -315,7 +315,7 @@ jsModule modul =
315 , [ ReturnStmt () (Just thisModule) ]
315 , [ ReturnStmt () (Just thisModule) ]
316 ]
316 ]
317
317
318− jsExports = assign ("elm" : names modul ++ ["values"]) (ObjectLit () exs)
318+ jsExports = assign ("_elm" : names modul ++ ["values"]) (ObjectLit () exs)
319 where
319 where
320 exs = map entry . filter (not . isOp) $ "_op" : exports modul
320 exs = map entry . filter (not . isOp) $ "_op" : exports modul
321 entry x = (PropId () (var x), ref x)
321 entry x = (PropId () (var x), ref x)
@@ -329,7 +329,7 @@ jsModule modul =
329 jsImport (modul,_) = setup Nothing path ++ [ include ]
329 jsImport (modul,_) = setup Nothing path ++ [ include ]
330 where
330 where
331 path = split modul
331 path = split modul
332− include = assign path $ dotSep ("Elm" : path ++ ["make"]) <| ref "elm"
332+ include = assign path $ dotSep ("Elm" : path ++ ["make"]) <| ref "_elm"
333
333
334 setup namespace path = map create paths
334 setup namespace path = map create paths
335 where
335 where
@@ -338,15 +338,15 @@ jsModule modul =
338 Nothing -> tail . init $ List.inits path
338 Nothing -> tail . init $ List.inits path
339 Just nmspc -> drop 2 . init . List.inits $ nmspc : path
339 Just nmspc -> drop 2 . init . List.inits $ nmspc : path
340
340
341− addId js = InfixExpr () OpAdd (string (js++"_")) (obj "elm.id")
341+ addId js = InfixExpr () OpAdd (string (js++"_")) (obj "_elm.id")
342
342
343 importEvent (js,base,elm,_) =
343 importEvent (js,base,elm,_) =
344 [ VarDeclStmt () [ varDecl elm $ obj "Signal.constant" <| evalState (expression base) 0 ]
344 [ VarDeclStmt () [ varDecl elm $ obj "Signal.constant" <| evalState (expression base) 0 ]
345 , ExprStmt () $
345 , ExprStmt () $
346 obj "document.addEventListener" `call`
346 obj "document.addEventListener" `call`
347 [ addId js
347 [ addId js
348− , function ["e"]
348+ , function ["_e"]
349− [ ExprStmt () $ obj "elm.notify" `call` [dotSep [elm,"id"], obj "e.value"] ]
349+ [ ExprStmt () $ obj "_elm.notify" `call` [dotSep [elm,"id"], obj "_e.value"] ]
350 ]
350 ]
351 ]
351 ]
352
352
@@ -354,13 +354,13 @@ jsModule modul =
354 ExprStmt () $
354 ExprStmt () $
355 ref "A2" `call`
355 ref "A2" `call`
356 [ obj "Signal.lift"
356 [ obj "Signal.lift"
357− , function ["v"]
357+ , function ["_v"]
358− [ VarDeclStmt () [varDecl "e" $ obj "document.createEvent" <| string "Event"]
358+ [ VarDeclStmt () [varDecl "_e" $ obj "document.createEvent" <| string "Event"]
359 , ExprStmt () $
359 , ExprStmt () $
360− obj "e.initEvent" `call` [ addId js, BoolLit () True, BoolLit () True ]
360+ obj "_e.initEvent" `call` [ addId js, BoolLit () True, BoolLit () True ]
361− , ExprStmt () $ AssignExpr () OpAssign (LDot () (ref "e") "value") (ref "v")
361+ , ExprStmt () $ AssignExpr () OpAssign (LDot () (ref "_e") "value") (ref "_v")
362− , ExprStmt () $ obj "document.dispatchEvent" <| ref "e"
362+ , ExprStmt () $ obj "document.dispatchEvent" <| ref "_e"
363− , ReturnStmt () (Just $ ref "v")
363+ , ReturnStmt () (Just $ ref "_v")
364 ]
364 ]
365 , ref elm ]
365 , ref elm ]
366
366
compiler/Generate/Markdown.hs+34−1
@@ -1,6 +1,39 @@
1module Generate.Markdown where
1module Generate.Markdown where
2
2
3import Text.Pandoc
3import Text.Pandoc
4+import qualified Data.Set as Set
4
5
5toHtml :: String -> String
6toHtml :: String -> String
6−toHtml = writeHtmlString def . readMarkdown def
7+toHtml = writeHtmlString writeOptions . readMarkdown readOptions
8+
9+readOptions =
10+ def { readerExtensions = elmExtensions
11+ , readerApplyMacros = False
12+ }
13+
14+writeOptions =
15+ def { writerExtensions = elmExtensions
16+ , writerHighlight = True
17+ }
18+
19+elmExtensions :: Set.Set Extension
20+elmExtensions = Set.fromList
21+ [ Ext_raw_html
22+ , Ext_fenced_code_blocks
23+ , Ext_fenced_code_attributes
24+ , Ext_backtick_code_blocks
25+ , Ext_inline_code_attributes
26+ , Ext_markdown_in_html_blocks
27+ , Ext_escaped_line_breaks
28+ , Ext_fancy_lists
29+ , Ext_startnum
30+ , Ext_definition_lists
31+ , Ext_example_lists
32+ , Ext_all_symbols_escapable
33+ , Ext_intraword_underscores
34+ , Ext_blank_before_blockquote
35+ , Ext_blank_before_header
36+ , Ext_auto_identifiers
37+ , Ext_header_attributes
38+ , Ext_implicit_header_references
39+ ]
compiler/Initialize.hsdeleted−123
@@ -1,123 +0,0 @@
1−module Initialize (buildFromSource, getSortedDependencies) where
2−
3−import Data.Data
4−import Control.Monad.State
5−import qualified Data.Graph as Graph
6−import qualified Data.List as List
7−import qualified Data.Map as Map
8−import qualified Data.Set as Set
9−import System.Directory
10−import System.Exit
11−import System.FilePath as FP
12−import Text.PrettyPrint (Doc)
13−
14−import SourceSyntax.Everything
15−import qualified SourceSyntax.Type as Type
16−import qualified Parse.Parse as Parse
17−import qualified Metadata.Prelude as Prelude
18−import qualified Transform.Check as Check
19−import qualified Transform.SortDefinitions as SD
20−import qualified Type.Inference as TI
21−import qualified Type.Constrain.Declaration as TcDecl
22−import qualified Transform.Canonicalize as Canonical
23−
24−buildFromSource :: Bool -> Interfaces -> String -> Either [Doc] (MetadataModule () ())
25−buildFromSource noPrelude interfaces source =
26− do let add = if noPrelude then id else Prelude.add
27− infixes = Map.fromList . map (\(assoc,lvl,op) -> (op,(lvl,assoc)))
28− . concatMap iFixities $ Map.elems interfaces
29−
30− modul@(Module _ _ _ decls') <- add `fmap` Parse.program infixes source
31−
32− -- check for structural errors
33− Module names exs ims decls <-
34− case Check.mistakes decls' of
35− [] -> return modul
36− ms -> Left ms
37−
38− let exports'
39− | null exs =
40− let get = Set.toList . SD.boundVars in
41− concat [ get pattern | Definition (Def pattern _) <- decls ] ++
42− concat [ map fst ctors | Datatype _ _ ctors <- decls ] ++
43− [ name | TypeAlias name _ (Type.Record _ _) <- decls ]
44− | otherwise = exs
45−
46− metaModule <- Canonical.metadataModule interfaces $ MetadataModule {
47− names = names,
48− path = FP.joinPath names,
49− exports = exports',
50− imports = ims,
51− -- reorder AST into strongly connected components
52− program = SD.sortDefs . dummyLet $ TcDecl.toExpr decls,
53− types = Map.empty,
54− datatypes = [ (name,vars,ctors) | Datatype name vars ctors <- decls ],
55− fixities = [ (assoc,level,op) | Fixity assoc level op <- decls ],
56− aliases = [ (name,tvs,tipe) | TypeAlias name tvs tipe <- decls ],
57− foreignImports = [ (evt,v,name,typ) | ImportEvent evt v name typ <- decls ],
58− foreignExports = [ (evt,name,typ) | ExportEvent evt name typ <- decls ]
59− }
60−
61− types <- TI.infer interfaces metaModule
62−
63− return $ metaModule { types = types }
64−
65−
66−getSortedDependencies :: [FilePath] -> Interfaces -> FilePath -> IO [String]
67−getSortedDependencies srcDirs builtIns root =
68− sortDeps =<< readDeps srcDirs builtIns root
69−
70−type Deps = (FilePath, String, [String])
71−
72−sortDeps :: [Deps] -> IO [String]
73−sortDeps depends =
74− if null mistakes
75− then return (concat sccs)
76− else print msg >> mapM print mistakes >> exitFailure
77− where
78− sccs = map Graph.flattenSCC $ Graph.stronglyConnComp depends
79−
80− mistakes = filter (\scc -> length scc > 1) sccs
81− msg = "A cyclical module dependency or was detected in: "
82−
83−readDeps :: [FilePath] -> Interfaces -> FilePath -> IO [Deps]
84−readDeps srcDirs builtIns root = do
85− let ifaces = (Set.fromList . Map.keys) builtIns
86− evalStateT (go ifaces root) Set.empty
87− where
88− go :: Set.Set String -> FilePath -> StateT (Set.Set String) IO [Deps]
89− go builtIns root = do
90− (root', txt) <- liftIO $ getFile srcDirs root
91− case Parse.dependencies txt of
92− Left err -> liftIO (putStrLn msg >> print err >> exitFailure)
93− where msg = "Error resolving dependencies in " ++ root' ++ ":"
94−
95− Right (name,deps) ->
96− do seen <- get
97− let realDeps = Set.difference (Set.fromList deps) builtIns
98− newDeps = Set.difference (Set.filter (not . isNative) realDeps) seen
99− put (Set.insert name (Set.union newDeps seen))
100− rest <- mapM (go builtIns . toFilePath) (Set.toList newDeps)
101− return ((makeRelative "." root', name, Set.toList realDeps) : concat rest)
102−
103−getFile :: [FilePath] -> FilePath -> IO (FilePath,String)
104−getFile [] path = do
105− putStrLn $ unlines [ "Could not find file: " ++ path
106− , " If it is not in the root directory of your project, use"
107− , " --src-dir to declare additional locations for source files." ]
108− exitFailure
109−
110−getFile (dir:dirs) path = do
111− let path' = dir </> path
112− exists <- doesFileExist path'
113− case exists of
114− True -> (,) path' `fmap` readFile path'
115− False -> getFile dirs path
116−
117−isNative name = List.isPrefixOf "Native." name
118−
119−toFilePath :: String -> FilePath
120−toFilePath name = map swapDots name ++ ext
121− where swapDots '.' = '/'
122− swapDots c = c
123− ext = if isNative name then ".js" else ".elm"
compiler/InterfaceSerialization.hs+4−4
@@ -6,8 +6,7 @@ module InterfaceSerialization ( loadInterface
6import qualified Data.ByteString.Lazy as L
6import qualified Data.ByteString.Lazy as L
7import qualified Data.Binary as Binary
7import qualified Data.Binary as Binary
8
8
9−import Paths_Elm (version)
9+import qualified Elm.Internal.Version as Version
10−import Data.Version (showVersion)
11import System.Directory (doesFileExist)
10import System.Directory (doesFileExist)
12import System.IO (hPutStrLn, stderr)
11import System.IO (hPutStrLn, stderr)
13import System.Exit (exitFailure)
12import System.Exit (exitFailure)
@@ -42,11 +41,12 @@ interfaceDecode filePath bytes = do
42validVersion :: FilePath -> (String, ModuleInterface) ->
41validVersion :: FilePath -> (String, ModuleInterface) ->
43 Either String (String, ModuleInterface)
42 Either String (String, ModuleInterface)
44validVersion filePath (name, interface) =
43validVersion filePath (name, interface) =
45− if iVersion interface == showVersion version then
44+ if iVersion interface == Version.elmVersion then
46 Right (name, interface)
45 Right (name, interface)
47 else
46 else
48 Left $ concat
47 Left $ concat
49 [ "Error reading build artifact: ", filePath, "\n"
48 [ "Error reading build artifact: ", filePath, "\n"
50− , " It was generated by a different version of the compiler: ", iVersion interface, "\n"
49+ , " It was generated by a different version of the compiler: "
50+ , show (iVersion interface), "\n"
51 , " Please remove the file and try again.\n"
51 , " Please remove the file and try again.\n"
52 ]
52 ]
compiler/Language/Elm.hsdeleted−45
@@ -1,45 +0,0 @@
1−{- | This module exports functions for compiling Elm to JS
2− and some utilities for making it easier to find some Elm-related files.
3−
4− Learning resources for Elm are available at
5− <http://elm-lang.org.elm/Learn.elm> and many interactive examples are
6− available at <http://elm-lang.org/Examples.elm>
7−-}
8−module Language.Elm (compile, moduleName, runtime, docs) where
9−
10−import qualified Data.List as List
11−import qualified Data.Map as Map
12−import Data.Version (showVersion)
13−import Generate.JavaScript (jsModule)
14−import Initialize (buildFromSource)
15−import Parse.Module (getModuleName)
16−import SourceSyntax.Module
17−import Text.Blaze.Html (Html)
18−import qualified Text.PrettyPrint as P
19−import qualified Metadata.Prelude as Prelude
20−import Paths_Elm
21−import System.IO.Unsafe
22−
23−-- |This function compiles Elm code to JavaScript. It will return either
24−-- an error message or the compiled JS code.
25−compile :: String -> Either String String
26−compile source =
27− case buildFromSource False interfaces source of
28− Left docs -> Left . unlines . List.intersperse "" $ map P.render docs
29− Right modul -> Right $ jsModule (modul :: MetadataModule () ())
30−
31−{-# NOINLINE interfaces #-}
32−interfaces :: Interfaces
33−interfaces = unsafePerformIO $ Prelude.interfaces
34−
35−-- |This function extracts the module name of a given source program.
36−moduleName :: String -> Maybe String
37−moduleName = getModuleName
38−
39−-- |The absolute path to Elm's runtime system.
40−runtime :: IO FilePath
41−runtime = getDataFileName "elm-runtime.js"
42−
43−-- |The absolute path to Elm's core library documentation.
44−docs :: IO FilePath
45−docs = getDataFileName "docs.json"
compiler/Paths_El.hs → compiler/Paths_Elm.hrenamed

The content is the same.

compiler/SourceSyntax/Module.hs+11−3
@@ -14,8 +14,7 @@ import SourceSyntax.Type
14import System.FilePath (joinPath)
14import System.FilePath (joinPath)
15import Control.Monad (liftM)
15import Control.Monad (liftM)
16
16
17−import Paths_Elm (version)
17+import qualified Elm.Internal.Version as Version
18−import Data.Version (showVersion)
19
18
20data Module tipe var =
19data Module tipe var =
21 Module [String] Exports Imports [Declaration tipe var]
20 Module [String] Exports Imports [Declaration tipe var]
@@ -62,7 +61,7 @@ type Interfaces = Map.Map String ModuleInterface
62type ADT = (String, [String], [(String,[Type])])
61type ADT = (String, [String], [(String,[Type])])
63
62
64data ModuleInterface = ModuleInterface {
63data ModuleInterface = ModuleInterface {
65− iVersion :: String,
64+ iVersion :: Version.Version,
66 iTypes :: Map.Map String Type,
65 iTypes :: Map.Map String Type,
67 iImports :: [(String, ImportMethod)],
66 iImports :: [(String, ImportMethod)],
68 iAdts :: [ADT],
67 iAdts :: [ADT],
@@ -70,6 +69,15 @@ data ModuleInterface = ModuleInterface {
70 iFixities :: [(Assoc, Int, String)]
69 iFixities :: [(Assoc, Int, String)]
71} deriving Show
70} deriving Show
72
71
72+metaToInterface metaModule =
73+ ModuleInterface
74+ { iVersion = Version.elmVersion
75+ , iTypes = types metaModule
76+ , iImports = imports metaModule
77+ , iAdts = datatypes metaModule
78+ , iAliases = aliases metaModule
79+ , iFixities = fixities metaModule
80+ }
73
81
74instance Binary ModuleInterface where
82instance Binary ModuleInterface where
75 get = ModuleInterface <$> get <*> get <*> get <*> get <*> get <*> get
83 get = ModuleInterface <$> get <*> get <*> get <*> get <*> get <*> get
libraries/Basics.elm+7−3
@@ -221,11 +221,15 @@ min = Native.Basics.min
221max : comparable -> comparable -> comparable
221max : comparable -> comparable -> comparable
222max = Native.Basics.max
222max = Native.Basics.max
223
223
224−{-| The and operator. True if both inputs are True. -}
224+{-| The and operator. True if both inputs are True.
225+This operator short-circuits if the first argument is False.
226+-}
225(&&) : Bool -> Bool -> Bool
227(&&) : Bool -> Bool -> Bool
226(&&) = Native.Basics.and
228(&&) = Native.Basics.and
227
229
228−{-| The or operator. True if one or both inputs are True. -}
230+{-| The or operator. True if one or both inputs are True.
231+This operator short-circuits if the first argument is True.
232+-}
229(||) : Bool -> Bool -> Bool
233(||) : Bool -> Bool -> Bool
230(||) = Native.Basics.or
234(||) = Native.Basics.or
231
235
@@ -328,7 +332,7 @@ curry : ((a,b) -> c) -> a -> b -> c
328curry f a b = f (a,b)
332curry f a b = f (a,b)
329
333
330{-| Change how arguments are passed to a function.
334{-| Change how arguments are passed to a function.
331−This combines two arguments into a sigle pair.
335+This combines two arguments into a single pair.
332-}
336-}
333uncurry : (a -> b -> c) -> (a,b) -> c
337uncurry : (a -> b -> c) -> (a,b) -> c
334uncurry f (a,b) = f a b
338uncurry f (a,b) = f a b
libraries/Bitwise.elm+6−6
@@ -13,22 +13,22 @@ module Bitwise where
13
13
14import Native.Bitwise
14import Native.Bitwise
15
15
16−{-| Bitwise &ldquo;and&rdquo;
16+{-| Bitwise AND
17-}
17-}
18and : Int -> Int -> Int
18and : Int -> Int -> Int
19and = Native.Bitwise.and
19and = Native.Bitwise.and
20
20
21−{-| Bitwise &ldquo;or&rdquo;
21+{-| Bitwise OR
22-}
22-}
23or : Int -> Int -> Int
23or : Int -> Int -> Int
24or = Native.Bitwise.or
24or = Native.Bitwise.or
25
25
26−{-| Bitwise &ldquo;xor&rdquo;
26+{-| Bitwise XOR
27-}
27-}
28xor : Int -> Int -> Int
28xor : Int -> Int -> Int
29xor = Native.Bitwise.xor
29xor = Native.Bitwise.xor
30
30
31−{-| Flip each bit individually, often called &ldquo;bitwise not&rdquo;
31+{-| Flip each bit individually, often called bitwise NOT
32-}
32-}
33complement : Int -> Int
33complement : Int -> Int
34complement = Native.Bitwise.complement
34complement = Native.Bitwise.complement
@@ -51,7 +51,7 @@ whatever is the topmost bit. This can be used to divide numbers by powers of two
51
51
52This is called an [arithmatic right
52This is called an [arithmatic right
53shift](http://en.wikipedia.org/wiki/Bitwise_operation#Arithmetic_shift),
53shift](http://en.wikipedia.org/wiki/Bitwise_operation#Arithmetic_shift),
54−often written (>>), and sometimes called a &ldquo;sign-propagating&rdquo;
54+often written (>>), and sometimes called a sign-propagating
55right shift because it fills empty spots with copies of the highest bit.
55right shift because it fills empty spots with copies of the highest bit.
56-}
56-}
57shiftRight : Int -> Int -> Int
57shiftRight : Int -> Int -> Int
@@ -66,7 +66,7 @@ zeros.
66
66
67This is called an [logical right
67This is called an [logical right
68shift](http://en.wikipedia.org/wiki/Bitwise_operation#Logical_shift), often written (>>>),
68shift](http://en.wikipedia.org/wiki/Bitwise_operation#Logical_shift), often written (>>>),
69−and sometimes called a &ldquo;zero-fill&rdquo; right shift because it fills empty spots
69+and sometimes called a zero-fill right shift because it fills empty spots
70with zeros.
70with zeros.
71-}
71-}
72shiftRightLogical : Int -> Int -> Int
72shiftRightLogical : Int -> Int -> Int
libraries/Graphics/Element.elm+1−1
@@ -108,7 +108,7 @@ color c e = let p = e.props in
108
108
109{-| Create an `Element` with a tag. This lets you link directly to it.
109{-| Create an `Element` with a tag. This lets you link directly to it.
110The element `(tag "all-about-badgers" thirdParagraph)` can be reached
110The element `(tag "all-about-badgers" thirdParagraph)` can be reached
111−with a link lik this: `/facts-about-animals.elm#all-about-badgers`
111+with a link like this: `/facts-about-animals.elm#all-about-badgers`
112-}
112-}
113tag : String -> Element -> Element
113tag : String -> Element -> Element
114tag name e = let p = e.props in
114tag name e = let p = e.props in
libraries/Graphics/Input.elm+1−1
@@ -113,7 +113,7 @@ hoverables : a -> { events : Signal a,
113 hoverable : (Bool -> a) -> Element -> Element }
113 hoverable : (Bool -> a) -> Element -> Element }
114hoverables = Native.Graphics.Input.hoverables
114hoverables = Native.Graphics.Input.hoverables
115
115
116−{-| Detect when the mouse is hovering over a specifici `Element`. -}
116+{-| Detect when the mouse is hovering over a specific `Element`. -}
117hoverable : Element -> (Element, Signal Bool)
117hoverable : Element -> (Element, Signal Bool)
118hoverable elem =
118hoverable elem =
119 let pool = hoverables False
119 let pool = hoverables False
libraries/Lazy.elmdeleted−53
@@ -1,53 +0,0 @@
1−module Lazy ( force, lazy, map, apply, bind
2− ) where
3−
4−{-| Library for efficient Lazy evaluation.
5−
6−# Delay
7−@docs lazy
8−
9−# Evaluate
10−@docs force
11−
12−# Transform
13−@docs map, apply, bind
14−-}
15−
16−import Basics ((<|), (.))
17−import Native.Lazy
18−
19−data Lazy a = L { force : () -> a }
20−
21−{-| Delay a computation. This function memoizes results, so
22−it guarantees that the computation will be evaluated at most once.
23−-}
24−lazy : (() -> a) -> Lazy a
25−lazy t = L { force = (Native.Lazy.lazy t) }
26−
27−{-| Evaluate a lazy value. It saves the result so the second time
28−you call `force` it does not run the computation again. -}
29−force : Lazy a -> a
30−force (L r) = r.force ()
31−
32−{-| Lazily apply a function to a lazy value. The computation
33−will be delayed until you force the resulting value.
34−-}
35−map : (a -> b) -> Lazy a -> Lazy b
36−map f t = lazy <| \() ->
37− f . force <| t
38−
39−{-| Lazily apply a lazy function to a lazy value. This can
40−be used to lazily apply a function to many arguments:
41−
42−```haskell
43−f `map` a `apply` b `apply` c
44−```
45−-}
46−apply : Lazy (a -> b) -> Lazy a -> Lazy b
47−apply f x = lazy <| \() ->
48− (force f) (force x)
49−
50−{-| Lazily chain together lazy computations. -}
51−bind : Lazy a -> (a -> Lazy b) -> Lazy b
52−bind x k = lazy <| \() ->
53− force . k . force <| x
libraries/Lazy/Stream.elmdeleted−275
@@ -1,275 +0,0 @@
1−module Lazy.Stream ( head, tail
2− , cons, cons', iterate, repeat, cycle
3− , map, apply, zip, zipWith, scanl
4− , take, drop, splitAt
5− , sampleOn
6− , filter, takeWhile, dropWhile, splitWith
7− ) where
8−
9−{-| This library is for creating and manipulating infinite streams
10−
11−# Create
12−@docs cons, cons', repeat, cycle, iterate
13−
14−# Use
15−@docs head, tail, sampleOn, take, takeWhile, drop, dropWhile, splitAt, splitWith
16−
17−# Transform
18−@docs map, zip, zipWith, scanl, filter, apply
19−
20−-}
21−
22−import Basics ((.), (<|), (-), id, fst, snd)
23−import open Lazy
24−import Signal ((<~), foldp, Signal)
25−
26−data Stream a = S (Lazy (a, Stream a))
27−
28−unS : Stream a -> (a, Stream a)
29−unS (S t) = force t
30−
31−{-| Get the first element of a stream, called the `head`.
32−
33−```haskell
34−head ones == 1
35−```
36−-}
37−head : Stream a -> a
38−head = fst . unS
39−
40−{-| Drop the `head` of a stream, leaving you with the `tail`.
41−
42−```haskell
43−-- 1, 1, 1, 1, ...
44−stillAllOnes = tail
45−```
46−-}
47−tail : Stream a -> Stream a
48−tail = snd . unS
49−
50−{-| Create a stream:
51−
52−```haskell
53−-- 1, 1, 1, 1, ...
54−ones = cons 1 (\() -> ones)
55−```
56− -}
57−cons : a -> (() -> Stream a) -> Stream a
58−cons x txs = let mtxs = lazy txs in
59− S . lazy <| \() ->
60− (x, force mtxs)
61−
62−{-| Create a stream that is slightly more lazy. Notice that the
63−head of the stream is defined within the thunk, so its evaluation
64−is delayed. This is nice when each element of the stream is costly to compute.
65−
66−```haskell
67−-- 1, 1, 1, 1, ...
68−ones = cons' (\_ -> (1,ones))
69−```
70−-}
71−cons' : (() -> (a, Stream a)) -> Stream a
72−cons' = S . lazy
73−
74−{-| Iteratively apply a function to a value:
75−
76−```haskell
77−-- x, f x, f (f x), f (f (f x)), ...
78−iterate f x
79−
80−-- 2, 4, 8, 16, ...
81−powersOf2 = iterate (\n -> n^2) 2
82−```
83−-}
84−iterate : (a -> a) -> a -> Stream a
85−iterate f x =
86− cons' <| \_ -> (x, iterate f (f x))
87−
88−{-| Repeat a value infinitely:
89−
90−```haskell
91−-- 1, 1, 1, 1, ...
92−ones = repeat 1
93−```
94− -}
95−repeat : a -> Stream a
96−repeat x = let go = cons x <| \() -> go
97− in go
98−
99−{-| Infinitely cycle through a list, where the head and tail of
100−the list are given separately to ensure that no one tries to cycle
101−on an empty list:
102−
103−```haskell
104−-- "Alice", "Bob", "Alice", "Bob", ...
105−cycle "Alice" ["Bob"]
106−```
107−-}
108−cycle : a -> [a] -> Stream a
109−cycle x xs =
110− let cycle' ys = case ys of
111− [] -> go
112− (y :: ys) -> cons y (\_ -> cycle' ys)
113− go = cons' <| \_ -> (x, cycle' xs)
114− in go
115−
116−{-| Apply a function to every element of a Stream.
117−
118−```haskell
119−-- 2, 2, 2, 2, ...
120−twos = map (\n -> n + 1) ones
121−```
122−-}
123−map : (a -> b) -> Stream a -> Stream b
124−map f xs =
125− cons' <| \_ -> (f (head xs), map f (tail xs))
126−
127−{-| Pairwise apply a stream of functions to a stream of arguments.
128−When paired with `map`, this can be used to emulate `zipWith` over *n* streams.
129−
130−```haskell
131−zipWith3 : (a -> b -> c -> d) -> Stream a -> Stream b -> Stream c -> Stream d
132−zipWith3 f xs ys zs = f `S.map` xs `S.apply` ys `S.apply` zs
133−```
134−-}
135−apply : Stream (a -> b) -> Stream a -> Stream b
136−apply fs xs = zipWith (<|) fs xs
137−
138−{-| Combine two streams, putting them into tuples pairwise:
139−
140−```haskell
141−-- (1,2), (1,4), (1,8), (1,16), ...
142−pairs = zip ones powersOf2
143−```
144−-}
145−zip : Stream a -> Stream b -> Stream (a,b)
146−zip = zipWith (\x y -> (x,y))
147−
148−{-| Combine two streams, applying the given function pairwise:
149−
150−```haskell
151−-- 3, 5, 9, 17, ...
152−zipWith (+) ones powersOf2
153−```
154−-}
155−zipWith : (a -> b -> c) -> Stream a -> Stream b -> Stream c
156−zipWith f xs ys = cons' <| \() ->
157− (f (head xs) (head ys),
158− zipWith f (tail xs) (tail ys))
159−
160−{-| Scan over a stream from the left, building an infinite stream of reductions.
161−
162−```haskell
163−-- 0, 1, 2, 3, ...
164−runningTotal = scanl (+) 0 ones
165−```
166−-}
167−scanl : (a -> b -> b) -> b -> Stream a -> Stream b
168−scanl f init xs =
169− cons' <| \() -> (init, scanl f (f (head xs) init) (tail xs))
170−
171−{-| Take the first *n* elements of a stream
172−
173−```haskell
174−take 5 powersOf2 == [2,4,8,16,32]
175−```
176−-}
177−take : Int -> Stream a -> [a]
178−take n xs = fst <| splitAt n xs
179−
180−{-| Drop the first *n* elements of a stream
181−
182−```haskell
183−-- 64, 128, 256, 512, ...
184−drop 5 powersOf2
185−```
186−-}
187−drop : Int -> Stream a -> Stream a
188−drop n xs = snd <| splitAt n xs
189−
190−{-| Combination of `take` and `drop`
191−
192−```haskell
193−splitAt n xs == (take n xs, drop n xs)
194−```
195−-}
196−splitAt : Int -> Stream a -> ([a], Stream a)
197−splitAt n xs = case n of
198− 0 -> ([], xs)
199− n -> let (heads, end) = splitAt (n - 1) (tail xs)
200− in (head xs :: heads, end)
201−
202−{-| Turn a stream into a signal of the elements of the stream,
203−advancing through the stream whenever an event in the given signal is
204−fired.
205−-}
206−sampleOn : Signal b -> Stream a -> Signal a
207−sampleOn sig str = let tails = foldp (\_ -> tail) str sig in
208− head <~ tails
209−
210−{-| Filter the elements of a Stream according to a predicate.
211−
212−```haskell
213−-- 1, 3, 5, 7, ...
214−filter isOdd naturals
215−
216−-- Bad! Infinite loop!
217−filter isOdd twos
218−```
219−
220−This can infinite loop if no more elements in the stream satisfy the predicate!
221−-}
222−filter : (a -> Bool) -> Stream a -> Stream a
223−filter pred xs = cons' <| (\() ->
224− let (hd, tl) = unS xs in
225− case pred hd of
226− True -> (hd, filter pred tl)
227− False -> unS <| filter pred tl)
228−
229−{-| Take values from the stream for as long as the predicate holds.
230−This can infinite loop if all elements of the stream satisfy the predicate!
231−
232−```haskell
233−takeWhile (\n -> n < 10) powersOf2 == [2,4,8]
234−
235−-- Bad! Infinite loop!
236−takeWhile isEven powersOf2
237−```
238−
239−This can infinite loop if all elements of the stream satisfy the predicate!
240−-}
241−takeWhile : (a -> Bool) -> Stream a -> [a]
242−takeWhile pred xs = fst <| splitWith pred xs
243−
244−{-| Drop values from the stream as long as the predicate holds.
245−
246−```haskell
247−-- 16, 32, 64, 128, ...
248−dropWhile (\n -> n < 10) powersOf2
249−
250−-- Bad! Infinite loop!
251−dropWhile isEven powersOf2
252−```
253−
254−This can infinite loop if all elements of the stream satisfy the predicate!
255−-}
256−dropWhile : (a -> Bool) -> Stream a -> Stream a
257−dropWhile pred xs = snd <| splitWith pred xs
258−
259−{-| Combination of `takeWhile` and `dropWhile`. Split a stream when
260−the predicate no longer holds.
261−
262−```haskell
263−splitWith pred xs == (takeWhile pred xs, dropWhile pred xs)
264−
265−splitWith (\n -> n < 10) powersOf2 == ([2,4,8], ...)
266−```
267−
268−This can infinite loop if all elements satisfy the predicate!
269−-}
270−splitWith : (a -> Bool) -> Stream a -> ([a], Stream a)
271−splitWith pred xs = let (hd, tl) = unS xs in
272− case pred hd of
273− True -> let (taken, dropped) = splitWith pred tl
274− in (hd :: taken, dropped)
275− False -> ([], xs)
libraries/Native/Lazy.jsdeleted−26
@@ -1,26 +0,0 @@
1−Elm.Native.Lazy = {};
2−Elm.Native.Lazy.make = function(elm) {
3− elm.Native = elm.Native || {};
4− elm.Native.Lazy = elm.Native.Lazy || {};
5−
6− if (elm.Native.Lazy.values) return elm.Native.Lazy.values;
7−
8− var Utils = Elm.Native.Utils.make(elm);
9−
10− function lazy(f) {
11− var value = {};
12− var isEvaled = false;
13− var memoed = function(x) {
14− if(!isEvaled) {
15− value = f(Utils.Tuple0);
16− isEvaled = true;
17− }
18− return value;
19− }
20− return memoed;
21− }
22−
23− return elm.Native.Lazy.values = {
24− lazy : lazy
25− };
26−};
libraries/Signal.elm+3−3
@@ -3,7 +3,7 @@ module Signal where
3`lift8` and infix lift operators `<~` and `~`, combinations, filters, and
3`lift8` and infix lift operators `<~` and `~`, combinations, filters, and
4past-dependence.
4past-dependence.
5
5
6−Signals are time-varying values. Lifted functions are reevaluated whenver any of
6+Signals are time-varying values. Lifted functions are reevaluated whenever any of
7their input signals has an event. Signal events may be of the same value as the
7their input signals has an event. Signal events may be of the same value as the
8previous value of the signal. Such signals are useful for timing and
8previous value of the signal. Such signals are useful for timing and
9past-dependence.
9past-dependence.
@@ -95,11 +95,11 @@ combine = foldr (Native.Signal.lift2 (::)) (Native.Signal.constant [])
95 -- fold over non-homogeneous inputs.
95 -- fold over non-homogeneous inputs.
96 -- mergeEither : Signal a -> Signal b -> Signal (Either a b)
96 -- mergeEither : Signal a -> Signal b -> Signal (Either a b)
97
97
98−{-| Count the number of events that have occured. -}
98+{-| Count the number of events that have occurred. -}
99count : Signal a -> Signal Int
99count : Signal a -> Signal Int
100count = Native.Signal.count
100count = Native.Signal.count
101
101
102−{-| Count the number of events that have occured that satisfy a given predicate.
102+{-| Count the number of events that have occurred that satisfy a given predicate.
103-}
103-}
104countIf : (a -> Bool) -> Signal a -> Signal Int
104countIf : (a -> Bool) -> Signal a -> Signal Int
105countIf = Native.Signal.countIf
105countIf = Native.Signal.countIf
libraries/Transform2D.elm+7−5
@@ -1,14 +1,16 @@
1module Transform2D where
1module Transform2D where
2−{-| A library for performing [2D matrix transformations](http://en.wikipedia.org/wiki/Transformation_matrix#Affine_transformations).
2+{-| A library for performing [2D matrix transformations][affine].
3It is used primarily with the `groupTransform` function from `Graphics.Collage` and
3It is used primarily with the `groupTransform` function from `Graphics.Collage` and
4allows you to do things like rotation, scaling, translation, shearing, and reflection.
4allows you to do things like rotation, scaling, translation, shearing, and reflection.
5
5
6Note that all the matrices in this library are 3x3 matrices of homogeneous
6Note that all the matrices in this library are 3x3 matrices of homogeneous
7−coordinates, used for affine transformations. Since the third row as always 0 0
7+coordinates, used for [affine transformations][affine]. Since the bottom row as
8−1, we omit this below.
8+always `0 0 1` in these matrices, it is omitted in the diagrams below.
9
9
10+ [affine]: http://en.wikipedia.org/wiki/Transformation_matrix#Affine_transformations
11+
10−# Basic Transforms
12+# Transforms
11−@docs identity, matrix, rotation
13+@docs identity, matrix, rotation, translation, scale, scaleX, scaleY
12
14
13# Multiplication
15# Multiplication
14@docs multiply
16@docs multiply
libraries/elm_dependencies.jsonnew file+40
@@ -0,0 +1,40 @@
1+{ "version": "0.10.0.2"
2+, "summary": "Elm's standard libraries"
3+, "description": "The full set of standard libraries for Elm. This library is pegged to the version number of the compiler, so if you are using Elm 0.11, you should be using version 0.11 of the standard libraries."
4+, "license": "BSD3"
5+, "repository": "http://github.com/evancz/Elm.git"
6+, "elm-version": "0.10.0.2"
7+, "dependencies": {}
8+, "exposed-modules":
9+ [ "Automaton"
10+ , "Basics"
11+ , "Bitwise"
12+ , "Char"
13+ , "Color"
14+ , "Date"
15+ , "Dict"
16+ , "Either"
17+ , "Graphics.Element"
18+ , "Graphics.Collage"
19+ , "Graphics.Input"
20+ , "Http"
21+ , "JavaScript"
22+ , "JavaScript.Experimental"
23+ , "Json"
24+ , "Keyboard"
25+ , "List"
26+ , "Maybe"
27+ , "Mouse"
28+ , "Random"
29+ , "Regex"
30+ , "Set"
31+ , "Signal"
32+ , "String"
33+ , "Text"
34+ , "Time"
35+ , "Touch"
36+ , "Transform2D"
37+ , "WebSocket"
38+ , "Window"
39+ ]
40+}