diff --git a/.gitignore b/.gitignore index 1dc2fee95..24e3f179b 100644 --- a/.gitignore +++ b/.gitignore @@ -13,3 +13,7 @@ data build cache *~ +tests/elm/build/ +tests/elm/cache/ +tests/elm/exe.js +node_modules/ diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 000000000..e067d9256 --- /dev/null +++ b/.gitmodules @@ -0,0 +1,9 @@ +[submodule "IO"] + path = IO + url = https://github.com/maxsnew/IO.git +[submodule "automaton"] + path = automaton + url = https://github.com/evancz/automaton.git +[submodule "Elm-Test"] + path = Elm-Test + url = https://github.com/deadfoxygrandpa/Elm-Test.git diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index d58cb0418..26338040b 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -5,31 +5,32 @@ describes the basic standards for opening pull requests: ## Branches - * The master branch of Elm is for tagging previous releases - and non-breaking changes, like bug fixes. This branch is - handy for folks who want to build the most recent public - release from source. + * [The master branch](https://github.com/elm-lang/Elm/tree/master) is the + home of the next release of the compiler so new features and improvements + get merged there. Most pull requests should target this branch! - * The dev branch is where the most active development occurs. - It is the home of the next release of the compiler so new - features and improvements get merged there. + * [The stable branch](https://github.com/elm-lang/Elm/tree/stable) is for + tagging previous releases and critical bug fixes. This branch is handy for + folks who want to build the most recent public release from source. + +If you are working on a fairly large feature, we will probably want to merge it +in as its own branch and do some testing before bringing it into the master +branch. This way we can keep releases of the master branch independent of new +features. ## Opening a pull request -**Please open PRs against the [dev branch of -Elm](http://github.com/evancz/elm/tree/dev) whenever possible.** Changes that -are compatible with the API of master will be merged to master as soon as -possible. Changes that affect Elm's API will be merged to master with a future -release of the compiler. +**Please open PRs against the [master branch of +Elm](http://github.com/elm-lang/elm/tree/master) whenever possible.** -Note that changes in the master branch of [Elm](https://github.com/evancz/Elm/) +Note that changes in the master branch of [Elm](https://github.com/elm-lang/Elm/) are able to be compiled against the master branch of the [elm-lang.org -repo](https://github.com/evancz/elm-lang.org), and the dev branch of -[Elm](https://github.com/evancz/Elm/) is able to be built with the dev branch of -the [elm-lang.org repo](https://github.com/evancz/elm-lang.org). Please make -sure that your changes maintain this compatibility. +repo](https://github.com/elm-lang/elm-lang.org), and the stable branch of +[Elm](https://github.com/elm-lang/Elm/) is able to be built with the stable +branch of the [elm-lang.org repo](https://github.com/elm-lang/elm-lang.org). +Please make sure that your changes maintain this compatibility. ## Licensing -You should sign the [contributor agreement](ContributorAgreement.pdf) -and send it to before opening your pull request. \ No newline at end of file +You need to sign the [contributor agreement](ContributorAgreement.pdf) +and send it to before opening your pull request. diff --git a/Elm-Test b/Elm-Test new file mode 160000 index 000000000..191185bb9 --- /dev/null +++ b/Elm-Test @@ -0,0 +1 @@ +Subproject commit 191185bb9e9a829ca604e28350b4d5b2381230e4 diff --git a/Elm.cabal b/Elm.cabal index f4f3f04c8..bcb4061d6 100644 --- a/Elm.cabal +++ b/Elm.cabal @@ -1,5 +1,5 @@ Name: Elm -Version: 0.12 +Version: 0.12.1 Synopsis: The Elm language module. Description: Elm aims to make client-side web-development more pleasant. It is a statically/strongly typed, functional reactive @@ -27,7 +27,7 @@ Cabal-version: >=1.9 source-repository head type: git - location: git://github.com/evancz/Elm.git + location: git://github.com/elm-lang/Elm.git Library exposed-modules: Elm.Internal.Dependencies, @@ -95,8 +95,9 @@ Library Paths_Elm Build-depends: aeson, + aeson-pretty, base >=4.2 && <5, - binary >= 0.6.4.0, + binary >= 0.7.0.0, blaze-html >= 0.5 && < 0.8, blaze-markup, bytestring, @@ -178,8 +179,9 @@ Executable elm Paths_Elm Build-depends: aeson, + aeson-pretty, base >=4.2 && <5, - binary >= 0.6.4.0, + binary >= 0.7.0.0, blaze-html >= 0.5 && < 0.8, blaze-markup, bytestring, @@ -224,7 +226,7 @@ Executable elm-doc Build-depends: aeson, aeson-pretty, base >=4.2 && <5, - binary >= 0.6.4.0, + binary >= 0.7.0.0, bytestring, cmdargs, containers >= 0.3, @@ -239,35 +241,33 @@ Executable elm-doc text, union-find -Test-Suite test-elm +Test-Suite compiler-tests Type: exitcode-stdio-1.0 - Hs-Source-Dirs: tests, compiler - Main-is: Main.hs + Hs-Source-Dirs: tests/hs, compiler + Main-is: CompilerTest.hs other-modules: Tests.Compiler Tests.Property Tests.Property.Arbitrary SourceSyntax.Helpers SourceSyntax.Literal SourceSyntax.PrettyPrint - build-depends: base, - directory, - Elm, - test-framework, + build-depends: test-framework, test-framework-hunit, test-framework-quickcheck2 >= 0.3, HUnit, - pretty, QuickCheck >= 2 && < 3, - filemanip, aeson, + aeson-pretty, base >=4.2 && <5, - binary >= 0.6.4.0, - blaze-html == 0.5.* || == 0.6.*, - blaze-markup == 0.5.1.*, + binary >= 0.7.0.0, + blaze-html, + blaze-markup, bytestring, cmdargs, containers >= 0.3, directory, + Elm, + filemanip, filepath, indents, language-ecmascript >=0.15 && < 1.0, @@ -280,3 +280,13 @@ Test-Suite test-elm transformers >= 0.2, union-find, unordered-containers + +Test-Suite lib-tests + Type: exitcode-stdio-1.0 + Hs-Source-Dirs: tests/hs + Main-is: LibTest.hs + build-depends: base, + directory, + Elm, + filepath, + process diff --git a/IO b/IO new file mode 160000 index 000000000..9fcf0c902 --- /dev/null +++ b/IO @@ -0,0 +1 @@ +Subproject commit 9fcf0c90253ca65c9d95a524eef1a2ed917f7737 diff --git a/README.md b/README.md index abf9e9765..750906a84 100644 --- a/README.md +++ b/README.md @@ -4,55 +4,20 @@ Learn about the Elm programming language at [elm-lang.org](http://elm-lang.org/) ## Install -**Arch Linux** — follow [these directions](https://github.com/elm-lang/Elm/wiki/Installing-Elm#arch-linux) and then -jump to the [My First Project](#my-first-project) section. -
-**OS X 10.9 or XCode 5** — follow -[these directions](http://justtesting.org/post/64947952690/the-glasgow-haskell-compiler-ghc-on-os-x-10-9) -before continuing with the platform agnostic directions below. +Follow [these instructions][installer] if you just want to use Elm. To build +the compiler from source, run the following commands: -**Platform Agnostic** — -download the [Haskell Platform 2012.2.0.0 or later](http://hackage.haskell.org/platform/). -Once the Haskell Platform is installed: + [installer]: https://github.com/elm-lang/elm-platform/blob/master/README.md#elm-platform - cabal update - cabal install elm - cabal install elm-server +```bash +git clone https://github.com/elm-lang/Elm.git +cd Elm +cabal configure +cabal build +``` -## Use - -To use `elm` and `elm-server` you may need to add a new directory to your PATH. - -Cabal should tell you where your executables are located upon -successful installation. It'll be something like `/home/evan/.cabal/bin` -which you should append to your PATH variable. -See this tutorial if you are new to changing your PATH in -[Unix/Linux](http://www.cyberciti.biz/faq/unix-linux-adding-path/). - -## My First Project - -Now we will create a simple Elm project. -The following commands will set-up a very basic project and start the Elm server. - - mkdir helloElm - cd helloElm - printf "import Mouse\n\nmain = lift asText Mouse.position" > Main.elm - elm-server - -The first two commands create a new directory and navigate into it. The `printf` -commands place a simple program into `Main.elm`. Do this manually if you do not -have `printf`. The final command starts the Elm server at [localhost:8000](http://localhost:8000/), -allowing you to navigate to `Main.elm` and see your first program in action. - -#### Final Notes - -The `elm` package provides -[some utility functions](http://hackage.haskell.org/package/Elm) for -working with Elm in Haskell. This can be useful for creating tooling -for Elm, and has been useful for projects like -[the website](http://elm-lang.org/) and -[`elm-get`](https://github.com/elm-lang/elm-get). Email the list if you -want to rely on these functions! +This will build the compiler in `/dist/build/elm/elm` but it will not be on +your PATH. If you are stuck, email [the list](https://groups.google.com/forum/?fromgroups#!forum/elm-discuss) diff --git a/automaton b/automaton new file mode 160000 index 000000000..599dcae5e --- /dev/null +++ b/automaton @@ -0,0 +1 @@ +Subproject commit 599dcae5ef1bf0b2e2e0b662f1ad8a5a1c8c9574 diff --git a/changelog.md b/changelog.md index 245e417bd..c01eda941 100644 --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,12 @@ -## 0.13 +## 0.12.1 + +## Improvements: + + * New Array library (thanks entirely to @Xashili) + * Json.Value can flow through ports + * Improve speed and stack usage in List library (thanks to @maxsnew) + * Add Dict.filter and Dict.partition (thanks to @hdgarrood) #### Breaking Changes: @@ -7,11 +14,6 @@ * Revamp JavaScript.Experimental library to have slightly better names * Remove JavaScript library which was made redundant by ports -## Improvements: - - * Json.Value can flow through ports, so you can bring in values even - if they don't conform to a consistent type. - ## 0.12 #### Breaking Changes: diff --git a/compiler/Elm/Internal/Dependencies.hs b/compiler/Elm/Internal/Dependencies.hs index fc3eaf44c..5e1aa2411 100644 --- a/compiler/Elm/Internal/Dependencies.hs +++ b/compiler/Elm/Internal/Dependencies.hs @@ -5,9 +5,12 @@ import Control.Applicative import Control.Monad.Error import qualified Control.Exception as E import Data.Aeson +import Data.Aeson.Encode.Pretty import qualified Data.List as List import qualified Data.ByteString.Lazy as BS import qualified Data.HashMap.Strict as Map +import qualified Data.Text as T + import qualified Elm.Internal.Name as N import qualified Elm.Internal.Version as V import qualified Elm.Internal.Paths as Path @@ -22,14 +25,32 @@ data Deps = Deps , exposed :: [String] , elmVersion :: V.Version , dependencies :: [(N.Name,V.Version)] - } deriving Show + } deriving (Show, Eq, Ord) data MiniDeps = Mini [(N.Name,V.Version)] + deriving (Show, Eq, Ord) + +instance ToJSON MiniDeps where + toJSON (Mini m) = toJSON m instance FromJSON MiniDeps where parseJSON (Object obj) = Mini <$> getDependencies obj parseJSON _ = mzero +instance ToJSON Deps where + toJSON d = object [ + "version" .= version d, + "summary" .= summary d, + "description" .= description d, + "license" .= license d, + "repository" .= repo d, + "exposed-modules" .= exposed d, + "elm-version" .= elmVersion d, + "dependencies" .= (jsonDeps . dependencies $ d) + ] + where jsonDeps = Map.fromList . map (mapFst (T.pack . show)) + mapFst f (a,b) = (f a, b) + instance FromJSON Deps where parseJSON (Object obj) = do version <- get obj "version" "your projects version number" @@ -110,8 +131,24 @@ withDeps handle path = case result of Right bytes -> return bytes Left _ -> throwError $ - "could not find file " ++ path ++ - "\n You may need to create a dependency file for your project." + "could not find " ++ path ++ " file. You may need to create one.\n" ++ + " For an example of how to fill in the dependencies file, check out\n" ++ + " " depsAt :: FilePath -> ErrorT String IO Deps -depsAt = withDeps id \ No newline at end of file +depsAt = withDeps id + +-- | Encode dependencies in a canonical JSON format +prettyJSON :: Deps -> BS.ByteString +prettyJSON = encodePretty' config + where config = defConfig { confCompare = order } + order = keyOrder [ "name", + "version", + "summary", + "description", + "license", + "repo", + "exposed-modules", + "elm-version", + "dependencies" + ] diff --git a/compiler/Elm/Internal/Name.hs b/compiler/Elm/Internal/Name.hs index 3bb9fe020..35315e95f 100644 --- a/compiler/Elm/Internal/Name.hs +++ b/compiler/Elm/Internal/Name.hs @@ -10,7 +10,7 @@ import qualified Data.Maybe as Maybe import Data.Typeable data Name = Name { user :: String, project :: String } - deriving (Typeable,Eq) + deriving (Typeable,Eq, Ord) instance Binary Name where get = Name <$> get <*> get @@ -48,4 +48,4 @@ errorMsg string = unlines [ "Dependency file has an invalid name: " ++ string , "Must have format user/project and match a public github project." - ] \ No newline at end of file + ] diff --git a/compiler/Generate/JavaScript.hs b/compiler/Generate/JavaScript.hs index e2475d6cb..6533ad188 100644 --- a/compiler/Generate/JavaScript.hs +++ b/compiler/Generate/JavaScript.hs @@ -34,10 +34,11 @@ include alias moduleName = internalImports :: String -> Statement () internalImports name = - VarDeclStmt () + VarDeclStmt () [ varDecl "_N" (obj "Elm.Native") , include "_U" "_N.Utils" , include "_L" "_N.List" + , include "_A" "_N.Array" , include "_E" "_N.Error" , varDecl "$moduleName" (string name) ] diff --git a/compiler/Generate/JavaScript/Ports.hs b/compiler/Generate/JavaScript/Ports.hs index 2270c1c94..eb4eb110c 100644 --- a/compiler/Generate/JavaScript/Ports.hs +++ b/compiler/Generate/JavaScript/Ports.hs @@ -20,7 +20,7 @@ check x jsType continue = JSNumber -> [typeof "number"] JSBoolean -> [typeof "boolean"] JSString -> [typeof "string", instanceof "String"] - JSArray -> [instanceof "Array"] + JSArray -> [(obj "_U.isJSArray" <|)] JSObject fields -> [jsFold OpLAnd (typeof "object" : map member fields)] incoming :: Type -> Expression () @@ -38,7 +38,7 @@ inc tipe x = Data "Json.Value" [] -> obj "Native.Json.fromJS" <| x - + Data ctor [] | ctor == "Int" -> from JSNumber | ctor == "Float" -> from JSNumber @@ -55,8 +55,12 @@ inc tipe x = | ctor == "_List" -> check x JSArray (obj "_L.fromArray" <| array) - where - array = DotRef () x (var "map") <| incoming t + + | ctor == "Array.Array" -> + check x JSArray (obj "_A.fromJSArray" <| array) + + where + array = DotRef () x (var "map") <| incoming t Data ctor ts | Help.isTuple ctor -> check x JSArray tuple @@ -67,10 +71,10 @@ inc tipe x = , inc t (BracketRef () x (IntLit () n))) Data _ _ -> - error "bad ADT got to port generation code" + error "bad ADT got to incoming port generation code" Record _ (Just _) -> - error "bad record got to port generation code" + error "bad record got to incoming port generation code" Record fields Nothing -> check x (JSObject (map fst fields)) object @@ -117,16 +121,19 @@ out tipe x = | ctor == "_List" -> DotRef () (obj "_L.toArray" <| x) (var "map") <| outgoing t + | ctor == "Array.Array" -> + DotRef () (obj "_A.toJSArray" <| x) (var "map") <| outgoing t + Data ctor ts | Help.isTuple ctor -> let convert n t = out t $ DotRef () x $ var ('_':show n) in ArrayLit () $ zipWith convert [0..] ts - + Data _ _ -> - error "bad ADT got to port generation code" + error "bad ADT got to outgoing port generation code" Record _ (Just _) -> - error "bad record got to port generation code" + error "bad record got to outgoing port generation code" Record fields Nothing -> ObjectLit () keys diff --git a/compiler/Type/ExtraChecks.hs b/compiler/Type/ExtraChecks.hs index 9c600a300..4f1e1968a 100644 --- a/compiler/Type/ExtraChecks.hs +++ b/compiler/Type/ExtraChecks.hs @@ -60,8 +60,7 @@ portTypes rules expr = | otherwise -> err' True "an unsupported type" where primitives = - ["Int","Float","String","Bool","Maybe.Maybe","_List","Json.Value"] - + ["Int","Float","String","Bool","Maybe.Maybe","_List","Array.Array","Json.Value"] validConstructor = ctor `elem` primitives || Help.isTuple ctor @@ -102,7 +101,7 @@ portTypes rules expr = , txt [ "It contains ", kind, ":\n" ] , (P.nest 4 . SPP.pretty $ Alias.realias rules tipe) <> P.text "\n" , txt [ "Acceptable values for ", dir "incoming" "outgoing", " ports include:" ] - , txt [ " Ints, Floats, Bools, Strings, Maybes, Lists, Tuples," ] + , txt [ " Ints, Floats, Bools, Strings, Maybes, Lists, Arrays, Tuples," ] , txt [ " Json.Values, ", dir "" "first-order functions, ", "and concrete records." ] ] ++ if couldBeAlias then aliasWarning else [] diff --git a/compiler/Type/Unify.hs b/compiler/Type/Unify.hs index 7d0fe1a6e..eacbc0d68 100644 --- a/compiler/Type/Unify.hs +++ b/compiler/Type/Unify.hs @@ -86,6 +86,10 @@ actuallyUnify region variable1 variable2 = do TS.addError region (Just $ Maybe.fromMaybe msg maybe) variable1 variable2 where msg = "A comparable must be an Int, Float, Char, String, list, or tuple." + appendableError maybe = + TS.addError region (Just $ Maybe.fromMaybe msg maybe) variable1 variable2 + where msg = "An appendable must be of type String, List, or Text." + unifyComparable var name | name `elem` ["Int","Float","Char","String","comparable"] = flexAndUnify var | otherwise = comparableError Nothing @@ -108,7 +112,7 @@ actuallyUnify region variable1 variable2 = do do struct <- liftIO $ collectApps varFlex case struct of List _ -> flexAndUnify varSuper - _ -> comparableError Nothing + _ -> appendableError Nothing rigidError variable = TS.addError region (Just hint) variable1 variable2 where diff --git a/libraries/Array.elm b/libraries/Array.elm index 7db5423c3..03fc384f8 100644 --- a/libraries/Array.elm +++ b/libraries/Array.elm @@ -1,23 +1,23 @@ module Array where -{-| A library for immutable arrays. The elements in an array must have the same -type. The arrays are implemented in Relaxed Radix Balanced-Trees for fast -reads, updates, and concatenation. +{-| A library for fast immutable arrays. The elements in an array must have the +same type. The arrays are implemented in Relaxed Radix Balanced-Trees for fast +reads, updates, and appends. -If you use more then one map or zip function on an array, consider turning it -into a list before operating on it, and then turning it back into an array. +# Creating Arrays +@docs empty, repeat, initialize, fromList # Basics -@docs empty, length, get, getMaybe, getSafe +@docs length, push, append -# Putting Arrays Together -@docs fill, fromList, concat, set, updates, push +# Get and Set +@docs get, getOrElse, getOrFail, set # Taking Arrays Apart -@docs toList, toIndexedList, indices, slice +@docs slice, toList, toIndexedList -# Mapping, folding, zipping -@docs map, indexedMap, foldl, foldr, zip, zipWith +# Mapping and Folding +@docs map, indexedMap, foldl, foldr -} import Native.Array @@ -27,17 +27,29 @@ import List data Array a = Array -{-| Fills an array with a given length and a default element. +{-| Initialize an array. `initialize n f` creates an array of length `n` with +the element at index `i` initialized to the result of `(f i)`. - fill 3 5 == fromList [5,5,5] + initialize 4 id == fromList [0,1,2,3] + initialize 4 (\n -> n*n) == fromList [0,1,4,9] + initialize 4 (always 0) == fromList [0,0,0,0] -} -fill : Int -> a -> Array a -fill len e = fromList <| List.map (always e) [1..len] +initialize : Int -> (Int -> a) -> Array a +initialize = Native.Array.initialize + +{-| Creates an array with a given length, filled with a default element. + + repeat 5 0 == fromList [0,0,0,0,0] + repeat 3 "cat" == fromList ["cat","cat","cat"] + +Notice that `repeat 3 x` is the same as `initialize 3 (always x)`. +-} +repeat : Int -> a -> Array a +repeat n e = initialize n (always e) --- TODO: make this a native function. {-| Create an array from a list. -} fromList : [a] -> Array a -fromList = List.foldl (Native.Array.push) Native.Array.empty +fromList = Native.Array.fromList {-| Create a list of elements from an array. @@ -46,24 +58,19 @@ fromList = List.foldl (Native.Array.push) Native.Array.empty toList : Array a -> [a] toList = Native.Array.toList -{-| Create a list of the possible indices of an array. - - indices (fromList [3,5,8] == [0,1,2]) --} -indices : Array a -> [Int] -indices a = [0..Native.Array.length a - 1] - -- TODO: make this a native function. -{-| Create a list of tuples (Index, Element) from an array. +{-| Create an indexed list from an array. Each element of the array will be +paired with its index. - toIndexedList (fromList [3,5,8]) == [(0,3), (1,5), (2,8)] + toIndexedList (fromList ["cat","dog"]) == [(0,"cat"), (1,"dog")] -} toIndexedList : Array a -> [(Int, a)] -toIndexedList a = List.zip (indices a) (Native.Array.toList a) +toIndexedList array = + List.zip [ 0 .. Native.Array.length array - 1 ] (Native.Array.toList array) {-| Apply a function on every element in an array. - map (\x -> x*x) (fromList [1,2,3]) == fromList [1,4,9] + map sqrt (fromList [1,4,9]) == fromList [1,2,3] -} map : (a -> b) -> Array a -> Array b map = Native.Array.map @@ -75,36 +82,29 @@ map = Native.Array.map indexedMap : (Int -> a -> b) -> Array a -> Array b indexedMap = Native.Array.indexedMap -{-| Reduce an array from the left. +{-| Reduce an array from the left. Read `foldl` as “fold from the left”. - foldl (+) 0 (fill 3 5) == 15 + foldl (::) [] (fromList [1,2,3]) == [3,2,1] -} foldl : (a -> b -> b) -> b -> Array a -> b foldl = Native.Array.foldl -{-| Reduce an array from the right. +{-| Reduce an array from the right. Read `foldr` as “fold from the right”. - foldr (::) [] (fromList [1,2,3]) == [3,2,1] + foldr (+) 0 (repeat 3 5) == 15 -} foldr : (a -> b -> b) -> b -> Array a -> b foldr = Native.Array.foldr -{-| Zip the elements of two arrays via a tuple into a new array. If one array is -longer, the extra elements are dropped. - - zip (fromList [1,2,3,4]) (fromList [0,0,0]) = fromList [(1,0), (2,0), (3,0)] --} -zip : Array a -> Array b -> Array (a,b) -zip = zipWith (,) - -{-| Zips the elements of two arrays via a function into a new array. If one array -is longer, the extra elements are dropped. +{-| Keep only elements that satisfy the predicate: - zipWith (+) (fill 3 5) (fill 5 8) == fill 3 13 + filter isEven (fromList [1..6]) == (fromList [2,4,6]) -} -zipWith : (a -> b -> c) -> Array a -> Array b -> Array c -zipWith f a b = - fromList <| List.zipWith f (Native.Array.toList a) (Native.Array.toList b) +filter : (a -> Bool) -> Array a -> Array a +filter isOkay arr = + let update x xs = if isOkay x then Native.Array.push x xs else xs + in + Native.Array.foldl update Native.Array.empty arr {-| Return an empty array. @@ -120,57 +120,65 @@ empty = Native.Array.empty push : a -> Array a -> Array a push = Native.Array.push -{-| Return the element at the index. Breaks, if index is out of range. If the -array length is unkown, use safeGet oder getWithDefault. +{-| Get the element at a particular index. - get 2 (A.fromList [3,2,1]) == 1 + getOrFail 0 (A.fromList [0,1,2]) == 0 + +Warning: this function will result in a runtime error if the index is not found, +so it is best to use `get` or `getOrElse` unless you are sure the index will be +found. -} -get : Int -> Array a -> a -get = Native.Array.get +getOrFail : Int -> Array a -> a +getOrFail = Native.Array.get {-| Return Just the element at the index or Nothing if the index is out of range. - getMaybe 2 (A.fromList [3,2,1]) == Just 2 - getMaybe 5 (A.fromList [3,2,1]) == Nothing + get 0 (fromList [0,1,2]) == Just 0 + get 2 (fromList [0,1,2]) == Just 2 + get 5 (fromList [0,1,2]) == Nothing + get -1 (fromList [0,1,2]) == Nothing -} -getMaybe : Int -> Array a -> Maybe a -getMaybe i array = if Native.Array.length array > i - then Just (Native.Array.get i array) - else Nothing +get : Int -> Array a -> Maybe a +get i array = + if 0 <= i && i < Native.Array.length array + then Just (Native.Array.get i array) + else Nothing -{-| Get the element at the index. If the index is out of range, the given default -element is returned. +{-| Get the element at the index. Or if the index is out of range, a default +value is returned. - getSafe 0 2 (A.fromList [3,2,1]) == 1 - getSafe 0 5 (A.fromList [3,2,1]) == 0 + getOrElse 0 2 (fromList [0,1,2]) == 2 + getOrElse 0 5 (fromList [0,1,2]) == 0 -} -getSafe : a -> Int -> Array a -> a -getSafe default i array = if Native.Array.length array > i - then Native.Array.get i array else default +getOrElse : a -> Int -> Array a -> a +getOrElse default i array = + if 0 <= i && i < Native.Array.length array + then Native.Array.get i array + else default -{-| Set the element at the index. Returns the updated array, or if the index is -out of range, the unaltered array. +{-| Set the element at a particular index. Returns an updated array. +If the index is out of range, the array is unaltered. set 1 7 (fromList [1,2,3]) == fromList [1,7,3] -} set : Int -> a -> Array a -> Array a set = Native.Array.set -{-| Update an array with a a list tuples, wherein the first Int is the index. +{-| Get a sub-section of an array: `(slice start end array)`. The `start` is a +zero-based index where we will start our slice. The `end` is a zero-based index +that indicates the end of the slice. The slice extracts up to but not including +`end`. - updates [(1,7),(2,8)] (fill 3 1) == fromList [1,7,8] --} -updates : [(Int, a)] -> Array a -> Array a -updates us array = List.foldl (uncurry Native.Array.set) array us + slice 0 3 (fromList [0,1,2,3,4]) == fromList [0,1,2] + slice 1 4 (fromList [0,1,2,3,4]) == fromList [1,2,3] + +Both the `start` and `end` indexes can be negative, indicating an offset from +the end of the array. -{-| Slice an array given a range. The selection is inclusive, so the last -element in the selection will also be in the new array. This may change in the -future. -You can select from the end by giving a negative Int. + slice 1 -1 (fromList [0,1,2,3,4]) == fromList [1,2,3] + slice -2 5 (fromList [0,1,2,3,4]) == fromList [3,4] - slice 1 2 (fromList [0,1,2,3,4]) == fromList [1,2] - slice 1 -2 (fromList [0,1,2,3,4]) == fromList [1,2,3] - slice -3 -2 (fromList [0,1,2,3,4]) == fromList [2,3] +This makes it pretty easy to `pop` the last element off of an array: `slice 0 -1 array` -} slice : Int -> Int -> Array a -> Array a slice = Native.Array.slice @@ -182,9 +190,9 @@ slice = Native.Array.slice length : Array a -> Int length = Native.Array.length -{-| Concat two arrays to a new one. +{-| Append two arrays to a new one. - concat (fill 3 1) (fill 4 2) == fromList [1,1,1,2,2,2,2] + append (array 2 42) (array 3 81) == fromList [42,42,81,81,81] -} -concat : Array a -> Array a -> Array a -concat = Native.Array.concat +append : Array a -> Array a -> Array a +append = Native.Array.append diff --git a/libraries/Dict.elm b/libraries/Dict.elm index 55c6afbe2..7ccedeb00 100644 --- a/libraries/Dict.elm +++ b/libraries/Dict.elm @@ -1,6 +1,8 @@ module Dict (empty,singleton,insert,update - ,lookup,findWithDefault + ,get,getOrElse,getOrFail ,remove,member + ,filter + ,partition ,foldl,foldr,map ,union,intersect,diff ,keys,values @@ -17,7 +19,7 @@ Insert, remove, and query operations all take *O(log n)* time. @docs empty, singleton, insert, update, remove # Query -@docs member, lookup, findWithDefault +@docs member, get, getOrElse, getOrFail # Combine @docs union, intersect, diff @@ -26,7 +28,7 @@ Insert, remove, and query operations all take *O(log n)* time. @docs keys, values, toList, fromList # Transform -@docs map, foldl, foldr +@docs map, foldl, foldr, filter, partition -} @@ -84,33 +86,74 @@ max t = RBNode _ _ _ _ r -> max r RBEmpty _ -> Native.Error.raise "(max Empty) is not defined" -{-| Lookup the value associated with a key. -} -lookup : comparable -> Dict comparable v -> Maybe v -lookup k t = +{-| Get the value associated with a key. If the key is not found, return +`Nothing`. This is useful when you are not sure if a key will be in the +dictionary. + + animals = fromList [ ("Tom", Cat), ("Jerry", Mouse) ] + + get "Tom" animals == Just Cat + get "Mouse" animals == Just Mouse + get "Spike" animals == Nothing + +The `getOrElse` and `getOrFail` are built-in ways to handle common ways of +using the resulting `Maybe`. +-} +get : comparable -> Dict comparable v -> Maybe v +get k t = case t of RBEmpty LBlack -> Nothing RBNode _ k' v l r -> case Native.Utils.compare k k' of - LT -> lookup k l + LT -> get k l EQ -> Just v - GT -> lookup k r + GT -> get k r + +{-| Get the value associated with a key. If the key is not found, +return a default value. -{-| Find the value associated with a key. If the key is not found, -return the default value. -} -findWithDefault : v -> comparable -> Dict comparable v -> v -findWithDefault base k t = + animals = fromList [ ("Tom", Cat), ("Jerry", Mouse) ] + + getOrElse Dog "Tom" animals == Cat + getOrElse Dog "Mouse" animals == Mouse + getOrElse Dog "Spike" animals == Dog +-} +getOrElse : v -> comparable -> Dict comparable v -> v +getOrElse base k t = case t of RBEmpty LBlack -> base RBNode _ k' v l r -> case Native.Utils.compare k k' of - LT -> findWithDefault base k l + LT -> getOrElse base k l EQ -> v - GT -> findWithDefault base k r + GT -> getOrElse base k r + +{-| Get the value associated with a key. + + animals = fromList [ ("Tom", Cat), ("Jerry", Mouse) ] + + getOrFail "Tom" animals == Cat + getOrFail "Mouse" animals == Mouse + getOrFail "Spike" animals == -- Runtime Error! + +Warning: this function will result in a runtime error if the key is not found, +so it is best to use `get` or `getOrElse` unless you are sure the key will be +found. +-} +getOrFail : comparable -> Dict comparable v -> v +getOrFail k t = + case t of + RBEmpty LBlack -> Native.Error.raise "key not found when using 'getOrFail'" + RBNode _ k' v l r -> + case Native.Utils.compare k k' of + LT -> getOrFail k l + EQ -> v + GT -> getOrFail k r {-| Determine if a key is in a dictionary. -} member : comparable -> Dict comparable v -> Bool -- Does t contain k? -member k t = isJust <| lookup k t +member k t = isJust <| get k t ensureBlackRoot : Dict k v -> Dict k v ensureBlackRoot t = @@ -327,9 +370,7 @@ union t1 t2 = foldl insert t2 t1 {-| Keep a key-value pair when its key appears in the second dictionary. Preference is given to values in the first dictionary. -} intersect : Dict comparable v -> Dict comparable v -> Dict comparable v -intersect t1 t2 = - let combine k v t = if k `member` t2 then insert k v t else t - in foldl combine empty t1 +intersect t1 t2 = filter (\k _ -> k `member` t2) t1 {-| Keep a key-value pair when its key does not appear in the second dictionary. Preference is given to the first dictionary. -} @@ -351,3 +392,20 @@ toList t = foldr (\k v acc -> (k,v) :: acc) [] t {-| Convert an association list into a dictionary. -} fromList : [(comparable,v)] -> Dict comparable v fromList assocs = List.foldl (\(k,v) d -> insert k v d) empty assocs + +{-| Keep a key-value pair when it satisfies a predicate. -} +filter : (comparable -> v -> Bool) -> Dict comparable v -> Dict comparable v +filter p dict = + let add k v t = if p k v then insert k v t else t + in foldl add empty dict + +{-| Partition a dictionary according to a predicate. The first dictionary +contains all key-value pairs which satisfy the predicate, and the second +contains the rest. +-} +partition : (comparable -> v -> Bool) -> Dict comparable v -> (Dict comparable v, Dict comparable v) +partition p dict = + let add k v (t1, t2) = if p k v + then (insert k v t1, t2) + else (t1, insert k v t2) + in foldl add (empty, empty) dict diff --git a/libraries/Graphics/Input.elm b/libraries/Graphics/Input.elm index e409ddeb7..24b44f828 100644 --- a/libraries/Graphics/Input.elm +++ b/libraries/Graphics/Input.elm @@ -89,7 +89,7 @@ button = Native.Graphics.Input.button prettyButton : Element prettyButton = - customButton click.handle + customButton click.handle () (image 100 40 "/button_up.jpg") (image 100 40 "/button_hover.jpg") (image 100 40 "/button_down.jpg") diff --git a/libraries/List.elm b/libraries/List.elm index 6d436e2dc..2b1f733e2 100644 --- a/libraries/List.elm +++ b/libraries/List.elm @@ -163,13 +163,19 @@ maximum = foldl1 max minimum : [comparable] -> comparable minimum = foldl1 min -{-| Split a list based on the predicate. -} +{-| Partition a list based on a predicate. The first list contains all values +that satisfy the predicate, and the second list contains all the value that do +not. + + partition (\x -> x < 3) [0..5] == ([0,1,2], [3,4,5]) + partition isEven [0..5] == ([0,2,4], [1,3,5]) +-} partition : (a -> Bool) -> [a] -> ([a],[a]) -partition pred lst = - case lst of - [] -> ([],[]) - x::xs -> let (bs,cs) = partition pred xs in - if pred x then (x::bs,cs) else (bs,x::cs) +partition pred = + let step x (ts, fs) = if pred x + then (x::ts, fs) + else (ts, x::fs) + in foldr step ([],[]) {-| Combine two lists, combining them into tuples pairwise. If one list is longer, the extra elements are dropped. @@ -188,12 +194,14 @@ If one list is longer, the extra elements are dropped. zipWith : (a -> b -> c) -> [a] -> [b] -> [c] zipWith = Native.List.zipWith -{-| Decompose a list of tuples. -} +{-| Decompose a list of tuples. + + unzip [(0, True), (17, False), (1337, True)] == ([0,17,1337], [True,False,True]) +-} unzip : [(a,b)] -> ([a],[b]) -unzip pairs = - case pairs of - [] -> ([],[]) - (x,y)::ps -> let (xs,ys) = (unzip ps) in (x::xs,y::ys) +unzip = + let step (x,y) (xs, ys) = (x::xs, y::ys) + in foldr step ([], []) {-| Places the given value between all of the lists in the second argument and concatenates the result. @@ -209,10 +217,12 @@ join = Native.List.join -} intersperse : a -> [a] -> [a] intersperse sep xs = - case xs of - a::b::cs -> a :: sep :: intersperse sep (b::cs) - [a] -> [a] - [] -> [] + case xs of + [] -> [] + hd::tl -> + let step x rest = sep :: x :: rest + spersed = foldr step [] tl + in hd :: spersed {-| Take the first n members of a list: `(take 2 [1,2,3,4] == [1,2])` -} take : Int -> [a] -> [a] diff --git a/libraries/Native/Array.js b/libraries/Native/Array.js index c87b97c94..30eceb70b 100644 --- a/libraries/Native/Array.js +++ b/libraries/Native/Array.js @@ -1,4 +1,4 @@ -Elm.Native.Array = {}; +Elm.Native.Array = {}; Elm.Native.Array.make = function(elm) { elm.Native = elm.Native || {}; elm.Native.Array = elm.Native.Array || {}; @@ -24,38 +24,144 @@ Elm.Native.Array.make = function(elm) { // An empty array. var empty = { ctor:"_Array", height:0, table:new Array() }; - // Gets the value at index i recursively. - function get(i, a) { - if (a.height == 0) { - if (i < a.table.length) { - return a.table[i]; - } else { - throw new Error("Index "+ i +" is out of range. Check the length of your array first or use getSafe or getMaybe."); + function get(i, array) { + if (i < 0 || i >= length(array)) { + throw new Error("Index " + i + " is out of range. Check the length of " + + "your array first or use getMaybe or getWithDefault."); } - } + return unsafeGet(i, array); + } - var slot = getSlot(i, a); - var sub = slot > 0 ? a.lengths[slot-1] : 0; - return get(i - sub, a.table[slot]); + function unsafeGet(i, array) { + for (var x = array.height; x > 0; x--) { + var slot = i >> (x * 5); + if (slot > 0) { + while (array.lengths[slot - 1] > i) { slot--; } + i -= array.lengths[slot - 1]; + } + array = array.table[slot]; + } + return array.table[i]; } // Sets the value at the index i. Only the nodes leading to i will get // copied and updated. - function set(i, item, a) { - if (length(a) <= i) { - return a; + function set(i, item, array) { + if (i < 0 || length(array) <= i) { + return array; } - var newA = nodeCopy(a); - newA.table = a.table.slice(); + return unsafeSet(i, item, array); + } - if (a.height == 0) { - newA.table[i] = item; + function unsafeSet(i, item, array) { + array = nodeCopy(array); + + if (array.height == 0) { + array.table[i] = item; } else { - var slot = getSlot(i, a); - var sub = slot > 0 ? a.lengths[slot-1] : 0; - newA.table[slot] = set(i - sub, item, a.table[slot]); + var slot = getSlot(i, array); + if (slot > 0) { + i -= array.lengths[slot - 1]; + } + array.table[slot] = unsafeSet(i, item, array.table[slot]); + } + return array; + } + + function initialize(len, f) { + if (len == 0) { return empty; } + var h = Math.floor(Math.log(len)/Math.log(M)); + return initialize_(f, h, 0, len); + } + + function initialize_(f, h, from, to) { + if (h == 0) { + var table = new Array((to - from) % (M + 1)); + for (var i = 0; i < table.length; i++) { + table[i] = f(from + i); + } + return { ctor:"_Array", height:0, table:table }; + } + + var step = Math.pow(M, h); + var table = new Array(Math.ceil((to - from) / step)); + var lengths = new Array(table.length); + for (var i = 0; i < table.length; i++) { + table[i] = initialize_( f, h - 1, from + (i * step) + , Math.min(from + ((i + 1) * step), to)); + lengths[i] = length(table[i]) + (i > 0 ? lengths[i-1] : 0); + } + return { ctor:"_Array", height:h, table:table, lengths:lengths }; + } + + function fromList(list) { + if (list == List.Nil) { return empty; } + + // Allocate M sized blocks (table) and write list elements to it. + var table = new Array(M); + var nodes = new Array(); + var i = 0; + + while (list.ctor !== '[]') { + table[i] = list._0; + list = list._1; + i++; + + // table is full, so we can push a leaf containing it into the + // next node. + if (i == M) { + fromListPush({ ctor:"_Array", height:0, table:table } + , nodes); + table = new Array(M); + i = 0; + } + } + + // Maybe there is something left on the table. + if (i > 0) { + fromListPush({ ctor:"_Array", height:0, table:table.splice(0,i) } + , nodes); + } + + // Go through all of the nodes and eventually push them into higher nodes. + for (var h = 0; h < nodes.length - 1; h++) { + if (nodes[h].table.length > 0) { + fromListPush(nodes[h], nodes); + } + } + + var head = nodes[nodes.length - 1]; + if (head.height > 0 && head.table.length == 1) { + return head.table[0]; + } else { + return head; + } + } + + // Push a node into a higher node as a child. + function fromListPush(toPush, nodes) { + var h = toPush.height; + + // Maybe the node on this height does not exist. + if (nodes.length == h) { + nodes.push({ ctor:"_Array", height:h + 1 + , table:new Array() + , lengths:new Array() }); + } + + nodes[h].table.push(toPush); + var len = length(toPush); + if (nodes[h].lengths.length > 0) { + len += nodes[h].lengths[nodes[h].lengths.length - 1]; + } + nodes[h].lengths.push(len); + + if (nodes[h].table.length == M) { + fromListPush(nodes[h], nodes); + nodes[h] = { ctor:"_Array", height:h + 1 + , table:new Array() + , lengths:new Array() }; } - return newA; } // Pushes an item via push_ to the bottom right of a tree. @@ -65,7 +171,7 @@ Elm.Native.Array.make = function(elm) { return pushed; } - newTree = create(item, a.height); + var newTree = create(item, a.height); return siblise(a, newTree); } @@ -143,22 +249,19 @@ Elm.Native.Array.make = function(elm) { } function foldl(f, b, a) { - for (var i = a.table.length - 1; i >= 0; i--) { + for (var i = 0; i < a.table.length; i++) { b = A2(f, a.height == 0 ? a.table[i] : foldl(f, b, a.table[i]), b); } return b; } function foldr(f, b, a) { - for (var i = 0; i < a.table.length; i++) { + for (var i = a.table.length; i--; ) { b = A2(f, a.height == 0 ? a.table[i] : foldr(f, b, a.table[i]), b); } return b; } - // Returns a sliced tree. "to" is inclusive, but this may change, - // when I understand, why e.g. JS does not handle it this way. :-) - // If "from" or "to" is negative, they will select from the end on. // TODO: currently, it slices the right, then the left. This can be // optimized. function slice(from, to, a) { @@ -175,7 +278,7 @@ Elm.Native.Array.make = function(elm) { // Handle leaf level. if (a.height == 0) { var newA = { ctor:"_Array", height:0 }; - newA.table = a.table.slice(0, to + 1); + newA.table = a.table.slice(0, to); return newA; } @@ -232,15 +335,15 @@ Elm.Native.Array.make = function(elm) { return newA; } - // Concats two trees. - // TODO: Add support for concatting trees of different sizes. Current - // behavior will just rise the lower tree and then concat them. - function concat(a, b) { - if (b.height > a.height) { return concat(parentise(a, b.height), b); } - if (a.height > b.height) { return concat(a, parentise(b, a.height)); } - if (a.height == 0) { return concat(parentise(a, 1), parentise(b, 1)); } + // Appends two trees. + // TODO: Add support for appending trees of different sizes. Current + // behavior will just rise the lower tree and then append them. + function append(a,b) { + if (b.height > a.height) { return append(parentise(a, b.height), b); } + if (a.height > b.height) { return append(a, parentise(b, a.height)); } + if (a.height == 0) { return append(parentise(a, 1), parentise(b, 1)); } - var c = concat_(a, b); + var c = append_(a, b); if (c[1].table.length > 0) { return siblise(c[0], c[1]); } else { @@ -249,9 +352,9 @@ Elm.Native.Array.make = function(elm) { } // Returns an array of two nodes. The second node _may_ be empty. This case - // needs to be handled by the function, that called concat_. May be only + // needs to be handled by the function, that called append_. May be only // called for trees with an minimal height of 1. - function concat_(a, b) { + function append_(a, b) { if (a.height == 1) { // Check if balancing is needed and return based on that. var toRemove = calcToRemove(a, b); @@ -262,18 +365,18 @@ Elm.Native.Array.make = function(elm) { return shuffle(a, b, toRemove); } - var concated = concat_(botRight(a), botLeft(b)); + var appended = append_(botRight(a), botLeft(b)); a = nodeCopy(a), b = nodeCopy(b); // Adjust the bottom right side of the new tree. - a.table[a.table.length - 1] = concated[0]; - a.lengths[a.lengths.length - 1] = length(concated[0]) + a.table[a.table.length - 1] = appended[0]; + a.lengths[a.lengths.length - 1] = length(appended[0]) a.lengths[a.lengths.length - 1] += a.lengths.length > 1 ? a.lengths[a.lengths.length - 2] : 0; // Adjust the bottom left side of the new tree. - if (concated[1].table.length > 0) { - b.table[0] = concated[1]; - b.lengths[0] = length(concated[1]); + if (appended[1].table.length > 0) { + b.table[0] = appended[1]; + b.lengths[0] = length(appended[1]); for (var i = 1, len = length(b.table[0]); i < b.lengths.length; i++) { len += length(b.table[i]); b.lengths[i] = len; @@ -423,21 +526,19 @@ Elm.Native.Array.make = function(elm) { } // Returns how many items are in the tree. - function length(a) { - if (a.height == 0) { - return a.table.length; + function length(array) { + if (array.height == 0) { + return array.table.length; } else { - return a.lengths[a.lengths.length - 1]; + return array.lengths[array.lengths.length - 1]; } } // Calculates in which slot of "table" the item probably is, then // find the exact slot via forward searching in "lengths". Returns the index. function getSlot(i, a) { - var slot = Math.floor(i / (Math.pow(M, a.height))); - while (a.lengths[slot] <= i) { - slot++ - } + var slot = i >> (5 * a.height); + while (a.lengths[slot - 1] > i) { slot--; } return slot; } @@ -472,10 +573,52 @@ Elm.Native.Array.make = function(elm) { , lengths:[length(a), length(a) + length(b)] }; } + function toJSArray(a) { + var jsArray = new Array(length(a)); + toJSArray_(jsArray, 0, a); + return jsArray; + } + + function toJSArray_(jsArray, i, a) { + for (var t = 0; t < a.table.length; t++) { + if (a.height == 0) { + jsArray[i + t] = a.table[t]; + } else { + var inc = t == 0 ? 0 : a.lengths[t - 1]; + toJSArray_(jsArray, i + inc, a.table[t]); + } + } + } + + function fromJSArray(jsArray) { + if (jsArray.length == 0) { return empty; } + var h = Math.floor(Math.log(jsArray.length) / Math.log(M)); + return fromJSArray_(jsArray, h, 0, jsArray.length); + } + + function fromJSArray_(jsArray, h, from, to) { + if (h == 0) { + return { ctor:"_Array", height:0 + , table:jsArray.slice(from, to) }; + } + + var step = Math.pow(M, h); + var table = new Array(Math.ceil((to - from) / step)); + var lengths = new Array(table.length); + for (var i = 0; i < table.length; i++) { + table[i] = fromJSArray_( jsArray, h - 1, from + (i * step) + , Math.min(from + ((i + 1) * step), to)); + lengths[i] = length(table[i]) + (i > 0 ? lengths[i-1] : 0); + } + return { ctor:"_Array", height:h, table:table, lengths:lengths }; + } + Elm.Native.Array.values = { empty:empty, + fromList:fromList, toList:toList, - concat:F2(concat), + initialize:F2(initialize), + append:F2(append), push:F2(push), slice:F3(slice), get:F2(get), @@ -484,7 +627,10 @@ Elm.Native.Array.make = function(elm) { indexedMap:F2(indexedMap), foldl:F3(foldl), foldr:F3(foldr), - length:length + length:length, + + toJSArray:toJSArray, + fromJSArray:fromJSArray }; return elm.Native.Array.values = Elm.Native.Array.values; diff --git a/libraries/Native/Error.js b/libraries/Native/Error.js index 0192aae30..7fa908c49 100644 --- a/libraries/Native/Error.js +++ b/libraries/Native/Error.js @@ -4,8 +4,6 @@ Elm.Native.Error.make = function(elm) { elm.Native.Error = elm.Native.Error || {}; if (elm.Native.Error.values) return elm.Native.Error.values; - var fromString = Elm.Native.JavaScript.make(elm).fromString; - function indent(lines) { var msg = ''; for (var i = 0; i < lines.length; ++i) { @@ -26,7 +24,7 @@ Elm.Native.Error.make = function(elm) { throw new Error('Runtime error in module ' + moduleName + ' (' + span + '):' + msg); } - function raise(str) { throw new Error(fromString(str)); } + function raise(str) { throw new Error(str); } return elm.Native.Error.values = { Case: Case, If: If, raise: raise }; -}; \ No newline at end of file +}; diff --git a/libraries/Native/Graphics/Input.js b/libraries/Native/Graphics/Input.js index e9b0b7b35..0e2630cd1 100644 --- a/libraries/Native/Graphics/Input.js +++ b/libraries/Native/Graphics/Input.js @@ -134,13 +134,6 @@ Elm.Native.Graphics.Input.make = function(elm) { btn.appendChild(btn.elm_up); - var clicker = newNode('div'); - clicker.style.width = btn.elm_up.style.width; - clicker.style.height = btn.elm_up.style.height; - clicker.style.position = 'absolute'; - clicker.style.top = 0; - btn.appendChild(clicker); - return btn; } @@ -297,29 +290,7 @@ Elm.Native.Graphics.Input.make = function(elm) { })); } - function mouseUpdate(event) { - var direction = field.selectionDirection === 'forward' ? 'Forward' : 'Backward'; - elm.notify(field.elm_signal.id, field.elm_handler({ - _:{}, - string: field.value, - selection: { - _:{}, - start: field.selectionStart, - end: field.selectionEnd, - direction: { ctor: direction } - }, - })); - } - function mousedown(event) { - mouseUpdate(event); - elm.node.addEventListener('mouseup', mouseup); - } - function mouseup(event) { - mouseUpdate(event); - elm.node.removeEventListener('mouseup', mouseup) - } field.addEventListener('input', inputUpdate); - field.addEventListener('mousedown', mousedown); field.addEventListener('focus', function() { field.elm_hasFocus = true; }); diff --git a/libraries/Native/String.js b/libraries/Native/String.js index bde0400d3..5f9ffa5cf 100644 --- a/libraries/Native/String.js +++ b/libraries/Native/String.js @@ -73,7 +73,7 @@ Elm.Native.String.make = function(elm) { return result; } - function sub(start, end, str) { + function slice(start, end, str) { return str.slice(start,end); } function left(n, str) { @@ -216,7 +216,7 @@ Elm.Native.String.make = function(elm) { join: F2(join), repeat: F2(repeat), - sub: F3(sub), + slice: F3(slice), left: F2(left), right: F2(right), dropLeft: F2(dropLeft), diff --git a/libraries/Native/Text.js b/libraries/Native/Text.js index 4f8ca4a4c..7f2a9ffae 100644 --- a/libraries/Native/Text.js +++ b/libraries/Native/Text.js @@ -153,6 +153,7 @@ Elm.Native.Text.make = function(elm) { typeface : F2(typeface), color : F2(color), link : F2(link), + style : F2(style), leftAligned : block('left'), rightAligned : block('right'), diff --git a/libraries/Native/Utils.js b/libraries/Native/Utils.js index 762c898c4..bfe1eed17 100644 --- a/libraries/Native/Utils.js +++ b/libraries/Native/Utils.js @@ -5,23 +5,30 @@ Elm.Native.Utils.make = function(elm) { elm.Native.Utils = elm.Native.Utils || {}; if (elm.Native.Utils.values) return elm.Native.Utils.values; - function eq(x,y) { - if (x === y) return true; - if (typeof x === "object") { - var c = 0; - for (var i in x) { - ++c; - if (!eq(x[i],y[i])) { - return false; + function eq(l,r) { + var stack = [{'x': l, 'y': r}] + while (stack.length > 0) { + var front = stack.pop(); + var x = front.x; + var y = front.y; + if (x === y) continue; + if (typeof x === "object") { + var c = 0; + for (var i in x) { + ++c; + stack.push({ 'x': x[i], 'y': y[i] }); } + if (c !== Object.keys(y).length) { + return false; + }; + } else if (typeof x === 'function') { + throw new Error('Equality error: general function equality is ' + + 'undecidable, and therefore, unsupported'); + } else { + return false; } - return c === Object.keys(y).length; } - if (typeof x === 'function') { - throw new Error('Equality error: general function equality is ' + - 'undecidable, and therefore, unsupported'); - } - return x === y; + return true; } // code in Generate/JavaScript.hs depends on the particular @@ -30,11 +37,15 @@ Elm.Native.Utils.make = function(elm) { function compare(x,y) { return { ctor: ord[cmp(x,y)+1] } } function cmp(x,y) { var ord; - if (typeof x !== 'object' || x instanceof String){ + if (typeof x !== 'object'){ return x === y ? EQ : x < y ? LT : GT; } - - if (x.ctor === "::" || x.ctor === "[]") { + else if (x.isChar){ + var a = x.toString(); + var b = y.toString(); + return a === b ? EQ : a < b ? LT : GT; + } + else if (x.ctor === "::" || x.ctor === "[]") { while (true) { if (x.ctor === "[]" && y.ctor === "[]") return EQ; if (x.ctor !== y.ctor) return x.ctor === '[]' ? LT : GT; @@ -44,8 +55,7 @@ Elm.Native.Utils.make = function(elm) { y = y._1; } } - - if (x.ctor.slice(0,6) === '_Tuple') { + else if (x.ctor.slice(0,6) === '_Tuple') { var n = x.ctor.slice(6) - 0; var err = 'cannot compare tuples with more than 6 elements.'; if (n === 0) return EQ; @@ -58,9 +68,11 @@ Elm.Native.Utils.make = function(elm) { if (n >= 7) throw new Error('Comparison error: ' + err); } } } } } } return EQ; } - throw new Error('Comparison error: comparison is only defined on ints, ' + - 'floats, times, chars, strings, lists of comparable values, ' + - 'and tuples of comparable values.') + else { + throw new Error('Comparison error: comparison is only defined on ints, ' + + 'floats, times, chars, strings, lists of comparable values, ' + + 'and tuples of comparable values.'); + } } @@ -205,6 +217,10 @@ Elm.Native.Utils.make = function(elm) { return Tuple2(posx, posy); } + function isJSArray(a) { + return a instanceof Array; + } + return elm.Native.Utils.values = { eq:eq, cmp:cmp, @@ -224,6 +240,7 @@ Elm.Native.Utils.make = function(elm) { mod : F2(mod), htmlHeight: F2(htmlHeight), getXY: getXY, + isJSArray: isJSArray, toFloat: function(x) { return +x; } }; }; diff --git a/libraries/Set.elm b/libraries/Set.elm index 19a736e89..60ef12495 100644 --- a/libraries/Set.elm +++ b/libraries/Set.elm @@ -2,6 +2,7 @@ module Set (empty,singleton,insert,remove ,member ,foldl,foldr,map + ,filter,partition ,union,intersect,diff ,toList,fromList ) where @@ -25,7 +26,7 @@ Insert, remove, and query operations all take *O(log n)* time. @docs toList, fromList # Transform -@docs map, foldl, foldr +@docs map, foldl, foldr, filter, partition -} @@ -88,3 +89,12 @@ foldr f b s = Dict.foldr (\k _ b -> f k b) b s {-| Map a function onto a set, creating a new set with no duplicates. -} map : (comparable -> comparable') -> Set comparable -> Set comparable' map f s = fromList (List.map f (toList s)) + +{-| Create a new set consisting only of elements which satisfy a predicate. -} +filter : (comparable -> Bool) -> Set comparable -> Set comparable +filter p set = Dict.filter (\k _ -> p k) set + +{-| Create two new sets; the first consisting of elements which satisfy a +predicate, the second consisting of elements which do not. -} +partition : (comparable -> Bool) -> Set comparable -> (Set comparable, Set comparable) +partition p set = Dict.partition (\k _ -> p k) set diff --git a/libraries/Signal.elm b/libraries/Signal.elm index 865b84783..716b2427b 100644 --- a/libraries/Signal.elm +++ b/libraries/Signal.elm @@ -31,10 +31,7 @@ the `Time` library. import Native.Signal import List (foldr) - import Basics (fst, snd, not) -import Native.Error -import Maybe as M data Signal a = Signal @@ -120,20 +117,18 @@ initially. -} dropIf : (a -> Bool) -> a -> Signal a -> Signal a dropIf = Native.Signal.dropIf -{-| Keep events only when the first signal is true. When the first signal -becomes true, the most recent value of the second signal will be propagated. -Until the first signal becomes false again, all events will be propagated. Elm -does not allow undefined signals, so a base case must be provided in case the -first signal is not true initially. -} +{-| Keep events only when the first signal is true. Elm does not allow undefined +signals, so a base case must be provided in case the first signal is not true +initially. +-} keepWhen : Signal Bool -> a -> Signal a -> Signal a keepWhen bs def sig = snd <~ (keepIf fst (False, def) ((,) <~ (sampleOn sig bs) ~ sig)) -{-| Drop events when the first signal is true. When the first signal becomes -false, the most recent value of the second signal will be propagated. Until the -first signal becomes true again, all events will be propagated. Elm does not -allow undefined signals, s oa base case must be provided in case the first -signal is true initially. -} +{-| Drop events when the first signal is true. Elm does not allow undefined +signals, so a base case must be provided in case the first signal is true +initially. +-} dropWhen : Signal Bool -> a -> Signal a -> Signal a dropWhen bs = keepWhen (not <~ bs) diff --git a/libraries/String.elm b/libraries/String.elm index eb8baddb2..edba13fcf 100644 --- a/libraries/String.elm +++ b/libraries/String.elm @@ -6,10 +6,10 @@ are enclosed in `"double quotes"`. Strings are *not* lists of characters. @docs isEmpty, length, reverse, repeat # Building and Splitting -@docs cons, uncons, append, concat, split, join, words, lines +@docs cons, uncons, append, concat, split, join, words, lines # Get Substrings -@docs sub, left, right, dropLeft, dropRight +@docs slice, left, right, dropLeft, dropRight # Check for Substrings @docs contains, startsWith, endsWith, indexes, indices @@ -114,7 +114,7 @@ foldr = Native.String.foldr {-| Split a string using a given separator. split "," "cat,dog,cow" == ["cat","dog","cow"] - split "/" "home/evan/Desktop/" == ["home","evan","Desktop"] + split "/" "home/evan/Desktop/" == ["home","evan","Desktop", ""] Use `Regex.split` if you need something more flexible. -} @@ -139,13 +139,13 @@ repeat = Native.String.repeat {-| Take a substring given a start and end index. Negative indexes are taken starting from the *end* of the list. - sub 7 9 "snakes on a plane!" == "on" - sub 0 6 "snakes on a plane!" == "snakes" - sub 0 -7 "snakes on a plane!" == "snakes on a" - sub -6 -1 "snakes on a plane!" == "plane" + slice 7 9 "snakes on a plane!" == "on" + slice 0 6 "snakes on a plane!" == "snakes" + slice 0 -7 "snakes on a plane!" == "snakes on a" + slice -6 -1 "snakes on a plane!" == "plane" -} -sub : Int -> Int -> String -> String -sub = Native.String.sub +slice : Int -> Int -> String -> String +slice = Native.String.slice {-| Take N characters from the left side of a string. -} left : Int -> String -> String diff --git a/libraries/elm_dependencies.json b/libraries/elm_dependencies.json index d3f57bc60..f205351c0 100644 --- a/libraries/elm_dependencies.json +++ b/libraries/elm_dependencies.json @@ -1,12 +1,13 @@ -{ "version": "0.12" +{ "version": "0.12.1" , "summary": "Elm's standard libraries" -, "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.12, you should be using version 0.12 of the standard libraries." +, "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.12.1, you should be using version 0.12.1 of the standard libraries." , "license": "BSD3" -, "repository": "http://github.com/evancz/Elm.git" -, "elm-version": "0.12" +, "repository": "http://github.com/elm-lang/Elm.git" +, "elm-version": "0.12.1" , "dependencies": {} , "exposed-modules": - [ "Basics" + [ "Array" + , "Basics" , "Bitwise" , "Char" , "Color" diff --git a/runtime/Render/Element.js b/runtime/Render/Element.js index fb8d90c9b..605824fd7 100644 --- a/runtime/Render/Element.js +++ b/runtime/Render/Element.js @@ -31,6 +31,7 @@ function setProps(elem, e) { a.style.display = 'block'; a.style.position = 'absolute'; e.style.position = 'relative'; + a.style.pointerEvents = 'auto'; e.appendChild(a); } if (props.hover.ctor !== '_Tuple0') { @@ -45,8 +46,9 @@ function setProps(elem, e) { function addClick(e, handler) { e.style.pointerEvents = 'auto'; e.elm_click_handler = handler; - function trigger() { + function trigger(ev) { e.elm_click_handler(Utils.Tuple0); + ev.stopPropagation(); } e.elm_click_trigger = trigger; e.addEventListener('click', trigger); @@ -63,14 +65,16 @@ function addHover(e, handler) { e.elm_hover_handler = handler; e.elm_hover_count = 0; - function over() { + function over(evt) { if (e.elm_hover_count++ > 0) return; e.elm_hover_handler(true); + evt.stopPropagation(); } function out(evt) { if (e.contains(evt.toElement || evt.relatedTarget)) return; e.elm_hover_count = 0; e.elm_hover_handler(false); + evt.stopPropagation(); } e.elm_hover_over = over; e.elm_hover_out = out; @@ -232,6 +236,7 @@ function rawHtml(elem) { } document.body.removeChild(div); div.style.visibility = 'visible'; + div.style.pointerEvents = 'auto'; return div; } @@ -375,6 +380,7 @@ function updateProps(node, curr, next) { a.style.display = 'block'; a.style.position = 'absolute'; e.style.position = 'relative'; + a.style.pointerEvents = 'auto'; e.appendChild(a); } else { node.lastNode.href = props.href; diff --git a/server/LICENSE b/server/LICENSE deleted file mode 100644 index ce6708f5f..000000000 --- a/server/LICENSE +++ /dev/null @@ -1,30 +0,0 @@ -Copyright (c)2012-2014, Evan Czaplicki - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of Evan Czaplicki nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/server/Server.hs b/server/Server.hs deleted file mode 100644 index 49a054385..000000000 --- a/server/Server.hs +++ /dev/null @@ -1,127 +0,0 @@ -{-# OPTIONS_GHC -Wall #-} -{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-} -module Main where - -import Control.Applicative ((<$>),(<|>)) -import Control.Monad (guard) -import Control.Monad.Trans (MonadIO(liftIO)) -import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as BSC -import qualified Data.HashMap.Strict as Map -import qualified Data.Version as Version -import System.Console.CmdArgs -import System.Directory -import System.Exit -import System.FilePath -import System.Process -import System.IO (hGetContents, Handle) - -import Paths_elm_server (version) -import qualified Elm.Internal.Paths as Elm -import Snap.Core -import Snap.Http.Server -import Snap.Util.FileServe - -data Flags = Flags - { port :: Int - , runtime :: Maybe FilePath - } deriving (Data,Typeable,Show,Eq) - -flags :: Flags -flags = Flags - { port = 8000 &= help "set the port of the server" - , runtime = Nothing &= typFile - &= help "Specify a custom location for Elm's runtime system." - } &= help "Quickly reload Elm projects in your browser. Just refresh to recompile.\n\ - \It serves static files and freshly recompiled Elm files." - &= helpArg [explicit, name "help", name "h"] - &= versionArg [ explicit, name "version", name "v" - , summary (Version.showVersion version) - ] - &= summary ("Elm Server " ++ Version.showVersion version ++ - ", (c) Evan Czaplicki 2011-2014") - - -config :: Config Snap a -config = setAccessLog ConfigNoLog (setErrorLog ConfigNoLog defaultConfig) - --- | Set up the server. -main :: IO () -main = do - cargs <- cmdArgs flags - putStrLn $ "Elm Server " ++ Version.showVersion version ++ - ": Just refresh a page to recompile it!" - httpServe (setPort (port cargs) config) $ - serveRuntime (maybe Elm.runtime id (runtime cargs)) - <|> serveElm - <|> serveDirectoryWith directoryConfig "." - -directoryConfig :: MonadSnap m => DirectoryConfig m -directoryConfig = - fancyDirectoryConfig - { indexGenerator = defaultIndexGenerator defaultMimeTypes indexStyle - , mimeTypes = Map.insert ".elm" "text/html" defaultMimeTypes - } - -indexStyle :: BS.ByteString -indexStyle = - "body { margin:0; font-family:sans-serif; background:rgb(245,245,245);\ - \ font-family: calibri, verdana, helvetica, arial; }\ - \div.header { padding: 40px 50px; font-size: 24px; }\ - \div.content { padding: 0 40px }\ - \div.footer { display:none; }\ - \table { width:100%; border-collapse:collapse; }\ - \td { padding: 6px 10px; }\ - \tr:nth-child(odd) { background:rgb(216,221,225); }\ - \td { font-family:monospace }\ - \th { background:rgb(90,99,120); color:white; text-align:left;\ - \ padding:10px; font-weight:normal; }" - -runtimeName :: String -runtimeName = "elm-runtime.js" - -serveRuntime :: FilePath -> Snap () -serveRuntime runtimePath = - do file <- BSC.unpack . rqPathInfo <$> getRequest - guard (file == runtimeName) - serveFileAs "application/javascript" runtimePath - -serveElm :: Snap () -serveElm = - do file <- BSC.unpack . rqPathInfo <$> getRequest - exists <- liftIO $ doesFileExist file - guard (exists && takeExtension file == ".elm") - onSuccess (compile file) (serve file) - where - compile file = - let elmArgs = [ "--make", "--runtime=" ++ runtimeName, file ] - in createProcess $ (proc "elm" elmArgs) { std_out = CreatePipe } - - serve file = - serveFileAs "text/html; charset=UTF-8" ("build" replaceExtension file "html") - -failure :: String -> Snap () -failure msg = - do modifyResponse $ setResponseStatus 404 "Not found" - writeBS $ BSC.pack msg - -onSuccess :: IO (t, Maybe Handle, t1, ProcessHandle) -> Snap () -> Snap () -onSuccess action success = - do (_, stdout, _, handle) <- liftIO action - exitCode <- liftIO $ waitForProcess handle - case (exitCode, stdout) of - (ExitFailure 127, _) -> - failure "Error: elm compiler not found in your path." - - (ExitFailure _, Just out) -> - failure =<< liftIO (hGetContents out) - - (ExitFailure _, Nothing) -> - failure "See command line for error message." - - (ExitSuccess, _) -> success - -{-- -pageTitle :: String -> String -pageTitle = dropExtension . takeBaseName ---} diff --git a/server/Setup.hs b/server/Setup.hs deleted file mode 100644 index 9a994af67..000000000 --- a/server/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/server/elm-server.cabal b/server/elm-server.cabal deleted file mode 100644 index 61febe52e..000000000 --- a/server/elm-server.cabal +++ /dev/null @@ -1,41 +0,0 @@ -Name: elm-server -Version: 0.12 -Synopsis: Server for developing Elm projects -Description: Provides a standalone Snap server that serves static files. - For Elm files, it recompiles them and serves them as HTML, - so you can just refresh to see the new version. - -Homepage: http://elm-lang.org - -License: BSD3 -License-file: LICENSE - -Author: Evan Czaplicki -Maintainer: info@elm-lang.org -Copyright: Copyright: (c) 2011-2014 Evan Czaplicki - -Category: Compiler, Language - -Build-type: Simple - ---Extra-source-files: README.md -Cabal-version: >=1.8 - -source-repository head - type: git - location: git://github.com/evancz/Elm.git - -Executable elm-server - Main-is: Server.hs - Build-depends: base >=4.2 && <5, - bytestring, - cmdargs, - containers >= 0.3, - directory, - filepath, - Elm >= 0.12, - snap-core, - snap-server, - mtl, - process, - unordered-containers diff --git a/tests/elm/Test.elm b/tests/elm/Test.elm new file mode 100644 index 000000000..ced60feea --- /dev/null +++ b/tests/elm/Test.elm @@ -0,0 +1,37 @@ +module Main where + +import ElmTest.Assertion as A +import ElmTest.Run as R +import ElmTest.Runner.Console (runDisplay) +import ElmTest.Test (..) + +import IO.IO (..) +import IO.Runner (Request, Response) +import IO.Runner as Run + +import Test.Array as Array +import Test.Dict as Dict +import Test.List as List +import Test.Set as Set +import Test.String as String +import Test.Trampoline as Trampoline + +tests : Test +tests = suite "Elm Standard Library Tests" [ List.tests, + String.tests, + Trampoline.tests, + Array.tests, + Dict.tests, + Set.tests + ] + +console : IO () +console = runDisplay tests + +port requests : Signal [{ mPut : Maybe String + , mExit : Maybe Int + , mGet : Bool + }] +port requests = Run.run responses console + +port responses : Signal (Maybe String) diff --git a/tests/elm/Test/Array.elm b/tests/elm/Test/Array.elm new file mode 100644 index 000000000..835a29c8d --- /dev/null +++ b/tests/elm/Test/Array.elm @@ -0,0 +1,62 @@ +module Test.Array (tests) where + +import List +import Array +import Native.Array + +import ElmTest.Assertion (..) +import ElmTest.Test (..) + +tests : Test +tests = + let creationTests = suite "Creation" + [ test "empty" <| assertEqual Array.empty (Array.fromList []) + , test "initialize" <| assertEqual (Array.initialize 4 id) (Array.fromList [0,1,2,3]) + , test "initialize 2" <| assertEqual (Array.initialize 4 (\n -> n*n)) (Array.fromList [0,1,4,9]) + , test "initialize 3" <| assertEqual (Array.initialize 4 (always 0)) (Array.fromList [0,0,0,0]) + , test "initialize Empty" <| assertEqual (Array.initialize 0 id) Array.empty + , test "initialize 4" <| assertEqual (Array.initialize 2 (always 0)) (Array.fromList [0,0]) + , test "repeat" <| assertEqual (Array.repeat 5 40) (Array.fromList [40,40,40,40,40]) + , test "repeat 2" <| assertEqual (Array.repeat 5 0) (Array.fromList [0,0,0,0,0]) + , test "repeat 3" <| assertEqual (Array.repeat 3 "cat") (Array.fromList ["cat","cat","cat"]) + , test "fromList" <| assertEqual (Array.fromList []) Array.empty + ] + basicsTests = suite "Basics" + [ test "length" <| assertEqual 3 (Array.length (Array.fromList [1,2,3])) + , test "length - Long" <| assertEqual 10000 (Array.length (Array.repeat 10000 0)) + , test "push" <| assertEqual (Array.fromList [1,2,3]) (Array.push 3 (Array.fromList [1,2])) + , test "append" <| assertEqual [42,42,81,81,81] (Array.toList (Array.append (Array.repeat 2 42) (Array.repeat 3 81))) + ] + getAndSetTests = suite "Get and Set" + [ test "get" <| assertEqual (Just 2) (Array.get 1 (Array.fromList [3,2,1])) + , test "get 2" <| assertEqual Nothing (Array.get 5 (Array.fromList [3,2,1])) + , test "get 3" <| assertEqual Nothing (Array.get -1 (Array.fromList [3,2,1])) + , test "getOrElse 1" <| assertEqual 1 (Array.getOrElse 0 2 (Array.fromList [3,2,1])) + , test "getOrElse 2" <| assertEqual 0 (Array.getOrElse 0 5 (Array.fromList [3,2,1])) + , test "getOrFail" <| assertEqual 1 (Array.getOrFail 2 (Array.fromList [3,2,1])) + , test "set" <| assertEqual (Array.fromList [1,7,3]) (Array.set 1 7 (Array.fromList [1,2,3])) + ] + takingArraysApartTests = suite "Taking Arrays Apart" + [ test "toList" <| assertEqual [3,5,8] (Array.toList (Array.fromList [3,5,8])) + , test "toIndexedList" <| assertEqual [(0,"cat"), (1,"dog")] (Array.toIndexedList (Array.fromList ["cat","dog"])) + , test "slice 1" <| assertEqual (Array.fromList [0,1,2]) (Array.slice 0 3 (Array.fromList [0,1,2,3,4])) + , test "slice 2" <| assertEqual (Array.fromList [1,2,3]) (Array.slice 1 4 (Array.fromList [0,1,2,3,4])) + , test "slice 3" <| assertEqual (Array.fromList [1,2,3]) (Array.slice 1 -1 (Array.fromList [0,1,2,3,4])) + , test "slice 4" <| assertEqual (Array.fromList [2]) (Array.slice -3 -2 (Array.fromList [0,1,2,3,4])) + ] + mappingAndFoldingTests = suite "Mapping and Folding" + [ test "map" <| assertEqual (Array.fromList [1,2,3]) (Array.map sqrt (Array.fromList [1,4,9])) + , test "indexedMap" <| assertEqual (Array.fromList [0,5,10]) (Array.indexedMap (*) (Array.fromList [5,5,5])) + , test "foldl" <| assertEqual [3,2,1] (Array.foldl (::) [] (Array.fromList [1,2,3])) + , test "foldr 1" <| assertEqual 15 (Array.foldr (+) 0 (Array.repeat 3 5)) + , test "foldr 2" <| assertEqual [1,2,3] (Array.foldr (::) [] (Array.fromList [1,2,3])) + , test "filter" <| assertEqual (Array.fromList [2,4,6]) (Array.filter (\x -> x `mod` 2 == 0) (Array.fromList [1..6])) + ] + nativeTests = suite "Conversion to JS Arrays" + [ test "jsArrays" <| assertEqual (Array.fromList [1..1100]) (Native.Array.fromJSArray (Native.Array.toJSArray (Array.fromList [1..1100]))) + ] + in + suite "Array" + [ creationTests, basicsTests, getAndSetTests + , takingArraysApartTests, mappingAndFoldingTests, nativeTests + ] diff --git a/tests/elm/Test/Dict.elm b/tests/elm/Test/Dict.elm new file mode 100644 index 000000000..2b3c175bf --- /dev/null +++ b/tests/elm/Test/Dict.elm @@ -0,0 +1,26 @@ +module Test.Dict (tests) where + +import Dict +import List + +import ElmTest.Assertion (..) +import ElmTest.Test (..) + +animals : Dict.Dict String String +animals = Dict.fromList [ ("Tom", "cat"), ("Jerry", "mouse") ] + +tests : Test +tests = + let getTests = + [ test "get 1" <| assertEqual (Just "cat") (Dict.get "Tom" animals) + , test "get 2" <| assertEqual Nothing (Dict.get "Spike" animals) + , test "getOrElse 1" <| assertEqual "mouse" (Dict.getOrElse "dog" "Jerry" animals) + , test "getOrElse 2" <| assertEqual "dog" (Dict.getOrElse "dog" "Spike" animals) + , test "getOrFail" <| assertEqual "cat" (Dict.getOrFail "Tom" animals) + ] + filterTests = + [ test "filter" <| assertEqual (Dict.singleton "Tom" "cat") (Dict.filter (\k v -> k == "Tom") animals) + , test "partition" <| assertEqual (Dict.singleton "Tom" "cat", Dict.singleton "Jerry" "mouse") (Dict.partition (\k v -> k == "Tom") animals) + ] + in + suite "Dict Tests" <| List.concat [ getTests, filterTests ] diff --git a/tests/elm/Test/List.elm b/tests/elm/Test/List.elm new file mode 100644 index 000000000..a3d8de024 --- /dev/null +++ b/tests/elm/Test/List.elm @@ -0,0 +1,38 @@ +module Test.List (tests) where + +import List + +import ElmTest.Assertion (..) +import ElmTest.Test (..) + +tests : Test +tests = + let partitionTests = + let p1 = id + p2 x = x < 3 + isEven n = n `mod` 2 == 0 + in suite "partition Tests" [ test "simple partition" <| assertEqual ([True],[False]) (List.partition p1 [False, True]), + test "order check" <| assertEqual ([2,1], [5,6]) (List.partition p2 [2,5,6,1]), + test "partition doc check 1" <| assertEqual ([0,1,2], [3,4,5]) (partition p2 [0..5]), + test "partition doc check 2" <| assertEqual ([0,2,4], [1,3,5]) (partition isEven [0..5]), + let n = 100000 + ts = repeat n True + fs = repeat n False + in test "partition stress test" <| assertEqual (ts, fs) (partition p1 (fs++ts)) + ] + unzipTests = suite "unzip Tests" [ + test "unzip doc check" <| assertEqual ([0,17,1337],[True,False,True]) (unzip [(0, True), (17, False), (1337, True)]), + let n = 100000 + ts = repeat n True + fs = repeat n False + in test "unzip stress test" <| assertEqual (ts, fs) (unzip (zip ts fs)) + ] + intersperseTests = suite "intersperse Tests" [ + test "intersperse doc check" <| assertEqual ["turtles","on","turtles","on","turtles"] (intersperse "on" ["turtles","turtles","turtles"]), + let n = 100000 + ts = repeat n True + fs = repeat n False + in test "intersperse stress test" <| assertEqual (tail . List.concat <| zipWith (\x y -> [x,y]) fs ts) + (intersperse False ts) + ] + in suite "List Tests" [partitionTests, unzipTests, intersperseTests] \ No newline at end of file diff --git a/tests/elm/Test/Set.elm b/tests/elm/Test/Set.elm new file mode 100644 index 000000000..d13e531a0 --- /dev/null +++ b/tests/elm/Test/Set.elm @@ -0,0 +1,27 @@ +module Test.Set (tests) where + +import Set +import Set (Set) +import List + +import ElmTest.Assertion (..) +import ElmTest.Test (..) + +set : Set Int +set = Set.fromList [1..100] + +setPart1 : Set Int +setPart1 = Set.fromList [1..50] + +setPart2 : Set Int +setPart2 = Set.fromList [51..100] + +pred : Int -> Bool +pred x = x <= 50 + +tests : Test +tests = + let + filterTests = suite "filter Tests" [test "Simple filter" <| assertEqual setPart1 <| Set.filter pred set] + partitionTests = suite "partition Tests" [test "Simple partition" <| assertEqual (setPart1, setPart2) <| Set.partition pred set] + in suite "Set Tests" [partitionTests, filterTests] diff --git a/tests/elm/Test/String.elm b/tests/elm/Test/String.elm new file mode 100644 index 000000000..a4aab235b --- /dev/null +++ b/tests/elm/Test/String.elm @@ -0,0 +1,37 @@ +module Test.String (tests) where + +import List +import String (..) + +import ElmTest.Assertion (..) +import ElmTest.Test (..) + +tests : Test +tests = + let simpleTests = suite "Simple Stuff" + [ test "is empty" <| assert (isEmpty "") + , test "is not empty" <| assert (not (isEmpty ("the world"))) + , test "length" <| assertEqual 11 (length "innumerable") + , test "endsWith" (assert <| endsWith "ship" "spaceship") + , test "reverse" <| assertEqual "desserts" (reverse "stressed") + , test "repeat" <| assertEqual "hahaha" (repeat 3 "ha") + ] + + combiningTests = suite "Combining Strings" + [ test "uncons non-empty" <| assertEqual (Just ('a',"bc")) (uncons "abc") + , test "uncons empty" <| assertEqual Nothing (uncons "") + , test "append 1" <| assertEqual "butterfly" (append "butter" "fly") + , test "append 2" <| assertEqual "butter" (append "butter" "") + , test "append 3" <| assertEqual "butter" (append "" "butter") + , test "concat" <| assertEqual "nevertheless" (concat ["never","the","less"]) + , test "split commas" <| assertEqual ["cat","dog","cow"] (split "," "cat,dog,cow") + , test "split slashes"<| assertEqual ["home","steve","Desktop", ""] (split "/" "home/steve/Desktop/") + , test "join spaces" <| assertEqual "cat dog cow" (join " " ["cat","dog","cow"]) + , test "join slashes" <| assertEqual "home/steve/Desktop" (join "/" ["home","steve","Desktop"]) + , test "slice 1" <| assertEqual "c" (slice 2 3 "abcd") + , test "slice 2" <| assertEqual "abc" (slice 0 3 "abcd") + , test "slice 3" <| assertEqual "abc" (slice 0 -1 "abcd") + , test "slice 4" <| assertEqual "cd" (slice -2 4 "abcd") + ] + in + suite "String" [ simpleTests, combiningTests ] \ No newline at end of file diff --git a/tests/elm/Test/Trampoline.elm b/tests/elm/Test/Trampoline.elm new file mode 100644 index 000000000..6e6644dcc --- /dev/null +++ b/tests/elm/Test/Trampoline.elm @@ -0,0 +1,29 @@ +module Test.Trampoline (tests) where + +import Trampoline (..) + +import ElmTest.Assertion (..) +import ElmTest.Test (..) + +badSum : Int -> Int +badSum n = + let loop x acc = + case x of + 0 -> acc + _ -> loop (x-1) (acc+x) + in loop n 0 + +goodSum : Int -> Int +goodSum n = + let sumT x acc = + case x of + 0 -> Done acc + _ -> Continue (\_ -> sumT (x-1) (acc+x)) + in trampoline <| sumT n 0 + +tests : Test +tests = + let mkLoopCheck n = test ("Equivalent Loop Check #"++ show n) (assertEqual (badSum n) (goodSum n)) + loopChecks = suite "Equivalent to untrampolined Tests" <| map mkLoopCheck [0..25] + noStackOverflow = test "Trampoline Deep Recursion Test" (assertEqual 500000500000 (goodSum 1000000)) + in suite "Trampoline Tests" [noStackOverflow, loopChecks] diff --git a/tests/Main.hs b/tests/hs/CompilerTest.hs similarity index 100% rename from tests/Main.hs rename to tests/hs/CompilerTest.hs diff --git a/tests/hs/LibTest.hs b/tests/hs/LibTest.hs new file mode 100644 index 000000000..72f7fd4ec --- /dev/null +++ b/tests/hs/LibTest.hs @@ -0,0 +1,30 @@ +module Main where + +import Control.Monad (unless) +import Data.List (isInfixOf) +import System.Directory +import System.Exit +import System.FilePath +import System.Process + +import Elm.Internal.Paths as Elm + +main :: IO () +main = do + top <- getCurrentDirectory + let ioScript s = top"IO"s + runCmd "git submodule update --init" + out <- readProcess "npm" ["ls", "--parseable"] "" + unless ("jsdom" `isInfixOf` out) $ runCmd "npm install jsdom" + setCurrentDirectory $ top"tests""elm" + runCmd $ concat [top"dist""build""elm""elm --make --only-js --src-dir=" , top"automaton", " --src-dir=", top"IO", " --src-dir=", top"Elm-Test", " Test.elm"] + runCmd $ unwords ["cat ", ioScript "prescript.js", Elm.runtime, "build""Test.js", ioScript "handler.js", "> exe.js"] + exitWith =<< waitForProcess =<< (runCommand "node exe.js") + where runCmd cmd = do + putStrLn cmd + exitCode <- waitForProcess =<< runCommand cmd + case exitCode of + ExitSuccess -> return () + ExitFailure _ -> error "something went wrong" + + diff --git a/tests/Tests/Compiler.hs b/tests/hs/Tests/Compiler.hs similarity index 100% rename from tests/Tests/Compiler.hs rename to tests/hs/Tests/Compiler.hs diff --git a/tests/Tests/Property.hs b/tests/hs/Tests/Property.hs similarity index 100% rename from tests/Tests/Property.hs rename to tests/hs/Tests/Property.hs diff --git a/tests/Tests/Property/Arbitrary.hs b/tests/hs/Tests/Property/Arbitrary.hs similarity index 100% rename from tests/Tests/Property/Arbitrary.hs rename to tests/hs/Tests/Property/Arbitrary.hs diff --git a/tests/test-files/bad/BBTArgs b/tests/hs/test-files/bad/BBTArgs similarity index 100% rename from tests/test-files/bad/BBTArgs rename to tests/hs/test-files/bad/BBTArgs diff --git a/tests/test-files/bad/InfiniteType.elm b/tests/hs/test-files/bad/InfiniteType.elm similarity index 100% rename from tests/test-files/bad/InfiniteType.elm rename to tests/hs/test-files/bad/InfiniteType.elm diff --git a/tests/test-files/bad/NonElementMain.elm b/tests/hs/test-files/bad/NonElementMain.elm similarity index 100% rename from tests/test-files/bad/NonElementMain.elm rename to tests/hs/test-files/bad/NonElementMain.elm diff --git a/tests/test-files/bad/Strings/ExtraClose.elm b/tests/hs/test-files/bad/Strings/ExtraClose.elm similarity index 100% rename from tests/test-files/bad/Strings/ExtraClose.elm rename to tests/hs/test-files/bad/Strings/ExtraClose.elm diff --git a/tests/test-files/good/AliasSubstitution.elm b/tests/hs/test-files/good/AliasSubstitution.elm similarity index 100% rename from tests/test-files/good/AliasSubstitution.elm rename to tests/hs/test-files/good/AliasSubstitution.elm diff --git a/tests/test-files/good/NoExpressions.elm b/tests/hs/test-files/good/NoExpressions.elm similarity index 100% rename from tests/test-files/good/NoExpressions.elm rename to tests/hs/test-files/good/NoExpressions.elm diff --git a/tests/test-files/good/Otherwise.elm b/tests/hs/test-files/good/Otherwise.elm similarity index 100% rename from tests/test-files/good/Otherwise.elm rename to tests/hs/test-files/good/Otherwise.elm diff --git a/tests/test-files/good/Ports.elm b/tests/hs/test-files/good/Ports.elm similarity index 100% rename from tests/test-files/good/Ports.elm rename to tests/hs/test-files/good/Ports.elm diff --git a/tests/test-files/good/QuotesAndComments.elm b/tests/hs/test-files/good/QuotesAndComments.elm similarity index 100% rename from tests/test-files/good/QuotesAndComments.elm rename to tests/hs/test-files/good/QuotesAndComments.elm diff --git a/tests/test-files/good/Soundness/Apply.elm b/tests/hs/test-files/good/Soundness/Apply.elm similarity index 100% rename from tests/test-files/good/Soundness/Apply.elm rename to tests/hs/test-files/good/Soundness/Apply.elm diff --git a/tests/test-files/good/Soundness/ApplyAnnotated.elm b/tests/hs/test-files/good/Soundness/ApplyAnnotated.elm similarity index 100% rename from tests/test-files/good/Soundness/ApplyAnnotated.elm rename to tests/hs/test-files/good/Soundness/ApplyAnnotated.elm diff --git a/tests/test-files/good/Soundness/Id.elm b/tests/hs/test-files/good/Soundness/Id.elm similarity index 100% rename from tests/test-files/good/Soundness/Id.elm rename to tests/hs/test-files/good/Soundness/Id.elm diff --git a/tests/test-files/good/Soundness/IdAnnotated.elm b/tests/hs/test-files/good/Soundness/IdAnnotated.elm similarity index 100% rename from tests/test-files/good/Soundness/IdAnnotated.elm rename to tests/hs/test-files/good/Soundness/IdAnnotated.elm diff --git a/tests/test-files/good/Soundness/TrickyId.elm b/tests/hs/test-files/good/Soundness/TrickyId.elm similarity index 100% rename from tests/test-files/good/Soundness/TrickyId.elm rename to tests/hs/test-files/good/Soundness/TrickyId.elm diff --git a/tests/test-files/good/Soundness/TrickyIdAnnotated.elm b/tests/hs/test-files/good/Soundness/TrickyIdAnnotated.elm similarity index 100% rename from tests/test-files/good/Soundness/TrickyIdAnnotated.elm rename to tests/hs/test-files/good/Soundness/TrickyIdAnnotated.elm diff --git a/tests/test-files/good/Strings/Multiline.elm b/tests/hs/test-files/good/Strings/Multiline.elm similarity index 100% rename from tests/test-files/good/Strings/Multiline.elm rename to tests/hs/test-files/good/Strings/Multiline.elm diff --git a/tests/test-files/good/Strings/MultilineNormal.elm b/tests/hs/test-files/good/Strings/MultilineNormal.elm similarity index 100% rename from tests/test-files/good/Strings/MultilineNormal.elm rename to tests/hs/test-files/good/Strings/MultilineNormal.elm diff --git a/tests/test-files/good/Unify/LockedVars.elm b/tests/hs/test-files/good/Unify/LockedVars.elm similarity index 100% rename from tests/test-files/good/Unify/LockedVars.elm rename to tests/hs/test-files/good/Unify/LockedVars.elm diff --git a/tests/test-files/good/Unify/NonHomogeneousRecords.elm b/tests/hs/test-files/good/Unify/NonHomogeneousRecords.elm similarity index 100% rename from tests/test-files/good/Unify/NonHomogeneousRecords.elm rename to tests/hs/test-files/good/Unify/NonHomogeneousRecords.elm