cerchez07/elm-0.19-workshop
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Check in packages.

Browse Source
This commit is contained in:
Richard Feldman
2017-10-26 03:03:03 +02:00
parent ef07ce6f52
commit b964fb9a6d
2046 changed files with 401572 additions and 101 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
part4/elm-stuff/packages/elm-lang/core/5.1.1/.gitignore vendored Normal file
View File

@@ -0,0 +1,3 @@
elm-stuff
tests/test.js
node_modules/

30
part4/elm-stuff/packages/elm-lang/core/5.1.1/LICENSE vendored Normal file
View File

@@ -0,0 +1,30 @@
Copyright (c) 2014-present, 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.

38
part4/elm-stuff/packages/elm-lang/core/5.1.1/elm-package.json vendored Normal file
View File

@@ -0,0 +1,38 @@
{
"version": "5.1.1",
"summary": "Elm's standard libraries",
"repository": "http://github.com/elm-lang/core.git",
"license": "BSD3",
"source-directories": [
"src"
],
"exposed-modules": [
"Array",
"Basics",
"Bitwise",
"Char",
"Color",
"Date",
"Debug",
"Dict",
"Json.Decode",
"Json.Encode",
"List",
"Maybe",
"Platform",
"Platform.Cmd",
"Platform.Sub",
"Process",
"Random",
"Regex",
"Result",
"Set",
"String",
"Task",
"Time",
"Tuple"
],
"native-modules": true,
"dependencies": {},
"elm-version": "0.18.0 <= v < 0.19.0"
}

240
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Array.elm vendored Normal file
View File

@@ -0,0 +1,240 @@
module Array exposing
( Array
, empty, repeat, initialize, fromList
, isEmpty, length, push, append
, get, set
, slice, toList, toIndexedList
, map, indexedMap, filter, foldl, foldr
)
{-| 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.
# Arrays
@docs Array
# Creating Arrays
@docs empty, repeat, initialize, fromList
# Basics
@docs isEmpty, length, push, append
# Get and Set
@docs get, set
# Taking Arrays Apart
@docs slice, toList, toIndexedList
# Mapping, Filtering, and Folding
@docs map, indexedMap, filter, foldl, foldr
-}
import Native.Array
import Basics exposing (..)
import Maybe exposing (..)
import List
{-| Representation of fast immutable arrays. You can create arrays of integers
(`Array Int`) or strings (`Array String`) or any other type of value you can
dream up.
-}
type Array a = Array
{-| 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)`.
initialize 4 identity == fromList [0,1,2,3]
initialize 4 (\n -> n*n) == fromList [0,1,4,9]
initialize 4 (always 0) == fromList [0,0,0,0]
-}
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)
{-| Create an array from a list.
-}
fromList : List a -> Array a
fromList =
Native.Array.fromList
{-| Create a list of elements from an array.
toList (fromList [3,5,8]) == [3,5,8]
-}
toList : Array a -> List a
toList =
Native.Array.toList
-- TODO: make this a native function.
{-| Create an indexed list from an array. Each element of the array will be
paired with its index.
toIndexedList (fromList ["cat","dog"]) == [(0,"cat"), (1,"dog")]
-}
toIndexedList : Array a -> List (Int, a)
toIndexedList array =
List.map2
(,)
(List.range 0 (Native.Array.length array - 1))
(Native.Array.toList array)
{-| Apply a function on every element in an array.
map sqrt (fromList [1,4,9]) == fromList [1,2,3]
-}
map : (a -> b) -> Array a -> Array b
map =
Native.Array.map
{-| Apply a function on every element with its index as first argument.
indexedMap (*) (fromList [5,5,5]) == fromList [0,5,10]
-}
indexedMap : (Int -> a -> b) -> Array a -> Array b
indexedMap =
Native.Array.indexedMap
{-| Reduce an array from the left. Read `foldl` as &ldquo;fold from the left&rdquo;.
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. Read `foldr` as &ldquo;fold from the right&rdquo;.
foldr (+) 0 (repeat 3 5) == 15
-}
foldr : (a -> b -> b) -> b -> Array a -> b
foldr =
Native.Array.foldr
{-| Keep only elements that satisfy the predicate:
filter isEven (fromList [1,2,3,4,5,6]) == (fromList [2,4,6])
-}
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.
length empty == 0
-}
empty : Array a
empty =
Native.Array.empty
{-| Push an element to the end of an array.
push 3 (fromList [1,2]) == fromList [1,2,3]
-}
push : a -> Array a -> Array a
push =
Native.Array.push
{-| Return Just the element at the index or Nothing if the index is out of range.
get 0 (fromList [0,5,3]) == Just 0
get 2 (fromList [0,5,3]) == Just 3
get 5 (fromList [0,5,3]) == Nothing
get -1 (fromList [0,5,3]) == 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
{-| 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
{-| 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`.
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 1 -1 (fromList [0,1,2,3,4]) == fromList [1,2,3]
slice -2 5 (fromList [0,1,2,3,4]) == fromList [3,4]
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
{-| Return the length of an array.
length (fromList [1,2,3]) == 3
-}
length : Array a -> Int
length =
Native.Array.length
{-| Determine if an array is empty.
isEmpty empty == True
-}
isEmpty : Array a -> Bool
isEmpty array =
length array == 0
{-| Append two arrays to a new one.
append (repeat 2 42) (repeat 3 81) == fromList [42,42,81,81,81]
-}
append : Array a -> Array a -> Array a
append =
Native.Array.append

650
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Basics.elm vendored Normal file
View File

@@ -0,0 +1,650 @@
module Basics exposing
( (==), (/=)
, (<), (>), (<=), (>=), max, min, Order (..), compare
, not, (&&), (||), xor
, (+), (-), (*), (/), (^), (//), rem, (%), negate, abs, sqrt, clamp, logBase, e
, pi, cos, sin, tan, acos, asin, atan, atan2
, round, floor, ceiling, truncate, toFloat
, degrees, radians, turns
, toPolar, fromPolar
, isNaN, isInfinite
, toString, (++)
, identity, always, (<|), (|>), (<<), (>>), flip, curry, uncurry, Never, never
)
{-| Tons of useful functions that get imported by default.
# Equality
@docs (==), (/=)
# Comparison
These functions only work on `comparable` types. This includes numbers,
characters, strings, lists of comparable things, and tuples of comparable
things. Note that tuples with 7 or more elements are not comparable; why
are your tuples so big?
@docs (<), (>), (<=), (>=), max, min, Order, compare
# Booleans
@docs not, (&&), (||), xor
# Mathematics
@docs (+), (-), (*), (/), (^), (//), rem, (%), negate, abs, sqrt, clamp, logBase, e
# Trigonometry
@docs pi, cos, sin, tan, acos, asin, atan, atan2
# Number Conversions
@docs round, floor, ceiling, truncate, toFloat
# Angle Conversions
All angle conversions result in &ldquo;standard Elm angles&rdquo;
which happen to be radians.
@docs degrees, radians, turns
# Polar Coordinates
@docs toPolar, fromPolar
# Floating Point Checks
@docs isNaN, isInfinite
# Strings and Lists
@docs toString, (++)
# Higher-Order Helpers
@docs identity, always, (<|), (|>), (<<), (>>), flip, curry, uncurry, Never, never
-}
import Native.Basics
import Native.Utils
{-| Convert radians to standard Elm angles (radians). -}
radians : Float -> Float
radians t =
t
{-| Convert degrees to standard Elm angles (radians). -}
degrees : Float -> Float
degrees =
Native.Basics.degrees
{-| Convert turns to standard Elm angles (radians).
One turn is equal to 360&deg;.
-}
turns : Float -> Float
turns =
Native.Basics.turns
{-| Convert polar coordinates (r,&theta;) to Cartesian coordinates (x,y). -}
fromPolar : (Float,Float) -> (Float,Float)
fromPolar =
Native.Basics.fromPolar
{-| Convert Cartesian coordinates (x,y) to polar coordinates (r,&theta;). -}
toPolar : (Float,Float) -> (Float,Float)
toPolar =
Native.Basics.toPolar
{-|-}
(+) : number -> number -> number
(+) =
Native.Basics.add
{-|-}
(-) : number -> number -> number
(-) =
Native.Basics.sub
{-|-}
(*) : number -> number -> number
(*) =
Native.Basics.mul
{-| Floating point division. -}
(/) : Float -> Float -> Float
(/) =
Native.Basics.floatDiv
infixl 6 +
infixl 6 -
infixl 7 *
infixl 7 /
infixr 8 ^
infixl 7 //
infixl 7 %
{-| Integer division. The remainder is discarded. -}
(//) : Int -> Int -> Int
(//) =
Native.Basics.div
{-| Find the remainder after dividing one number by another.
rem 11 4 == 3
rem 12 4 == 0
rem 13 4 == 1
rem -1 4 == -1
-}
rem : Int -> Int -> Int
rem =
Native.Basics.rem
{-| Perform [modular arithmetic](http://en.wikipedia.org/wiki/Modular_arithmetic).
7 % 2 == 1
-1 % 4 == 3
-}
(%) : Int -> Int -> Int
(%) =
Native.Basics.mod
{-| Exponentiation
3^2 == 9
-}
(^) : number -> number -> number
(^) =
Native.Basics.exp
{-|-}
cos : Float -> Float
cos =
Native.Basics.cos
{-|-}
sin : Float -> Float
sin =
Native.Basics.sin
{-|-}
tan : Float -> Float
tan =
Native.Basics.tan
{-|-}
acos : Float -> Float
acos =
Native.Basics.acos
{-|-}
asin : Float -> Float
asin =
Native.Basics.asin
{-| You probably do not want to use this. It takes `(y/x)` as the
argument, so there is no way to know whether the negative signs comes from
the `y` or `x`. Thus, the resulting angle is always between &pi;/2 and -&pi;/2
(in quadrants I and IV). You probably want to use `atan2` instead.
-}
atan : Float -> Float
atan =
Native.Basics.atan
{-| This helps you find the angle of a Cartesian coordinate.
You will almost certainly want to use this instead of `atan`.
So `atan2 y x` computes *atan(y/x)* but also keeps track of which
quadrant the angle should really be in. The result will be between
&pi; and -&pi;, giving you the full range of angles.
-}
atan2 : Float -> Float -> Float
atan2 =
Native.Basics.atan2
{-| Take the square root of a number. -}
sqrt : Float -> Float
sqrt =
Native.Basics.sqrt
{-| Negate a number.
negate 42 == -42
negate -42 == 42
negate 0 == 0
-}
negate : number -> number
negate =
Native.Basics.negate
{-| Take the absolute value of a number. -}
abs : number -> number
abs =
Native.Basics.abs
{-| Calculate the logarithm of a number with a given base.
logBase 10 100 == 2
logBase 2 256 == 8
-}
logBase : Float -> Float -> Float
logBase =
Native.Basics.logBase
{-| Clamps a number within a given range. With the expression
`clamp 100 200 x` the results are as follows:
100 if x < 100
x if 100 <= x < 200
200 if 200 <= x
-}
clamp : number -> number -> number -> number
clamp =
Native.Basics.clamp
{-| An approximation of pi. -}
pi : Float
pi =
Native.Basics.pi
{-| An approximation of e. -}
e : Float
e =
Native.Basics.e
{-| Check if values are &ldquo;the same&rdquo;.
**Note:** Elm uses structural equality on tuples, records, and user-defined
union types. This means the values `(3, 4)` and `(3, 4)` are definitely equal.
This is not true in languages like JavaScript that use reference equality on
objects.
**Note:** Equality (in the Elm sense) is not possible for certain types. For
example, the functions `(\n -> n + 1)` and `(\n -> 1 + n)` are &ldquo;the
same&rdquo; but detecting this in general is [undecidable][]. In a future
release, the compiler will detect when `(==)` is used with problematic
types and provide a helpful error message. This will require quite serious
infrastructure work that makes sense to batch with another big project, so the
stopgap is to crash as quickly as possible. Problematic types include functions
and JavaScript values like `Json.Encode.Value` which could contain functions
if passed through a port.
[undecidable]: https://en.wikipedia.org/wiki/Undecidable_problem
-}
(==) : a -> a -> Bool
(==) =
Native.Basics.eq
{-| Check if values are not &ldquo;the same&rdquo;.
So `(a /= b)` is the same as `(not (a == b))`.
-}
(/=) : a -> a -> Bool
(/=) =
Native.Basics.neq
{-|-}
(<) : comparable -> comparable -> Bool
(<) =
Native.Basics.lt
{-|-}
(>) : comparable -> comparable -> Bool
(>) =
Native.Basics.gt
{-|-}
(<=) : comparable -> comparable -> Bool
(<=) =
Native.Basics.le
{-|-}
(>=) : comparable -> comparable -> Bool
(>=) =
Native.Basics.ge
infix 4 ==
infix 4 /=
infix 4 <
infix 4 >
infix 4 <=
infix 4 >=
{-| Compare any two comparable values. Comparable values include `String`, `Char`,
`Int`, `Float`, `Time`, or a list or tuple containing comparable values.
These are also the only values that work as `Dict` keys or `Set` members.
-}
compare : comparable -> comparable -> Order
compare =
Native.Basics.compare
{-| Represents the relative ordering of two things.
The relations are less than, equal to, and greater than.
-}
type Order = LT | EQ | GT
{-| Find the smaller of two comparables. -}
min : comparable -> comparable -> comparable
min =
Native.Basics.min
{-| Find the larger of two comparables. -}
max : comparable -> comparable -> comparable
max =
Native.Basics.max
{-| The logical AND operator. `True` if both inputs are `True`.
**Note:** When used in the infix position, like `(left && right)`, the operator
short-circuits. This means if `left` is `False` we do not bother evaluating `right`
and just return `False` overall.
-}
(&&) : Bool -> Bool -> Bool
(&&) =
Native.Basics.and
{-| The logical OR operator. `True` if one or both inputs are `True`.
**Note:** When used in the infix position, like `(left || right)`, the operator
short-circuits. This means if `left` is `True` we do not bother evaluating `right`
and just return `True` overall.
-}
(||) : Bool -> Bool -> Bool
(||) =
Native.Basics.or
infixr 3 &&
infixr 2 ||
{-| The exclusive-or operator. `True` if exactly one input is `True`. -}
xor : Bool -> Bool -> Bool
xor =
Native.Basics.xor
{-| Negate a boolean value.
not True == False
not False == True
-}
not : Bool -> Bool
not =
Native.Basics.not
-- Conversions
{-| Round a number to the nearest integer. -}
round : Float -> Int
round =
Native.Basics.round
{-| Truncate a number, rounding towards zero. -}
truncate : Float -> Int
truncate =
Native.Basics.truncate
{-| Floor function, rounding down. -}
floor : Float -> Int
floor =
Native.Basics.floor
{-| Ceiling function, rounding up. -}
ceiling : Float -> Int
ceiling =
Native.Basics.ceiling
{-| Convert an integer into a float. -}
toFloat : Int -> Float
toFloat =
Native.Basics.toFloat
{-| Determine whether a float is an undefined or unrepresentable number.
NaN stands for *not a number* and it is [a standardized part of floating point
numbers](http://en.wikipedia.org/wiki/NaN).
isNaN (0/0) == True
isNaN (sqrt -1) == True
isNaN (1/0) == False -- infinity is a number
isNaN 1 == False
-}
isNaN : Float -> Bool
isNaN =
Native.Basics.isNaN
{-| Determine whether a float is positive or negative infinity.
isInfinite (0/0) == False
isInfinite (sqrt -1) == False
isInfinite (1/0) == True
isInfinite 1 == False
Notice that NaN is not infinite! For float `n` to be finite implies that
`not (isInfinite n || isNaN n)` evaluates to `True`.
-}
isInfinite : Float -> Bool
isInfinite =
Native.Basics.isInfinite
{-| Turn any kind of value into a string. When you view the resulting string
with `Text.fromString` it should look just like the value it came from.
toString 42 == "42"
toString [1,2] == "[1,2]"
toString "he said, \"hi\"" == "\"he said, \\\"hi\\\"\""
-}
toString : a -> String
toString =
Native.Utils.toString
{-| Put two appendable things together. This includes strings, lists, and text.
"hello" ++ "world" == "helloworld"
[1,1,2] ++ [3,5,8] == [1,1,2,3,5,8]
-}
(++) : appendable -> appendable -> appendable
(++) =
Native.Utils.append
infixr 5 ++
-- Function Helpers
{-| Function composition, passing results along in the suggested direction. For
example, the following code checks if the square root of a number is odd:
not << isEven << sqrt
You can think of this operator as equivalent to the following:
(g << f) == (\x -> g (f x))
So our example expands out to something like this:
\n -> not (isEven (sqrt n))
-}
(<<) : (b -> c) -> (a -> b) -> (a -> c)
(<<) g f x =
g (f x)
{-| Function composition, passing results along in the suggested direction. For
example, the following code checks if the square root of a number is odd:
sqrt >> isEven >> not
This direction of function composition seems less pleasant than `(<<)` which
reads nicely in expressions like: `filter (not << isRegistered) students`
-}
(>>) : (a -> b) -> (b -> c) -> (a -> c)
(>>) f g x =
g (f x)
{-| Forward function application `x |> f == f x`. This function is useful
for avoiding parentheses and writing code in a more natural way.
Consider the following code to create a pentagon:
scale 2 (move (10,10) (filled blue (ngon 5 30)))
This can also be written as:
ngon 5 30
|> filled blue
|> move (10,10)
|> scale 2
-}
(|>) : a -> (a -> b) -> b
(|>) x f =
f x
{-| Backward function application `f <| x == f x`. This function is useful for
avoiding parentheses. Consider the following code to create a text element:
leftAligned (monospace (fromString "code"))
This can also be written as:
leftAligned <| monospace <| fromString "code"
-}
(<|) : (a -> b) -> a -> b
(<|) f x =
f x
infixr 9 <<
infixl 9 >>
infixr 0 <|
infixl 0 |>
{-| Given a value, returns exactly the same value. This is called
[the identity function](http://en.wikipedia.org/wiki/Identity_function).
-}
identity : a -> a
identity x =
x
{-| Create a function that *always* returns the same value. Useful with
functions like `map`:
List.map (always 0) [1,2,3,4,5] == [0,0,0,0,0]
-- List.map (\_ -> 0) [1,2,3,4,5] == [0,0,0,0,0]
-- always = (\x _ -> x)
-}
always : a -> b -> a
always a _ =
a
{-| Flip the order of the first two arguments to a function. -}
flip : (a -> b -> c) -> (b -> a -> c)
flip f b a =
f a b
{-| Change how arguments are passed to a function.
This splits paired arguments into two separate arguments.
-}
curry : ((a,b) -> c) -> a -> b -> c
curry f a b =
f (a,b)
{-| Change how arguments are passed to a function.
This combines two arguments into a single pair.
-}
uncurry : (a -> b -> c) -> (a,b) -> c
uncurry f (a,b) =
f a b
{-| A value that can never happen! For context:
- The boolean type `Bool` has two values: `True` and `False`
- The unit type `()` has one value: `()`
- The never type `Never` has no values!
You may see it in the wild in `Html Never` which means this HTML will never
produce any messages. You would need to write an event handler like
`onClick ??? : Attribute Never` but how can we fill in the question marks?!
So there cannot be any event handlers on that HTML.
You may also see this used with tasks that never fail, like `Task Never ()`.
The `Never` type is useful for restricting *arguments* to a function. Maybe my
API can only accept HTML without event handlers, so I require `Html Never` and
users can give `Html msg` and everything will go fine. Generally speaking, you
do not want `Never` in your return types though.
-}
type Never = JustOneMore Never
{-| A function that can never be called. Seems extremely pointless, but it
*can* come in handy. Imagine you have some HTML that should never produce any
messages. And say you want to use it in some other HTML that *does* produce
messages. You could say:
import Html exposing (..)
embedHtml : Html Never -> Html msg
embedHtml staticStuff =
div []
[ text "hello"
, Html.map never staticStuff
]
So the `never` function is basically telling the type system, make sure no one
ever calls me!
-}
never : Never -> a
never (JustOneMore nvr) =
never nvr

90
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Bitwise.elm vendored Normal file
View File

@@ -0,0 +1,90 @@
module Bitwise exposing
( and, or, xor, complement
, shiftLeftBy, shiftRightBy, shiftRightZfBy
)
{-| Library for [bitwise operations](http://en.wikipedia.org/wiki/Bitwise_operation).
# Basic Operations
@docs and, or, xor, complement
# Bit Shifts
@docs shiftLeftBy, shiftRightBy, shiftRightZfBy
-}
import Native.Bitwise
{-| Bitwise AND
-}
and : Int -> Int -> Int
and =
Native.Bitwise.and
{-| Bitwise OR
-}
or : Int -> Int -> Int
or =
Native.Bitwise.or
{-| Bitwise XOR
-}
xor : Int -> Int -> Int
xor =
Native.Bitwise.xor
{-| Flip each bit individually, often called bitwise NOT
-}
complement : Int -> Int
complement =
Native.Bitwise.complement
{-| Shift bits to the left by a given offset, filling new bits with zeros.
This can be used to multiply numbers by powers of two.
shiftLeftBy 1 5 == 10
shiftLeftBy 5 1 == 32
-}
shiftLeftBy : Int -> Int -> Int
shiftLeftBy =
Native.Bitwise.shiftLeftBy
{-| Shift bits to the right by a given offset, filling new bits with
whatever is the topmost bit. This can be used to divide numbers by powers of two.
shiftRightBy 1 32 == 16
shiftRightBy 2 32 == 8
shiftRightBy 1 -32 == -16
This is called an [arithmetic right shift][ars], often written (>>), and
sometimes called a sign-propagating right shift because it fills empty spots
with copies of the highest bit.
[ars]: http://en.wikipedia.org/wiki/Bitwise_operation#Arithmetic_shift
-}
shiftRightBy : Int -> Int -> Int
shiftRightBy =
Native.Bitwise.shiftRightBy
{-| Shift bits to the right by a given offset, filling new bits with zeros.
shiftRightZfBy 1 32 == 16
shiftRightZfBy 2 32 == 8
shiftRightZfBy 1 -32 == 2147483632
This is called an [logical right shift][lrs], often written (>>>), and
sometimes called a zero-fill right shift because it fills empty spots with
zeros.
[lrs]: http://en.wikipedia.org/wiki/Bitwise_operation#Logical_shift
-}
shiftRightZfBy : Int -> Int -> Int
shiftRightZfBy =
Native.Bitwise.shiftRightZfBy

103
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Char.elm vendored Normal file
View File

@@ -0,0 +1,103 @@
module Char exposing
( isUpper, isLower, isDigit, isOctDigit, isHexDigit
, toUpper, toLower, toLocaleUpper, toLocaleLower
, KeyCode, toCode, fromCode
)
{-| Functions for working with characters. Character literals are enclosed in
`'a'` pair of single quotes.
# Classification
@docs isUpper, isLower, isDigit, isOctDigit, isHexDigit
# Conversion
@docs toUpper, toLower, toLocaleUpper, toLocaleLower
# Key Codes
@docs KeyCode, toCode, fromCode
-}
import Native.Char
import Basics exposing ((&&), (||), (>=), (<=))
isBetween : Char -> Char -> Char -> Bool
isBetween low high char =
let code = toCode char
in
(code >= toCode low) && (code <= toCode high)
{-| True for upper case ASCII letters. -}
isUpper : Char -> Bool
isUpper =
isBetween 'A' 'Z'
{-| True for lower case ASCII letters. -}
isLower : Char -> Bool
isLower =
isBetween 'a' 'z'
{-| True for ASCII digits `[0-9]`. -}
isDigit : Char -> Bool
isDigit =
isBetween '0' '9'
{-| True for ASCII octal digits `[0-7]`. -}
isOctDigit : Char -> Bool
isOctDigit =
isBetween '0' '7'
{-| True for ASCII hexadecimal digits `[0-9a-fA-F]`. -}
isHexDigit : Char -> Bool
isHexDigit char =
isDigit char || isBetween 'a' 'f' char || isBetween 'A' 'F' char
{-| Convert to upper case. -}
toUpper : Char -> Char
toUpper =
Native.Char.toUpper
{-| Convert to lower case. -}
toLower : Char -> Char
toLower =
Native.Char.toLower
{-| Convert to upper case, according to any locale-specific case mappings. -}
toLocaleUpper : Char -> Char
toLocaleUpper =
Native.Char.toLocaleUpper
{-| Convert to lower case, according to any locale-specific case mappings. -}
toLocaleLower : Char -> Char
toLocaleLower =
Native.Char.toLocaleLower
{-| Keyboard keys can be represented as integers. These are called *key codes*.
You can use [`toCode`](#toCode) and [`fromCode`](#fromCode) to convert between
key codes and characters.
-}
type alias KeyCode = Int
{-| Convert to key code.
-}
toCode : Char -> KeyCode
toCode =
Native.Char.toCode
{-| Convert from key code. -}
fromCode : KeyCode -> Char
fromCode =
Native.Char.fromCode

456
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Color.elm vendored Normal file
View File

@@ -0,0 +1,456 @@
module Color exposing
( Color, rgb, rgba, hsl, hsla, greyscale, grayscale, complement
, Gradient, linear, radial
, toRgb, toHsl
, red, orange, yellow, green, blue, purple, brown
, lightRed, lightOrange, lightYellow, lightGreen, lightBlue, lightPurple, lightBrown
, darkRed, darkOrange, darkYellow, darkGreen, darkBlue, darkPurple, darkBrown
, white, lightGrey, grey, darkGrey, lightCharcoal, charcoal, darkCharcoal, black
, lightGray, gray, darkGray
)
{-| Library for working with colors. Includes
[RGB](https://en.wikipedia.org/wiki/RGB_color_model) and
[HSL](http://en.wikipedia.org/wiki/HSL_and_HSV) creation, gradients, and
built-in names.
# Colors
@docs Color
# Creation
@docs rgb, rgba, hsl, hsla, greyscale, grayscale, complement
# Gradients
@docs Gradient, linear, radial
# Extracting Colors
@docs toRgb, toHsl
# Built-in Colors
These colors come from the [Tango
palette](http://tango.freedesktop.org/Tango_Icon_Theme_Guidelines)
which provides aesthetically reasonable defaults for colors. Each color also
comes with a light and dark version.
### Standard
@docs red, orange, yellow, green, blue, purple, brown
### Light
@docs lightRed, lightOrange, lightYellow, lightGreen, lightBlue, lightPurple, lightBrown
### Dark
@docs darkRed, darkOrange, darkYellow, darkGreen, darkBlue, darkPurple, darkBrown
### Eight Shades of Grey
These colors are a compatible series of shades of grey, fitting nicely
with the Tango palette.
@docs white, lightGrey, grey, darkGrey, lightCharcoal, charcoal, darkCharcoal, black
These are identical to the *grey* versions. It seems the spelling is regional, but
that has never helped me remember which one I should be writing.
@docs lightGray, gray, darkGray
-}
import Basics exposing (..)
{-| Representation of colors.
-}
type Color
= RGBA Int Int Int Float
| HSLA Float Float Float Float
{-| Create RGB colors with an alpha component for transparency.
The alpha component is specified with numbers between 0 and 1. -}
rgba : Int -> Int -> Int -> Float -> Color
rgba =
RGBA
{-| Create RGB colors from numbers between 0 and 255 inclusive. -}
rgb : Int -> Int -> Int -> Color
rgb r g b =
RGBA r g b 1
{-| Create [HSL colors](http://en.wikipedia.org/wiki/HSL_and_HSV)
with an alpha component for transparency.
-}
hsla : Float -> Float -> Float -> Float -> Color
hsla hue saturation lightness alpha =
HSLA (hue - turns (toFloat (floor (hue / (2*pi))))) saturation lightness alpha
{-| Create [HSL colors](http://en.wikipedia.org/wiki/HSL_and_HSV). This gives
you access to colors more like a color wheel, where all hues are arranged in a
circle that you specify with standard Elm angles (radians).
red = hsl (degrees 0) 1 0.5
green = hsl (degrees 120) 1 0.5
blue = hsl (degrees 240) 1 0.5
pastelRed = hsl (degrees 0) 0.7 0.7
To cycle through all colors, just cycle through degrees. The saturation level
is how vibrant the color is, like a dial between grey and bright colors. The
lightness level is a dial between white and black.
-}
hsl : Float -> Float -> Float -> Color
hsl hue saturation lightness =
hsla hue saturation lightness 1
{-| Produce a gray based on the input. 0 is white, 1 is black.
-}
grayscale : Float -> Color
grayscale p =
HSLA 0 0 (1-p) 1
{-| Produce a gray based on the input. 0 is white, 1 is black.
-}
greyscale : Float -> Color
greyscale p =
HSLA 0 0 (1-p) 1
{-| Produce a &ldquo;complementary color&rdquo;. The two colors will
accent each other. This is the same as rotating the hue by 180&deg;.
-}
complement : Color -> Color
complement color =
case color of
HSLA h s l a ->
hsla (h + degrees 180) s l a
RGBA r g b a ->
let
(h,s,l) = rgbToHsl r g b
in
hsla (h + degrees 180) s l a
{-| Extract the components of a color in the HSL format.
-}
toHsl : Color -> { hue:Float, saturation:Float, lightness:Float, alpha:Float }
toHsl color =
case color of
HSLA h s l a ->
{ hue=h, saturation=s, lightness=l, alpha=a }
RGBA r g b a ->
let
(h,s,l) = rgbToHsl r g b
in
{ hue=h, saturation=s, lightness=l, alpha=a }
{-| Extract the components of a color in the RGB format.
-}
toRgb : Color -> { red:Int, green:Int, blue:Int, alpha:Float }
toRgb color =
case color of
RGBA r g b a ->
{ red = r, green = g, blue = b, alpha = a }
HSLA h s l a ->
let
(r,g,b) = hslToRgb h s l
in
{ red = round (255 * r)
, green = round (255 * g)
, blue = round (255 * b)
, alpha = a
}
fmod : Float -> Int -> Float
fmod f n =
let
integer = floor f
in
toFloat (integer % n) + f - toFloat integer
rgbToHsl : Int -> Int -> Int -> (Float,Float,Float)
rgbToHsl red green blue =
let
r = toFloat red / 255
g = toFloat green / 255
b = toFloat blue / 255
cMax = max (max r g) b
cMin = min (min r g) b
c = cMax - cMin
hue =
degrees 60 *
if cMax == r then
fmod ((g - b) / c) 6
else if cMax == g then
((b - r) / c) + 2
else {- cMax == b -}
((r - g) / c) + 4
lightness =
(cMax + cMin) / 2
saturation =
if lightness == 0 then
0
else
c / (1 - abs (2 * lightness - 1))
in
(hue, saturation, lightness)
hslToRgb : Float -> Float -> Float -> (Float,Float,Float)
hslToRgb hue saturation lightness =
let
chroma = (1 - abs (2 * lightness - 1)) * saturation
normHue = hue / degrees 60
x = chroma * (1 - abs (fmod normHue 2 - 1))
(r,g,b) =
if normHue < 0 then (0, 0, 0)
else if normHue < 1 then (chroma, x, 0)
else if normHue < 2 then (x, chroma, 0)
else if normHue < 3 then (0, chroma, x)
else if normHue < 4 then (0, x, chroma)
else if normHue < 5 then (x, 0, chroma)
else if normHue < 6 then (chroma, 0, x)
else (0, 0, 0)
m = lightness - chroma / 2
in
(r + m, g + m, b + m)
--toV3 : Color -> V3
--toV4 : Color -> V4
{-| Abstract representation of a color gradient.
-}
type Gradient
= Linear (Float,Float) (Float,Float) (List (Float,Color))
| Radial (Float,Float) Float (Float,Float) Float (List (Float,Color))
{-| Create a linear gradient. Takes a start and end point and then a series of
&ldquo;color stops&rdquo; that indicate how to interpolate between the start and
end points. See [this example](http://elm-lang.org/examples/linear-gradient) for a
more visual explanation.
-}
linear : (Float, Float) -> (Float, Float) -> List (Float,Color) -> Gradient
linear =
Linear
{-| Create a radial gradient. First takes a start point and inner radius. Then
takes an end point and outer radius. It then takes a series of &ldquo;color
stops&rdquo; that indicate how to interpolate between the inner and outer
circles. See [this example](http://elm-lang.org/examples/radial-gradient) for a
more visual explanation.
-}
radial : (Float,Float) -> Float -> (Float,Float) -> Float -> List (Float,Color) -> Gradient
radial =
Radial
-- BUILT-IN COLORS
{-|-}
lightRed : Color
lightRed =
RGBA 239 41 41 1
{-|-}
red : Color
red =
RGBA 204 0 0 1
{-|-}
darkRed : Color
darkRed =
RGBA 164 0 0 1
{-|-}
lightOrange : Color
lightOrange =
RGBA 252 175 62 1
{-|-}
orange : Color
orange =
RGBA 245 121 0 1
{-|-}
darkOrange : Color
darkOrange =
RGBA 206 92 0 1
{-|-}
lightYellow : Color
lightYellow =
RGBA 255 233 79 1
{-|-}
yellow : Color
yellow =
RGBA 237 212 0 1
{-|-}
darkYellow : Color
darkYellow =
RGBA 196 160 0 1
{-|-}
lightGreen : Color
lightGreen =
RGBA 138 226 52 1
{-|-}
green : Color
green =
RGBA 115 210 22 1
{-|-}
darkGreen : Color
darkGreen =
RGBA 78 154 6 1
{-|-}
lightBlue : Color
lightBlue =
RGBA 114 159 207 1
{-|-}
blue : Color
blue =
RGBA 52 101 164 1
{-|-}
darkBlue : Color
darkBlue =
RGBA 32 74 135 1
{-|-}
lightPurple : Color
lightPurple =
RGBA 173 127 168 1
{-|-}
purple : Color
purple =
RGBA 117 80 123 1
{-|-}
darkPurple : Color
darkPurple =
RGBA 92 53 102 1
{-|-}
lightBrown : Color
lightBrown =
RGBA 233 185 110 1
{-|-}
brown : Color
brown =
RGBA 193 125 17 1
{-|-}
darkBrown : Color
darkBrown =
RGBA 143 89 2 1
{-|-}
black : Color
black =
RGBA 0 0 0 1
{-|-}
white : Color
white =
RGBA 255 255 255 1
{-|-}
lightGrey : Color
lightGrey =
RGBA 238 238 236 1
{-|-}
grey : Color
grey =
RGBA 211 215 207 1
{-|-}
darkGrey : Color
darkGrey =
RGBA 186 189 182 1
{-|-}
lightGray : Color
lightGray =
RGBA 238 238 236 1
{-|-}
gray : Color
gray =
RGBA 211 215 207 1
{-|-}
darkGray : Color
darkGray =
RGBA 186 189 182 1
{-|-}
lightCharcoal : Color
lightCharcoal =
RGBA 136 138 133 1
{-|-}
charcoal : Color
charcoal =
RGBA 85 87 83 1
{-|-}
darkCharcoal : Color
darkCharcoal =
RGBA 46 52 54 1

150
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Date.elm vendored Normal file
View File

@@ -0,0 +1,150 @@
module Date exposing
( Date, fromString, toTime, fromTime
, year, month, Month(..)
, day, dayOfWeek, Day(..)
, hour, minute, second, millisecond
, now
)
{-| Library for working with dates. Email the mailing list if you encounter
issues with internationalization or locale formatting.
# Dates
@docs Date, now
# Conversions
@docs fromString, toTime, fromTime
# Extractions
@docs year, month, Month, day, dayOfWeek, Day, hour, minute, second, millisecond
-}
import Native.Date
import Task exposing (Task)
import Time exposing (Time)
import Result exposing (Result)
-- DATES
{-| Representation of a date.
-}
type Date = Date
{-| Get the `Date` at the moment when this task is run.
-}
now : Task x Date
now =
Task.map fromTime Time.now
-- CONVERSIONS AND EXTRACTIONS
{-| Represents the days of the week.
-}
type Day = Mon | Tue | Wed | Thu | Fri | Sat | Sun
{-| Represents the month of the year.
-}
type Month
= Jan | Feb | Mar | Apr
| May | Jun | Jul | Aug
| Sep | Oct | Nov | Dec
{-| Attempt to read a date from a string.
-}
fromString : String -> Result String Date
fromString =
Native.Date.fromString
{-| Convert a `Date` to a time in milliseconds.
A time is the number of milliseconds since
[the Unix epoch](http://en.wikipedia.org/wiki/Unix_time).
-}
toTime : Date -> Time
toTime =
Native.Date.toTime
{-| Convert a time in milliseconds into a `Date`.
A time is the number of milliseconds since
[the Unix epoch](http://en.wikipedia.org/wiki/Unix_time).
-}
fromTime : Time -> Date
fromTime =
Native.Date.fromTime
{-| Extract the year of a given date. Given the date 23 June 1990 at 11:45AM
this returns the integer `1990`.
-}
year : Date -> Int
year =
Native.Date.year
{-| Extract the month of a given date. Given the date 23 June 1990 at 11:45AM
this returns the month `Jun` as defined below.
-}
month : Date -> Month
month =
Native.Date.month
{-| Extract the day of a given date. Given the date 23 June 1990 at 11:45AM
this returns the integer `23`.
-}
day : Date -> Int
day =
Native.Date.day
{-| Extract the day of the week for a given date. Given the date 23 June
1990 at 11:45AM this returns the day `Sat` as defined below.
-}
dayOfWeek : Date -> Day
dayOfWeek =
Native.Date.dayOfWeek
{-| Extract the hour of a given date. Given the date 23 June 1990 at 11:45AM
this returns the integer `11`.
-}
hour : Date -> Int
hour =
Native.Date.hour
{-| Extract the minute of a given date. Given the date 23 June 1990 at 11:45AM
this returns the integer `45`.
-}
minute : Date -> Int
minute =
Native.Date.minute
{-| Extract the second of a given date. Given the date 23 June 1990 at 11:45AM
this returns the integer `0`.
-}
second : Date -> Int
second =
Native.Date.second
{-| Extract the millisecond of a given date. Given the date 23 June 1990 at 11:45:30.123AM
this returns the integer `123`.
-}
millisecond : Date -> Int
millisecond =
Native.Date.millisecond

62
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Debug.elm vendored Normal file
View File

@@ -0,0 +1,62 @@
module Debug exposing
( log
, crash
)
{-| This library is for investigating bugs or performance problems. It should
*not* be used in production code.
# Debugging
@docs log, crash
-}
import Native.Debug
{-| Log a tagged value on the developer console, and then return the value.
1 + log "number" 1 -- equals 2, logs "number: 1"
length (log "start" []) -- equals 0, logs "start: []"
Notice that `log` is not a pure function! It should *only* be used for
investigating bugs or performance problems.
-}
log : String -> a -> a
log =
Native.Debug.log
{-| Crash the program with an error message. This is an uncatchable error,
intended for code that is soon-to-be-implemented. For example, if you are
working with a large ADT and have partially completed a case expression, it may
make sense to do this:
type Entity = Ship | Fish | Captain | Seagull
drawEntity entity =
case entity of
Ship ->
...
Fish ->
...
_ ->
Debug.crash "TODO"
The Elm compiler recognizes each `Debug.crash` and when you run into it at
runtime, the error will point to the corresponding module name and line number.
For `case` expressions that ends with a wildcard pattern and a crash, it will
also show the value that snuck through. In our example, that'd be `Captain` or
`Seagull`.
**Use this if** you want to do some testing while you are partway through
writing a function.
**Do not use this if** you want to do some typical try-catch exception handling.
Use the [`Maybe`](Maybe) or [`Result`](Result) libraries instead.
-}
crash : String -> a
crash =
Native.Debug.crash

661
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Dict.elm vendored Normal file
View File

@@ -0,0 +1,661 @@
module Dict exposing
( Dict
, empty, singleton, insert, update
, isEmpty, get, remove, member, size
, filter
, partition
, foldl, foldr, map
, union, intersect, diff, merge
, keys, values
, toList, fromList
)
{-| A dictionary mapping unique keys to values. The keys can be any comparable
type. This includes `Int`, `Float`, `Time`, `Char`, `String`, and tuples or
lists of comparable types.
Insert, remove, and query operations all take *O(log n)* time.
# Dictionaries
@docs Dict
# Build
@docs empty, singleton, insert, update, remove
# Query
@docs isEmpty, member, get, size
# Lists
@docs keys, values, toList, fromList
# Transform
@docs map, foldl, foldr, filter, partition
# Combine
@docs union, intersect, diff, merge
-}
import Basics exposing (..)
import Maybe exposing (..)
import List exposing (..)
import Native.Debug
import String
-- DICTIONARIES
-- BBlack and NBlack should only be used during the deletion
-- algorithm. Any other occurrence is a bug and should fail an assert.
type NColor
= Red
| Black
| BBlack -- Double Black, counts as 2 blacks for the invariant
| NBlack -- Negative Black, counts as -1 blacks for the invariant
type LeafColor
= LBlack
| LBBlack -- Double Black, counts as 2
{-| A dictionary of keys and values. So a `(Dict String User)` is a dictionary
that lets you look up a `String` (such as user names) and find the associated
`User`.
-}
type Dict k v
= RBNode_elm_builtin NColor k v (Dict k v) (Dict k v)
| RBEmpty_elm_builtin LeafColor
{-| Create an empty dictionary. -}
empty : Dict k v
empty =
RBEmpty_elm_builtin LBlack
maxWithDefault : k -> v -> Dict k v -> (k, v)
maxWithDefault k v r =
case r of
RBEmpty_elm_builtin _ ->
(k, v)
RBNode_elm_builtin _ kr vr _ rr ->
maxWithDefault kr vr rr
{-| 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 "Jerry" animals == Just Mouse
get "Spike" animals == Nothing
-}
get : comparable -> Dict comparable v -> Maybe v
get targetKey dict =
case dict of
RBEmpty_elm_builtin _ ->
Nothing
RBNode_elm_builtin _ key value left right ->
case compare targetKey key of
LT ->
get targetKey left
EQ ->
Just value
GT ->
get targetKey right
{-| Determine if a key is in a dictionary. -}
member : comparable -> Dict comparable v -> Bool
member key dict =
case get key dict of
Just _ ->
True
Nothing ->
False
{-| Determine the number of key-value pairs in the dictionary. -}
size : Dict k v -> Int
size dict =
sizeHelp 0 dict
sizeHelp : Int -> Dict k v -> Int
sizeHelp n dict =
case dict of
RBEmpty_elm_builtin _ ->
n
RBNode_elm_builtin _ _ _ left right ->
sizeHelp (sizeHelp (n+1) right) left
{-| Determine if a dictionary is empty.
isEmpty empty == True
-}
isEmpty : Dict k v -> Bool
isEmpty dict =
dict == empty
{- The actual pattern match here is somewhat lax. If it is given invalid input,
it will do the wrong thing. The expected behavior is:
red node => black node
black node => same
bblack node => xxx
nblack node => xxx
black leaf => same
bblack leaf => xxx
-}
ensureBlackRoot : Dict k v -> Dict k v
ensureBlackRoot dict =
case dict of
RBNode_elm_builtin Red key value left right ->
RBNode_elm_builtin Black key value left right
_ ->
dict
{-| Insert a key-value pair into a dictionary. Replaces value when there is
a collision. -}
insert : comparable -> v -> Dict comparable v -> Dict comparable v
insert key value dict =
update key (always (Just value)) dict
{-| Remove a key-value pair from a dictionary. If the key is not found,
no changes are made. -}
remove : comparable -> Dict comparable v -> Dict comparable v
remove key dict =
update key (always Nothing) dict
type Flag = Insert | Remove | Same
{-| Update the value of a dictionary for a specific key with a given function. -}
update : comparable -> (Maybe v -> Maybe v) -> Dict comparable v -> Dict comparable v
update k alter dict =
let
up dict =
case dict of
-- expecting only black nodes, never double black nodes here
RBEmpty_elm_builtin _ ->
case alter Nothing of
Nothing ->
(Same, empty)
Just v ->
(Insert, RBNode_elm_builtin Red k v empty empty)
RBNode_elm_builtin clr key value left right ->
case compare k key of
EQ ->
case alter (Just value) of
Nothing ->
(Remove, rem clr left right)
Just newValue ->
(Same, RBNode_elm_builtin clr key newValue left right)
LT ->
let (flag, newLeft) = up left in
case flag of
Same ->
(Same, RBNode_elm_builtin clr key value newLeft right)
Insert ->
(Insert, balance clr key value newLeft right)
Remove ->
(Remove, bubble clr key value newLeft right)
GT ->
let (flag, newRight) = up right in
case flag of
Same ->
(Same, RBNode_elm_builtin clr key value left newRight)
Insert ->
(Insert, balance clr key value left newRight)
Remove ->
(Remove, bubble clr key value left newRight)
(flag, updatedDict) =
up dict
in
case flag of
Same ->
updatedDict
Insert ->
ensureBlackRoot updatedDict
Remove ->
blacken updatedDict
{-| Create a dictionary with one key-value pair. -}
singleton : comparable -> v -> Dict comparable v
singleton key value =
insert key value empty
-- HELPERS
isBBlack : Dict k v -> Bool
isBBlack dict =
case dict of
RBNode_elm_builtin BBlack _ _ _ _ ->
True
RBEmpty_elm_builtin LBBlack ->
True
_ ->
False
moreBlack : NColor -> NColor
moreBlack color =
case color of
Black ->
BBlack
Red ->
Black
NBlack ->
Red
BBlack ->
Native.Debug.crash "Can't make a double black node more black!"
lessBlack : NColor -> NColor
lessBlack color =
case color of
BBlack ->
Black
Black ->
Red
Red ->
NBlack
NBlack ->
Native.Debug.crash "Can't make a negative black node less black!"
{- The actual pattern match here is somewhat lax. If it is given invalid input,
it will do the wrong thing. The expected behavior is:
node => less black node
bblack leaf => black leaf
black leaf => xxx
-}
lessBlackTree : Dict k v -> Dict k v
lessBlackTree dict =
case dict of
RBNode_elm_builtin c k v l r ->
RBNode_elm_builtin (lessBlack c) k v l r
RBEmpty_elm_builtin _ ->
RBEmpty_elm_builtin LBlack
reportRemBug : String -> NColor -> String -> String -> a
reportRemBug msg c lgot rgot =
Native.Debug.crash <|
String.concat
[ "Internal red-black tree invariant violated, expected "
, msg, " and got ", toString c, "/", lgot, "/", rgot
, "\nPlease report this bug to <https://github.com/elm-lang/core/issues>"
]
-- Remove the top node from the tree, may leave behind BBlacks
rem : NColor -> Dict k v -> Dict k v -> Dict k v
rem color left right =
case (left, right) of
(RBEmpty_elm_builtin _, RBEmpty_elm_builtin _) ->
case color of
Red ->
RBEmpty_elm_builtin LBlack
Black ->
RBEmpty_elm_builtin LBBlack
_ ->
Native.Debug.crash "cannot have bblack or nblack nodes at this point"
(RBEmpty_elm_builtin cl, RBNode_elm_builtin cr k v l r) ->
case (color, cl, cr) of
(Black, LBlack, Red) ->
RBNode_elm_builtin Black k v l r
_ ->
reportRemBug "Black/LBlack/Red" color (toString cl) (toString cr)
(RBNode_elm_builtin cl k v l r, RBEmpty_elm_builtin cr) ->
case (color, cl, cr) of
(Black, Red, LBlack) ->
RBNode_elm_builtin Black k v l r
_ ->
reportRemBug "Black/Red/LBlack" color (toString cl) (toString cr)
-- l and r are both RBNodes
(RBNode_elm_builtin cl kl vl ll rl, RBNode_elm_builtin _ _ _ _ _) ->
let
(k, v) =
maxWithDefault kl vl rl
newLeft =
removeMax cl kl vl ll rl
in
bubble color k v newLeft right
-- Kills a BBlack or moves it upward, may leave behind NBlack
bubble : NColor -> k -> v -> Dict k v -> Dict k v -> Dict k v
bubble c k v l r =
if isBBlack l || isBBlack r then
balance (moreBlack c) k v (lessBlackTree l) (lessBlackTree r)
else
RBNode_elm_builtin c k v l r
-- Removes rightmost node, may leave root as BBlack
removeMax : NColor -> k -> v -> Dict k v -> Dict k v -> Dict k v
removeMax c k v l r =
case r of
RBEmpty_elm_builtin _ ->
rem c l r
RBNode_elm_builtin cr kr vr lr rr ->
bubble c k v l (removeMax cr kr vr lr rr)
-- generalized tree balancing act
balance : NColor -> k -> v -> Dict k v -> Dict k v -> Dict k v
balance c k v l r =
let
tree =
RBNode_elm_builtin c k v l r
in
if blackish tree then
balanceHelp tree
else
tree
blackish : Dict k v -> Bool
blackish t =
case t of
RBNode_elm_builtin c _ _ _ _ ->
c == Black || c == BBlack
RBEmpty_elm_builtin _ ->
True
balanceHelp : Dict k v -> Dict k v
balanceHelp tree =
case tree of
-- double red: left, left
RBNode_elm_builtin col zk zv (RBNode_elm_builtin Red yk yv (RBNode_elm_builtin Red xk xv a b) c) d ->
balancedTree col xk xv yk yv zk zv a b c d
-- double red: left, right
RBNode_elm_builtin col zk zv (RBNode_elm_builtin Red xk xv a (RBNode_elm_builtin Red yk yv b c)) d ->
balancedTree col xk xv yk yv zk zv a b c d
-- double red: right, left
RBNode_elm_builtin col xk xv a (RBNode_elm_builtin Red zk zv (RBNode_elm_builtin Red yk yv b c) d) ->
balancedTree col xk xv yk yv zk zv a b c d
-- double red: right, right
RBNode_elm_builtin col xk xv a (RBNode_elm_builtin Red yk yv b (RBNode_elm_builtin Red zk zv c d)) ->
balancedTree col xk xv yk yv zk zv a b c d
-- handle double blacks
RBNode_elm_builtin BBlack xk xv a (RBNode_elm_builtin NBlack zk zv (RBNode_elm_builtin Black yk yv b c) (RBNode_elm_builtin Black _ _ _ _ as d)) ->
RBNode_elm_builtin Black yk yv (RBNode_elm_builtin Black xk xv a b) (balance Black zk zv c (redden d))
RBNode_elm_builtin BBlack zk zv (RBNode_elm_builtin NBlack xk xv (RBNode_elm_builtin Black _ _ _ _ as a) (RBNode_elm_builtin Black yk yv b c)) d ->
RBNode_elm_builtin Black yk yv (balance Black xk xv (redden a) b) (RBNode_elm_builtin Black zk zv c d)
_ ->
tree
balancedTree : NColor -> k -> v -> k -> v -> k -> v -> Dict k v -> Dict k v -> Dict k v -> Dict k v -> Dict k v
balancedTree col xk xv yk yv zk zv a b c d =
RBNode_elm_builtin
(lessBlack col)
yk
yv
(RBNode_elm_builtin Black xk xv a b)
(RBNode_elm_builtin Black zk zv c d)
-- make the top node black
blacken : Dict k v -> Dict k v
blacken t =
case t of
RBEmpty_elm_builtin _ ->
RBEmpty_elm_builtin LBlack
RBNode_elm_builtin _ k v l r ->
RBNode_elm_builtin Black k v l r
-- make the top node red
redden : Dict k v -> Dict k v
redden t =
case t of
RBEmpty_elm_builtin _ ->
Native.Debug.crash "can't make a Leaf red"
RBNode_elm_builtin _ k v l r ->
RBNode_elm_builtin Red k v l r
-- COMBINE
{-| Combine two dictionaries. If there is a collision, preference is given
to the first dictionary.
-}
union : Dict comparable v -> Dict comparable v -> Dict comparable v
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 =
filter (\k _ -> member k t2) t1
{-| Keep a key-value pair when its key does not appear in the second dictionary.
-}
diff : Dict comparable v -> Dict comparable v -> Dict comparable v
diff t1 t2 =
foldl (\k v t -> remove k t) t1 t2
{-| The most general way of combining two dictionaries. You provide three
accumulators for when a given key appears:
1. Only in the left dictionary.
2. In both dictionaries.
3. Only in the right dictionary.
You then traverse all the keys from lowest to highest, building up whatever
you want.
-}
merge
: (comparable -> a -> result -> result)
-> (comparable -> a -> b -> result -> result)
-> (comparable -> b -> result -> result)
-> Dict comparable a
-> Dict comparable b
-> result
-> result
merge leftStep bothStep rightStep leftDict rightDict initialResult =
let
stepState rKey rValue (list, result) =
case list of
[] ->
(list, rightStep rKey rValue result)
(lKey, lValue) :: rest ->
if lKey < rKey then
stepState rKey rValue (rest, leftStep lKey lValue result)
else if lKey > rKey then
(list, rightStep rKey rValue result)
else
(rest, bothStep lKey lValue rValue result)
(leftovers, intermediateResult) =
foldl stepState (toList leftDict, initialResult) rightDict
in
List.foldl (\(k,v) result -> leftStep k v result) intermediateResult leftovers
-- TRANSFORM
{-| Apply a function to all values in a dictionary.
-}
map : (comparable -> a -> b) -> Dict comparable a -> Dict comparable b
map f dict =
case dict of
RBEmpty_elm_builtin _ ->
RBEmpty_elm_builtin LBlack
RBNode_elm_builtin clr key value left right ->
RBNode_elm_builtin clr key (f key value) (map f left) (map f right)
{-| Fold over the key-value pairs in a dictionary, in order from lowest
key to highest key.
-}
foldl : (comparable -> v -> b -> b) -> b -> Dict comparable v -> b
foldl f acc dict =
case dict of
RBEmpty_elm_builtin _ ->
acc
RBNode_elm_builtin _ key value left right ->
foldl f (f key value (foldl f acc left)) right
{-| Fold over the key-value pairs in a dictionary, in order from highest
key to lowest key.
-}
foldr : (comparable -> v -> b -> b) -> b -> Dict comparable v -> b
foldr f acc t =
case t of
RBEmpty_elm_builtin _ ->
acc
RBNode_elm_builtin _ key value left right ->
foldr f (f key value (foldr f acc right)) left
{-| Keep a key-value pair when it satisfies a predicate. -}
filter : (comparable -> v -> Bool) -> Dict comparable v -> Dict comparable v
filter predicate dictionary =
let
add key value dict =
if predicate key value then
insert key value dict
else
dict
in
foldl add empty dictionary
{-| 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 predicate dict =
let
add key value (t1, t2) =
if predicate key value then
(insert key value t1, t2)
else
(t1, insert key value t2)
in
foldl add (empty, empty) dict
-- LISTS
{-| Get all of the keys in a dictionary, sorted from lowest to highest.
keys (fromList [(0,"Alice"),(1,"Bob")]) == [0,1]
-}
keys : Dict comparable v -> List comparable
keys dict =
foldr (\key value keyList -> key :: keyList) [] dict
{-| Get all of the values in a dictionary, in the order of their keys.
values (fromList [(0,"Alice"),(1,"Bob")]) == ["Alice", "Bob"]
-}
values : Dict comparable v -> List v
values dict =
foldr (\key value valueList -> value :: valueList) [] dict
{-| Convert a dictionary into an association list of key-value pairs, sorted by keys. -}
toList : Dict comparable v -> List (comparable,v)
toList dict =
foldr (\key value list -> (key,value) :: list) [] dict
{-| Convert an association list into a dictionary. -}
fromList : List (comparable,v) -> Dict comparable v
fromList assocs =
List.foldl (\(key,value) dict -> insert key value dict) empty assocs

520
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Json/Decode.elm vendored Normal file
View File

@@ -0,0 +1,520 @@
module Json.Decode exposing
( Decoder, string, bool, int, float
, nullable, list, array, dict, keyValuePairs
, field, at, index
, maybe, oneOf
, decodeString, decodeValue, Value
, map, map2, map3, map4, map5, map6, map7, map8
, lazy, value, null, succeed, fail, andThen
)
{-| Turn JSON values into Elm values. Definitely check out this [intro to
JSON decoders][guide] to get a feel for how this library works!
[guide]: https://guide.elm-lang.org/interop/json.html
# Primitives
@docs Decoder, string, bool, int, float
# Data Structures
@docs nullable, list, array, dict, keyValuePairs
# Object Primitives
@docs field, at, index
# Inconsistent Structure
@docs maybe, oneOf
# Run Decoders
@docs decodeString, decodeValue, Value
# Mapping
**Note:** If you run out of map functions, take a look at [elm-decode-pipeline][pipe]
which makes it easier to handle large objects, but produces lower quality type
errors.
[pipe]: http://package.elm-lang.org/packages/NoRedInk/elm-decode-pipeline/latest
@docs map, map2, map3, map4, map5, map6, map7, map8
# Fancy Decoding
@docs lazy, value, null, succeed, fail, andThen
-}
import Array exposing (Array)
import Dict exposing (Dict)
import Json.Encode as JsEncode
import List
import Maybe exposing (Maybe(..))
import Result exposing (Result(..))
import Native.Json
-- PRIMITIVES
{-| A value that knows how to decode JSON values.
-}
type Decoder a = Decoder
{-| Decode a JSON string into an Elm `String`.
decodeString string "true" == Err ...
decodeString string "42" == Err ...
decodeString string "3.14" == Err ...
decodeString string "\"hello\"" == Ok "hello"
decodeString string "{ \"hello\": 42 }" == Err ...
-}
string : Decoder String
string =
Native.Json.decodePrimitive "string"
{-| Decode a JSON boolean into an Elm `Bool`.
decodeString bool "true" == Ok True
decodeString bool "42" == Err ...
decodeString bool "3.14" == Err ...
decodeString bool "\"hello\"" == Err ...
decodeString bool "{ \"hello\": 42 }" == Err ...
-}
bool : Decoder Bool
bool =
Native.Json.decodePrimitive "bool"
{-| Decode a JSON number into an Elm `Int`.
decodeString int "true" == Err ...
decodeString int "42" == Ok 42
decodeString int "3.14" == Err ...
decodeString int "\"hello\"" == Err ...
decodeString int "{ \"hello\": 42 }" == Err ...
-}
int : Decoder Int
int =
Native.Json.decodePrimitive "int"
{-| Decode a JSON number into an Elm `Float`.
decodeString float "true" == Err ..
decodeString float "42" == Ok 42
decodeString float "3.14" == Ok 3.14
decodeString float "\"hello\"" == Err ...
decodeString float "{ \"hello\": 42 }" == Err ...
-}
float : Decoder Float
float =
Native.Json.decodePrimitive "float"
-- DATA STRUCTURES
{-| Decode a nullable JSON value into an Elm value.
decodeString (nullable int) "13" == Ok (Just 13)
decodeString (nullable int) "42" == Ok (Just 42)
decodeString (nullable int) "null" == Ok Nothing
decodeString (nullable int) "true" == Err ..
-}
nullable : Decoder a -> Decoder (Maybe a)
nullable decoder =
oneOf
[ null Nothing
, map Just decoder
]
{-| Decode a JSON array into an Elm `List`.
decodeString (list int) "[1,2,3]" == Ok [1,2,3]
decodeString (list bool) "[true,false]" == Ok [True,False]
-}
list : Decoder a -> Decoder (List a)
list decoder =
Native.Json.decodeContainer "list" decoder
{-| Decode a JSON array into an Elm `Array`.
decodeString (array int) "[1,2,3]" == Ok (Array.fromList [1,2,3])
decodeString (array bool) "[true,false]" == Ok (Array.fromList [True,False])
-}
array : Decoder a -> Decoder (Array a)
array decoder =
Native.Json.decodeContainer "array" decoder
{-| Decode a JSON object into an Elm `Dict`.
decodeString (dict int) "{ \"alice\": 42, \"bob\": 99 }"
== Dict.fromList [("alice", 42), ("bob", 99)]
-}
dict : Decoder a -> Decoder (Dict String a)
dict decoder =
map Dict.fromList (keyValuePairs decoder)
{-| Decode a JSON object into an Elm `List` of pairs.
decodeString (keyValuePairs int) "{ \"alice\": 42, \"bob\": 99 }"
== [("alice", 42), ("bob", 99)]
-}
keyValuePairs : Decoder a -> Decoder (List (String, a))
keyValuePairs =
Native.Json.decodeKeyValuePairs
-- OBJECT PRIMITIVES
{-| Decode a JSON object, requiring a particular field.
decodeString (field "x" int) "{ \"x\": 3 }" == Ok 3
decodeString (field "x" int) "{ \"x\": 3, \"y\": 4 }" == Ok 3
decodeString (field "x" int) "{ \"x\": true }" == Err ...
decodeString (field "x" int) "{ \"y\": 4 }" == Err ...
decodeString (field "name" string) "{ \"name\": \"tom\" }" == Ok "tom"
The object *can* have other fields. Lots of them! The only thing this decoder
cares about is if `x` is present and that the value there is an `Int`.
Check out [`map2`](#map2) to see how to decode multiple fields!
-}
field : String -> Decoder a -> Decoder a
field =
Native.Json.decodeField
{-| Decode a nested JSON object, requiring certain fields.
json = """{ "person": { "name": "tom", "age": 42 } }"""
decodeString (at ["person", "name"] string) json == Ok "tom"
decodeString (at ["person", "age" ] int ) json == Ok "42
This is really just a shorthand for saying things like:
field "person" (field "name" string) == at ["person","name"] string
-}
at : List String -> Decoder a -> Decoder a
at fields decoder =
List.foldr field decoder fields
{-| Decode a JSON array, requiring a particular index.
json = """[ "alice", "bob", "chuck" ]"""
decodeString (index 0 string) json == Ok "alice"
decodeString (index 1 string) json == Ok "bob"
decodeString (index 2 string) json == Ok "chuck"
decodeString (index 3 string) json == Err ...
-}
index : Int -> Decoder a -> Decoder a
index =
Native.Json.decodeIndex
-- WEIRD STRUCTURE
{-| Helpful for dealing with optional fields. Here are a few slightly different
examples:
json = """{ "name": "tom", "age": 42 }"""
decodeString (maybe (field "age" int )) json == Ok (Just 42)
decodeString (maybe (field "name" int )) json == Ok Nothing
decodeString (maybe (field "height" float)) json == Ok Nothing
decodeString (field "age" (maybe int )) json == Ok (Just 42)
decodeString (field "name" (maybe int )) json == Ok Nothing
decodeString (field "height" (maybe float)) json == Err ...
Notice the last example! It is saying we *must* have a field named `height` and
the content *may* be a float. There is no `height` field, so the decoder fails.
Point is, `maybe` will make exactly what it contains conditional. For optional
fields, this means you probably want it *outside* a use of `field` or `at`.
-}
maybe : Decoder a -> Decoder (Maybe a)
maybe decoder =
Native.Json.decodeContainer "maybe" decoder
{-| Try a bunch of different decoders. This can be useful if the JSON may come
in a couple different formats. For example, say you want to read an array of
numbers, but some of them are `null`.
import String
badInt : Decoder Int
badInt =
oneOf [ int, null 0 ]
-- decodeString (list badInt) "[1,2,null,4]" == Ok [1,2,0,4]
Why would someone generate JSON like this? Questions like this are not good
for your health. The point is that you can use `oneOf` to handle situations
like this!
You could also use `oneOf` to help version your data. Try the latest format,
then a few older ones that you still support. You could use `andThen` to be
even more particular if you wanted.
-}
oneOf : List (Decoder a) -> Decoder a
oneOf =
Native.Json.oneOf
-- MAPPING
{-| Transform a decoder. Maybe you just want to know the length of a string:
import String
stringLength : Decoder Int
stringLength =
map String.length string
It is often helpful to use `map` with `oneOf`, like when defining `nullable`:
nullable : Decoder a -> Decoder (Maybe a)
nullable decoder =
oneOf
[ null Nothing
, map Just decoder
]
-}
map : (a -> value) -> Decoder a -> Decoder value
map =
Native.Json.map1
{-| Try two decoders and then combine the result. We can use this to decode
objects with many fields:
type alias Point = { x : Float, y : Float }
point : Decoder Point
point =
map2 Point
(field "x" float)
(field "y" float)
-- decodeString point """{ "x": 3, "y": 4 }""" == Ok { x = 3, y = 4 }
It tries each individual decoder and puts the result together with the `Point`
constructor.
-}
map2 : (a -> b -> value) -> Decoder a -> Decoder b -> Decoder value
map2 =
Native.Json.map2
{-| Try three decoders and then combine the result. We can use this to decode
objects with many fields:
type alias Person = { name : String, age : Int, height : Float }
person : Decoder Person
person =
map3 Person
(at ["name"] string)
(at ["info","age"] int)
(at ["info","height"] float)
-- json = """{ "name": "tom", "info": { "age": 42, "height": 1.8 } }"""
-- decodeString person json == Ok { name = "tom", age = 42, height = 1.8 }
Like `map2` it tries each decoder in order and then give the results to the
`Person` constructor. That can be any function though!
-}
map3 : (a -> b -> c -> value) -> Decoder a -> Decoder b -> Decoder c -> Decoder value
map3 =
Native.Json.map3
{-|-}
map4 : (a -> b -> c -> d -> value) -> Decoder a -> Decoder b -> Decoder c -> Decoder d -> Decoder value
map4 =
Native.Json.map4
{-|-}
map5 : (a -> b -> c -> d -> e -> value) -> Decoder a -> Decoder b -> Decoder c -> Decoder d -> Decoder e -> Decoder value
map5 =
Native.Json.map5
{-|-}
map6 : (a -> b -> c -> d -> e -> f -> value) -> Decoder a -> Decoder b -> Decoder c -> Decoder d -> Decoder e -> Decoder f -> Decoder value
map6 =
Native.Json.map6
{-|-}
map7 : (a -> b -> c -> d -> e -> f -> g -> value) -> Decoder a -> Decoder b -> Decoder c -> Decoder d -> Decoder e -> Decoder f -> Decoder g -> Decoder value
map7 =
Native.Json.map7
{-|-}
map8 : (a -> b -> c -> d -> e -> f -> g -> h -> value) -> Decoder a -> Decoder b -> Decoder c -> Decoder d -> Decoder e -> Decoder f -> Decoder g -> Decoder h -> Decoder value
map8 =
Native.Json.map8
-- RUN DECODERS
{-| Parse the given string into a JSON value and then run the `Decoder` on it.
This will fail if the string is not well-formed JSON or if the `Decoder`
fails for some reason.
decodeString int "4" == Ok 4
decodeString int "1 + 2" == Err ...
-}
decodeString : Decoder a -> String -> Result String a
decodeString =
Native.Json.runOnString
{-| Run a `Decoder` on some JSON `Value`. You can send these JSON values
through ports, so that is probably the main time you would use this function.
-}
decodeValue : Decoder a -> Value -> Result String a
decodeValue =
Native.Json.run
{-| A JSON value.
-}
type alias Value = JsEncode.Value
-- FANCY PRIMITIVES
{-| Ignore the JSON and produce a certain Elm value.
decodeString (succeed 42) "true" == Ok 42
decodeString (succeed 42) "[1,2,3]" == Ok 42
decodeString (succeed 42) "hello" == Err ... -- this is not a valid JSON string
This is handy when used with `oneOf` or `andThen`.
-}
succeed : a -> Decoder a
succeed =
Native.Json.succeed
{-| Ignore the JSON and make the decoder fail. This is handy when used with
`oneOf` or `andThen` where you want to give a custom error message in some
case.
See the [`andThen`](#andThen) docs for an example.
-}
fail : String -> Decoder a
fail =
Native.Json.fail
{-| Create decoders that depend on previous results. If you are creating
versioned data, you might do something like this:
info : Decoder Info
info =
field "version" int
|> andThen infoHelp
infoHelp : Int -> Decoder Info
infoHelp version =
case version of
4 ->
infoDecoder4
3 ->
infoDecoder3
_ ->
fail <|
"Trying to decode info, but version "
++ toString version ++ " is not supported."
-- infoDecoder4 : Decoder Info
-- infoDecoder3 : Decoder Info
-}
andThen : (a -> Decoder b) -> Decoder a -> Decoder b
andThen =
Native.Json.andThen
{-| Sometimes you have JSON with recursive structure, like nested comments.
You can use `lazy` to make sure your decoder unrolls lazily.
type alias Comment =
{ message : String
, responses : Responses
}
type Responses = Responses (List Comment)
comment : Decoder Comment
comment =
map2 Comment
(field "message" string)
(field "responses" (map Responses (list (lazy (\_ -> comment)))))
If we had said `list comment` instead, we would start expanding the value
infinitely. What is a `comment`? It is a decoder for objects where the
`responses` field contains comments. What is a `comment` though? Etc.
By using `list (lazy (\_ -> comment))` we make sure the decoder only expands
to be as deep as the JSON we are given. You can read more about recursive data
structures [here][].
[here]: https://github.com/elm-lang/elm-compiler/blob/master/hints/recursive-alias.md
-}
lazy : (() -> Decoder a) -> Decoder a
lazy thunk =
andThen thunk (succeed ())
{-| Do not do anything with a JSON value, just bring it into Elm as a `Value`.
This can be useful if you have particularly crazy data that you would like to
deal with later. Or if you are going to send it out a port and do not care
about its structure.
-}
value : Decoder Value
value =
Native.Json.decodePrimitive "value"
{-| Decode a `null` value into some Elm value.
decodeString (null False) "null" == Ok False
decodeString (null 42) "null" == Ok 42
decodeString (null 42) "42" == Err ..
decodeString (null 42) "false" == Err ..
So if you ever see a `null`, this will return whatever value you specified.
-}
null : a -> Decoder a
null =
Native.Json.decodeNull

102
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Json/Encode.elm vendored Normal file
View File

@@ -0,0 +1,102 @@
module Json.Encode exposing
( Value
, encode
, string, int, float, bool, null
, list, array
, object
)
{-| Library for turning Elm values into Json values.
# Encoding
@docs encode, Value
# Primitives
@docs string, int, float, bool, null
# Arrays
@docs list, array
# Objects
@docs object
-}
import Array exposing (Array)
import Native.Json
{-| Represents a JavaScript value.
-}
type Value = Value
{-| Convert a `Value` into a prettified string. The first argument specifies
the amount of indentation in the resulting string.
person =
object
[ ("name", string "Tom")
, ("age", int 42)
]
compact = encode 0 person
-- {"name":"Tom","age":42}
readable = encode 4 person
-- {
-- "name": "Tom",
-- "age": 42
-- }
-}
encode : Int -> Value -> String
encode =
Native.Json.encode
{-|-}
string : String -> Value
string =
Native.Json.identity
{-|-}
int : Int -> Value
int =
Native.Json.identity
{-| Encode a Float. `Infinity` and `NaN` are encoded as `null`.
-}
float : Float -> Value
float =
Native.Json.identity
{-|-}
bool : Bool -> Value
bool =
Native.Json.identity
{-|-}
null : Value
null =
Native.Json.encodeNull
{-|-}
object : List (String, Value) -> Value
object =
Native.Json.encodeObject
{-|-}
array : Array Value -> Value
array =
Native.Json.encodeArray
{-|-}
list : List Value -> Value
list =
Native.Json.encodeList

613
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/List.elm vendored Normal file
View File

@@ -0,0 +1,613 @@
module List exposing
( isEmpty, length, reverse, member
, head, tail, filter, take, drop
, singleton, repeat, range, (::), append, concat, intersperse
, partition, unzip
, map, map2, map3, map4, map5
, filterMap, concatMap, indexedMap
, foldr, foldl
, sum, product, maximum, minimum, all, any, scanl
, sort, sortBy, sortWith
)
{-| A library for manipulating lists of values. Every value in a
list must have the same type.
# Basics
@docs isEmpty, length, reverse, member
# Sub-lists
@docs head, tail, filter, take, drop
# Putting Lists Together
@docs singleton, repeat, range, (::), append, concat, intersperse
# Taking Lists Apart
@docs partition, unzip
# Mapping
@docs map, map2, map3, map4, map5
If you can think of a legitimate use of `mapN` where `N` is 6 or more, please
let us know on [the list](https://groups.google.com/forum/#!forum/elm-discuss).
The current sentiment is that it is already quite error prone once you get to
4 and possibly should be approached another way.
# Special Maps
@docs filterMap, concatMap, indexedMap
# Folding
@docs foldr, foldl
# Special Folds
@docs sum, product, maximum, minimum, all, any, scanl
# Sorting
@docs sort, sortBy, sortWith
-}
import Basics exposing (..)
import Maybe
import Maybe exposing ( Maybe(Just,Nothing) )
import Native.List
{-| Add an element to the front of a list. Pronounced *cons*.
1 :: [2,3] == [1,2,3]
1 :: [] == [1]
-}
(::) : a -> List a -> List a
(::) =
Native.List.cons
infixr 5 ::
{-| Extract the first element of a list.
head [1,2,3] == Just 1
head [] == Nothing
-}
head : List a -> Maybe a
head list =
case list of
x :: xs ->
Just x
[] ->
Nothing
{-| Extract the rest of the list.
tail [1,2,3] == Just [2,3]
tail [] == Nothing
-}
tail : List a -> Maybe (List a)
tail list =
case list of
x :: xs ->
Just xs
[] ->
Nothing
{-| Determine if a list is empty.
isEmpty [] == True
-}
isEmpty : List a -> Bool
isEmpty xs =
case xs of
[] ->
True
_ ->
False
{-| Figure out whether a list contains a value.
member 9 [1,2,3,4] == False
member 4 [1,2,3,4] == True
-}
member : a -> List a -> Bool
member x xs =
any (\a -> a == x) xs
{-| Apply a function to every element of a list.
map sqrt [1,4,9] == [1,2,3]
map not [True,False,True] == [False,True,False]
-}
map : (a -> b) -> List a -> List b
map f xs =
foldr (\x acc -> f x :: acc) [] xs
{-| Same as `map` but the function is also applied to the index of each
element (starting at zero).
indexedMap (,) ["Tom","Sue","Bob"] == [ (0,"Tom"), (1,"Sue"), (2,"Bob") ]
-}
indexedMap : (Int -> a -> b) -> List a -> List b
indexedMap f xs =
map2 f (range 0 (length xs - 1)) xs
{-| Reduce a list from the left.
foldl (::) [] [1,2,3] == [3,2,1]
-}
foldl : (a -> b -> b) -> b -> List a -> b
foldl func acc list =
case list of
[] ->
acc
x :: xs ->
foldl func (func x acc) xs
{-| Reduce a list from the right.
foldr (+) 0 [1,2,3] == 6
-}
foldr : (a -> b -> b) -> b -> List a -> b
foldr =
Native.List.foldr
{-| Reduce a list from the left, building up all of the intermediate results into a list.
scanl (+) 0 [1,2,3,4] == [0,1,3,6,10]
-}
scanl : (a -> b -> b) -> b -> List a -> List b
scanl f b xs =
let
scan1 x accAcc =
case accAcc of
acc :: _ ->
f x acc :: accAcc
[] ->
[] -- impossible
in
reverse (foldl scan1 [b] xs)
{-| Keep only elements that satisfy the predicate.
filter isEven [1,2,3,4,5,6] == [2,4,6]
-}
filter : (a -> Bool) -> List a -> List a
filter pred xs =
let
conditionalCons front back =
if pred front then
front :: back
else
back
in
foldr conditionalCons [] xs
{-| Apply a function that may succeed to all values in the list, but only keep
the successes.
onlyTeens =
filterMap isTeen [3, 15, 12, 18, 24] == [15, 18]
isTeen : Int -> Maybe Int
isTeen n =
if 13 <= n && n <= 19 then
Just n
else
Nothing
-}
filterMap : (a -> Maybe b) -> List a -> List b
filterMap f xs =
foldr (maybeCons f) [] xs
maybeCons : (a -> Maybe b) -> a -> List b -> List b
maybeCons f mx xs =
case f mx of
Just x ->
x :: xs
Nothing ->
xs
{-| Determine the length of a list.
length [1,2,3] == 3
-}
length : List a -> Int
length xs =
foldl (\_ i -> i + 1) 0 xs
{-| Reverse a list.
reverse [1,2,3,4] == [4,3,2,1]
-}
reverse : List a -> List a
reverse list =
foldl (::) [] list
{-| Determine if all elements satisfy the predicate.
all isEven [2,4] == True
all isEven [2,3] == False
all isEven [] == True
-}
all : (a -> Bool) -> List a -> Bool
all isOkay list =
not (any (not << isOkay) list)
{-| Determine if any elements satisfy the predicate.
any isEven [2,3] == True
any isEven [1,3] == False
any isEven [] == False
-}
any : (a -> Bool) -> List a -> Bool
any isOkay list =
case list of
[] ->
False
x :: xs ->
-- note: (isOkay x || any isOkay xs) would not get TCO
if isOkay x then
True
else
any isOkay xs
{-| Put two lists together.
append [1,1,2] [3,5,8] == [1,1,2,3,5,8]
append ['a','b'] ['c'] == ['a','b','c']
You can also use [the `(++)` operator](Basics#++) to append lists.
-}
append : List a -> List a -> List a
append xs ys =
case ys of
[] ->
xs
_ ->
foldr (::) ys xs
{-| Concatenate a bunch of lists into a single list:
concat [[1,2],[3],[4,5]] == [1,2,3,4,5]
-}
concat : List (List a) -> List a
concat lists =
foldr append [] lists
{-| Map a given function onto a list and flatten the resulting lists.
concatMap f xs == concat (map f xs)
-}
concatMap : (a -> List b) -> List a -> List b
concatMap f list =
concat (map f list)
{-| Get the sum of the list elements.
sum [1,2,3,4] == 10
-}
sum : List number -> number
sum numbers =
foldl (+) 0 numbers
{-| Get the product of the list elements.
product [1,2,3,4] == 24
-}
product : List number -> number
product numbers =
foldl (*) 1 numbers
{-| Find the maximum element in a non-empty list.
maximum [1,4,2] == Just 4
maximum [] == Nothing
-}
maximum : List comparable -> Maybe comparable
maximum list =
case list of
x :: xs ->
Just (foldl max x xs)
_ ->
Nothing
{-| Find the minimum element in a non-empty list.
minimum [3,2,1] == Just 1
minimum [] == Nothing
-}
minimum : List comparable -> Maybe comparable
minimum list =
case list of
x :: xs ->
Just (foldl min x xs)
_ ->
Nothing
{-| 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,1,2,3,4,5] == ([0,1,2], [3,4,5])
partition isEven [0,1,2,3,4,5] == ([0,2,4], [1,3,5])
-}
partition : (a -> Bool) -> List a -> (List a, List a)
partition pred list =
let
step x (trues, falses) =
if pred x then
(x :: trues, falses)
else
(trues, x :: falses)
in
foldr step ([],[]) list
{-| Combine two lists, combining them with the given function.
If one list is longer, the extra elements are dropped.
map2 (+) [1,2,3] [1,2,3,4] == [2,4,6]
map2 (,) [1,2,3] ['a','b'] == [ (1,'a'), (2,'b') ]
pairs : List a -> List b -> List (a,b)
pairs lefts rights =
map2 (,) lefts rights
-}
map2 : (a -> b -> result) -> List a -> List b -> List result
map2 =
Native.List.map2
{-|-}
map3 : (a -> b -> c -> result) -> List a -> List b -> List c -> List result
map3 =
Native.List.map3
{-|-}
map4 : (a -> b -> c -> d -> result) -> List a -> List b -> List c -> List d -> List result
map4 =
Native.List.map4
{-|-}
map5 : (a -> b -> c -> d -> e -> result) -> List a -> List b -> List c -> List d -> List e -> List result
map5 =
Native.List.map5
{-| Decompose a list of tuples into a tuple of lists.
unzip [(0, True), (17, False), (1337, True)] == ([0,17,1337], [True,False,True])
-}
unzip : List (a,b) -> (List a, List b)
unzip pairs =
let
step (x,y) (xs,ys) =
(x :: xs, y :: ys)
in
foldr step ([], []) pairs
{-| Places the given value between all members of the given list.
intersperse "on" ["turtles","turtles","turtles"] == ["turtles","on","turtles","on","turtles"]
-}
intersperse : a -> List a -> List a
intersperse sep xs =
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 -> List a -> List a
take n list =
takeFast 0 n list
takeFast : Int -> Int -> List a -> List a
takeFast ctr n list =
if n <= 0 then
[]
else
case ( n, list ) of
( _, [] ) ->
list
( 1, x :: _ ) ->
[ x ]
( 2, x :: y :: _ ) ->
[ x, y ]
( 3, x :: y :: z :: _ ) ->
[ x, y, z ]
( _, x :: y :: z :: w :: tl ) ->
if ctr > 1000 then
x :: y :: z :: w :: takeTailRec (n - 4) tl
else
x :: y :: z :: w :: takeFast (ctr + 1) (n - 4) tl
_ ->
list
takeTailRec : Int -> List a -> List a
takeTailRec n list =
reverse (takeReverse n list [])
takeReverse : Int -> List a -> List a -> List a
takeReverse n list taken =
if n <= 0 then
taken
else
case list of
[] ->
taken
x :: xs ->
takeReverse (n - 1) xs (x :: taken)
{-| Drop the first *n* members of a list.
drop 2 [1,2,3,4] == [3,4]
-}
drop : Int -> List a -> List a
drop n list =
if n <= 0 then
list
else
case list of
[] ->
list
x :: xs ->
drop (n-1) xs
{-| Create a list with only one element:
singleton 1234 == [1234]
singleton "hi" == ["hi"]
-}
singleton : a -> List a
singleton value =
[value]
{-| Create a list with *n* copies of a value:
repeat 3 (0,0) == [(0,0),(0,0),(0,0)]
-}
repeat : Int -> a -> List a
repeat n value =
repeatHelp [] n value
repeatHelp : List a -> Int -> a -> List a
repeatHelp result n value =
if n <= 0 then
result
else
repeatHelp (value :: result) (n-1) value
{-| Create a list of numbers, every element increasing by one.
You give the lowest and highest number that should be in the list.
range 3 6 == [3, 4, 5, 6]
range 3 3 == [3]
range 6 3 == []
-}
range : Int -> Int -> List Int
range lo hi =
rangeHelp lo hi []
rangeHelp : Int -> Int -> List Int -> List Int
rangeHelp lo hi list =
if lo <= hi then
rangeHelp lo (hi - 1) (hi :: list)
else
list
{-| Sort values from lowest to highest
sort [3,1,5] == [1,3,5]
-}
sort : List comparable -> List comparable
sort xs =
sortBy identity xs
{-| Sort values by a derived property.
alice = { name="Alice", height=1.62 }
bob = { name="Bob" , height=1.85 }
chuck = { name="Chuck", height=1.76 }
sortBy .name [chuck,alice,bob] == [alice,bob,chuck]
sortBy .height [chuck,alice,bob] == [alice,chuck,bob]
sortBy String.length ["mouse","cat"] == ["cat","mouse"]
-}
sortBy : (a -> comparable) -> List a -> List a
sortBy =
Native.List.sortBy
{-| Sort values with a custom comparison function.
sortWith flippedComparison [1,2,3,4,5] == [5,4,3,2,1]
flippedComparison a b =
case compare a b of
LT -> GT
EQ -> EQ
GT -> LT
This is also the most general sort function, allowing you
to define any other: `sort == sortWith compare`
-}
sortWith : (a -> a -> Order) -> List a -> List a
sortWith =
Native.List.sortWith

157
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Maybe.elm vendored Normal file
View File

@@ -0,0 +1,157 @@
module Maybe exposing
( Maybe(Just,Nothing)
, andThen
, map, map2, map3, map4, map5
, withDefault
)
{-| This library fills a bunch of important niches in Elm. A `Maybe` can help
you with optional arguments, error handling, and records with optional fields.
# Definition
@docs Maybe
# Common Helpers
@docs withDefault, map, map2, map3, map4, map5
# Chaining Maybes
@docs andThen
-}
{-| Represent values that may or may not exist. It can be useful if you have a
record field that is only filled in sometimes. Or if a function takes a value
sometimes, but does not absolutely need it.
-- A person, but maybe we do not know their age.
type alias Person =
{ name : String
, age : Maybe Int
}
tom = { name = "Tom", age = Just 42 }
sue = { name = "Sue", age = Nothing }
-}
type Maybe a
= Just a
| Nothing
{-| Provide a default value, turning an optional value into a normal
value. This comes in handy when paired with functions like
[`Dict.get`](Dict#get) which gives back a `Maybe`.
withDefault 100 (Just 42) -- 42
withDefault 100 Nothing -- 100
withDefault "unknown" (Dict.get "Tom" Dict.empty) -- "unknown"
-}
withDefault : a -> Maybe a -> a
withDefault default maybe =
case maybe of
Just value -> value
Nothing -> default
{-| Transform a `Maybe` value with a given function:
map sqrt (Just 9) == Just 3
map sqrt Nothing == Nothing
-}
map : (a -> b) -> Maybe a -> Maybe b
map f maybe =
case maybe of
Just value -> Just (f value)
Nothing -> Nothing
{-| Apply a function if all the arguments are `Just` a value.
map2 (+) (Just 3) (Just 4) == Just 7
map2 (+) (Just 3) Nothing == Nothing
map2 (+) Nothing (Just 4) == Nothing
-}
map2 : (a -> b -> value) -> Maybe a -> Maybe b -> Maybe value
map2 func ma mb =
case (ma,mb) of
(Just a, Just b) ->
Just (func a b)
_ ->
Nothing
{-|-}
map3 : (a -> b -> c -> value) -> Maybe a -> Maybe b -> Maybe c -> Maybe value
map3 func ma mb mc =
case (ma,mb,mc) of
(Just a, Just b, Just c) ->
Just (func a b c)
_ ->
Nothing
{-|-}
map4 : (a -> b -> c -> d -> value) -> Maybe a -> Maybe b -> Maybe c -> Maybe d -> Maybe value
map4 func ma mb mc md =
case (ma,mb,mc,md) of
(Just a, Just b, Just c, Just d) ->
Just (func a b c d)
_ ->
Nothing
{-|-}
map5 : (a -> b -> c -> d -> e -> value) -> Maybe a -> Maybe b -> Maybe c -> Maybe d -> Maybe e -> Maybe value
map5 func ma mb mc md me =
case (ma,mb,mc,md,me) of
(Just a, Just b, Just c, Just d, Just e) ->
Just (func a b c d e)
_ ->
Nothing
{-| Chain together many computations that may fail. It is helpful to see its
definition:
andThen : (a -> Maybe b) -> Maybe a -> Maybe b
andThen callback maybe =
case maybe of
Just value ->
callback value
Nothing ->
Nothing
This means we only continue with the callback if things are going well. For
example, say you need to use (`head : List Int -> Maybe Int`) to get the
first month from a `List` and then make sure it is between 1 and 12:
toValidMonth : Int -> Maybe Int
toValidMonth month =
if month >= 1 && month <= 12 then
Just month
else
Nothing
getFirstMonth : List Int -> Maybe Int
getFirstMonth months =
head months
|> andThen toValidMonth
If `head` fails and results in `Nothing` (because the `List` was `empty`),
this entire chain of operations will short-circuit and result in `Nothing`.
If `toValidMonth` results in `Nothing`, again the chain of computations
will result in `Nothing`.
-}
andThen : (a -> Maybe b) -> Maybe a -> Maybe b
andThen callback maybeValue =
case maybeValue of
Just value ->
callback value
Nothing ->
Nothing

967
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Native/Array.js vendored Normal file
View File

@@ -0,0 +1,967 @@
//import Native.List //
var _elm_lang$core$Native_Array = function() {
// A RRB-Tree has two distinct data types.
// Leaf -> "height" is always 0
// "table" is an array of elements
// Node -> "height" is always greater than 0
// "table" is an array of child nodes
// "lengths" is an array of accumulated lengths of the child nodes
// M is the maximal table size. 32 seems fast. E is the allowed increase
// of search steps when concatting to find an index. Lower values will
// decrease balancing, but will increase search steps.
var M = 32;
var E = 2;
// An empty array.
var empty = {
ctor: '_Array',
height: 0,
table: []
};
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);
}
function unsafeGet(i, array)
{
for (var x = array.height; x > 0; x--)
{
var slot = i >> (x * 5);
while (array.lengths[slot] <= i)
{
slot++;
}
if (slot > 0)
{
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, array)
{
if (i < 0 || length(array) <= i)
{
return array;
}
return unsafeSet(i, item, array);
}
function unsafeSet(i, item, array)
{
array = nodeCopy(array);
if (array.height === 0)
{
array.table[i] = item;
}
else
{
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.ctor === '[]')
{
return empty;
}
// Allocate M sized blocks (table) and write list elements to it.
var table = new Array(M);
var nodes = [];
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)
{
var leaf = {
ctor: '_Array',
height: 0,
table: table
};
fromListPush(leaf, nodes);
table = new Array(M);
i = 0;
}
}
// Maybe there is something left on the table.
if (i > 0)
{
var leaf = {
ctor: '_Array',
height: 0,
table: table.splice(0, i)
};
fromListPush(leaf, 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)
{
var node = {
ctor: '_Array',
height: h + 1,
table: [],
lengths: []
};
nodes.push(node);
}
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: [],
lengths: []
};
}
}
// Pushes an item via push_ to the bottom right of a tree.
function push(item, a)
{
var pushed = push_(item, a);
if (pushed !== null)
{
return pushed;
}
var newTree = create(item, a.height);
return siblise(a, newTree);
}
// Recursively tries to push an item to the bottom-right most
// tree possible. If there is no space left for the item,
// null will be returned.
function push_(item, a)
{
// Handle resursion stop at leaf level.
if (a.height === 0)
{
if (a.table.length < M)
{
var newA = {
ctor: '_Array',
height: 0,
table: a.table.slice()
};
newA.table.push(item);
return newA;
}
else
{
return null;
}
}
// Recursively push
var pushed = push_(item, botRight(a));
// There was space in the bottom right tree, so the slot will
// be updated.
if (pushed !== null)
{
var newA = nodeCopy(a);
newA.table[newA.table.length - 1] = pushed;
newA.lengths[newA.lengths.length - 1]++;
return newA;
}
// When there was no space left, check if there is space left
// for a new slot with a tree which contains only the item
// at the bottom.
if (a.table.length < M)
{
var newSlot = create(item, a.height - 1);
var newA = nodeCopy(a);
newA.table.push(newSlot);
newA.lengths.push(newA.lengths[newA.lengths.length - 1] + length(newSlot));
return newA;
}
else
{
return null;
}
}
// Converts an array into a list of elements.
function toList(a)
{
return toList_(_elm_lang$core$Native_List.Nil, a);
}
function toList_(list, a)
{
for (var i = a.table.length - 1; i >= 0; i--)
{
list =
a.height === 0
? _elm_lang$core$Native_List.Cons(a.table[i], list)
: toList_(list, a.table[i]);
}
return list;
}
// Maps a function over the elements of an array.
function map(f, a)
{
var newA = {
ctor: '_Array',
height: a.height,
table: new Array(a.table.length)
};
if (a.height > 0)
{
newA.lengths = a.lengths;
}
for (var i = 0; i < a.table.length; i++)
{
newA.table[i] =
a.height === 0
? f(a.table[i])
: map(f, a.table[i]);
}
return newA;
}
// Maps a function over the elements with their index as first argument.
function indexedMap(f, a)
{
return indexedMap_(f, a, 0);
}
function indexedMap_(f, a, from)
{
var newA = {
ctor: '_Array',
height: a.height,
table: new Array(a.table.length)
};
if (a.height > 0)
{
newA.lengths = a.lengths;
}
for (var i = 0; i < a.table.length; i++)
{
newA.table[i] =
a.height === 0
? A2(f, from + i, a.table[i])
: indexedMap_(f, a.table[i], i == 0 ? from : from + a.lengths[i - 1]);
}
return newA;
}
function foldl(f, b, a)
{
if (a.height === 0)
{
for (var i = 0; i < a.table.length; i++)
{
b = A2(f, a.table[i], b);
}
}
else
{
for (var i = 0; i < a.table.length; i++)
{
b = foldl(f, b, a.table[i]);
}
}
return b;
}
function foldr(f, b, a)
{
if (a.height === 0)
{
for (var i = a.table.length; i--; )
{
b = A2(f, a.table[i], b);
}
}
else
{
for (var i = a.table.length; i--; )
{
b = foldr(f, b, a.table[i]);
}
}
return b;
}
// TODO: currently, it slices the right, then the left. This can be
// optimized.
function slice(from, to, a)
{
if (from < 0)
{
from += length(a);
}
if (to < 0)
{
to += length(a);
}
return sliceLeft(from, sliceRight(to, a));
}
function sliceRight(to, a)
{
if (to === length(a))
{
return a;
}
// Handle leaf level.
if (a.height === 0)
{
var newA = { ctor:'_Array', height:0 };
newA.table = a.table.slice(0, to);
return newA;
}
// Slice the right recursively.
var right = getSlot(to, a);
var sliced = sliceRight(to - (right > 0 ? a.lengths[right - 1] : 0), a.table[right]);
// Maybe the a node is not even needed, as sliced contains the whole slice.
if (right === 0)
{
return sliced;
}
// Create new node.
var newA = {
ctor: '_Array',
height: a.height,
table: a.table.slice(0, right),
lengths: a.lengths.slice(0, right)
};
if (sliced.table.length > 0)
{
newA.table[right] = sliced;
newA.lengths[right] = length(sliced) + (right > 0 ? newA.lengths[right - 1] : 0);
}
return newA;
}
function sliceLeft(from, a)
{
if (from === 0)
{
return a;
}
// Handle leaf level.
if (a.height === 0)
{
var newA = { ctor:'_Array', height:0 };
newA.table = a.table.slice(from, a.table.length + 1);
return newA;
}
// Slice the left recursively.
var left = getSlot(from, a);
var sliced = sliceLeft(from - (left > 0 ? a.lengths[left - 1] : 0), a.table[left]);
// Maybe the a node is not even needed, as sliced contains the whole slice.
if (left === a.table.length - 1)
{
return sliced;
}
// Create new node.
var newA = {
ctor: '_Array',
height: a.height,
table: a.table.slice(left, a.table.length + 1),
lengths: new Array(a.table.length - left)
};
newA.table[0] = sliced;
var len = 0;
for (var i = 0; i < newA.table.length; i++)
{
len += length(newA.table[i]);
newA.lengths[i] = len;
}
return newA;
}
// Appends two trees.
function append(a,b)
{
if (a.table.length === 0)
{
return b;
}
if (b.table.length === 0)
{
return a;
}
var c = append_(a, b);
// Check if both nodes can be crunshed together.
if (c[0].table.length + c[1].table.length <= M)
{
if (c[0].table.length === 0)
{
return c[1];
}
if (c[1].table.length === 0)
{
return c[0];
}
// Adjust .table and .lengths
c[0].table = c[0].table.concat(c[1].table);
if (c[0].height > 0)
{
var len = length(c[0]);
for (var i = 0; i < c[1].lengths.length; i++)
{
c[1].lengths[i] += len;
}
c[0].lengths = c[0].lengths.concat(c[1].lengths);
}
return c[0];
}
if (c[0].height > 0)
{
var toRemove = calcToRemove(a, b);
if (toRemove > E)
{
c = shuffle(c[0], c[1], toRemove);
}
}
return siblise(c[0], c[1]);
}
// Returns an array of two nodes; right and left. One node _may_ be empty.
function append_(a, b)
{
if (a.height === 0 && b.height === 0)
{
return [a, b];
}
if (a.height !== 1 || b.height !== 1)
{
if (a.height === b.height)
{
a = nodeCopy(a);
b = nodeCopy(b);
var appended = append_(botRight(a), botLeft(b));
insertRight(a, appended[1]);
insertLeft(b, appended[0]);
}
else if (a.height > b.height)
{
a = nodeCopy(a);
var appended = append_(botRight(a), b);
insertRight(a, appended[0]);
b = parentise(appended[1], appended[1].height + 1);
}
else
{
b = nodeCopy(b);
var appended = append_(a, botLeft(b));
var left = appended[0].table.length === 0 ? 0 : 1;
var right = left === 0 ? 1 : 0;
insertLeft(b, appended[left]);
a = parentise(appended[right], appended[right].height + 1);
}
}
// Check if balancing is needed and return based on that.
if (a.table.length === 0 || b.table.length === 0)
{
return [a, b];
}
var toRemove = calcToRemove(a, b);
if (toRemove <= E)
{
return [a, b];
}
return shuffle(a, b, toRemove);
}
// Helperfunctions for append_. Replaces a child node at the side of the parent.
function insertRight(parent, node)
{
var index = parent.table.length - 1;
parent.table[index] = node;
parent.lengths[index] = length(node);
parent.lengths[index] += index > 0 ? parent.lengths[index - 1] : 0;
}
function insertLeft(parent, node)
{
if (node.table.length > 0)
{
parent.table[0] = node;
parent.lengths[0] = length(node);
var len = length(parent.table[0]);
for (var i = 1; i < parent.lengths.length; i++)
{
len += length(parent.table[i]);
parent.lengths[i] = len;
}
}
else
{
parent.table.shift();
for (var i = 1; i < parent.lengths.length; i++)
{
parent.lengths[i] = parent.lengths[i] - parent.lengths[0];
}
parent.lengths.shift();
}
}
// Returns the extra search steps for E. Refer to the paper.
function calcToRemove(a, b)
{
var subLengths = 0;
for (var i = 0; i < a.table.length; i++)
{
subLengths += a.table[i].table.length;
}
for (var i = 0; i < b.table.length; i++)
{
subLengths += b.table[i].table.length;
}
var toRemove = a.table.length + b.table.length;
return toRemove - (Math.floor((subLengths - 1) / M) + 1);
}
// get2, set2 and saveSlot are helpers for accessing elements over two arrays.
function get2(a, b, index)
{
return index < a.length
? a[index]
: b[index - a.length];
}
function set2(a, b, index, value)
{
if (index < a.length)
{
a[index] = value;
}
else
{
b[index - a.length] = value;
}
}
function saveSlot(a, b, index, slot)
{
set2(a.table, b.table, index, slot);
var l = (index === 0 || index === a.lengths.length)
? 0
: get2(a.lengths, a.lengths, index - 1);
set2(a.lengths, b.lengths, index, l + length(slot));
}
// Creates a node or leaf with a given length at their arrays for perfomance.
// Is only used by shuffle.
function createNode(h, length)
{
if (length < 0)
{
length = 0;
}
var a = {
ctor: '_Array',
height: h,
table: new Array(length)
};
if (h > 0)
{
a.lengths = new Array(length);
}
return a;
}
// Returns an array of two balanced nodes.
function shuffle(a, b, toRemove)
{
var newA = createNode(a.height, Math.min(M, a.table.length + b.table.length - toRemove));
var newB = createNode(a.height, newA.table.length - (a.table.length + b.table.length - toRemove));
// Skip the slots with size M. More precise: copy the slot references
// to the new node
var read = 0;
while (get2(a.table, b.table, read).table.length % M === 0)
{
set2(newA.table, newB.table, read, get2(a.table, b.table, read));
set2(newA.lengths, newB.lengths, read, get2(a.lengths, b.lengths, read));
read++;
}
// Pulling items from left to right, caching in a slot before writing
// it into the new nodes.
var write = read;
var slot = new createNode(a.height - 1, 0);
var from = 0;
// If the current slot is still containing data, then there will be at
// least one more write, so we do not break this loop yet.
while (read - write - (slot.table.length > 0 ? 1 : 0) < toRemove)
{
// Find out the max possible items for copying.
var source = get2(a.table, b.table, read);
var to = Math.min(M - slot.table.length, source.table.length);
// Copy and adjust size table.
slot.table = slot.table.concat(source.table.slice(from, to));
if (slot.height > 0)
{
var len = slot.lengths.length;
for (var i = len; i < len + to - from; i++)
{
slot.lengths[i] = length(slot.table[i]);
slot.lengths[i] += (i > 0 ? slot.lengths[i - 1] : 0);
}
}
from += to;
// Only proceed to next slots[i] if the current one was
// fully copied.
if (source.table.length <= to)
{
read++; from = 0;
}
// Only create a new slot if the current one is filled up.
if (slot.table.length === M)
{
saveSlot(newA, newB, write, slot);
slot = createNode(a.height - 1, 0);
write++;
}
}
// Cleanup after the loop. Copy the last slot into the new nodes.
if (slot.table.length > 0)
{
saveSlot(newA, newB, write, slot);
write++;
}
// Shift the untouched slots to the left
while (read < a.table.length + b.table.length )
{
saveSlot(newA, newB, write, get2(a.table, b.table, read));
read++;
write++;
}
return [newA, newB];
}
// Navigation functions
function botRight(a)
{
return a.table[a.table.length - 1];
}
function botLeft(a)
{
return a.table[0];
}
// Copies a node for updating. Note that you should not use this if
// only updating only one of "table" or "lengths" for performance reasons.
function nodeCopy(a)
{
var newA = {
ctor: '_Array',
height: a.height,
table: a.table.slice()
};
if (a.height > 0)
{
newA.lengths = a.lengths.slice();
}
return newA;
}
// Returns how many items are in the tree.
function length(array)
{
if (array.height === 0)
{
return array.table.length;
}
else
{
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 = i >> (5 * a.height);
while (a.lengths[slot] <= i)
{
slot++;
}
return slot;
}
// Recursively creates a tree with a given height containing
// only the given item.
function create(item, h)
{
if (h === 0)
{
return {
ctor: '_Array',
height: 0,
table: [item]
};
}
return {
ctor: '_Array',
height: h,
table: [create(item, h - 1)],
lengths: [1]
};
}
// Recursively creates a tree that contains the given tree.
function parentise(tree, h)
{
if (h === tree.height)
{
return tree;
}
return {
ctor: '_Array',
height: h,
table: [parentise(tree, h - 1)],
lengths: [length(tree)]
};
}
// Emphasizes blood brotherhood beneath two trees.
function siblise(a, b)
{
return {
ctor: '_Array',
height: a.height + 1,
table: [a, b],
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
};
}
return {
empty: empty,
fromList: fromList,
toList: toList,
initialize: F2(initialize),
append: F2(append),
push: F2(push),
slice: F3(slice),
get: F2(get),
set: F3(set),
map: F2(map),
indexedMap: F2(indexedMap),
foldl: F3(foldl),
foldr: F3(foldr),
length: length,
toJSArray: toJSArray,
fromJSArray: fromJSArray
};
}();

141
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Native/Basics.js vendored Normal file
View File

@@ -0,0 +1,141 @@
//import Native.Utils //
var _elm_lang$core$Native_Basics = function() {
function div(a, b)
{
return (a / b) | 0;
}
function rem(a, b)
{
return a % b;
}
function mod(a, b)
{
if (b === 0)
{
throw new Error('Cannot perform mod 0. Division by zero error.');
}
var r = a % b;
var m = a === 0 ? 0 : (b > 0 ? (a >= 0 ? r : r + b) : -mod(-a, -b));
return m === b ? 0 : m;
}
function logBase(base, n)
{
return Math.log(n) / Math.log(base);
}
function negate(n)
{
return -n;
}
function abs(n)
{
return n < 0 ? -n : n;
}
function min(a, b)
{
return _elm_lang$core$Native_Utils.cmp(a, b) < 0 ? a : b;
}
function max(a, b)
{
return _elm_lang$core$Native_Utils.cmp(a, b) > 0 ? a : b;
}
function clamp(lo, hi, n)
{
return _elm_lang$core$Native_Utils.cmp(n, lo) < 0
? lo
: _elm_lang$core$Native_Utils.cmp(n, hi) > 0
? hi
: n;
}
var ord = ['LT', 'EQ', 'GT'];
function compare(x, y)
{
return { ctor: ord[_elm_lang$core$Native_Utils.cmp(x, y) + 1] };
}
function xor(a, b)
{
return a !== b;
}
function not(b)
{
return !b;
}
function isInfinite(n)
{
return n === Infinity || n === -Infinity;
}
function truncate(n)
{
return n | 0;
}
function degrees(d)
{
return d * Math.PI / 180;
}
function turns(t)
{
return 2 * Math.PI * t;
}
function fromPolar(point)
{
var r = point._0;
var t = point._1;
return _elm_lang$core$Native_Utils.Tuple2(r * Math.cos(t), r * Math.sin(t));
}
function toPolar(point)
{
var x = point._0;
var y = point._1;
return _elm_lang$core$Native_Utils.Tuple2(Math.sqrt(x * x + y * y), Math.atan2(y, x));
}
return {
div: F2(div),
rem: F2(rem),
mod: F2(mod),
pi: Math.PI,
e: Math.E,
cos: Math.cos,
sin: Math.sin,
tan: Math.tan,
acos: Math.acos,
asin: Math.asin,
atan: Math.atan,
atan2: F2(Math.atan2),
degrees: degrees,
turns: turns,
fromPolar: fromPolar,
toPolar: toPolar,
sqrt: Math.sqrt,
logBase: F2(logBase),
negate: negate,
abs: abs,
min: F2(min),
max: F2(max),
clamp: F3(clamp),
compare: F2(compare),
xor: F2(xor),
not: not,
truncate: truncate,
ceiling: Math.ceil,
floor: Math.floor,
round: Math.round,
toFloat: function(x) { return x; },
isNaN: isNaN,
isInfinite: isInfinite
};
}();

13
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Native/Bitwise.js vendored Normal file
View File

@@ -0,0 +1,13 @@
var _elm_lang$core$Native_Bitwise = function() {
return {
and: F2(function and(a, b) { return a & b; }),
or: F2(function or(a, b) { return a | b; }),
xor: F2(function xor(a, b) { return a ^ b; }),
complement: function complement(a) { return ~a; },
shiftLeftBy: F2(function(offset, a) { return a << offset; }),
shiftRightBy: F2(function(offset, a) { return a >> offset; }),
shiftRightZfBy: F2(function(offset, a) { return a >>> offset; })
};
}();

14
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Native/Char.js vendored Normal file
View File

@@ -0,0 +1,14 @@
//import Native.Utils //
var _elm_lang$core$Native_Char = function() {
return {
fromCode: function(c) { return _elm_lang$core$Native_Utils.chr(String.fromCharCode(c)); },
toCode: function(c) { return c.charCodeAt(0); },
toUpper: function(c) { return _elm_lang$core$Native_Utils.chr(c.toUpperCase()); },
toLower: function(c) { return _elm_lang$core$Native_Utils.chr(c.toLowerCase()); },
toLocaleUpper: function(c) { return _elm_lang$core$Native_Utils.chr(c.toLocaleUpperCase()); },
toLocaleLower: function(c) { return _elm_lang$core$Native_Utils.chr(c.toLocaleLowerCase()); }
};
}();

33
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Native/Date.js vendored Normal file
View File

@@ -0,0 +1,33 @@
//import Result //
var _elm_lang$core$Native_Date = function() {
function fromString(str)
{
var date = new Date(str);
return isNaN(date.getTime())
? _elm_lang$core$Result$Err('Unable to parse \'' + str + '\' as a date. Dates must be in the ISO 8601 format.')
: _elm_lang$core$Result$Ok(date);
}
var dayTable = ['Sun', 'Mon', 'Tue', 'Wed', 'Thu', 'Fri', 'Sat'];
var monthTable =
['Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'];
return {
fromString: fromString,
year: function(d) { return d.getFullYear(); },
month: function(d) { return { ctor: monthTable[d.getMonth()] }; },
day: function(d) { return d.getDate(); },
hour: function(d) { return d.getHours(); },
minute: function(d) { return d.getMinutes(); },
second: function(d) { return d.getSeconds(); },
millisecond: function(d) { return d.getMilliseconds(); },
toTime: function(d) { return d.getTime(); },
fromTime: function(t) { return new Date(t); },
dayOfWeek: function(d) { return { ctor: dayTable[d.getDay()] }; }
};
}();

30
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Native/Debug.js vendored Normal file
View File

@@ -0,0 +1,30 @@
//import Native.Utils //
var _elm_lang$core$Native_Debug = function() {
function log(tag, value)
{
var msg = tag + ': ' + _elm_lang$core$Native_Utils.toString(value);
var process = process || {};
if (process.stdout)
{
process.stdout.write(msg);
}
else
{
console.log(msg);
}
return value;
}
function crash(message)
{
throw new Error(message);
}
return {
crash: crash,
log: F2(log)
};
}();

575
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Native/Json.js vendored Normal file
View File

@@ -0,0 +1,575 @@
//import Maybe, Native.Array, Native.List, Native.Utils, Result //
var _elm_lang$core$Native_Json = function() {
// CORE DECODERS
function succeed(msg)
{
return {
ctor: '<decoder>',
tag: 'succeed',
msg: msg
};
}
function fail(msg)
{
return {
ctor: '<decoder>',
tag: 'fail',
msg: msg
};
}
function decodePrimitive(tag)
{
return {
ctor: '<decoder>',
tag: tag
};
}
function decodeContainer(tag, decoder)
{
return {
ctor: '<decoder>',
tag: tag,
decoder: decoder
};
}
function decodeNull(value)
{
return {
ctor: '<decoder>',
tag: 'null',
value: value
};
}
function decodeField(field, decoder)
{
return {
ctor: '<decoder>',
tag: 'field',
field: field,
decoder: decoder
};
}
function decodeIndex(index, decoder)
{
return {
ctor: '<decoder>',
tag: 'index',
index: index,
decoder: decoder
};
}
function decodeKeyValuePairs(decoder)
{
return {
ctor: '<decoder>',
tag: 'key-value',
decoder: decoder
};
}
function mapMany(f, decoders)
{
return {
ctor: '<decoder>',
tag: 'map-many',
func: f,
decoders: decoders
};
}
function andThen(callback, decoder)
{
return {
ctor: '<decoder>',
tag: 'andThen',
decoder: decoder,
callback: callback
};
}
function oneOf(decoders)
{
return {
ctor: '<decoder>',
tag: 'oneOf',
decoders: decoders
};
}
// DECODING OBJECTS
function map1(f, d1)
{
return mapMany(f, [d1]);
}
function map2(f, d1, d2)
{
return mapMany(f, [d1, d2]);
}
function map3(f, d1, d2, d3)
{
return mapMany(f, [d1, d2, d3]);
}
function map4(f, d1, d2, d3, d4)
{
return mapMany(f, [d1, d2, d3, d4]);
}
function map5(f, d1, d2, d3, d4, d5)
{
return mapMany(f, [d1, d2, d3, d4, d5]);
}
function map6(f, d1, d2, d3, d4, d5, d6)
{
return mapMany(f, [d1, d2, d3, d4, d5, d6]);
}
function map7(f, d1, d2, d3, d4, d5, d6, d7)
{
return mapMany(f, [d1, d2, d3, d4, d5, d6, d7]);
}
function map8(f, d1, d2, d3, d4, d5, d6, d7, d8)
{
return mapMany(f, [d1, d2, d3, d4, d5, d6, d7, d8]);
}
// DECODE HELPERS
function ok(value)
{
return { tag: 'ok', value: value };
}
function badPrimitive(type, value)
{
return { tag: 'primitive', type: type, value: value };
}
function badIndex(index, nestedProblems)
{
return { tag: 'index', index: index, rest: nestedProblems };
}
function badField(field, nestedProblems)
{
return { tag: 'field', field: field, rest: nestedProblems };
}
function badIndex(index, nestedProblems)
{
return { tag: 'index', index: index, rest: nestedProblems };
}
function badOneOf(problems)
{
return { tag: 'oneOf', problems: problems };
}
function bad(msg)
{
return { tag: 'fail', msg: msg };
}
function badToString(problem)
{
var context = '_';
while (problem)
{
switch (problem.tag)
{
case 'primitive':
return 'Expecting ' + problem.type
+ (context === '_' ? '' : ' at ' + context)
+ ' but instead got: ' + jsToString(problem.value);
case 'index':
context += '[' + problem.index + ']';
problem = problem.rest;
break;
case 'field':
context += '.' + problem.field;
problem = problem.rest;
break;
case 'oneOf':
var problems = problem.problems;
for (var i = 0; i < problems.length; i++)
{
problems[i] = badToString(problems[i]);
}
return 'I ran into the following problems'
+ (context === '_' ? '' : ' at ' + context)
+ ':\n\n' + problems.join('\n');
case 'fail':
return 'I ran into a `fail` decoder'
+ (context === '_' ? '' : ' at ' + context)
+ ': ' + problem.msg;
}
}
}
function jsToString(value)
{
return value === undefined
? 'undefined'
: JSON.stringify(value);
}
// DECODE
function runOnString(decoder, string)
{
var json;
try
{
json = JSON.parse(string);
}
catch (e)
{
return _elm_lang$core$Result$Err('Given an invalid JSON: ' + e.message);
}
return run(decoder, json);
}
function run(decoder, value)
{
var result = runHelp(decoder, value);
return (result.tag === 'ok')
? _elm_lang$core$Result$Ok(result.value)
: _elm_lang$core$Result$Err(badToString(result));
}
function runHelp(decoder, value)
{
switch (decoder.tag)
{
case 'bool':
return (typeof value === 'boolean')
? ok(value)
: badPrimitive('a Bool', value);
case 'int':
if (typeof value !== 'number') {
return badPrimitive('an Int', value);
}
if (-2147483647 < value && value < 2147483647 && (value | 0) === value) {
return ok(value);
}
if (isFinite(value) && !(value % 1)) {
return ok(value);
}
return badPrimitive('an Int', value);
case 'float':
return (typeof value === 'number')
? ok(value)
: badPrimitive('a Float', value);
case 'string':
return (typeof value === 'string')
? ok(value)
: (value instanceof String)
? ok(value + '')
: badPrimitive('a String', value);
case 'null':
return (value === null)
? ok(decoder.value)
: badPrimitive('null', value);
case 'value':
return ok(value);
case 'list':
if (!(value instanceof Array))
{
return badPrimitive('a List', value);
}
var list = _elm_lang$core$Native_List.Nil;
for (var i = value.length; i--; )
{
var result = runHelp(decoder.decoder, value[i]);
if (result.tag !== 'ok')
{
return badIndex(i, result)
}
list = _elm_lang$core$Native_List.Cons(result.value, list);
}
return ok(list);
case 'array':
if (!(value instanceof Array))
{
return badPrimitive('an Array', value);
}
var len = value.length;
var array = new Array(len);
for (var i = len; i--; )
{
var result = runHelp(decoder.decoder, value[i]);
if (result.tag !== 'ok')
{
return badIndex(i, result);
}
array[i] = result.value;
}
return ok(_elm_lang$core$Native_Array.fromJSArray(array));
case 'maybe':
var result = runHelp(decoder.decoder, value);
return (result.tag === 'ok')
? ok(_elm_lang$core$Maybe$Just(result.value))
: ok(_elm_lang$core$Maybe$Nothing);
case 'field':
var field = decoder.field;
if (typeof value !== 'object' || value === null || !(field in value))
{
return badPrimitive('an object with a field named `' + field + '`', value);
}
var result = runHelp(decoder.decoder, value[field]);
return (result.tag === 'ok') ? result : badField(field, result);
case 'index':
var index = decoder.index;
if (!(value instanceof Array))
{
return badPrimitive('an array', value);
}
if (index >= value.length)
{
return badPrimitive('a longer array. Need index ' + index + ' but there are only ' + value.length + ' entries', value);
}
var result = runHelp(decoder.decoder, value[index]);
return (result.tag === 'ok') ? result : badIndex(index, result);
case 'key-value':
if (typeof value !== 'object' || value === null || value instanceof Array)
{
return badPrimitive('an object', value);
}
var keyValuePairs = _elm_lang$core$Native_List.Nil;
for (var key in value)
{
var result = runHelp(decoder.decoder, value[key]);
if (result.tag !== 'ok')
{
return badField(key, result);
}
var pair = _elm_lang$core$Native_Utils.Tuple2(key, result.value);
keyValuePairs = _elm_lang$core$Native_List.Cons(pair, keyValuePairs);
}
return ok(keyValuePairs);
case 'map-many':
var answer = decoder.func;
var decoders = decoder.decoders;
for (var i = 0; i < decoders.length; i++)
{
var result = runHelp(decoders[i], value);
if (result.tag !== 'ok')
{
return result;
}
answer = answer(result.value);
}
return ok(answer);
case 'andThen':
var result = runHelp(decoder.decoder, value);
return (result.tag !== 'ok')
? result
: runHelp(decoder.callback(result.value), value);
case 'oneOf':
var errors = [];
var temp = decoder.decoders;
while (temp.ctor !== '[]')
{
var result = runHelp(temp._0, value);
if (result.tag === 'ok')
{
return result;
}
errors.push(result);
temp = temp._1;
}
return badOneOf(errors);
case 'fail':
return bad(decoder.msg);
case 'succeed':
return ok(decoder.msg);
}
}
// EQUALITY
function equality(a, b)
{
if (a === b)
{
return true;
}
if (a.tag !== b.tag)
{
return false;
}
switch (a.tag)
{
case 'succeed':
case 'fail':
return a.msg === b.msg;
case 'bool':
case 'int':
case 'float':
case 'string':
case 'value':
return true;
case 'null':
return a.value === b.value;
case 'list':
case 'array':
case 'maybe':
case 'key-value':
return equality(a.decoder, b.decoder);
case 'field':
return a.field === b.field && equality(a.decoder, b.decoder);
case 'index':
return a.index === b.index && equality(a.decoder, b.decoder);
case 'map-many':
if (a.func !== b.func)
{
return false;
}
return listEquality(a.decoders, b.decoders);
case 'andThen':
return a.callback === b.callback && equality(a.decoder, b.decoder);
case 'oneOf':
return listEquality(a.decoders, b.decoders);
}
}
function listEquality(aDecoders, bDecoders)
{
var len = aDecoders.length;
if (len !== bDecoders.length)
{
return false;
}
for (var i = 0; i < len; i++)
{
if (!equality(aDecoders[i], bDecoders[i]))
{
return false;
}
}
return true;
}
// ENCODE
function encode(indentLevel, value)
{
return JSON.stringify(value, null, indentLevel);
}
function identity(value)
{
return value;
}
function encodeObject(keyValuePairs)
{
var obj = {};
while (keyValuePairs.ctor !== '[]')
{
var pair = keyValuePairs._0;
obj[pair._0] = pair._1;
keyValuePairs = keyValuePairs._1;
}
return obj;
}
return {
encode: F2(encode),
runOnString: F2(runOnString),
run: F2(run),
decodeNull: decodeNull,
decodePrimitive: decodePrimitive,
decodeContainer: F2(decodeContainer),
decodeField: F2(decodeField),
decodeIndex: F2(decodeIndex),
map1: F2(map1),
map2: F3(map2),
map3: F4(map3),
map4: F5(map4),
map5: F6(map5),
map6: F7(map6),
map7: F8(map7),
map8: F9(map8),
decodeKeyValuePairs: decodeKeyValuePairs,
andThen: F2(andThen),
fail: fail,
succeed: succeed,
oneOf: oneOf,
identity: identity,
encodeNull: null,
encodeArray: _elm_lang$core$Native_Array.toJSArray,
encodeList: _elm_lang$core$Native_List.toArray,
encodeObject: encodeObject,
equality: equality
};
}();

137
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Native/List.js vendored Normal file
View File

@@ -0,0 +1,137 @@
//import Native.Utils //
var _elm_lang$core$Native_List = function() {
var Nil = { ctor: '[]' };
function Cons(hd, tl)
{
return { ctor: '::', _0: hd, _1: tl };
}
function fromArray(arr)
{
var out = Nil;
for (var i = arr.length; i--; )
{
out = Cons(arr[i], out);
}
return out;
}
function toArray(xs)
{
var out = [];
while (xs.ctor !== '[]')
{
out.push(xs._0);
xs = xs._1;
}
return out;
}
function foldr(f, b, xs)
{
var arr = toArray(xs);
var acc = b;
for (var i = arr.length; i--; )
{
acc = A2(f, arr[i], acc);
}
return acc;
}
function map2(f, xs, ys)
{
var arr = [];
while (xs.ctor !== '[]' && ys.ctor !== '[]')
{
arr.push(A2(f, xs._0, ys._0));
xs = xs._1;
ys = ys._1;
}
return fromArray(arr);
}
function map3(f, xs, ys, zs)
{
var arr = [];
while (xs.ctor !== '[]' && ys.ctor !== '[]' && zs.ctor !== '[]')
{
arr.push(A3(f, xs._0, ys._0, zs._0));
xs = xs._1;
ys = ys._1;
zs = zs._1;
}
return fromArray(arr);
}
function map4(f, ws, xs, ys, zs)
{
var arr = [];
while ( ws.ctor !== '[]'
&& xs.ctor !== '[]'
&& ys.ctor !== '[]'
&& zs.ctor !== '[]')
{
arr.push(A4(f, ws._0, xs._0, ys._0, zs._0));
ws = ws._1;
xs = xs._1;
ys = ys._1;
zs = zs._1;
}
return fromArray(arr);
}
function map5(f, vs, ws, xs, ys, zs)
{
var arr = [];
while ( vs.ctor !== '[]'
&& ws.ctor !== '[]'
&& xs.ctor !== '[]'
&& ys.ctor !== '[]'
&& zs.ctor !== '[]')
{
arr.push(A5(f, vs._0, ws._0, xs._0, ys._0, zs._0));
vs = vs._1;
ws = ws._1;
xs = xs._1;
ys = ys._1;
zs = zs._1;
}
return fromArray(arr);
}
function sortBy(f, xs)
{
return fromArray(toArray(xs).sort(function(a, b) {
return _elm_lang$core$Native_Utils.cmp(f(a), f(b));
}));
}
function sortWith(f, xs)
{
return fromArray(toArray(xs).sort(function(a, b) {
var ord = f(a)(b).ctor;
return ord === 'EQ' ? 0 : ord === 'LT' ? -1 : 1;
}));
}
return {
Nil: Nil,
Cons: Cons,
cons: F2(Cons),
toArray: toArray,
fromArray: fromArray,
foldr: F3(foldr),
map2: F3(map2),
map3: F4(map3),
map4: F5(map4),
map5: F6(map5),
sortBy: F2(sortBy),
sortWith: F2(sortWith)
};
}();

559
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Native/Platform.js vendored Normal file
View File

@@ -0,0 +1,559 @@
//import //
var _elm_lang$core$Native_Platform = function() {
// PROGRAMS
function program(impl)
{
return function(flagDecoder)
{
return function(object, moduleName)
{
object['worker'] = function worker(flags)
{
if (typeof flags !== 'undefined')
{
throw new Error(
'The `' + moduleName + '` module does not need flags.\n'
+ 'Call ' + moduleName + '.worker() with no arguments and you should be all set!'
);
}
return initialize(
impl.init,
impl.update,
impl.subscriptions,
renderer
);
};
};
};
}
function programWithFlags(impl)
{
return function(flagDecoder)
{
return function(object, moduleName)
{
object['worker'] = function worker(flags)
{
if (typeof flagDecoder === 'undefined')
{
throw new Error(
'Are you trying to sneak a Never value into Elm? Trickster!\n'
+ 'It looks like ' + moduleName + '.main is defined with `programWithFlags` but has type `Program Never`.\n'
+ 'Use `program` instead if you do not want flags.'
);
}
var result = A2(_elm_lang$core$Native_Json.run, flagDecoder, flags);
if (result.ctor === 'Err')
{
throw new Error(
moduleName + '.worker(...) was called with an unexpected argument.\n'
+ 'I tried to convert it to an Elm value, but ran into this problem:\n\n'
+ result._0
);
}
return initialize(
impl.init(result._0),
impl.update,
impl.subscriptions,
renderer
);
};
};
};
}
function renderer(enqueue, _)
{
return function(_) {};
}
// HTML TO PROGRAM
function htmlToProgram(vnode)
{
var emptyBag = batch(_elm_lang$core$Native_List.Nil);
var noChange = _elm_lang$core$Native_Utils.Tuple2(
_elm_lang$core$Native_Utils.Tuple0,
emptyBag
);
return _elm_lang$virtual_dom$VirtualDom$program({
init: noChange,
view: function(model) { return main; },
update: F2(function(msg, model) { return noChange; }),
subscriptions: function (model) { return emptyBag; }
});
}
// INITIALIZE A PROGRAM
function initialize(init, update, subscriptions, renderer)
{
// ambient state
var managers = {};
var updateView;
// init and update state in main process
var initApp = _elm_lang$core$Native_Scheduler.nativeBinding(function(callback) {
var model = init._0;
updateView = renderer(enqueue, model);
var cmds = init._1;
var subs = subscriptions(model);
dispatchEffects(managers, cmds, subs);
callback(_elm_lang$core$Native_Scheduler.succeed(model));
});
function onMessage(msg, model)
{
return _elm_lang$core$Native_Scheduler.nativeBinding(function(callback) {
var results = A2(update, msg, model);
model = results._0;
updateView(model);
var cmds = results._1;
var subs = subscriptions(model);
dispatchEffects(managers, cmds, subs);
callback(_elm_lang$core$Native_Scheduler.succeed(model));
});
}
var mainProcess = spawnLoop(initApp, onMessage);
function enqueue(msg)
{
_elm_lang$core$Native_Scheduler.rawSend(mainProcess, msg);
}
var ports = setupEffects(managers, enqueue);
return ports ? { ports: ports } : {};
}
// EFFECT MANAGERS
var effectManagers = {};
function setupEffects(managers, callback)
{
var ports;
// setup all necessary effect managers
for (var key in effectManagers)
{
var manager = effectManagers[key];
if (manager.isForeign)
{
ports = ports || {};
ports[key] = manager.tag === 'cmd'
? setupOutgoingPort(key)
: setupIncomingPort(key, callback);
}
managers[key] = makeManager(manager, callback);
}
return ports;
}
function makeManager(info, callback)
{
var router = {
main: callback,
self: undefined
};
var tag = info.tag;
var onEffects = info.onEffects;
var onSelfMsg = info.onSelfMsg;
function onMessage(msg, state)
{
if (msg.ctor === 'self')
{
return A3(onSelfMsg, router, msg._0, state);
}
var fx = msg._0;
switch (tag)
{
case 'cmd':
return A3(onEffects, router, fx.cmds, state);
case 'sub':
return A3(onEffects, router, fx.subs, state);
case 'fx':
return A4(onEffects, router, fx.cmds, fx.subs, state);
}
}
var process = spawnLoop(info.init, onMessage);
router.self = process;
return process;
}
function sendToApp(router, msg)
{
return _elm_lang$core$Native_Scheduler.nativeBinding(function(callback)
{
router.main(msg);
callback(_elm_lang$core$Native_Scheduler.succeed(_elm_lang$core$Native_Utils.Tuple0));
});
}
function sendToSelf(router, msg)
{
return A2(_elm_lang$core$Native_Scheduler.send, router.self, {
ctor: 'self',
_0: msg
});
}
// HELPER for STATEFUL LOOPS
function spawnLoop(init, onMessage)
{
var andThen = _elm_lang$core$Native_Scheduler.andThen;
function loop(state)
{
var handleMsg = _elm_lang$core$Native_Scheduler.receive(function(msg) {
return onMessage(msg, state);
});
return A2(andThen, loop, handleMsg);
}
var task = A2(andThen, loop, init);
return _elm_lang$core$Native_Scheduler.rawSpawn(task);
}
// BAGS
function leaf(home)
{
return function(value)
{
return {
type: 'leaf',
home: home,
value: value
};
};
}
function batch(list)
{
return {
type: 'node',
branches: list
};
}
function map(tagger, bag)
{
return {
type: 'map',
tagger: tagger,
tree: bag
}
}
// PIPE BAGS INTO EFFECT MANAGERS
function dispatchEffects(managers, cmdBag, subBag)
{
var effectsDict = {};
gatherEffects(true, cmdBag, effectsDict, null);
gatherEffects(false, subBag, effectsDict, null);
for (var home in managers)
{
var fx = home in effectsDict
? effectsDict[home]
: {
cmds: _elm_lang$core$Native_List.Nil,
subs: _elm_lang$core$Native_List.Nil
};
_elm_lang$core$Native_Scheduler.rawSend(managers[home], { ctor: 'fx', _0: fx });
}
}
function gatherEffects(isCmd, bag, effectsDict, taggers)
{
switch (bag.type)
{
case 'leaf':
var home = bag.home;
var effect = toEffect(isCmd, home, taggers, bag.value);
effectsDict[home] = insert(isCmd, effect, effectsDict[home]);
return;
case 'node':
var list = bag.branches;
while (list.ctor !== '[]')
{
gatherEffects(isCmd, list._0, effectsDict, taggers);
list = list._1;
}
return;
case 'map':
gatherEffects(isCmd, bag.tree, effectsDict, {
tagger: bag.tagger,
rest: taggers
});
return;
}
}
function toEffect(isCmd, home, taggers, value)
{
function applyTaggers(x)
{
var temp = taggers;
while (temp)
{
x = temp.tagger(x);
temp = temp.rest;
}
return x;
}
var map = isCmd
? effectManagers[home].cmdMap
: effectManagers[home].subMap;
return A2(map, applyTaggers, value)
}
function insert(isCmd, newEffect, effects)
{
effects = effects || {
cmds: _elm_lang$core$Native_List.Nil,
subs: _elm_lang$core$Native_List.Nil
};
if (isCmd)
{
effects.cmds = _elm_lang$core$Native_List.Cons(newEffect, effects.cmds);
return effects;
}
effects.subs = _elm_lang$core$Native_List.Cons(newEffect, effects.subs);
return effects;
}
// PORTS
function checkPortName(name)
{
if (name in effectManagers)
{
throw new Error('There can only be one port named `' + name + '`, but your program has multiple.');
}
}
// OUTGOING PORTS
function outgoingPort(name, converter)
{
checkPortName(name);
effectManagers[name] = {
tag: 'cmd',
cmdMap: outgoingPortMap,
converter: converter,
isForeign: true
};
return leaf(name);
}
var outgoingPortMap = F2(function cmdMap(tagger, value) {
return value;
});
function setupOutgoingPort(name)
{
var subs = [];
var converter = effectManagers[name].converter;
// CREATE MANAGER
var init = _elm_lang$core$Native_Scheduler.succeed(null);
function onEffects(router, cmdList, state)
{
while (cmdList.ctor !== '[]')
{
// grab a separate reference to subs in case unsubscribe is called
var currentSubs = subs;
var value = converter(cmdList._0);
for (var i = 0; i < currentSubs.length; i++)
{
currentSubs[i](value);
}
cmdList = cmdList._1;
}
return init;
}
effectManagers[name].init = init;
effectManagers[name].onEffects = F3(onEffects);
// PUBLIC API
function subscribe(callback)
{
subs.push(callback);
}
function unsubscribe(callback)
{
// copy subs into a new array in case unsubscribe is called within a
// subscribed callback
subs = subs.slice();
var index = subs.indexOf(callback);
if (index >= 0)
{
subs.splice(index, 1);
}
}
return {
subscribe: subscribe,
unsubscribe: unsubscribe
};
}
// INCOMING PORTS
function incomingPort(name, converter)
{
checkPortName(name);
effectManagers[name] = {
tag: 'sub',
subMap: incomingPortMap,
converter: converter,
isForeign: true
};
return leaf(name);
}
var incomingPortMap = F2(function subMap(tagger, finalTagger)
{
return function(value)
{
return tagger(finalTagger(value));
};
});
function setupIncomingPort(name, callback)
{
var sentBeforeInit = [];
var subs = _elm_lang$core$Native_List.Nil;
var converter = effectManagers[name].converter;
var currentOnEffects = preInitOnEffects;
var currentSend = preInitSend;
// CREATE MANAGER
var init = _elm_lang$core$Native_Scheduler.succeed(null);
function preInitOnEffects(router, subList, state)
{
var postInitResult = postInitOnEffects(router, subList, state);
for(var i = 0; i < sentBeforeInit.length; i++)
{
postInitSend(sentBeforeInit[i]);
}
sentBeforeInit = null; // to release objects held in queue
currentSend = postInitSend;
currentOnEffects = postInitOnEffects;
return postInitResult;
}
function postInitOnEffects(router, subList, state)
{
subs = subList;
return init;
}
function onEffects(router, subList, state)
{
return currentOnEffects(router, subList, state);
}
effectManagers[name].init = init;
effectManagers[name].onEffects = F3(onEffects);
// PUBLIC API
function preInitSend(value)
{
sentBeforeInit.push(value);
}
function postInitSend(value)
{
var temp = subs;
while (temp.ctor !== '[]')
{
callback(temp._0(value));
temp = temp._1;
}
}
function send(incomingValue)
{
var result = A2(_elm_lang$core$Json_Decode$decodeValue, converter, incomingValue);
if (result.ctor === 'Err')
{
throw new Error('Trying to send an unexpected type of value through port `' + name + '`:\n' + result._0);
}
currentSend(result._0);
}
return { send: send };
}
return {
// routers
sendToApp: F2(sendToApp),
sendToSelf: F2(sendToSelf),
// global setup
effectManagers: effectManagers,
outgoingPort: outgoingPort,
incomingPort: incomingPort,
htmlToProgram: htmlToProgram,
program: program,
programWithFlags: programWithFlags,
initialize: initialize,
// effect bags
leaf: leaf,
batch: batch,
map: F2(map)
};
}();

119
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Native/Regex.js vendored Normal file
View File

@@ -0,0 +1,119 @@
//import Maybe, Native.List //
var _elm_lang$core$Native_Regex = function() {
function escape(str)
{
return str.replace(/[-\/\\^$*+?.()|[\]{}]/g, '\\$&');
}
function caseInsensitive(re)
{
return new RegExp(re.source, 'gi');
}
function regex(raw)
{
return new RegExp(raw, 'g');
}
function contains(re, string)
{
return string.match(re) !== null;
}
function find(n, re, str)
{
n = n.ctor === 'All' ? Infinity : n._0;
var out = [];
var number = 0;
var string = str;
var lastIndex = re.lastIndex;
var prevLastIndex = -1;
var result;
while (number++ < n && (result = re.exec(string)))
{
if (prevLastIndex === re.lastIndex) break;
var i = result.length - 1;
var subs = new Array(i);
while (i > 0)
{
var submatch = result[i];
subs[--i] = submatch === undefined
? _elm_lang$core$Maybe$Nothing
: _elm_lang$core$Maybe$Just(submatch);
}
out.push({
match: result[0],
submatches: _elm_lang$core$Native_List.fromArray(subs),
index: result.index,
number: number
});
prevLastIndex = re.lastIndex;
}
re.lastIndex = lastIndex;
return _elm_lang$core$Native_List.fromArray(out);
}
function replace(n, re, replacer, string)
{
n = n.ctor === 'All' ? Infinity : n._0;
var count = 0;
function jsReplacer(match)
{
if (count++ >= n)
{
return match;
}
var i = arguments.length - 3;
var submatches = new Array(i);
while (i > 0)
{
var submatch = arguments[i];
submatches[--i] = submatch === undefined
? _elm_lang$core$Maybe$Nothing
: _elm_lang$core$Maybe$Just(submatch);
}
return replacer({
match: match,
submatches: _elm_lang$core$Native_List.fromArray(submatches),
index: arguments[arguments.length - 2],
number: count
});
}
return string.replace(re, jsReplacer);
}
function split(n, re, str)
{
n = n.ctor === 'All' ? Infinity : n._0;
if (n === Infinity)
{
return _elm_lang$core$Native_List.fromArray(str.split(re));
}
var string = str;
var result;
var out = [];
var start = re.lastIndex;
var restoreLastIndex = re.lastIndex;
while (n--)
{
if (!(result = re.exec(string))) break;
out.push(string.slice(start, result.index));
start = re.lastIndex;
}
out.push(string.slice(start));
re.lastIndex = restoreLastIndex;
return _elm_lang$core$Native_List.fromArray(out);
}
return {
regex: regex,
caseInsensitive: caseInsensitive,
escape: escape,
contains: F2(contains),
find: F3(find),
replace: F4(replace),
split: F3(split)
};
}();

281
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Native/Scheduler.js vendored Normal file
View File

@@ -0,0 +1,281 @@
//import Native.Utils //
var _elm_lang$core$Native_Scheduler = function() {
var MAX_STEPS = 10000;
// TASKS
function succeed(value)
{
return {
ctor: '_Task_succeed',
value: value
};
}
function fail(error)
{
return {
ctor: '_Task_fail',
value: error
};
}
function nativeBinding(callback)
{
return {
ctor: '_Task_nativeBinding',
callback: callback,
cancel: null
};
}
function andThen(callback, task)
{
return {
ctor: '_Task_andThen',
callback: callback,
task: task
};
}
function onError(callback, task)
{
return {
ctor: '_Task_onError',
callback: callback,
task: task
};
}
function receive(callback)
{
return {
ctor: '_Task_receive',
callback: callback
};
}
// PROCESSES
function rawSpawn(task)
{
var process = {
ctor: '_Process',
id: _elm_lang$core$Native_Utils.guid(),
root: task,
stack: null,
mailbox: []
};
enqueue(process);
return process;
}
function spawn(task)
{
return nativeBinding(function(callback) {
var process = rawSpawn(task);
callback(succeed(process));
});
}
function rawSend(process, msg)
{
process.mailbox.push(msg);
enqueue(process);
}
function send(process, msg)
{
return nativeBinding(function(callback) {
rawSend(process, msg);
callback(succeed(_elm_lang$core$Native_Utils.Tuple0));
});
}
function kill(process)
{
return nativeBinding(function(callback) {
var root = process.root;
if (root.ctor === '_Task_nativeBinding' && root.cancel)
{
root.cancel();
}
process.root = null;
callback(succeed(_elm_lang$core$Native_Utils.Tuple0));
});
}
function sleep(time)
{
return nativeBinding(function(callback) {
var id = setTimeout(function() {
callback(succeed(_elm_lang$core$Native_Utils.Tuple0));
}, time);
return function() { clearTimeout(id); };
});
}
// STEP PROCESSES
function step(numSteps, process)
{
while (numSteps < MAX_STEPS)
{
var ctor = process.root.ctor;
if (ctor === '_Task_succeed')
{
while (process.stack && process.stack.ctor === '_Task_onError')
{
process.stack = process.stack.rest;
}
if (process.stack === null)
{
break;
}
process.root = process.stack.callback(process.root.value);
process.stack = process.stack.rest;
++numSteps;
continue;
}
if (ctor === '_Task_fail')
{
while (process.stack && process.stack.ctor === '_Task_andThen')
{
process.stack = process.stack.rest;
}
if (process.stack === null)
{
break;
}
process.root = process.stack.callback(process.root.value);
process.stack = process.stack.rest;
++numSteps;
continue;
}
if (ctor === '_Task_andThen')
{
process.stack = {
ctor: '_Task_andThen',
callback: process.root.callback,
rest: process.stack
};
process.root = process.root.task;
++numSteps;
continue;
}
if (ctor === '_Task_onError')
{
process.stack = {
ctor: '_Task_onError',
callback: process.root.callback,
rest: process.stack
};
process.root = process.root.task;
++numSteps;
continue;
}
if (ctor === '_Task_nativeBinding')
{
process.root.cancel = process.root.callback(function(newRoot) {
process.root = newRoot;
enqueue(process);
});
break;
}
if (ctor === '_Task_receive')
{
var mailbox = process.mailbox;
if (mailbox.length === 0)
{
break;
}
process.root = process.root.callback(mailbox.shift());
++numSteps;
continue;
}
throw new Error(ctor);
}
if (numSteps < MAX_STEPS)
{
return numSteps + 1;
}
enqueue(process);
return numSteps;
}
// WORK QUEUE
var working = false;
var workQueue = [];
function enqueue(process)
{
workQueue.push(process);
if (!working)
{
setTimeout(work, 0);
working = true;
}
}
function work()
{
var numSteps = 0;
var process;
while (numSteps < MAX_STEPS && (process = workQueue.shift()))
{
if (process.root)
{
numSteps = step(numSteps, process);
}
}
if (!process)
{
working = false;
return;
}
setTimeout(work, 0);
}
return {
succeed: succeed,
fail: fail,
nativeBinding: nativeBinding,
andThen: F2(andThen),
onError: F2(onError),
receive: receive,
spawn: spawn,
kill: kill,
sleep: sleep,
send: F2(send),
rawSpawn: rawSpawn,
rawSend: rawSend
};
}();

339
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Native/String.js vendored Normal file
View File

@@ -0,0 +1,339 @@
//import Maybe, Native.List, Native.Utils, Result //
var _elm_lang$core$Native_String = function() {
function isEmpty(str)
{
return str.length === 0;
}
function cons(chr, str)
{
return chr + str;
}
function uncons(str)
{
var hd = str[0];
if (hd)
{
return _elm_lang$core$Maybe$Just(_elm_lang$core$Native_Utils.Tuple2(_elm_lang$core$Native_Utils.chr(hd), str.slice(1)));
}
return _elm_lang$core$Maybe$Nothing;
}
function append(a, b)
{
return a + b;
}
function concat(strs)
{
return _elm_lang$core$Native_List.toArray(strs).join('');
}
function length(str)
{
return str.length;
}
function map(f, str)
{
var out = str.split('');
for (var i = out.length; i--; )
{
out[i] = f(_elm_lang$core$Native_Utils.chr(out[i]));
}
return out.join('');
}
function filter(pred, str)
{
return str.split('').map(_elm_lang$core$Native_Utils.chr).filter(pred).join('');
}
function reverse(str)
{
return str.split('').reverse().join('');
}
function foldl(f, b, str)
{
var len = str.length;
for (var i = 0; i < len; ++i)
{
b = A2(f, _elm_lang$core$Native_Utils.chr(str[i]), b);
}
return b;
}
function foldr(f, b, str)
{
for (var i = str.length; i--; )
{
b = A2(f, _elm_lang$core$Native_Utils.chr(str[i]), b);
}
return b;
}
function split(sep, str)
{
return _elm_lang$core$Native_List.fromArray(str.split(sep));
}
function join(sep, strs)
{
return _elm_lang$core$Native_List.toArray(strs).join(sep);
}
function repeat(n, str)
{
var result = '';
while (n > 0)
{
if (n & 1)
{
result += str;
}
n >>= 1, str += str;
}
return result;
}
function slice(start, end, str)
{
return str.slice(start, end);
}
function left(n, str)
{
return n < 1 ? '' : str.slice(0, n);
}
function right(n, str)
{
return n < 1 ? '' : str.slice(-n);
}
function dropLeft(n, str)
{
return n < 1 ? str : str.slice(n);
}
function dropRight(n, str)
{
return n < 1 ? str : str.slice(0, -n);
}
function pad(n, chr, str)
{
var half = (n - str.length) / 2;
return repeat(Math.ceil(half), chr) + str + repeat(half | 0, chr);
}
function padRight(n, chr, str)
{
return str + repeat(n - str.length, chr);
}
function padLeft(n, chr, str)
{
return repeat(n - str.length, chr) + str;
}
function trim(str)
{
return str.trim();
}
function trimLeft(str)
{
return str.replace(/^\s+/, '');
}
function trimRight(str)
{
return str.replace(/\s+$/, '');
}
function words(str)
{
return _elm_lang$core$Native_List.fromArray(str.trim().split(/\s+/g));
}
function lines(str)
{
return _elm_lang$core$Native_List.fromArray(str.split(/\r\n|\r|\n/g));
}
function toUpper(str)
{
return str.toUpperCase();
}
function toLower(str)
{
return str.toLowerCase();
}
function any(pred, str)
{
for (var i = str.length; i--; )
{
if (pred(_elm_lang$core$Native_Utils.chr(str[i])))
{
return true;
}
}
return false;
}
function all(pred, str)
{
for (var i = str.length; i--; )
{
if (!pred(_elm_lang$core$Native_Utils.chr(str[i])))
{
return false;
}
}
return true;
}
function contains(sub, str)
{
return str.indexOf(sub) > -1;
}
function startsWith(sub, str)
{
return str.indexOf(sub) === 0;
}
function endsWith(sub, str)
{
return str.length >= sub.length &&
str.lastIndexOf(sub) === str.length - sub.length;
}
function indexes(sub, str)
{
var subLen = sub.length;
if (subLen < 1)
{
return _elm_lang$core$Native_List.Nil;
}
var i = 0;
var is = [];
while ((i = str.indexOf(sub, i)) > -1)
{
is.push(i);
i = i + subLen;
}
return _elm_lang$core$Native_List.fromArray(is);
}
function toInt(s)
{
var len = s.length;
// if empty
if (len === 0)
{
return intErr(s);
}
// if hex
var c = s[0];
if (c === '0' && s[1] === 'x')
{
for (var i = 2; i < len; ++i)
{
var c = s[i];
if (('0' <= c && c <= '9') || ('A' <= c && c <= 'F') || ('a' <= c && c <= 'f'))
{
continue;
}
return intErr(s);
}
return _elm_lang$core$Result$Ok(parseInt(s, 16));
}
// is decimal
if (c > '9' || (c < '0' && c !== '-' && c !== '+'))
{
return intErr(s);
}
for (var i = 1; i < len; ++i)
{
var c = s[i];
if (c < '0' || '9' < c)
{
return intErr(s);
}
}
return _elm_lang$core$Result$Ok(parseInt(s, 10));
}
function intErr(s)
{
return _elm_lang$core$Result$Err("could not convert string '" + s + "' to an Int");
}
function toFloat(s)
{
// check if it is a hex, octal, or binary number
if (s.length === 0 || /[\sxbo]/.test(s))
{
return floatErr(s);
}
var n = +s;
// faster isNaN check
return n === n ? _elm_lang$core$Result$Ok(n) : floatErr(s);
}
function floatErr(s)
{
return _elm_lang$core$Result$Err("could not convert string '" + s + "' to a Float");
}
function toList(str)
{
return _elm_lang$core$Native_List.fromArray(str.split('').map(_elm_lang$core$Native_Utils.chr));
}
function fromList(chars)
{
return _elm_lang$core$Native_List.toArray(chars).join('');
}
return {
isEmpty: isEmpty,
cons: F2(cons),
uncons: uncons,
append: F2(append),
concat: concat,
length: length,
map: F2(map),
filter: F2(filter),
reverse: reverse,
foldl: F3(foldl),
foldr: F3(foldr),
split: F2(split),
join: F2(join),
repeat: F2(repeat),
slice: F3(slice),
left: F2(left),
right: F2(right),
dropLeft: F2(dropLeft),
dropRight: F2(dropRight),
pad: F3(pad),
padLeft: F3(padLeft),
padRight: F3(padRight),
trim: trim,
trimLeft: trimLeft,
trimRight: trimRight,
words: words,
lines: lines,
toUpper: toUpper,
toLower: toLower,
any: F2(any),
all: F2(all),
contains: F2(contains),
startsWith: F2(startsWith),
endsWith: F2(endsWith),
indexes: F2(indexes),
toInt: toInt,
toFloat: toFloat,
toList: toList,
fromList: fromList
};
}();

27
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Native/Time.js vendored Normal file
View File

@@ -0,0 +1,27 @@
//import Native.Scheduler //
var _elm_lang$core$Native_Time = function() {
var now = _elm_lang$core$Native_Scheduler.nativeBinding(function(callback)
{
callback(_elm_lang$core$Native_Scheduler.succeed(Date.now()));
});
function setInterval_(interval, task)
{
return _elm_lang$core$Native_Scheduler.nativeBinding(function(callback)
{
var id = setInterval(function() {
_elm_lang$core$Native_Scheduler.rawSpawn(task);
}, interval);
return function() { clearInterval(id); };
});
}
return {
now: now,
setInterval_: F2(setInterval_)
};
}();

488
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Native/Utils.js vendored Normal file
View File

@@ -0,0 +1,488 @@
//import //
var _elm_lang$core$Native_Utils = function() {
// COMPARISONS
function eq(x, y)
{
var stack = [];
var isEqual = eqHelp(x, y, 0, stack);
var pair;
while (isEqual && (pair = stack.pop()))
{
isEqual = eqHelp(pair.x, pair.y, 0, stack);
}
return isEqual;
}
function eqHelp(x, y, depth, stack)
{
if (depth > 100)
{
stack.push({ x: x, y: y });
return true;
}
if (x === y)
{
return true;
}
if (typeof x !== 'object')
{
if (typeof x === 'function')
{
throw new Error(
'Trying to use `(==)` on functions. There is no way to know if functions are "the same" in the Elm sense.'
+ ' Read more about this at http://package.elm-lang.org/packages/elm-lang/core/latest/Basics#=='
+ ' which describes why it is this way and what the better version will look like.'
);
}
return false;
}
if (x === null || y === null)
{
return false
}
if (x instanceof Date)
{
return x.getTime() === y.getTime();
}
if (!('ctor' in x))
{
for (var key in x)
{
if (!eqHelp(x[key], y[key], depth + 1, stack))
{
return false;
}
}
return true;
}
// convert Dicts and Sets to lists
if (x.ctor === 'RBNode_elm_builtin' || x.ctor === 'RBEmpty_elm_builtin')
{
x = _elm_lang$core$Dict$toList(x);
y = _elm_lang$core$Dict$toList(y);
}
if (x.ctor === 'Set_elm_builtin')
{
x = _elm_lang$core$Set$toList(x);
y = _elm_lang$core$Set$toList(y);
}
// check if lists are equal without recursion
if (x.ctor === '::')
{
var a = x;
var b = y;
while (a.ctor === '::' && b.ctor === '::')
{
if (!eqHelp(a._0, b._0, depth + 1, stack))
{
return false;
}
a = a._1;
b = b._1;
}
return a.ctor === b.ctor;
}
// check if Arrays are equal
if (x.ctor === '_Array')
{
var xs = _elm_lang$core$Native_Array.toJSArray(x);
var ys = _elm_lang$core$Native_Array.toJSArray(y);
if (xs.length !== ys.length)
{
return false;
}
for (var i = 0; i < xs.length; i++)
{
if (!eqHelp(xs[i], ys[i], depth + 1, stack))
{
return false;
}
}
return true;
}
if (!eqHelp(x.ctor, y.ctor, depth + 1, stack))
{
return false;
}
for (var key in x)
{
if (!eqHelp(x[key], y[key], depth + 1, stack))
{
return false;
}
}
return true;
}
// Code in Generate/JavaScript.hs, Basics.js, and List.js depends on
// the particular integer values assigned to LT, EQ, and GT.
var LT = -1, EQ = 0, GT = 1;
function cmp(x, y)
{
if (typeof x !== 'object')
{
return x === y ? EQ : x < y ? LT : GT;
}
if (x instanceof String)
{
var a = x.valueOf();
var b = y.valueOf();
return a === b ? EQ : a < b ? LT : GT;
}
if (x.ctor === '::' || x.ctor === '[]')
{
while (x.ctor === '::' && y.ctor === '::')
{
var ord = cmp(x._0, y._0);
if (ord !== EQ)
{
return ord;
}
x = x._1;
y = y._1;
}
return x.ctor === y.ctor ? EQ : x.ctor === '[]' ? LT : GT;
}
if (x.ctor.slice(0, 6) === '_Tuple')
{
var ord;
var n = x.ctor.slice(6) - 0;
var err = 'cannot compare tuples with more than 6 elements.';
if (n === 0) return EQ;
if (n >= 1) { ord = cmp(x._0, y._0); if (ord !== EQ) return ord;
if (n >= 2) { ord = cmp(x._1, y._1); if (ord !== EQ) return ord;
if (n >= 3) { ord = cmp(x._2, y._2); if (ord !== EQ) return ord;
if (n >= 4) { ord = cmp(x._3, y._3); if (ord !== EQ) return ord;
if (n >= 5) { ord = cmp(x._4, y._4); if (ord !== EQ) return ord;
if (n >= 6) { ord = cmp(x._5, y._5); if (ord !== EQ) return ord;
if (n >= 7) throw new Error('Comparison error: ' + err); } } } } } }
return EQ;
}
throw new Error(
'Comparison error: comparison is only defined on ints, '
+ 'floats, times, chars, strings, lists of comparable values, '
+ 'and tuples of comparable values.'
);
}
// COMMON VALUES
var Tuple0 = {
ctor: '_Tuple0'
};
function Tuple2(x, y)
{
return {
ctor: '_Tuple2',
_0: x,
_1: y
};
}
function chr(c)
{
return new String(c);
}
// GUID
var count = 0;
function guid(_)
{
return count++;
}
// RECORDS
function update(oldRecord, updatedFields)
{
var newRecord = {};
for (var key in oldRecord)
{
newRecord[key] = oldRecord[key];
}
for (var key in updatedFields)
{
newRecord[key] = updatedFields[key];
}
return newRecord;
}
//// LIST STUFF ////
var Nil = { ctor: '[]' };
function Cons(hd, tl)
{
return {
ctor: '::',
_0: hd,
_1: tl
};
}
function append(xs, ys)
{
// append Strings
if (typeof xs === 'string')
{
return xs + ys;
}
// append Lists
if (xs.ctor === '[]')
{
return ys;
}
var root = Cons(xs._0, Nil);
var curr = root;
xs = xs._1;
while (xs.ctor !== '[]')
{
curr._1 = Cons(xs._0, Nil);
xs = xs._1;
curr = curr._1;
}
curr._1 = ys;
return root;
}
// CRASHES
function crash(moduleName, region)
{
return function(message) {
throw new Error(
'Ran into a `Debug.crash` in module `' + moduleName + '` ' + regionToString(region) + '\n'
+ 'The message provided by the code author is:\n\n '
+ message
);
};
}
function crashCase(moduleName, region, value)
{
return function(message) {
throw new Error(
'Ran into a `Debug.crash` in module `' + moduleName + '`\n\n'
+ 'This was caused by the `case` expression ' + regionToString(region) + '.\n'
+ 'One of the branches ended with a crash and the following value got through:\n\n ' + toString(value) + '\n\n'
+ 'The message provided by the code author is:\n\n '
+ message
);
};
}
function regionToString(region)
{
if (region.start.line == region.end.line)
{
return 'on line ' + region.start.line;
}
return 'between lines ' + region.start.line + ' and ' + region.end.line;
}
// TO STRING
function toString(v)
{
var type = typeof v;
if (type === 'function')
{
return '<function>';
}
if (type === 'boolean')
{
return v ? 'True' : 'False';
}
if (type === 'number')
{
return v + '';
}
if (v instanceof String)
{
return '\'' + addSlashes(v, true) + '\'';
}
if (type === 'string')
{
return '"' + addSlashes(v, false) + '"';
}
if (v === null)
{
return 'null';
}
if (type === 'object' && 'ctor' in v)
{
var ctorStarter = v.ctor.substring(0, 5);
if (ctorStarter === '_Tupl')
{
var output = [];
for (var k in v)
{
if (k === 'ctor') continue;
output.push(toString(v[k]));
}
return '(' + output.join(',') + ')';
}
if (ctorStarter === '_Task')
{
return '<task>'
}
if (v.ctor === '_Array')
{
var list = _elm_lang$core$Array$toList(v);
return 'Array.fromList ' + toString(list);
}
if (v.ctor === '<decoder>')
{
return '<decoder>';
}
if (v.ctor === '_Process')
{
return '<process:' + v.id + '>';
}
if (v.ctor === '::')
{
var output = '[' + toString(v._0);
v = v._1;
while (v.ctor === '::')
{
output += ',' + toString(v._0);
v = v._1;
}
return output + ']';
}
if (v.ctor === '[]')
{
return '[]';
}
if (v.ctor === 'Set_elm_builtin')
{
return 'Set.fromList ' + toString(_elm_lang$core$Set$toList(v));
}
if (v.ctor === 'RBNode_elm_builtin' || v.ctor === 'RBEmpty_elm_builtin')
{
return 'Dict.fromList ' + toString(_elm_lang$core$Dict$toList(v));
}
var output = '';
for (var i in v)
{
if (i === 'ctor') continue;
var str = toString(v[i]);
var c0 = str[0];
var parenless = c0 === '{' || c0 === '(' || c0 === '<' || c0 === '"' || str.indexOf(' ') < 0;
output += ' ' + (parenless ? str : '(' + str + ')');
}
return v.ctor + output;
}
if (type === 'object')
{
if (v instanceof Date)
{
return '<' + v.toString() + '>';
}
if (v.elm_web_socket)
{
return '<websocket>';
}
var output = [];
for (var k in v)
{
output.push(k + ' = ' + toString(v[k]));
}
if (output.length === 0)
{
return '{}';
}
return '{ ' + output.join(', ') + ' }';
}
return '<internal structure>';
}
function addSlashes(str, isChar)
{
var s = str.replace(/\\/g, '\\\\')
.replace(/\n/g, '\\n')
.replace(/\t/g, '\\t')
.replace(/\r/g, '\\r')
.replace(/\v/g, '\\v')
.replace(/\0/g, '\\0');
if (isChar)
{
return s.replace(/\'/g, '\\\'');
}
else
{
return s.replace(/\"/g, '\\"');
}
}
return {
eq: eq,
cmp: cmp,
Tuple0: Tuple0,
Tuple2: Tuple2,
chr: chr,
update: update,
guid: guid,
append: F2(append),
crash: crash,
crashCase: crashCase,
toString: toString
};
}();

145
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Platform.elm vendored Normal file
View File

@@ -0,0 +1,145 @@
module Platform exposing
( Program, program, programWithFlags
, Task, ProcessId
, Router, sendToApp, sendToSelf
)
{-|
# Programs
@docs Program, program, programWithFlags
# Platform Internals
## Tasks and Processes
@docs Task, ProcessId
## Effect Manager Helpers
An extremely tiny portion of library authors should ever write effect managers.
Fundamentally, Elm needs maybe 10 of them total. I get that people are smart,
curious, etc. but that is not a substitute for a legitimate reason to make an
effect manager. Do you have an *organic need* this fills? Or are you just
curious? Public discussions of your explorations should be framed accordingly.
@docs Router, sendToApp, sendToSelf
-}
import Basics exposing (Never)
import Native.Platform
import Native.Scheduler
import Platform.Cmd exposing (Cmd)
import Platform.Sub exposing (Sub)
-- PROGRAMS
{-| A `Program` describes how to manage your Elm app.
You can create [headless][] programs with the [`program`](#program) and
[`programWithFlags`](#programWithFlags) functions. Similar functions exist in
[`Html`][html] that let you specify a view.
[headless]: https://en.wikipedia.org/wiki/Headless_software
[html]: http://package.elm-lang.org/packages/elm-lang/html/latest/Html
Honestly, it is totally normal if this seems crazy at first. The best way to
understand is to work through [guide.elm-lang.org](http://guide.elm-lang.org/).
It makes way more sense in context!
-}
type Program flags model msg = Program
{-| Create a [headless][] program. This is great if you want to use Elm as the
&ldquo;brain&rdquo; for something else. You can still communicate with JS via
ports and manage your model, you just do not have to specify a `view`.
[headless]: https://en.wikipedia.org/wiki/Headless_software
Initializing a headless program from JavaScript looks like this:
```javascript
var app = Elm.MyThing.worker();
```
-}
program
: { init : (model, Cmd msg)
, update : msg -> model -> (model, Cmd msg)
, subscriptions : model -> Sub msg
}
-> Program Never model msg
program =
Native.Platform.program
{-| Same as [`program`](#program), but you can provide flags. Initializing a
headless program (with flags) from JavaScript looks like this:
```javascript
var app = Elm.MyThing.worker({ user: 'Tom', token: 1234 });
```
Whatever argument you provide to `worker` will get converted to an Elm value,
allowing you to configure your Elm program however you want from JavaScript!
-}
programWithFlags
: { init : flags -> (model, Cmd msg)
, update : msg -> model -> (model, Cmd msg)
, subscriptions : model -> Sub msg
}
-> Program flags model msg
programWithFlags =
Native.Platform.programWithFlags
-- TASKS and PROCESSES
{-| Head over to the documentation for the [`Task`](Task) module for more
information on this. It is only defined here because it is a platform
primitive.
-}
type Task err ok = Task
{-| Head over to the documentation for the [`Process`](Process) module for
information on this. It is only defined here because it is a platform
primitive.
-}
type ProcessId = ProcessId
-- EFFECT MANAGER INTERNALS
{-| An effect manager has access to a “router” that routes messages between
the main app and your individual effect manager.
-}
type Router appMsg selfMsg =
Router
{-| Send the router a message for the main loop of your app. This message will
be handled by the overall `update` function, just like events from `Html`.
-}
sendToApp : Router msg a -> msg -> Task x ()
sendToApp =
Native.Platform.sendToApp
{-| Send the router a message for your effect manager. This message will
be routed to the `onSelfMsg` function, where you can update the state of your
effect manager as necessary.
As an example, the effect manager for web sockets
-}
sendToSelf : Router a msg -> msg -> Task x ()
sendToSelf =
Native.Platform.sendToSelf
hack =
Native.Scheduler.succeed

67
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Platform/Cmd.elm vendored Normal file
View File

@@ -0,0 +1,67 @@
module Platform.Cmd exposing
( Cmd
, map
, batch
, none
, (!)
)
{-|
# Effects
Elm has **managed effects**, meaning that things like HTTP requests or writing
to disk are all treated as *data* in Elm. When this data is given to the Elm
runtime system, it can do some “query optimization” before actually performing
the effect. Perhaps unexpectedly, this managed effects idea is the heart of why
Elm is so nice for testing, reuse, reproducibility, etc.
There are two kinds of managed effects you will use in your programs: commands
and subscriptions.
@docs Cmd, map, batch, none, (!)
-}
import Native.Platform
{-| A command is a way of telling Elm, “Hey, I want you to do this thing!”
So if you want to send an HTTP request, you would need to command Elm to do it.
Or if you wanted to ask for geolocation, you would need to command Elm to go
get it.
Every `Cmd` specifies (1) which effects you need access to and (2) the type of
messages that will come back into your application.
**Note:** Do not worry if this seems confusing at first! As with every Elm user
ever, commands will make more sense as you work through [the Elm Architecture
Tutorial](http://guide.elm-lang.org/architecture/index.html) and see how they
fit into a real application!
-}
type Cmd msg = Cmd
{-|-}
map : (a -> msg) -> Cmd a -> Cmd msg
map =
Native.Platform.map
{-|-}
batch : List (Cmd msg) -> Cmd msg
batch =
Native.Platform.batch
{-|-}
none : Cmd msg
none =
batch []
{-|-}
(!) : model -> List (Cmd msg) -> (model, Cmd msg)
(!) model commands =
(model, batch commands)

52
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Platform/Sub.elm vendored Normal file
View File

@@ -0,0 +1,52 @@
module Platform.Sub exposing
( Sub
, map
, batch
, none
)
{-|
@docs Sub, map, batch, none
-}
import Native.Platform
{-| A subscription is a way of telling Elm, “Hey, let me know if anything
interesting happens over there!” So if you want to listen for messages on a web
socket, you would tell Elm to create a subscription. If you want to get clock
ticks, you would tell Elm to subscribe to that. The cool thing here is that
this means *Elm* manages all the details of subscriptions instead of *you*.
So if a web socket goes down, *you* do not need to manually reconnect with an
exponential backoff strategy, *Elm* does this all for you behind the scenes!
Every `Sub` specifies (1) which effects you need access to and (2) the type of
messages that will come back into your application.
**Note:** Do not worry if this seems confusing at first! As with every Elm user
ever, subscriptions will make more sense as you work through [the Elm Architecture
Tutorial](http://guide.elm-lang.org/architecture/index.html) and see how they fit
into a real application!
-}
type Sub msg = Sub
{-|-}
map : (a -> msg) -> Sub a -> Sub msg
map =
Native.Platform.map
{-|-}
batch : List (Sub msg) -> Sub msg
batch =
Native.Platform.batch
{-|-}
none : Sub msg
none =
batch []

106
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Process.elm vendored Normal file
View File

@@ -0,0 +1,106 @@
module Process exposing
( Id
, spawn
, sleep
, kill
)
{-|
# Processes
@docs Id, spawn, sleep, kill
## Future Plans
Right now, this library is pretty sparse. For example, there is no public API
for processes to communicate with each other. This is a really important
ability, but it is also something that is extraordinarily easy to get wrong!
I think the trend will be towards an Erlang style of concurrency, where every
process has an “event queue” that anyone can send messages to. I currently
think the API will be extended to be more like this:
type Id exit msg
spawn : Task exit a -> Task x (Id exit Never)
kill : Id exit msg -> Task x ()
send : Id exit msg -> msg -> Task x ()
A process `Id` will have two type variables to make sure all communication is
valid. The `exit` type describes the messages that are produced if the process
fails because of user code. So if processes are linked and trapping errors,
they will need to handle this. The `msg` type just describes what kind of
messages this process can be sent by strangers.
We shall see though! This is just a draft that does not cover nearly everything
it needs to, so the long-term vision for concurrency in Elm will be rolling out
slowly as I get more data and experience.
I ask that people bullish on compiling to node.js keep this in mind. I think we
can do better than the hopelessly bad concurrency model of node.js, and I hope
the Elm community will be supportive of being more ambitious, even if it takes
longer. That’s kind of what Elm is all about.
-}
import Basics exposing (Never)
import Native.Scheduler
import Platform
import Task exposing (Task)
import Time exposing (Time)
{-| A light-weight process that runs concurrently. You can use `spawn` to
get a bunch of different tasks running in different processes. The Elm runtime
will interleave their progress. So if a task is taking too long, we will pause
it at an `andThen` and switch over to other stuff.
**Note:** We make a distinction between *concurrency* which means interleaving
different sequences and *parallelism* which means running different
sequences at the exact same time. For example, a
[time-sharing system](https://en.wikipedia.org/wiki/Time-sharing) is definitely
concurrent, but not necessarily parallel. So even though JS runs within a
single OS-level thread, Elm can still run things concurrently.
-}
type alias Id =
Platform.ProcessId
{-| Run a task in its own light-weight process. In the following example,
`task1` and `task2` will be interleaved. If `task1` makes a long HTTP request
or is just taking a long time, we can hop over to `task2` and do some work
there.
spawn task1
|> Task.andThen (\_ -> spawn task2)
**Note:** This creates a relatively restricted kind of `Process` because it
cannot receive any messages. More flexibility for user-defined processes will
come in a later release!
-}
spawn : Task x a -> Task y Id
spawn =
Native.Scheduler.spawn
{-| Block progress on the current process for a given amount of time. The
JavaScript equivalent of this is [`setTimeout`][setTimeout] which lets you
delay work until later.
[setTimeout]: https://developer.mozilla.org/en-US/docs/Web/API/WindowTimers/setTimeout
-}
sleep : Time -> Task x ()
sleep =
Native.Scheduler.sleep
{-| Sometimes you `spawn` a process, but later decide it would be a waste to
have it keep running and doing stuff. The `kill` function will force a process
to bail on whatever task it is running. So if there is an HTTP request in
flight, it will also abort the request.
-}
kill : Id -> Task x ()
kill =
Native.Scheduler.kill

532
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Random.elm vendored Normal file
View File

@@ -0,0 +1,532 @@
effect module Random where { command = MyCmd } exposing
( Generator, Seed
, bool, int, float
, list, pair
, map, map2, map3, map4, map5
, andThen
, minInt, maxInt
, generate
, step, initialSeed
)
{-| This library helps you generate pseudo-random values.
This library is all about building [`generators`](#Generator) for whatever
type of values you need. There are a bunch of primitive generators like
[`bool`](#bool) and [`int`](#int) that you can build up into fancier
generators with functions like [`list`](#list) and [`map`](#map).
It may be helpful to [read about JSON decoders][json] because they work very
similarly.
[json]: https://evancz.gitbooks.io/an-introduction-to-elm/content/interop/json.html
> *Note:* This is an implementation of the Portable Combined Generator of
L'Ecuyer for 32-bit computers. It is almost a direct translation from the
[System.Random](http://hackage.haskell.org/package/random-1.0.1.1/docs/System-Random.html)
module. It has a period of roughly 2.30584e18.
# Generators
@docs Generator
# Primitive Generators
@docs bool, int, float
# Data Structure Generators
@docs pair, list
# Custom Generators
@docs map, map2, map3, map4, map5, andThen
# Generate Values
@docs generate
# Generate Values Manually
@docs step, Seed, initialSeed
# Constants
@docs maxInt, minInt
-}
import Basics exposing (..)
import List exposing ((::))
import Platform
import Platform.Cmd exposing (Cmd)
import Task exposing (Task)
import Time
import Tuple
-- PRIMITIVE GENERATORS
{-| Create a generator that produces boolean values. The following example
simulates a coin flip that may land heads or tails.
type Flip = Heads | Tails
coinFlip : Generator Flip
coinFlip =
map (\b -> if b then Heads else Tails) bool
-}
bool : Generator Bool
bool =
map ((==) 1) (int 0 1)
{-| Generate 32-bit integers in a given range.
int 0 10 -- an integer between zero and ten
int -5 5 -- an integer between -5 and 5
int minInt maxInt -- an integer in the widest range feasible
This function *can* produce values outside of the range [[`minInt`](#minInt),
[`maxInt`](#maxInt)] but sufficient randomness is not guaranteed.
-}
int : Int -> Int -> Generator Int
int a b =
Generator <| \(Seed seed) ->
let
(lo,hi) =
if a < b then (a,b) else (b,a)
k = hi - lo + 1
-- 2^31 - 87
base = 2147483561
n = iLogBase base k
f n acc state =
case n of
0 -> (acc, state)
_ ->
let
(x, nextState) = seed.next state
in
f (n - 1) (x + acc * base) nextState
(v, nextState) =
f n 1 seed.state
in
( lo + v % k
, Seed { seed | state = nextState }
)
iLogBase : Int -> Int -> Int
iLogBase b i =
if i < b then
1
else
1 + iLogBase b (i // b)
{-| The maximum value for randomly generated 32-bit ints: 2147483647 -}
maxInt : Int
maxInt =
2147483647
{-| The minimum value for randomly generated 32-bit ints: -2147483648 -}
minInt : Int
minInt =
-2147483648
{-| Generate floats in a given range. The following example is a generator
that produces decimals between 0 and 1.
probability : Generator Float
probability =
float 0 1
-}
float : Float -> Float -> Generator Float
float a b =
Generator <| \seed ->
let
(lo, hi) =
if a < b then (a,b) else (b,a)
(number, newSeed) =
step (int minInt maxInt) seed
negativeOneToOne =
toFloat number / toFloat (maxInt - minInt)
scaled =
(lo+hi)/2 + ((hi-lo) * negativeOneToOne)
in
(scaled, newSeed)
-- DATA STRUCTURES
{-| Create a pair of random values. A common use of this might be to generate
a point in a certain 2D space. Imagine we have a collage that is 400 pixels
wide and 200 pixels tall.
randomPoint : Generator (Int,Int)
randomPoint =
pair (int -200 200) (int -100 100)
-}
pair : Generator a -> Generator b -> Generator (a,b)
pair genA genB =
map2 (,) genA genB
{-| Create a list of random values.
floatList : Generator (List Float)
floatList =
list 10 (float 0 1)
intList : Generator (List Int)
intList =
list 5 (int 0 100)
intPairs : Generator (List (Int, Int))
intPairs =
list 10 <| pair (int 0 100) (int 0 100)
-}
list : Int -> Generator a -> Generator (List a)
list n (Generator generate) =
Generator <| \seed ->
listHelp [] n generate seed
listHelp : List a -> Int -> (Seed -> (a,Seed)) -> Seed -> (List a, Seed)
listHelp list n generate seed =
if n < 1 then
(List.reverse list, seed)
else
let
(value, newSeed) =
generate seed
in
listHelp (value :: list) (n-1) generate newSeed
-- CUSTOM GENERATORS
{-| Transform the values produced by a generator. The following examples show
how to generate booleans and letters based on a basic integer generator.
bool : Generator Bool
bool =
map ((==) 1) (int 0 1)
lowercaseLetter : Generator Char
lowercaseLetter =
map (\n -> Char.fromCode (n + 97)) (int 0 25)
uppercaseLetter : Generator Char
uppercaseLetter =
map (\n -> Char.fromCode (n + 65)) (int 0 25)
-}
map : (a -> b) -> Generator a -> Generator b
map func (Generator genA) =
Generator <| \seed0 ->
let
(a, seed1) = genA seed0
in
(func a, seed1)
{-| Combine two generators.
This function is used to define things like [`pair`](#pair) where you want to
put two generators together.
pair : Generator a -> Generator b -> Generator (a,b)
pair genA genB =
map2 (,) genA genB
-}
map2 : (a -> b -> c) -> Generator a -> Generator b -> Generator c
map2 func (Generator genA) (Generator genB) =
Generator <| \seed0 ->
let
(a, seed1) = genA seed0
(b, seed2) = genB seed1
in
(func a b, seed2)
{-| Combine three generators. This could be used to produce random colors.
import Color
rgb : Generator Color.Color
rgb =
map3 Color.rgb (int 0 255) (int 0 255) (int 0 255)
hsl : Generator Color.Color
hsl =
map3 Color.hsl (map degrees (int 0 360)) (float 0 1) (float 0 1)
-}
map3 : (a -> b -> c -> d) -> Generator a -> Generator b -> Generator c -> Generator d
map3 func (Generator genA) (Generator genB) (Generator genC) =
Generator <| \seed0 ->
let
(a, seed1) = genA seed0
(b, seed2) = genB seed1
(c, seed3) = genC seed2
in
(func a b c, seed3)
{-| Combine four generators.
-}
map4 : (a -> b -> c -> d -> e) -> Generator a -> Generator b -> Generator c -> Generator d -> Generator e
map4 func (Generator genA) (Generator genB) (Generator genC) (Generator genD) =
Generator <| \seed0 ->
let
(a, seed1) = genA seed0
(b, seed2) = genB seed1
(c, seed3) = genC seed2
(d, seed4) = genD seed3
in
(func a b c d, seed4)
{-| Combine five generators.
-}
map5 : (a -> b -> c -> d -> e -> f) -> Generator a -> Generator b -> Generator c -> Generator d -> Generator e -> Generator f
map5 func (Generator genA) (Generator genB) (Generator genC) (Generator genD) (Generator genE) =
Generator <| \seed0 ->
let
(a, seed1) = genA seed0
(b, seed2) = genB seed1
(c, seed3) = genC seed2
(d, seed4) = genD seed3
(e, seed5) = genE seed4
in
(func a b c d e, seed5)
{-| Chain random operations, threading through the seed. In the following
example, we will generate a random letter by putting together uppercase and
lowercase letters.
letter : Generator Char
letter =
bool
|> andThen upperOrLower
upperOrLower : Bool -> Generator Char
upperOrLower b =
if b then uppercaseLetter else lowercaseLetter
-- bool : Generator Bool
-- uppercaseLetter : Generator Char
-- lowercaseLetter : Generator Char
-}
andThen : (a -> Generator b) -> Generator a -> Generator b
andThen callback (Generator generate) =
Generator <| \seed ->
let
(result, newSeed) =
generate seed
(Generator genB) =
callback result
in
genB newSeed
-- IMPLEMENTATION
{-| A `Generator` is like a recipe for generating certain random values. So a
`Generator Int` describes how to generate integers and a `Generator String`
describes how to generate strings.
To actually *run* a generator and produce the random values, you need to use
functions like [`generate`](#generate) and [`initialSeed`](#initialSeed).
-}
type Generator a =
Generator (Seed -> (a, Seed))
type State = State Int Int
{-| A `Seed` is the source of randomness in this whole system. Whenever
you want to use a generator, you need to pair it with a seed.
-}
type Seed =
Seed
{ state : State
, next : State -> (Int, State)
, split : State -> (State, State)
, range : State -> (Int,Int)
}
{-| Generate a random value as specified by a given `Generator`.
In the following example, we are trying to generate a number between 0 and 100
with the `int 0 100` generator. Each time we call `step` we need to provide a
seed. This will produce a random number and a *new* seed to use if we want to
run other generators later.
So here it is done right, where we get a new seed from each `step` call and
thread that through.
seed0 = initialSeed 31415
-- step (int 0 100) seed0 ==> (42, seed1)
-- step (int 0 100) seed1 ==> (31, seed2)
-- step (int 0 100) seed2 ==> (99, seed3)
Notice that we use different seeds on each line. This is important! If you use
the same seed, you get the same results.
-- step (int 0 100) seed0 ==> (42, seed1)
-- step (int 0 100) seed0 ==> (42, seed1)
-- step (int 0 100) seed0 ==> (42, seed1)
-}
step : Generator a -> Seed -> (a, Seed)
step (Generator generator) seed =
generator seed
{-| Create a &ldquo;seed&rdquo; of randomness which makes it possible to
generate random values. If you use the same seed many times, it will result
in the same thing every time! A good way to get an unexpected seed is to use
the current time.
-}
initialSeed : Int -> Seed
initialSeed n =
Seed
{ state = initState n
, next = next
, split = split
, range = range
}
{-| Produce the initial generator state. Distinct arguments should be likely
to produce distinct generator states.
-}
initState : Int -> State
initState seed =
let
s = max seed -seed
q = s // (magicNum6-1)
s1 = s % (magicNum6-1)
s2 = q % (magicNum7-1)
in
State (s1+1) (s2+1)
magicNum0 = 40014
magicNum1 = 53668
magicNum2 = 12211
magicNum3 = 52774
magicNum4 = 40692
magicNum5 = 3791
magicNum6 = 2147483563
magicNum7 = 2147483399
magicNum8 = 2147483562
next : State -> (Int, State)
next (State state1 state2) =
-- Div always rounds down and so random numbers are biased
-- ideally we would use division that rounds towards zero so
-- that in the negative case it rounds up and in the positive case
-- it rounds down. Thus half the time it rounds up and half the time it
-- rounds down
let
k1 = state1 // magicNum1
rawState1 = magicNum0 * (state1 - k1 * magicNum1) - k1 * magicNum2
newState1 = if rawState1 < 0 then rawState1 + magicNum6 else rawState1
k2 = state2 // magicNum3
rawState2 = magicNum4 * (state2 - k2 * magicNum3) - k2 * magicNum5
newState2 = if rawState2 < 0 then rawState2 + magicNum7 else rawState2
z = newState1 - newState2
newZ = if z < 1 then z + magicNum8 else z
in
(newZ, State newState1 newState2)
split : State -> (State, State)
split (State s1 s2 as std) =
let
new_s1 =
if s1 == magicNum6-1 then 1 else s1 + 1
new_s2 =
if s2 == 1 then magicNum7-1 else s2 - 1
(State t1 t2) =
Tuple.second (next std)
in
(State new_s1 t2, State t1 new_s2)
range : State -> (Int,Int)
range _ =
(0, magicNum8)
-- MANAGER
{-| Create a command that will generate random values.
Read more about how to use this in your programs in [The Elm Architecture
tutorial][arch] which has a section specifically [about random values][rand].
[arch]: https://evancz.gitbooks.io/an-introduction-to-elm/content/architecture/index.html
[rand]: https://evancz.gitbooks.io/an-introduction-to-elm/content/architecture/effects/random.html
-}
generate : (a -> msg) -> Generator a -> Cmd msg
generate tagger generator =
command (Generate (map tagger generator))
type MyCmd msg = Generate (Generator msg)
cmdMap : (a -> b) -> MyCmd a -> MyCmd b
cmdMap func (Generate generator) =
Generate (map func generator)
init : Task Never Seed
init =
Time.now
|> Task.andThen (\t -> Task.succeed (initialSeed (round t)))
onEffects : Platform.Router msg Never -> List (MyCmd msg) -> Seed -> Task Never Seed
onEffects router commands seed =
case commands of
[] ->
Task.succeed seed
Generate generator :: rest ->
let
(value, newSeed) =
step generator seed
in
Platform.sendToApp router value
|> Task.andThen (\_ -> onEffects router rest newSeed)
onSelfMsg : Platform.Router msg Never -> Never -> Seed -> Task Never Seed
onSelfMsg _ _ seed =
Task.succeed seed

148
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Regex.elm vendored Normal file
View File

@@ -0,0 +1,148 @@
module Regex exposing
( Regex
, regex, escape, caseInsensitive
, HowMany(..), Match
, contains, find, replace, split
)
{-| A library for working with regular expressions. It uses [the
same kind of regular expressions accepted by JavaScript](https://developer.mozilla.org/en/docs/Web/JavaScript/Guide/Regular_Expressions).
# Create
@docs Regex, regex, escape, caseInsensitive
# Helpful Data Structures
These data structures are needed to help define functions like [`find`](#find)
and [`replace`](#replace).
@docs HowMany, Match
# Use
@docs contains, find, replace, split
-}
import Maybe exposing (Maybe)
import Native.Regex
{-| A regular expression, describing a certain set of strings.
-}
type Regex = Regex
{-| Escape strings to be regular expressions, making all special characters
safe. So `regex (escape "^a+")` will match exactly `"^a+"` instead of a series
of `a`&rsquo;s that start at the beginning of the line.
-}
escape : String -> String
escape =
Native.Regex.escape
{-| Create a Regex that matches patterns [as specified in JavaScript](https://developer.mozilla.org/en/docs/Web/JavaScript/Guide/Regular_Expressions#Writing_a_Regular_Expression_Pattern).
Be careful to escape backslashes properly! For example, `"\w"` is escaping the
letter `w` which is probably not what you want. You probably want `"\\w"`
instead, which escapes the backslash.
-}
regex : String -> Regex
regex =
Native.Regex.regex
{-| Make a regex case insensitive -}
caseInsensitive : Regex -> Regex
caseInsensitive =
Native.Regex.caseInsensitive
{-| Check to see if a Regex is contained in a string.
contains (regex "123") "12345" == True
contains (regex "b+") "aabbcc" == True
contains (regex "789") "12345" == False
contains (regex "z+") "aabbcc" == False
-}
contains : Regex -> String -> Bool
contains =
Native.Regex.contains
{-| A `Match` represents all of the details about a particular match in a string.
Here are details on each field:
* `match` &mdash; the full string of the match.
* `submatches` &mdash; a regex might have [subpatterns, surrounded by
parentheses](https://developer.mozilla.org/en/docs/Web/JavaScript/Guide/Regular_Expressions#Using_Parenthesized_Substring_Matches).
If there are N subpatterns, there will be N elements in the `submatches` list.
Each submatch in this list is a `Maybe` because not all subpatterns may trigger.
For example, `(regex "(a+)|(b+)")` will either match many `a`&rsquo;s or
many `b`&rsquo;s, but never both.
* `index` &mdash; the index of the match in the original string.
* `number` &mdash; if you find many matches, you can think of each one
as being labeled with a `number` starting at one. So the first time you
find a match, that is match `number` one. Second time is match `number` two.
This is useful when paired with `replace All` if replacement is dependent on how
many times a pattern has appeared before.
-}
type alias Match =
{ match : String
, submatches : List (Maybe String)
, index : Int
, number : Int
}
{-| `HowMany` is used to specify how many matches you want to make. So
`replace All` would replace every match, but `replace (AtMost 2)` would
replace at most two matches (i.e. zero, one, two, but never three or more).
-}
type HowMany = All | AtMost Int
{-| Find matches in a string:
findTwoCommas = find (AtMost 2) (regex ",")
-- map .index (findTwoCommas "a,b,c,d,e") == [1,3]
-- map .index (findTwoCommas "a b c d e") == []
places = find All (regex "[oi]n a (\\w+)") "I am on a boat in a lake."
-- map .match places == ["on a boat", "in a lake"]
-- map .submatches places == [ [Just "boat"], [Just "lake"] ]
-}
find : HowMany -> Regex -> String -> List Match
find =
Native.Regex.find
{-| Replace matches. The function from `Match` to `String` lets
you use the details of a specific match when making replacements.
devowel = replace All (regex "[aeiou]") (\_ -> "")
-- devowel "The quick brown fox" == "Th qck brwn fx"
reverseWords = replace All (regex "\\w+") (\{match} -> String.reverse match)
-- reverseWords "deliver mined parts" == "reviled denim strap"
-}
replace : HowMany -> Regex -> (Match -> String) -> String -> String
replace =
Native.Regex.replace
{-| Split a string, using the regex as the separator.
split (AtMost 1) (regex ",") "tom,99,90,85" == ["tom","99,90,85"]
split All (regex ",") "a,b,c,d" == ["a","b","c","d"]
-}
split : HowMany -> Regex -> String -> List String
split =
Native.Regex.split

210
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Result.elm vendored Normal file
View File

@@ -0,0 +1,210 @@
module Result exposing
( Result(..)
, withDefault
, map, map2, map3, map4, map5
, andThen
, toMaybe, fromMaybe, mapError
)
{-| A `Result` is the result of a computation that may fail. This is a great
way to manage errors in Elm.
# Type and Constructors
@docs Result
# Mapping
@docs map, map2, map3, map4, map5
# Chaining
@docs andThen
# Handling Errors
@docs withDefault, toMaybe, fromMaybe, mapError
-}
import Maybe exposing ( Maybe(Just, Nothing) )
{-| A `Result` is either `Ok` meaning the computation succeeded, or it is an
`Err` meaning that there was some failure.
-}
type Result error value
= Ok value
| Err error
{-| If the result is `Ok` return the value, but if the result is an `Err` then
return a given default value. The following examples try to parse integers.
Result.withDefault 0 (String.toInt "123") == 123
Result.withDefault 0 (String.toInt "abc") == 0
-}
withDefault : a -> Result x a -> a
withDefault def result =
case result of
Ok a ->
a
Err _ ->
def
{-| Apply a function to a result. If the result is `Ok`, it will be converted.
If the result is an `Err`, the same error value will propagate through.
map sqrt (Ok 4.0) == Ok 2.0
map sqrt (Err "bad input") == Err "bad input"
-}
map : (a -> value) -> Result x a -> Result x value
map func ra =
case ra of
Ok a -> Ok (func a)
Err e -> Err e
{-| Apply a function to two results, if both results are `Ok`. If not,
the first argument which is an `Err` will propagate through.
map2 (+) (String.toInt "1") (String.toInt "2") == Ok 3
map2 (+) (String.toInt "1") (String.toInt "y") == Err "could not convert string 'y' to an Int"
map2 (+) (String.toInt "x") (String.toInt "y") == Err "could not convert string 'x' to an Int"
-}
map2 : (a -> b -> value) -> Result x a -> Result x b -> Result x value
map2 func ra rb =
case (ra,rb) of
(Ok a, Ok b) -> Ok (func a b)
(Err x, _) -> Err x
(_, Err x) -> Err x
{-|-}
map3 : (a -> b -> c -> value) -> Result x a -> Result x b -> Result x c -> Result x value
map3 func ra rb rc =
case (ra,rb,rc) of
(Ok a, Ok b, Ok c) -> Ok (func a b c)
(Err x, _, _) -> Err x
(_, Err x, _) -> Err x
(_, _, Err x) -> Err x
{-|-}
map4 : (a -> b -> c -> d -> value) -> Result x a -> Result x b -> Result x c -> Result x d -> Result x value
map4 func ra rb rc rd =
case (ra,rb,rc,rd) of
(Ok a, Ok b, Ok c, Ok d) -> Ok (func a b c d)
(Err x, _, _, _) -> Err x
(_, Err x, _, _) -> Err x
(_, _, Err x, _) -> Err x
(_, _, _, Err x) -> Err x
{-|-}
map5 : (a -> b -> c -> d -> e -> value) -> Result x a -> Result x b -> Result x c -> Result x d -> Result x e -> Result x value
map5 func ra rb rc rd re =
case (ra,rb,rc,rd,re) of
(Ok a, Ok b, Ok c, Ok d, Ok e) -> Ok (func a b c d e)
(Err x, _, _, _, _) -> Err x
(_, Err x, _, _, _) -> Err x
(_, _, Err x, _, _) -> Err x
(_, _, _, Err x, _) -> Err x
(_, _, _, _, Err x) -> Err x
{-| Chain together a sequence of computations that may fail. It is helpful
to see its definition:
andThen : (a -> Result e b) -> Result e a -> Result e b
andThen callback result =
case result of
Ok value -> callback value
Err msg -> Err msg
This means we only continue with the callback if things are going well. For
example, say you need to use (`toInt : String -> Result String Int`) to parse
a month and make sure it is between 1 and 12:
toValidMonth : Int -> Result String Int
toValidMonth month =
if month >= 1 && month <= 12
then Ok month
else Err "months must be between 1 and 12"
toMonth : String -> Result String Int
toMonth rawString =
toInt rawString
|> andThen toValidMonth
-- toMonth "4" == Ok 4
-- toMonth "9" == Ok 9
-- toMonth "a" == Err "cannot parse to an Int"
-- toMonth "0" == Err "months must be between 1 and 12"
This allows us to come out of a chain of operations with quite a specific error
message. It is often best to create a custom type that explicitly represents
the exact ways your computation may fail. This way it is easy to handle in your
code.
-}
andThen : (a -> Result x b) -> Result x a -> Result x b
andThen callback result =
case result of
Ok value ->
callback value
Err msg ->
Err msg
{-| Transform an `Err` value. For example, say the errors we get have too much
information:
parseInt : String -> Result ParseError Int
type alias ParseError =
{ message : String
, code : Int
, position : (Int,Int)
}
mapError .message (parseInt "123") == Ok 123
mapError .message (parseInt "abc") == Err "char 'a' is not a number"
-}
mapError : (x -> y) -> Result x a -> Result y a
mapError f result =
case result of
Ok v ->
Ok v
Err e ->
Err (f e)
{-| Convert to a simpler `Maybe` if the actual error message is not needed or
you need to interact with some code that primarily uses maybes.
parseInt : String -> Result ParseError Int
maybeParseInt : String -> Maybe Int
maybeParseInt string =
toMaybe (parseInt string)
-}
toMaybe : Result x a -> Maybe a
toMaybe result =
case result of
Ok v -> Just v
Err _ -> Nothing
{-| Convert from a simple `Maybe` to interact with some code that primarily
uses `Results`.
parseInt : String -> Maybe Int
resultParseInt : String -> Result String Int
resultParseInt string =
fromMaybe ("error parsing string: " ++ toString string) (parseInt string)
-}
fromMaybe : x -> Maybe a -> Result x a
fromMaybe err maybe =
case maybe of
Just v -> Ok v
Nothing -> Err err

168
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Set.elm vendored Normal file
View File

@@ -0,0 +1,168 @@
module Set exposing
( Set
, empty, singleton, insert, remove
, isEmpty, member, size
, foldl, foldr, map
, filter, partition
, union, intersect, diff
, toList, fromList
)
{-| A set of unique values. The values can be any comparable type. This
includes `Int`, `Float`, `Time`, `Char`, `String`, and tuples or lists
of comparable types.
Insert, remove, and query operations all take *O(log n)* time.
# Sets
@docs Set
# Build
@docs empty, singleton, insert, remove
# Query
@docs isEmpty, member, size
# Combine
@docs union, intersect, diff
# Lists
@docs toList, fromList
# Transform
@docs map, foldl, foldr, filter, partition
-}
import Basics exposing ((<|))
import Dict as Dict
import List as List
{-| Represents a set of unique values. So `(Set Int)` is a set of integers and
`(Set String)` is a set of strings.
-}
type Set t =
Set_elm_builtin (Dict.Dict t ())
{-| Create an empty set.
-}
empty : Set a
empty =
Set_elm_builtin Dict.empty
{-| Create a set with one value.
-}
singleton : comparable -> Set comparable
singleton k =
Set_elm_builtin <| Dict.singleton k ()
{-| Insert a value into a set.
-}
insert : comparable -> Set comparable -> Set comparable
insert k (Set_elm_builtin d) =
Set_elm_builtin <| Dict.insert k () d
{-| Remove a value from a set. If the value is not found, no changes are made.
-}
remove : comparable -> Set comparable -> Set comparable
remove k (Set_elm_builtin d) =
Set_elm_builtin <| Dict.remove k d
{-| Determine if a set is empty.
-}
isEmpty : Set a -> Bool
isEmpty (Set_elm_builtin d) =
Dict.isEmpty d
{-| Determine if a value is in a set.
-}
member : comparable -> Set comparable -> Bool
member k (Set_elm_builtin d) =
Dict.member k d
{-| Determine the number of elements in a set.
-}
size : Set a -> Int
size (Set_elm_builtin d) =
Dict.size d
{-| Get the union of two sets. Keep all values.
-}
union : Set comparable -> Set comparable -> Set comparable
union (Set_elm_builtin d1) (Set_elm_builtin d2) =
Set_elm_builtin <| Dict.union d1 d2
{-| Get the intersection of two sets. Keeps values that appear in both sets.
-}
intersect : Set comparable -> Set comparable -> Set comparable
intersect (Set_elm_builtin d1) (Set_elm_builtin d2) =
Set_elm_builtin <| Dict.intersect d1 d2
{-| Get the difference between the first set and the second. Keeps values
that do not appear in the second set.
-}
diff : Set comparable -> Set comparable -> Set comparable
diff (Set_elm_builtin d1) (Set_elm_builtin d2) =
Set_elm_builtin <| Dict.diff d1 d2
{-| Convert a set into a list, sorted from lowest to highest.
-}
toList : Set comparable -> List comparable
toList (Set_elm_builtin d) =
Dict.keys d
{-| Convert a list into a set, removing any duplicates.
-}
fromList : List comparable -> Set comparable
fromList xs = List.foldl insert empty xs
{-| Fold over the values in a set, in order from lowest to highest.
-}
foldl : (comparable -> b -> b) -> b -> Set comparable -> b
foldl f b (Set_elm_builtin d) =
Dict.foldl (\k _ b -> f k b) b d
{-| Fold over the values in a set, in order from highest to lowest.
-}
foldr : (comparable -> b -> b) -> b -> Set comparable -> b
foldr f b (Set_elm_builtin d) =
Dict.foldr (\k _ b -> f k b) b d
{-| Map a function onto a set, creating a new set with no duplicates.
-}
map : (comparable -> comparable2) -> Set comparable -> Set comparable2
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_elm_builtin d) =
Set_elm_builtin <| Dict.filter (\k _ -> p k) d
{-| 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_elm_builtin d) =
let
(p1, p2) = Dict.partition (\k _ -> p k) d
in
(Set_elm_builtin p1, Set_elm_builtin p2)

464
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/String.elm vendored Normal file
View File

@@ -0,0 +1,464 @@
module String exposing
( isEmpty, length, reverse, repeat
, cons, uncons, fromChar, append, concat, split, join, words, lines
, slice, left, right, dropLeft, dropRight
, contains, startsWith, endsWith, indexes, indices
, toInt, toFloat, toList, fromList
, toUpper, toLower, pad, padLeft, padRight, trim, trimLeft, trimRight
, map, filter, foldl, foldr, any, all
)
{-| A built-in representation for efficient string manipulation. String literals
are enclosed in `"double quotes"`. Strings are *not* lists of characters.
# Basics
@docs isEmpty, length, reverse, repeat
# Building and Splitting
@docs cons, uncons, fromChar, append, concat, split, join, words, lines
# Get Substrings
@docs slice, left, right, dropLeft, dropRight
# Check for Substrings
@docs contains, startsWith, endsWith, indexes, indices
# Conversions
@docs toInt, toFloat, toList, fromList
# Formatting
Cosmetic operations such as padding with extra characters or trimming whitespace.
@docs toUpper, toLower,
pad, padLeft, padRight,
trim, trimLeft, trimRight
# Higher-Order Functions
@docs map, filter, foldl, foldr, any, all
-}
import Native.String
import Char
import Maybe exposing (Maybe)
import Result exposing (Result)
{-| Determine if a string is empty.
isEmpty "" == True
isEmpty "the world" == False
-}
isEmpty : String -> Bool
isEmpty =
Native.String.isEmpty
{-| Add a character to the beginning of a string.
cons 'T' "he truth is out there" == "The truth is out there"
-}
cons : Char -> String -> String
cons =
Native.String.cons
{-| Create a string from a given character.
fromChar 'a' == "a"
-}
fromChar : Char -> String
fromChar char =
cons char ""
{-| Split a non-empty string into its head and tail. This lets you
pattern match on strings exactly as you would with lists.
uncons "abc" == Just ('a',"bc")
uncons "" == Nothing
-}
uncons : String -> Maybe (Char, String)
uncons =
Native.String.uncons
{-| Append two strings. You can also use [the `(++)` operator](Basics#++)
to do this.
append "butter" "fly" == "butterfly"
-}
append : String -> String -> String
append =
Native.String.append
{-| Concatenate many strings into one.
concat ["never","the","less"] == "nevertheless"
-}
concat : List String -> String
concat =
Native.String.concat
{-| Get the length of a string.
length "innumerable" == 11
length "" == 0
-}
length : String -> Int
length =
Native.String.length
{-| Transform every character in a string
map (\c -> if c == '/' then '.' else c) "a/b/c" == "a.b.c"
-}
map : (Char -> Char) -> String -> String
map =
Native.String.map
{-| Keep only the characters that satisfy the predicate.
filter isDigit "R2-D2" == "22"
-}
filter : (Char -> Bool) -> String -> String
filter =
Native.String.filter
{-| Reverse a string.
reverse "stressed" == "desserts"
-}
reverse : String -> String
reverse =
Native.String.reverse
{-| Reduce a string from the left.
foldl cons "" "time" == "emit"
-}
foldl : (Char -> b -> b) -> b -> String -> b
foldl =
Native.String.foldl
{-| Reduce a string from the right.
foldr cons "" "time" == "time"
-}
foldr : (Char -> b -> b) -> b -> String -> b
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", ""]
Use [`Regex.split`](Regex#split) if you need something more flexible.
-}
split : String -> String -> List String
split =
Native.String.split
{-| Put many strings together with a given separator.
join "a" ["H","w","ii","n"] == "Hawaiian"
join " " ["cat","dog","cow"] == "cat dog cow"
join "/" ["home","evan","Desktop"] == "home/evan/Desktop"
-}
join : String -> List String -> String
join =
Native.String.join
{-| Repeat a string *n* times.
repeat 3 "ha" == "hahaha"
-}
repeat : Int -> String -> String
repeat =
Native.String.repeat
{-| Take a substring given a start and end index. Negative indexes
are taken starting from the *end* of the list.
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"
-}
slice : Int -> Int -> String -> String
slice =
Native.String.slice
{-| Take *n* characters from the left side of a string.
left 2 "Mulder" == "Mu"
-}
left : Int -> String -> String
left =
Native.String.left
{-| Take *n* characters from the right side of a string.
right 2 "Scully" == "ly"
-}
right : Int -> String -> String
right =
Native.String.right
{-| Drop *n* characters from the left side of a string.
dropLeft 2 "The Lone Gunmen" == "e Lone Gunmen"
-}
dropLeft : Int -> String -> String
dropLeft =
Native.String.dropLeft
{-| Drop *n* characters from the right side of a string.
dropRight 2 "Cigarette Smoking Man" == "Cigarette Smoking M"
-}
dropRight : Int -> String -> String
dropRight =
Native.String.dropRight
{-| Pad a string on both sides until it has a given length.
pad 5 ' ' "1" == " 1 "
pad 5 ' ' "11" == " 11 "
pad 5 ' ' "121" == " 121 "
-}
pad : Int -> Char -> String -> String
pad =
Native.String.pad
{-| Pad a string on the left until it has a given length.
padLeft 5 '.' "1" == "....1"
padLeft 5 '.' "11" == "...11"
padLeft 5 '.' "121" == "..121"
-}
padLeft : Int -> Char -> String -> String
padLeft =
Native.String.padLeft
{-| Pad a string on the right until it has a given length.
padRight 5 '.' "1" == "1...."
padRight 5 '.' "11" == "11..."
padRight 5 '.' "121" == "121.."
-}
padRight : Int -> Char -> String -> String
padRight =
Native.String.padRight
{-| Get rid of whitespace on both sides of a string.
trim " hats \n" == "hats"
-}
trim : String -> String
trim =
Native.String.trim
{-| Get rid of whitespace on the left of a string.
trimLeft " hats \n" == "hats \n"
-}
trimLeft : String -> String
trimLeft =
Native.String.trimLeft
{-| Get rid of whitespace on the right of a string.
trimRight " hats \n" == " hats"
-}
trimRight : String -> String
trimRight =
Native.String.trimRight
{-| Break a string into words, splitting on chunks of whitespace.
words "How are \t you? \n Good?" == ["How","are","you?","Good?"]
-}
words : String -> List String
words =
Native.String.words
{-| Break a string into lines, splitting on newlines.
lines "How are you?\nGood?" == ["How are you?", "Good?"]
-}
lines : String -> List String
lines =
Native.String.lines
{-| Convert a string to all upper case. Useful for case-insensitive comparisons
and VIRTUAL YELLING.
toUpper "skinner" == "SKINNER"
-}
toUpper : String -> String
toUpper =
Native.String.toUpper
{-| Convert a string to all lower case. Useful for case-insensitive comparisons.
toLower "X-FILES" == "x-files"
-}
toLower : String -> String
toLower =
Native.String.toLower
{-| Determine whether *any* characters satisfy a predicate.
any isDigit "90210" == True
any isDigit "R2-D2" == True
any isDigit "heart" == False
-}
any : (Char -> Bool) -> String -> Bool
any =
Native.String.any
{-| Determine whether *all* characters satisfy a predicate.
all isDigit "90210" == True
all isDigit "R2-D2" == False
all isDigit "heart" == False
-}
all : (Char -> Bool) -> String -> Bool
all =
Native.String.all
{-| See if the second string contains the first one.
contains "the" "theory" == True
contains "hat" "theory" == False
contains "THE" "theory" == False
Use [`Regex.contains`](Regex#contains) if you need something more flexible.
-}
contains : String -> String -> Bool
contains =
Native.String.contains
{-| See if the second string starts with the first one.
startsWith "the" "theory" == True
startsWith "ory" "theory" == False
-}
startsWith : String -> String -> Bool
startsWith =
Native.String.startsWith
{-| See if the second string ends with the first one.
endsWith "the" "theory" == False
endsWith "ory" "theory" == True
-}
endsWith : String -> String -> Bool
endsWith =
Native.String.endsWith
{-| Get all of the indexes for a substring in another string.
indexes "i" "Mississippi" == [1,4,7,10]
indexes "ss" "Mississippi" == [2,5]
indexes "needle" "haystack" == []
-}
indexes : String -> String -> List Int
indexes =
Native.String.indexes
{-| Alias for `indexes`. -}
indices : String -> String -> List Int
indices =
Native.String.indexes
{-| Try to convert a string into an int, failing on improperly formatted strings.
String.toInt "123" == Ok 123
String.toInt "-42" == Ok -42
String.toInt "3.1" == Err "could not convert string '3.1' to an Int"
String.toInt "31a" == Err "could not convert string '31a' to an Int"
If you are extracting a number from some raw user input, you will typically
want to use [`Result.withDefault`](Result#withDefault) to handle bad data:
Result.withDefault 0 (String.toInt "42") == 42
Result.withDefault 0 (String.toInt "ab") == 0
-}
toInt : String -> Result String Int
toInt =
Native.String.toInt
{-| Try to convert a string into a float, failing on improperly formatted strings.
String.toFloat "123" == Ok 123.0
String.toFloat "-42" == Ok -42.0
String.toFloat "3.1" == Ok 3.1
String.toFloat "31a" == Err "could not convert string '31a' to a Float"
If you are extracting a number from some raw user input, you will typically
want to use [`Result.withDefault`](Result#withDefault) to handle bad data:
Result.withDefault 0 (String.toFloat "42.5") == 42.5
Result.withDefault 0 (String.toFloat "cats") == 0
-}
toFloat : String -> Result String Float
toFloat =
Native.String.toFloat
{-| Convert a string to a list of characters.
toList "abc" == ['a','b','c']
-}
toList : String -> List Char
toList =
Native.String.toList
{-| Convert a list of characters into a String. Can be useful if you
want to create a string primarily by consing, perhaps for decoding
something.
fromList ['a','b','c'] == "abc"
-}
fromList : List Char -> String
fromList =
Native.String.fromList

277
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Task.elm vendored Normal file
View File

@@ -0,0 +1,277 @@
effect module Task where { command = MyCmd } exposing
( Task
, succeed, fail
, map, map2, map3, map4, map5
, sequence
, andThen
, onError, mapError
, perform, attempt
)
{-| Tasks make it easy to describe asynchronous operations that may fail, like
HTTP requests or writing to a database. For more information, see the [Elm
documentation on Tasks](http://guide.elm-lang.org/error_handling/task.html).
# Basics
@docs Task, succeed, fail
# Mapping
@docs map, map2, map3, map4, map5
# Chaining
@docs andThen, sequence
# Errors
@docs onError, mapError
# Commands
@docs perform, attempt
-}
import Basics exposing (Never, (|>), (<<))
import List exposing ((::))
import Maybe exposing (Maybe(Just,Nothing))
import Native.Scheduler
import Platform
import Platform.Cmd exposing (Cmd)
import Result exposing (Result(Ok,Err))
{-| Represents asynchronous effects that may fail. It is useful for stuff like
HTTP.
For example, maybe we have a task with the type (`Task String User`). This means
that when we perform the task, it will either fail with a `String` message or
succeed with a `User`. So this could represent a task that is asking a server
for a certain user.
-}
type alias Task err ok =
Platform.Task err ok
-- BASICS
{-| A task that succeeds immediately when run.
succeed 42 -- results in 42
-}
succeed : a -> Task x a
succeed =
Native.Scheduler.succeed
{-| A task that fails immediately when run.
fail "file not found" : Task String a
-}
fail : x -> Task x a
fail =
Native.Scheduler.fail
-- MAPPING
{-| Transform a task.
map sqrt (succeed 9) -- succeed 3
-}
map : (a -> b) -> Task x a -> Task x b
map func taskA =
taskA
|> andThen (\a -> succeed (func a))
{-| Put the results of two tasks together. If either task fails, the whole
thing fails. It also runs in order so the first task will be completely
finished before the second task starts.
map2 (+) (succeed 9) (succeed 3) -- succeed 12
-}
map2 : (a -> b -> result) -> Task x a -> Task x b -> Task x result
map2 func taskA taskB =
taskA
|> andThen (\a -> taskB
|> andThen (\b -> succeed (func a b)))
{-|-}
map3 : (a -> b -> c -> result) -> Task x a -> Task x b -> Task x c -> Task x result
map3 func taskA taskB taskC =
taskA
|> andThen (\a -> taskB
|> andThen (\b -> taskC
|> andThen (\c -> succeed (func a b c))))
{-|-}
map4 : (a -> b -> c -> d -> result) -> Task x a -> Task x b -> Task x c -> Task x d -> Task x result
map4 func taskA taskB taskC taskD =
taskA
|> andThen (\a -> taskB
|> andThen (\b -> taskC
|> andThen (\c -> taskD
|> andThen (\d -> succeed (func a b c d)))))
{-|-}
map5 : (a -> b -> c -> d -> e -> result) -> Task x a -> Task x b -> Task x c -> Task x d -> Task x e -> Task x result
map5 func taskA taskB taskC taskD taskE =
taskA
|> andThen (\a -> taskB
|> andThen (\b -> taskC
|> andThen (\c -> taskD
|> andThen (\d -> taskE
|> andThen (\e -> succeed (func a b c d e))))))
{-| Start with a list of tasks, and turn them into a single task that returns a
list. The tasks will be run in order one-by-one and if any task fails the whole
sequence fails.
sequence [ succeed 1, succeed 2 ] -- succeed [ 1, 2 ]
This can be useful if you need to make a bunch of HTTP requests one-by-one.
-}
sequence : List (Task x a) -> Task x (List a)
sequence tasks =
case tasks of
[] ->
succeed []
task :: remainingTasks ->
map2 (::) task (sequence remainingTasks)
-- CHAINING
{-| Chain together a task and a callback. The first task will run, and if it is
successful, you give the result to the callback resulting in another task. This
task then gets run.
succeed 2
|> andThen (\n -> succeed (n + 2))
-- succeed 4
This is useful for chaining tasks together. Maybe you need to get a user from
your servers *and then* lookup their picture once you know their name.
-}
andThen : (a -> Task x b) -> Task x a -> Task x b
andThen =
Native.Scheduler.andThen
-- ERRORS
{-| Recover from a failure in a task. If the given task fails, we use the
callback to recover.
fail "file not found"
|> onError (\msg -> succeed 42)
-- succeed 42
succeed 9
|> onError (\msg -> succeed 42)
-- succeed 9
-}
onError : (x -> Task y a) -> Task x a -> Task y a
onError =
Native.Scheduler.onError
{-| Transform the error value. This can be useful if you need a bunch of error
types to match up.
type Error = Http Http.Error | WebGL WebGL.Error
getResources : Task Error Resource
getResources =
sequence [ mapError Http serverTask, mapError WebGL textureTask ]
-}
mapError : (x -> y) -> Task x a -> Task y a
mapError convert task =
task
|> onError (fail << convert)
-- COMMANDS
type MyCmd msg =
Perform (Task Never msg)
{-| The only way to *do* things in Elm is to give commands to the Elm runtime.
So we describe some complex behavior with a `Task` and then command the runtime
to `perform` that task. For example, getting the current time looks like this:
import Task
import Time exposing (Time)
type Msg = Click | NewTime Time
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
Click ->
( model, Task.perform NewTime Time.now )
NewTime time ->
...
-}
perform : (a -> msg) -> Task Never a -> Cmd msg
perform toMessage task =
command (Perform (map toMessage task))
{-| Command the Elm runtime to attempt a task that might fail!
-}
attempt : (Result x a -> msg) -> Task x a -> Cmd msg
attempt resultToMessage task =
command (Perform (
task
|> andThen (succeed << resultToMessage << Ok)
|> onError (succeed << resultToMessage << Err)
))
cmdMap : (a -> b) -> MyCmd a -> MyCmd b
cmdMap tagger (Perform task) =
Perform (map tagger task)
-- MANAGER
init : Task Never ()
init =
succeed ()
onEffects : Platform.Router msg Never -> List (MyCmd msg) -> () -> Task Never ()
onEffects router commands state =
map
(\_ -> ())
(sequence (List.map (spawnCmd router) commands))
onSelfMsg : Platform.Router msg Never -> Never -> () -> Task Never ()
onSelfMsg _ _ _ =
succeed ()
spawnCmd : Platform.Router msg Never -> MyCmd msg -> Task x ()
spawnCmd router (Perform task) =
Native.Scheduler.spawn (
task
|> andThen (Platform.sendToApp router)
)

243
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Time.elm vendored Normal file
View File

@@ -0,0 +1,243 @@
effect module Time where { subscription = MySub } exposing
( Time
, now, every
, millisecond, second, minute, hour
, inMilliseconds, inSeconds, inMinutes, inHours
)
{-| Library for working with time.
# Time
@docs Time, now, every
# Units
@docs millisecond, second, minute, hour,
inMilliseconds, inSeconds, inMinutes, inHours
-}
import Basics exposing (..)
import Dict
import List exposing ((::))
import Maybe exposing (Maybe(..))
import Native.Scheduler
import Native.Time
import Platform
import Platform.Sub exposing (Sub)
import Task exposing (Task)
-- TIMES
{-| Type alias to make it clearer when you are working with time values.
Using the `Time` helpers like `second` and `inSeconds` instead of raw numbers
is very highly recommended.
-}
type alias Time = Float
{-| Get the `Time` at the moment when this task is run.
-}
now : Task x Time
now =
Native.Time.now
{-| Subscribe to the current time. First you provide an interval describing how
frequently you want updates. Second, you give a tagger that turns a time into a
message for your `update` function. So if you want to hear about the current
time every second, you would say something like this:
type Msg = Tick Time | ...
subscriptions model =
every second Tick
Check out the [Elm Architecture Tutorial][arch] for more info on how
subscriptions work.
[arch]: https://github.com/evancz/elm-architecture-tutorial/
**Note:** this function is not for animation! You need to use something based
on `requestAnimationFrame` to get smooth animations. This is based on
`setInterval` which is better for recurring tasks like “check on something
every 30 seconds”.
-}
every : Time -> (Time -> msg) -> Sub msg
every interval tagger =
subscription (Every interval tagger)
-- UNITS
{-| Units of time, making it easier to specify things like a half-second
`(500 * millisecond)` without remembering Elm&rsquo;s underlying units of time.
-}
millisecond : Time
millisecond =
1
{-|-}
second : Time
second =
1000 * millisecond
{-|-}
minute : Time
minute =
60 * second
{-|-}
hour : Time
hour =
60 * minute
{-|-}
inMilliseconds : Time -> Float
inMilliseconds t =
t
{-|-}
inSeconds : Time -> Float
inSeconds t =
t / second
{-|-}
inMinutes : Time -> Float
inMinutes t =
t / minute
{-|-}
inHours : Time -> Float
inHours t =
t / hour
-- SUBSCRIPTIONS
type MySub msg =
Every Time (Time -> msg)
subMap : (a -> b) -> MySub a -> MySub b
subMap f (Every interval tagger) =
Every interval (f << tagger)
-- EFFECT MANAGER
type alias State msg =
{ taggers : Taggers msg
, processes : Processes
}
type alias Processes =
Dict.Dict Time Platform.ProcessId
type alias Taggers msg =
Dict.Dict Time (List (Time -> msg))
init : Task Never (State msg)
init =
Task.succeed (State Dict.empty Dict.empty)
onEffects : Platform.Router msg Time -> List (MySub msg) -> State msg -> Task Never (State msg)
onEffects router subs {processes} =
let
newTaggers =
List.foldl addMySub Dict.empty subs
leftStep interval taggers (spawnList, existingDict, killTask) =
(interval :: spawnList, existingDict, killTask)
bothStep interval taggers id (spawnList, existingDict, killTask) =
(spawnList, Dict.insert interval id existingDict, killTask)
rightStep _ id (spawnList, existingDict, killTask) =
( spawnList
, existingDict
, Native.Scheduler.kill id
|> Task.andThen (\_ -> killTask)
)
(spawnList, existingDict, killTask) =
Dict.merge
leftStep
bothStep
rightStep
newTaggers
processes
([], Dict.empty, Task.succeed ())
in
killTask
|> Task.andThen (\_ -> spawnHelp router spawnList existingDict)
|> Task.andThen (\newProcesses -> Task.succeed (State newTaggers newProcesses))
addMySub : MySub msg -> Taggers msg -> Taggers msg
addMySub (Every interval tagger) state =
case Dict.get interval state of
Nothing ->
Dict.insert interval [tagger] state
Just taggers ->
Dict.insert interval (tagger :: taggers) state
spawnHelp : Platform.Router msg Time -> List Time -> Processes -> Task.Task x Processes
spawnHelp router intervals processes =
case intervals of
[] ->
Task.succeed processes
interval :: rest ->
let
spawnTimer =
Native.Scheduler.spawn (setInterval interval (Platform.sendToSelf router interval))
spawnRest id =
spawnHelp router rest (Dict.insert interval id processes)
in
spawnTimer
|> Task.andThen spawnRest
onSelfMsg : Platform.Router msg Time -> Time -> State msg -> Task Never (State msg)
onSelfMsg router interval state =
case Dict.get interval state.taggers of
Nothing ->
Task.succeed state
Just taggers ->
let
tellTaggers time =
Task.sequence (List.map (\tagger -> Platform.sendToApp router (tagger time)) taggers)
in
now
|> Task.andThen tellTaggers
|> Task.andThen (\_ -> Task.succeed state)
setInterval : Time -> Task Never () -> Task x Never
setInterval =
Native.Time.setInterval_

61
part4/elm-stuff/packages/elm-lang/core/5.1.1/src/Tuple.elm vendored Normal file
View File

@@ -0,0 +1,61 @@
module Tuple exposing
( first, second
, mapFirst, mapSecond
)
{-| Some helpers for working with 2-tuples.
**Note:** For larger chunks of data, it is best to switch to using records. So
instead of representing a 3D point as `(3,4,5)` and wondering why there are no
helper functions, represent it as `{ x = 3, y = 4, z = 5 }` and use all the
built-in syntax for records.
@docs first, second, mapFirst, mapSecond
-}
{-| Extract the first value from a tuple.
first (3, 4) == 3
first ("john", "doe") == "john"
-}
first : (a1, a2) -> a1
first (x,_) =
x
{-| Extract the second value from a tuple.
second (3, 4) == 4
second ("john", "doe") == "doe"
-}
second : (a1, a2) -> a2
second (_,y) =
y
{-| Transform the first value in a tuple.
import String
mapFirst String.reverse ("stressed", 16) == ("desserts", 16)
mapFirst String.length ("stressed", 16) == (8, 16)
-}
mapFirst : (a -> b) -> (a, a2) -> (b, a2)
mapFirst func (x,y) =
(func x, y)
{-| Transform the second value in a tuple.
import String
mapSecond sqrt ("stressed", 16) == ("stressed", 4)
mapSecond (\x -> x + 1) ("stressed", 16) == ("stressed", 17)
-}
mapSecond : (a -> b) -> (a1, a) -> (a1, b)
mapSecond func (x,y) =
(x, func y)

50
part4/elm-stuff/packages/elm-lang/core/5.1.1/tests/Main.elm vendored Normal file
View File

@@ -0,0 +1,50 @@
port module Main exposing (..)
import Basics exposing (..)
import Task exposing (..)
import Test exposing (..)
import Platform.Cmd exposing (Cmd)
import Json.Decode exposing (Value)
import Test.Runner.Node exposing (run, TestProgram)
import Test.Array as Array
import Test.Basics as Basics
import Test.Bitwise as Bitwise
import Test.Char as Char
import Test.CodeGen as CodeGen
import Test.Dict as Dict
import Test.Maybe as Maybe
import Test.Equality as Equality
import Test.Json as Json
import Test.List as List
import Test.Result as Result
import Test.Set as Set
import Test.String as String
import Test.Regex as Regex
tests : Test
tests =
describe "Elm Standard Library Tests"
[ Array.tests
, Basics.tests
, Bitwise.tests
, Char.tests
, CodeGen.tests
, Dict.tests
, Equality.tests
, Json.tests
, List.tests
, Result.tests
, Set.tests
, String.tests
, Regex.tests
, Maybe.tests
]
main : TestProgram
main =
run emit tests
port emit : ( String, Value ) -> Cmd msg

120
part4/elm-stuff/packages/elm-lang/core/5.1.1/tests/Test/Array.elm vendored Normal file
View File

@@ -0,0 +1,120 @@
module Test.Array exposing (tests)
import Array
import Basics exposing (..)
import List
import List exposing ((::))
import Maybe exposing (..)
import Native.Array
import Test exposing (..)
import Expect
mergeSplit : Int -> Array.Array a -> Array.Array a
mergeSplit n arr =
let
left =
Array.slice 0 n arr
right =
Array.slice n (Array.length arr) arr
in
Array.append left right
holeArray : Array.Array Int
holeArray =
List.foldl mergeSplit (Array.fromList (List.range 0 100)) (List.range 0 100)
mapArray : Array.Array a -> Array.Array a
mapArray array =
Array.indexedMap
(\i el ->
case (Array.get i array) of
Just x ->
x
Nothing ->
el
)
array
tests : Test
tests =
let
creationTests =
describe "Creation"
[ test "empty" <| \() -> Expect.equal Array.empty (Array.fromList [])
, test "initialize" <| \() -> Expect.equal (Array.initialize 4 identity) (Array.fromList [ 0, 1, 2, 3 ])
, test "initialize 2" <| \() -> Expect.equal (Array.initialize 4 (\n -> n * n)) (Array.fromList [ 0, 1, 4, 9 ])
, test "initialize 3" <| \() -> Expect.equal (Array.initialize 4 (always 0)) (Array.fromList [ 0, 0, 0, 0 ])
, test "initialize Empty" <| \() -> Expect.equal (Array.initialize 0 identity) Array.empty
, test "initialize 4" <| \() -> Expect.equal (Array.initialize 2 (always 0)) (Array.fromList [ 0, 0 ])
, test "initialize negative" <| \() -> Expect.equal (Array.initialize -1 identity) Array.empty
, test "repeat" <| \() -> Expect.equal (Array.repeat 5 40) (Array.fromList [ 40, 40, 40, 40, 40 ])
, test "repeat 2" <| \() -> Expect.equal (Array.repeat 5 0) (Array.fromList [ 0, 0, 0, 0, 0 ])
, test "repeat 3" <| \() -> Expect.equal (Array.repeat 3 "cat") (Array.fromList [ "cat", "cat", "cat" ])
, test "fromList" <| \() -> Expect.equal (Array.fromList []) Array.empty
]
basicsTests =
describe "Basics"
[ test "length" <| \() -> Expect.equal 3 (Array.length (Array.fromList [ 1, 2, 3 ]))
, test "length - Long" <| \() -> Expect.equal 10000 (Array.length (Array.repeat 10000 0))
, test "push" <| \() -> Expect.equal (Array.fromList [ 1, 2, 3 ]) (Array.push 3 (Array.fromList [ 1, 2 ]))
, test "append" <| \() -> Expect.equal [ 42, 42, 81, 81, 81 ] (Array.toList (Array.append (Array.repeat 2 42) (Array.repeat 3 81)))
, test "appendEmpty 1" <| \() -> Expect.equal (List.range 1 33) (Array.toList (Array.append Array.empty (Array.fromList <| List.range 1 33)))
, test "appendEmpty 2" <| \() -> Expect.equal (List.range 1 33) (Array.toList (Array.append (Array.fromList <| List.range 1 33) Array.empty))
, test "appendSmall 1" <| \() -> Expect.equal (List.range 1 33) (Array.toList (Array.append (Array.fromList <| List.range 1 30) (Array.fromList <| List.range 31 33)))
, test "appendSmall 2" <| \() -> Expect.equal (List.range 1 33) (Array.toList (Array.append (Array.fromList <| List.range 1 3) (Array.fromList <| List.range 4 33)))
, test "appendAndSlice" <| \() -> Expect.equal (List.range 0 100) (Array.toList holeArray)
]
getAndSetTests =
describe "Get and Set"
[ test "get" <| \() -> Expect.equal (Just 2) (Array.get 1 (Array.fromList [ 3, 2, 1 ]))
, test "get 2" <| \() -> Expect.equal Nothing (Array.get 5 (Array.fromList [ 3, 2, 1 ]))
, test "get 3" <| \() -> Expect.equal Nothing (Array.get -1 (Array.fromList [ 3, 2, 1 ]))
, test "set" <| \() -> Expect.equal (Array.fromList [ 1, 7, 3 ]) (Array.set 1 7 (Array.fromList [ 1, 2, 3 ]))
]
takingArraysApartTests =
describe "Taking Arrays Apart"
[ test "toList" <| \() -> Expect.equal [ 3, 5, 8 ] (Array.toList (Array.fromList [ 3, 5, 8 ]))
, test "toIndexedList" <| \() -> Expect.equal [ ( 0, "cat" ), ( 1, "dog" ) ] (Array.toIndexedList (Array.fromList [ "cat", "dog" ]))
, test "slice 1" <| \() -> Expect.equal (Array.fromList [ 0, 1, 2 ]) (Array.slice 0 3 (Array.fromList [ 0, 1, 2, 3, 4 ]))
, test "slice 2" <| \() -> Expect.equal (Array.fromList [ 1, 2, 3 ]) (Array.slice 1 4 (Array.fromList [ 0, 1, 2, 3, 4 ]))
, test "slice 3" <| \() -> Expect.equal (Array.fromList [ 1, 2, 3 ]) (Array.slice 1 -1 (Array.fromList [ 0, 1, 2, 3, 4 ]))
, test "slice 4" <| \() -> Expect.equal (Array.fromList [ 2 ]) (Array.slice -3 -2 (Array.fromList [ 0, 1, 2, 3, 4 ]))
, test "slice 5" <| \() -> Expect.equal 63 (Array.length <| Array.slice 65 (65 + 63) <| Array.fromList (List.range 1 200))
]
mappingAndFoldingTests =
describe "Mapping and Folding"
[ test "map" <| \() -> Expect.equal (Array.fromList [ 1, 2, 3 ]) (Array.map sqrt (Array.fromList [ 1, 4, 9 ]))
, test "indexedMap 1" <| \() -> Expect.equal (Array.fromList [ 0, 5, 10 ]) (Array.indexedMap (*) (Array.fromList [ 5, 5, 5 ]))
, test "indexedMap 2" <| \() -> Expect.equal (List.range 0 99) (Array.toList (Array.indexedMap always (Array.repeat 100 0)))
, test "large indexed map" <| \() -> Expect.equal (List.range 0 <| 32768 - 1) (Array.toList <| mapArray <| Array.initialize 32768 identity)
, test "foldl 1" <| \() -> Expect.equal [ 3, 2, 1 ] (Array.foldl (::) [] (Array.fromList [ 1, 2, 3 ]))
, test "foldl 2" <| \() -> Expect.equal 33 (Array.foldl (+) 0 (Array.repeat 33 1))
, test "foldr 1" <| \() -> Expect.equal 15 (Array.foldr (+) 0 (Array.repeat 3 5))
, test "foldr 2" <| \() -> Expect.equal [ 1, 2, 3 ] (Array.foldr (::) [] (Array.fromList [ 1, 2, 3 ]))
, test "foldr 3" <| \() -> Expect.equal 53 (Array.foldr (-) 54 (Array.fromList [ 10, 11 ]))
, test "filter" <| \() -> Expect.equal (Array.fromList [ 2, 4, 6 ]) (Array.filter (\x -> x % 2 == 0) (Array.fromList <| List.range 1 6))
]
nativeTests =
describe "Conversion to JS Arrays"
[ test "jsArrays" <| \() -> Expect.equal (Array.fromList <| List.range 1 1100) (Native.Array.fromJSArray (Native.Array.toJSArray (Array.fromList <| List.range 1 1100)))
]
in
describe "Array"
[ creationTests
, basicsTests
, getAndSetTests
, takingArraysApartTests
, mappingAndFoldingTests
, nativeTests
]

220
part4/elm-stuff/packages/elm-lang/core/5.1.1/tests/Test/Basics.elm vendored Normal file
View File

@@ -0,0 +1,220 @@
module Test.Basics exposing (tests)
import Array
import Tuple exposing (first, second)
import Basics exposing (..)
import Date
import Set
import Dict
import Test exposing (..)
import Expect
import List
import String
tests : Test
tests =
let
comparison =
describe "Comparison"
[ test "max" <| \() -> Expect.equal 42 (max 32 42)
, test "min" <| \() -> Expect.equal 42 (min 91 42)
, test "clamp low" <| \() -> Expect.equal 10 (clamp 10 20 5)
, test "clamp mid" <| \() -> Expect.equal 15 (clamp 10 20 15)
, test "clamp high" <| \() -> Expect.equal 20 (clamp 10 20 25)
, test "5 < 6" <| \() -> Expect.equal True (5 < 6)
, test "6 < 5" <| \() -> Expect.equal False (6 < 5)
, test "6 < 6" <| \() -> Expect.equal False (6 < 6)
, test "5 > 6" <| \() -> Expect.equal False (5 > 6)
, test "6 > 5" <| \() -> Expect.equal True (6 > 5)
, test "6 > 6" <| \() -> Expect.equal False (6 > 6)
, test "5 <= 6" <| \() -> Expect.equal True (5 <= 6)
, test "6 <= 5" <| \() -> Expect.equal False (6 <= 5)
, test "6 <= 6" <| \() -> Expect.equal True (6 <= 6)
, test "compare \"A\" \"B\"" <| \() -> Expect.equal LT (compare "A" "B")
, test "compare 'f' 'f'" <| \() -> Expect.equal EQ (compare 'f' 'f')
, test "compare (1, 2, 3, 4, 5, 6) (0, 1, 2, 3, 4, 5)" <| \() -> Expect.equal GT (compare ( 1, 2, 3, 4, 5, 6 ) ( 0, 1, 2, 3, 4, 5 ))
, test "compare ['a'] ['b']" <| \() -> Expect.equal LT (compare [ 'a' ] [ 'b' ])
, test "array equality" <| \() -> Expect.equal (Array.fromList [ 1, 1, 1, 1 ]) (Array.repeat 4 1)
, test "set equality" <| \() -> Expect.equal (Set.fromList [ 1, 2 ]) (Set.fromList [ 2, 1 ])
, test "dict equality" <| \() -> Expect.equal (Dict.fromList [ ( 1, 1 ), ( 2, 2 ) ]) (Dict.fromList [ ( 2, 2 ), ( 1, 1 ) ])
, test "char equality" <| \() -> Expect.notEqual '0' '饑'
, test "date equality" <| \() -> Expect.equal (Date.fromString "2/7/1992") (Date.fromString "2/7/1992")
, test "date equality" <| \() -> Expect.notEqual (Date.fromString "11/16/1995") (Date.fromString "2/7/1992")
]
toStringTests =
describe "toString Tests"
[ test "toString Int" <| \() -> Expect.equal "42" (toString 42)
, test "toString Float" <| \() -> Expect.equal "42.52" (toString 42.52)
, test "toString Char" <| \() -> Expect.equal "'c'" (toString 'c')
, test "toString Char single quote" <| \() -> Expect.equal "'\\''" (toString '\'')
, test "toString Char double quote" <| \() -> Expect.equal "'\"'" (toString '"')
, test "toString String single quote" <| \() -> Expect.equal "\"not 'escaped'\"" (toString "not 'escaped'")
, test "toString String double quote" <| \() -> Expect.equal "\"are \\\"escaped\\\"\"" (toString "are \"escaped\"")
, test "toString record" <| \() -> Expect.equal "{ field = [0] }" (toString { field = [ 0 ] })
-- TODO
--, test "toString record, special case" <| \() -> Expect.equal "{ ctor = [0] }" (toString { ctor = [ 0 ] })
]
trigTests =
describe "Trigonometry Tests"
[ test "radians 0" <| \() -> Expect.equal 0 (radians 0)
, test "radians positive" <| \() -> Expect.equal 5 (radians 5)
, test "radians negative" <| \() -> Expect.equal -5 (radians -5)
, test "degrees 0" <| \() -> Expect.equal 0 (degrees 0)
, test "degrees 90" <| \() -> Expect.lessThan 0.01 (abs (1.57 - degrees 90))
-- This should test to enough precision to know if anything's breaking
, test "degrees -145" <| \() -> Expect.lessThan 0.01 (abs (-2.53 - degrees -145))
-- This should test to enough precision to know if anything's breaking
, test "turns 0" <| \() -> Expect.equal 0 (turns 0)
, test "turns 8" <| \() -> Expect.lessThan 0.01 (abs (50.26 - turns 8))
-- This should test to enough precision to know if anything's breaking
, test "turns -133" <| \() -> Expect.lessThan 0.01 (abs (-835.66 - turns -133))
-- This should test to enough precision to know if anything's breaking
, test "fromPolar (0, 0)" <| \() -> Expect.equal ( 0, 0 ) (fromPolar ( 0, 0 ))
, test "fromPolar (1, 0)" <| \() -> Expect.equal ( 1, 0 ) (fromPolar ( 1, 0 ))
, test "fromPolar (0, 1)" <| \() -> Expect.equal ( 0, 0 ) (fromPolar ( 0, 1 ))
, test "fromPolar (1, 1)" <|
\() ->
Expect.equal True
(let
( x, y ) =
fromPolar ( 1, 1 )
in
0.54 - x < 0.01 && 0.84 - y < 0.01
)
, test "toPolar (0, 0)" <| \() -> Expect.equal ( 0, 0 ) (toPolar ( 0, 0 ))
, test "toPolar (1, 0)" <| \() -> Expect.equal ( 1, 0 ) (toPolar ( 1, 0 ))
, test "toPolar (0, 1)" <|
\() ->
Expect.equal True
(let
( r, theta ) =
toPolar ( 0, 1 )
in
r == 1 && abs (1.57 - theta) < 0.01
)
, test "toPolar (1, 1)" <|
\() ->
Expect.equal True
(let
( r, theta ) =
toPolar ( 1, 1 )
in
abs (1.41 - r) < 0.01 && abs (0.78 - theta) < 0.01
)
, test "cos" <| \() -> Expect.equal 1 (cos 0)
, test "sin" <| \() -> Expect.equal 0 (sin 0)
, test "tan" <| \() -> Expect.lessThan 0.01 (abs (12.67 - tan 17.2))
, test "acos" <| \() -> Expect.lessThan 0.01 (abs (3.14 - acos -1))
, test "asin" <| \() -> Expect.lessThan 0.01 (abs (0.3 - asin 0.3))
, test "atan" <| \() -> Expect.lessThan 0.01 (abs (1.57 - atan 4567.8))
, test "atan2" <| \() -> Expect.lessThan 0.01 (abs (1.55 - atan2 36 0.65))
, test "pi" <| \() -> Expect.lessThan 0.01 (abs (3.14 - pi))
]
basicMathTests =
describe "Basic Math Tests"
[ test "add float" <| \() -> Expect.equal 159 (155.6 + 3.4)
, test "add int" <| \() -> Expect.equal 17 ((round 10) + (round 7))
, test "subtract float" <| \() -> Expect.equal -6.3 (1 - 7.3)
, test "subtract int" <| \() -> Expect.equal 1130 ((round 9432) - (round 8302))
, test "multiply float" <| \() -> Expect.equal 432 (96 * 4.5)
, test "multiply int" <| \() -> Expect.equal 90 ((round 10) * (round 9))
, test "divide float" <| \() -> Expect.equal 13.175 (527 / 40)
, test "divide int" <| \() -> Expect.equal 23 (70 // 3)
, test "2 |> rem 7" <| \() -> Expect.equal 1 (2 |> rem 7)
, test "4 |> rem -1" <| \() -> Expect.equal -1 (4 |> rem -1)
, test "7 % 2" <| \() -> Expect.equal 1 (7 % 2)
, test "-1 % 4" <| \() -> Expect.equal 3 (-1 % 4)
, test "3^2" <| \() -> Expect.equal 9 (3 ^ 2)
, test "sqrt" <| \() -> Expect.equal 9 (sqrt 81)
, test "negate 42" <| \() -> Expect.equal -42 (negate 42)
, test "negate -42" <| \() -> Expect.equal 42 (negate -42)
, test "negate 0" <| \() -> Expect.equal 0 (negate 0)
, test "abs -25" <| \() -> Expect.equal 25 (abs -25)
, test "abs 76" <| \() -> Expect.equal 76 (abs 76)
, test "logBase 10 100" <| \() -> Expect.equal 2 (logBase 10 100)
, test "logBase 2 256" <| \() -> Expect.equal 8 (logBase 2 256)
, test "e" <| \() -> Expect.lessThan 0.01 (abs (2.72 - e))
]
booleanTests =
describe "Boolean Tests"
[ test "False && False" <| \() -> Expect.equal False (False && False)
, test "False && True" <| \() -> Expect.equal False (False && True)
, test "True && False" <| \() -> Expect.equal False (True && False)
, test "True && True" <| \() -> Expect.equal True (True && True)
, test "False || False" <| \() -> Expect.equal False (False || False)
, test "False || True" <| \() -> Expect.equal True (False || True)
, test "True || False" <| \() -> Expect.equal True (True || False)
, test "True || True" <| \() -> Expect.equal True (True || True)
, test "xor False False" <| \() -> Expect.equal False (xor False False)
, test "xor False True" <| \() -> Expect.equal True (xor False True)
, test "xor True False" <| \() -> Expect.equal True (xor True False)
, test "xor True True" <| \() -> Expect.equal False (xor True True)
, test "not True" <| \() -> Expect.equal False (not True)
, test "not False" <| \() -> Expect.equal True (not False)
]
conversionTests =
describe "Conversion Tests"
[ test "round 0.6" <| \() -> Expect.equal 1 (round 0.6)
, test "round 0.4" <| \() -> Expect.equal 0 (round 0.4)
, test "round 0.5" <| \() -> Expect.equal 1 (round 0.5)
, test "truncate -2367.9267" <| \() -> Expect.equal -2367 (truncate -2367.9267)
, test "floor -2367.9267" <| \() -> Expect.equal -2368 (floor -2367.9267)
, test "ceiling 37.2" <| \() -> Expect.equal 38 (ceiling 37.2)
, test "toFloat 25" <| \() -> Expect.equal 25 (toFloat 25)
]
miscTests =
describe "Miscellaneous Tests"
[ test "isNaN (0/0)" <| \() -> Expect.equal True (isNaN (0 / 0))
, test "isNaN (sqrt -1)" <| \() -> Expect.equal True (isNaN (sqrt -1))
, test "isNaN (1/0)" <| \() -> Expect.equal False (isNaN (1 / 0))
, test "isNaN 1" <| \() -> Expect.equal False (isNaN 1)
, test "isInfinite (0/0)" <| \() -> Expect.equal False (isInfinite (0 / 0))
, test "isInfinite (sqrt -1)" <| \() -> Expect.equal False (isInfinite (sqrt -1))
, test "isInfinite (1/0)" <| \() -> Expect.equal True (isInfinite (1 / 0))
, test "isInfinite 1" <| \() -> Expect.equal False (isInfinite 1)
, test "\"hello\" ++ \"world\"" <| \() -> Expect.equal "helloworld" ("hello" ++ "world")
, test "[1, 1, 2] ++ [3, 5, 8]" <| \() -> Expect.equal [ 1, 1, 2, 3, 5, 8 ] ([ 1, 1, 2 ] ++ [ 3, 5, 8 ])
, test "first (1, 2)" <| \() -> Expect.equal 1 (first ( 1, 2 ))
, test "second (1, 2)" <| \() -> Expect.equal 2 (second ( 1, 2 ))
]
higherOrderTests =
describe "Higher Order Helpers"
[ test "identity 'c'" <| \() -> Expect.equal 'c' (identity 'c')
, test "always 42 ()" <| \() -> Expect.equal 42 (always 42 ())
, test "<|" <| \() -> Expect.equal 9 (identity <| 3 + 6)
, test "|>" <| \() -> Expect.equal 9 (3 + 6 |> identity)
, test "<<" <| \() -> Expect.equal True (not << xor True <| True)
, test "<<" <| \() -> Expect.equal True (not << xor True <| True)
, describe ">>"
[ test "with xor" <|
\() ->
(True |> xor True >> not)
|> Expect.equal True
, test "with a record accessor" <|
\() ->
[ { foo = "NaS", bar = "baz" } ]
|> List.map (.foo >> String.reverse)
|> Expect.equal [ "SaN" ]
]
, test "flip" <| \() -> Expect.equal 10 ((flip (//)) 2 20)
, test "curry" <| \() -> Expect.equal 1 ((curry (\( a, b ) -> a + b)) -5 6)
, test "uncurry" <| \() -> Expect.equal 1 ((uncurry (+)) ( -5, 6 ))
]
in
describe "Basics"
[ comparison
, toStringTests
, trigTests
, basicMathTests
, booleanTests
, miscTests
, higherOrderTests
]

51
part4/elm-stuff/packages/elm-lang/core/5.1.1/tests/Test/Bitwise.elm vendored Normal file
View File

@@ -0,0 +1,51 @@
module Test.Bitwise exposing (tests)
import Basics exposing (..)
import Bitwise
import Test exposing (..)
import Expect
tests : Test
tests =
describe "Bitwise"
[ describe "and"
[ test "and with 32 bit integers" <| \() -> Expect.equal 1 (Bitwise.and 5 3)
, test "and with 0 as first argument" <| \() -> Expect.equal 0 (Bitwise.and 0 1450)
, test "and with 0 as second argument" <| \() -> Expect.equal 0 (Bitwise.and 274 0)
, test "and with -1 as first argument" <| \() -> Expect.equal 2671 (Bitwise.and -1 2671)
, test "and with -1 as second argument" <| \() -> Expect.equal 96 (Bitwise.and 96 -1)
]
, describe "or"
[ test "or with 32 bit integers" <| \() -> Expect.equal 15 (Bitwise.or 9 14)
, test "or with 0 as first argument" <| \() -> Expect.equal 843 (Bitwise.or 0 843)
, test "or with 0 as second argument" <| \() -> Expect.equal 19 (Bitwise.or 19 0)
, test "or with -1 as first argument" <| \() -> Expect.equal -1 (Bitwise.or -1 2360)
, test "or with -1 as second argument" <| \() -> Expect.equal -1 (Bitwise.or 3 -1)
]
, describe "xor"
[ test "xor with 32 bit integers" <| \() -> Expect.equal 604 (Bitwise.xor 580 24)
, test "xor with 0 as first argument" <| \() -> Expect.equal 56 (Bitwise.xor 0 56)
, test "xor with 0 as second argument" <| \() -> Expect.equal -268 (Bitwise.xor -268 0)
, test "xor with -1 as first argument" <| \() -> Expect.equal -25 (Bitwise.xor -1 24)
, test "xor with -1 as second argument" <| \() -> Expect.equal 25601 (Bitwise.xor -25602 -1)
]
, describe "complement"
[ test "complement a positive" <| \() -> Expect.equal -9 (Bitwise.complement 8)
, test "complement a negative" <| \() -> Expect.equal 278 (Bitwise.complement -279)
]
, describe "shiftLeftBy"
[ test "8 |> shiftLeftBy 1 == 16" <| \() -> Expect.equal 16 (8 |> Bitwise.shiftLeftBy 1)
, test "8 |> shiftLeftby 2 == 32" <| \() -> Expect.equal 32 (8 |> Bitwise.shiftLeftBy 2)
]
, describe "shiftRightBy"
[ test "32 |> shiftRight 1 == 16" <| \() -> Expect.equal 16 (32 |> Bitwise.shiftRightBy 1)
, test "32 |> shiftRight 2 == 8" <| \() -> Expect.equal 8 (32 |> Bitwise.shiftRightBy 2)
, test "-32 |> shiftRight 1 == -16" <| \() -> Expect.equal -16 (-32 |> Bitwise.shiftRightBy 1)
]
, describe "shiftRightZfBy"
[ test "32 |> shiftRightZfBy 1 == 16" <| \() -> Expect.equal 16 (32 |> Bitwise.shiftRightZfBy 1)
, test "32 |> shiftRightZfBy 2 == 8" <| \() -> Expect.equal 8 (32 |> Bitwise.shiftRightZfBy 2)
, test "-32 |> shiftRightZfBy 1 == 2147483632" <| \() -> Expect.equal 2147483632 (-32 |> Bitwise.shiftRightZfBy 1)
]
]

113
part4/elm-stuff/packages/elm-lang/core/5.1.1/tests/Test/Char.elm vendored Normal file
View File

@@ -0,0 +1,113 @@
module Test.Char exposing (tests)
import Basics exposing (..)
import Char exposing (..)
import List
import Test exposing (..)
import Expect
lower =
[ 'a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o', 'p', 'q', 'r', 's', 't', 'u', 'v', 'w', 'x', 'y', 'z' ]
upper =
[ 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z' ]
dec =
[ '0', '1', '2', '3', '4', '5', '6', '7', '8', '9' ]
oct =
List.take 8 dec
hexLower =
List.take 6 lower
hexUpper =
List.take 6 upper
hex =
List.append hexLower hexUpper |> List.append dec
lowerCodes =
List.range 97 (97 + List.length lower - 1)
upperCodes =
List.range 65 (65 + List.length upper - 1)
decCodes =
List.range 48 (48 + List.length dec - 1)
oneOf : List a -> a -> Bool
oneOf =
flip List.member
tests : Test
tests =
describe "Char"
[ describe "toCode"
[ test "a-z" <| \() -> Expect.equal (lowerCodes) (List.map toCode lower)
, test "A-Z" <| \() -> Expect.equal (upperCodes) (List.map toCode upper)
, test "0-9" <| \() -> Expect.equal (decCodes) (List.map toCode dec)
]
, describe "fromCode"
[ test "a-z" <| \() -> Expect.equal (lower) (List.map fromCode lowerCodes)
, test "A-Z" <| \() -> Expect.equal (upper) (List.map fromCode upperCodes)
, test "0-9" <| \() -> Expect.equal (dec) (List.map fromCode decCodes)
]
, describe "toLocaleLower"
[ test "a-z" <| \() -> Expect.equal (lower) (List.map toLocaleLower lower)
, test "A-Z" <| \() -> Expect.equal (lower) (List.map toLocaleLower upper)
, test "0-9" <| \() -> Expect.equal (dec) (List.map toLocaleLower dec)
]
, describe "toLocaleUpper"
[ test "a-z" <| \() -> Expect.equal (upper) (List.map toLocaleUpper lower)
, test "A-Z" <| \() -> Expect.equal (upper) (List.map toLocaleUpper upper)
, test "0-9" <| \() -> Expect.equal (dec) (List.map toLocaleUpper dec)
]
, describe "toLower"
[ test "a-z" <| \() -> Expect.equal (lower) (List.map toLower lower)
, test "A-Z" <| \() -> Expect.equal (lower) (List.map toLower upper)
, test "0-9" <| \() -> Expect.equal (dec) (List.map toLower dec)
]
, describe "toUpper"
[ test "a-z" <| \() -> Expect.equal (upper) (List.map toUpper lower)
, test "A-Z" <| \() -> Expect.equal (upper) (List.map toUpper upper)
, test "0-9" <| \() -> Expect.equal (dec) (List.map toUpper dec)
]
, describe "isLower"
[ test "a-z" <| \() -> Expect.equal (True) (List.all isLower lower)
, test "A-Z" <| \() -> Expect.equal (False) (List.any isLower upper)
, test "0-9" <| \() -> Expect.equal (False) (List.any isLower dec)
]
, describe "isUpper"
[ test "a-z" <| \() -> Expect.equal (False) (List.any isUpper lower)
, test "A-Z" <| \() -> Expect.equal (True) (List.all isUpper upper)
, test "0-9" <| \() -> Expect.equal (False) (List.any isUpper dec)
]
, describe "isDigit"
[ test "a-z" <| \() -> Expect.equal (False) (List.any isDigit lower)
, test "A-Z" <| \() -> Expect.equal (False) (List.any isDigit upper)
, test "0-9" <| \() -> Expect.equal (True) (List.all isDigit dec)
]
, describe "isHexDigit"
[ test "a-z" <| \() -> Expect.equal (List.map (oneOf hex) lower) (List.map isHexDigit lower)
, test "A-Z" <| \() -> Expect.equal (List.map (oneOf hex) upper) (List.map isHexDigit upper)
, test "0-9" <| \() -> Expect.equal (True) (List.all isHexDigit dec)
]
, describe "isOctDigit"
[ test "a-z" <| \() -> Expect.equal (False) (List.any isOctDigit lower)
, test "A-Z" <| \() -> Expect.equal (False) (List.any isOctDigit upper)
, test "0-9" <| \() -> Expect.equal (List.map (oneOf oct) dec) (List.map isOctDigit dec)
]
]

109
part4/elm-stuff/packages/elm-lang/core/5.1.1/tests/Test/CodeGen.elm vendored Normal file
View File

@@ -0,0 +1,109 @@
module Test.CodeGen exposing (tests)
import Basics exposing (..)
import Test exposing (..)
import Expect
import Maybe
import Maybe exposing (..)
type Wrapper a
= Wrapper a
caseUnderscore : Maybe number -> number
caseUnderscore m_ =
case m_ of
Just x ->
x
Nothing ->
0
patternUnderscore : number
patternUnderscore =
case Just 42 of
Just x_ ->
x_
Nothing ->
0
letQualified : number
letQualified =
let
(Wrapper x) =
Wrapper 42
in
x
caseQualified : number
caseQualified =
case Just 42 of
Maybe.Just x ->
x
Nothing ->
0
caseScope : String
caseScope =
case "Not this one!" of
string ->
case "Hi" of
string ->
string
tests : Test
tests =
let
-- We don't strictly speaking need annotations in this let-expression,
-- but having these here exercises the parser to avoid regressions like
-- https://github.com/elm-lang/elm-compiler/issues/1535
underscores : Test
underscores =
describe "Underscores"
[ test "case" <| \() -> Expect.equal 42 (caseUnderscore (Just 42))
, test "pattern" <| \() -> Expect.equal 42 patternUnderscore
]
qualifiedPatterns : Test
qualifiedPatterns =
describe "Qualified Patterns"
[ test "let" <| \() -> Expect.equal 42 letQualified
, test "case" <| \() -> Expect.equal 42 caseQualified
]
scope : Test
scope =
describe "Scoping"
[ test "case" <| \() -> Expect.equal "Hi" caseScope ]
hex : Test
hex =
describe "Hex"
[ test "0xFFFFFFFF" <|
\() ->
0xFFFFFFFF
|> Expect.equal 4294967295
, test "0xD066F00D" <|
\() ->
0xD066F00D
|> Expect.equal 3496407053
, test "0x00" <|
\() ->
0x00
|> Expect.equal 0
]
in
describe "CodeGen"
[ underscores
, qualifiedPatterns
, scope
, hex
]

107
part4/elm-stuff/packages/elm-lang/core/5.1.1/tests/Test/Dict.elm vendored Normal file
View File

@@ -0,0 +1,107 @@
module Test.Dict exposing (tests)
import Basics exposing (..)
import Dict
import List
import Maybe exposing (..)
import Test exposing (..)
import Expect
animals : Dict.Dict String String
animals =
Dict.fromList [ ( "Tom", "cat" ), ( "Jerry", "mouse" ) ]
tests : Test
tests =
let
buildTests =
describe "build Tests"
[ test "empty" <| \() -> Expect.equal (Dict.fromList []) (Dict.empty)
, test "singleton" <| \() -> Expect.equal (Dict.fromList [ ( "k", "v" ) ]) (Dict.singleton "k" "v")
, test "insert" <| \() -> Expect.equal (Dict.fromList [ ( "k", "v" ) ]) (Dict.insert "k" "v" Dict.empty)
, test "insert replace" <| \() -> Expect.equal (Dict.fromList [ ( "k", "vv" ) ]) (Dict.insert "k" "vv" (Dict.singleton "k" "v"))
, test "update" <| \() -> Expect.equal (Dict.fromList [ ( "k", "vv" ) ]) (Dict.update "k" (\v -> Just "vv") (Dict.singleton "k" "v"))
, test "update Nothing" <| \() -> Expect.equal Dict.empty (Dict.update "k" (\v -> Nothing) (Dict.singleton "k" "v"))
, test "remove" <| \() -> Expect.equal Dict.empty (Dict.remove "k" (Dict.singleton "k" "v"))
, test "remove not found" <| \() -> Expect.equal (Dict.singleton "k" "v") (Dict.remove "kk" (Dict.singleton "k" "v"))
]
queryTests =
describe "query Tests"
[ test "member 1" <| \() -> Expect.equal True (Dict.member "Tom" animals)
, test "member 2" <| \() -> Expect.equal False (Dict.member "Spike" animals)
, test "get 1" <| \() -> Expect.equal (Just "cat") (Dict.get "Tom" animals)
, test "get 2" <| \() -> Expect.equal Nothing (Dict.get "Spike" animals)
, test "size of empty dictionary" <| \() -> Expect.equal 0 (Dict.size Dict.empty)
, test "size of example dictionary" <| \() -> Expect.equal 2 (Dict.size animals)
]
combineTests =
describe "combine Tests"
[ test "union" <| \() -> Expect.equal animals (Dict.union (Dict.singleton "Jerry" "mouse") (Dict.singleton "Tom" "cat"))
, test "union collison" <| \() -> Expect.equal (Dict.singleton "Tom" "cat") (Dict.union (Dict.singleton "Tom" "cat") (Dict.singleton "Tom" "mouse"))
, test "intersect" <| \() -> Expect.equal (Dict.singleton "Tom" "cat") (Dict.intersect animals (Dict.singleton "Tom" "cat"))
, test "diff" <| \() -> Expect.equal (Dict.singleton "Jerry" "mouse") (Dict.diff animals (Dict.singleton "Tom" "cat"))
]
transformTests =
describe "transform Tests"
[ test "filter" <| \() -> Expect.equal (Dict.singleton "Tom" "cat") (Dict.filter (\k v -> k == "Tom") animals)
, test "partition" <| \() -> Expect.equal ( Dict.singleton "Tom" "cat", Dict.singleton "Jerry" "mouse" ) (Dict.partition (\k v -> k == "Tom") animals)
]
mergeTests =
let
insertBoth key leftVal rightVal dict =
Dict.insert key (leftVal ++ rightVal) dict
s1 =
Dict.empty |> Dict.insert "u1" [ 1 ]
s2 =
Dict.empty |> Dict.insert "u2" [ 2 ]
s23 =
Dict.empty |> Dict.insert "u2" [ 3 ]
b1 =
List.map (\i -> ( i, [ i ] )) (List.range 1 10) |> Dict.fromList
b2 =
List.map (\i -> ( i, [ i ] )) (List.range 5 15) |> Dict.fromList
bExpected =
[ ( 1, [ 1 ] ), ( 2, [ 2 ] ), ( 3, [ 3 ] ), ( 4, [ 4 ] ), ( 5, [ 5, 5 ] ), ( 6, [ 6, 6 ] ), ( 7, [ 7, 7 ] ), ( 8, [ 8, 8 ] ), ( 9, [ 9, 9 ] ), ( 10, [ 10, 10 ] ), ( 11, [ 11 ] ), ( 12, [ 12 ] ), ( 13, [ 13 ] ), ( 14, [ 14 ] ), ( 15, [ 15 ] ) ]
in
describe "merge Tests"
[ test "merge empties" <|
\() ->
Expect.equal (Dict.empty)
(Dict.merge Dict.insert insertBoth Dict.insert Dict.empty Dict.empty Dict.empty)
, test "merge singletons in order" <|
\() ->
Expect.equal [ ( "u1", [ 1 ] ), ( "u2", [ 2 ] ) ]
((Dict.merge Dict.insert insertBoth Dict.insert s1 s2 Dict.empty) |> Dict.toList)
, test "merge singletons out of order" <|
\() ->
Expect.equal [ ( "u1", [ 1 ] ), ( "u2", [ 2 ] ) ]
((Dict.merge Dict.insert insertBoth Dict.insert s2 s1 Dict.empty) |> Dict.toList)
, test "merge with duplicate key" <|
\() ->
Expect.equal [ ( "u2", [ 2, 3 ] ) ]
((Dict.merge Dict.insert insertBoth Dict.insert s2 s23 Dict.empty) |> Dict.toList)
, test "partially overlapping" <|
\() ->
Expect.equal bExpected
((Dict.merge Dict.insert insertBoth Dict.insert b1 b2 Dict.empty) |> Dict.toList)
]
in
describe "Dict Tests"
[ buildTests
, queryTests
, combineTests
, transformTests
, mergeTests
]

34
part4/elm-stuff/packages/elm-lang/core/5.1.1/tests/Test/Equality.elm vendored Normal file
View File

@@ -0,0 +1,34 @@
module Test.Equality exposing (tests)
import Basics exposing (..)
import Maybe exposing (..)
import Test exposing (..)
import Expect
type Different
= A String
| B (List Int)
tests : Test
tests =
let
diffTests =
describe "ADT equality"
[ test "As eq" <| \() -> Expect.equal True (A "a" == A "a")
, test "Bs eq" <| \() -> Expect.equal True (B [ 1 ] == B [ 1 ])
, test "A left neq" <| \() -> Expect.equal True (A "a" /= B [ 1 ])
, test "A left neq" <| \() -> Expect.equal True (B [ 1 ] /= A "a")
]
recordTests =
describe "Record equality"
[ test "empty same" <| \() -> Expect.equal True ({} == {})
, test "ctor same" <| \() -> Expect.equal True ({ field = Just 3 } == { field = Just 3 })
, test "ctor same, special case" <| \() -> Expect.equal True ({ ctor = Just 3 } == { ctor = Just 3 })
, test "ctor diff" <| \() -> Expect.equal True ({ field = Just 3 } /= { field = Nothing })
, test "ctor diff, special case" <| \() -> Expect.equal True ({ ctor = Just 3 } /= { ctor = Nothing })
]
in
describe "Equality Tests" [ diffTests, recordTests ]

84
part4/elm-stuff/packages/elm-lang/core/5.1.1/tests/Test/Json.elm vendored Normal file
View File

@@ -0,0 +1,84 @@
module Test.Json exposing (tests)
import Basics exposing (..)
import Result exposing (..)
import Json.Decode as Json
import String
import Test exposing (..)
import Expect
tests : Test
tests =
describe "Json decode"
[ intTests
, customTests
]
intTests : Test
intTests =
let
testInt val str =
case Json.decodeString Json.int str of
Ok _ ->
Expect.equal val True
Err _ ->
Expect.equal val False
in
describe "Json decode int"
[ test "whole int" <| \() -> testInt True "4"
, test "-whole int" <| \() -> testInt True "-4"
, test "whole float" <| \() -> testInt True "4.0"
, test "-whole float" <| \() -> testInt True "-4.0"
, test "large int" <| \() -> testInt True "1801439850948"
, test "-large int" <| \() -> testInt True "-1801439850948"
, test "float" <| \() -> testInt False "4.2"
, test "-float" <| \() -> testInt False "-4.2"
, test "Infinity" <| \() -> testInt False "Infinity"
, test "-Infinity" <| \() -> testInt False "-Infinity"
, test "NaN" <| \() -> testInt False "NaN"
, test "-NaN" <| \() -> testInt False "-NaN"
, test "true" <| \() -> testInt False "true"
, test "false" <| \() -> testInt False "false"
, test "string" <| \() -> testInt False "\"string\""
, test "object" <| \() -> testInt False "{}"
, test "null" <| \() -> testInt False "null"
, test "undefined" <| \() -> testInt False "undefined"
, test "Decoder expects object finds array, was crashing runtime." <|
\() ->
Expect.equal
(Err "Expecting an object but instead got: []")
(Json.decodeString (Json.dict Json.float) "[]")
]
customTests : Test
customTests =
let
jsonString =
"""{ "foo": "bar" }"""
customErrorMessage =
"I want to see this message!"
myDecoder =
Json.field "foo" Json.string |> Json.andThen (\_ -> Json.fail customErrorMessage)
assertion =
case Json.decodeString myDecoder jsonString of
Ok _ ->
Expect.fail "expected `customDecoder` to produce a value of type Err, but got Ok"
Err message ->
if String.contains customErrorMessage message then
Expect.pass
else
Expect.fail <|
"expected `customDecoder` to preserve user's error message '"
++ customErrorMessage
++ "', but instead got: "
++ message
in
test "customDecoder preserves user error messages" <| \() -> assertion

160
part4/elm-stuff/packages/elm-lang/core/5.1.1/tests/Test/List.elm vendored Normal file
View File

@@ -0,0 +1,160 @@
module Test.List exposing (tests)
import Test exposing (..)
import Expect
import Basics exposing (..)
import Maybe exposing (Maybe(Nothing, Just))
import List exposing (..)
tests : Test
tests =
describe "List Tests"
[ testListOfN 0
, testListOfN 1
, testListOfN 2
, testListOfN 5000
]
testListOfN : Int -> Test
testListOfN n =
let
xs =
List.range 1 n
xsOpp =
List.range -n -1
xsNeg =
foldl (::) [] xsOpp
-- assume foldl and (::) work
zs =
List.range 0 n
sumSeq k =
k * (k + 1) // 2
xsSum =
sumSeq n
mid =
n // 2
in
describe (toString n ++ " elements")
[ describe "foldl"
[ test "order" <| \() -> Expect.equal (n) (foldl (\x acc -> x) 0 xs)
, test "total" <| \() -> Expect.equal (xsSum) (foldl (+) 0 xs)
]
, describe "foldr"
[ test "order" <| \() -> Expect.equal (min 1 n) (foldr (\x acc -> x) 0 xs)
, test "total" <| \() -> Expect.equal (xsSum) (foldl (+) 0 xs)
]
, describe "map"
[ test "identity" <| \() -> Expect.equal (xs) (map identity xs)
, test "linear" <| \() -> Expect.equal (List.range 2 (n + 1)) (map ((+) 1) xs)
]
, test "isEmpty" <| \() -> Expect.equal (n == 0) (isEmpty xs)
, test "length" <| \() -> Expect.equal (n) (length xs)
, test "reverse" <| \() -> Expect.equal (xsOpp) (reverse xsNeg)
, describe "member"
[ test "positive" <| \() -> Expect.equal (True) (member n zs)
, test "negative" <| \() -> Expect.equal (False) (member (n + 1) xs)
]
, test "head" <|
\() ->
if n == 0 then
Expect.equal (Nothing) (head xs)
else
Expect.equal (Just 1) (head xs)
, describe "List.filter"
[ test "none" <| \() -> Expect.equal ([]) (List.filter (\x -> x > n) xs)
, test "one" <| \() -> Expect.equal ([ n ]) (List.filter (\z -> z == n) zs)
, test "all" <| \() -> Expect.equal (xs) (List.filter (\x -> x <= n) xs)
]
, describe "take"
[ test "none" <| \() -> Expect.equal ([]) (take 0 xs)
, test "some" <| \() -> Expect.equal (List.range 0 (n - 1)) (take n zs)
, test "all" <| \() -> Expect.equal (xs) (take n xs)
, test "all+" <| \() -> Expect.equal (xs) (take (n + 1) xs)
]
, describe "drop"
[ test "none" <| \() -> Expect.equal (xs) (drop 0 xs)
, test "some" <| \() -> Expect.equal ([ n ]) (drop n zs)
, test "all" <| \() -> Expect.equal ([]) (drop n xs)
, test "all+" <| \() -> Expect.equal ([]) (drop (n + 1) xs)
]
, test "repeat" <| \() -> Expect.equal (map (\x -> -1) xs) (repeat n -1)
, test "append" <| \() -> Expect.equal (xsSum * 2) (append xs xs |> foldl (+) 0)
, test "(::)" <| \() -> Expect.equal (append [ -1 ] xs) (-1 :: xs)
, test "List.concat" <| \() -> Expect.equal (append xs (append zs xs)) (List.concat [ xs, zs, xs ])
, test "intersperse" <|
\() ->
Expect.equal
( min -(n - 1) 0, xsSum )
(intersperse -1 xs |> foldl (\x ( c1, c2 ) -> ( c2, c1 + x )) ( 0, 0 ))
, describe "partition"
[ test "left" <| \() -> Expect.equal ( xs, [] ) (partition (\x -> x > 0) xs)
, test "right" <| \() -> Expect.equal ( [], xs ) (partition (\x -> x < 0) xs)
, test "split" <| \() -> Expect.equal ( List.range (mid + 1) n, List.range 1 mid ) (partition (\x -> x > mid) xs)
]
, describe "map2"
[ test "same length" <| \() -> Expect.equal (map ((*) 2) xs) (map2 (+) xs xs)
, test "long first" <| \() -> Expect.equal (map (\x -> x * 2 - 1) xs) (map2 (+) zs xs)
, test "short first" <| \() -> Expect.equal (map (\x -> x * 2 - 1) xs) (map2 (+) xs zs)
]
, test "unzip" <| \() -> Expect.equal ( xsNeg, xs ) (map (\x -> ( -x, x )) xs |> unzip)
, describe "filterMap"
[ test "none" <| \() -> Expect.equal ([]) (filterMap (\x -> Nothing) xs)
, test "all" <| \() -> Expect.equal (xsNeg) (filterMap (\x -> Just -x) xs)
, let
halve x =
if x % 2 == 0 then
Just (x // 2)
else
Nothing
in
test "some" <| \() -> Expect.equal (List.range 1 mid) (filterMap halve xs)
]
, describe "concatMap"
[ test "none" <| \() -> Expect.equal ([]) (concatMap (\x -> []) xs)
, test "all" <| \() -> Expect.equal (xsNeg) (concatMap (\x -> [ -x ]) xs)
]
, test "indexedMap" <| \() -> Expect.equal (map2 (,) zs xsNeg) (indexedMap (\i x -> ( i, -x )) xs)
, test "sum" <| \() -> Expect.equal (xsSum) (sum xs)
, test "product" <| \() -> Expect.equal (0) (product zs)
, test "maximum" <|
\() ->
if n == 0 then
Expect.equal (Nothing) (maximum xs)
else
Expect.equal (Just n) (maximum xs)
, test "minimum" <|
\() ->
if n == 0 then
Expect.equal (Nothing) (minimum xs)
else
Expect.equal (Just 1) (minimum xs)
, describe "all"
[ test "false" <| \() -> Expect.equal (False) (all (\z -> z < n) zs)
, test "true" <| \() -> Expect.equal (True) (all (\x -> x <= n) xs)
]
, describe "any"
[ test "false" <| \() -> Expect.equal (False) (any (\x -> x > n) xs)
, test "true" <| \() -> Expect.equal (True) (any (\z -> z >= n) zs)
]
, describe "sort"
[ test "sorted" <| \() -> Expect.equal (xs) (sort xs)
, test "unsorted" <| \() -> Expect.equal (xsOpp) (sort xsNeg)
]
, describe "sortBy"
[ test "sorted" <| \() -> Expect.equal (xsNeg) (sortBy negate xsNeg)
, test "unsorted" <| \() -> Expect.equal (xsNeg) (sortBy negate xsOpp)
]
, describe "sortWith"
[ test "sorted" <| \() -> Expect.equal (xsNeg) (sortWith (flip compare) xsNeg)
, test "unsorted" <| \() -> Expect.equal (xsNeg) (sortWith (flip compare) xsOpp)
]
, test "scanl" <| \() -> Expect.equal (0 :: map sumSeq xs) (scanl (+) 0 xs)
]

169
part4/elm-stuff/packages/elm-lang/core/5.1.1/tests/Test/Maybe.elm vendored Normal file
View File

@@ -0,0 +1,169 @@
module Test.Maybe exposing (tests)
import Basics exposing (..)
import Maybe exposing (..)
import Test exposing (..)
import Expect
tests : Test
tests =
describe "Maybe Tests"
[ describe "Common Helpers Tests"
[ describe "withDefault Tests"
[ test "no default used" <|
\() -> Expect.equal 0 (Maybe.withDefault 5 (Just 0))
, test "default used" <|
\() -> Expect.equal 5 (Maybe.withDefault 5 (Nothing))
]
, describe "map Tests"
( let f = (\n -> n + 1) in
[ test "on Just" <|
\() ->
Expect.equal
(Just 1)
(Maybe.map f (Just 0))
, test "on Nothing" <|
\() ->
Expect.equal
Nothing
(Maybe.map f Nothing)
]
)
, describe "map2 Tests"
( let f = (+) in
[ test "on (Just, Just)" <|
\() ->
Expect.equal
(Just 1)
(Maybe.map2 f (Just 0) (Just 1))
, test "on (Just, Nothing)" <|
\() ->
Expect.equal
Nothing
(Maybe.map2 f (Just 0) Nothing)
, test "on (Nothing, Just)" <|
\() ->
Expect.equal
Nothing
(Maybe.map2 f Nothing (Just 0))
]
)
, describe "map3 Tests"
( let f = (\a b c -> a + b + c) in
[ test "on (Just, Just, Just)" <|
\() ->
Expect.equal
(Just 3)
(Maybe.map3 f (Just 1) (Just 1) (Just 1))
, test "on (Just, Just, Nothing)" <|
\() ->
Expect.equal
Nothing
(Maybe.map3 f (Just 1) (Just 1) Nothing)
, test "on (Just, Nothing, Just)" <|
\() ->
Expect.equal
Nothing
(Maybe.map3 f (Just 1) Nothing (Just 1))
, test "on (Nothing, Just, Just)" <|
\() ->
Expect.equal
Nothing
(Maybe.map3 f Nothing (Just 1) (Just 1))
]
)
, describe "map4 Tests"
( let f = (\a b c d -> a + b + c + d) in
[ test "on (Just, Just, Just, Just)" <|
\() ->
Expect.equal
(Just 4)
(Maybe.map4 f (Just 1) (Just 1) (Just 1) (Just 1))
, test "on (Just, Just, Just, Nothing)" <|
\() ->
Expect.equal
Nothing
(Maybe.map4 f (Just 1) (Just 1) (Just 1) Nothing)
, test "on (Just, Just, Nothing, Just)" <|
\() ->
Expect.equal
Nothing
(Maybe.map4 f (Just 1) (Just 1) Nothing (Just 1))
, test "on (Just, Nothing, Just, Just)" <|
\() ->
Expect.equal
Nothing
(Maybe.map4 f (Just 1) Nothing (Just 1) (Just 1))
, test "on (Nothing, Just, Just, Just)" <|
\() ->
Expect.equal
Nothing
(Maybe.map4 f Nothing (Just 1) (Just 1) (Just 1))
]
)
, describe "map5 Tests"
( let f = (\a b c d e -> a + b + c + d + e) in
[ test "on (Just, Just, Just, Just, Just)" <|
\() ->
Expect.equal
(Just 5)
(Maybe.map5 f (Just 1) (Just 1) (Just 1) (Just 1) (Just 1))
, test "on (Just, Just, Just, Just, Nothing)" <|
\() ->
Expect.equal
Nothing
(Maybe.map5 f (Just 1) (Just 1) (Just 1) (Just 1) Nothing)
, test "on (Just, Just, Just, Nothing, Just)" <|
\() ->
Expect.equal
Nothing
(Maybe.map5 f (Just 1) (Just 1) (Just 1) Nothing (Just 1))
, test "on (Just, Just, Nothing, Just, Just)" <|
\() ->
Expect.equal
Nothing
(Maybe.map5 f (Just 1) (Just 1) Nothing (Just 1) (Just 1))
, test "on (Just, Nothing, Just, Just, Just)" <|
\() ->
Expect.equal
Nothing
(Maybe.map5 f (Just 1) Nothing (Just 1) (Just 1) (Just 1))
, test "on (Nothing, Just, Just, Just, Just)" <|
\() ->
Expect.equal
Nothing
(Maybe.map5 f Nothing (Just 1) (Just 1) (Just 1) (Just 1))
]
)
]
, describe "Chaining Maybes Tests"
[ describe "andThen Tests"
[ test "succeeding chain" <|
\() ->
Expect.equal
(Just 1)
(Maybe.andThen (\a -> Just a) (Just 1))
, test "failing chain (original Maybe failed)" <|
\() ->
Expect.equal
Nothing
(Maybe.andThen (\a -> Just a) Nothing)
, test "failing chain (chained function failed)" <|
\() ->
Expect.equal
Nothing
(Maybe.andThen (\a -> Nothing) (Just 1))
]
]
]

57
part4/elm-stuff/packages/elm-lang/core/5.1.1/tests/Test/Regex.elm vendored Normal file
View File

@@ -0,0 +1,57 @@
module Test.Regex exposing (tests)
import Basics exposing (..)
import Regex exposing (..)
import Test exposing (..)
import Expect
tests : Test
tests =
let
simpleTests =
describe "Simple Stuff"
[ test "split All" <| \() -> Expect.equal [ "a", "b" ] (split All (regex ",") "a,b")
, test "split" <| \() -> Expect.equal [ "a", "b,c" ] (split (AtMost 1) (regex ",") "a,b,c")
, test "split idempotent" <|
\() ->
let
findComma =
regex ","
in
Expect.equal
(split (AtMost 1) findComma "a,b,c,d,e")
(split (AtMost 1) findComma "a,b,c,d,e")
, test "find All" <|
\() ->
Expect.equal
([ Match "a" [] 0 1, Match "b" [] 1 2 ])
(find All (regex ".") "ab")
, test "find All" <|
\() ->
Expect.equal
([ Match "" [] 0 1 ])
(find All (regex ".*") "")
, test "replace AtMost 0" <|
\() ->
Expect.equal "The quick brown fox"
(replace (AtMost 0) (regex "[aeiou]") (\_ -> "") "The quick brown fox")
, test "replace AtMost 1" <|
\() ->
Expect.equal "Th quick brown fox"
(replace (AtMost 1) (regex "[aeiou]") (\_ -> "") "The quick brown fox")
, test "replace AtMost 2" <|
\() ->
Expect.equal "Th qick brown fox"
(replace (AtMost 2) (regex "[aeiou]") (\_ -> "") "The quick brown fox")
, test "replace All" <|
\() ->
Expect.equal "Th qck brwn fx"
(replace All (regex "[aeiou]") (\_ -> "") "The quick brown fox")
, test "replace using index" <|
\() ->
Expect.equal "a1b3c"
(replace All (regex ",") (\match -> toString match.index) "a,b,c")
]
in
describe "Regex" [ simpleTests ]

70
part4/elm-stuff/packages/elm-lang/core/5.1.1/tests/Test/Result.elm vendored Normal file
View File

@@ -0,0 +1,70 @@
module Test.Result exposing (tests)
import Basics exposing (..)
import Result
import Result exposing (Result(..))
import String
import Test exposing (..)
import Expect
isEven n =
if n % 2 == 0 then
Ok n
else
Err "number is odd"
add3 a b c =
a + b + c
add4 a b c d =
a + b + c + d
add5 a b c d e =
a + b + c + d + e
tests : Test
tests =
let
mapTests =
describe "map Tests"
[ test "map Ok" <| \() -> Expect.equal (Ok 3) (Result.map ((+) 1) (Ok 2))
, test "map Err" <| \() -> Expect.equal (Err "error") (Result.map ((+) 1) (Err "error"))
]
mapNTests =
describe "mapN Tests"
[ test "map2 Ok" <| \() -> Expect.equal (Ok 3) (Result.map2 (+) (Ok 1) (Ok 2))
, test "map2 Err" <| \() -> Expect.equal (Err "x") (Result.map2 (+) (Ok 1) (Err "x"))
, test "map3 Ok" <| \() -> Expect.equal (Ok 6) (Result.map3 add3 (Ok 1) (Ok 2) (Ok 3))
, test "map3 Err" <| \() -> Expect.equal (Err "x") (Result.map3 add3 (Ok 1) (Ok 2) (Err "x"))
, test "map4 Ok" <| \() -> Expect.equal (Ok 10) (Result.map4 add4 (Ok 1) (Ok 2) (Ok 3) (Ok 4))
, test "map4 Err" <| \() -> Expect.equal (Err "x") (Result.map4 add4 (Ok 1) (Ok 2) (Ok 3) (Err "x"))
, test "map5 Ok" <| \() -> Expect.equal (Ok 15) (Result.map5 add5 (Ok 1) (Ok 2) (Ok 3) (Ok 4) (Ok 5))
, test "map5 Err" <| \() -> Expect.equal (Err "x") (Result.map5 add5 (Ok 1) (Ok 2) (Ok 3) (Ok 4) (Err "x"))
]
andThenTests =
describe "andThen Tests"
[ test "andThen Ok" <| \() -> Expect.equal (Ok 42) ((String.toInt "42") |> Result.andThen isEven)
, test "andThen first Err" <|
\() ->
Expect.equal
(Err "could not convert string '4.2' to an Int")
(String.toInt "4.2" |> Result.andThen isEven)
, test "andThen second Err" <|
\() ->
Expect.equal
(Err "number is odd")
(String.toInt "41" |> Result.andThen isEven)
]
in
describe "Result Tests"
[ mapTests
, mapNTests
, andThenTests
]

52
part4/elm-stuff/packages/elm-lang/core/5.1.1/tests/Test/Set.elm vendored Normal file
View File

@@ -0,0 +1,52 @@
module Test.Set exposing (tests)
import Basics exposing (..)
import Set
import Set exposing (Set)
import List
import Test exposing (..)
import Expect
set : Set Int
set =
Set.fromList <| List.range 1 100
setPart1 : Set Int
setPart1 =
Set.fromList <| List.range 1 50
setPart2 : Set Int
setPart2 =
Set.fromList <| List.range 51 100
pred : Int -> Bool
pred x =
x <= 50
tests : Test
tests =
let
queryTests =
describe "query Tests"
[ test "size of set of 100 elements" <|
\() -> Expect.equal 100 (Set.size set)
]
filterTests =
describe "filter Tests"
[ test "Simple filter" <|
\() -> Expect.equal setPart1 <| Set.filter pred set
]
partitionTests =
describe "partition Tests"
[ test "Simple partition" <|
\() -> Expect.equal ( setPart1, setPart2 ) <| Set.partition pred set
]
in
describe "Set Tests" [ queryTests, partitionTests, filterTests ]

110
part4/elm-stuff/packages/elm-lang/core/5.1.1/tests/Test/String.elm vendored Normal file
View File

@@ -0,0 +1,110 @@
module Test.String exposing (tests)
import Basics exposing (..)
import List
import Maybe exposing (..)
import Result exposing (Result(..))
import String
import Test exposing (..)
import Expect
tests : Test
tests =
let
simpleTests =
describe "Simple Stuff"
[ test "is empty" <| \() -> Expect.equal True (String.isEmpty "")
, test "is not empty" <| \() -> Expect.equal True (not (String.isEmpty ("the world")))
, test "length" <| \() -> Expect.equal 11 (String.length "innumerable")
, test "endsWith" <| \() -> Expect.equal True <| String.endsWith "ship" "spaceship"
, test "reverse" <| \() -> Expect.equal "desserts" (String.reverse "stressed")
, test "repeat" <| \() -> Expect.equal "hahaha" (String.repeat 3 "ha")
, test "indexes" <| \() -> Expect.equal [ 0, 2 ] (String.indexes "a" "aha")
, test "empty indexes" <| \() -> Expect.equal [] (String.indexes "" "aha")
]
combiningTests =
describe "Combining Strings"
[ test "uncons non-empty" <| \() -> Expect.equal (Just ( 'a', "bc" )) (String.uncons "abc")
, test "uncons empty" <| \() -> Expect.equal Nothing (String.uncons "")
, test "append 1" <| \() -> Expect.equal "butterfly" (String.append "butter" "fly")
, test "append 2" <| \() -> Expect.equal "butter" (String.append "butter" "")
, test "append 3" <| \() -> Expect.equal "butter" (String.append "" "butter")
, test "concat" <| \() -> Expect.equal "nevertheless" (String.concat [ "never", "the", "less" ])
, test "split commas" <| \() -> Expect.equal [ "cat", "dog", "cow" ] (String.split "," "cat,dog,cow")
, test "split slashes" <| \() -> Expect.equal [ "home", "steve", "Desktop", "" ] (String.split "/" "home/steve/Desktop/")
, test "join spaces" <| \() -> Expect.equal "cat dog cow" (String.join " " [ "cat", "dog", "cow" ])
, test "join slashes" <| \() -> Expect.equal "home/steve/Desktop" (String.join "/" [ "home", "steve", "Desktop" ])
, test "slice 1" <| \() -> Expect.equal "c" (String.slice 2 3 "abcd")
, test "slice 2" <| \() -> Expect.equal "abc" (String.slice 0 3 "abcd")
, test "slice 3" <| \() -> Expect.equal "abc" (String.slice 0 -1 "abcd")
, test "slice 4" <| \() -> Expect.equal "cd" (String.slice -2 4 "abcd")
]
intTests =
describe "String.toInt"
[ goodInt "1234" 1234
, goodInt "+1234" 1234
, goodInt "-1234" -1234
, badInt "1.34"
, badInt "1e31"
, badInt "123a"
, goodInt "0123" 123
, goodInt "0x001A" 26
, goodInt "0x001a" 26
, goodInt "0xBEEF" 48879
, badInt "0x12.0"
, badInt "0x12an"
]
floatTests =
describe "String.toFloat"
[ goodFloat "123" 123
, goodFloat "3.14" 3.14
, goodFloat "+3.14" 3.14
, goodFloat "-3.14" -3.14
, goodFloat "0.12" 0.12
, goodFloat ".12" 0.12
, goodFloat "1e-42" 1e-42
, goodFloat "6.022e23" 6.022e23
, goodFloat "6.022E23" 6.022e23
, goodFloat "6.022e+23" 6.022e23
, badFloat "6.022e"
, badFloat "6.022n"
, badFloat "6.022.31"
]
in
describe "String" [ simpleTests, combiningTests, intTests, floatTests ]
-- NUMBER HELPERS
goodInt : String -> Int -> Test
goodInt str int =
test str <| \_ ->
Expect.equal (Ok int) (String.toInt str)
badInt : String -> Test
badInt str =
test str <| \_ ->
Expect.equal
(Err ("could not convert string '" ++ str ++ "' to an Int"))
(String.toInt str)
goodFloat : String -> Float -> Test
goodFloat str float =
test str <| \_ ->
Expect.equal (Ok float) (String.toFloat str)
badFloat : String -> Test
badFloat str =
test str <| \_ ->
Expect.equal
(Err ("could not convert string '" ++ str ++ "' to a Float"))
(String.toFloat str)

17
part4/elm-stuff/packages/elm-lang/core/5.1.1/tests/elm-package.json vendored Normal file
View File

@@ -0,0 +1,17 @@
{
"version": "1.1.1",
"summary": "Tests for Elm's standard libraries",
"repository": "http://github.com/elm-lang/core.git",
"license": "BSD3",
"source-directories": [
".",
"../src"
],
"exposed-modules": [ ],
"native-modules": true,
"dependencies": {
"elm-community/elm-test": "3.1.0 <= v < 4.0.0",
"rtfeldman/node-test-runner": "3.0.0 <= v < 4.0.0"
},
"elm-version": "0.18.0 <= v < 0.19.0"
}

1
part4/elm-stuff/packages/elm-lang/html/2.0.0/.gitignore vendored Normal file
View File

@@ -0,0 +1 @@
elm-stuff

30
part4/elm-stuff/packages/elm-lang/html/2.0.0/LICENSE vendored Normal file
View File

@@ -0,0 +1,30 @@
Copyright (c) 2014-present, 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.

21
part4/elm-stuff/packages/elm-lang/html/2.0.0/elm-package.json vendored Normal file
View File

@@ -0,0 +1,21 @@
{
"version": "2.0.0",
"summary": "Fast HTML, rendered with virtual DOM diffing",
"repository": "https://github.com/elm-lang/html.git",
"license": "BSD3",
"source-directories": [
"src"
],
"exposed-modules": [
"Html",
"Html.Attributes",
"Html.Events",
"Html.Keyed",
"Html.Lazy"
],
"dependencies": {
"elm-lang/core": "5.0.0 <= v < 6.0.0",
"elm-lang/virtual-dom": "2.0.0 <= v < 3.0.0"
},
"elm-version": "0.18.0 <= v < 0.19.0"
}

923
part4/elm-stuff/packages/elm-lang/html/2.0.0/src/Html.elm vendored Normal file
View File

@@ -0,0 +1,923 @@
module Html exposing
( Html, Attribute
, text, node, map
, beginnerProgram, program, programWithFlags
, h1, h2, h3, h4, h5, h6
, div, p, hr, pre, blockquote
, span, a, code, em, strong, i, b, u, sub, sup, br
, ol, ul, li, dl, dt, dd
, img, iframe, canvas, math
, form, input, textarea, button, select, option
, section, nav, article, aside, header, footer, address, main_, body
, figure, figcaption
, table, caption, colgroup, col, tbody, thead, tfoot, tr, td, th
, fieldset, legend, label, datalist, optgroup, keygen, output, progress, meter
, audio, video, source, track
, embed, object, param
, ins, del
, small, cite, dfn, abbr, time, var, samp, kbd, s, q
, mark, ruby, rt, rp, bdi, bdo, wbr
, details, summary, menuitem, menu
)
{-| This file is organized roughly in order of popularity. The tags which you'd
expect to use frequently will be closer to the top.
# Primitives
@docs Html, Attribute, text, node, map
# Programs
@docs beginnerProgram, program, programWithFlags
# Tags
## Headers
@docs h1, h2, h3, h4, h5, h6
## Grouping Content
@docs div, p, hr, pre, blockquote
## Text
@docs span, a, code, em, strong, i, b, u, sub, sup, br
## Lists
@docs ol, ul, li, dl, dt, dd
## Emdedded Content
@docs img, iframe, canvas, math
## Inputs
@docs form, input, textarea, button, select, option
## Sections
@docs section, nav, article, aside, header, footer, address, main_, body
## Figures
@docs figure, figcaption
## Tables
@docs table, caption, colgroup, col, tbody, thead, tfoot, tr, td, th
## Less Common Elements
### Less Common Inputs
@docs fieldset, legend, label, datalist, optgroup, keygen, output, progress, meter
### Audio and Video
@docs audio, video, source, track
### Embedded Objects
@docs embed, object, param
### Text Edits
@docs ins, del
### Semantic Text
@docs small, cite, dfn, abbr, time, var, samp, kbd, s, q
### Less Common Text Tags
@docs mark, ruby, rt, rp, bdi, bdo, wbr
## Interactive Elements
@docs details, summary, menuitem, menu
-}
import VirtualDom
-- CORE TYPES
{-| The core building block used to build up HTML. Here we create an `Html`
value with no attributes and one child:
hello : Html msg
hello =
div [] [ text "Hello!" ]
-}
type alias Html msg = VirtualDom.Node msg
{-| Set attributes on your `Html`. Learn more in the
[`Html.Attributes`](Html-Attributes) module.
-}
type alias Attribute msg = VirtualDom.Property msg
-- PRIMITIVES
{-| General way to create HTML nodes. It is used to define all of the helper
functions in this library.
div : List (Attribute msg) -> List (Html msg) -> Html msg
div attributes children =
node "div" attributes children
You can use this to create custom nodes if you need to create something that
is not covered by the helper functions in this library.
-}
node : String -> List (Attribute msg) -> List (Html msg) -> Html msg
node =
VirtualDom.node
{-| Just put plain text in the DOM. It will escape the string so that it appears
exactly as you specify.
text "Hello World!"
-}
text : String -> Html msg
text =
VirtualDom.text
-- NESTING VIEWS
{-| Transform the messages produced by some `Html`. In the following example,
we have `viewButton` that produces `()` messages, and we transform those values
into `Msg` values in `view`.
type Msg = Left | Right
view : model -> Html Msg
view model =
div []
[ map (\_ -> Left) (viewButton "Left")
, map (\_ -> Right) (viewButton "Right")
]
viewButton : String -> Html ()
viewButton name =
button [ onClick () ] [ text name ]
This should not come in handy too often. Definitely read [this][reuse] before
deciding if this is what you want.
[reuse]: https://guide.elm-lang.org/reuse/
-}
map : (a -> msg) -> Html a -> Html msg
map =
VirtualDom.map
-- CREATING PROGRAMS
{-| Create a [`Program`][program] that describes how your whole app works.
Read about [The Elm Architecture][tea] to learn how to use this. Just do it.
The additional context is very worthwhile! (Honestly, it is best to just read
that guide from front to back instead of muddling around and reading it
piecemeal.)
[program]: http://package.elm-lang.org/packages/elm-lang/core/latest/Platform#Program
[tea]: https://guide.elm-lang.org/architecture/
-}
beginnerProgram
: { model : model
, view : model -> Html msg
, update : msg -> model -> model
}
-> Program Never model msg
beginnerProgram {model, view, update} =
program
{ init = model ! []
, update = \msg model -> update msg model ! []
, view = view
, subscriptions = \_ -> Sub.none
}
{-| Create a [`Program`][program] that describes how your whole app works.
Read about [The Elm Architecture][tea] to learn how to use this. Just do it.
Commands and subscriptions make way more sense when you work up to them
gradually and see them in context with examples.
[program]: http://package.elm-lang.org/packages/elm-lang/core/latest/Platform#Program
[tea]: https://guide.elm-lang.org/architecture/
-}
program
: { init : (model, Cmd msg)
, update : msg -> model -> (model, Cmd msg)
, subscriptions : model -> Sub msg
, view : model -> Html msg
}
-> Program Never model msg
program =
VirtualDom.program
{-| Create a [`Program`][program] that describes how your whole app works.
It works just like `program` but you can provide &ldquo;flags&rdquo; from
JavaScript to configure your application. Read more about that [here][].
[program]: http://package.elm-lang.org/packages/elm-lang/core/latest/Platform#Program
[here]: https://guide.elm-lang.org/interop/javascript.html
-}
programWithFlags
: { init : flags -> (model, Cmd msg)
, update : msg -> model -> (model, Cmd msg)
, subscriptions : model -> Sub msg
, view : model -> Html msg
}
-> Program flags model msg
programWithFlags =
VirtualDom.programWithFlags
-- SECTIONS
{-| Represents the content of an HTML document. There is only one `body`
element in a document.
-}
body : List (Attribute msg) -> List (Html msg) -> Html msg
body =
node "body"
{-| Defines a section in a document.
-}
section : List (Attribute msg) -> List (Html msg) -> Html msg
section =
node "section"
{-| Defines a section that contains only navigation links.
-}
nav : List (Attribute msg) -> List (Html msg) -> Html msg
nav =
node "nav"
{-| Defines self-contained content that could exist independently of the rest
of the content.
-}
article : List (Attribute msg) -> List (Html msg) -> Html msg
article =
node "article"
{-| Defines some content loosely related to the page content. If it is removed,
the remaining content still makes sense.
-}
aside : List (Attribute msg) -> List (Html msg) -> Html msg
aside =
node "aside"
{-|-}
h1 : List (Attribute msg) -> List (Html msg) -> Html msg
h1 =
node "h1"
{-|-}
h2 : List (Attribute msg) -> List (Html msg) -> Html msg
h2 =
node "h2"
{-|-}
h3 : List (Attribute msg) -> List (Html msg) -> Html msg
h3 =
node "h3"
{-|-}
h4 : List (Attribute msg) -> List (Html msg) -> Html msg
h4 =
node "h4"
{-|-}
h5 : List (Attribute msg) -> List (Html msg) -> Html msg
h5 =
node "h5"
{-|-}
h6 : List (Attribute msg) -> List (Html msg) -> Html msg
h6 =
node "h6"
{-| Defines the header of a page or section. It often contains a logo, the
title of the web site, and a navigational table of content.
-}
header : List (Attribute msg) -> List (Html msg) -> Html msg
header =
node "header"
{-| Defines the footer for a page or section. It often contains a copyright
notice, some links to legal information, or addresses to give feedback.
-}
footer : List (Attribute msg) -> List (Html msg) -> Html msg
footer =
node "footer"
{-| Defines a section containing contact information. -}
address : List (Attribute msg) -> List (Html msg) -> Html msg
address =
node "address"
{-| Defines the main or important content in the document. There is only one
`main` element in the document.
-}
main_ : List (Attribute msg) -> List (Html msg) -> Html msg
main_ =
node "main"
-- GROUPING CONTENT
{-| Defines a portion that should be displayed as a paragraph. -}
p : List (Attribute msg) -> List (Html msg) -> Html msg
p =
node "p"
{-| Represents a thematic break between paragraphs of a section or article or
any longer content.
-}
hr : List (Attribute msg) -> List (Html msg) -> Html msg
hr =
node "hr"
{-| Indicates that its content is preformatted and that this format must be
preserved.
-}
pre : List (Attribute msg) -> List (Html msg) -> Html msg
pre =
node "pre"
{-| Represents a content that is quoted from another source. -}
blockquote : List (Attribute msg) -> List (Html msg) -> Html msg
blockquote =
node "blockquote"
{-| Defines an ordered list of items. -}
ol : List (Attribute msg) -> List (Html msg) -> Html msg
ol =
node "ol"
{-| Defines an unordered list of items. -}
ul : List (Attribute msg) -> List (Html msg) -> Html msg
ul =
node "ul"
{-| Defines a item of an enumeration list. -}
li : List (Attribute msg) -> List (Html msg) -> Html msg
li =
node "li"
{-| Defines a definition list, that is, a list of terms and their associated
definitions.
-}
dl : List (Attribute msg) -> List (Html msg) -> Html msg
dl =
node "dl"
{-| Represents a term defined by the next `dd`. -}
dt : List (Attribute msg) -> List (Html msg) -> Html msg
dt =
node "dt"
{-| Represents the definition of the terms immediately listed before it. -}
dd : List (Attribute msg) -> List (Html msg) -> Html msg
dd =
node "dd"
{-| Represents a figure illustrated as part of the document. -}
figure : List (Attribute msg) -> List (Html msg) -> Html msg
figure =
node "figure"
{-| Represents the legend of a figure. -}
figcaption : List (Attribute msg) -> List (Html msg) -> Html msg
figcaption =
node "figcaption"
{-| Represents a generic container with no special meaning. -}
div : List (Attribute msg) -> List (Html msg) -> Html msg
div =
node "div"
-- TEXT LEVEL SEMANTIC
{-| Represents a hyperlink, linking to another resource. -}
a : List (Attribute msg) -> List (Html msg) -> Html msg
a =
node "a"
{-| Represents emphasized text, like a stress accent. -}
em : List (Attribute msg) -> List (Html msg) -> Html msg
em =
node "em"
{-| Represents especially important text. -}
strong : List (Attribute msg) -> List (Html msg) -> Html msg
strong =
node "strong"
{-| Represents a side comment, that is, text like a disclaimer or a
copyright, which is not essential to the comprehension of the document.
-}
small : List (Attribute msg) -> List (Html msg) -> Html msg
small =
node "small"
{-| Represents content that is no longer accurate or relevant. -}
s : List (Attribute msg) -> List (Html msg) -> Html msg
s =
node "s"
{-| Represents the title of a work. -}
cite : List (Attribute msg) -> List (Html msg) -> Html msg
cite =
node "cite"
{-| Represents an inline quotation. -}
q : List (Attribute msg) -> List (Html msg) -> Html msg
q =
node "q"
{-| Represents a term whose definition is contained in its nearest ancestor
content.
-}
dfn : List (Attribute msg) -> List (Html msg) -> Html msg
dfn =
node "dfn"
{-| Represents an abbreviation or an acronym; the expansion of the
abbreviation can be represented in the title attribute.
-}
abbr : List (Attribute msg) -> List (Html msg) -> Html msg
abbr =
node "abbr"
{-| Represents a date and time value; the machine-readable equivalent can be
represented in the datetime attribute.
-}
time : List (Attribute msg) -> List (Html msg) -> Html msg
time =
node "time"
{-| Represents computer code. -}
code : List (Attribute msg) -> List (Html msg) -> Html msg
code =
node "code"
{-| Represents a variable. Specific cases where it should be used include an
actual mathematical expression or programming context, an identifier
representing a constant, a symbol identifying a physical quantity, a function
parameter, or a mere placeholder in prose.
-}
var : List (Attribute msg) -> List (Html msg) -> Html msg
var =
node "var"
{-| Represents the output of a program or a computer. -}
samp : List (Attribute msg) -> List (Html msg) -> Html msg
samp =
node "samp"
{-| Represents user input, often from the keyboard, but not necessarily; it
may represent other input, like transcribed voice commands.
-}
kbd : List (Attribute msg) -> List (Html msg) -> Html msg
kbd =
node "kbd"
{-| Represent a subscript. -}
sub : List (Attribute msg) -> List (Html msg) -> Html msg
sub =
node "sub"
{-| Represent a superscript. -}
sup : List (Attribute msg) -> List (Html msg) -> Html msg
sup =
node "sup"
{-| Represents some text in an alternate voice or mood, or at least of
different quality, such as a taxonomic designation, a technical term, an
idiomatic phrase, a thought, or a ship name.
-}
i : List (Attribute msg) -> List (Html msg) -> Html msg
i =
node "i"
{-| Represents a text which to which attention is drawn for utilitarian
purposes. It doesn't convey extra importance and doesn't imply an alternate
voice.
-}
b : List (Attribute msg) -> List (Html msg) -> Html msg
b =
node "b"
{-| Represents a non-textual annoatation for which the conventional
presentation is underlining, such labeling the text as being misspelt or
labeling a proper name in Chinese text.
-}
u : List (Attribute msg) -> List (Html msg) -> Html msg
u =
node "u"
{-| Represents text highlighted for reference purposes, that is for its
relevance in another context.
-}
mark : List (Attribute msg) -> List (Html msg) -> Html msg
mark =
node "mark"
{-| Represents content to be marked with ruby annotations, short runs of text
presented alongside the text. This is often used in conjunction with East Asian
language where the annotations act as a guide for pronunciation, like the
Japanese furigana.
-}
ruby : List (Attribute msg) -> List (Html msg) -> Html msg
ruby =
node "ruby"
{-| Represents the text of a ruby annotation. -}
rt : List (Attribute msg) -> List (Html msg) -> Html msg
rt =
node "rt"
{-| Represents parenthesis around a ruby annotation, used to display the
annotation in an alternate way by browsers not supporting the standard display
for annotations.
-}
rp : List (Attribute msg) -> List (Html msg) -> Html msg
rp =
node "rp"
{-| Represents text that must be isolated from its surrounding for
bidirectional text formatting. It allows embedding a span of text with a
different, or unknown, directionality.
-}
bdi : List (Attribute msg) -> List (Html msg) -> Html msg
bdi =
node "bdi"
{-| Represents the directionality of its children, in order to explicitly
override the Unicode bidirectional algorithm.
-}
bdo : List (Attribute msg) -> List (Html msg) -> Html msg
bdo =
node "bdo"
{-| Represents text with no specific meaning. This has to be used when no other
text-semantic element conveys an adequate meaning, which, in this case, is
often brought by global attributes like `class`, `lang`, or `dir`.
-}
span : List (Attribute msg) -> List (Html msg) -> Html msg
span =
node "span"
{-| Represents a line break. -}
br : List (Attribute msg) -> List (Html msg) -> Html msg
br =
node "br"
{-| Represents a line break opportunity, that is a suggested point for
wrapping text in order to improve readability of text split on several lines.
-}
wbr : List (Attribute msg) -> List (Html msg) -> Html msg
wbr =
node "wbr"
-- EDITS
{-| Defines an addition to the document. -}
ins : List (Attribute msg) -> List (Html msg) -> Html msg
ins =
node "ins"
{-| Defines a removal from the document. -}
del : List (Attribute msg) -> List (Html msg) -> Html msg
del =
node "del"
-- EMBEDDED CONTENT
{-| Represents an image. -}
img : List (Attribute msg) -> List (Html msg) -> Html msg
img =
node "img"
{-| Embedded an HTML document. -}
iframe : List (Attribute msg) -> List (Html msg) -> Html msg
iframe =
node "iframe"
{-| Represents a integration point for an external, often non-HTML,
application or interactive content.
-}
embed : List (Attribute msg) -> List (Html msg) -> Html msg
embed =
node "embed"
{-| Represents an external resource, which is treated as an image, an HTML
sub-document, or an external resource to be processed by a plug-in.
-}
object : List (Attribute msg) -> List (Html msg) -> Html msg
object =
node "object"
{-| Defines parameters for use by plug-ins invoked by `object` elements. -}
param : List (Attribute msg) -> List (Html msg) -> Html msg
param =
node "param"
{-| Represents a video, the associated audio and captions, and controls. -}
video : List (Attribute msg) -> List (Html msg) -> Html msg
video =
node "video"
{-| Represents a sound or audio stream. -}
audio : List (Attribute msg) -> List (Html msg) -> Html msg
audio =
node "audio"
{-| Allows authors to specify alternative media resources for media elements
like `video` or `audio`.
-}
source : List (Attribute msg) -> List (Html msg) -> Html msg
source =
node "source"
{-| Allows authors to specify timed text track for media elements like `video`
or `audio`.
-}
track : List (Attribute msg) -> List (Html msg) -> Html msg
track =
node "track"
{-| Represents a bitmap area for graphics rendering. -}
canvas : List (Attribute msg) -> List (Html msg) -> Html msg
canvas =
node "canvas"
{-| Defines a mathematical formula. -}
math : List (Attribute msg) -> List (Html msg) -> Html msg
math =
node "math"
-- TABULAR DATA
{-| Represents data with more than one dimension. -}
table : List (Attribute msg) -> List (Html msg) -> Html msg
table =
node "table"
{-| Represents the title of a table. -}
caption : List (Attribute msg) -> List (Html msg) -> Html msg
caption =
node "caption"
{-| Represents a set of one or more columns of a table. -}
colgroup : List (Attribute msg) -> List (Html msg) -> Html msg
colgroup =
node "colgroup"
{-| Represents a column of a table. -}
col : List (Attribute msg) -> List (Html msg) -> Html msg
col =
node "col"
{-| Represents the block of rows that describes the concrete data of a table.
-}
tbody : List (Attribute msg) -> List (Html msg) -> Html msg
tbody =
node "tbody"
{-| Represents the block of rows that describes the column labels of a table.
-}
thead : List (Attribute msg) -> List (Html msg) -> Html msg
thead =
node "thead"
{-| Represents the block of rows that describes the column summaries of a table.
-}
tfoot : List (Attribute msg) -> List (Html msg) -> Html msg
tfoot =
node "tfoot"
{-| Represents a row of cells in a table. -}
tr : List (Attribute msg) -> List (Html msg) -> Html msg
tr =
node "tr"
{-| Represents a data cell in a table. -}
td : List (Attribute msg) -> List (Html msg) -> Html msg
td =
node "td"
{-| Represents a header cell in a table. -}
th : List (Attribute msg) -> List (Html msg) -> Html msg
th =
node "th"
-- FORMS
{-| Represents a form, consisting of controls, that can be submitted to a
server for processing.
-}
form : List (Attribute msg) -> List (Html msg) -> Html msg
form =
node "form"
{-| Represents a set of controls. -}
fieldset : List (Attribute msg) -> List (Html msg) -> Html msg
fieldset =
node "fieldset"
{-| Represents the caption for a `fieldset`. -}
legend : List (Attribute msg) -> List (Html msg) -> Html msg
legend =
node "legend"
{-| Represents the caption of a form control. -}
label : List (Attribute msg) -> List (Html msg) -> Html msg
label =
node "label"
{-| Represents a typed data field allowing the user to edit the data. -}
input : List (Attribute msg) -> List (Html msg) -> Html msg
input =
node "input"
{-| Represents a button. -}
button : List (Attribute msg) -> List (Html msg) -> Html msg
button =
node "button"
{-| Represents a control allowing selection among a set of options. -}
select : List (Attribute msg) -> List (Html msg) -> Html msg
select =
node "select"
{-| Represents a set of predefined options for other controls. -}
datalist : List (Attribute msg) -> List (Html msg) -> Html msg
datalist =
node "datalist"
{-| Represents a set of options, logically grouped. -}
optgroup : List (Attribute msg) -> List (Html msg) -> Html msg
optgroup =
node "optgroup"
{-| Represents an option in a `select` element or a suggestion of a `datalist`
element.
-}
option : List (Attribute msg) -> List (Html msg) -> Html msg
option =
node "option"
{-| Represents a multiline text edit control. -}
textarea : List (Attribute msg) -> List (Html msg) -> Html msg
textarea =
node "textarea"
{-| Represents a key-pair generator control. -}
keygen : List (Attribute msg) -> List (Html msg) -> Html msg
keygen =
node "keygen"
{-| Represents the result of a calculation. -}
output : List (Attribute msg) -> List (Html msg) -> Html msg
output =
node "output"
{-| Represents the completion progress of a task. -}
progress : List (Attribute msg) -> List (Html msg) -> Html msg
progress =
node "progress"
{-| Represents a scalar measurement (or a fractional value), within a known
range.
-}
meter : List (Attribute msg) -> List (Html msg) -> Html msg
meter =
node "meter"
-- INTERACTIVE ELEMENTS
{-| Represents a widget from which the user can obtain additional information
or controls.
-}
details : List (Attribute msg) -> List (Html msg) -> Html msg
details =
node "details"
{-| Represents a summary, caption, or legend for a given `details`. -}
summary : List (Attribute msg) -> List (Html msg) -> Html msg
summary =
node "summary"
{-| Represents a command that the user can invoke. -}
menuitem : List (Attribute msg) -> List (Html msg) -> Html msg
menuitem =
node "menuitem"
{-| Represents a list of commands. -}
menu : List (Attribute msg) -> List (Html msg) -> Html msg
menu =
node "menu"

1009
part4/elm-stuff/packages/elm-lang/html/2.0.0/src/Html/Attributes.elm vendored Normal file
View File

File diff suppressed because it is too large Load Diff

269
part4/elm-stuff/packages/elm-lang/html/2.0.0/src/Html/Events.elm vendored Normal file
View File

@@ -0,0 +1,269 @@
module Html.Events exposing
( onClick, onDoubleClick
, onMouseDown, onMouseUp
, onMouseEnter, onMouseLeave
, onMouseOver, onMouseOut
, onInput, onCheck, onSubmit
, onBlur, onFocus
, on, onWithOptions, Options, defaultOptions
, targetValue, targetChecked, keyCode
)
{-|
It is often helpful to create an [Union Type][] so you can have many different kinds
of events as seen in the [TodoMVC][] example.
[Union Type]: http://elm-lang.org/learn/Union-Types.elm
[TodoMVC]: https://github.com/evancz/elm-todomvc/blob/master/Todo.elm
# Mouse Helpers
@docs onClick, onDoubleClick,
onMouseDown, onMouseUp,
onMouseEnter, onMouseLeave,
onMouseOver, onMouseOut
# Form Helpers
@docs onInput, onCheck, onSubmit
# Focus Helpers
@docs onBlur, onFocus
# Custom Event Handlers
@docs on, onWithOptions, Options, defaultOptions
# Custom Decoders
@docs targetValue, targetChecked, keyCode
-}
import Html exposing (Attribute)
import Json.Decode as Json
import VirtualDom
-- MOUSE EVENTS
{-|-}
onClick : msg -> Attribute msg
onClick msg =
on "click" (Json.succeed msg)
{-|-}
onDoubleClick : msg -> Attribute msg
onDoubleClick msg =
on "dblclick" (Json.succeed msg)
{-|-}
onMouseDown : msg -> Attribute msg
onMouseDown msg =
on "mousedown" (Json.succeed msg)
{-|-}
onMouseUp : msg -> Attribute msg
onMouseUp msg =
on "mouseup" (Json.succeed msg)
{-|-}
onMouseEnter : msg -> Attribute msg
onMouseEnter msg =
on "mouseenter" (Json.succeed msg)
{-|-}
onMouseLeave : msg -> Attribute msg
onMouseLeave msg =
on "mouseleave" (Json.succeed msg)
{-|-}
onMouseOver : msg -> Attribute msg
onMouseOver msg =
on "mouseover" (Json.succeed msg)
{-|-}
onMouseOut : msg -> Attribute msg
onMouseOut msg =
on "mouseout" (Json.succeed msg)
-- FORM EVENTS
{-| Capture [input](https://developer.mozilla.org/en-US/docs/Web/Events/input)
events for things like text fields or text areas.
It grabs the **string** value at `event.target.value`, so it will not work if
you need some other type of information. For example, if you want to track
inputs on a range slider, make a custom handler with [`on`](#on).
For more details on how `onInput` works, check out [targetValue](#targetValue).
-}
onInput : (String -> msg) -> Attribute msg
onInput tagger =
on "input" (Json.map tagger targetValue)
{-| Capture [change](https://developer.mozilla.org/en-US/docs/Web/Events/change)
events on checkboxes. It will grab the boolean value from `event.target.checked`
on any input event.
Check out [targetChecked](#targetChecked) for more details on how this works.
-}
onCheck : (Bool -> msg) -> Attribute msg
onCheck tagger =
on "change" (Json.map tagger targetChecked)
{-| Capture a [submit](https://developer.mozilla.org/en-US/docs/Web/Events/submit)
event with [`preventDefault`](https://developer.mozilla.org/en-US/docs/Web/API/Event/preventDefault)
in order to prevent the form from changing the page’s location. If you need
different behavior, use `onWithOptions` to create a customized version of
`onSubmit`.
-}
onSubmit : msg -> Attribute msg
onSubmit msg =
onWithOptions "submit" onSubmitOptions (Json.succeed msg)
onSubmitOptions : Options
onSubmitOptions =
{ defaultOptions | preventDefault = True }
-- FOCUS EVENTS
{-|-}
onBlur : msg -> Attribute msg
onBlur msg =
on "blur" (Json.succeed msg)
{-|-}
onFocus : msg -> Attribute msg
onFocus msg =
on "focus" (Json.succeed msg)
-- CUSTOM EVENTS
{-| Create a custom event listener. Normally this will not be necessary, but
you have the power! Here is how `onClick` is defined for example:
import Json.Decode as Json
onClick : msg -> Attribute msg
onClick message =
on "click" (Json.succeed message)
The first argument is the event name in the same format as with JavaScript's
[`addEventListener`][aEL] function.
The second argument is a JSON decoder. Read more about these [here][decoder].
When an event occurs, the decoder tries to turn the event object into an Elm
value. If successful, the value is routed to your `update` function. In the
case of `onClick` we always just succeed with the given `message`.
If this is confusing, work through the [Elm Architecture Tutorial][tutorial].
It really does help!
[aEL]: https://developer.mozilla.org/en-US/docs/Web/API/EventTarget/addEventListener
[decoder]: http://package.elm-lang.org/packages/elm-lang/core/latest/Json-Decode
[tutorial]: https://github.com/evancz/elm-architecture-tutorial/
-}
on : String -> Json.Decoder msg -> Attribute msg
on =
VirtualDom.on
{-| Same as `on` but you can set a few options.
-}
onWithOptions : String -> Options -> Json.Decoder msg -> Attribute msg
onWithOptions =
VirtualDom.onWithOptions
{-| Options for an event listener. If `stopPropagation` is true, it means the
event stops traveling through the DOM so it will not trigger any other event
listeners. If `preventDefault` is true, any built-in browser behavior related
to the event is prevented. For example, this is used with touch events when you
want to treat them as gestures of your own, not as scrolls.
-}
type alias Options =
{ stopPropagation : Bool
, preventDefault : Bool
}
{-| Everything is `False` by default.
defaultOptions =
{ stopPropagation = False
, preventDefault = False
}
-}
defaultOptions : Options
defaultOptions =
VirtualDom.defaultOptions
-- COMMON DECODERS
{-| A `Json.Decoder` for grabbing `event.target.value`. We use this to define
`onInput` as follows:
import Json.Decode as Json
onInput : (String -> msg) -> Attribute msg
onInput tagger =
on "input" (Json.map tagger targetValue)
You probably will never need this, but hopefully it gives some insights into
how to make custom event handlers.
-}
targetValue : Json.Decoder String
targetValue =
Json.at ["target", "value"] Json.string
{-| A `Json.Decoder` for grabbing `event.target.checked`. We use this to define
`onCheck` as follows:
import Json.Decode as Json
onCheck : (Bool -> msg) -> Attribute msg
onCheck tagger =
on "input" (Json.map tagger targetChecked)
-}
targetChecked : Json.Decoder Bool
targetChecked =
Json.at ["target", "checked"] Json.bool
{-| A `Json.Decoder` for grabbing `event.keyCode`. This helps you define
keyboard listeners like this:
import Json.Decode as Json
onKeyUp : (Int -> msg) -> Attribute msg
onKeyUp tagger =
on "keyup" (Json.map tagger keyCode)
**Note:** It looks like the spec is moving away from `event.keyCode` and
towards `event.key`. Once this is supported in more browsers, we may add
helpers here for `onKeyUp`, `onKeyDown`, `onKeyPress`, etc.
-}
keyCode : Json.Decoder Int
keyCode =
Json.field "keyCode" Json.int

48
part4/elm-stuff/packages/elm-lang/html/2.0.0/src/Html/Keyed.elm vendored Normal file
View File

@@ -0,0 +1,48 @@
module Html.Keyed exposing
( node
, ol
, ul
)
{-| A keyed node helps optimize cases where children are getting added, moved,
removed, etc. Common examples include:
- The user can delete items from a list.
- The user can create new items in a list.
- You can sort a list based on name or date or whatever.
When you use a keyed node, every child is paired with a string identifier. This
makes it possible for the underlying diffing algorithm to reuse nodes more
efficiently.
# Keyed Nodes
@docs node
# Commonly Keyed Nodes
@docs ol, ul
-}
import Html exposing (Attribute, Html)
import VirtualDom
{-| Works just like `Html.node`, but you add a unique identifier to each child
node. You want this when you have a list of nodes that is changing: adding
nodes, removing nodes, etc. In these cases, the unique identifiers help make
the DOM modifications more efficient.
-}
node : String -> List (Attribute msg) -> List ( String, Html msg ) -> Html msg
node =
VirtualDom.keyedNode
{-|-}
ol : List (Attribute msg) -> List ( String, Html msg ) -> Html msg
ol =
node "ol"
{-|-}
ul : List (Attribute msg) -> List ( String, Html msg ) -> Html msg
ul =
node "ul"

48
part4/elm-stuff/packages/elm-lang/html/2.0.0/src/Html/Lazy.elm vendored Normal file
View File

@@ -0,0 +1,48 @@
module Html.Lazy exposing
( lazy, lazy2, lazy3
)
{-| Since all Elm functions are pure we have a guarantee that the same input
will always result in the same output. This module gives us tools to be lazy
about building `Html` that utilize this fact.
Rather than immediately applying functions to their arguments, the `lazy`
functions just bundle the function and arguments up for later. When diffing
the old and new virtual DOM, it checks to see if all the arguments are equal.
If so, it skips calling the function!
This is a really cheap test and often makes things a lot faster, but definitely
benchmark to be sure!
@docs lazy, lazy2, lazy3
-}
import Html exposing (Html)
import VirtualDom
{-| A performance optimization that delays the building of virtual DOM nodes.
Calling `(view model)` will definitely build some virtual DOM, perhaps a lot of
it. Calling `(lazy view model)` delays the call until later. During diffing, we
can check to see if `model` is referentially equal to the previous value used,
and if so, we just stop. No need to build up the tree structure and diff it,
we know if the input to `view` is the same, the output must be the same!
-}
lazy : (a -> Html msg) -> a -> Html msg
lazy =
VirtualDom.lazy
{-| Same as `lazy` but checks on two arguments.
-}
lazy2 : (a -> b -> Html msg) -> a -> b -> Html msg
lazy2 =
VirtualDom.lazy2
{-| Same as `lazy` but checks on three arguments.
-}
lazy3 : (a -> b -> c -> Html msg) -> a -> b -> c -> Html msg
lazy3 =
VirtualDom.lazy3

3
part4/elm-stuff/packages/elm-lang/virtual-dom/2.0.4/.gitignore vendored Normal file
View File

@@ -0,0 +1,3 @@
node_modules
elm-stuff
tests/build

30
part4/elm-stuff/packages/elm-lang/virtual-dom/2.0.4/LICENSE vendored Normal file
View File

@@ -0,0 +1,30 @@
Copyright (c) 2016-present, 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.

17
part4/elm-stuff/packages/elm-lang/virtual-dom/2.0.4/elm-package.json vendored Normal file
View File

@@ -0,0 +1,17 @@
{
"version": "2.0.4",
"summary": "Core virtual DOM implementation, basis for HTML and SVG libraries",
"repository": "https://github.com/elm-lang/virtual-dom.git",
"license": "BSD3",
"source-directories": [
"src"
],
"exposed-modules": [
"VirtualDom"
],
"native-modules": true,
"dependencies": {
"elm-lang/core": "5.0.0 <= v < 6.0.0"
},
"elm-version": "0.18.0 <= v < 0.19.0"
}

280
part4/elm-stuff/packages/elm-lang/virtual-dom/2.0.4/src/Native/Debug.js vendored Normal file
View File

@@ -0,0 +1,280 @@
var _elm_lang$virtual_dom$Native_Debug = function() {
// IMPORT / EXPORT
function unsafeCoerce(value)
{
return value;
}
var upload = _elm_lang$core$Native_Scheduler.nativeBinding(function(callback)
{
var element = document.createElement('input');
element.setAttribute('type', 'file');
element.setAttribute('accept', 'text/json');
element.style.display = 'none';
element.addEventListener('change', function(event)
{
var fileReader = new FileReader();
fileReader.onload = function(e)
{
callback(_elm_lang$core$Native_Scheduler.succeed(e.target.result));
};
fileReader.readAsText(event.target.files[0]);
document.body.removeChild(element);
});
document.body.appendChild(element);
element.click();
});
function download(historyLength, json)
{
return _elm_lang$core$Native_Scheduler.nativeBinding(function(callback)
{
var fileName = 'history-' + historyLength + '.txt';
var jsonString = JSON.stringify(json);
var mime = 'text/plain;charset=utf-8';
var done = _elm_lang$core$Native_Scheduler.succeed(_elm_lang$core$Native_Utils.Tuple0);
// for IE10+
if (navigator.msSaveBlob)
{
navigator.msSaveBlob(new Blob([jsonString], {type: mime}), fileName);
return callback(done);
}
// for HTML5
var element = document.createElement('a');
element.setAttribute('href', 'data:' + mime + ',' + encodeURIComponent(jsonString));
element.setAttribute('download', fileName);
element.style.display = 'none';
document.body.appendChild(element);
element.click();
document.body.removeChild(element);
callback(done);
});
}
// POPOUT
function messageToString(value)
{
switch (typeof value)
{
case 'boolean':
return value ? 'True' : 'False';
case 'number':
return value + '';
case 'string':
return '"' + addSlashes(value, false) + '"';
}
if (value instanceof String)
{
return '\'' + addSlashes(value, true) + '\'';
}
if (typeof value !== 'object' || value === null || !('ctor' in value))
{
return '…';
}
var ctorStarter = value.ctor.substring(0, 5);
if (ctorStarter === '_Tupl' || ctorStarter === '_Task')
{
return '…'
}
if (['_Array', '<decoder>', '_Process', '::', '[]', 'Set_elm_builtin', 'RBNode_elm_builtin', 'RBEmpty_elm_builtin'].indexOf(value.ctor) >= 0)
{
return '…';
}
var keys = Object.keys(value);
switch (keys.length)
{
case 1:
return value.ctor;
case 2:
return value.ctor + ' ' + messageToString(value._0);
default:
return value.ctor + ' … ' + messageToString(value[keys[keys.length - 1]]);
}
}
function primitive(str)
{
return { ctor: 'Primitive', _0: str };
}
function init(value)
{
var type = typeof value;
if (type === 'boolean')
{
return {
ctor: 'Constructor',
_0: _elm_lang$core$Maybe$Just(value ? 'True' : 'False'),
_1: true,
_2: _elm_lang$core$Native_List.Nil
};
}
if (type === 'number')
{
return primitive(value + '');
}
if (type === 'string')
{
return { ctor: 'S', _0: '"' + addSlashes(value, false) + '"' };
}
if (value instanceof String)
{
return { ctor: 'S', _0: "'" + addSlashes(value, true) + "'" };
}
if (value instanceof Date)
{
return primitive('<' + value.toString() + '>');
}
if (value === null)
{
return primitive('XXX');
}
if (type === 'object' && 'ctor' in value)
{
var ctor = value.ctor;
if (ctor === '::' || ctor === '[]')
{
return {
ctor: 'Sequence',
_0: {ctor: 'ListSeq'},
_1: true,
_2: A2(_elm_lang$core$List$map, init, value)
};
}
if (ctor === 'Set_elm_builtin')
{
return {
ctor: 'Sequence',
_0: {ctor: 'SetSeq'},
_1: true,
_2: A3(_elm_lang$core$Set$foldr, initCons, _elm_lang$core$Native_List.Nil, value)
};
}
if (ctor === 'RBNode_elm_builtin' || ctor == 'RBEmpty_elm_builtin')
{
return {
ctor: 'Dictionary',
_0: true,
_1: A3(_elm_lang$core$Dict$foldr, initKeyValueCons, _elm_lang$core$Native_List.Nil, value)
};
}
if (ctor === '_Array')
{
return {
ctor: 'Sequence',
_0: {ctor: 'ArraySeq'},
_1: true,
_2: A3(_elm_lang$core$Array$foldr, initCons, _elm_lang$core$Native_List.Nil, value)
};
}
var ctorStarter = value.ctor.substring(0, 5);
if (ctorStarter === '_Task')
{
return primitive('<task>');
}
if (ctor === '<decoder>')
{
return primitive(ctor);
}
if (ctor === '_Process')
{
return primitive('<process>');
}
var list = _elm_lang$core$Native_List.Nil;
for (var i in value)
{
if (i === 'ctor') continue;
list = _elm_lang$core$Native_List.Cons(init(value[i]), list);
}
return {
ctor: 'Constructor',
_0: ctorStarter === '_Tupl' ? _elm_lang$core$Maybe$Nothing : _elm_lang$core$Maybe$Just(ctor),
_1: true,
_2: _elm_lang$core$List$reverse(list)
};
}
if (type === 'object')
{
var dict = _elm_lang$core$Dict$empty;
for (var i in value)
{
dict = A3(_elm_lang$core$Dict$insert, i, init(value[i]), dict);
}
return { ctor: 'Record', _0: true, _1: dict };
}
return primitive('XXX');
}
var initCons = F2(initConsHelp);
function initConsHelp(value, list)
{
return _elm_lang$core$Native_List.Cons(init(value), list);
}
var initKeyValueCons = F3(initKeyValueConsHelp);
function initKeyValueConsHelp(key, value, list)
{
return _elm_lang$core$Native_List.Cons(
_elm_lang$core$Native_Utils.Tuple2(init(key), init(value)),
list
);
}
function addSlashes(str, isChar)
{
var s = str.replace(/\\/g, '\\\\')
.replace(/\n/g, '\\n')
.replace(/\t/g, '\\t')
.replace(/\r/g, '\\r')
.replace(/\v/g, '\\v')
.replace(/\0/g, '\\0');
if (isChar)
{
return s.replace(/\'/g, '\\\'');
}
else
{
return s.replace(/\"/g, '\\"');
}
}
return {
upload: upload,
download: F2(download),
unsafeCoerce: unsafeCoerce,
messageToString: messageToString,
init: init
}
}();

1881
part4/elm-stuff/packages/elm-lang/virtual-dom/2.0.4/src/Native/VirtualDom.js vendored Normal file
View File

File diff suppressed because it is too large Load Diff

331
part4/elm-stuff/packages/elm-lang/virtual-dom/2.0.4/src/VirtualDom.elm vendored Normal file
View File

@@ -0,0 +1,331 @@
module VirtualDom exposing
( Node
, text, node
, Property, property, attribute, attributeNS, mapProperty
, style
, on, onWithOptions, Options, defaultOptions
, map
, lazy, lazy2, lazy3
, keyedNode
, program, programWithFlags
)
{-| API to the core diffing algorithm. Can serve as a foundation for libraries
that expose more helper functions for HTML or SVG.
# Create
@docs Node, text, node
# Declare Properties and Attributes
@docs Property, property, attribute, attributeNS, mapProperty
# Styles
@docs style
# Events
@docs on, onWithOptions, Options, defaultOptions
# Routing Messages
@docs map
# Optimizations
@docs lazy, lazy2, lazy3, keyedNode
# Programs
@docs program, programWithFlags
-}
import Json.Decode as Json
import Native.VirtualDom
import VirtualDom.Debug as Debug
{-| An immutable chunk of data representing a DOM node. This can be HTML or SVG.
-}
type Node msg = Node
{-| Create a DOM node with a tag name, a list of HTML properties that can
include styles and event listeners, a list of CSS properties like `color`, and
a list of child nodes.
import Json.Encode as Json
hello : Node msg
hello =
node "div" [] [ text "Hello!" ]
greeting : Node msg
greeting =
node "div"
[ property "id" (Json.string "greeting") ]
[ text "Hello!" ]
-}
node : String -> List (Property msg) -> List (Node msg) -> Node msg
node =
Native.VirtualDom.node
{-| Just put plain text in the DOM. It will escape the string so that it appears
exactly as you specify.
text "Hello World!"
-}
text : String -> Node msg
text =
Native.VirtualDom.text
{-| This function is useful when nesting components with [the Elm
Architecture](https://github.com/evancz/elm-architecture-tutorial/). It lets
you transform the messages produced by a subtree.
Say you have a node named `button` that produces `()` values when it is
clicked. To get your model updating properly, you will probably want to tag
this `()` value like this:
type Msg = Click | ...
update msg model =
case msg of
Click ->
...
view model =
map (\_ -> Click) button
So now all the events produced by `button` will be transformed to be of type
`Msg` so they can be handled by your update function!
-}
map : (a -> msg) -> Node a -> Node msg
map =
Native.VirtualDom.map
-- PROPERTIES
{-| When using HTML and JS, there are two ways to specify parts of a DOM node.
1. Attributes &mdash; You can set things in HTML itself. So the `class`
in `<div class="greeting"></div>` is called an *attribute*.
2. Properties &mdash; You can also set things in JS. So the `className`
in `div.className = 'greeting'` is called a *property*.
So the `class` attribute corresponds to the `className` property. At first
glance, perhaps this distinction is defensible, but it gets much crazier.
*There is not always a one-to-one mapping between attributes and properties!*
Yes, that is a true fact. Sometimes an attribute exists, but there is no
corresponding property. Sometimes changing an attribute does not change the
underlying property. For example, as of this writing, the `webkit-playsinline`
attribute can be used in HTML, but there is no corresponding property!
-}
type Property msg = Property
{-| Create arbitrary *properties*.
import JavaScript.Encode as Json
greeting : Html
greeting =
node "div" [ property "className" (Json.string "greeting") ] [
text "Hello!"
]
Notice that you must give the *property* name, so we use `className` as it
would be in JavaScript, not `class` as it would appear in HTML.
-}
property : String -> Json.Value -> Property msg
property =
Native.VirtualDom.property
{-| Create arbitrary HTML *attributes*. Maps onto JavaScript’s `setAttribute`
function under the hood.
greeting : Html
greeting =
node "div" [ attribute "class" "greeting" ] [
text "Hello!"
]
Notice that you must give the *attribute* name, so we use `class` as it would
be in HTML, not `className` as it would appear in JS.
-}
attribute : String -> String -> Property msg
attribute =
Native.VirtualDom.attribute
{-| Would you believe that there is another way to do this?! This corresponds
to JavaScript's `setAttributeNS` function under the hood. It is doing pretty
much the same thing as `attribute` but you are able to have "namespaced"
attributes. This is used in some SVG stuff at least.
-}
attributeNS : String -> String -> String -> Property msg
attributeNS =
Native.VirtualDom.attributeNS
{-| Transform the messages produced by a `Property`.
-}
mapProperty : (a -> b) -> Property a -> Property b
mapProperty =
Native.VirtualDom.mapProperty
{-| Specify a list of styles.
myStyle : Property msg
myStyle =
style
[ ("backgroundColor", "red")
, ("height", "90px")
, ("width", "100%")
]
greeting : Node msg
greeting =
node "div" [ myStyle ] [ text "Hello!" ]
-}
style : List (String, String) -> Property msg
style =
Native.VirtualDom.style
-- EVENTS
{-| Create a custom event listener.
import Json.Decode as Json
onClick : msg -> Property msg
onClick msg =
on "click" (Json.succeed msg)
You first specify the name of the event in the same format as with JavaScript’s
`addEventListener`. Next you give a JSON decoder, which lets you pull
information out of the event object. If the decoder succeeds, it will produce
a message and route it to your `update` function.
-}
on : String -> Json.Decoder msg -> Property msg
on eventName decoder =
onWithOptions eventName defaultOptions decoder
{-| Same as `on` but you can set a few options.
-}
onWithOptions : String -> Options -> Json.Decoder msg -> Property msg
onWithOptions =
Native.VirtualDom.on
{-| Options for an event listener. If `stopPropagation` is true, it means the
event stops traveling through the DOM so it will not trigger any other event
listeners. If `preventDefault` is true, any built-in browser behavior related
to the event is prevented. For example, this is used with touch events when you
want to treat them as gestures of your own, not as scrolls.
-}
type alias Options =
{ stopPropagation : Bool
, preventDefault : Bool
}
{-| Everything is `False` by default.
defaultOptions =
{ stopPropagation = False
, preventDefault = False
}
-}
defaultOptions : Options
defaultOptions =
{ stopPropagation = False
, preventDefault = False
}
-- OPTIMIZATION
{-| A performance optimization that delays the building of virtual DOM nodes.
Calling `(view model)` will definitely build some virtual DOM, perhaps a lot of
it. Calling `(lazy view model)` delays the call until later. During diffing, we
can check to see if `model` is referentially equal to the previous value used,
and if so, we just stop. No need to build up the tree structure and diff it,
we know if the input to `view` is the same, the output must be the same!
-}
lazy : (a -> Node msg) -> a -> Node msg
lazy =
Native.VirtualDom.lazy
{-| Same as `lazy` but checks on two arguments.
-}
lazy2 : (a -> b -> Node msg) -> a -> b -> Node msg
lazy2 =
Native.VirtualDom.lazy2
{-| Same as `lazy` but checks on three arguments.
-}
lazy3 : (a -> b -> c -> Node msg) -> a -> b -> c -> Node msg
lazy3 =
Native.VirtualDom.lazy3
{-| Works just like `node`, but you add a unique identifier to each child
node. You want this when you have a list of nodes that is changing: adding
nodes, removing nodes, etc. In these cases, the unique identifiers help make
the DOM modifications more efficient.
-}
keyedNode : String -> List (Property msg) -> List ( String, Node msg ) -> Node msg
keyedNode =
Native.VirtualDom.keyedNode
-- PROGRAMS
{-| Check out the docs for [`Html.App.program`][prog].
It works exactly the same way.
[prog]: http://package.elm-lang.org/packages/elm-lang/html/latest/Html-App#program
-}
program
: { init : (model, Cmd msg)
, update : msg -> model -> (model, Cmd msg)
, subscriptions : model -> Sub msg
, view : model -> Node msg
}
-> Program Never model msg
program impl =
Native.VirtualDom.program Debug.wrap impl
{-| Check out the docs for [`Html.App.programWithFlags`][prog].
It works exactly the same way.
[prog]: http://package.elm-lang.org/packages/elm-lang/html/latest/Html-App#programWithFlags
-}
programWithFlags
: { init : flags -> (model, Cmd msg)
, update : msg -> model -> (model, Cmd msg)
, subscriptions : model -> Sub msg
, view : model -> Node msg
}
-> Program flags model msg
programWithFlags impl =
Native.VirtualDom.programWithFlags Debug.wrapWithFlags impl

567
part4/elm-stuff/packages/elm-lang/virtual-dom/2.0.4/src/VirtualDom/Debug.elm vendored Normal file
View File

@@ -0,0 +1,567 @@
module VirtualDom.Debug exposing (wrap, wrapWithFlags)
import Json.Decode as Decode
import Json.Encode as Encode
import Task exposing (Task)
import Native.Debug
import Native.VirtualDom
import VirtualDom.Expando as Expando exposing (Expando)
import VirtualDom.Helpers as VDom exposing (Node)
import VirtualDom.History as History exposing (History)
import VirtualDom.Metadata as Metadata exposing (Metadata)
import VirtualDom.Overlay as Overlay
import VirtualDom.Report as Report
-- WRAP PROGRAMS
wrap metadata { init, update, subscriptions, view } =
{ init = wrapInit metadata init
, view = wrapView view
, update = wrapUpdate update
, viewIn = viewIn
, viewOut = viewOut
, subscriptions = wrapSubs subscriptions
}
wrapWithFlags metadata { init, update, subscriptions, view } =
{ init = \flags -> wrapInit metadata (init flags)
, view = wrapView view
, update = wrapUpdate update
, viewIn = viewIn
, viewOut = viewOut
, subscriptions = wrapSubs subscriptions
}
-- MODEL
type alias Model model msg =
{ history : History model msg
, state : State model
, expando : Expando
, metadata : Result Metadata.Error Metadata
, overlay : Overlay.State
, isDebuggerOpen : Bool
}
type State model
= Running model
| Paused Int model model
wrapInit : Encode.Value -> ( model, Cmd msg ) -> ( Model model msg, Cmd (Msg msg) )
wrapInit metadata ( userModel, userCommands ) =
{ history = History.empty userModel
, state = Running userModel
, expando = Expando.init userModel
, metadata = Metadata.decode metadata
, overlay = Overlay.none
, isDebuggerOpen = False
}
! [ Cmd.map UserMsg userCommands ]
-- UPDATE
type Msg msg
= NoOp
| UserMsg msg
| ExpandoMsg Expando.Msg
| Resume
| Jump Int
| Open
| Close
| Up
| Down
| Import
| Export
| Upload String
| OverlayMsg Overlay.Msg
type alias UserUpdate model msg =
msg -> model -> ( model, Cmd msg )
wrapUpdate
: UserUpdate model msg
-> Task Never ()
-> Msg msg
-> Model model msg
-> (Model model msg, Cmd (Msg msg))
wrapUpdate userUpdate scrollTask msg model =
case msg of
NoOp ->
model ! []
UserMsg userMsg ->
updateUserMsg userUpdate scrollTask userMsg model
ExpandoMsg eMsg ->
{ model
| expando = Expando.update eMsg model.expando
}
! []
Resume ->
case model.state of
Running _ ->
model ! []
Paused _ _ userModel ->
{ model
| state = Running userModel
, expando = Expando.merge userModel model.expando
}
! [ runIf model.isDebuggerOpen scrollTask ]
Jump index ->
let
(indexModel, indexMsg) =
History.get userUpdate index model.history
in
{ model
| state = Paused index indexModel (getLatestModel model.state)
, expando = Expando.merge indexModel model.expando
}
! []
Open ->
{ model | isDebuggerOpen = True } ! []
Close ->
{ model | isDebuggerOpen = False } ! []
Up ->
let
index =
case model.state of
Paused index _ _ ->
index
Running _ ->
History.size model.history
in
if index > 0 then
wrapUpdate userUpdate scrollTask (Jump (index - 1)) model
else
model ! []
Down ->
case model.state of
Running _ ->
model ! []
Paused index _ userModel ->
if index == History.size model.history - 1 then
wrapUpdate userUpdate scrollTask Resume model
else
wrapUpdate userUpdate scrollTask (Jump (index + 1)) model
Import ->
withGoodMetadata model <| \_ ->
model ! [ upload ]
Export ->
withGoodMetadata model <| \metadata ->
model ! [ download metadata model.history ]
Upload jsonString ->
withGoodMetadata model <| \metadata ->
case Overlay.assessImport metadata jsonString of
Err newOverlay ->
{ model | overlay = newOverlay } ! []
Ok rawHistory ->
loadNewHistory rawHistory userUpdate model
OverlayMsg overlayMsg ->
case Overlay.close overlayMsg model.overlay of
Nothing ->
{ model | overlay = Overlay.none } ! []
Just rawHistory ->
loadNewHistory rawHistory userUpdate model
-- COMMANDS
upload : Cmd (Msg msg)
upload =
Task.perform Upload Native.Debug.upload
download : Metadata -> History model msg -> Cmd (Msg msg)
download metadata history =
let
historyLength =
History.size history
json =
Encode.object
[ ("metadata", Metadata.encode metadata)
, ("history", History.encode history)
]
in
Task.perform (\_ -> NoOp) (Native.Debug.download historyLength json)
-- UPDATE OVERLAY
withGoodMetadata
: Model model msg
-> (Metadata -> (Model model msg, Cmd (Msg msg)))
-> (Model model msg, Cmd (Msg msg))
withGoodMetadata model func =
case model.metadata of
Ok metadata ->
func metadata
Err error ->
{ model | overlay = Overlay.badMetadata error } ! []
loadNewHistory
: Encode.Value
-> UserUpdate model msg
-> Model model msg
-> ( Model model msg, Cmd (Msg msg) )
loadNewHistory rawHistory userUpdate model =
let
initialUserModel =
History.initialModel model.history
pureUserUpdate msg userModel =
Tuple.first (userUpdate msg userModel)
decoder =
History.decoder initialUserModel pureUserUpdate
in
case Decode.decodeValue decoder rawHistory of
Err _ ->
{ model | overlay = Overlay.corruptImport } ! []
Ok (latestUserModel, newHistory) ->
{ model
| history = newHistory
, state = Running latestUserModel
, expando = Expando.init latestUserModel
, overlay = Overlay.none
}
! []
-- UPDATE - USER MESSAGES
updateUserMsg
: UserUpdate model msg
-> Task Never ()
-> msg
-> Model model msg
-> (Model model msg, Cmd (Msg msg))
updateUserMsg userUpdate scrollTask userMsg ({ history, state, expando } as model) =
let
userModel =
getLatestModel state
newHistory =
History.add userMsg userModel history
(newUserModel, userCmds) =
userUpdate userMsg userModel
commands =
Cmd.map UserMsg userCmds
in
case state of
Running _ ->
{ model
| history = newHistory
, state = Running newUserModel
, expando = Expando.merge newUserModel expando
}
! [ commands, runIf model.isDebuggerOpen scrollTask ]
Paused index indexModel _ ->
{ model
| history = newHistory
, state = Paused index indexModel newUserModel
}
! [ commands ]
runIf : Bool -> Task Never () -> Cmd (Msg msg)
runIf bool task =
if bool then
Task.perform (always NoOp) task
else
Cmd.none
getLatestModel : State model -> model
getLatestModel state =
case state of
Running model ->
model
Paused _ _ model ->
model
-- SUBSCRIPTIONS
wrapSubs : (model -> Sub msg) -> Model model msg -> Sub (Msg msg)
wrapSubs userSubscriptions {state} =
getLatestModel state
|> userSubscriptions
|> Sub.map UserMsg
-- VIEW
wrapView : (model -> Node msg) -> Model model msg -> Node (Msg msg)
wrapView userView { state } =
let
currentModel =
case state of
Running model ->
model
Paused _ oldModel _ ->
oldModel
in
VDom.map UserMsg (userView currentModel)
-- SMALL DEBUG VIEW
viewIn : Model model msg -> ( Overlay.Block, Node (Msg msg) )
viewIn { history, state, overlay, isDebuggerOpen } =
let
isPaused =
case state of
Running _ ->
False
Paused _ _ _ ->
True
in
Overlay.view overlayConfig isPaused isDebuggerOpen (History.size history) overlay
overlayConfig : Overlay.Config (Msg msg)
overlayConfig =
{ resume = Resume
, open = Open
, importHistory = Import
, exportHistory = Export
, wrap = OverlayMsg
}
-- BIG DEBUG VIEW
viewOut : Model model msg -> Node (Msg msg)
viewOut { history, state, expando } =
VDom.div
[ VDom.id "debugger" ]
[ styles
, viewSidebar state history
, VDom.map ExpandoMsg <|
VDom.div [ VDom.id "values" ] [ Expando.view Nothing expando ]
]
viewSidebar : State model -> History model msg -> Node (Msg msg)
viewSidebar state history =
let
maybeIndex =
case state of
Running _ ->
Nothing
Paused index _ _ ->
Just index
in
VDom.div [ VDom.class "debugger-sidebar" ]
[ VDom.map Jump (History.view maybeIndex history)
, playButton maybeIndex
]
playButton : Maybe Int -> Node (Msg msg)
playButton maybeIndex =
VDom.div [ VDom.class "debugger-sidebar-controls" ]
[ viewResumeButton maybeIndex
, VDom.div [ VDom.class "debugger-sidebar-controls-import-export" ]
[ button Import "Import"
, VDom.text " / "
, button Export "Export"
]
]
button msg label =
VDom.span
[ VDom.onClick msg
, VDom.style [("cursor","pointer")]
]
[ VDom.text label ]
viewResumeButton maybeIndex =
case maybeIndex of
Nothing ->
VDom.text ""
Just _ ->
resumeButton
resumeButton =
VDom.div
[ VDom.onClick Resume
, VDom.class "debugger-sidebar-controls-resume"
]
[ VDom.text "Resume"
]
-- STYLE
styles : Node msg
styles =
VDom.node "style" [] [ VDom.text """
html {
overflow: hidden;
height: 100%;
}
body {
height: 100%;
overflow: auto;
}
#debugger {
width: 100%
height: 100%;
font-family: monospace;
}
#values {
display: block;
float: left;
height: 100%;
width: calc(100% - 30ch);
margin: 0;
overflow: auto;
cursor: default;
}
.debugger-sidebar {
display: block;
float: left;
width: 30ch;
height: 100%;
color: white;
background-color: rgb(61, 61, 61);
}
.debugger-sidebar-controls {
width: 100%;
text-align: center;
background-color: rgb(50, 50, 50);
}
.debugger-sidebar-controls-import-export {
width: 100%;
height: 24px;
line-height: 24px;
font-size: 12px;
}
.debugger-sidebar-controls-resume {
width: 100%;
height: 30px;
line-height: 30px;
cursor: pointer;
}
.debugger-sidebar-controls-resume:hover {
background-color: rgb(41, 41, 41);
}
.debugger-sidebar-messages {
width: 100%;
overflow-y: auto;
height: calc(100% - 24px);
}
.debugger-sidebar-messages-paused {
width: 100%;
overflow-y: auto;
height: calc(100% - 54px);
}
.messages-entry {
cursor: pointer;
width: 100%;
}
.messages-entry:hover {
background-color: rgb(41, 41, 41);
}
.messages-entry-selected, .messages-entry-selected:hover {
background-color: rgb(10, 10, 10);
}
.messages-entry-content {
width: calc(100% - 7ch);
padding-top: 4px;
padding-bottom: 4px;
padding-left: 1ch;
text-overflow: ellipsis;
white-space: nowrap;
overflow: hidden;
display: inline-block;
}
.messages-entry-index {
color: #666;
width: 5ch;
padding-top: 4px;
padding-bottom: 4px;
padding-right: 1ch;
text-align: right;
display: block;
float: right;
}
""" ]

659
part4/elm-stuff/packages/elm-lang/virtual-dom/2.0.4/src/VirtualDom/Expando.elm vendored Normal file
View File

@@ -0,0 +1,659 @@
module VirtualDom.Expando exposing
( Expando
, init
, merge
, Msg, update
, view
)
import Dict exposing (Dict)
import Json.Decode as Json
import Native.Debug
import VirtualDom.Helpers as VDom exposing (Node, text, div, span, class, onClick)
-- MODEL
type Expando
= S String
| Primitive String
| Sequence SeqType Bool (List Expando)
| Dictionary Bool (List (Expando, Expando))
| Record Bool (Dict String Expando)
| Constructor (Maybe String) Bool (List Expando)
type SeqType = ListSeq | SetSeq | ArraySeq
seqTypeToString : Int -> SeqType -> String
seqTypeToString n seqType =
case seqType of
ListSeq ->
"List(" ++ toString n ++ ")"
SetSeq ->
"Set(" ++ toString n ++ ")"
ArraySeq ->
"Array(" ++ toString n ++ ")"
-- INITIALIZE
init : a -> Expando
init value =
initHelp True (Native.Debug.init value)
initHelp : Bool -> Expando -> Expando
initHelp isOuter expando =
case expando of
S _ ->
expando
Primitive _ ->
expando
Sequence seqType isClosed items ->
if isOuter then
Sequence seqType False (List.map (initHelp False) items)
else if List.length items <= 8 then
Sequence seqType False items
else
expando
Dictionary isClosed keyValuePairs ->
if isOuter then
Dictionary False (List.map (\(k,v) -> (k, initHelp False v)) keyValuePairs)
else if List.length keyValuePairs <= 8 then
Dictionary False keyValuePairs
else
expando
Record isClosed entries ->
if isOuter then
Record False (Dict.map (\_ v -> initHelp False v) entries)
else if Dict.size entries <= 4 then
Record False entries
else
expando
Constructor maybeName isClosed args ->
if isOuter then
Constructor maybeName False (List.map (initHelp False) args)
else if List.length args <= 4 then
Constructor maybeName False args
else
expando
-- PRESERVE OLD EXPANDO STATE (open/closed)
merge : a -> Expando -> Expando
merge value expando =
mergeHelp expando (Native.Debug.init value)
mergeHelp : Expando -> Expando -> Expando
mergeHelp old new =
case ( old, new ) of
( _, S _ ) ->
new
( _, Primitive _ ) ->
new
( Sequence _ isClosed oldValues, Sequence seqType _ newValues ) ->
Sequence seqType isClosed (mergeListHelp oldValues newValues)
( Dictionary isClosed _, Dictionary _ keyValuePairs ) ->
Dictionary isClosed keyValuePairs
( Record isClosed oldDict, Record _ newDict ) ->
Record isClosed <| Dict.map (mergeDictHelp oldDict) newDict
( Constructor _ isClosed oldValues, Constructor maybeName _ newValues ) ->
Constructor maybeName isClosed (mergeListHelp oldValues newValues)
_ ->
new
mergeListHelp : List Expando -> List Expando -> List Expando
mergeListHelp olds news =
case (olds, news) of
( [], _ ) ->
news
( _, [] ) ->
news
( x :: xs, y :: ys ) ->
mergeHelp x y :: mergeListHelp xs ys
mergeDictHelp : Dict String Expando -> String -> Expando -> Expando
mergeDictHelp oldDict key value =
case Dict.get key oldDict of
Nothing ->
value
Just oldValue ->
mergeHelp oldValue value
-- UPDATE
type Msg
= Toggle
| Index Redirect Int Msg
| Field String Msg
type Redirect = None | Key | Value
update : Msg -> Expando -> Expando
update msg value =
case value of
S _ ->
Debug.crash "No messages for primitives"
Primitive _ ->
Debug.crash "No messages for primitives"
Sequence seqType isClosed valueList ->
case msg of
Toggle ->
Sequence seqType (not isClosed) valueList
Index None index subMsg ->
Sequence seqType isClosed <|
updateIndex index (update subMsg) valueList
Index _ _ _ ->
Debug.crash "No redirected indexes on sequences"
Field _ _ ->
Debug.crash "No field on sequences"
Dictionary isClosed keyValuePairs ->
case msg of
Toggle ->
Dictionary (not isClosed) keyValuePairs
Index redirect index subMsg ->
case redirect of
None ->
Debug.crash "must have redirect for dictionaries"
Key ->
Dictionary isClosed <|
updateIndex index (\(k,v) -> (update subMsg k, v)) keyValuePairs
Value ->
Dictionary isClosed <|
updateIndex index (\(k,v) -> (k, update subMsg v)) keyValuePairs
Field _ _ ->
Debug.crash "no field for dictionaries"
Record isClosed valueDict ->
case msg of
Toggle ->
Record (not isClosed) valueDict
Index _ _ _ ->
Debug.crash "No index for records"
Field field subMsg ->
Record isClosed (Dict.update field (updateField subMsg) valueDict)
Constructor maybeName isClosed valueList ->
case msg of
Toggle ->
Constructor maybeName (not isClosed) valueList
Index None index subMsg ->
Constructor maybeName isClosed <|
updateIndex index (update subMsg) valueList
Index _ _ _ ->
Debug.crash "No redirected indexes on sequences"
Field _ _ ->
Debug.crash "No field for constructors"
updateIndex : Int -> (a -> a) -> List a -> List a
updateIndex n func list =
case list of
[] ->
[]
x :: xs ->
if n <= 0 then
func x :: xs
else
x :: updateIndex (n-1) func xs
updateField : Msg -> Maybe Expando -> Maybe Expando
updateField msg maybeExpando =
case maybeExpando of
Nothing ->
Debug.crash "key does not exist"
Just expando ->
Just (update msg expando)
-- VIEW
view : Maybe String -> Expando -> Node Msg
view maybeKey expando =
case expando of
S stringRep ->
div [ leftPad maybeKey ] (lineStarter maybeKey Nothing [span [red] [text stringRep]])
Primitive stringRep ->
div [ leftPad maybeKey ] (lineStarter maybeKey Nothing [span [blue] [text stringRep]])
Sequence seqType isClosed valueList ->
viewSequence maybeKey seqType isClosed valueList
Dictionary isClosed keyValuePairs ->
viewDictionary maybeKey isClosed keyValuePairs
Record isClosed valueDict ->
viewRecord maybeKey isClosed valueDict
Constructor maybeName isClosed valueList ->
viewConstructor maybeKey maybeName isClosed valueList
-- VIEW SEQUENCE
viewSequence : Maybe String -> SeqType -> Bool -> List Expando -> Node Msg
viewSequence maybeKey seqType isClosed valueList =
let
starter =
seqTypeToString (List.length valueList) seqType
in
div [ leftPad maybeKey ]
[ div [ onClick Toggle ] (lineStarter maybeKey (Just isClosed) [text starter])
, if isClosed then text "" else viewSequenceOpen valueList
]
viewSequenceOpen : List Expando -> Node Msg
viewSequenceOpen values =
div [] (List.indexedMap viewConstructorEntry values)
-- VIEW DICTIONARY
viewDictionary : Maybe String -> Bool -> List (Expando, Expando) -> Node Msg
viewDictionary maybeKey isClosed keyValuePairs =
let
starter =
"Dict(" ++ toString (List.length keyValuePairs) ++ ")"
in
div [ leftPad maybeKey ]
[ div [ onClick Toggle ] (lineStarter maybeKey (Just isClosed) [text starter])
, if isClosed then text "" else viewDictionaryOpen keyValuePairs
]
viewDictionaryOpen : List (Expando, Expando) -> Node Msg
viewDictionaryOpen keyValuePairs =
div [] (List.indexedMap viewDictionaryEntry keyValuePairs)
viewDictionaryEntry : Int -> (Expando, Expando) -> Node Msg
viewDictionaryEntry index (key, value) =
case key of
S stringRep ->
VDom.map (Index Value index) (view (Just stringRep) value)
Primitive stringRep ->
VDom.map (Index Value index) (view (Just stringRep) value)
_ ->
div []
[ VDom.map (Index Key index) (view (Just "key") key)
, VDom.map (Index Value index) (view (Just "value") value)
]
-- VIEW RECORD
viewRecord : Maybe String -> Bool -> Dict String Expando -> Node Msg
viewRecord maybeKey isClosed record =
let
(start, middle, end) =
if isClosed then
( Tuple.second (viewTinyRecord record), text "", text "" )
else
( [ text "{" ], viewRecordOpen record, div [leftPad (Just ())] [text "}"] )
in
div [ leftPad maybeKey ]
[ div [ onClick Toggle ] (lineStarter maybeKey (Just isClosed) start)
, middle
, end
]
viewRecordOpen : Dict String Expando -> Node Msg
viewRecordOpen record =
div [] (List.map viewRecordEntry (Dict.toList record))
viewRecordEntry : (String, Expando) -> Node Msg
viewRecordEntry (field, value) =
VDom.map (Field field) (view (Just field) value)
-- VIEW CONSTRUCTOR
viewConstructor : Maybe String -> Maybe String -> Bool -> List Expando -> Node Msg
viewConstructor maybeKey maybeName isClosed valueList =
let
tinyArgs =
List.map (Tuple.second << viewExtraTiny) valueList
description =
case (maybeName, tinyArgs) of
(Nothing, []) ->
[ text "()" ]
(Nothing, x :: xs) ->
text "( "
:: span [] x
:: List.foldr (\args rest -> text ", " :: span [] args :: rest) [text " )"] xs
(Just name, []) ->
[ text name ]
(Just name, x :: xs) ->
text (name ++ " ")
:: span [] x
:: List.foldr (\args rest -> text " " :: span [] args :: rest) [] xs
(maybeIsClosed, openHtml) =
case valueList of
[] ->
( Nothing, div [] [] )
[entry] ->
case entry of
S _ ->
( Nothing, div [] [] )
Primitive _ ->
( Nothing, div [] [] )
Sequence _ _ subValueList ->
( Just isClosed
, if isClosed then div [] [] else VDom.map (Index None 0) (viewSequenceOpen subValueList)
)
Dictionary _ keyValuePairs ->
( Just isClosed
, if isClosed then div [] [] else VDom.map (Index None 0) (viewDictionaryOpen keyValuePairs)
)
Record _ record ->
( Just isClosed
, if isClosed then div [] [] else VDom.map (Index None 0) (viewRecordOpen record)
)
Constructor _ _ subValueList ->
( Just isClosed
, if isClosed then div [] [] else VDom.map (Index None 0) (viewConstructorOpen subValueList)
)
_ ->
( Just isClosed
, if isClosed then div [] [] else viewConstructorOpen valueList
)
in
div [ leftPad maybeKey ]
[ div [ onClick Toggle ] (lineStarter maybeKey maybeIsClosed description)
, openHtml
]
viewConstructorOpen : List Expando -> Node Msg
viewConstructorOpen valueList =
div [] (List.indexedMap viewConstructorEntry valueList)
viewConstructorEntry : Int -> Expando -> Node Msg
viewConstructorEntry index value =
VDom.map (Index None index) (view (Just (toString index)) value)
-- VIEW TINY
viewTiny : Expando -> ( Int, List (Node msg) )
viewTiny value =
case value of
S stringRep ->
let
str =
elideMiddle stringRep
in
( String.length str
, [ span [red] [text str] ]
)
Primitive stringRep ->
( String.length stringRep
, [ span [blue] [text stringRep] ]
)
Sequence seqType _ valueList ->
viewTinyHelp <|
seqTypeToString (List.length valueList) seqType
Dictionary _ keyValuePairs ->
viewTinyHelp <|
"Dict(" ++ toString (List.length keyValuePairs) ++ ")"
Record _ record ->
viewTinyRecord record
Constructor maybeName _ [] ->
viewTinyHelp <|
Maybe.withDefault "Unit" maybeName
Constructor maybeName _ valueList ->
viewTinyHelp <|
case maybeName of
Nothing ->
"Tuple(" ++ toString (List.length valueList) ++ ")"
Just name ->
name ++ " …"
viewTinyHelp : String -> ( Int, List (Node msg) )
viewTinyHelp str =
( String.length str, [text str] )
elideMiddle : String -> String
elideMiddle str =
if String.length str <= 18 then
str
else
String.left 8 str ++ "..." ++ String.right 8 str
-- VIEW TINY RECORDS
viewTinyRecord : Dict String Expando -> ( Int, List (Node msg) )
viewTinyRecord record =
if Dict.isEmpty record then
( 2, [text "{}"] )
else
viewTinyRecordHelp 0 "{ " (Dict.toList record)
viewTinyRecordHelp : Int -> String -> List (String, Expando) -> ( Int, List (Node msg) )
viewTinyRecordHelp length starter entries =
case entries of
[] ->
( length + 2, [ text " }" ] )
(field, value) :: rest ->
let
fieldLen =
String.length field
(valueLen, valueNodes) =
viewExtraTiny value
newLength =
length + fieldLen + valueLen + 5
in
if newLength > 60 then
( length + 4, [text ", … }"] )
else
let
( finalLength, otherNodes ) =
viewTinyRecordHelp newLength ", " rest
in
( finalLength
, text starter
:: span [purple] [text field]
:: text " = "
:: span [] valueNodes
:: otherNodes
)
viewExtraTiny : Expando -> ( Int, List (Node msg) )
viewExtraTiny value =
case value of
Record _ record ->
viewExtraTinyRecord 0 "{" (Dict.keys record)
_ ->
viewTiny value
viewExtraTinyRecord : Int -> String -> List String -> ( Int, List (Node msg) )
viewExtraTinyRecord length starter entries =
case entries of
[] ->
( length + 1, [text "}"] )
field :: rest ->
let
nextLength =
length + String.length field + 1
in
if nextLength > 18 then
( length + 2, [text "…}"])
else
let
(finalLength, otherNodes) =
viewExtraTinyRecord nextLength "," rest
in
( finalLength
, text starter :: span [purple] [text field] :: otherNodes
)
-- VIEW HELPERS
lineStarter : Maybe String -> Maybe Bool -> List (Node msg) -> List (Node msg)
lineStarter maybeKey maybeIsClosed description =
let
arrow =
case maybeIsClosed of
Nothing ->
makeArrow ""
Just True ->
makeArrow "▸"
Just False ->
makeArrow "▾"
in
case maybeKey of
Nothing ->
arrow :: description
Just key ->
arrow :: span [purple] [text key] :: text " = " :: description
makeArrow : String -> Node msg
makeArrow arrow =
span
[ VDom.style
[ ("color", "#777")
, ("padding-left", "2ch")
, ("width", "2ch")
, ("display", "inline-block")
]
]
[ text arrow ]
leftPad : Maybe a -> VDom.Property msg
leftPad maybeKey =
case maybeKey of
Nothing ->
VDom.style []
Just _ ->
VDom.style [("padding-left", "4ch")]
red : VDom.Property msg
red =
VDom.style [("color", "rgb(196, 26, 22)")]
blue : VDom.Property msg
blue =
VDom.style [("color", "rgb(28, 0, 207)")]
purple : VDom.Property msg
purple =
VDom.style [("color", "rgb(136, 19, 145)")]

137
part4/elm-stuff/packages/elm-lang/virtual-dom/2.0.4/src/VirtualDom/Helpers.elm vendored Normal file
View File

@@ -0,0 +1,137 @@
module VirtualDom.Helpers exposing
( Node
, text, node, div, span, a, h1
, Property, property, attribute
, class, id, href
, style
, on, onWithOptions, Options, defaultOptions
, onClick
, map
, lazy, lazy2, lazy3
, keyedNode
)
import Json.Decode as Decode
import Json.Encode as Encode
import Native.VirtualDom
type Node msg = Node
node : String -> List (Property msg) -> List (Node msg) -> Node msg
node =
Native.VirtualDom.node
text : String -> Node msg
text =
Native.VirtualDom.text
div : List (Property msg) -> List (Node msg) -> Node msg
div =
node "div"
span : List (Property msg) -> List (Node msg) -> Node msg
span =
node "span"
a : List (Property msg) -> List (Node msg) -> Node msg
a =
node "a"
h1 : List (Property msg) -> List (Node msg) -> Node msg
h1 =
node "h1"
map : (a -> msg) -> Node a -> Node msg
map =
Native.VirtualDom.map
type Property msg = Property
property : String -> Decode.Value -> Property msg
property =
Native.VirtualDom.property
attribute : String -> String -> Property msg
attribute =
Native.VirtualDom.attribute
class : String -> Property msg
class name =
property "className" (Encode.string name)
href : String -> Property msg
href name =
property "href" (Encode.string name)
id : String -> Property msg
id =
attribute "id"
style : List (String, String) -> Property msg
style =
Native.VirtualDom.style
on : String -> Decode.Decoder msg -> Property msg
on eventName decoder =
onWithOptions eventName defaultOptions decoder
onClick : msg -> Property msg
onClick msg =
on "click" (Decode.succeed msg)
onWithOptions : String -> Options -> Decode.Decoder msg -> Property msg
onWithOptions =
Native.VirtualDom.on
type alias Options =
{ stopPropagation : Bool
, preventDefault : Bool
}
defaultOptions : Options
defaultOptions =
{ stopPropagation = False
, preventDefault = False
}
lazy : (a -> Node msg) -> a -> Node msg
lazy =
Native.VirtualDom.lazy
lazy2 : (a -> b -> Node msg) -> a -> b -> Node msg
lazy2 =
Native.VirtualDom.lazy2
lazy3 : (a -> b -> c -> Node msg) -> a -> b -> c -> Node msg
lazy3 =
Native.VirtualDom.lazy3
keyedNode : String -> List (Property msg) -> List ( String, Node msg ) -> Node msg
keyedNode =
Native.VirtualDom.keyedNode

290
part4/elm-stuff/packages/elm-lang/virtual-dom/2.0.4/src/VirtualDom/History.elm vendored Normal file
View File

@@ -0,0 +1,290 @@
module VirtualDom.History exposing
( History
, empty
, size
, initialModel
, add
, get
, view
, decoder
, encode
)
import Array exposing (Array)
import Json.Decode as Decode
import Json.Encode as Encode
import Native.Debug
import VirtualDom.Helpers as VDom exposing (Node)
import VirtualDom.Metadata as Metadata
-- CONSTANTS
maxSnapshotSize : Int
maxSnapshotSize =
64
-- HISTORY
type alias History model msg =
{ snapshots : Array (Snapshot model msg)
, recent : RecentHistory model msg
, numMessages : Int
}
type alias RecentHistory model msg =
{ model : model
, messages : List msg
, numMessages : Int
}
type alias Snapshot model msg =
{ model : model
, messages : Array msg
}
empty : model -> History model msg
empty model =
History Array.empty (RecentHistory model [] 0) 0
size : History model msg -> Int
size history =
history.numMessages
initialModel : History model msg -> model
initialModel { snapshots, recent } =
case Array.get 0 snapshots of
Just { model } ->
model
Nothing ->
recent.model
-- JSON
decoder : model -> (msg -> model -> model) -> Decode.Decoder (model, History model msg)
decoder initialModel update =
let
addMessage rawMsg (model, history) =
let
msg =
jsToElm rawMsg
in
(update msg model, add msg model history)
updateModel rawMsgs =
List.foldl addMessage (initialModel, empty initialModel) rawMsgs
in
Decode.map updateModel (Decode.list Decode.value)
jsToElm : Encode.Value -> a
jsToElm =
Native.Debug.unsafeCoerce
encode : History model msg -> Encode.Value
encode { snapshots, recent } =
let
recentJson =
List.map elmToJs (List.reverse recent.messages)
in
Encode.list <| Array.foldr encodeHelp recentJson snapshots
encodeHelp : Snapshot model msg -> List Encode.Value -> List Encode.Value
encodeHelp snapshot allMessages =
Array.foldl (\elm msgs -> elmToJs elm :: msgs) allMessages snapshot.messages
elmToJs : a -> Encode.Value
elmToJs =
Native.Debug.unsafeCoerce
-- ADD MESSAGES
add : msg -> model -> History model msg -> History model msg
add msg model { snapshots, recent, numMessages } =
case addRecent msg model recent of
(Just snapshot, newRecent) ->
History (Array.push snapshot snapshots) newRecent (numMessages + 1)
(Nothing, newRecent) ->
History snapshots newRecent (numMessages + 1)
addRecent
: msg
-> model
-> RecentHistory model msg
-> ( Maybe (Snapshot model msg), RecentHistory model msg )
addRecent msg newModel { model, messages, numMessages } =
if numMessages == maxSnapshotSize then
( Just (Snapshot model (Array.fromList messages))
, RecentHistory newModel [msg] 1
)
else
( Nothing
, RecentHistory model (msg :: messages) (numMessages + 1)
)
-- GET SUMMARY
get : (msg -> model -> (model, a)) -> Int -> History model msg -> ( model, msg )
get update index { snapshots, recent, numMessages } =
let
snapshotMax =
numMessages - recent.numMessages
in
if index >= snapshotMax then
undone <|
List.foldr (getHelp update) (Stepping (index - snapshotMax) recent.model) recent.messages
else
case Array.get (index // maxSnapshotSize) snapshots of
Nothing ->
Debug.crash "UI should only let you ask for real indexes!"
Just { model, messages } ->
undone <|
Array.foldr (getHelp update) (Stepping (rem index maxSnapshotSize) model) messages
type GetResult model msg
= Stepping Int model
| Done msg model
getHelp : (msg -> model -> (model, a)) -> msg -> GetResult model msg -> GetResult model msg
getHelp update msg getResult =
case getResult of
Done _ _ ->
getResult
Stepping n model ->
if n == 0 then
Done msg (Tuple.first (update msg model))
else
Stepping (n - 1) (Tuple.first (update msg model))
undone : GetResult model msg -> ( model, msg )
undone getResult =
case getResult of
Done msg model ->
( model, msg )
Stepping _ _ ->
Debug.crash "Bug in History.get"
-- VIEW
view : Maybe Int -> History model msg -> Node Int
view maybeIndex { snapshots, recent, numMessages } =
let
(index, className) =
case maybeIndex of
Nothing ->
( -1, "debugger-sidebar-messages" )
Just i ->
( i, "debugger-sidebar-messages-paused" )
oldStuff =
VDom.lazy2 viewSnapshots index snapshots
newStuff =
Tuple.second <| List.foldl (consMsg index) (numMessages - 1, []) recent.messages
in
VDom.div [ VDom.class className ] (oldStuff :: newStuff)
-- VIEW SNAPSHOTS
viewSnapshots : Int -> Array (Snapshot model msg) -> Node Int
viewSnapshots currentIndex snapshots =
let
highIndex =
maxSnapshotSize * Array.length snapshots
in
VDom.div [] <| Tuple.second <|
Array.foldr (consSnapshot currentIndex) (highIndex, []) snapshots
consSnapshot : Int -> Snapshot model msg -> ( Int, List (Node Int) ) -> ( Int, List (Node Int) )
consSnapshot currentIndex snapshot (index, rest) =
let
nextIndex =
index - maxSnapshotSize
currentIndexHelp =
if nextIndex <= currentIndex && currentIndex < index then currentIndex else -1
in
( index - maxSnapshotSize
, VDom.lazy3 viewSnapshot currentIndexHelp index snapshot :: rest
)
viewSnapshot : Int -> Int -> Snapshot model msg -> Node Int
viewSnapshot currentIndex index { messages } =
VDom.div [] <| Tuple.second <|
Array.foldl (consMsg currentIndex) (index - 1, []) messages
-- VIEW MESSAGE
consMsg : Int -> msg -> ( Int, List (Node Int) ) -> ( Int, List (Node Int) )
consMsg currentIndex msg (index, rest) =
( index - 1
, VDom.lazy3 viewMessage currentIndex index msg :: rest
)
viewMessage : Int -> Int -> msg -> Node Int
viewMessage currentIndex index msg =
let
className =
if currentIndex == index then
"messages-entry messages-entry-selected"
else
"messages-entry"
messageName =
Native.Debug.messageToString msg
in
VDom.div
[ VDom.class className
, VDom.on "click" (Decode.succeed index)
]
[ VDom.span [VDom.class "messages-entry-content", VDom.attribute "title" messageName ] [ VDom.text messageName ]
, VDom.span [VDom.class "messages-entry-index"] [ VDom.text (toString index) ]
]

326
part4/elm-stuff/packages/elm-lang/virtual-dom/2.0.4/src/VirtualDom/Metadata.elm vendored Normal file
View File

@@ -0,0 +1,326 @@
module VirtualDom.Metadata exposing
( Metadata
, check
, decode, decoder, encode
, Error, ProblemType, Problem(..)
)
import Array exposing (Array)
import Dict exposing (Dict)
import Json.Decode as Decode
import Json.Encode as Encode
import VirtualDom.Report as Report exposing (Report)
-- METADATA
type alias Metadata =
{ versions : Versions
, types : Types
}
-- VERSIONS
type alias Versions =
{ elm : String
}
-- TYPES
type alias Types =
{ message : String
, aliases : Dict String Alias
, unions : Dict String Union
}
type alias Alias =
{ args : List String
, tipe : String
}
type alias Union =
{ args : List String
, tags : Dict String (List String)
}
-- PORTABILITY
isPortable : Metadata -> Maybe Error
isPortable {types} =
let
badAliases =
Dict.foldl collectBadAliases [] types.aliases
in
case Dict.foldl collectBadUnions badAliases types.unions of
[] ->
Nothing
problems ->
Just (Error types.message problems)
type alias Error =
{ message : String
, problems : List ProblemType
}
type alias ProblemType =
{ name : String
, problems : List Problem
}
type Problem
= Function
| Decoder
| Task
| Process
| Socket
| Request
| Program
| VirtualDom
collectBadAliases : String -> Alias -> List ProblemType -> List ProblemType
collectBadAliases name {tipe} list =
case findProblems tipe of
[] ->
list
problems ->
ProblemType name problems :: list
collectBadUnions : String -> Union -> List ProblemType -> List ProblemType
collectBadUnions name {tags} list =
case List.concatMap findProblems (List.concat (Dict.values tags)) of
[] ->
list
problems ->
ProblemType name problems :: list
findProblems : String -> List Problem
findProblems tipe =
List.filterMap (hasProblem tipe) problemTable
hasProblem : String -> (Problem, String) -> Maybe Problem
hasProblem tipe (problem, token) =
if String.contains token tipe then Just problem else Nothing
problemTable : List (Problem, String)
problemTable =
[ ( Function, "->" )
, ( Decoder, "Json.Decode.Decoder" )
, ( Task, "Task.Task" )
, ( Process, "Process.Id" )
, ( Socket, "WebSocket.LowLevel.WebSocket" )
, ( Request, "Http.Request" )
, ( Program, "Platform.Program" )
, ( VirtualDom, "VirtualDom.Node" )
, ( VirtualDom, "VirtualDom.Attribute" )
]
-- CHECK
check : Metadata -> Metadata -> Report
check old new =
if old.versions.elm /= new.versions.elm then
Report.VersionChanged old.versions.elm new.versions.elm
else
checkTypes old.types new.types
checkTypes : Types -> Types -> Report
checkTypes old new =
if old.message /= new.message then
Report.MessageChanged old.message new.message
else
[]
|> Dict.merge ignore checkAlias ignore old.aliases new.aliases
|> Dict.merge ignore checkUnion ignore old.unions new.unions
|> Report.SomethingChanged
ignore : String -> value -> a -> a
ignore key value report =
report
-- CHECK ALIASES
checkAlias : String -> Alias -> Alias -> List Report.Change -> List Report.Change
checkAlias name old new changes =
if old.tipe == new.tipe && old.args == new.args then
changes
else
Report.AliasChange name :: changes
-- CHECK UNIONS
checkUnion : String -> Union -> Union -> List Report.Change -> List Report.Change
checkUnion name old new changes =
let
tagChanges =
Dict.merge removeTag checkTag addTag old.tags new.tags <|
Report.emptyTagChanges (old.args == new.args)
in
if Report.hasTagChanges tagChanges then
changes
else
Report.UnionChange name tagChanges :: changes
removeTag : String -> a -> Report.TagChanges -> Report.TagChanges
removeTag tag _ changes =
{ changes | removed = tag :: changes.removed }
addTag : String -> a -> Report.TagChanges -> Report.TagChanges
addTag tag _ changes =
{ changes | added = tag :: changes.added }
checkTag : String -> a -> a -> Report.TagChanges -> Report.TagChanges
checkTag tag old new changes =
if old == new then
changes
else
{ changes | changed = tag :: changes.changed }
-- JSON DECODE
decode : Encode.Value -> Result Error Metadata
decode value =
case Decode.decodeValue decoder value of
Err _ ->
Debug.crash "Compiler is generating bad metadata. Report this at <https://github.com/elm-lang/virtual-dom/issues>."
Ok metadata ->
case isPortable metadata of
Nothing ->
Ok metadata
Just error ->
Err error
decoder : Decode.Decoder Metadata
decoder =
Decode.map2 Metadata
(Decode.field "versions" decodeVersions)
(Decode.field "types" decodeTypes)
decodeVersions : Decode.Decoder Versions
decodeVersions =
Decode.map Versions
(Decode.field "elm" Decode.string)
decodeTypes : Decode.Decoder Types
decodeTypes =
Decode.map3 Types
(Decode.field "message" Decode.string)
(Decode.field "aliases" (Decode.dict decodeAlias))
(Decode.field "unions" (Decode.dict decodeUnion))
decodeUnion : Decode.Decoder Union
decodeUnion =
Decode.map2 Union
(Decode.field "args" (Decode.list Decode.string))
(Decode.field "tags" (Decode.dict (Decode.list Decode.string)))
decodeAlias : Decode.Decoder Alias
decodeAlias =
Decode.map2 Alias
(Decode.field "args" (Decode.list Decode.string))
(Decode.field "type" (Decode.string))
-- JSON ENCODE
encode : Metadata -> Encode.Value
encode { versions, types } =
Encode.object
[ ("versions", encodeVersions versions)
, ("types", encodeTypes types)
]
encodeVersions : Versions -> Encode.Value
encodeVersions { elm } =
Encode.object [("elm", Encode.string elm)]
encodeTypes : Types -> Encode.Value
encodeTypes { message, unions, aliases } =
Encode.object
[ ("message", Encode.string message)
, ("aliases", encodeDict encodeAlias aliases)
, ("unions", encodeDict encodeUnion unions)
]
encodeAlias : Alias -> Encode.Value
encodeAlias { args, tipe } =
Encode.object
[ ("args", Encode.list (List.map Encode.string args))
, ("type", Encode.string tipe)
]
encodeUnion : Union -> Encode.Value
encodeUnion { args, tags } =
Encode.object
[ ("args", Encode.list (List.map Encode.string args))
, ("tags", encodeDict (Encode.list << List.map Encode.string) tags)
]
encodeDict : (a -> Encode.Value) -> Dict String a -> Encode.Value
encodeDict f dict =
dict
|> Dict.map (\key value -> f value)
|> Dict.toList
|> Encode.object

541
part4/elm-stuff/packages/elm-lang/virtual-dom/2.0.4/src/VirtualDom/Overlay.elm vendored Normal file
View File

@@ -0,0 +1,541 @@
module VirtualDom.Overlay exposing
( State, none, corruptImport, badMetadata
, Msg, close, assessImport
, isBlocking
, Config
, Block
, view
, viewImportExport
)
import Json.Decode as Decode
import Json.Encode as Encode
import VirtualDom.Helpers exposing (..)
import VirtualDom.Metadata as Metadata exposing (Metadata)
import VirtualDom.Report as Report exposing (Report)
type State
= None
| BadMetadata Metadata.Error
| BadImport Report
| RiskyImport Report Encode.Value
none : State
none =
None
corruptImport : State
corruptImport =
BadImport Report.CorruptHistory
badMetadata : Metadata.Error -> State
badMetadata =
BadMetadata
isBlocking : State -> Bool
isBlocking state =
case state of
None ->
False
_ ->
True
-- UPDATE
type Msg = Cancel | Proceed
close : Msg -> State -> Maybe Encode.Value
close msg state =
case state of
None ->
Nothing
BadMetadata _ ->
Nothing
BadImport _ ->
Nothing
RiskyImport _ rawHistory ->
case msg of
Cancel ->
Nothing
Proceed ->
Just rawHistory
assessImport : Metadata -> String -> Result State Encode.Value
assessImport metadata jsonString =
case Decode.decodeString uploadDecoder jsonString of
Err _ ->
Err corruptImport
Ok (foreignMetadata, rawHistory) ->
let
report =
Metadata.check foreignMetadata metadata
in
case Report.evaluate report of
Report.Impossible ->
Err (BadImport report)
Report.Risky ->
Err (RiskyImport report rawHistory)
Report.Fine ->
Ok rawHistory
uploadDecoder : Decode.Decoder (Metadata, Encode.Value)
uploadDecoder =
Decode.map2 (,)
(Decode.field "metadata" Metadata.decoder)
(Decode.field "history" Decode.value)
-- VIEW
type alias Config msg =
{ resume : msg
, open : msg
, importHistory : msg
, exportHistory : msg
, wrap : Msg -> msg
}
type Block = Normal | Pause | Message
view : Config msg -> Bool -> Bool -> Int -> State -> ( Block, Node msg )
view config isPaused isOpen numMsgs state =
let
(block, nodes) =
viewHelp config isPaused isOpen numMsgs state
in
( block
, div [ class "elm-overlay" ] (styles :: nodes)
)
viewHelp : Config msg -> Bool -> Bool -> Int -> State -> ( Block, List (Node msg) )
viewHelp config isPaused isOpen numMsgs state =
case state of
None ->
let
miniControls =
if isOpen then [] else [ viewMiniControls config numMsgs ]
in
( if isPaused then Pause else Normal
, if isPaused && not isOpen then
viewResume config :: miniControls
else
miniControls
)
BadMetadata badMetadata ->
viewMessage config
"Cannot use Import or Export"
(viewBadMetadata badMetadata)
(Accept "Ok")
BadImport report ->
viewMessage config
"Cannot Import History"
(viewReport True report)
(Accept "Ok")
RiskyImport report _ ->
viewMessage config
"Warning"
(viewReport False report)
(Choose "Cancel" "Import Anyway")
viewResume config =
div [ class "elm-overlay-resume", onClick config.resume ]
[ div [class "elm-overlay-resume-words"] [text "Click to Resume"] ]
-- VIEW MESSAGE
viewMessage : Config msg -> String -> List (Node msg) -> Buttons -> ( Block, List (Node msg) )
viewMessage config title details buttons =
( Message
, [ div [ class "elm-overlay-message" ]
[ div [ class "elm-overlay-message-title" ] [ text title ]
, div [ class "elm-overlay-message-details" ] details
, map config.wrap (viewButtons buttons)
]
]
)
viewReport : Bool -> Report -> List (Node msg)
viewReport isBad report =
case report of
Report.CorruptHistory ->
[ text "Looks like this history file is corrupt. I cannot understand it."
]
Report.VersionChanged old new ->
[ text <|
"This history was created with Elm "
++ old ++ ", but you are using Elm "
++ new ++ " right now."
]
Report.MessageChanged old new ->
[ text <|
"To import some other history, the overall message type must"
++ " be the same. The old history has "
, viewCode old
, text " messages, but the new program works with "
, viewCode new
, text " messages."
]
Report.SomethingChanged changes ->
[ node "p" [] [ text (if isBad then explanationBad else explanationRisky) ]
, node "ul" [] (List.map viewChange changes)
]
explanationBad : String
explanationBad = """
The messages in this history do not match the messages handled by your
program. I noticed changes in the following types:
"""
explanationRisky : String
explanationRisky = """
This history seems old. It will work with this program, but some
messages have been added since the history was created:
"""
viewCode : String -> Node msg
viewCode name =
node "code" [] [ text name ]
viewChange : Report.Change -> Node msg
viewChange change =
node "li" [] <|
case change of
Report.AliasChange name ->
[ span [ class "elm-overlay-message-details-type" ] [ viewCode name ]
]
Report.UnionChange name { removed, changed, added, argsMatch } ->
[ span [ class "elm-overlay-message-details-type" ] [ viewCode name ]
, node "ul" []
[ viewMention removed "Removed "
, viewMention changed "Changed "
, viewMention added "Added "
]
, if argsMatch then
text ""
else
text "This may be due to the fact that the type variable names changed."
]
viewMention : List String -> String -> Node msg
viewMention tags verbed =
case List.map viewCode (List.reverse tags) of
[] ->
text ""
[tag] ->
node "li" []
[ text verbed, tag, text "." ]
[tag2, tag1] ->
node "li" []
[ text verbed, tag1, text " and ", tag2, text "." ]
lastTag :: otherTags ->
node "li" [] <|
text verbed
:: List.intersperse (text ", ") (List.reverse otherTags)
++ [ text ", and ", lastTag, text "." ]
viewBadMetadata : Metadata.Error -> List (Node msg)
viewBadMetadata {message, problems} =
[ node "p" []
[ text "The "
, viewCode message
, text " type of your program cannot be reliably serialized for history files."
]
, node "p" [] [ text "Functions cannot be serialized, nor can values that contain functions. This is a problem in these places:" ]
, node "ul" [] (List.map viewProblemType problems)
, node "p" []
[ text goodNews1
, a [ href "https://guide.elm-lang.org/types/union_types.html" ] [ text "union types" ]
, text ", in your messages. From there, your "
, viewCode "update"
, text goodNews2
]
]
goodNews1 = """
The good news is that having values like this in your message type is not
so great in the long run. You are better off using simpler data, like
"""
goodNews2 = """
function can pattern match on that data and call whatever functions, JSON
decoders, etc. you need. This makes the code much more explicit and easy to
follow for other readers (or you in a few months!)
"""
viewProblemType : Metadata.ProblemType -> Node msg
viewProblemType { name, problems } =
node "li" []
[ viewCode name
, text (" can contain " ++ addCommas (List.map problemToString problems) ++ ".")
]
problemToString : Metadata.Problem -> String
problemToString problem =
case problem of
Metadata.Function ->
"functions"
Metadata.Decoder ->
"JSON decoders"
Metadata.Task ->
"tasks"
Metadata.Process ->
"processes"
Metadata.Socket ->
"web sockets"
Metadata.Request ->
"HTTP requests"
Metadata.Program ->
"programs"
Metadata.VirtualDom ->
"virtual DOM values"
addCommas : List String -> String
addCommas items =
case items of
[] ->
""
[item] ->
item
[item1, item2] ->
item1 ++ " and " ++ item2
lastItem :: otherItems ->
String.join ", " (otherItems ++ [ " and " ++ lastItem ])
-- VIEW MESSAGE BUTTONS
type Buttons
= Accept String
| Choose String String
viewButtons : Buttons -> Node Msg
viewButtons buttons =
div [ class "elm-overlay-message-buttons" ] <|
case buttons of
Accept proceed ->
[ node "button" [ onClick Proceed ] [ text proceed ]
]
Choose cancel proceed ->
[ node "button" [ onClick Cancel ] [ text cancel ]
, node "button" [ onClick Proceed ] [ text proceed ]
]
-- VIEW MINI CONTROLS
viewMiniControls : Config msg -> Int -> Node msg
viewMiniControls config numMsgs =
div
[ class "elm-mini-controls"
]
[ div
[ onClick config.open
, class "elm-mini-controls-button"
]
[ text ("Explore History (" ++ toString numMsgs ++ ")")
]
, viewImportExport
[class "elm-mini-controls-import-export"]
config.importHistory
config.exportHistory
]
viewImportExport : List (Property msg) -> msg -> msg -> Node msg
viewImportExport props importMsg exportMsg =
div
props
[ button importMsg "Import"
, text " / "
, button exportMsg "Export"
]
button : msg -> String -> Node msg
button msg label =
span [ onClick msg, style [("cursor","pointer")] ] [ text label ]
-- STYLE
styles : Node msg
styles =
node "style" [] [ text """
.elm-overlay {
position: fixed;
top: 0;
left: 0;
width: 100%;
height: 100%;
color: white;
pointer-events: none;
font-family: 'Trebuchet MS', 'Lucida Grande', 'Bitstream Vera Sans', 'Helvetica Neue', sans-serif;
}
.elm-overlay-resume {
width: 100%;
height: 100%;
cursor: pointer;
text-align: center;
pointer-events: auto;
background-color: rgba(200, 200, 200, 0.7);
}
.elm-overlay-resume-words {
position: absolute;
top: calc(50% - 40px);
font-size: 80px;
line-height: 80px;
height: 80px;
width: 100%;
}
.elm-mini-controls {
position: fixed;
bottom: 0;
right: 6px;
border-radius: 4px;
background-color: rgb(61, 61, 61);
font-family: monospace;
pointer-events: auto;
}
.elm-mini-controls-button {
padding: 6px;
cursor: pointer;
text-align: center;
min-width: 24ch;
}
.elm-mini-controls-import-export {
padding: 4px 0;
font-size: 0.8em;
text-align: center;
background-color: rgb(50, 50, 50);
}
.elm-overlay-message {
position: absolute;
width: 600px;
height: 100%;
padding-left: calc(50% - 300px);
padding-right: calc(50% - 300px);
background-color: rgba(200, 200, 200, 0.7);
pointer-events: auto;
}
.elm-overlay-message-title {
font-size: 36px;
height: 80px;
background-color: rgb(50, 50, 50);
padding-left: 22px;
vertical-align: middle;
line-height: 80px;
}
.elm-overlay-message-details {
padding: 8px 20px;
overflow-y: auto;
max-height: calc(100% - 156px);
background-color: rgb(61, 61, 61);
}
.elm-overlay-message-details-type {
font-size: 1.5em;
}
.elm-overlay-message-details ul {
list-style-type: none;
padding-left: 20px;
}
.elm-overlay-message-details ul ul {
list-style-type: disc;
padding-left: 2em;
}
.elm-overlay-message-details li {
margin: 8px 0;
}
.elm-overlay-message-buttons {
height: 60px;
line-height: 60px;
text-align: right;
background-color: rgb(50, 50, 50);
}
.elm-overlay-message-buttons button {
margin-right: 20px;
}
""" ]

99
part4/elm-stuff/packages/elm-lang/virtual-dom/2.0.4/src/VirtualDom/Report.elm vendored Normal file
View File

@@ -0,0 +1,99 @@
module VirtualDom.Report exposing
( Report(..)
, Change(..)
, TagChanges
, emptyTagChanges
, hasTagChanges
, Status(..), evaluate
)
-- REPORTS
type Report
= CorruptHistory
| VersionChanged String String
| MessageChanged String String
| SomethingChanged (List Change)
type Change
= AliasChange String
| UnionChange String TagChanges
type alias TagChanges =
{ removed : List String
, changed : List String
, added : List String
, argsMatch : Bool
}
emptyTagChanges : Bool -> TagChanges
emptyTagChanges argsMatch =
TagChanges [] [] [] argsMatch
hasTagChanges : TagChanges -> Bool
hasTagChanges tagChanges =
tagChanges == TagChanges [] [] [] True
type Status = Impossible | Risky | Fine
evaluate : Report -> Status
evaluate report =
case report of
CorruptHistory ->
Impossible
VersionChanged _ _ ->
Impossible
MessageChanged _ _ ->
Impossible
SomethingChanged changes ->
worstCase Fine (List.map evaluateChange changes)
worstCase : Status -> List Status -> Status
worstCase status statusList =
case statusList of
[] ->
status
Impossible :: _ ->
Impossible
Risky :: rest ->
worstCase Risky rest
Fine :: rest ->
worstCase status rest
evaluateChange : Change -> Status
evaluateChange change =
case change of
AliasChange _ ->
Impossible
UnionChange _ { removed, changed, added, argsMatch } ->
if not argsMatch || some changed || some removed then
Impossible
else if some added then
Risky
else
Fine
some : List a -> Bool
some list =
not (List.isEmpty list)

35
part4/elm-stuff/packages/elm-lang/virtual-dom/2.0.4/tests/Native/TestHelpers.js vendored Normal file
View File

@@ -0,0 +1,35 @@
Elm.Native.TestHelpers = {};
Elm.Native.TestHelpers.make = function(localRuntime)
{
localRuntime.Native = localRuntime.Native || {};
localRuntime.Native.TestHelpers = localRuntime.Native.TestHelpers || {};
if (localRuntime.Native.TestHelpers.values)
{
return localRuntime.Native.TestHelpers.values;
}
var VirtualDom = Elm.Native.VirtualDom.make(localRuntime);
function unsafeRecordCallCount(f) {
function wrapper(a) {
wrapper.__elm_test_call_count += 1;
return f(a);
}
wrapper.__elm_test_call_count = 0;
return wrapper;
}
function unsafeQueryCallCount(f) {
if (f.__elm_test_call_count === undefined) {
return -1;
}
return f.__elm_test_call_count;
}
Elm.Native.TestHelpers.values = {
unsafeRecordCallCount: unsafeRecordCallCount,
unsafeQueryCallCount: unsafeQueryCallCount,
updateAndReplace: F3(VirtualDom.updateAndReplace)
};
return localRuntime.Native.TestHelpers.values = Elm.Native.TestHelpers.values;
};

72
part4/elm-stuff/packages/elm-lang/virtual-dom/2.0.4/tests/TestCases/Lazy.elm vendored Normal file
View File

@@ -0,0 +1,72 @@
module TestCases.Lazy where
import VirtualDom exposing (Node, lazy)
import ElmTest.Assertion exposing (assertEqual)
import ElmTest.Test exposing (Test, suite, test)
import TestHelpers exposing (renderDom, updateDom, unsafeRecordCallCount, unsafeQueryCallCount)
renderRecord : { x: String, y: String } -> Node
renderRecord r =
VirtualDom.text <| "The values: " ++ r.x ++ ", " ++ r.y
renderPrimitive : Int -> Node
renderPrimitive x =
VirtualDom.text <| "The value: " ++ (toString x)
testLazyIdenticalRecord =
test "isn't called again with identical record" <|
let record = { x = "a", y = "b" }
wrappedRender = unsafeRecordCallCount renderRecord
v1 = renderDom <| lazy wrappedRender record
v2 = updateDom v1 <| lazy wrappedRender record
v3 = updateDom v2 <| lazy wrappedRender record
in
assertEqual 1 <| unsafeQueryCallCount wrappedRender
testLazyIdenticalPrimitive =
test "isn't called again with identical primitive" <|
let wrappedRender = unsafeRecordCallCount renderPrimitive
v1 = renderDom <| lazy wrappedRender 5
v2 = updateDom v1 <| lazy wrappedRender 5
v3 = updateDom v2 <| lazy wrappedRender 5
in
assertEqual 1 <| unsafeQueryCallCount wrappedRender
testLazyRecordMutationOfIdenticalValue =
test "isn't called again with record mutation of identical value" <|
let record = { x = "a", y = "b" }
wrappedRender = unsafeRecordCallCount renderRecord
v1 = renderDom <| lazy wrappedRender record
v2 = updateDom v1 <| lazy wrappedRender { record | x = "a" }
v3 = updateDom v2 <| lazy wrappedRender { record | x = "a", y = "b" }
in
assertEqual 1 <| unsafeQueryCallCount wrappedRender
testNotLazyDifferentRecord =
test "is called again with an equivalent but different record" <|
let wrappedRender = unsafeRecordCallCount renderRecord
v1 = renderDom <| lazy wrappedRender { x = "a", y = "b" }
v2 = updateDom v1 <| lazy wrappedRender { x = "a", y = "b" }
v3 = updateDom v2 <| lazy wrappedRender { x = "a", y = "b" }
in
assertEqual 3 <| unsafeQueryCallCount wrappedRender
tests : Test
tests =
suite
"Lazy"
[
testLazyIdenticalRecord,
testLazyIdenticalPrimitive,
-- Re-enable this test when core supports checking
-- record update values for identity before copying:
-- testLazyRecordMutationOfIdenticalValue,
testNotLazyDifferentRecord
]

34
part4/elm-stuff/packages/elm-lang/virtual-dom/2.0.4/tests/TestHelpers.elm vendored Normal file
View File

@@ -0,0 +1,34 @@
module TestHelpers where
import VirtualDom exposing (Node)
import Native.TestHelpers
import Native.VirtualDom
unsafeRecordCallCount : (a -> b) -> (a -> b)
unsafeRecordCallCount =
Native.TestHelpers.unsafeRecordCallCount
unsafeQueryCallCount : (a -> b) -> Int
unsafeQueryCallCount =
Native.TestHelpers.unsafeQueryCallCount
type OpaqueDom = OpaqueDom
render : Node -> OpaqueDom
render =
Native.VirtualDom.render
updateAndReplace : OpaqueDom -> Node -> Node -> OpaqueDom
updateAndReplace =
Native.TestHelpers.updateAndReplace
renderDom : Node -> (OpaqueDom, Node)
renderDom vdom =
(render vdom, vdom)
updateDom : (OpaqueDom, Node) -> Node -> (OpaqueDom, Node)
updateDom (oldDom, oldVDom) newVDom =
(updateAndReplace oldDom oldVDom newVDom, newVDom)

18
part4/elm-stuff/packages/elm-lang/virtual-dom/2.0.4/tests/TestMain.elm vendored Normal file
View File

@@ -0,0 +1,18 @@
import ElmTest.Runner.Console exposing (runDisplay)
import ElmTest.Test exposing (Test, suite)
import Console exposing (IO)
import Task exposing (Task)
import TestCases.Lazy
tests : Test
tests =
suite
"VirtualDom Library Tests"
[
TestCases.Lazy.tests
]
port runner : Signal (Task x ())
port runner = Console.run (runDisplay tests)

18
part4/elm-stuff/packages/elm-lang/virtual-dom/2.0.4/tests/elm-package.json vendored Normal file
View File

@@ -0,0 +1,18 @@
{
"version": "1.0.0",
"summary": "Test for VirtualDom",
"license": "BSD3",
"repository": "https://github.com/evancz/virtual-dom.git",
"exposed-modules": [],
"source-directories": [
".",
"build/virtual-dom/"
],
"native-modules": true,
"dependencies": {
"elm-lang/core": "2.0.0 <= v < 4.0.0",
"laszlopandy/elm-console": "1.0.0 <= v < 2.0.0",
"deadfoxygrandpa/elm-test": "1.0.3 <= v < 2.0.0"
},
"elm-version": "0.16.0 <= v < 0.17.0"
}