nri-prelude (empty) → 0.1.0.0
raw patch · 45 files changed
+7420/−0 lines, 45 filesdep +aesondep +ansi-terminaldep +async
Dependencies added: aeson, ansi-terminal, async, auto-update, base, bytestring, concurrent-output, containers, directory, exceptions, filepath, hedgehog, junit-xml, pretty-diff, pretty-show, resourcet, safe-exceptions, tasty, tasty-test-reporter, terminal-size, text, time, vector
Files
- CHANGELOG.md +3/−0
- LICENSE +29/−0
- README.md +8/−0
- licenses/ELM_CORE_LICENSE +11/−0
- licenses/ELM_TEST_LICENSE +27/−0
- nri-prelude.cabal +169/−0
- src/Array.hs +239/−0
- src/Basics.hs +780/−0
- src/Bitwise.hs +75/−0
- src/Char.hs +160/−0
- src/Debug.hs +66/−0
- src/Dict.hs +259/−0
- src/Expect.hs +456/−0
- src/Expect/Task.hs +72/−0
- src/Fuzz.hs +49/−0
- src/Internal/Expectation.hs +48/−0
- src/Internal/Shortcut.hs +85/−0
- src/Internal/Terminal.hs +101/−0
- src/Internal/Test.hs +227/−0
- src/Internal/TestResult.hs +108/−0
- src/List.hs +425/−0
- src/Log.hs +256/−0
- src/Maybe.hs +122/−0
- src/NriPrelude.hs +56/−0
- src/Platform.hs +172/−0
- src/Platform/DoAnything.hs +43/−0
- src/Platform/Internal.hs +601/−0
- src/Process.hs +61/−0
- src/Result.hs +190/−0
- src/Set.hs +154/−0
- src/Task.hs +246/−0
- src/Test.hs +231/−0
- src/Test/Console/Color.hs +44/−0
- src/Test/Runner/Tasty.hs +115/−0
- src/Text.hs +486/−0
- src/Tuple.hs +94/−0
- tests/ArraySpec.hs +277/−0
- tests/BitwiseSpec.hs +108/−0
- tests/DebugSpec.hs +51/−0
- tests/DictSpec.hs +136/−0
- tests/LogSpec.hs +192/−0
- tests/Main.hs +33/−0
- tests/PlatformSpec.hs +23/−0
- tests/SetSpec.hs +187/−0
- tests/TextSpec.hs +145/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+# 0.1.0.0++- Initial release.
+ LICENSE view
@@ -0,0 +1,29 @@+BSD 3-Clause License++Copyright (c) 2017, NoRedInk+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 the copyright holder nor the names of its+ 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 HOLDER 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.
+ README.md view
@@ -0,0 +1,8 @@+# NriPrelude++A Prelude inspired by the Elm programming language.++This package re-implements API's and re-uses documentation from [elm-core][] ([license](./licenses/ELM_CORE_LICENSE)) and [elm-test][] ([license](./licenses/ELM_TEST_LICENSE)).++[elm-core]: https://github.com/elm/core+[elm-test]: https://github.com/elm-community/elm-test
+ licenses/ELM_CORE_LICENSE view
@@ -0,0 +1,11 @@+Copyright 2014-present Evan Czaplicki++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.++2. 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.++3. Neither the name of the copyright holder nor the names of its 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 HOLDER 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.
+ licenses/ELM_TEST_LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2016-2017 the Elm-test contributors+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 elm-test nor the names of its+ 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 HOLDER 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.
+ nri-prelude.cabal view
@@ -0,0 +1,169 @@+cabal-version: 1.18++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: dcd025f2d9ab7c46a4048057b540fb9a87772aa05d01a3c0909c4cc48cfcc614++name: nri-prelude+version: 0.1.0.0+synopsis: A Prelude inspired by the Elm programming language+description: Please see the README at <https://github.com/NoRedInk/haskell-libraries/tree/trunk/nri-prelude>.+homepage: https://github.com/NoRedInk/haskell-libraries#readme+bug-reports: https://github.com/NoRedInk/haskell-libraries/issues+author: NoRedInk+maintainer: haskell-open-source@noredink.com+copyright: 2020 NoRedInk Corp.+license: BSD3+license-file: LICENSE+build-type: Simple+extra-doc-files:+ README.md+ LICENSE+ CHANGELOG.md+ licenses/ELM_CORE_LICENSE+ licenses/ELM_TEST_LICENSE++source-repository head+ type: git+ location: https://github.com/NoRedInk/haskell-libraries+ subdir: nri-prelude++library+ exposed-modules:+ Array+ Basics+ Bitwise+ Char+ Debug+ Dict+ Expect+ Expect.Task+ Fuzz+ List+ Log+ Maybe+ NriPrelude+ Platform+ Process+ Result+ Set+ Task+ Test+ Test.Runner.Tasty+ Text+ Tuple+ other-modules:+ Internal.Expectation+ Internal.Shortcut+ Internal.Terminal+ Internal.Test+ Internal.TestResult+ Platform.DoAnything+ Platform.Internal+ Test.Console.Color+ Paths_nri_prelude+ hs-source-dirs:+ src+ default-extensions: DataKinds DeriveGeneric FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving MultiParamTypeClasses NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures ScopedTypeVariables Strict TypeOperators+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wpartial-fields -Wredundant-constraints -Wincomplete-uni-patterns+ build-depends:+ aeson >=1.4.6.0 && <1.6+ , ansi-terminal >=0.9.1 && <0.12+ , async >=2.2.2 && <2.3+ , auto-update >=0.1.6 && <0.2+ , base >=4.12.0.0 && <4.13+ , bytestring >=0.10.8.2 && <0.11+ , concurrent-output >=1.10.11 && <1.11+ , containers >=0.6.0.1 && <0.7+ , directory >=1.3.3.0 && <1.4+ , exceptions >=0.10.4 && <0.11+ , filepath >=1.4.2.1 && <1.5+ , hedgehog >=1.0.2 && <1.1+ , junit-xml >=0.1.0.0 && <0.2+ , pretty-diff >=0.1.0.0 && <0.2+ , pretty-show >=1.9.5 && <1.11+ , resourcet >=1.2.2 && <1.3+ , safe-exceptions >=0.1.7.0 && <1.3+ , tasty >=1.2.3 && <1.4+ , tasty-test-reporter >=0.1.1.1 && <0.2+ , terminal-size >=0.3.2.1 && <0.4+ , text >=1.2.3.1 && <1.3+ , time >=1.8.0.2 && <1.11+ , vector >=0.12.1.2 && <0.13+ default-language: Haskell2010++test-suite tests+ type: exitcode-stdio-1.0+ main-is: Main.hs+ other-modules:+ ArraySpec+ BitwiseSpec+ DebugSpec+ DictSpec+ LogSpec+ PlatformSpec+ SetSpec+ TextSpec+ Array+ Basics+ Bitwise+ Char+ Debug+ Dict+ Expect+ Expect.Task+ Fuzz+ Internal.Expectation+ Internal.Shortcut+ Internal.Terminal+ Internal.Test+ Internal.TestResult+ List+ Log+ Maybe+ NriPrelude+ Platform+ Platform.DoAnything+ Platform.Internal+ Process+ Result+ Set+ Task+ Test+ Test.Console.Color+ Test.Runner.Tasty+ Text+ Tuple+ Paths_nri_prelude+ hs-source-dirs:+ tests+ src+ default-extensions: DataKinds DeriveGeneric FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving MultiParamTypeClasses NamedFieldPuns NoImplicitPrelude OverloadedStrings PartialTypeSignatures ScopedTypeVariables Strict TypeOperators+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wpartial-fields -Wredundant-constraints -Wincomplete-uni-patterns -threaded -rtsopts "-with-rtsopts=-N -T"+ build-depends:+ aeson >=1.4.6.0 && <1.6+ , ansi-terminal >=0.9.1 && <0.12+ , async >=2.2.2 && <2.3+ , auto-update >=0.1.6 && <0.2+ , base >=4.12.0.0 && <4.13+ , bytestring >=0.10.8.2 && <0.11+ , concurrent-output >=1.10.11 && <1.11+ , containers >=0.6.0.1 && <0.7+ , directory >=1.3.3.0 && <1.4+ , exceptions >=0.10.4 && <0.11+ , filepath >=1.4.2.1 && <1.5+ , hedgehog >=1.0.2 && <1.1+ , junit-xml >=0.1.0.0 && <0.2+ , pretty-diff >=0.1.0.0 && <0.2+ , pretty-show >=1.9.5 && <1.11+ , resourcet >=1.2.2 && <1.3+ , safe-exceptions >=0.1.7.0 && <1.3+ , tasty >=1.2.3 && <1.4+ , tasty-test-reporter >=0.1.1.1 && <0.2+ , terminal-size >=0.3.2.1 && <0.4+ , text >=1.2.3.1 && <1.3+ , time >=1.8.0.2 && <1.11+ , vector >=0.12.1.2 && <0.13+ default-language: Haskell2010
+ src/Array.hs view
@@ -0,0 +1,239 @@+-- | Fast immutable arrays. The elements in an array must have the same type.+module Array+ ( -- * Arrays+ Array,++ -- * Creation+ empty,+ initialize,+ repeat,+ fromList,++ -- * Query+ isEmpty,+ length,+ get,++ -- * Manipulate+ set,+ push,+ append,+ slice,++ -- * Lists+ toList,+ toIndexedList,++ -- * Transform+ map,+ indexedMap,+ foldr,+ foldl,+ filter,+ )+where++import Basics+ ( (&&),+ (+),+ (-),+ (<),+ (<=),+ (<|),+ (>>),+ Bool,+ Int,+ clamp,+ )+import qualified Data.Foldable+import qualified Data.Vector+import Data.Vector ((!?), (++), (//))+import List (List)+import qualified List+import Maybe (Maybe (..))+import qualified Tuple+import Prelude (otherwise)+import qualified Prelude++-- | 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.+newtype Array a = Array (Data.Vector.Vector a)+ deriving (Prelude.Eq, Prelude.Show)++-- | Helper function to unwrap an array+unwrap :: Array a -> Data.Vector.Vector a+unwrap (Array v) = v++-- | Return an empty array.+--+-- > length empty == 0+empty :: Array a+empty =+ Array Data.Vector.empty++-- | Determine if an array is empty.+--+-- > isEmpty empty == True+isEmpty :: Array a -> Bool+isEmpty = unwrap >> Data.Vector.null++-- | Return the length of an array.+--+-- > length (fromList [1,2,3]) == 3+length :: Array a -> Int+length =+ unwrap+ >> Data.Vector.length+ >> Prelude.fromIntegral++-- | 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 n f =+ Array+ <| Data.Vector.generate+ (Prelude.fromIntegral n)+ (Prelude.fromIntegral >> f)++-- | 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 =+ Array+ <| Data.Vector.replicate (Prelude.fromIntegral n) e++-- | Create an array from a 'List'.+fromList :: List a -> Array a+fromList =+ Data.Vector.fromList >> Array++-- | Return @Just@ the element at the index or @Nothing@ if the index is out of range.+--+-- > get 0 (fromList [0,1,2]) == Just 0+-- > get 2 (fromList [0,1,2]) == Just 2+-- > get 5 (fromList [0,1,2]) == Nothing+-- > get (-1) (fromList [0,1,2]) == Nothing+get :: Int -> Array a -> Maybe a+get i array =+ unwrap array !? Prelude.fromIntegral i++-- | 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 i value array = Array result+ where+ len = length array+ vector = unwrap array+ result+ | 0 <= i && i < len = vector // [(Prelude.fromIntegral i, value)]+ | otherwise = vector++-- | Push an element onto the end of an array.+--+-- > push 3 (fromList [1,2]) == fromList [1,2,3]+push :: a -> Array a -> Array a+push a (Array vector) =+ Array (Data.Vector.snoc vector a)++-- | Create a list of elements from an array.+--+-- > toList (fromList [3,5,8]) == [3,5,8]+toList :: Array a -> List a+toList = unwrap >> Data.Vector.toList++-- | 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 =+ unwrap+ >> Data.Vector.indexed+ >> Data.Vector.toList+ >> List.map (Tuple.mapFirst Prelude.fromIntegral)++-- | Reduce an array from the right. Read @foldr@ as fold from the right.+--+-- > foldr (+) 0 (repeat 3 5) == 15+foldr :: (a -> b -> b) -> b -> Array a -> b+foldr f value array = Prelude.foldr f value (unwrap array)++-- | Reduce an array from the left. Read @foldl@ as fold from the left.+--+-- > foldl (:) [] (fromList [1,2,3]) == [3,2,1]+foldl :: (a -> b -> b) -> b -> Array a -> b+foldl f value array =+ Data.Foldable.foldl' (\a b -> f b a) value (unwrap array)++-- | Keep elements that pass the test.+--+-- > filter isEven (fromList [1,2,3,4,5,6]) == (fromList [2,4,6])+filter :: (a -> Bool) -> Array a -> Array a+filter f (Array vector) =+ Array (Data.Vector.filter f vector)++-- | 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 f (Array vector) =+ Array (Data.Vector.map f vector)++-- | 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 f (Array vector) =+ Array (Data.Vector.imap (Prelude.fromIntegral >> f) vector)++-- | 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 (Array first) (Array second) =+ Array (first ++ second)++-- | 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 from to (Array vector)+ | sliceLen <= 0 = empty+ | otherwise = Array <| Data.Vector.slice from' sliceLen vector+ where+ len = Data.Vector.length vector+ handleNegative value+ | value < 0 = len + value+ | otherwise = value+ normalize =+ Prelude.fromIntegral+ >> handleNegative+ >> clamp 0 len+ from' = normalize from+ to' = normalize to+ sliceLen = to' - from'
+ src/Basics.hs view
@@ -0,0 +1,780 @@+-- The 'ignore-exports' option allows us to define our own documentation for ==+-- and \= while secretly exporting the original Haskell definitions, which are+-- the only ones that can be used in defining custom Eq typeclasses.++-- | Tons of useful functions that get imported by default.+module Basics+ ( -- * Math+ Int,+ Float,+ (+),+ (-),+ (*),+ (/),+ (//),+ (^),+ toFloat,+ round,+ floor,+ ceiling,+ truncate,++ -- * Equality+ (==),+ (/=),++ -- * Comparison++ -- | These functions only work on @Order@-able types. This includes numbers,+ -- characters, strings, lists of comparable things, and tuples of comparable+ -- things.+ (<),+ (>),+ (<=),+ (>=),+ max,+ min,+ compare,+ Order,+ Prelude.Ordering (Prelude.LT, Prelude.GT, Prelude.EQ),++ -- * Booleans+ Prelude.Bool (..),+ not,+ (&&),+ (||),+ xor,++ -- * Append Strings and Lists+ (++),++ -- * Fancier Math+ modBy,+ remainderBy,+ negate,+ abs,+ clamp,+ sqrt,+ logBase,+ e,++ -- * Angles+ degrees,+ radians,+ turns,++ -- * Trigonometry+ pi,+ cos,+ sin,+ tan,+ acos,+ asin,+ atan,+ atan2,++ -- * Polar Coordinates+ toPolar,+ fromPolar,++ -- * Floating Point Checks+ isNaN,+ isInfinite,++ -- * Function Helpers+ identity,+ always,+ (<|),+ (|>),+ (<<),+ (>>),+ Never,+ never,++ -- * Often-implemented typeclasses+ Prelude.Eq,+ Prelude.Ord,+ Prelude.Num,+ )+where++import qualified Data.Bits (xor)+import qualified Data.Int (Int64)+import qualified Data.Void (Void, absurd)+import Prelude (otherwise)+import qualified Prelude++-- INFIX OPERATORS++infixr 0 <|++infixl 0 |>++infixr 2 ||++infixr 3 &&++infix 4 ==++infix 4 /=++infix 4 <++infix 4 >++infix 4 <=++infix 4 >=++infixr 5 ++++infixl 6 +++infixl 6 -++infixl 7 *++infixl 7 /++infixl 7 //++infixr 8 ^++infixl 9 <<++infixr 9 >>++-- | An @Int@ is a whole number. Valid syntax for integers includes:+--+-- > 0+-- > 42+-- > 9000+-- > 0xFF -- 255 in hexadecimal+-- > 0x000A -- 10 in hexadecimal+--+-- __Note:__ @Int@ math is well-defined in the range @-2^31@ to @2^31 - 1@.+--+-- __Historical Note:__ The name @Int@ comes from the term [integer](https://en.wikipedia.org/wiki/Integer). It appears that the @int@ abbreviation was introduced in [ALGOL 68](https://en.wikipedia.org/wiki/ALGOL_60), shortening it from @integer@ in [ALGOL 60](https://en.wikipedia.org/wiki/ALGOL_68). Today, almost all programming languages use this abbreviation.+type Int = Data.Int.Int64++-- | A @Float@ is a [floating-point number](https://en.wikipedia.org/wiki/Floating-point_arithmetic). Valid syntax for floats includes:+--+-- > 0+-- > 42+-- > 3.14+-- > 0.1234+-- > 6.022e23 -- == (6.022 * 10^23)+-- > 6.022e+23 -- == (6.022 * 10^23)+-- > 1.602e-19 -- == (1.602 * 10^-19)+-- > 1e3 -- == (1 * 10^3) == 1000+--+-- __Historical Note:__ The particular details of floats (e.g. @NaN@) are+-- specified by [IEEE 754](https://en.wikipedia.org/wiki/IEEE_754) which is+-- literally hard-coded into almost all CPUs in the world. That means if you+-- think @NaN@ is weird, you must successfully overtake Intel and AMD with a+-- chip that is not backwards compatible with any widely-used assembly+-- language.+type Float = Prelude.Double++-- | Add two numbers. The @number@ type variable means this operation can be+-- specialized to @Int -> Int -> Int@ or to @Float -> Float -> Float@. So you+-- can do things like this:+--+-- > 3002 + 4004 == 7006 -- all ints+-- > 3.14 + 3.14 == 6.28 -- all floats+--+-- You _cannot_ add an @Int@ and a @Float@ directly though. Use functions like+-- 'toFloat' or 'round' to convert both values to the same type. So if you+-- needed to add a list length to a @Float@ for some reason, you could say one+-- of these:+--+-- > 3.14 + toFloat (List.length [1,2,3]) == 6.14+-- > round 3.14 + List.length [1,2,3] == 6+--+-- __Note:__ Languages like Java and JavaScript automatically convert @Int@+-- values to @Float@ values when you mix and match. This can make it difficult+-- to be sure exactly what type of number you are dealing with. When you try to+-- /infer/ these conversions (as Scala does) it can be even more confusing. Elm+-- has opted for a design that makes all conversions explicit.+(+) :: Prelude.Num number => number -> number -> number+(+) =+ (Prelude.+)++-- | Subtract numbers like @4 - 3 == 1@.+--+-- See @'(+)'@ for docs on the @number@ type variable.+(-) :: Prelude.Num number => number -> number -> number+(-) =+ (Prelude.-)++-- | Multiply numbers like @2 * 3 == 6@.+--+-- See @'(+)'@ for docs on the @number@ type variable.+(*) :: Prelude.Num number => number -> number -> number+(*) =+ (Prelude.*)++-- | Floating-point division:+--+-- > 3.14 / 2 == 1.57+(/) :: Float -> Float -> Float+(/) =+ (Prelude./)++-- | Integer division:+--+-- > 3 // 2 == 1+--+-- Notice that the remainder is discarded.+(//) :: Int -> Int -> Int+(//) =+ -- Prelude.div truncates towards negative infinity which differs from Elm's+ -- behaviour.+ Prelude.quot++-- | Exponentiation+--+-- > 3^2 == 9+-- > 3^3 == 27+--+-- Breaking from Elm here, in that this is only defined for @Float@ arguments.+-- The exponentiation story in Haskell is a little more complex. See the @(^)@,+-- @(^^)@, and @(__)@ operations as a starting point.+(^) :: Float -> Float -> Float+(^) =+ (Prelude.**)++-- * Int to Float / Float to Int++-- | Convert an integer into a float. Useful when mixing @Int@ and @Float@+-- values like this:+--+-- > halfOf :: Int -> Float+-- > halfOf number =+-- > toFloat number / 2+toFloat :: Int -> Float+toFloat =+ Prelude.fromIntegral++-- | Round a number to the nearest integer.+--+-- > round 1.0 == 1+-- > round 1.2 == 1+-- > round 1.5 == 2+-- > round 1.8 == 2+--+-- > round -1.2 == -1+-- > round -1.5 == -1+-- > round -1.8 == -2+round :: Float -> Int+round =+ Prelude.round++-- | Floor function, rounding down.+--+-- > floor 1.0 == 1+-- > floor 1.2 == 1+-- > floor 1.5 == 1+-- > floor 1.8 == 1+--+-- > floor -1.2 == -2+-- > floor -1.5 == -2+-- > floor -1.8 == -2+floor :: Float -> Int+floor =+ Prelude.floor++-- | Ceiling function, rounding up.+--+-- > ceiling 1.0 == 1+-- > ceiling 1.2 == 2+-- > ceiling 1.5 == 2+-- > ceiling 1.8 == 2+--+-- > ceiling -1.2 == -1+-- > ceiling -1.5 == -1+-- > ceiling -1.8 == -1+ceiling :: Float -> Int+ceiling =+ Prelude.ceiling++-- | Truncate a number, rounding towards zero.+--+-- > truncate 1.0 == 1+-- > truncate 1.2 == 1+-- > truncate 1.5 == 1+-- > truncate 1.8 == 1+--+-- > truncate -1.2 == -1+-- > truncate -1.5 == -1+-- > truncate -1.8 == -1+truncate :: Float -> Int+truncate =+ Prelude.truncate++-- | Check if values are “the same”.+--+-- Breaking from Elm, this relies on Haskell's @Eq@ typeclass. For example:+--+-- > data Foo = Bar | Baz deriving (Eq)+(==) :: Prelude.Eq a => a -> a -> Bool+(==) =+ (Prelude.==)++-- | Check if values are not “the same”.+--+-- Like with @(==)@, this relies on Haskell's @Eq@ typeclass.+--+-- So @(a /= b)@ is the same as @(not (a == b))@.+(/=) :: Prelude.Eq a => a -> a -> Bool+(/=) =+ (Prelude./=)++-- |+(<) :: Prelude.Ord comparable => comparable -> comparable -> Bool+(<) =+ (Prelude.<)++-- |+(>) :: Prelude.Ord comparable => comparable -> comparable -> Bool+(>) =+ (Prelude.>)++-- |+(<=) :: Prelude.Ord comparable => comparable -> comparable -> Bool+(<=) =+ (Prelude.<=)++-- |+(>=) :: Prelude.Ord comparable => comparable -> comparable -> Bool+(>=) =+ (Prelude.>=)++-- | Find the larger of two comparables.+--+-- > max 42 12345678 == 12345678+-- > max "abc" "xyz" == "xyz"+max :: Prelude.Ord comparable => comparable -> comparable -> comparable+max =+ Prelude.max++-- | Find the smaller of two comparables.+--+-- > min 42 12345678 == 42+-- > min "abc" "xyz" == "abc"+min :: Prelude.Ord comparable => comparable -> comparable -> comparable+min =+ Prelude.min++-- | Compare any two comparable values. Comparable values include @String@,+-- @Char@, @Int@, @Float@, or a list or tuple containing comparable values. These+-- are also the only values that work as @Dict@ keys or @Set@ members.+--+-- > compare 3 4 == LT+-- > compare 4 4 == EQ+-- > compare 5 4 == GT+compare :: Prelude.Ord comparable => comparable -> comparable -> Order+compare =+ Prelude.compare++-- | Represents the relative ordering of two things.+-- The relations are less than, equal to, and greater than.+type Order = Prelude.Ordering++-- | A “Boolean” value. It can either be @True@ or @False@.+--+-- __Note:__ Programmers coming from JavaScript, Java, etc. tend to reach for boolean values way too often in Elm. Using a [union type](https://guide.elm-lang.org/types/union_types.html) is often clearer and more reliable. You can learn more about this from Jeremy [here](https://youtu.be/6TDKHGtAxeg?t=1m25s) or from Richard [here](https://youtu.be/IcgmSRJHu_8?t=1m14s).+type Bool = Prelude.Bool++-- | Negate a boolean value.+--+-- > not True == False+-- > not False == True+not :: Bool -> Bool+not =+ Prelude.not++-- | The logical AND operator. @True@ if both inputs are @True@.+--+-- > True && True == True+-- > True && False == False+-- > False && True == False+-- > False && False == False+(&&) :: Bool -> Bool -> Bool+(&&) =+ (Prelude.&&)++-- | The logical OR operator. @True@ if one or both inputs are @True@.+--+-- > True || True == True+-- > True || False == True+-- > False || True == True+-- > False || False == False+(||) :: Bool -> Bool -> Bool+(||) =+ (Prelude.||)++-- | The exclusive-or operator. @True@ if exactly one input is @True@.+--+-- > xor True True == False+-- > xor True False == True+-- > xor False True == True+-- > xor False False == False+xor :: Bool -> Bool -> Bool+xor =+ Data.Bits.xor++-- | 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]+(++) :: Prelude.Semigroup appendable => appendable -> appendable -> appendable+(++) =+ (Prelude.<>)++-- | Perform [modular arithmetic](https://en.wikipedia.org/wiki/Modular_arithmetic).+-- A common trick is to use (n mod 2) to detect even and odd numbers:+--+-- > modBy 2 0 == 0+-- > modBy 2 1 == 1+-- > modBy 2 2 == 0+-- > modBy 2 3 == 1+--+-- Our @modBy@ function works in the typical mathematical way when you run into+-- negative numbers:+--+-- > List.map (modBy 4) [ -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5 ]+-- > -- [ 3, 0, 1, 2, 3, 0, 1, 2, 3, 0, 1 ]+--+-- Use '@remainderBy@' for a different treatment of negative numbers, or read Daan Leijen’s [Division and Modulus for Computer Scientists](https://www.microsoft.com/en-us/research/wp-content/uploads/2016/02/divmodnote-letter.pdf) for more information.+modBy :: Int -> Int -> Int+modBy =+ Prelude.flip Prelude.mod++-- | Get the remainder after division. Here are bunch of examples of dividing by four:+--+-- > List.map (remainderBy 4) [ -5, -4, -3, -2, -1, 0, 1, 2, 3, 4, 5 ]+-- > -- [ -1, 0, -3, -2, -1, 0, 1, 2, 3, 0, 1 ]+--+-- Use '@modBy@' for a different treatment of negative numbers, or read Daan Leijen’s [Division and Modulus for Computer Scientists](https://www.microsoft.com/en-us/research/wp-content/uploads/2016/02/divmodnote-letter.pdf) for more information.+remainderBy :: Int -> Int -> Int+remainderBy =+ Prelude.flip Prelude.rem++-- | Negate a number.+--+-- negate 42 == -42+-- negate -42 == 42+-- negate 0 == 0+negate :: Prelude.Num number => number -> number+negate =+ Prelude.negate++-- | Get the [absolute value](https://en.wikipedia.org/wiki/Absolute_value) of+-- a number.+--+-- > abs 16 == 16+-- > abs -4 == 4+-- > abs -8.5 == 8.5+-- > abs 3.14 == 3.14+abs :: Prelude.Num number => number -> number+abs =+ Prelude.abs++-- | 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 :: Prelude.Ord number => number -> number -> number -> number+clamp low high number+ | number < low = low+ | number > high = high+ | otherwise = number++-- | Take the square root of a number.+--+-- > sqrt 4 == 2+-- > sqrt 9 == 3+-- > sqrt 16 == 4+-- > sqrt 25 == 5+sqrt :: Float -> Float+sqrt =+ Prelude.sqrt++-- | Calculate the logarithm of a number with a given base.+--+-- > logBase 10 100 == 2+-- > logBase 2 256 == 8+logBase :: Float -> Float -> Float+logBase =+ Prelude.logBase++-- | An approximation of e.+e :: Float+e =+ Prelude.exp 1++-- | Convert radians to standard Elm angles (radians).+--+-- > radians pi == 3.141592653589793+radians :: Float -> Float+radians angleInRadians =+ angleInRadians++-- | Convert degrees to standard Elm angles (radians).+--+-- > degrees 180 == 3.141592653589793+degrees :: Float -> Float+degrees angleInDegrees =+ (angleInDegrees * pi) / 180++-- | Convert turns to standard Elm angles (radians). One turn is equal to 360°.+--+-- > turns (1/2) == 3.141592653589793+turns :: Float -> Float+turns angleInTurns =+ (2 * pi) * angleInTurns++-- | An approximation of pi.+pi :: Float+pi =+ Prelude.pi++-- | Figure out the cosine given an angle in radians.+--+-- > cos (degrees 60) == 0.5000000000000001+-- > cos (turns (1/6)) == 0.5000000000000001+-- > cos (radians (pi/3)) == 0.5000000000000001+-- > cos (pi/3) == 0.5000000000000001+cos :: Float -> Float+cos =+ Prelude.cos++-- | Figure out the sine given an angle in radians.+--+-- > sin (degrees 30) == 0.49999999999999994+-- > sin (turns (1/12)) == 0.49999999999999994+-- > sin (radians (pi/6)) == 0.49999999999999994+-- > sin (pi/6) == 0.49999999999999994+sin :: Float -> Float+sin =+ Prelude.sin++-- | Figure out the tangent given an angle in radians.+--+-- > tan (degrees 45) == 0.9999999999999999+-- > tan (turns (1/8)) == 0.9999999999999999+-- > tan (radians (pi/4)) == 0.9999999999999999+-- > tan (pi/4) == 0.9999999999999999+tan :: Float -> Float+tan =+ Prelude.tan++-- | Figure out the arccosine for @adjacent / hypotenuse@ in radians:+--+-- > acos (1/2) == 1.0471975511965979 -- 60° or pi/3 radians+acos :: Float -> Float+acos =+ Prelude.acos++-- | Figure out the arcsine for @opposite / hypotenuse@ in radians:+--+-- > asin (1/2) == 0.5235987755982989 -- 30° or pi/6 radians+asin :: Float -> Float+asin =+ Prelude.asin++-- | This helps you find the angle (in radians) to an @(x,y)@ coordinate, but+-- in a way that is rarely useful in programming. __You probably want+-- 'atan2' instead!__+--+-- This version takes @y/x@ as its argument, so there is no way to know whether+-- the negative signs comes from the @y@ or @x@ value. So as we go counter-clockwise+-- around the origin from point @(1,1)@ to @(1,-1)@ to @(-1,-1)@ to @(-1,1)@ we do+-- not get angles that go in the full circle:+--+-- > atan ( 1 / 1 ) == 0.7853981633974483 -- 45° or pi/4 radians+-- > atan ( 1 / -1 ) == -0.7853981633974483 -- 315° or 7*pi/4 radians+-- > atan ( -1 / -1 ) == 0.7853981633974483 -- 45° or pi/4 radians+-- > atan ( -1 / 1 ) == -0.7853981633974483 -- 315° or 7*pi/4 radians+--+-- Notice that everything is between @pi/2@ and @-pi/2@. That is pretty useless+-- for figuring out angles in any sort of visualization, so again, check out+-- 'atan2' instead!+atan :: Float -> Float+atan =+ Prelude.atan++-- | This helps you find the angle (in radians) to an @(x,y)@ coordinate.+-- So rather than saying @atan (y/x)@ you say @atan2 y x@ and you can get a full+-- range of angles:+--+-- > atan2 1 1 == 0.7853981633974483 -- 45° or pi/4 radians+-- > atan2 1 -1 == 2.356194490192345 -- 135° or 3*pi/4 radians+-- > atan2 -1 -1 == -2.356194490192345 -- 225° or 5*pi/4 radians+-- > atan2 -1 1 == -0.7853981633974483 -- 315° or 7*pi/4 radians+atan2 :: Float -> Float -> Float+atan2 =+ Prelude.atan2++-- | Convert Cartesian coordinates (x,y) to polar coordinates (r,θ).+--+-- > toPolar (3, 4) == ( 5, 0.9272952180016122)+-- > toPolar (5,12) == (13, 1.1760052070951352)+toPolar :: (Float, Float) -> (Float, Float)+toPolar (x, y) =+ ( sqrt ((x * x) + (y * y)),+ atan2 y x+ )++-- | Convert polar coordinates (r,θ) to Cartesian coordinates (x,y).+--+-- > fromPolar (sqrt 2, degrees 45) == (1, 1)+fromPolar :: (Float, Float) -> (Float, Float)+fromPolar (radius, theta) =+ ( radius * cos theta,+ radius * sin theta+ )++-- | 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](https://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 =+ Prelude.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 =+ Prelude.isInfinite++-- | Given a value, returns exactly the same value. This is called+-- [the identity function](https://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++-- | Saying @f <| x@ is exactly the same as @f x@.+--+-- It can help you avoid parentheses, which can be nice sometimes. Maybe you want+-- to apply a function to a @case@ expression? That sort of thing.+(<|) :: (a -> b) -> a -> b+f <| x = f x++-- | Saying @x |> f@ is exactly the same as @f x@.+--+-- It is called the “pipe” operator because it lets you write “pipelined” code.+-- For example, say we have a @sanitize@ function for turning user input into+-- integers:+--+-- > -- BEFORE+-- > sanitize :: String -> Maybe Int+-- > sanitize input =+-- > String.toInt (String.trim input)+--+-- We can rewrite it like this:+--+-- > -- AFTER+-- > sanitize :: String -> Maybe Int+-- > sanitize input =+-- > input+-- > |> String.trim+-- > |> String.toInt+--+-- Totally equivalent! I recommend trying to rewrite code that uses @x |> f@+-- into code like @f x@ until there are no pipes left. That can help you build+-- your intuition.+--+-- __Note:__ This can be overused! I think folks find it quite neat, but when you+-- have three or four steps, the code often gets clearer if you break out a+-- top-level helper function. Now the transformation has a name. The arguments are+-- named. It has a type annotation. It is much more self-documenting that way!+-- Testing the logic gets easier too. Nice side benefit!+(|>) :: a -> (a -> b) -> b+x |> f = 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:+--+-- > 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)+(<<) = (Prelude..)++-- | 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+(>>) :: (a -> b) -> (b -> c) -> (a -> c)+(>>) = Prelude.flip (Prelude..)++-- | 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 = Data.Void.Void++-- | 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 = Data.Void.absurd
+ src/Bitwise.hs view
@@ -0,0 +1,75 @@+-- | Library for [bitwise operations](https://en.wikipedia.org/wiki/Bitwise_operation).+module Bitwise+ ( -- * Basic Operations+ and,+ or,+ xor,+ complement,++ -- * Bit Shifts+ shiftLeftBy,+ shiftRightBy,+ shiftRightZfBy,+ )+where++import Basics (Int)+import Data.Bits ((.&.), (.|.))+import qualified Data.Bits+import qualified Prelude++-- | Bitwise AND+and :: Int -> Int -> Int+and = (.&.)++-- | Bitwise OR+or :: Int -> Int -> Int+or = (.|.)++-- | Bitwise XOR+xor :: Int -> Int -> Int+xor = Data.Bits.xor++-- | Flip each bit individually, often called bitwise NOT+complement :: Int -> Int+complement = Data.Bits.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 offset value =+ Data.Bits.shift value (Prelude.fromIntegral offset)++-- | 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](https://en.wikipedia.org/wiki/Bitwise_operation#Arithmetic_shift), often written @>>@, and sometimes called a sign-propagating right shift because it fills empty spots with copies of the highest bit.+shiftRightBy :: Int -> Int -> Int+shiftRightBy offset value =+ Data.Bits.shiftR value (Prelude.fromIntegral offset)++-- | 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 == 9223372036854775792+--+-- This is called an [logical right shift](https://en.wikipedia.org/wiki/Bitwise_operation#Logical_shift), often written @>>>@, and sometimes called a zero-fill right shift because it fills empty spots with zeros.+shiftRightZfBy :: Int -> Int -> Int+shiftRightZfBy offset value =+ -- For some reason Data.Bits does not implement this function. The general idea is:+ -- 1. Generate a mask that will clear the leftmost n bits when ANDed with the result.+ -- 2. Shift right by n bits.+ -- 3. Bitwise AND the mask.+ let n = Prelude.fromIntegral offset+ oneBits = Data.Bits.complement Data.Bits.zeroBits :: Int+ shiftedValue = Data.Bits.shiftR value n+ shiftedMask = Data.Bits.rotateR (Data.Bits.shiftL oneBits n) n+ in and shiftedValue shiftedMask
+ src/Char.hs view
@@ -0,0 +1,160 @@+-- | Functions for working with characters. Character literals are enclosed in @\'a\'@ pair of single quotes.+--+-- Since we don't have a browser and we don't have a default locale, functions+-- like @toLocaleUpper@ and @toLocaleUpper@ are not supported. If you need+-- something like that you can check out the 'text-icu' package which provides+-- functions like @toUpper :: LocaleName -> Text -> Text@.+module Char+ ( -- * Characters+ Char,++ -- * ASCII Letters+ isUpper,+ isLower,+ isAlpha,+ isAlphaNum,++ -- * Digits+ isDigit,+ isOctDigit,+ isHexDigit,++ -- * Conversion+ toUpper,+ toLower,++ -- * Unicode Code Points+ toCode,+ fromCode,+ )+where++import Basics+ ( (&&),+ (<<),+ (<=),+ Bool (..),+ Int,+ )+import qualified Data.Char+import Prelude (Char, otherwise)+import qualified Prelude++-- | Detect upper case ASCII characters.+--+-- > isUpper 'A' == True+-- > isUpper 'B' == True+-- > ...+-- > isUpper 'Z' == True+--+-- > isUpper '0' == False+-- > isUpper 'a' == False+-- > isUpper '-' == False+-- > isUpper 'Σ' == False+isUpper :: Char -> Bool+isUpper = Data.Char.isUpper++-- | Detect lower case ASCII characters.+--+-- > isLower 'a' == True+-- > isLower 'b' == True+-- > ...+-- > isLower 'z' == True+--+-- > isLower '0' == False+-- > isLower 'A' == False+-- > isLower '-' == False+-- > isLower 'π' == False+isLower :: Char -> Bool+isLower = Data.Char.isLower++-- | Detect upper case and lower case ASCII characters.+--+-- > isAlpha 'a' == True+-- > isAlpha 'b' == True+-- > isAlpha 'E' == True+-- > isAlpha 'Y' == True+--+-- > isAlpha '0' == False+-- > isAlpha '-' == False+-- > isAlpha 'π' == False+isAlpha :: Char -> Bool+isAlpha = Data.Char.isAlpha++-- | Detect upper case and lower case ASCII characters.+--+-- > isAlphaNum 'a' == True+-- > isAlphaNum 'b' == True+-- > isAlphaNum 'E' == True+-- > isAlphaNum 'Y' == True+-- > isAlphaNum '0' == True+-- > isAlphaNum '7' == True+--+-- > isAlphaNum '-' == False+-- > isAlphaNum 'π' == False+isAlphaNum :: Char -> Bool+isAlphaNum = Data.Char.isAlphaNum++-- | Detect digits @0123456789@+--+-- > isDigit '0' == True+-- > isDigit '1' == True+-- > ...+-- > isDigit '9' == True+--+-- > isDigit 'a' == False+-- > isDigit 'b' == False+-- > isDigit 'A' == False+isDigit :: Char -> Bool+isDigit = Data.Char.isDigit++-- | Detect octal digits @01234567@+--+-- > isOctDigit '0' == True+-- > isOctDigit '1' == True+-- > ...+-- > isOctDigit '7' == True+--+-- > isOctDigit '8' == False+-- > isOctDigit 'a' == False+-- > isOctDigit 'A' == False+isOctDigit :: Char -> Bool+isOctDigit = Data.Char.isOctDigit++-- | Detect hexadecimal digits @0123456789abcdefABCDEF@+isHexDigit :: Char -> Bool+isHexDigit = Data.Char.isHexDigit++-- | Convert to upper case.+toUpper :: Char -> Char+toUpper = Data.Char.toUpper++-- | Convert to lower case.+toLower :: Char -> Char+toLower = Data.Char.toLower++-- | Convert to the corresponding Unicode [code point](https://en.wikipedia.org/wiki/Code_point).+--+-- > toCode 'A' == 65+-- > toCode 'B' == 66+-- > toCode '木' == 26408+-- > toCode '𝌆' == 0x1D306+-- > toCode '😃' == 0x1F603+toCode :: Char -> Int+toCode = Prelude.fromIntegral << Data.Char.ord++-- | Convert a Unicode [code point](https://en.wikipedia.org/wiki/Code_point) to a character.+--+-- > fromCode 65 == 'A'+-- > fromCode 66 == 'B'+-- > fromCode 0x6728 == '\26408' -- '木'+-- > fromCode 0x1D306 == '\119558' -- '𝌆'+-- > fromCode 0x1F603 == '\128515' -- '😃'+-- > fromCode (-1) == '\65533' -- '�'+--+-- The full range of unicode is from @0@ to @0x10FFFF@. With numbers outside that+-- range, you get [the replacement character](https://en.wikipedia.org/wiki/Specials_(Unicode_block)#Replacement_character).+fromCode :: Int -> Char+fromCode value+ | 0 <= value && value <= 0x10FFFF = Data.Char.chr (Prelude.fromIntegral value)+ | otherwise = '\xfffd'
+ src/Debug.hs view
@@ -0,0 +1,66 @@+-- | This module can be useful while _developing_ an application. It should not+-- be used in production.+module Debug+ ( -- * Debugging+ toString,+ log,+ todo,+ )+where++import Basics ((>>))+import Data.Text (pack, unpack)+import qualified Debug.Trace+import Text (Text, concat)+import qualified Text.Show.Pretty+import Prelude (Show, error)++-- | Turn any @Show@able kind of value into a string.+--+-- > toString 42 == "42"+-- > toString [1,2] == "[1,2]"+-- > toString ('a', "cat", 13) == "('a', \"cat\", 13)"+-- > toString "he said, \"hi\"" == "\"he said, \\\"hi\\\"\""+--+-- Notice that with strings, this is not the @identity@ function. Ultimately it's+-- down to the value's @Show@ instance, but for strings this typically escapes+-- characters. If you say @toString "he said, \"hi\""@ it will show @"he said,+-- \"hi\""@ rather than @he said, "hi"@.+toString :: Show a => a -> Text+toString =+ Text.Show.Pretty.ppShow >> pack++-- | 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: []"+--+-- It is often possible to sprinkle this around to see if values are what you+-- expect. It is kind of old-school to do it this way, but it works!+log :: Show a => Text -> a -> a+log message value =+ Debug.Trace.trace (unpack (concat [message, ": ", toString value])) value++-- | This is a placeholder for code that you will write later.+--+-- For example, if you are working with a large union type 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.todo "handle Captain and Seagull"+--+-- When you call this it throws an exception with the message you give. That+-- exception is catchable... but don't.+todo :: Text -> a+todo =+ unpack >> error
+ src/Dict.hs view
@@ -0,0 +1,259 @@+-- | 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.+module Dict+ ( -- * Dictionaries+ Dict,++ -- * Build+ empty,+ singleton,+ insert,+ update,+ remove,++ -- * Query+ isEmpty,+ member,+ get,+ size,++ -- * Lists+ keys,+ values,+ toList,+ fromList,++ -- * Transform+ map,+ foldl,+ foldr,+ filter,+ partition,++ -- * Combine+ union,+ intersect,+ diff,+ merge,+ )+where++import Basics+import qualified Data.Map.Strict+import qualified List+import List (List)+import Maybe (Maybe (..))+import Prelude (Ord, fromIntegral, otherwise)++-- DICTIONARIES++-- | 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@.+--+-- > import Dict exposing (Dict)+-- >+-- > users : Dict String User+-- > users =+-- > Dict.fromList+-- > [ ("Alice", User "Alice" 28 1.65)+-- > , ("Bob" , User "Bob" 19 1.82)+-- > , ("Chuck", User "Chuck" 33 1.75)+-- > ]+-- >+-- > type alias User =+-- > { name : String+-- > , age : Int+-- > , height : Float+-- > }+type Dict k v =+ Data.Map.Strict.Map k v++-- | Create an empty dictionary.+empty :: Dict k v+empty =+ Data.Map.Strict.empty++-- | 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 :: Ord comparable => comparable -> Dict comparable v -> Maybe v+get =+ Data.Map.Strict.lookup++-- | Determine if a key is in a dictionary.+member :: Ord comparable => comparable -> Dict comparable v -> Bool+member =+ Data.Map.Strict.member++-- | Determine the number of key-value pairs in the dictionary.+size :: Dict k v -> Int+size =+ Data.Map.Strict.size >> fromIntegral++-- | Determine if a dictionary is empty.+--+-- > isEmpty empty == True+isEmpty :: Dict k v -> Bool+isEmpty =+ Data.Map.Strict.null++-- | Insert a key-value pair into a dictionary. Replaces value when there is+-- a collision.+insert :: Ord comparable => comparable -> v -> Dict comparable v -> Dict comparable v+insert =+ Data.Map.Strict.insert++-- | Remove a key-value pair from a dictionary. If the key is not found,+-- no changes are made.+remove :: Ord comparable => comparable -> Dict comparable v -> Dict comparable v+remove =+ Data.Map.Strict.delete++-- | Update the value of a dictionary for a specific key with a given function.+update :: Ord comparable => comparable -> (Maybe v -> Maybe v) -> Dict comparable v -> Dict comparable v+update targetKey alter dictionary =+ let maybeItemToSet =+ Data.Map.Strict.lookup targetKey dictionary |> alter+ in case maybeItemToSet of+ Just itemToSet ->+ Data.Map.Strict.insert targetKey itemToSet dictionary+ Nothing ->+ Data.Map.Strict.delete targetKey dictionary++-- | Create a dictionary with one key-value pair.+singleton :: comparable -> v -> Dict comparable v+singleton =+ Data.Map.Strict.singleton++-- COMBINE++-- | Combine two dictionaries. If there is a collision, preference is given+-- to the first dictionary.+union :: Ord comparable => Dict comparable v -> Dict comparable v -> Dict comparable v+union =+ Data.Map.Strict.union++-- | Keep a key-value pair when its key appears in the second dictionary.+-- Preference is given to values in the first dictionary.+intersect :: Ord comparable => Dict comparable v -> Dict comparable v -> Dict comparable v+intersect =+ Data.Map.Strict.intersection++-- | Keep a key-value pair when its key does not appear in the second dictionary.+diff :: Ord comparable => Dict comparable a -> Dict comparable b -> Dict comparable a+diff =+ Data.Map.Strict.difference++-- | 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 ::+ Ord comparable =>+ (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+ | lKey < rKey -> stepState rKey rValue (rest, leftStep lKey lValue result)+ | lKey > rKey -> (list, rightStep rKey rValue result)+ | otherwise -> (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 :: (k -> a -> b) -> Dict k a -> Dict k b+map = Data.Map.Strict.mapWithKey++-- | Fold over the key-value pairs in a dictionary from lowest key to highest key.+--+-- > import Dict exposing (Dict)+-- >+-- > getAges : Dict String User -> List String+-- > getAges users =+-- > Dict.foldl addAge [] users+-- >+-- > addAge : String -> User -> List String -> List String+-- > addAge _ user ages =+-- > user.age :: ages+-- >+-- > -- getAges users == [33,19,28]+foldl :: (k -> v -> b -> b) -> b -> Dict k v -> b+foldl fun =+ Data.Map.Strict.foldlWithKey' flippedFun+ where+ flippedFun acc key value = fun key value acc++-- | Fold over the key-value pairs in a dictionary from highest key to lowest key.+--+-- > import Dict exposing (Dict)+-- >+-- > getAges : Dict String User -> List String+-- > getAges users =+-- > Dict.foldr addAge [] users+-- >+-- > addAge : String -> User -> List String -> List String+-- > addAge _ user ages =+-- > user.age :: ages+-- >+-- > -- getAges users == [28,19,33]+foldr :: (k -> v -> b -> b) -> b -> Dict k v -> b+foldr = Data.Map.Strict.foldrWithKey++-- | Keep only the key-value pairs that pass the given test.+filter :: (comparable -> v -> Bool) -> Dict comparable v -> Dict comparable v+filter = Data.Map.Strict.filterWithKey++-- | Partition a dictionary according to some test. The first dictionary+-- contains all key-value pairs which passed the test, and the second contains+-- the pairs that did not.+partition :: (comparable -> v -> Bool) -> Dict comparable v -> (Dict comparable v, Dict comparable v)+partition = Data.Map.Strict.partitionWithKey++-- LISTS++-- | Get all of the keys in a dictionary, sorted from lowest to highest.+--+-- > keys (fromList [(0,"Alice"),(1,"Bob")]) == [0,1]+keys :: Dict k v -> List k+keys = Data.Map.Strict.keys++-- | Get all of the values in a dictionary, in the order of their keys.+--+-- > values (fromList [(0,"Alice"),(1,"Bob")]) == ["Alice", "Bob"]+values :: Dict k v -> List v+values = Data.Map.Strict.elems++-- | Convert a dictionary into an association list of key-value pairs, sorted by keys.+toList :: Dict k v -> List (k, v)+toList = Data.Map.Strict.toList++-- | Convert an association list into a dictionary.+fromList :: Ord comparable => List (comparable, v) -> Dict comparable v+fromList = Data.Map.Strict.fromList
+ src/Expect.hs view
@@ -0,0 +1,456 @@+-- | A library to create @Expectation@s, which describe a claim to be tested.+--+-- = Quick Reference+--+-- - 'equal' @(arg2 == arg1)@+-- - 'notEqual' @(arg2 /= arg1)@+-- - 'lessThan' @(arg2 < arg1)@+-- - 'atMost' @(arg2 <= arg1)@+-- - 'greaterThan' @(arg2 > arg1)@+-- - 'atLeast' @(arg2 >= arg1)@+-- - 'true' @(arg == True)@+-- - 'false' @(arg == False)@+module Expect+ ( -- * Basic Expectations+ Expectation,+ equal,+ notEqual,+ all,+ concat,++ -- * Numeric Comparisons+ lessThan,+ atMost,+ greaterThan,+ atLeast,++ -- * Booleans+ true,+ false,++ -- * Collections+ ok,+ err,++ -- * Customizing++ -- | These functions will let you build your own expectations.+ pass,+ fail,+ onFail,++ -- * Fancy Expectations+ equalToContentsOf,+ withIO,+ )+where++import qualified Data.Text+import qualified Data.Text.IO+import qualified Debug+import qualified Internal.Expectation+import qualified Internal.TestResult+import qualified List+import List (List)+import NriPrelude+import qualified System.Directory as Directory+import qualified System.FilePath as FilePath+import Prelude (Eq, IO, Ord, Show, show)++-- | The result of a single test run: either a 'pass' or a 'fail'.+type Expectation =+ Internal.Expectation.Expectation Internal.TestResult.TestResult++-- | Run some IO and assert the value it produces.+--+-- If the IO throws an exception the test will fail.+withIO :: (a -> Expectation) -> IO a -> Expectation+withIO fn io =+ Internal.Expectation.fromIO io |> andThen fn++-- | Always passes.+--+-- > import Json.Decode exposing (decodeString, int)+-- > import Test exposing (test)+-- > import Expect+-- >+-- >+-- > test "Json.Decode.int can decode the number 42." <|+-- > \_ ->+-- > case decodeString int "42" of+-- > Ok _ ->+-- > Expect.pass+-- >+-- > Err err ->+-- > Expect.fail err+pass :: Expectation+pass = Internal.Expectation.pass++-- | Fails with the given message.+--+-- > import Json.Decode exposing (decodeString, int)+-- > import Test exposing (test)+-- > import Expect+-- >+-- >+-- > test "Json.Decode.int can decode the number 42." <|+-- > \_ ->+-- > case decodeString int "42" of+-- > Ok _ ->+-- > Expect.pass+-- >+-- > Err err ->+-- > Expect.fail err+fail :: Text -> Expectation+fail = Internal.Expectation.fail++-- | If the given expectation fails, replace its failure message with a custom one.+--+-- > "something"+-- > |> Expect.equal "something else"+-- > |> Expect.onFail "thought those two strings would be the same"+onFail :: Text -> Expectation -> Expectation+onFail = Internal.Expectation.onFail++-- | Passes if the arguments are equal.+--+-- > Expect.equal 0 (List.length [])+-- >+-- > -- Passes because (0 == 0) is True+--+-- Failures resemble code written in pipeline style, so you can tell which argument is which:+--+-- > -- Fails because the expected value didn't split the space in "Betty Botter"+-- > Text.split " " "Betty Botter bought some butter"+-- > |> Expect.equal [ "Betty Botter", "bought", "some", "butter" ]+-- >+-- > {-+-- >+-- > [ "Betty", "Botter", "bought", "some", "butter" ]+-- > ╷+-- > │ Expect.equal+-- > ╵+-- > [ "Betty Botter", "bought", "some", "butter" ]+-- >+-- > -}+equal :: (Show a, Eq a) => a -> a -> Expectation+equal = Internal.Expectation.build (==) "Expect.equal"++-- | Passes if the arguments are not equal.+--+-- > -- Passes because (11 /= 100) is True+-- > 90 + 10+-- > |> Expect.notEqual 11+-- >+-- >+-- > -- Fails because (100 /= 100) is False+-- > 90 + 10+-- > |> Expect.notEqual 100+-- >+-- > {-+-- >+-- > 100+-- > ╷+-- > │ Expect.notEqual+-- > ╵+-- > 100+-- >+-- > -}+notEqual :: (Show a, Eq a) => a -> a -> Expectation+notEqual = Internal.Expectation.build (/=) "Expect.notEqual"++-- | Passes if the second argument is less than the first.+--+-- > Expect.lessThan 1 (List.length [])+-- >+-- > -- Passes because (0 < 1) is True+--+-- Failures resemble code written in pipeline style, so you can tell which argument is which:+--+-- > -- Fails because (0 < -1) is False+-- > List.length []+-- > |> Expect.lessThan -1+-- >+-- >+-- > {-+-- >+-- > 0+-- > ╷+-- > │ Expect.lessThan+-- > ╵+-- > -1+-- >+-- > -}+lessThan :: (Show a, Ord a) => a -> a -> Expectation+lessThan = Internal.Expectation.build (>) "Expect.lessThan"++-- | Passes if the second argument is less than or equal to the first.+--+-- > Expect.atMost 1 (List.length [])+-- >+-- > -- Passes because (0 <= 1) is True+--+-- Failures resemble code written in pipeline style, so you can tell which argument is which:+--+-- > -- Fails because (0 <= -3) is False+-- > List.length []+-- > |> Expect.atMost -3+-- >+-- > {-+-- >+-- > 0+-- > ╷+-- > │ Expect.atMost+-- > ╵+-- > -3+-- >+-- > -}+atMost :: (Show a, Ord a) => a -> a -> Expectation+atMost = Internal.Expectation.build (>=) "Expect.atMost"++-- | Passes if the second argument is greater than the first.+--+-- > Expect.greaterThan -2 List.length []+-- >+-- > -- Passes because (0 > -2) is True+--+-- Failures resemble code written in pipeline style, so you can tell which argument is which:+--+-- > -- Fails because (0 > 1) is False+-- > List.length []+-- > |> Expect.greaterThan 1+-- >+-- > {-+-- >+-- > 0+-- > ╷+-- > │ Expect.greaterThan+-- > ╵+-- > 1+-- >+-- > -}+greaterThan :: (Show a, Ord a) => a -> a -> Expectation+greaterThan = Internal.Expectation.build (<) "Expect.greaterThan"++-- | Passes if the second argument is greater than or equal to the first.+--+-- > Expect.atLeast -2 (List.length [])+-- >+-- > -- Passes because (0 >= -2) is True+--+-- Failures resemble code written in pipeline style, so you can tell which argument is which:+--+-- > -- Fails because (0 >= 3) is False+-- > List.length []+-- > |> Expect.atLeast 3+-- >+-- > {-+-- >+-- > 0+-- > ╷+-- > │ Expect.atLeast+-- > ╵+-- > 3+-- >+-- > -}+atLeast :: (Show a, Ord a) => a -> a -> Expectation+atLeast = Internal.Expectation.build (<=) "Expect.atLeast"++-- | Passes if the argument is 'True', and otherwise fails with the given message.+--+-- > Expect.true "Expected the list to be empty." (List.isEmpty [])+-- >+-- > -- Passes because (List.isEmpty []) is True+--+-- Failures resemble code written in pipeline style, so you can tell which argument is which:+--+-- > -- Fails because List.isEmpty returns False, but we expect True.+-- > List.isEmpty [ 42 ]+-- > |> Expect.true "Expected the list to be empty."+-- >+-- > {-+-- >+-- > Expected the list to be empty.+-- >+-- > -}+true :: Bool -> Expectation+true x = Internal.Expectation.build (&&) "Expect.true" x True++-- | Passes if the argument is 'False', and otherwise fails with the given message.+--+-- > Expect.false "Expected the list not to be empty." (List.isEmpty [ 42 ])+-- >+-- > -- Passes because (List.isEmpty [ 42 ]) is False+--+-- Failures resemble code written in pipeline style, so you can tell which argument is which:+--+-- > -- Fails because (List.isEmpty []) is True+-- > List.isEmpty []+-- > |> Expect.false "Expected the list not to be empty."+-- >+-- > {-+-- >+-- > Expected the list not to be empty.+-- >+-- > -}+false :: Bool -> Expectation+false x = Internal.Expectation.build xor "Expect.false" x True++-- | Passes if each of the given functions passes when applied to the subject.+--+-- Passing an empty list is assumed to be a mistake, so Expect.all [] will always return a failed expectation no matter what else it is passed.+--+-- > Expect.all+-- > [ Expect.greaterThan -2+-- > , Expect.lessThan 5+-- > ]+-- > (List.length [])+-- > -- Passes because (0 > -2) is True and (0 < 5) is also True+--+-- Failures resemble code written in pipeline style, so you can tell which argument is which:+--+-- > -- Fails because (0 < -10) is False+-- > List.length []+-- > |> Expect.all+-- > [ Expect.greaterThan -2+-- > , Expect.lessThan -10+-- > , Expect.equal 0+-- > ]+-- > {-+-- > 0+-- > ╷+-- > │ Expect.lessThan+-- > ╵+-- > -10+-- > -}+all :: List (subject -> Expectation) -> subject -> Expectation+all expectations subject =+ List.foldl+ ( \expectation acc ->+ Internal.Expectation.join+ acc+ (expectation subject)+ )+ Internal.Expectation.pass+ expectations++-- | Combine multiple expectations into one. The resulting expectation is a+-- failure if any of the original expectations are a failure.+concat :: List Expectation -> Expectation+concat expectations =+ List.foldl+ ( \expectation acc ->+ Internal.Expectation.join+ acc+ expectation+ )+ Internal.Expectation.pass+ expectations++-- | Passes if the Result is an Ok rather than Err. This is useful for tests where you expect not to see an error, but you don't care what the actual result is.+--+-- (Tip: If your function returns a Maybe instead, consider Expect.notEqual Nothing.)+--+-- > -- Passes+-- > String.toInt "not an int"+-- > |> Expect.err+--+-- Test failures will be printed with the unexpected Ok value contrasting with any Err.+--+-- > -- Fails+-- > String.toInt "20"+-- > |> Expect.err+-- >+-- > {-+-- >+-- > Ok 20+-- > ╷+-- > │ Expect.err+-- > ╵+-- > Err _+-- >+-- > -}+ok :: Show b => Result b a -> Expectation+ok res =+ case res of+ Ok _ -> Expect.pass+ Err message -> fail ("I expected a Ok but got Err (" ++ Debug.toString message ++ ")")++-- | Passes if the Result is an Err rather than Ok. This is useful for tests where you expect to get an error but you don't care what the actual error is.+--+-- (Tip: If your function returns a Maybe instead, consider Expect.equal Nothing.)+--+-- > -- Passes+-- > String.toInt "not an int"+-- > |> Expect.err+--+-- Test failures will be printed with the unexpected Ok value contrasting with any Err.+--+-- > -- Fails+-- > String.toInt "20"+-- > |> Expect.err+-- >+-- > {-+-- >+-- > Ok 20+-- > ╷+-- > │ Expect.err+-- > ╵+-- > Err _+-- >+-- > -}+err :: Show a => Result b a -> Expectation+err res =+ case res of+ Ok value -> fail ("I expected a Err but got Ok (" ++ Debug.toString value ++ ")")+ Err _ -> Expect.pass++-- | Check if a string is equal to the contents of a file.+--+-- > Debug.toString complicatedObject+-- > |> Expect.equalToContentsOf "golden-results/complicated-object.txt"+--+-- If the file does not exist it will be created and the test will pass.+-- Subsequent runs will check the test output matches the now existing file.+--+-- This can be useful when checking big strings, like for example JSON+-- encodings. When a test fails we can throw away the file, rerun the test, and+-- use @git diff golden-results/complicated-object.txt@ to check whether the+-- changes are acceptable.+equalToContentsOf :: Text -> Text -> Expectation+equalToContentsOf filepath' actual = do+ let filepath = Data.Text.unpack filepath'+ exists <- Internal.Expectation.fromIO <| do+ Directory.createDirectoryIfMissing True (FilePath.takeDirectory filepath)+ Directory.doesFileExist filepath+ if exists+ then do+ expected <- Internal.Expectation.fromIO (Data.Text.IO.readFile filepath)+ Internal.Expectation.build+ (==)+ "Expect.equalToContentsOf"+ (UnescapedShow expected)+ (UnescapedShow actual)+ else do+ Internal.Expectation.fromIO (Data.Text.IO.writeFile filepath actual)+ Internal.Expectation.pass++-- By default we will compare values with each other after they have been+-- passed to @show@. Unfortunately @show@ for the @Text@ type escapes special+-- characters, so a string like this:+--+-- Hi there,+-- newline!+--+-- Is rendered in test output as this:+--+-- \"Hi there,\nnewline!\"+--+-- And then test output looks all garbled.+--+-- This newtype wrapper for @Text@ makes the show instance render it without+-- escaping any character, resulting in cleaner test output!+newtype UnescapedShow = UnescapedShow Text deriving (Eq)++instance Show UnescapedShow where+ show (UnescapedShow text) = Data.Text.unpack text
+ src/Expect/Task.hs view
@@ -0,0 +1,72 @@+-- | A library to create @Expecation@s for @Task@s.+module Expect.Task+ ( check,+ andCheck,+ succeeds,+ fails,+ TestFailure,+ )+where++import qualified Debug+import qualified Expect+import qualified Internal.Expectation+import qualified Internal.TestResult+import Internal.TestResult (TestFailure)+import NriPrelude+import qualified Platform+import qualified Platform.DoAnything as DoAnything+import qualified Task++-- | Check a task returns an expected value, than pass that value on.+--+-- > task "Greetings are friendly" <| do+-- > getGreeting+-- > |> andCheck (Expect.equal "Hi!")+andCheck :: (a -> Expect.Expectation) -> Task TestFailure a -> Task TestFailure a+andCheck expectation t = do+ x <- t+ expectation x+ |> Internal.Expectation.toResult+ |> map Ok+ |> Platform.doAnything DoAnything.Handler+ |> Task.andThen+ ( \res -> case res of+ Internal.TestResult.Passed -> Task.succeed ()+ Internal.TestResult.Skipped -> Task.succeed ()+ Internal.TestResult.Failed message -> Task.fail message+ )+ Task.succeed x++-- | Check an expectation in the middle of a @do@ block.+--+-- > task "Laundry gets done" <| do+-- > weightInKgs <- clothesInWasher+-- > check (weightInKgs |> Expect.atMost 8)+-- > soapInWasher+-- > startMachine+check :: Expect.Expectation -> Task TestFailure ()+check expectation =+ Task.succeed ()+ |> andCheck (\() -> expectation)++-- | Check a task succeeds.+--+-- > task "solve rubicskube" <| do+-- > solveRubicsKube+-- > |> succeeds+succeeds :: Show err => Task err a -> Task TestFailure a+succeeds =+ Task.mapError+ ( \message ->+ Internal.TestResult.TestFailure (Debug.toString message)+ )++-- | Check a task fails.+--+-- > task "chemistry experiment" <| do+-- > mixRedAndGreenLiquids+-- > |> fails+fails :: Text -> Task TestFailure a+fails =+ Task.fail << Internal.TestResult.TestFailure << Debug.toString
+ src/Fuzz.hs view
@@ -0,0 +1,49 @@+-- | This is a library of fuzzers you can use to supply values to your fuzz tests. You can typically pick out which ones you need according to their types.+-- A @Fuzzer@ a knows how to create values of type @a@ in two different ways. It can create them randomly, so that your test's expectations are run against many values. Fuzzers will often generate edge cases likely to find bugs. If the fuzzer can make your test fail, it also knows how to "shrink" that failing input into more minimal examples, some of which might also cause the tests to fail. In this way, fuzzers can usually find the smallest or simplest input that reproduces a bug.+module Fuzz+ ( -- * Common Fuzzers+ int,+ intRange,+ list,++ -- * Working with Fuzzers+ Fuzzer,+ )+where++import qualified Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import NriPrelude++type Fuzzer = Hedgehog.Gen++-- | A fuzzer for int values. It will never produce @NaN@, @Infinity@, or @-Infinity@.+-- It's possible for this fuzzer to generate any 32-bit integer, signed or unsigned, but it favors+-- numbers between -50 and 50 and especially zero.+int :: Fuzzer Int+int =+ Gen.frequency+ [ (30, intRange (-50) 50),+ (2, Gen.constant 0),+ (10, intRange 0 (maxInt - minInt)),+ (10, intRange (minInt - maxInt) 0)+ ]++-- | A fuzzer for int values between a given minimum and maximum value,+-- inclusive. Shrunken values will also be within the range.+-- Remember that [Random.maxInt](http://package.elm-lang.org/packages/elm-lang/core/latest/Random#maxInt)+-- is the maximum possible int value, so you can do @intRange x Random.maxInt@ to get all+-- the ints x or bigger.+intRange :: Int -> Int -> Fuzzer Int+intRange min_ max_ = Gen.integral (Range.linear min_ max_)++-- | Given a fuzzer of a type, create a fuzzer of a list of that type. Generates random lists of varying length, favoring shorter lists.+list :: Fuzzer a -> Fuzzer (List a)+list = Gen.list (Range.linear 0 10)++maxInt :: Int+maxInt = 2147483647++minInt :: Int+minInt = -2147483648
+ src/Internal/Expectation.hs view
@@ -0,0 +1,48 @@+module Internal.Expectation+ ( Expectation,+ pass,+ fail,+ join,+ build,+ toResult,+ fromResult,+ fromIO,+ onFail,+ )+where++import NriPrelude+import Control.Monad.IO.Class (liftIO)+import qualified Internal.TestResult as TestResult+import Internal.TestResult (TestResult)+import Prelude (Applicative, Functor, IO, Monad, Show, pure)++newtype Expectation a = Expectation (IO a)+ deriving (Functor, Applicative, Monad)++fromIO :: IO a -> Expectation a+fromIO = Expectation << liftIO++join :: Expectation TestResult -> Expectation TestResult -> Expectation TestResult+join (Expectation x) (Expectation y) = Expectation (map2 TestResult.join x y)++pass :: Expectation TestResult+pass = Expectation (pure TestResult.passed)++fail :: Text -> Expectation TestResult+fail = Expectation << pure << TestResult.failed++onFail :: Text -> Expectation TestResult -> Expectation TestResult+onFail message =+ fmap (TestResult.onFail message)++build :: Show a => (a -> a -> Bool) -> Text -> a -> a -> Expectation TestResult+build pred funcName x y =+ TestResult.fromPredicate pred funcName x y+ |> Expectation++toResult :: Expectation TestResult -> IO TestResult+toResult (Expectation r) = r++fromResult :: TestResult.TestFailure -> Expectation TestResult+fromResult r = Expectation (pure (TestResult.Failed r))
+ src/Internal/Shortcut.hs view
@@ -0,0 +1,85 @@+{- HLINT ignore -}++module Internal.Shortcut+ ( map,+ map2,+ map3,+ map4,+ map5,+ map6,+ map7,+ map8,+ map9,+ andMap,+ andThen,+ afterwards,+ blank,+ )+where++import Prelude ((<*>), (>>=), Applicative, Functor, Monad, Monad, fmap, pure)++-- |+andThen :: Monad m => (a -> m b) -> m a -> m b+andThen b a =+ a >>= b++-- |+afterwards :: Monad m => m b -> m a -> m b+afterwards b a =+ a >>= (\_ -> b)++-- |+map :: Functor m => (a -> value) -> m a -> m value+map =+ fmap++-- |+map2 :: Applicative m => (a -> b -> value) -> m a -> m b -> m value+map2 func a b =+ pure func <*> a <*> b++-- |+map3 :: Applicative m => (a -> b -> c -> value) -> m a -> m b -> m c -> m value+map3 func a b c =+ pure func <*> a <*> b <*> c++-- |+map4 :: Applicative m => (a -> b -> c -> d -> value) -> m a -> m b -> m c -> m d -> m value+map4 func a b c d =+ pure func <*> a <*> b <*> c <*> d++-- |+map5 :: Applicative m => (a -> b -> c -> d -> e -> value) -> m a -> m b -> m c -> m d -> m e -> m value+map5 func a b c d e =+ pure func <*> a <*> b <*> c <*> d <*> e++-- |+map6 :: Applicative m => (a -> b -> c -> d -> e -> f -> value) -> m a -> m b -> m c -> m d -> m e -> m f -> m value+map6 func a b c d e f =+ pure func <*> a <*> b <*> c <*> d <*> e <*> f++-- |+map7 :: Applicative m => (a -> b -> c -> d -> e -> f -> g -> value) -> m a -> m b -> m c -> m d -> m e -> m f -> m g -> m value+map7 func a b c d e f g =+ pure func <*> a <*> b <*> c <*> d <*> e <*> f <*> g++-- |+map8 :: Applicative m => (a -> b -> c -> d -> e -> f -> g -> h -> value) -> m a -> m b -> m c -> m d -> m e -> m f -> m g -> m h -> m value+map8 func a b c d e f g h =+ pure func <*> a <*> b <*> c <*> d <*> e <*> f <*> g <*> h++-- |+map9 :: Applicative m => (a -> b -> c -> d -> e -> f -> g -> h -> i -> value) -> m a -> m b -> m c -> m d -> m e -> m f -> m g -> m h -> m i -> m value+map9 func a b c d e f g h i =+ pure func <*> a <*> b <*> c <*> d <*> e <*> f <*> g <*> h <*> i++-- |+andMap :: Applicative m => m a -> m (a -> b) -> m b+andMap m mf =+ mf <*> m++-- |+blank :: Monad m => m ()+blank =+ pure ()
+ src/Internal/Terminal.hs view
@@ -0,0 +1,101 @@+module Internal.Terminal (write, read, red, blue, green, magenta, yellow, cyan, lightBlue, black, white, reset, underline, italic, newline, indent, message, header, blank, paragraphs) where++import Basics+import qualified Data.Text+import List (List)+import qualified Text+import qualified Prelude as P++-- |+write :: Text.Text -> P.IO ()+write string =+ P.putStr (Data.Text.unpack string)++-- |+read :: P.IO Text.Text+read =+ P.getLine+ |> P.fmap Data.Text.pack++-- CHARACTERS++red :: Text.Text+red =+ "\x1b[31m"++blue :: Text.Text+blue =+ "\x1b[34m"++magenta :: Text.Text+magenta =+ "\x1b[35m"++green :: Text.Text+green =+ "\x1b[32m"++yellow :: Text.Text+yellow =+ "\x1b[33m"++cyan :: Text.Text+cyan =+ "\x1b[36m"++lightBlue :: Text.Text+lightBlue =+ "\x1b[94m"++black :: Text.Text+black =+ "\x1b[30m"++white :: Text.Text+white =+ "\x1b[37m"++reset :: Text.Text+reset =+ "\x1b[0m"++newline :: Text.Text+newline =+ "\n"++blank :: Text.Text+blank =+ newline ++ newline++underline :: Text.Text+underline =+ "\x1b[4m"++italic :: Text.Text+italic =+ "\x1b[3m"++indent :: Int -> Text.Text+indent number =+ Text.repeat number " "++-- MESSAGE++message :: Text.Text -> Text.Text -> Text.Text -> List Text.Text -> P.IO ()+message color title location content = do+ write (color ++ header title location ++ reset)+ write blank+ write (paragraphs content)+ write blank++header :: Text.Text -> Text.Text -> Text.Text+header title location =+ let number = 75 - Text.length title - Text.length location+ dashes = Text.repeat number "-"+ in "-- " ++ Text.toUpper title ++ " " ++ dashes ++ " " ++ location ++ " "++-- PARAGRAPHS++paragraphs :: List Text.Text -> Text.Text+paragraphs =+ Text.join blank
+ src/Internal/Test.hs view
@@ -0,0 +1,227 @@+{-# LANGUAGE GADTs #-}++module Internal.Test+ ( Test (Describe, Test, Skip, Only, Todo, Fuzz, FromTestTree),+ FuzzerFunction (Fuzzer1, Fuzzer2, Fuzzer3),+ FuzzReplay (FuzzReplay),+ run,+ name,+ hasOnly,+ rejectTestTree,+ )+where++import NriPrelude+import qualified Control.Exception.Safe as Exception+import Control.Monad.IO.Class (MonadIO, liftIO)+import qualified Data.Text+import Fuzz (Fuzzer)+import qualified Hedgehog+import qualified Hedgehog.Internal.Property as Hedgehog.Property+import qualified Hedgehog.Internal.Report as Hedgehog.Report+import qualified Hedgehog.Internal.Runner as Hedgehog.Runner+import qualified Hedgehog.Internal.Seed as Seed+import qualified Internal.Expectation+import Internal.Expectation (Expectation)+import qualified Internal.TestResult+import Internal.TestResult (TestResult)+import List (List)+import qualified List+import Test.Tasty (TestTree)+import qualified Text+import Prelude (IO, Monad, Show, pure, show, traverse)++data Test where+ Test :: Text -> (() -> Expectation TestResult) -> Test+ Describe :: Text -> List Test -> Test+ Skip :: Test -> Test+ Only :: Test -> Test+ Todo :: Text -> Test+ Fuzz :: FuzzerFunction -> Text -> Test+ FromTestTree :: Text -> TestTree -> Test++data FuzzerFunction where+ Fuzzer1 ::+ forall a.+ (Show a) =>+ Fuzzer a ->+ (a -> Expectation TestResult) ->+ FuzzerFunction+ Fuzzer2 ::+ forall a b.+ (Show a, Show b) =>+ Fuzzer a ->+ Fuzzer b ->+ (a -> b -> Expectation TestResult) ->+ FuzzerFunction+ Fuzzer3 ::+ forall a b c.+ (Show a, Show b, Show c) =>+ Fuzzer a ->+ Fuzzer b ->+ Fuzzer c ->+ (a -> b -> c -> Expectation TestResult) ->+ FuzzerFunction++--++-- | The replay token to use for replaying a previous test run+newtype FuzzReplay = FuzzReplay (Maybe (Hedgehog.Size, Hedgehog.Seed))++run :: FuzzReplay -> Test -> IO TestResult+run replay test =+ Exception.handle handleException <| case test of+ Describe _ tests ->+ -- NOTE: Tasty actually never runs this, because it builds it's own tree.+ tests+ |> rejectTestTree+ |> traverse (run replay)+ |> fmap Internal.TestResult.concat+ Test _ testToRun -> Internal.Expectation.toResult (testToRun ())+ Skip _ -> pure Internal.TestResult.skipped+ Only test_ -> run replay test_+ Todo _ -> pure <| Internal.TestResult.failed "TODO"+ FromTestTree _ _ ->+ "This should never happen sorry."+ |> Internal.TestResult.failed+ |> pure+ Fuzz gen _ ->+ genForAll gen+ |> andThen (liftIO << Internal.Expectation.toResult)+ |> andThen (liftIO << Internal.TestResult.throwFailingTest)+ |> handleProperty replay+ |> andThen+ ( \reportStatus ->+ case reportStatus of+ Hedgehog.Report.OK -> pure Internal.TestResult.passed+ Hedgehog.Report.GaveUp ->+ [ "Gave up!",+ "You can rerun this test with the following command:",+ " stack test {package} --test-arguments '--seed \"Size {size} Seed {seed} {seed}\"'",+ "Search for a line containing the word `recheck` to locate the Size and Seed"+ ]+ |> Text.join "\n"+ |> Internal.TestResult.failed+ |> pure+ Hedgehog.Report.Failed+ Hedgehog.Report.FailureReport+ { Hedgehog.Report.failureMessage,+ Hedgehog.Report.failureSeed,+ Hedgehog.Report.failureSize+ } ->+ [ Data.Text.pack failureMessage,+ "You can rerun this test with the following command:",+ " stack test {package} --test-arguments '--seed \""+ ++ Data.Text.pack (show failureSize)+ ++ " "+ ++ Data.Text.pack (show failureSeed)+ ++ "\"'",+ "Search for a line containing the word `recheck` to locate the Size and Seed"+ ]+ |> Text.join "\n"+ |> Internal.TestResult.failed+ |> pure+ )++rejectTestTree :: List Test -> List Test+rejectTestTree tests =+ case tests of+ [] -> []+ FromTestTree _ _ : rest -> rejectTestTree rest+ t : rest -> t : rejectTestTree rest++genForAll ::+ Monad m =>+ FuzzerFunction ->+ Hedgehog.PropertyT m (Expectation TestResult)+genForAll fuzzerFunction =+ case fuzzerFunction of+ Fuzzer1 a cb ->+ map cb (Hedgehog.forAll a)+ Fuzzer2 a b cb ->+ map2+ cb+ (Hedgehog.forAll a)+ (Hedgehog.forAll b)+ Fuzzer3 a b c cb ->+ map3+ cb+ (Hedgehog.forAll a)+ (Hedgehog.forAll b)+ (Hedgehog.forAll c)++handleProperty :: FuzzReplay -> Hedgehog.PropertyT IO () -> IO Hedgehog.Report.Result+handleProperty (FuzzReplay replay) prop =+ case replay of+ Nothing -> Hedgehog.property prop |> checkProperty+ Just (size, seed) -> Hedgehog.property prop |> recheck size seed++-- | Check a property using a specific size and seed.+recheck :: MonadIO m => Hedgehog.Size -> Hedgehog.Seed -> Hedgehog.Property -> m Hedgehog.Report.Result+recheck size seed prop0 =+ Hedgehog.withTests 1 prop0+ |> checkHedgehog size seed+ |> liftIO++checkProperty :: MonadIO m => Hedgehog.Property -> m Hedgehog.Report.Result+checkProperty prop = liftIO <| do+ seed <- Seed.random+ checkHedgehog 0 seed prop++checkHedgehog ::+ MonadIO m =>+ Hedgehog.Size ->+ Hedgehog.Seed ->+ Hedgehog.Property ->+ m Hedgehog.Report.Result+checkHedgehog+ size+ seed+ Hedgehog.Property.Property+ { Hedgehog.Property.propertyConfig,+ Hedgehog.Property.propertyTest+ } =+ Hedgehog.Runner.checkReport propertyConfig size seed propertyTest (\_ -> pure ())+ |> map Hedgehog.Report.reportStatus+ |> liftIO++handleException :: Exception.SomeException -> IO TestResult+handleException exception =+ let exceptionMessage =+ exception+ |> Exception.displayException+ |> Data.Text.pack+ in [ "There was an unexpected exception!",+ "",+ " " ++ exceptionMessage,+ ""+ ]+ |> Data.Text.unlines+ |> Internal.TestResult.failed+ |> pure++name :: Test -> Text+name test =+ case test of+ Test n _ -> n+ Describe n _ -> n+ Skip test_ -> name test_+ Only test_ -> name test_+ Todo n -> n+ FromTestTree n _ -> n+ Fuzz _ n -> n++hasOnly :: Test -> Maybe Test+hasOnly test =+ case test of+ Only t -> Just t+ Test _ _ -> Nothing+ Describe _ tests ->+ tests+ |> rejectTestTree+ |> List.filterMap hasOnly+ |> List.head+ Skip _ -> Nothing+ Todo _ -> Nothing+ FromTestTree _ _ -> Nothing+ Fuzz {} -> Nothing
+ src/Internal/TestResult.hs view
@@ -0,0 +1,108 @@+module Internal.TestResult+ ( TestResult (Passed, Failed, Skipped),+ TestFailure (TestFailure),+ concat,+ join,+ passed,+ failed,+ skipped,+ onFail,+ fromPredicate,+ throwFailingTest,+ )+where++import Control.Exception.Safe (Exception, throwIO)+import Data.Dynamic (Typeable)+import qualified Data.Text+import List (List)+import qualified List+import NriPrelude+import qualified Pretty.Diff as Diff+import qualified System.Console.Terminal.Size as Terminal+import qualified Text+import qualified Text.Show.Pretty+import Prelude (IO, Monoid, Semigroup ((<>)), Show, pure, show)++data TestResult+ = Passed+ | Skipped+ | Failed TestFailure++passed :: TestResult+passed = Passed++failed :: Text -> TestResult+failed = Failed << TestFailure++skipped :: TestResult+skipped = Skipped++onFail :: Text -> TestResult -> TestResult+onFail message result =+ case result of+ Passed -> result+ Skipped -> result+ Failed _ -> failed message++concat :: List TestResult -> TestResult+concat xs =+ case xs of+ [] -> Passed+ x : rest -> join x (concat rest)++join :: TestResult -> TestResult -> TestResult+join a b =+ case (a, b) of+ (Passed, Passed) -> Passed+ (Passed, Failed x) -> Failed x+ (Passed, Skipped) -> Skipped+ (Failed x, Failed y) -> Failed (x <> y)+ (Failed x, Passed) -> Failed x+ (Failed x, Skipped) -> Failed x+ (Skipped, Skipped) -> Skipped+ (Skipped, Passed) -> Skipped+ (Skipped, Failed x) -> Failed x++fromPredicate :: Show a => (a -> a -> Bool) -> Text -> a -> a -> IO TestResult+fromPredicate pred funcName actual expected =+ if pred actual expected+ then pure Passed+ else do+ window <- Terminal.size+ let terminalWidth = case window of+ Just Terminal.Window {Terminal.width} -> width - 4 -- indentation+ Nothing -> 80+ Diff.pretty+ Diff.Config+ { Diff.separatorText = Just funcName,+ Diff.wrapping = Diff.Wrap terminalWidth+ }+ (PrettyShow expected)+ (PrettyShow actual)+ |> failed+ |> pure++newtype PrettyShow a = PrettyShow a++instance Show a => Show (PrettyShow a) where+ show (PrettyShow x) = Text.Show.Pretty.ppShow x++-- | Error generated when a test expectation is not met.+newtype TestFailure = TestFailure Text+ deriving (Typeable, Semigroup, Monoid)++instance Exception TestFailure++instance Show TestFailure where+ show (TestFailure err) = Data.Text.unpack (indent err)++throwFailingTest :: TestResult -> IO ()+throwFailingTest result =+ case result of+ Passed -> pure ()+ Skipped -> pure ()+ Failed err -> throwIO err++indent :: Text -> Text+indent = Data.Text.lines >> List.map (" " <>) >> Text.join "\n"
+ src/List.hs view
@@ -0,0 +1,425 @@+-- | You can create a @List@ in Elm with the @[1,2,3]@ syntax, so lists are used all over the place. This module has a bunch of functions to help you work with them!+module List+ ( List,++ -- * Create+ singleton,+ repeat,+ range,++ -- * Transform+ map,+ indexedMap,+ foldl,+ foldr,+ filter,+ filterMap,++ -- * Utilities+ length,+ reverse,+ member,+ all,+ any,+ maximum,+ minimum,+ sum,+ product,++ -- * Combine+ append,+ concat,+ concatMap,+ intersperse,+ map2,+ map3,+ map4,+ map5,++ -- * Sort+ sort,+ sortBy,+ sortWith,++ -- * Deconstruct+ isEmpty,+ head,+ tail,+ take,+ drop,+ partition,+ unzip,+ )+where++import Basics ((-), (>>), Bool (..), Int, Num, Ord, Ordering (..))+import qualified Data.Foldable+import qualified Data.List+import qualified Data.Maybe+import qualified Internal.Shortcut as Shortcut+import Maybe (Maybe (..))+import qualified Prelude++-- | In Haskell a list type is defined using square brackets. This alias allows+-- us to alternatively write the type like we would in Elm.+type List a = [a]++-- CREATE++-- | 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 =+ Prelude.fromIntegral >> Data.List.replicate++-- | 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 =+ [lo .. hi]++-- TRANSFORM++-- | 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]+--+-- So @map func [ a, b, c ]@ is the same as @[ func a, func b, func c ]@+map :: (a -> b) -> List a -> List b+map =+ Shortcut.map++-- | Same as @map@ but the function is also applied to the index of each element+-- (starting at zero).+--+-- > indexedMap Tuple.pair ["Tom","Sue","Bob"] == [ (0,"Tom"), (1,"Sue"), (2,"Bob") ]+indexedMap :: (Int -> a -> b) -> List a -> List b+indexedMap f xs =+ map2 f [0 .. (length xs - 1)] xs++-- | Reduce a list from the left.+--+-- > foldl (+) 0 [1,2,3] == 6+-- > foldl (::) [] [1,2,3] == [3,2,1]+--+-- So @foldl step state [1,2,3]@ is like saying:+--+-- > state+-- > |> step 1+-- > |> step 2+-- > |> step 3+--+-- Note: This function is implemented using fold' to eagerly evaluate the+-- accumulator, preventing space leaks.+foldl :: (a -> b -> b) -> b -> List a -> b+foldl func =+ Data.List.foldl' (\a b -> func b a)++-- | Reduce a list from the right.+--+-- > foldr (+) 0 [1,2,3] == 6+-- > foldr (::) [] [1,2,3] == [1,2,3]+--+-- So @foldr step state [1,2,3]@ is like saying:+--+-- > state+-- > |> step 3+-- > |> step 2+-- > |> step 1+foldr :: (a -> b -> b) -> b -> List a -> b+foldr =+ Data.List.foldr++-- | Keep elements that satisfy the test.+--+-- > filter isEven [1,2,3,4,5,6] == [2,4,6]+filter :: (a -> Bool) -> List a -> List a+filter =+ Data.List.filter++-- | Filter out certain values. For example, maybe you have a bunch of strings+-- from an untrusted source and you want to turn them into numbers:+--+-- > numbers : List Int+-- > numbers =+-- > filterMap String.toInt ["3", "hi", "12", "4th", "May"]+-- > -- numbers == [3, 12]+filterMap :: (a -> Maybe b) -> List a -> List b+filterMap =+ Data.Maybe.mapMaybe++-- UTILITIES++-- | Determine the length of a list.+--+-- > length [1,2,3] == 3+length :: List a -> Int+length =+ Data.List.length >> Prelude.fromIntegral++-- | Reverse a list.+-- > reverse [1,2,3,4] == [4,3,2,1]+reverse :: List a -> List a+reverse =+ Data.List.reverse++-- | Figure out whether a list contains a value.+--+-- > member 9 [1,2,3,4] == False+-- > member 4 [1,2,3,4] == True+member :: Prelude.Eq a => a -> List a -> Bool+member =+ Data.List.elem++-- | Determine if all elements satisfy some test.+--+-- > all isEven [2,4] == True+-- > all isEven [2,3] == False+-- > all isEven [] == True+all :: (a -> Bool) -> List a -> Bool+all =+ Data.List.all++-- | Determine if any elements satisfy some test.+--+-- > any isEven [2,3] == True+-- > any isEven [1,3] == False+-- > any isEven [] == False+any :: (a -> Bool) -> List a -> Bool+any =+ Data.List.any++-- | Find the maximum element in a non-empty list.+--+-- > maximum [1,4,2] == Just 4+-- > maximum [] == Nothing+maximum :: Ord a => List a -> Maybe a+maximum list =+ case list of+ [] ->+ Nothing+ _ ->+ Just (Data.List.maximum list)++-- | Find the minimum element in a non-empty list.+--+-- > minimum [3,2,1] == Just 1+-- > minimum [] == Nothing+minimum :: Ord a => List a -> Maybe a+minimum list =+ case list of+ [] ->+ Nothing+ _ ->+ Just (Data.List.minimum list)++-- | Get the sum of the list elements.+--+-- > sum [1,2,3,4] == 10+sum :: Num a => List a -> a+sum =+ Data.Foldable.sum++-- | Get the product of the list elements.+--+-- > product [1,2,3,4] == 24+product :: Num a => List a -> a+product =+ Data.Foldable.product++-- COMBINE++-- | 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 to append lists.+append :: List a -> List a -> List a+append =+ Prelude.mappend++-- | 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 =+ Prelude.mconcat++-- | 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 =+ Shortcut.andThen++-- | 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 =+ Data.List.intersperse++-- | Combine two lists, combining them with the given function.+-- If one list is longer, the extra elements are dropped.+--+-- > totals : List Int -> List Int -> List Int+-- > totals xs ys =+-- > List.map2 (+) xs ys+-- >+-- > -- totals [1,2,3] [4,5,6] == [5,7,9]+-- >+-- > pairs : List a -> List b -> List (a,b)+-- > pairs xs ys =+-- > List.map2 Tuple.pair xs ys+-- >+-- > -- pairs ["alice","bob","chuck"] [2,5,7,8]+-- > -- == [("alice",2),("bob",5),("chuck",7)]+--+-- __NOTE:__ This behaves differently than @NriPrelude.Internal.map2@, which produces+-- all combinations of elements from both lists.+map2 :: (a -> b -> result) -> List a -> List b -> List result+map2 =+ Data.List.zipWith++-- | __NOTE:__ This behaves differently than @NriPrelude.Internal.map3@, which produces+-- all combinations of elements from all lists.+map3 :: (a -> b -> c -> result) -> List a -> List b -> List c -> List result+map3 =+ Data.List.zipWith3++-- | __NOTE:__ This behaves differently than @NriPrelude.Internal.map4@, which produces+-- all combinations of elements from all lists.+map4 :: (a -> b -> c -> d -> result) -> List a -> List b -> List c -> List d -> List result+map4 =+ Data.List.zipWith4++-- | __NOTE:__ This behaves differently than @NriPrelude.Internal.map5@, which produces+-- all combinations of elements from all lists.+map5 :: (a -> b -> c -> d -> e -> result) -> List a -> List b -> List c -> List d -> List e -> List result+map5 =+ Data.List.zipWith5++-- SORT++-- | Sort values from lowest to highest+--+-- > sort [3,1,5] == [1,3,5]+sort :: Ord a => List a -> List a+sort =+ Data.List.sort++-- | 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 :: Ord b => (a -> b) -> List a -> List a+sortBy =+ Data.List.sortOn++-- | 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 -> Ordering) -> List a -> List a+sortWith =+ Data.List.sortBy++-- DECONSTRUCT++-- | Determine if a list is empty.+--+-- > isEmpty [] == True+--+-- **Note:** It is usually preferable to use a @case@ to test this so you do not+-- forget to handle the @(x :: xs)@ case as well!+isEmpty :: List a -> Bool+isEmpty =+ Data.List.null++-- | Extract the first element of a list.+--+-- > head [1,2,3] == Just 1+-- > head [] == Nothing+--+-- **Note:** It is usually preferable to use a @case@ to deconstruct a @List@+-- because it gives you @(x :: xs)@ and you can work with both subparts.+head :: List a -> Maybe a+head xs =+ case xs of+ x : _ ->+ Just x+ [] ->+ Nothing++-- | Extract the rest of the list.+--+-- > tail [1,2,3] == Just [2,3]+-- > tail [] == Nothing+--+-- **Note:** It is usually preferable to use a @case@ to deconstruct a @List@+-- because it gives you @(x :: xs)@ and you can work with both subparts.+tail :: List a -> Maybe (List a)+tail list =+ case list of+ _ : xs ->+ Just xs+ [] ->+ Nothing++-- | Take the first *n* members of a list.+--+-- > take 2 [1,2,3,4] == [1,2]+take :: Int -> List a -> List a+take =+ Prelude.fromIntegral >> Data.List.take++-- | Drop the first *n* members of a list.+--+-- > drop 2 [1,2,3,4] == [3,4]+drop :: Int -> List a -> List a+drop =+ Prelude.fromIntegral >> Data.List.drop++-- | Partition a list based on some test. The first list contains all values+-- that satisfy the test, 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 =+ Data.List.partition++-- | 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 =+ Data.List.unzip
+ src/Log.hs view
@@ -0,0 +1,256 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE GADTs #-}++-- | This module is dedicated to logging information in production, to help+-- understand what the application is doing when something goes wrong. This sets+-- it apart from the @Debug@ module which provide helpers for debugging problems+-- in development.+--+-- This module does not have an Elm counterpart.+module Log+ ( -- * Logging+ info,+ userIsAnnoyed,+ userIsConfused,+ userIsPained,+ userIsBlocked,+ withContext,+ context,++ -- * Secrets+ Secret,+ mkSecret,+ unSecret,++ -- * For use in observability modules+ Context (..),+ LogContexts (..),+ TriageInfo (..),+ Impact (..),+ )+where++import Data.Aeson ((.=))+import qualified Data.Aeson as Aeson+import GHC.Generics (Generic)+import qualified GHC.Stack as Stack+import NriPrelude+import qualified Platform+import qualified Platform.Internal as Internal+import qualified Task+import qualified Text.Show+import qualified Prelude++-- | A log message useful for when things have gone off the rails.+-- We should have a ton of messages at this level.+-- It should help us out when we're dealing with something hard.+--+-- In addition to a log message you can pass additional key-value pairs with+-- information that might be relevant for debugging.+--+-- info "I added 1 and 1" [context "answer" 2]+info :: Stack.HasCallStack => Text -> [Context] -> Task e ()+info message contexts = Stack.withFrozenCallStack log message True contexts++-- | A log message when the user is annoyed, but not blocked.+--+-- Log.userIsAnnoyed+-- "We poked the user unnecessarily."+-- "Try to stop poking the user."+-- [ Log.context "The type of poking stick" poker ]+userIsAnnoyed :: Stack.HasCallStack => Text -> Text -> [Context] -> Task e ()+userIsAnnoyed message advisory contexts =+ let triage = TriageInfo UserAnnoyed advisory+ in Stack.withFrozenCallStack+ log+ message+ False+ (Context "triage" triage : contexts)++-- | Like @userIsAnnoyed@, but when the user is userIsConfused.+userIsConfused :: Stack.HasCallStack => Text -> Text -> [Context] -> Task e ()+userIsConfused message advisory contexts =+ let triage = TriageInfo UserConfused advisory+ in Stack.withFrozenCallStack+ log+ message+ False+ (Context "triage" triage : contexts)++-- | Like @userIsAnnoyed@, but when the user is in pain.+userIsPained :: Stack.HasCallStack => Text -> Text -> [Context] -> Task e ()+userIsPained message advisory contexts =+ let triage = TriageInfo UserInPain advisory+ in Stack.withFrozenCallStack+ log+ message+ False+ (Context "triage" triage : contexts)++-- | Like @userIsAnnoyed@, but when the user is blocked.+userIsBlocked :: Stack.HasCallStack => Text -> Text -> [Context] -> Task e ()+userIsBlocked message advisory contexts =+ let triage = TriageInfo UserBlocked advisory+ in Stack.withFrozenCallStack+ log+ message+ False+ (Context "triage" triage : contexts)++-- | Mark a block of code as a logical unit by giving it a name. This name will+-- be used in logs and monitoring dashboards, so use this function to help+-- debug production problems.+--+-- In addition to a name you can pass this function a list of context. A+-- context is a key-value pair you want to attach to all logs made inside of+-- the block of code wrapped.+--+-- Example usage:+--+-- withContext "play-music" [context "artist" "The Beatles"] <| do+-- -- your code here!+--+-- Additionally, this function adds an entry to our homemade stack trace for if something errors.+-- Why not use the built-in stack trace? Well, the built-in stack trace only records a frame if you+-- add @Stack.HasCallStack =>@ to the function, so if we want a full stack trace, we need to add+-- that to literally all functions. Instead of doing that, we will use @withContext@ to collect+-- the stack trace, since it is used fairly often already. It will not be complete either, but+-- it's the best we can do without too much trouble.+withContext ::+ Stack.HasCallStack =>+ Text ->+ [Context] ->+ Task e b ->+ Task e b+withContext name contexts task =+ Stack.withFrozenCallStack+ Internal.tracingSpan+ name+ ( Platform.finally+ task+ (Platform.setTracingSpanDetails (LogContexts contexts))+ )++--+-- CONTEXT+--++-- | A key-value pair that can be added to a log context. All log expressions+-- within the context will always log this key-value pair.+context :: (Aeson.ToJSON a) => Text -> a -> Context+context = Context++-- | Extra information to attach to a log message. It is passed a string key+-- defining what the data is and a value with a @ToJSON@ instance.+data Context where+ Context :: Aeson.ToJSON a => Text -> a -> Context++-- | A set of log contexts.+newtype LogContexts+ = LogContexts [Context]++instance Aeson.ToJSON LogContexts where+ toJSON (LogContexts contexts) =+ contexts+ |> map (\(Context key val) -> key .= val)+ |> Aeson.object++ toEncoding (LogContexts contexts) =+ contexts+ |> Prelude.foldMap (\(Context key val) -> key .= val)+ |> Aeson.pairs++instance Internal.TracingSpanDetails LogContexts++--+-- SECRET+--++-- | Wrap a value in a secret to prevent it from being accidentally logged.+--+-- Debug.log "Logging a secret" (mkSecret "My PIN is 1234")+-- --> Logging a secret: Secret *****+mkSecret :: a -> Secret a+mkSecret = Secret++-- | Retrieve the original value from a secret. Be very careful with this and ask+-- yourself: is there really no way I can pass this value on as a secret+-- further before I need to unwrap it?+--+-- The longer a value is wrapped in a Secret, the smaller the odds of it+-- accidentally being logged.+unSecret :: Secret a -> a+unSecret (Secret x) = x++-- | Distinguishes data that is secret and should not be logged.+--+-- Please be careful when defining or altering instances for this data type.+-- There's a good chance we will leak credentials, PII, or+-- other equally sensitive information.+newtype Secret a+ = Secret a+ deriving (Prelude.Eq, Prelude.Functor)++instance Prelude.Applicative Secret where+ Secret f <*> Secret x = Secret (f x)++ pure = Secret++-- | N.B. This instance of 'Show' is not law abiding.+--+-- This instance exists because we sometimes use 'Secret' in data types+-- that have to derive 'Show' (due to other constraints on those data types).+--+-- This is not a pattern to follow; it's an exception.+instance Show (Secret a) where+ showsPrec p _ =+ Text.Show.showParen (p > 10) (Text.Show.showString "Secret \"*****\"")++instance Aeson.ToJSON (Secret a) where+ toJSON _ = Aeson.String "Secret *****"++--+-- TRIAGE+--++-- | A logged message for log levels warning and above. Because these levels+-- indicate a (potential) problem we want to provide some additional data that+-- would help a triager figure out what next steps to take.+data TriageInfo+ = TriageInfo+ { impact :: Impact,+ advisory :: Text+ }+ deriving (Generic)++instance Aeson.ToJSON TriageInfo++-- | Classification of the levels of impact an issue might have on end-users.+data Impact+ = UserAnnoyed+ | UserConfused+ | UserInPain+ | UserBlocked+ deriving (Show)++instance Aeson.ToJSON Impact where+ toJSON = Aeson.toJSON << impactToText++ toEncoding = Aeson.toEncoding << impactToText++impactToText :: Impact -> Text+impactToText kind =+ case kind of+ UserAnnoyed -> "This is causing inconveniences to users but they will be able to achieve want they want."+ UserBlocked -> "User is blocked from performing an action."+ UserConfused -> "The UI did something unexpected and it's unclear why."+ UserInPain -> "This is causing pain to users and workaround is not obvious."++log :: Stack.HasCallStack => Text -> Bool -> [Context] -> Task e ()+log msg succeeded contexts =+ Internal.tracingSpan msg <| do+ Platform.setTracingSpanDetails (LogContexts contexts)+ if succeeded+ then Task.succeed ()+ else Platform.markTracingSpanFailed
+ src/Maybe.hs view
@@ -0,0 +1,122 @@+-- | 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.+module Maybe+ ( -- * Definition+ Maybe (..),++ -- * Common Helpers+ withDefault,+ map,+ map2,+ map3,+ map4,+ map5,++ -- * Chaining Maybes+ andThen,+ )+where++import Data.Maybe (Maybe (..), fromMaybe)+import qualified Internal.Shortcut as Shortcut++-- | Provide a default value, turning an optional value into a normal+-- value. This comes in handy when paired with functions like+-- 'Dict.get' which gives back a @Maybe@.+--+-- > >>> withDefault 100 (Just 42)+-- > 42+-- > >>> withDefault 100 Nothing+-- > 100+-- > >>> withDefault "unknown" (Dict.get "Tom" Dict.empty)+-- > "unknown"+--+-- __Note:__ This can be overused! Many cases are better handled by a @case@+-- expression. And if you end up using @withDefault@ a lot, it can be a good sign+-- that a [custom type](https://guide.elm-lang.org/types/custom_types.html)+-- will clean your code up quite a bit!+withDefault :: a -> Maybe a -> a+withDefault =+ Data.Maybe.fromMaybe++-- | Transform a @Maybe@ value with a given function:+--+-- > >>> map sqrt (Just 9)+-- > Just 3+-- > >>> map sqrt Nothing+-- > Nothing+-- > >>> map sqrt (String.toFloat "9")+-- > Just 3+-- > >>> map sqrt (String.toFloat "x")+-- > Nothing+map :: (a -> b) -> Maybe a -> Maybe b+map =+ Shortcut.map++-- | 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 (+) (String.toInt "1") (String.toInt "123")+-- > Just 124+-- > >>> map2 (+) (String.toInt "x") (String.toInt "123")+-- > Nothing+-- > >>> map2 (+) (String.toInt "1") (String.toInt "1.3")+-- > Nothing+map2 :: (a -> b -> value) -> Maybe a -> Maybe b -> Maybe value+map2 =+ Shortcut.map2++-- |+map3 :: (a -> b -> c -> value) -> Maybe a -> Maybe b -> Maybe c -> Maybe value+map3 =+ Shortcut.map3++-- |+map4 :: (a -> b -> c -> d -> value) -> Maybe a -> Maybe b -> Maybe c -> Maybe d -> Maybe value+map4 =+ Shortcut.map4++-- |+map5 :: (a -> b -> c -> d -> e -> value) -> Maybe a -> Maybe b -> Maybe c -> Maybe d -> Maybe e -> Maybe value+map5 =+ Shortcut.map5++-- | Chain together many computations that may fail. It is helpful to see an+-- equivalent 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 parse some user input as a month:+--+-- > parseMonth :: String -> Maybe Int+-- > parseMonth userInput =+-- > String.toInt userInput+-- > |> andThen toValidMonth+-- >+-- > toValidMonth :: Int -> Maybe Int+-- > toValidMonth month =+-- > if 1 <= month && month <= 12 then+-- > Just month+-- >+-- > else+-- > Nothing+--+-- In the @parseMonth' function, if 'String.toInt@ produces @Nothing@ (because+-- the @userInput@ was not an integer) 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 =+ Shortcut.andThen
+ src/NriPrelude.hs view
@@ -0,0 +1,56 @@+{-# OPTIONS_HADDOCK not-home #-}++-- | These are functions and types that in Elm are in scope by default, without+-- needing to import anything. In Haskell we refer to such imports as a+-- "Prelude".+module NriPrelude+ ( -- * Elm Prelude+ Platform.Internal.Task,+ module Basics,+ module Internal.Shortcut,+ List.List,+ Maybe.Maybe (..),+ Result.Result (..),+ Text.Text,+ Char.Char,++ -- * The following exports are Non-Elm, but we can't really do without them.+ Prelude.Show,+ GHC.Generics.Generic,++ -- * We're exposing these so users can define custom Functor, Applicative, and+ -- Monad instances. If you use them outside of type class instance definitions+ -- hlint should ask you to replace them with Elm-ish functions instead.+ fmap,+ (<*>),+ (>>=),+ )+where++-- Elm implicitly imports a variety of names into each module. There isn't a+-- formal "prelude" like in Haskell; it's defined in the language. See+-- https://package.elm-lang.org/packages/elm/core/latest/ for the full list.+--+-- import Basics exposing (..)+-- import List exposing (List, (::))+-- import Maybe exposing (Maybe(..))+-- import Result exposing (Result(..))+-- import String exposing (String)+-- import Char exposing (Char)+-- import Tuple+-- import Debug+import Basics+import qualified Char+import qualified GHC.Generics+import Internal.Shortcut+import qualified List+import qualified Maybe+import qualified Platform.Internal+import qualified Result+import qualified Text+import Prelude+ ( (<*>),+ (>>=),+ fmap,+ )+import qualified Prelude
+ src/Platform.hs view
@@ -0,0 +1,172 @@+-- | This module is for running applications we build using this library, and+-- for integrating external Haskell libraries into our code. You normally+-- shouldn't need to use this module, unless you're building a library or+-- creating a wrapper for an existing Haskell library.+module Platform+ ( -- * Turning a @IO@ type into a @Task@.+ DoAnythingHandler,+ doAnythingHandler,+ doAnything,++ -- * Working with the log handler+ Internal.LogHandler,+ logHandler,+ requestId,+ silentHandler,++ -- * Creating custom tracingSpans in libraries+ Internal.tracingSpan,+ Internal.tracingSpanIO,+ Internal.rootTracingSpanIO,+ Internal.setTracingSpanDetails,+ Internal.setTracingSpanDetailsIO,+ Internal.markTracingSpanFailed,+ Internal.markTracingSpanFailedIO,++ -- * Interpreting tracingSpans for reporting to monitoring platforms+ Internal.TracingSpan (..),+ Internal.Succeeded (..),+ Internal.TracingSpanDetails (..),+ Internal.SomeTracingSpanDetails,+ Internal.Renderer (Renderer),+ Internal.renderTracingSpanDetails,+ Internal.MonotonicTime,+ Internal.inMicroseconds,++ -- * Ensuring cleanup logic gets ran in case of exceptions.+ bracketWithError,+ finally,++ -- * Exception throwing, in rare cases we need it.+ unsafeThrowException,+ )+where++import Basics+import qualified Control.Exception.Safe as Exception+import qualified Control.Monad.Catch as Catch+import qualified Data.Text+import qualified GHC.Stack as Stack+import NriPrelude+import qualified Platform.DoAnything as DoAnything+import qualified Platform.Internal as Internal+import qualified Task+import Prelude (IO, pure)++-- | A value of this type allows you to turn an @IO@ type into a @Task@ using the+-- @doAnything@ function.+--+-- The intended use for this is creating other handlers for running specific+-- types of effects. Suppose you're creating a library for making queries to+-- a database. You might create a @Handler@ type for it like this:+--+-- > data Handler = Handler+-- > { doAnything :: DoAnythingHandler+-- > , host :: Text+-- > , port :: Text+-- > }+--+-- You create this handler in the root of your application and then pass it to+-- wherever you need to perform database requests. Using the @DoAnythingHandler@+-- available to it your library can perform the query, then wrap the resulting+-- @IO@ up in a @Task@.+type DoAnythingHandler = DoAnything.Handler++-- | Get a key that allows you to run arbitrary IO in a @Task@. This key you can+-- then pass to @doAnything@. See the documentation for @DoAnythingHandler@.+doAnythingHandler :: IO DoAnything.Handler+doAnythingHandler = pure DoAnything.Handler++-- | Allow running arbitrary IO in @Task@, but only if you have a license for it.+doAnything :: DoAnything.Handler -> IO (Result e a) -> Task e a+doAnything _ io = Internal.Task (\_ -> io)++-- | @bracket@ allows us to acquire a resource (the first argument), use it (the+-- third argument), and release it afterward (the second argument). Critically,+-- the @release@ phase always runs, even if the use phase fails with an error.+--+-- @bracket@ is defined in the @exceptions@ package for all types+-- implementing the @MonadMask@ type class. We could acquire it for @Task@ by+-- deriving @MonadMask@ for it, but this would require us to implement super+-- classes @MonadThrow@ and @MonadCatch@ for @Task@ as well.+--+-- We don't want to implement @MonadThrow@ for @Task@ because it would allow us+-- to throw exceptions directly in the @IO@ monad hidden in @Task@. These types+-- of exceptions disappear from the types: @IO@ does not have a type parameter+-- indicating possible errors. We want to ensure our own errors end up in the+-- error argument of the @Task@ type, so we don't implement @MonadThrow@.+--+-- The implementation below is mostly taken from the implementation of+-- @generalBracket@ for @ExceptT e m a@ in the @Control.Monad.Catch@ module.+bracketWithError ::+ Task e a ->+ (Internal.Succeeded -> a -> Task e c) ->+ (a -> Task e b) ->+ Task e b+bracketWithError (Internal.Task acquire) release use =+ Internal.Task <| \log -> do+ (eb, ec) <-+ Exception.generalBracket+ (acquire log)+ ( \eresource exitCase ->+ case eresource of+ Err err -> pure (Err err) -- nothing to release, acquire didn't succeed+ Ok resource ->+ case exitCase of+ Catch.ExitCaseSuccess (Ok _) -> Internal._run (release Internal.Succeeded resource) log+ _ -> Internal._run (release Internal.Failed resource) log+ )+ ( \result ->+ case result of+ Err err -> pure (Err err)+ Ok x -> Internal._run (use x) log+ )+ pure <| do+ -- The order in which we perform those two 'Either' effects determines+ -- which error will win if they are both 'Left's. We want the error from+ -- 'release' to win.+ _ <- ec+ eb++-- | Ensure some cleanup logic always run, regardless of whether the task it+-- runs after failed with an exception.+--+-- finally+-- doSomeWork+-- (Log.info "Finished doing work." [])+finally :: Task e a -> Task e b -> Task e a+finally run cleanup =+ bracketWithError+ (Task.succeed ())+ (\_ _ -> cleanup)+ (\_ -> run)++-- |+-- Access the log handler in a task.+logHandler :: Task e Internal.LogHandler+logHandler = Internal.Task (pure << Ok)++-- | Get the ID of the current request.+requestId :: Task e Text+requestId = map Internal.requestId logHandler++-- | A log handler that doesn't log anything.+silentHandler :: IO Internal.LogHandler+silentHandler = Internal.mkHandler "" (Internal.Clock (pure 0)) (\_ -> pure ()) ""++-- | Throw a runtime exception that cannot be caught. This function, like+-- @Debug.todo@, breaks type level guarantees and should be avoided. Where+-- possible use a type like @Result@ or @Task@ that explicitly handlers errors.+--+-- Some external libraries and API depend on sometimes require us to throw+-- errors. When that is the case prefer this function over different ways to+-- throw an exception in @Control.Exception@, because it results in better logs+-- for those who'll need to investigate these problems.+unsafeThrowException ::+ Stack.HasCallStack =>+ Text ->+ Task e a+unsafeThrowException title =+ Internal.Task+ <| \_ ->+ Exception.throwString (Data.Text.unpack title)
+ src/Platform/DoAnything.hs view
@@ -0,0 +1,43 @@+module Platform.DoAnything+ ( Handler (Handler),+ )+where++-- |+-- tldr; Having a value of this type represents an allowance to run any @IO@ in+-- the @Task@ type. Intended for use in effects packages only.+--+-- Longer explanation:+--+-- One of our goals with creating a shared @Task@ type is that our libraries+-- can all use it. Instead of returning polymorphic values like:+--+-- (MonadError e m, Monad IO m) => m a+--+-- We could instead let our libraries return @Task e m@. Looks simpler, no?+--+-- But for this to fly our libraries will need to be able to run @IO@ in+-- @Task@. The postgres library for example will want to talk to the+-- database. How should it take a @IO a@ returned from @postgresql-typed@+-- and turn it into an @Task e a@ to return to the library user?+--+-- @MonadIO@ is intended for this stuff. By deriving it for our @Task@ type+-- we could use @liftIO@ to take an @IO a@ value and turn it into @Task e a@.+-- But any part of the code could do this, and we'd like to restrict+-- ourselves from running IO in our applications to functions that take a+-- handler, indicating the type of effect they perform.+--+-- This commit uses the handler pattern to restrict access to arbitrary IO+-- in @Task@: You can turn an @IO a@ into a @Task e a@, but only if you can+-- submit a @Handler@ to proof you're allowed. Are libraries will+-- be allowed, but our applications not.+--+-- You can only get a handler wrapped in an @IO@. This means you+-- can only use it in an environment where you can perform arbitrary IO. We+-- cannot extract the value from a @Data.Acquire@ in our @Task@ code, but we can+-- use it to generate handlers for other packages. The Postgres package for+-- example can store the @Handler@ in its @Connection@ handler, and+-- so whenever Postgres is passed a @Connection@ to perform a query, it also+-- has access to the @Handler@ necessary to perform IO.+data Handler+ = Handler
+ src/Platform/Internal.hs view
@@ -0,0 +1,601 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE RankNTypes #-}++module Platform.Internal where++import Basics+import Control.Applicative ((<|>))+import qualified Control.AutoUpdate as AutoUpdate+import qualified Control.Exception.Safe as Exception+import qualified Data.Aeson as Aeson+import qualified Data.IORef as IORef+import qualified Data.Text+import qualified Data.Typeable as Typeable+import qualified GHC.Clock as Clock+import qualified GHC.Stack as Stack+import qualified GHC.Word+import qualified Internal.Shortcut as Shortcut+import Internal.Shortcut (andThen, map)+import qualified List+import Maybe (Maybe (..))+import Result (Result (Err, Ok))+import Text (Text)+import qualified Tuple+import Prelude+ ( Applicative ((<*>), pure),+ Functor,+ IO,+ Monad ((>>=)),+ )+import qualified Prelude++--+-- TASK+--++-- | Here are some common tasks:++-- - @now : Task x Posix@+-- - @query : String -> Task Error ()@+-- - @sleep : Float -> Task x ()@+--+-- In each case we have a Task that will resolve successfully with an a value+-- or unsuccessfully with an x value. So Postgres.query may fail with an Error+-- if the query is invalid. Whereas Time.now never fails so I cannot be more+-- specific than x. No such value will ever exist! Instead it always succeeds+-- with the current POSIX time.+--+-- More generally a task is a /description/ of what you need to do. Like a todo+-- list. Or like a grocery list. Or like GitHub issues. So saying "the task is+-- to tell me the current POSIX time" does not complete the task! You need+-- 'perform' tasks or 'attempt' tasks.+newtype Task x a+ = Task {_run :: LogHandler -> IO (Result x a)}+ deriving (Functor)++instance Applicative (Task a) where+ pure a =+ Task (\_ -> Prelude.pure (Ok a))++ (<*>) func task =+ Task <| \key ->+ let onResult resultFunc resultTask =+ case (resultFunc, resultTask) of+ (Ok func_, Ok task_) ->+ Ok (func_ task_)+ (Err x, _) ->+ Err x+ (_, Err x) ->+ Err x+ in do+ func_ <- _run func key+ task_ <- _run task key+ pure (onResult func_ task_)++instance Monad (Task a) where+ task >>= func =+ Task <| \key ->+ let onResult result =+ case result of+ Ok ok ->+ _run (func ok) key+ Err err ->+ pure (Err err)+ in _run task key |> andThen onResult++--+-- SPAN+--++-- | A @TracingSpan@ contains debugging information related to a section of the+-- program. TracingSpans can be nested inside other tracingSpans to form a+-- tree, each tracingSpan representing part of the execution of the program.+-- This format is a typical way to store tracing data. Check out this section+-- of the documentation on the open tracing standard for a good introduction on+-- tracing data and tracingSpans:+--+-- https://github.com/opentracing/specification/blob/master/specification.md#the-opentracing-data-model+--+-- From tracingSpans we can derive many other formats of debugging information:+--+-- - Logs are tracingSpans flattened into a series of events ordered by time. For+-- example, consider the following tracingSpans:+--+-- do the laundry 11:00-12:15+-- wash clothes 11:00-12:00+-- hang clothes to dry 12:00-12:15+--+-- we could recover the following logs from this:+--+-- 11:00 starting do the laundry+-- 11:00 wash clothes+-- 12:00 hang clothes to dry+-- 12:15 finishing do the laundry+--+-- - Metrics are rolling statistics on tracingSpans. For example, we can+-- increment a counter every time we see a particular tracingSpan pass by.+--+-- So whether we're looking for tracing data, logs, or metrics, tracingSpans+-- got us covered.+data TracingSpan+ = TracingSpan+ { -- | A description of this tracingSpan. This should not contain any+ -- dynamically generated strings to make grouping tracingSpans easy.+ -- Any contextual info should go into 'details'.+ name :: Text,+ -- | The time this tracingSpan started.+ started :: MonotonicTime,+ -- | The time this tracingSpan finished.+ finished :: MonotonicTime,+ -- | The source code location of this tracingSpan. The first @Text@ is+ -- the name of the function getting called.+ frame :: Maybe (Text, Stack.SrcLoc),+ -- | Unique information for this tracingSpan.+ details :: Maybe SomeTracingSpanDetails,+ -- | Whether this tracingSpan succeeded. If any of the children of this+ -- tracingSpan failed, so will this tracingSpan. This will create a+ -- path to the tracingSpan closest to the failure from the root+ -- tracingSpan.+ succeeded :: Succeeded,+ -- | Any subtracingSpans nested inside this tracingSpan. These are+ -- ordered in reverse chronological order, so most recent tracingSpan+ -- first, because it's cheaper to append new tracingSpans onto the left+ -- of the list.+ children :: [TracingSpan]+ }+ deriving (Prelude.Show)++-- | The @Succeeded@ type is used to indicate whether or not a particular+-- @TracingSpan@ ran without encountering user-facing problems.+data Succeeded+ = -- | A tracingSpan that didn't fail with an unexpected exception, or was+ -- explicitly marked as failed by the user.+ --+ -- When a tracingSpan returns a failed task we do not count that as @Failed@+ -- here, because a failed task might be part of normal program+ -- operation. We wouldn't want to log those kinds of failures as errors.+ Succeeded+ | -- | A tracingSpan marked as failed by a user, for example by logging with a+ -- high severity to indicate a user is in pain.+ Failed+ | -- | A tracingSpan that failed with an unhandled exception thrown by the+ -- Haskell runtime or a library.+ FailedWith Exception.SomeException+ deriving (Prelude.Show)++-- | If the first bit of code succeeded and the second failed, the combination+-- of the two has failed as well. The @SemiGroup@ and @Monoid@ type instances+-- for @Succeeded@ allow us to combine @Succeeded@ values in such a fashion.+--+-- The rule expressed here is that the Succeeded value of a combination of+-- computations if the same as the worst thing that happened to any of the+-- individual computations.+instance Prelude.Semigroup Succeeded where+ FailedWith err <> _ = FailedWith err+ _ <> FailedWith err = FailedWith err+ Failed <> _ = Failed+ _ <> Failed = Failed+ _ <> _ = Succeeded++instance Prelude.Monoid Succeeded where+ mempty = Succeeded++--+-- SPAN DETAILS+--++-- | A wrapper around the various types that specify details for different kinds+-- of tracingSpans.+--+-- Depending on what happens within a tracingSpan we want to log different+-- information for debugging. A tracingSpan for a database query might include+-- the SQL of the query, and a tracingSpan for an HTTP request the URL the+-- request is addressed to.+--+-- We could define a single @SomeTracingSpanDetails@ type that can represent all+-- of these different types of details. One way would be to write a union:+--+-- data SomeTracingSpanDetails+-- = Sql SqlDetails+-- | Http HttpDetails+-- | ...+--+-- The disadvantage of this is that nri-prelude will have to know about every+-- possible type of tracingSpan. If a library wanted to log new information it+-- would have to change @nri-prelude@ first to support this. That's a barrier to+-- adding useful logging information we'd prefer not to have.+--+-- Another approach is to have the details field take arbitrary JSON:+--+-- type SomeTracingSpanDetails = Data.Aeson.Value+--+-- This allows any library to log what it wants without requiring any changes in+-- nri-prelude. However, unless we parse that JSON back into the original types+-- (which is wasteful and can fail) we have lost the ability to render specific+-- bits of information in special ways. If we provide Bugsnag with the stack+-- trace of an error it will present it nicely in its UI. NewRelic can treat SQL+-- strings of queries in a special way. But we don't have stack traces or SQL+-- strings to give, just opaque JSON blobs.+--+-- We'd like to both let libraries define custom detail types _and_ be able to+-- read specific fields from those types in loggers that present certain bits of+-- information in nice ways. To do that we allow a bit of type magic here.+-- Analogous to Haskell's @SomeException@ type and @Exception@ type class, we+-- define a @SomeTracingSpanDetails@ type and @TracingSpanDetails@ type class.+--+-- The SomeTracingSpanDetails type can wrap any custom type, as long as it has+-- @TracingSpanDetails@ instance. The @TracingSpanDetails@ instance allows us+-- to recover the original details type if we want to treat it special in a+-- custom logger.+data SomeTracingSpanDetails where+ SomeTracingSpanDetails :: (TracingSpanDetails a) => a -> SomeTracingSpanDetails++instance Aeson.ToJSON SomeTracingSpanDetails where+ toJSON (SomeTracingSpanDetails details) = Aeson.toJSON details++ toEncoding (SomeTracingSpanDetails details) = Aeson.toEncoding details++instance TracingSpanDetails SomeTracingSpanDetails where+ toTracingSpanDetails details = details++ fromTracingSpanDetails = Just++instance Prelude.Show SomeTracingSpanDetails where+ show (SomeTracingSpanDetails details) =+ Aeson.encode details+ |> Prelude.show++-- | Every type we want to use as tracingSpan metadata needs a+-- @TracingSpanDetails@ instance. The @TracingSpanDetails@ class fulfills+-- these roles:+--+-- - It allows for conversion between the custom details type and the+-- @SomeTracingSpanDetails@ type stored in a @TracingSpan@.+-- - It requires the custom details type to also have a @ToJSON@ instance.+--+-- This gives a logger two options for rendering a @SomeTracingSpanDetails@+-- value into a format understood by a monitoring tool:+--+-- - It can try @fromTracingSpanDetails@ to try to recover one of the custom+-- tracingSpan details types it has implemented custom rendering logic for.+-- - If this particular tracingSpan details type is unknown to this particular+-- logger, it can obtain always obtain a generic JSON blob of the information+-- instead.+class (Typeable.Typeable e, Aeson.ToJSON e) => TracingSpanDetails e where+ toTracingSpanDetails :: e -> SomeTracingSpanDetails+ toTracingSpanDetails = SomeTracingSpanDetails++ fromTracingSpanDetails :: SomeTracingSpanDetails -> Maybe e+ fromTracingSpanDetails (SomeTracingSpanDetails d) = Typeable.cast d++-- | A helper type used for @renderTracingSpanDetails@. Used to wrap rendering+-- functions so they have the same type and can be put in a list together.+data Renderer a where+ Renderer :: TracingSpanDetails s => (s -> a) -> Renderer a++-- | In reporting logic we'd like to case on the different types a+-- 'SomeTracingSpanDetails' can contain and write logic for each one. This+-- helper allows us to do so.+--+-- > newtype ImportantFact = ImportantFact Text+-- > instance ToJSON ImportantFact+-- > instance SpanDetails ImportantFact+-- >+-- > newtype KeyStatistic = KeyStatistic Int+-- > instance ToJSON KeyStatistic+-- > instance SpanDetails KeyStatistic+-- >+-- > toTracingSpanDetails (ImportantFact "Koala's are adorable")+-- > |> renderTracingSpanDetails+-- > [ Renderer (\ImportantFact fact -> fact)+-- > , Renderer (\KeyStatistic stat -> Text.fromInt stat)+-- > ]+-- > |> Maybe.withDefault (\details -> show (Data.Aeson.encode details))+--+-- Remember that @SomeTracingSpanDetails@ are always JSON-serializable, so you+-- can use that if you need to render a span of a type you didn't prepare for.+renderTracingSpanDetails :: [Renderer a] -> SomeTracingSpanDetails -> Maybe a+renderTracingSpanDetails rs s =+ case rs of+ [] -> Nothing+ (Renderer r) : rest -> Shortcut.map r (fromTracingSpanDetails s) <|> renderTracingSpanDetails rest s++--+-- HANDLER+--++-- | Our @Task@ type secretly passed a value of this type throughout our+-- application. Anywhere in our application we can add context to the log+-- handler. For example we might wrap our database queries in a tracingSpan+-- called "query" and add some bits of context, such as the SQL operation the+-- query is performing. These bits of metadata will then be used as much as+-- possible in logging messages, tracing, and error reporting.+--+-- Note that we do not report recorded information anywhere (log it to file, or+-- to an observability platform), until we completely finish a request. This+-- gives us the option _not_ to report on a particular request. We might use+-- this to report only on a subset of the succeeding requests, to save us money+-- without loosing important signal. We'll only know whether a request succeeds+-- after it completes though, so we have to hold off on any reporting for a+-- request until it's done.+data LogHandler+ = LogHandler+ { -- | We're making the assumption that every task we run is ran because+ -- of some sort of request, and that this request has a unique+ -- identifier. We take this identifier from the incoming request and+ -- pass it on when we call external services. If something goes wrong+ -- we'll be able to collect all information related to a single request+ -- from all the components in our architecture that did work for it.+ requestId :: Text,+ -- | Every tracingSpan gets its own handler. That way if we record+ -- debugging information using a handler we'll know which tracingSpan+ -- the information belongs to. This function creates a new handler for+ -- a child tracingSpan of the current handler.+ startChildTracingSpan :: Stack.HasCallStack => Text -> IO LogHandler,+ -- | There's common fields all tracingSpans have such as a name and+ -- start and finish times. On top of that each tracingSpan can define a+ -- custom type containing useful custom data. This function allows us+ -- to set this custom data for the current tracingSpan. We could design+ -- it so this data is passed in as an extra argument when we create the+ -- tracingSpan, but then we'd miss out on useful details that only+ -- become known as the tracingSpan runs, for example the response code+ -- of an HTTP request.+ setTracingSpanDetailsIO :: forall d. TracingSpanDetails d => d -> IO (),+ -- | Mark the current tracingSpan as failed. Some reporting backends+ -- will use this to decide whether a particular request is worth+ -- reporting on.+ markTracingSpanFailedIO :: IO (),+ -- | Mark the current tracingSpan as finished, which will set the+ -- @finished@ timestamp. What this function does depends on the+ -- tracingSpan. Once we're done collecting data for the root+ -- tracingSpan we'll want to pass the tracingSpan "out", to some code+ -- that will report the debugging data to whatever observability+ -- platform(s) are used. Once we're done collecting data for child+ -- tracingSpans we'll want to add the "completed" child tracingSpan to+ -- its parent.+ finishTracingSpan :: Maybe Exception.SomeException -> IO ()+ }++-- | Helper that creates one of the handler's above. This is intended for+-- internal use in this library only and not for exposing. Outside of this+-- library the @rootTracingSpanIO@ is the more user-friendly way to get hands+-- on a @LogHandler@.+mkHandler ::+ Stack.HasCallStack =>+ Text ->+ Clock ->+ (TracingSpan -> IO ()) ->+ Text ->+ IO LogHandler+mkHandler requestId clock onFinish name' = do+ tracingSpanRef <-+ Stack.withFrozenCallStack startTracingSpan clock name'+ |> andThen IORef.newIORef+ pure+ LogHandler+ { requestId,+ startChildTracingSpan = mkHandler requestId clock (appendTracingSpanToParent tracingSpanRef),+ setTracingSpanDetailsIO = \details' ->+ updateIORef+ tracingSpanRef+ (\tracingSpan' -> tracingSpan' {details = Just (toTracingSpanDetails details')}),+ markTracingSpanFailedIO =+ updateIORef+ tracingSpanRef+ (\tracingSpan' -> tracingSpan' {succeeded = succeeded tracingSpan' ++ Failed}),+ finishTracingSpan = finalizeTracingSpan clock tracingSpanRef >> andThen onFinish+ }++-- | Set the details for a tracingSpan created using the @tracingSpan@+-- function. Like @tracingSpan@ this is intended for use in writing libraries+-- that define custom types of effects, such as database queries or http+-- requests.+--+-- It's often a good idea to use this together with @Platform.finally@ or+-- @Platform.bracketWithError@, to ensure we record tracingSpan details even in+-- the event of an exception cutting the execution of our tracingSpan short.+--+-- tracingSpan "holiday" do+-- let bookPick = BookPick "The Stone Sky"+-- Platform.finally+-- (readBook bookPick)+-- (setTracingSpanDetails bookPick)+--+-- newtype BookPick = BookPick Text+-- deriving (Aeson.ToJSON)+--+-- instance TracingSpanDetails BookPick+setTracingSpanDetails :: TracingSpanDetails d => d -> Task e ()+setTracingSpanDetails details =+ Task+ ( \handler ->+ setTracingSpanDetailsIO handler details+ |> map Ok+ )++-- | Mark a tracingSpan created with the @tracingSpan@ function as failed. Like+-- @tracingSpan@ this is intended for use in writing libraries that define+-- custom types of effects, such as database queries or http requests.+--+-- tracingSpan "plane spotting" do+-- spotPlanes+-- |> Task.onError+-- (\GlobalPandemicError -> do+-- markTracingSpanFailed+-- Task.fail GlobalPandemicError+-- )+markTracingSpanFailed :: Task e ()+markTracingSpanFailed =+ Task (map Ok << markTracingSpanFailedIO)++-- | Create an initial @TracingSpan@ with some initial values.+startTracingSpan :: Stack.HasCallStack => Clock -> Text -> IO TracingSpan+startTracingSpan clock name = do+ started <- monotonicTimeInMsec clock+ pure+ TracingSpan+ { name,+ started,+ finished = started,+ frame =+ -- This records a single stack frame containing the location in source+ -- code that creates this tracingSpan. It wouldn't be that useful if+ -- this single stack frame referenced the line in this source file+ -- where the @startTracingSpan@ function itself gets called, that would+ -- be the same line for every tracingSpan! Instead we'd like the source+ -- location recorded here to be the line outside this library calling+ -- into it. For example: the line in the application doing a database+ -- query, or logging some information.+ --+ -- That's why you see the @Stack.HasCallStack@ constraints and+ -- @Stack.withFrozenCallStack@ calls on this function's callers all the+ -- way to the boundary of the library. Unfortunately, that's what we+ -- need to do to push the stack frame we record out of the library.+ --+ -- We record only a single stack frame because that's all we get+ -- anyway, unless we'd start adding @Stack.HasCallStack@ constraints to+ -- functions in our Haskell applications. But because we record a frame+ -- for each tracingSpan together these frames can create a stack trace+ -- with a couple of different frames.+ --+ -- See the docs of the @GHC.Stack@ module for more information on how+ -- these traces work.+ Stack.callStack+ |> Stack.getCallStack+ |> List.head+ |> Shortcut.map (Tuple.mapFirst Data.Text.pack),+ details = Nothing,+ succeeded = Succeeded,+ children = []+ }++-- | Some final properties to set on a tracingSpan before calling it done.+finalizeTracingSpan :: Clock -> IORef.IORef TracingSpan -> Maybe Exception.SomeException -> IO TracingSpan+finalizeTracingSpan clock tracingSpanRef maybeException = do+ finished <- monotonicTimeInMsec clock+ tracingSpan' <- IORef.readIORef tracingSpanRef+ pure+ tracingSpan'+ { finished,+ -- Below we implement the rule that if any of the children of a+ -- tracingSpan failed, that tracingSpan itself failed too. The reason+ -- we have this rule is to make it easy to see if a request as a whole+ -- failed (just check the 'succeeded' property of the root tracingSpan+ -- to see if any errors occurred), and to make it easy to trace the+ -- source of a problem from the root tracingSpan upward by following+ -- the failing child tracingSpans.+ succeeded = succeeded tracingSpan'+ ++ case maybeException of+ Just exception -> FailedWith exception+ Nothing ->+ map Platform.Internal.succeeded (children tracingSpan')+ |> Prelude.mconcat+ }++appendTracingSpanToParent :: IORef.IORef TracingSpan -> TracingSpan -> IO ()+appendTracingSpanToParent parentRef child =+ updateIORef parentRef <| \parentTracingSpan ->+ -- Note child tracingSpans are consed to the front of the list, so children+ -- are ordered new-to-old.+ parentTracingSpan {children = child : children parentTracingSpan}++updateIORef :: IORef.IORef a -> (a -> a) -> IO ()+updateIORef ref f = IORef.atomicModifyIORef' ref (\x -> (f x, ()))++--+-- SPAN CONSTRUCTION+--++-- | Run a task in a tracingSpan.+--+-- tracingSpan "code dance" <| do+-- waltzPassLeft+-- clockwiseTurn 60+--+-- This will help provide better debugging information if something goes wrong+-- inside the wrapped task.+tracingSpan :: Stack.HasCallStack => Text -> Task e a -> Task e a+tracingSpan name (Task run) =+ Task+ ( \handler ->+ Stack.withFrozenCallStack+ tracingSpanIO+ handler+ name+ run+ )++-- | Like @tracingSpan@, but this one runs in @IO@ instead of @Task@. We+-- sometimes need this in libraries. @Task@ has the concept of a @LogHandler@+-- built in but @IO@ does not, so we'll have to pass it around ourselves.+--+-- tracingSpanIO handler "code dance" <| \childHandler -> do+-- waltzPassLeft childHandler+-- clockwiseTurn childHandler 60+tracingSpanIO :: Stack.HasCallStack => LogHandler -> Text -> (LogHandler -> IO a) -> IO a+tracingSpanIO handler name run =+ Exception.bracketWithError+ (Stack.withFrozenCallStack startChildTracingSpan handler name)+ (Prelude.flip finishTracingSpan)+ run++-- | Special version of @tracingSpanIO@ to call in the root of your application.+-- Instead of taking a parent handler it takes a continuation that will be+-- called with this root tracingSpan after it has run.+--+-- rootTracingSpanIO "request-23" Prelude.print "incoming request" <| \handler ->+-- handleRequest+-- |> Task.perform handler+rootTracingSpanIO :: Stack.HasCallStack => Text -> (TracingSpan -> IO ()) -> Text -> (LogHandler -> IO a) -> IO a+rootTracingSpanIO requestId onFinish name runIO = do+ clock' <- mkClock+ Exception.bracketWithError+ (Stack.withFrozenCallStack mkHandler requestId clock' onFinish name)+ (Prelude.flip finishTracingSpan)+ runIO++--+-- CLOCK+--++-- | A clock we can use to get the current time, to check when tracingSpans are+-- starting or ending. We could call @getCurrentTime@ or somesuch whenever we+-- need the time but we'd be calling this a lot: every time a tracingSpan+-- starts or finishes. The @Clock@ type we pass around here contains cached+-- version of @getCurrentTime@. We can call it as often as we like and it will+-- only get the current time at most once every millisecond.+newtype Clock = Clock {monotonicTimeInMsec :: IO MonotonicTime}++mkClock :: IO Clock+mkClock =+ AutoUpdate.mkAutoUpdate+ AutoUpdate.defaultUpdateSettings+ { AutoUpdate.updateAction =+ Clock.getMonotonicTimeNSec+ |> map (\n -> MonotonicTime (n `Prelude.div` 1000)),+ AutoUpdate.updateFreq = 100 -- Once every 100 microseconds+ }+ |> map Clock++-- |+-- You might expect a timestamp here, but timestamps are unreliable for+-- measuring how long a bit of code runs. For example: events like leap seconds+-- can cause them to move backards. This might result in us measuring the+-- duration of an operation and finding it to be minus 200 milliseconds.+--+-- We use @GHC.Clock.getMonotonicTimeNSec@ to let the OS tell us how much time+-- has passed since an arbitrary but constant moment in the past. That might+-- not seem all that useful, but if we 'sync watches' at one moment by getting+-- the monotonic and "regular" time in the same moment then we'll able to+-- convert any monotonic time to real timestamps. Conversion is not our concern+-- here though, we just store these monotonic times and let code that reporters+-- that use these tracingSpans convert the monotonic times into whatever format+-- they need.+newtype MonotonicTime+ = MonotonicTime+ { -- | The number of microseconds that have passed since an arbitrary but+ -- constant moment in the past.+ inMicroseconds :: GHC.Word.Word64+ }+ deriving (Prelude.Show, Prelude.Num, Prelude.Eq, Prelude.Ord)
+ src/Process.hs view
@@ -0,0 +1,61 @@+-- |+module Process+ ( Id,+ spawn,+ sleep,+ kill,+ )+where++import Basics+import qualified Control.Concurrent+import qualified Control.Concurrent.Async as Async+import Internal.Shortcut+import qualified Platform.Internal as Internal+import qualified Result+import Task (Task)+import qualified Prelude++-- | A light-weight process that runs concurrently. You can use @spawn@ to get+-- a bunch of different tasks running in different processes. The Elm Haskell+-- 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 is definitely+-- concurrent, but not necessarily parallel.+newtype Id = Id (Async.Async ())++-- | 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 (Internal.Task f) =+ Internal.Task+ ( \handler ->+ f handler+ |> Async.async+ |> map (Result.Ok << Id << map (\_ -> ()))+ )++-- | Block progress on the current process for the given number of+-- milliseconds. The JavaScript equivalent of this is @setTimeout@ which lets+-- you delay work until later.+sleep :: Float -> Task x ()+sleep delay = Internal.Task (\_ -> map Result.Ok (Control.Concurrent.threadDelay (Prelude.floor (delay * 1000))))++-- | 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 (Id async) = Internal.Task (\_ -> map Result.Ok (Async.cancel async))
+ src/Result.hs view
@@ -0,0 +1,190 @@+-- | A @Result@ is the result of a computation that may fail. This is a great+-- way to manage errors in Elm.+module Result+ ( -- * Type and Constructors+ Result (..),++ -- * Mapping+ map,+ map2,+ map3,+ map4,+ map5,++ -- * Chaining+ andThen,++ -- * Handling Errors+ withDefault,+ toMaybe,+ fromMaybe,+ mapError,+ )+where++import Basics+import qualified Internal.Shortcut as Shortcut+import Maybe (Maybe (..))+import Prelude (fmap)+import qualified Prelude++-- | A @Result@ is either @Ok@ meaning the computation succeeded, or it is an+-- @Err@ meaning that there was some failure.+data Result error value+ = Ok value+ | Err error+ deriving (Prelude.Show, Eq)++instance Prelude.Functor (Result error) where+ fmap func result =+ case result of+ Ok value -> Ok (func value)+ Err error -> Err error++instance Prelude.Applicative (Result error) where+ pure = Ok++ (<*>) r1 r2 =+ case (r1, r2) of+ (Ok func, Ok a) -> Ok (func a)+ (Err error, _) -> Err error+ (Ok _, Err error) -> Err error++instance Prelude.Monad (Result error) where+ (>>=) result func =+ case result of+ Ok value -> func value+ Err error -> 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 (Ok 123) == 123+-- > Result.withDefault 0 (Err "no") == 0+withDefault :: a -> Result b a -> a+withDefault fallback result =+ case result of+ Ok value -> value+ Err _ -> fallback++-- | 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 =+ Shortcut.map++-- | Apply a function if both results are @Ok@. If not, the first @Err@ will+-- propagate through.+--+-- map2 max (Ok 42) (Ok 13) == Ok 42+-- map2 max (Err "x") (Ok 13) == Err "x"+-- map2 max (Ok 42) (Err "y") == Err "y"+-- map2 max (Err "x") (Err "y") == Err "x"+--+-- This can be useful if you have two computations that may fail, and you want+-- to put them together quickly.+map2 :: (a -> b -> value) -> Result x a -> Result x b -> Result x value+map2 =+ Shortcut.map2++-- |+map3 :: (a -> b -> c -> value) -> Result x a -> Result x b -> Result x c -> Result x value+map3 =+ Shortcut.map3++-- |+map4 :: (a -> b -> c -> d -> value) -> Result x a -> Result x b -> Result x c -> Result x d -> Result x value+map4 =+ Shortcut.map4++-- |+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 =+ Shortcut.map5++-- | 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 c b) -> Result c a -> Result c b+andThen =+ Shortcut.andThen++-- | 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 :: (a -> b) -> Result a c -> Result b c+mapError func result =+ case result of+ Ok value -> Ok value+ Err error -> Err (func error)++-- | 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 a b -> Maybe b+toMaybe result =+ case result of+ Ok value -> Just value+ 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 :: a -> Maybe b -> Result a b+fromMaybe error maybe =+ case maybe of+ Just something -> Ok something+ Nothing -> Err error
+ src/Set.hs view
@@ -0,0 +1,154 @@+-- | 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.+module Set+ ( -- * Sets+ Set,++ -- * Build+ empty,+ singleton,+ insert,+ remove,++ -- * Query+ isEmpty,+ member,+ size,++ -- * Combine+ union,+ intersect,+ diff,++ -- * Lists+ toList,+ fromList,++ -- * Transform+ map,+ foldl,+ foldr,+ filter,+ partition,+ )+where++import Basics ((>>), Bool, Int, Ord)+import qualified Data.Set+import List (List)+import qualified Prelude++-- | 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 =+ Data.Set.Set t++-- | Create an empty set.+empty :: Set a+empty =+ Data.Set.empty++-- | Create a set with one value.+singleton :: comparable -> Set comparable+singleton =+ Data.Set.singleton++-- | Insert a value into a set.+insert :: Ord comparable => comparable -> Set comparable -> Set comparable+insert =+ Data.Set.insert++-- | Remove a value from a set. If the value is not found, no changes are made.+remove :: Ord comparable => comparable -> Set comparable -> Set comparable+remove =+ Data.Set.delete++-- | Determine if a set is empty.+isEmpty :: Set a -> Bool+isEmpty =+ Data.Set.null++-- | Determine if a value is in a set.+member :: Ord comparable => comparable -> Set comparable -> Bool+member =+ Data.Set.member++-- | Determine the number of elements in a set.+size :: Set a -> Int+size =+ Data.Set.size >> Prelude.fromIntegral++-- | Get the union of two sets, preferring the first set when equal elements are+-- encountered.+--+-- In Elm it's not possible to have two comparable elements that are not equal, but+-- it is possible in Haskell.+union :: Ord comparable => Set comparable -> Set comparable -> Set comparable+union =+ Data.Set.union++-- | Get the intersection of two sets, preferring the first set when equal elements+-- are encountered.+--+-- In Elm it's not possible to have two comparable elements that are not equal, but+-- it is possible in Haskell.+intersect :: Ord comparable => Set comparable -> Set comparable -> Set comparable+intersect =+ Data.Set.intersection++-- | Get the difference between the first set and the second. Keeps values+-- that do not appear in the second set.+diff :: Ord comparable => Set comparable -> Set comparable -> Set comparable+diff =+ Data.Set.difference++-- | Convert a set into a list, sorted from lowest to highest.+toList :: Set a -> List a+toList =+ Data.Set.toAscList++-- | Convert a list into a set, removing any duplicates.+fromList :: Ord comparable => List comparable -> Set comparable+fromList =+ Data.Set.fromList++-- | Fold over the values in a set, in order from lowest to highest.+foldl :: (a -> b -> b) -> b -> Set a -> b+foldl func =+ Data.Set.foldl' (\a b -> func b a)++-- | Fold over the values in a set, in order from highest to lowest.+foldr :: (a -> b -> b) -> b -> Set a -> b+foldr =+ Data.Set.foldr'++-- | Map a function onto a set, creating a new set with no duplicates.+map :: Ord comparable2 => (comparable -> comparable2) -> Set comparable -> Set comparable2+map =+ Data.Set.map++-- | Only keep elements that pass the given test.+--+-- > import Set exposing (Set)+-- >+-- > numbers : Set Int+-- > numbers =+-- > Set.fromList [-2,-1,0,1,2]+-- >+-- > positives : Set Int+-- > positives =+-- > Set.filter (\x -> x > 0) numbers+-- >+-- > -- positives == Set.fromList [1,2]+filter :: (comparable -> Bool) -> Set comparable -> Set comparable+filter =+ Data.Set.filter++-- | Create two new sets. The first contains all the elements that passed the+-- given test, and the second contains all the elements that did not.+partition :: (comparable -> Bool) -> Set comparable -> (Set comparable, Set comparable)+partition =+ Data.Set.partition
+ src/Task.hs view
@@ -0,0 +1,246 @@+-- | Tasks make it easy to describe asynchronous operations that may fail, like+-- HTTP requests or writing to a database.+module Task+ ( -- * Tasks+ Task,+ perform,+ attempt,++ -- * Chains+ andThen,+ succeed,+ fail,+ sequence,++ -- * Maps+ map,+ map2,+ map3,+ map4,+ map5,+ map6,++ -- * Errors+ onError,+ mapError,++ -- * Special (custom helpers not found in Elm)+ timeout,+ parallel,+ )+where++import Basics+import qualified Control.Concurrent.Async as Async+import qualified Internal.Shortcut as Shortcut+import List (List)+import qualified List+import Maybe (Maybe (..))+import qualified Platform.Internal as Internal+import Platform.Internal (Task)+import Result (Result (..))+import qualified System.Timeout+import Prelude (IO)+import qualified Prelude++-- BASICS++-- | Just having a @Task@ does not mean it is done. We must @perform@ the task:+--+-- > import qualified Task+-- > import qualified Platform+-- >+-- > main :: IO+-- > main =+-- > Task.perform Platform.silentHandler Time.now+perform :: Internal.LogHandler -> Task Never a -> IO a+perform output task =+ let onResult result =+ case result of+ Err err -> never err+ Ok x -> x+ in attempt output task+ |> Shortcut.map onResult++-- | This is very similar to perform except it can handle failures!+attempt :: Internal.LogHandler -> Task x a -> IO (Result x a)+attempt output task =+ let onResult result =+ Prelude.pure result+ in Internal._run task output |> Shortcut.andThen onResult++-- | A task that succeeds immediately when run. It is usually used with+-- @andThen@. You can use it like @map@ if you want:+--+-- > import qualified Time+-- >+-- > timeInMillis : Task x Int+-- > timeInMillis =+-- > Time.now+-- > |> andThen (\t -> succeed (Time.posixToMillis t))+succeed :: a -> Task x a+succeed a =+ Internal.Task <| \_ -> Prelude.pure (Ok a)++-- | A task that fails immediately when run. Like with @succeed@, this can be+-- used with @andThen@ to check on the outcome of another task.+--+-- > type Error = NotFound+-- >+-- > notFound : Task Error a+-- > notFound =+-- > fail NotFound+fail :: x -> Task x a+fail x =+ Internal.Task <| \_ -> Prelude.pure (Err x)++-- MAPS++-- | Transform a task. Maybe you want to figure out what time it will be in one+-- hour:+--+-- > import Task exposing (Task)+-- > import qualified Time+-- >+-- > timeInOneHour : Task x Time.Posix+-- > timeInOneHour =+-- > Task.map addAnHour Time.now+-- >+-- > addAnHour : Time.Posix -> Time.Posix+-- > addAnHour time =+-- > Time.millisToPosix (Time.posixToMillis time + 60 * 60 * 1000)+map :: (a -> b) -> Task x a -> Task x b+map =+ Shortcut.map++-- | Put the results of two tasks together. For example, if we wanted to know+-- the current month, we could ask:+--+-- > import qualified Task exposing (Task)+-- > import qualified Time+-- >+-- > getMonth : Task x Int+-- > getMonth =+-- > Task.map2 Time.toMonth Time.here Time.now+--+-- __Note:__ Say we were doing HTTP requests instead. @map2@ does each task in+-- order, so it would try the first request and only continue after it succeeds.+-- If it fails, the whole thing fails!+map2 :: (a -> b -> result) -> Task x a -> Task x b -> Task x result+map2 =+ Shortcut.map2++-- |+map3 :: (a -> b -> c -> result) -> Task x a -> Task x b -> Task x c -> Task x result+map3 =+ Shortcut.map3++-- |+map4 :: (a -> b -> c -> d -> result) -> Task x a -> Task x b -> Task x c -> Task x d -> Task x result+map4 =+ Shortcut.map4++-- |+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 =+ Shortcut.map5++-- |+map6 :: (a -> b -> c -> d -> e -> f -> result) -> Task x a -> Task x b -> Task x c -> Task x d -> Task x e -> Task x f -> Task x result+map6 =+ Shortcut.map6++-- | 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. We could use this to make a task that resolves an hour from+-- now:+--+-- > import qualified Time+-- > import qualified Process+-- >+-- > timeInOneHour : Task x Time.Posix+-- > timeInOneHour =+-- > Process.sleep (60 * 60 * 1000)+-- > |> andThen (\_ -> Time.now)+--+-- First the process sleeps for an hour __and then__ it tells us what time it is.+andThen :: (a -> Task x b) -> Task x a -> Task x b+andThen =+ Shortcut.andThen++-- | 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 ]+sequence :: List (Task x a) -> Task x (List a)+sequence tasks =+ List.foldr (Shortcut.map2 (:)) (succeed []) tasks++-- | Start with a list of tasks, and turn them into a single task that returns a+-- list. The tasks will be run in parallel and if any task fails the whole+-- parallel call fails.+--+-- > parallel [ succeed 1, succeed 2 ] == succeed [ 1, 2 ]+parallel :: List (Task x a) -> Task x (List a)+parallel tasks =+ Internal.Task+ ( \handler ->+ Async.forConcurrently tasks (\task -> Internal._run task handler)+ |> Shortcut.map Prelude.sequence+ )++-- | 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 func task =+ Internal.Task <| \key ->+ let onResult result =+ case result of+ Ok ok -> Prelude.pure (Ok ok)+ Err err -> Internal._run (func err) key+ in Internal._run task key+ |> Shortcut.andThen onResult++-- | 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 func task =+ task |> onError (fail << func)++-- | Run a task. If it doesn't complete within the given number of milliseconds+-- then fail it with the provided error.+--+-- > Process.sleep 2000+-- > |> timeout 1000 "overslept!"+timeout :: Float -> err -> Task err a -> Task err a+timeout duration err task =+ Internal.Task+ ( \handler -> do+ maybeResult <-+ System.Timeout.timeout+ (Prelude.round (1000 * duration))+ (Internal._run task handler)+ case maybeResult of+ Just result -> Prelude.pure result+ Nothing -> Prelude.pure (Err err)+ )
+ src/Test.hs view
@@ -0,0 +1,231 @@+-- | A module containing functions for creating and managing tests.+module Test+ ( -- * Organizing Tests+ Test,+ test,+ describe,+ concat,+ skip,+ only,+ todo,++ -- * Fuzz Testing+ fuzz,+ fuzz2,+ fuzz3,+ fromTestTree,++ -- * Task Testing+ task,+ )+where++import qualified Data.Text+import qualified Expect+import Fuzz (Fuzzer)+import qualified Internal.Expectation+import qualified Internal.Test+import Internal.TestResult (TestFailure)+import NriPrelude+import qualified Platform+import qualified Task+import Test.Tasty (TestName, TestTree)+import Prelude (Show)++-- | A test which has yet to be evaluated. When evaluated, it produces one+-- or more 'Expect.Expectation's.+-- See 'test' and 'fuzz' for some ways to create a @Test@.+type Test = Internal.Test.Test++-- | Apply a description to a list of tests.+--+-- > import Test (describe, test, fuzz)+-- > import Fuzz (int)+-- > import Expect+-- >+-- > describe "List"+-- > [ describe "reverse"+-- > [ test "has no effect on an empty list" <|+-- > \_ ->+-- > List.reverse []+-- > |> Expect.equal []+-- > , fuzz int "has no effect on a one-item list" <|+-- > \num ->+-- > List.reverse [ num ]+-- > |> Expect.equal [ num ]+-- > ]+-- > ]+--+-- Passing an empty list will result in a failing test, because you either made a+-- mistake or are creating a placeholder.+describe :: Text -> List Test -> Test+describe =+ Internal.Test.Describe++-- | Run each of the given tests.+--+-- > concat [ testDecoder, testSorting ]+concat :: List Test -> Test+concat =+ Internal.Test.Describe ""++-- | Return a 'Test' that evaluates a single+-- 'Expect.Expectation'+--+-- > import Test (fuzz)+-- > import Expect+-- > test "the empty list has 0 length" <|+-- > \_ ->+-- > List.length []+-- > |> Expect.equal 0+test :: Text -> (() -> Expect.Expectation) -> Test+test =+ Internal.Test.Test++-- | Returns a 'Test' that gets skipped.+--+-- Calls to @skip@ aren't meant to be committed to version control. Instead,+-- use it when you want to focus on getting a particular subset of your tests+-- to pass. If you use @skip@, your entire test suite will fail, even if each+-- of the individual tests pass. This is to help avoid accidentally committing+-- a @skip@ to version control.+--+-- See also 'only'. Note that @skip@ takes precedence over @only@; if you use a+-- @skip@ inside an @only@, it will still get skipped, and if you use an @only@+-- inside a @skip@, it will also get skipped.+--+-- > describe "List"+-- > [ skip <|+-- > describe "reverse"+-- > [ test "has no effect on an empty list" <|+-- > \_ ->+-- > List.reverse []+-- > |> Expect.equal []+-- > , fuzz int "has no effect on a one-item list" <|+-- > \num ->+-- > List.reverse [ num ]+-- > |> Expect.equal [ num ]+-- > ]+-- > , test "This is the only test that will get run; the other was skipped!" <|+-- > \_ ->+-- > List.length []+-- > |> Expect.equal 0+-- > ]+skip :: Test -> Test+skip = Internal.Test.Skip++-- | Returns a 'Test' that causes other tests to be skipped, and only runs the given one.+--+-- Calls to @only@ aren't meant to be committed to version control. Instead,+-- use them when you want to focus on getting a particular subset of your tests+-- to pass. If you use @only@, your entire test suite will fail, even if each+-- of the individual tests pass. This is to help avoid accidentally committing+-- a @only@ to version control.+--+-- If you you use @only@ on multiple tests, only those tests will run. If you+-- put a @only@ inside another @only@, only the outermost @only@ will affect+-- which tests gets run. See also 'skip'. Note that @skip@ takes precedence+-- over @only@; if you use a @skip@ inside an @only@, it will still get+-- skipped, and if you use an @only@ inside a @skip@, it will also get skipped.+--+-- > describe "List"+-- > [ only <|+-- > describe "reverse"+-- > [ test "has no effect on an empty list" <|+-- > \_ ->+-- > List.reverse []+-- > |> Expect.equal []+-- > , fuzz int "has no effect on a one-item list" <|+-- > \num ->+-- > List.reverse [ num ]+-- > |> Expect.equal [ num ]+-- > ]+-- > , test "This will not get run, because of the @only@ above!" <|+-- > \_ ->+-- > List.length []+-- > |> Expect.equal 0+-- > ]+only :: Test -> Test+only = Internal.Test.Only++-- | Returns a 'Test' that is "todo" (not yet implemented). These tests always+-- fail.+--+-- These tests aren't meant to be committed to version control. Instead, use+-- them when you're brainstorming lots of tests you'd like to write, but you+-- can't implement them all at once. When you replace @todo@ with a real test,+-- you'll be able to see if it fails without clutter from tests still not+-- implemented. But, unlike leaving yourself comments, you'll be prompted to+-- implement these tests because your suite will fail.+--+-- > describe "a new thing"+-- > [ todo "does what is expected in the common case"+-- > , todo "correctly handles an edge case I just thought of"+-- > ]+--+-- This functionality is similar to "pending" tests in other frameworks, except+-- that a todo test is considered failing but a pending test often is not.+todo :: Text -> Test+todo = Internal.Test.Todo++-- | Take a function that produces a test, and calls it several times, using a+-- randomly-generated input from a 'Fuzz.Fuzzer' each time. This allows you to+-- test that a property that should always be true is indeed true under a wide+-- variety of conditions. The function also takes a string describing the test.+--+-- These are called "[fuzz tests](https://en.wikipedia.org/wiki/Fuzz_testing)" because of the randomness. You may find them elsewhere called [property-based tests](http://blog.jessitron.com/2013/04/property-based-testing-what-is-it.html), [generative tests](http://www.pivotaltracker.com/community/tracker-blog/generative-testing), or [QuickCheck-style tests](https://en.wikipedia.org/wiki/QuickCheck).+--+-- > import Test (fuzz)+-- > import Fuzz (list, int)+-- > import Expect+-- >+-- > fuzz (list int) "List.length should always be positive" <|+-- > -- This anonymous function will be run 100 times, each time with a+-- > -- randomly-generated fuzzList value.+-- > \fuzzList ->+-- > fuzzList+-- > |> List.length+-- > |> Expect.atLeast 0+--+-- NOTE: You can use any Hedgehog.Gen for Fuzzer.+fuzz :: Show a => Fuzzer a -> Text -> (a -> Expect.Expectation) -> Test+fuzz a name cb = Internal.Test.Fuzz (Internal.Test.Fuzzer1 a cb) name++-- | Run a fuzz test using two random inputs.+--+-- > import Test (fuzz2)+-- > import Fuzz (list, int)+-- >+-- > fuzz2 (list int) int "List.reverse never influences List.member" <|+-- > \nums target ->+-- > List.member target (List.reverse nums)+-- > |> Expect.equal (List.member target nums)+fuzz2 :: (Show a, Show b) => Fuzzer a -> Fuzzer b -> Text -> (a -> b -> Expect.Expectation) -> Test+fuzz2 a b name cb = Internal.Test.Fuzz (Internal.Test.Fuzzer2 a b cb) name++-- | Run a fuzz test using three random inputs.+fuzz3 :: (Show a, Show b, Show c) => Fuzzer a -> Fuzzer b -> Fuzzer c -> Text -> (a -> b -> c -> Expect.Expectation) -> Test+fuzz3 a b c name cb = Internal.Test.Fuzz (Internal.Test.Fuzzer3 a b c cb) name++-- | Embed arbitrary Tasty @TestTree@ among your other tests.+fromTestTree :: Text -> (TestName -> TestTree) -> Test+fromTestTree n f =+ Internal.Test.FromTestTree n (f (Data.Text.unpack n))++-- | Run a test that executes a task. The test passes if the task returns a+-- success value.+task :: Text -> Task TestFailure a -> Test+task n expectation =+ Internal.Test.Test n (\() -> runTask expectation)++runTask :: Task TestFailure a -> Expect.Expectation+runTask t =+ Expect.withIO+ ( \res ->+ case res of+ Ok _ -> Expect.pass+ Err message -> Internal.Expectation.fromResult message+ )+ <| do+ noLogger <- Platform.silentHandler+ Task.attempt noLogger t
+ src/Test/Console/Color.hs view
@@ -0,0 +1,44 @@+module Test.Console.Color+ ( Style,+ styled,++ -- * colors+ blue,+ grey,+ magenta,+ red,+ yellow,+ )+where++import NriPrelude+import qualified Data.Text+import List (List)+import qualified System.Console.ANSI as Console+import Text (Text)++type Style = List Console.SGR++code :: Style -> Text+code = Data.Text.pack << Console.setSGRCode++styled :: Style -> Text -> Text+styled col t = code col ++ t ++ code [reset]++reset :: Console.SGR+reset = Console.Reset++red :: Console.SGR+red = Console.SetColor Console.Foreground Console.Dull Console.Red++magenta :: Console.SGR+magenta = Console.SetColor Console.Foreground Console.Dull Console.Magenta++blue :: Console.SGR+blue = Console.SetColor Console.Foreground Console.Dull Console.Blue++yellow :: Console.SGR+yellow = Console.SetColor Console.Foreground Console.Dull Console.Yellow++grey :: Console.SGR+grey = Console.SetColor Console.Foreground Console.Dull Console.White
+ src/Test/Runner/Tasty.hs view
@@ -0,0 +1,115 @@+-- | Run tests.+module Test.Runner.Tasty+ ( main,+ )+where++import Control.Exception.Safe (throw)+import Data.Proxy (Proxy (Proxy))+import qualified Data.Text+import Data.Typeable (Typeable)+import qualified Internal.Test+import qualified Internal.TestResult as Result+import qualified List+import NriPrelude+import qualified System.Environment as Env+import qualified Test+import qualified Test.Tasty as Tasty+import qualified Test.Tasty.Options as Options+import qualified Test.Tasty.Providers as Providers+import qualified Test.Tasty.Runners.Reporter as Reporter+import qualified Text+import Prelude (IO, pure, show)++-- | Run tests.+main :: Test.Test -> IO ()+main test = do+ -- NOTE: We need to always run AntXML,+ -- because this ingredient actually runs the tests.+ let tastyXmlEnv = "TASTY_XML"+ maybeXml <- Env.lookupEnv tastyXmlEnv+ case maybeXml of+ Just _ -> pure ()+ Nothing -> Env.setEnv tastyXmlEnv "_build/report.xml"+ Tasty.defaultMainWithIngredients [Reporter.ingredient] (setup test)++data TestToRun+ = TestToRun Test.Test+ | Only TestToRun+ deriving (Typeable)++instance Providers.IsTest TestToRun where+ testOptions = pure [Options.Option (Proxy :: Proxy FuzzReplay)]++ run options (Only (TestToRun testToRun)) _progress = do+ result <- runTest options testToRun+ throw (Reporter.TestOnly result)+ run options (Only testToRun) progress = Providers.run options testToRun progress+ run options (TestToRun testToRun) _progress = do+ result <- runTest options testToRun+ case result of+ Reporter.OnlyTestPassed str -> pure (Providers.testPassed str)+ Reporter.OnlyTestFailed str -> pure (Providers.testFailed str)++runTest :: Options.OptionSet -> Test.Test -> IO Reporter.OnlyTestResult+runTest options testToRun = do+ let FuzzReplay replay = Options.lookupOption options+ testResult <- Internal.Test.run replay testToRun+ case testResult of+ Result.Passed -> pure (Reporter.OnlyTestPassed "")+ Result.Skipped -> throw Reporter.TestSkipped+ Result.Failed message ->+ show message+ |> Reporter.OnlyTestFailed+ |> pure++--++-- | The replay token to use for replaying a previous test run+newtype FuzzReplay = FuzzReplay Internal.Test.FuzzReplay+ deriving (Typeable)++instance Options.IsOption FuzzReplay where+ defaultValue = FuzzReplay (Internal.Test.FuzzReplay Nothing)++ parseValue v = map (FuzzReplay << Internal.Test.FuzzReplay << Just) replay+ where+ -- Reads a replay token in the form "{size} {seed}"+ size = List.take 2 (Text.words <| Data.Text.pack v)+ seed = List.drop 2 (Text.words <| Data.Text.pack v)+ replay =+ map2+ (,)+ (Options.safeRead (Data.Text.unpack <| Text.join " " size))+ (Options.safeRead (Data.Text.unpack <| Text.join " " seed))++ optionName = pure "seed"++ optionHelp = pure "Allow running the tests with a predefined seed, rather than a randomly generated seed. This is especially helpful when trying to reproduce a failing fuzz-test."++setup :: Test.Test -> Providers.TestTree+setup tests =+ case Internal.Test.hasOnly tests of+ Just sub ->+ -- only run tests that are wrapped in @only@.+ setup_ True sub+ Nothing ->+ setup_ False tests++setup_ :: Bool -> Test.Test -> Providers.TestTree+setup_ hasOnly test =+ case test of+ Internal.Test.Describe name tests ->+ tests+ |> List.map+ ( \test' ->+ case test' of+ Internal.Test.FromTestTree _ t -> t+ t -> setup_ hasOnly t+ )+ |> Tasty.testGroup (Data.Text.unpack name)+ _ ->+ Providers.singleTest (Data.Text.unpack (Internal.Test.name test))+ <| if hasOnly+ then Only (TestToRun test)+ else TestToRun test
+ src/Text.hs view
@@ -0,0 +1,486 @@+-- | A built-in representation for efficient string manipulation.+-- @Text@ values are /not/ lists of characters.+module Text+ ( -- * Text+ Text,+ isEmpty,+ length,+ reverse,+ repeat,+ replace,++ -- * Building and Splitting+ append,+ concat,+ split,+ join,+ words,+ lines,++ -- * Get Substrings+ slice,+ left,+ right,+ dropLeft,+ dropRight,++ -- * Check for Substrings+ contains,+ startsWith,+ endsWith,+ indexes,+ indices,++ -- * Int Conversions+ toInt,+ fromInt,++ -- * Float Conversions+ toFloat,+ fromFloat,++ -- * Char Conversions+ fromChar,+ cons,+ uncons,++ -- * List Conversions+ toList,+ fromList,++ -- * Formatting++ -- | Cosmetic operations such as padding with extra characters or trimming whitespace.+ toUpper,+ toLower,+ pad,+ padLeft,+ padRight,+ trim,+ trimLeft,+ trimRight,++ -- * Higher-Order Functions+ map,+ filter,+ foldl,+ foldr,+ any,+ all,+ )+where++import Basics+ ( (+),+ (-),+ (<),+ (<<),+ (<=),+ (>>),+ Bool,+ Float,+ Int,+ clamp,+ (|>),+ )+import Char (Char)+import qualified Data.Text+import qualified List+import List (List)+import Maybe (Maybe)+import qualified Text.Read+import Prelude (otherwise)+import qualified Prelude++-- | A @Text@ is a chunk of text:+--+-- > "Hello!"+-- > "How are you?"+-- > "🙈🙉🙊"+-- >+-- > -- strings with escape characters+-- > "this\n\t\"that\""+-- > "\x1F648\x1F649\x1F64A" -- "🙈🙉🙊"+--+-- A @Text@ can represent any sequence of [unicode characters](https://en.wikipedia.org/wiki/Unicode). You can use the unicode escapes from @\x0000@ to @\x10FFFF@ to represent characters by their code point. You can also include the unicode characters directly. Using the escapes can be better if you need one of the many whitespace characters with different widths.+type Text = Data.Text.Text++-- | Determine if a string is empty.+--+-- > isEmpty "" == True+-- > isEmpty "the world" == False+isEmpty :: Text -> Bool+isEmpty = Data.Text.null++-- | Get the length of a string.+--+-- > length "innumerable" == 11+-- > length "" == 0+length :: Text -> Int+length =+ Data.Text.length >> Prelude.fromIntegral++-- | Reverse a string.+--+-- > reverse "stressed" == "desserts"+reverse :: Text -> Text+reverse = Data.Text.reverse++-- | Repeat a string /n/ times.+--+-- > repeat 3 "ha" == "hahaha"+repeat :: Int -> Text -> Text+repeat =+ Prelude.fromIntegral >> Data.Text.replicate++-- | Replace all occurrences of some substring.+--+-- > replace "." "-" "Json.Decode.succeed" == "Json-Decode-succeed"+-- > replace "," "/" "a,b,c,d,e" == "a/b/c/d/e"+replace :: Text -> Text -> Text -> Text+replace = Data.Text.replace++-- BUILDING AND SPLITTING++-- | Append two strings. You can also use the @(++)@ operator to do this.+--+-- > append "butter" "fly" == "butterfly"+append :: Text -> Text -> Text+append = Data.Text.append++-- | Concatenate many strings into one.+--+-- > concat ["never","the","less"] == "nevertheless"+concat :: List Text -> Text+concat = Data.Text.concat++-- | Split a string using a given separator.+--+-- > split "," "cat,dog,cow" == ["cat","dog","cow"]+-- > split "/" "home/evan/Desktop/" == ["home","evan","Desktop", ""]+split :: Text -> Text -> List Text+split = Data.Text.splitOn++-- | 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 :: Text -> List Text -> Text+join = Data.Text.intercalate++-- | Break a string into words, splitting on chunks of whitespace.+--+-- > words "How are \t you? \n Good?" == ["How","are","you?","Good?"]+words :: Text -> List Text+words = Data.Text.words++-- | Break a string into lines, splitting on newlines.+--+-- > lines "How are you?\nGood?" == ["How are you?", "Good?"]+lines :: Text -> List Text+lines = Data.Text.lines++-- SUBSTRINGS++-- | 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 -> Text -> Text+slice from to text+ | to' - from' <= 0 = Data.Text.empty+ | otherwise =+ Data.Text.drop from' (Data.Text.take to' text)+ where+ len = Data.Text.length text+ handleNegative value+ | value < 0 = len + value+ | otherwise = value+ normalize =+ Prelude.fromIntegral+ >> handleNegative+ >> clamp 0 len+ from' = normalize from+ to' = normalize to++-- | Take /n/ characters from the left side of a string.+--+-- > left 2 "Mulder" == "Mu"+left :: Int -> Text -> Text+left =+ Prelude.fromIntegral >> Data.Text.take++-- | Take /n/ characters from the right side of a string.+--+-- > right 2 "Scully" == "ly"+right :: Int -> Text -> Text+right =+ Prelude.fromIntegral >> Data.Text.takeEnd++-- | Drop /n/ characters from the left side of a string.+--+-- > dropLeft 2 "The Lone Gunmen" == "e Lone Gunmen"+dropLeft :: Int -> Text -> Text+dropLeft =+ Prelude.fromIntegral >> Data.Text.drop++-- | Drop /n/ characters from the right side of a string.+--+-- > dropRight 2 "Cigarette Smoking Man" == "Cigarette Smoking M"+dropRight :: Int -> Text -> Text+dropRight =+ Prelude.fromIntegral >> Data.Text.dropEnd++-- DETECT SUBSTRINGS++-- | See if the second string contains the first one.+--+-- > contains "the" "theory" == True+-- > contains "hat" "theory" == False+-- > contains "THE" "theory" == False+contains :: Text -> Text -> Bool+contains = Data.Text.isInfixOf++-- | See if the second string starts with the first one.+--+-- > startsWith "the" "theory" == True+-- > startsWith "ory" "theory" == False+startsWith :: Text -> Text -> Bool+startsWith = Data.Text.isPrefixOf++-- | See if the second string ends with the first one.+--+-- > endsWith "the" "theory" == False+-- > endsWith "ory" "theory" == True+endsWith :: Text -> Text -> Bool+endsWith = Data.Text.isSuffixOf++-- | 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 :: Text -> Text -> List Int+indexes n h+ | isEmpty n = []+ | otherwise = indexes' n h+ where+ indexes' needle haystack =+ Data.Text.breakOnAll needle haystack+ |> List.map+ ( \(lhs, _) ->+ Data.Text.length lhs+ |> Prelude.fromIntegral+ )++-- | Alias for @indexes@.+indices :: Text -> Text -> List Int+indices = indexes++-- FORMATTING++-- | Convert a string to all upper case. Useful for case-insensitive comparisons+-- and VIRTUAL YELLING.+--+-- > toUpper "skinner" == "SKINNER"+toUpper :: Text -> Text+toUpper = Data.Text.toUpper++-- | Convert a string to all lower case. Useful for case-insensitive comparisons.+--+-- > toLower "X-FILES" == "x-files"+toLower :: Text -> Text+toLower = Data.Text.toLower++-- | 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 -> Text -> Text+pad =+ Prelude.fromIntegral >> Data.Text.center++-- | 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 -> Text -> Text+padLeft =+ Prelude.fromIntegral >> Data.Text.justifyRight++-- | 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 -> Text -> Text+padRight =+ Prelude.fromIntegral >> Data.Text.justifyLeft++-- | Get rid of whitespace on both sides of a string.+--+-- > trim " hats \n" == "hats"+trim :: Text -> Text+trim = Data.Text.strip++-- | Get rid of whitespace on the left of a string.+--+-- > trimLeft " hats \n" == "hats \n"+trimLeft :: Text -> Text+trimLeft = Data.Text.stripStart++-- | Get rid of whitespace on the right of a string.+--+-- > trimRight " hats \n" == " hats"+trimRight :: Text -> Text+trimRight = Data.Text.stripEnd++-- INT CONVERSIONS++-- | Try to convert a string into an int, failing on improperly formatted strings.+--+-- > Text.toInt "123" == Just 123+-- > Text.toInt "-42" == Just -42+-- > Text.toInt "3.1" == Nothing+-- > Text.toInt "31a" == Nothing+--+-- If you are extracting a number from some raw user input, you will typically+-- want to use [@Maybe.withDefault@](Maybe#withDefault) to handle bad data:+--+-- > Maybe.withDefault 0 (Text.toInt "42") == 42+-- > Maybe.withDefault 0 (Text.toInt "ab") == 0+toInt :: Text -> Maybe Int+toInt text =+ Text.Read.readMaybe str'+ where+ str = Data.Text.unpack text+ str' = case str of+ '+' : rest -> rest+ other -> other++-- | Convert an @Int@ to a @Text@.+--+-- > Text.fromInt 123 == "123"+-- > Text.fromInt -42 == "-42"+fromInt :: Int -> Text+fromInt = Data.Text.pack << Prelude.show++-- FLOAT CONVERSIONS++-- | Try to convert a string into a float, failing on improperly formatted strings.+--+-- > Text.toFloat "123" == Just 123.0+-- > Text.toFloat "-42" == Just -42.0+-- > Text.toFloat "3.1" == Just 3.1+-- > Text.toFloat "31a" == Nothing+--+-- If you are extracting a number from some raw user input, you will typically+-- want to use [@Maybe.withDefault@](Maybe#withDefault) to handle bad data:+--+-- > Maybe.withDefault 0 (Text.toFloat "42.5") == 42.5+-- > Maybe.withDefault 0 (Text.toFloat "cats") == 0+toFloat :: Text -> Maybe Float+toFloat text =+ Text.Read.readMaybe str'+ where+ str = Data.Text.unpack text+ str' = case str of+ '+' : rest -> rest+ '.' : rest -> '0' : '.' : rest+ other -> other++-- | Convert a @Float@ to a @Text@.+--+-- > Text.fromFloat 123 == "123"+-- > Text.fromFloat -42 == "-42"+-- > Text.fromFloat 3.9 == "3.9"+fromFloat :: Float -> Text+fromFloat = Data.Text.pack << Prelude.show++-- LIST CONVERSIONS++-- | Convert a Text to a list of characters.+--+-- > toList "abc" == ['a','b','c']+-- > toList "🙈🙉🙊" == ['🙈','🙉','🙊']+toList :: Text -> List Char+toList = Data.Text.unpack++-- | Convert a list of characters into a Text. Can be useful if you+-- want to create a string primarily by consing, perhaps for decoding+-- something.+--+-- > fromList ['a','b','c'] == "abc"+-- > fromList ['🙈','🙉','🙊'] == "🙈🙉🙊"+fromList :: List Char -> Text+fromList = Data.Text.pack++-- CHAR CONVERSIONS++-- | Create a Text from a given character.+--+-- > fromChar 'a' == "a"+fromChar :: Char -> Text+fromChar = Data.Text.singleton++-- | Add a character to the beginning of a Text.+--+-- > cons 'T' "he truth is out there" == "The truth is out there"+cons :: Char -> Text -> Text+cons = Data.Text.cons++-- | Split a non-empty Text 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 :: Text -> Maybe (Char, Text)+uncons = Data.Text.uncons++-- HIGHER-ORDER FUNCTIONS++-- | Transform every character in a Text+--+-- > map (\c -> if c == '/' then '.' else c) "a/b/c" == "a.b.c"+map :: (Char -> Char) -> Text -> Text+map = Data.Text.map++-- | Keep only the characters that pass the test.+--+-- > filter isDigit "R2-D2" == "22"+filter :: (Char -> Bool) -> Text -> Text+filter = Data.Text.filter++-- | Reduce a Text from the left.+--+-- > foldl cons "" "time" == "emit"+foldl :: (Char -> b -> b) -> b -> Text -> b+foldl f = Data.Text.foldl' (\a b -> f b a)++-- | Reduce a Text from the right.+--+-- > foldr cons "" "time" == "time"+foldr :: (Char -> b -> b) -> b -> Text -> b+foldr = Data.Text.foldr++-- | Determine whether /any/ characters pass the test.+--+-- > any isDigit "90210" == True+-- > any isDigit "R2-D2" == True+-- > any isDigit "heart" == False+any :: (Char -> Bool) -> Text -> Bool+any = Data.Text.any++-- | Determine whether /all/ characters pass the test.+--+-- > all isDigit "90210" == True+-- > all isDigit "R2-D2" == False+-- > all isDigit "heart" == False+all :: (Char -> Bool) -> Text -> Bool+all = Data.Text.all
+ src/Tuple.hs view
@@ -0,0 +1,94 @@+-- | Haskell has built-in syntax for tuples, so you can define 2D points like+-- this:+--+-- > origin :: (Float, Float)+-- > origin =+-- > (0, 0)+-- >+-- > position :: (Float, Float)+-- > position =+-- > (3, 4)+--+-- This module is a bunch of helpers for working with 2-tuples.+--+-- __Note 1:__ For more complex data, it is best to switch to records. So+-- instead of representing a 3D point as @(3,4,5)@ and not having any helper+-- functions, represent it as @Coords { x = 3, y = 4, z = 5 }@ and use all the+-- built-in record syntax!+--+-- __Note 2:__ If your record contains a bunch of @Bool@ and @Maybe@ values, you may want to upgrade to union types. Check out [Joël’s post][https://robots.thoughtbot.com/modeling-with-union-types] for more info on this. (Picking appropriate data structures is super important in Haskell!)+module Tuple+ ( -- * Create+ pair,++ -- * Access+ first,+ second,++ -- * Map+ mapFirst,+ mapSecond,+ mapBoth,+ )+where++-- CREATE++-- | Create a 2-tuple.+--+-- > -- pair 3 4 == (3, 4)+-- >+-- > zip :: List a -> List b -> List (a, b)+-- > zip xs ys =+-- > List.map2 Tuple.pair xs ys+pair :: a -> b -> (a, b)+pair a b =+ (a, b)++-- ACCESS++-- | Extract the first value from a tuple.+--+-- > first (3, 4) == 3+-- > first ("john", "doe") == "john"+first :: (a, b) -> a+first (x, _) =+ x++-- | Extract the second value from a tuple.+--+-- > second (3, 4) == 4+-- > second ("john", "doe") == "doe"+second :: (a, b) -> b+second (_, y) =+ y++-- MAP++-- | 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 -> x) -> (a, b) -> (x, b)+mapFirst func (x, y) =+ (func x, y)++-- | Transform the second value in a tuple.+--+-- > mapSecond sqrt ("stressed", 16) == ("stressed", 4)+-- > mapSecond negate ("stressed", 16) == ("stressed", -16)+mapSecond :: (b -> y) -> (a, b) -> (a, y)+mapSecond func (x, y) =+ (x, func y)++-- | Transform both parts of a tuple.+--+-- > import String+-- >+-- > mapBoth String.reverse sqrt ("stressed", 16) == ("desserts", 4)+-- > mapBoth String.length negate ("stressed", 16) == (8, -16)+mapBoth :: (a -> x) -> (b -> y) -> (a, b) -> (x, y)+mapBoth funcA funcB (x, y) =+ (funcA x, funcB y)
+ tests/ArraySpec.hs view
@@ -0,0 +1,277 @@+module ArraySpec (tests) where++import Array+import NriPrelude hiding (map)+import qualified Expect+import qualified Fuzz+import qualified List+import Test (Test, describe, fuzz, fuzz2, test)++tests :: Test+tests =+ describe+ "Array tests"+ [ initTests,+ isEmptyTests,+ lengthTests,+ getSetTests,+ conversionTests,+ transformTests,+ sliceTests+ ]++limit :: Int+limit = 10000++size :: Fuzz.Fuzzer Int+size = Fuzz.intRange 1 limit++toLimit :: Int -> Fuzz.Fuzzer Int+toLimit x = Fuzz.intRange x limit++initTests :: Test+initTests =+ describe+ "Initialization"+ [ fuzz size "initialize" <| \size_ ->+ initialize size_ identity+ |> toList+ |> Expect.equal (List.range 0 (size_ - 1)),+ fuzz size "push" <| \size_ ->+ size_ - 1+ |> List.range 0+ |> List.foldl push empty+ |> Expect.equal (initialize size_ identity),+ test "initialize non-identity" <| \() ->+ initialize 4 (\n -> n * n)+ |> toList+ |> Expect.equal+ [0, 1, 4, 9],+ test "initialize empty" <| \() ->+ initialize 0 identity+ |> toList+ |> Expect.equal [],+ test "initialize negative" <| \() ->+ initialize (-2) identity+ |> toList+ |> Expect.equal []+ ]++isEmptyTests :: Test+isEmptyTests =+ describe+ "isEmpty"+ [ test "all empty arrays are equal" <| \() ->+ empty+ |> Expect.equal+ (fromList [] :: Array ()),+ test "empty array" <| \() ->+ isEmpty empty+ |> Expect.equal True,+ test "empty converted array" <| \() ->+ isEmpty (fromList [])+ |> Expect.equal True,+ test "non-empty array" <| \() ->+ isEmpty (fromList [1 :: Int])+ |> Expect.equal False+ ]++lengthTests :: Test+lengthTests =+ describe+ "Length"+ [ test "empty array" <| \() ->+ Expect.equal (length empty) 0,+ fuzz size "non-empty array" <| \size_ ->+ initialize size_ identity+ |> length+ |> Expect.equal size_,+ fuzz size "push" <| \size_ ->+ initialize size_ identity+ |> push size_+ |> length+ |> Expect.equal (size_ + 1),+ fuzz size "append" <| \size_ ->+ initialize (size_ // 2) identity+ |> append (initialize size_ identity)+ |> length+ |> Expect.equal (size_ + (size_ // 2)),+ fuzz size "set does not increase" <| \size_ ->+ initialize size_ identity+ |> set (size_ // 2) 1+ |> length+ |> Expect.equal size_,+ fuzz (toLimit 100) "big slice" <| \size_ ->+ initialize size_ identity+ |> slice 35 (-35)+ |> length+ |> Expect.equal (size_ - 70),+ fuzz2+ (Fuzz.intRange (-32) (-1))+ (toLimit 100)+ "small slice end"+ <| \n size_ ->+ initialize size_ identity+ |> slice 0 n+ |> length+ |> Expect.equal (size_ + n)+ ]++getSetTests :: Test+getSetTests =+ describe+ "Get and set"+ [ fuzz2 size size "can retrieve element" <| \x y ->+ let n = min x y+ size_ = max x y+ in get n (initialize (size_ + 1) identity)+ |> Expect.equal (Just n),+ fuzz2+ (Fuzz.intRange 1 50)+ (toLimit 100)+ "out of bounds retrieval returns nothing"+ <| \n size_ ->+ let arr = initialize size_ identity+ in Expect.all+ [ \() -> Expect.equal (get (negate n) arr) Nothing,+ \() -> Expect.equal (get (size_ + n) arr) Nothing+ ]+ (),+ fuzz2 size size "set replaces value" <| \x y ->+ let n = min x y+ size_ = max x y+ in initialize (size_ + 1) identity+ |> set n 5+ |> get n+ |> Expect.equal (Just 5),+ fuzz2+ (Fuzz.intRange 1 50)+ size+ "set out of bounds returns original array"+ <| \n size_ ->+ let arr = initialize size_ identity+ in set (negate n) 5 arr+ |> set (size_ + n) 5+ |> Expect.equal arr,+ test "Retrieval works from tail" <| \() ->+ initialize 1035 identity+ |> set 1030 5+ |> get 1030+ |> Expect.equal (Just 5)+ ]++conversionTests :: Test+conversionTests =+ describe+ "Conversion"+ [ fuzz size "back and forth" <| \size_ ->+ let ls = List.range 0 (size_ - 1)+ in fromList ls+ |> toList+ |> Expect.equal ls,+ fuzz size "indexed" <| \size_ ->+ initialize size_ (1 +)+ |> toIndexedList+ |> Expect.equal+ ( toList+ ( initialize+ size_+ (\idx -> (idx, idx + 1))+ )+ )+ ]++transformTests :: Test+transformTests =+ describe+ "Transform"+ [ fuzz size "foldl" <| \size_ ->+ initialize size_ identity+ |> foldl (:) []+ |> Expect.equal+ ( List.reverse (List.range 0 (size_ - 1))+ ),+ fuzz size "foldr" <| \size_ ->+ initialize size_ identity+ |> foldr (:) []+ |> Expect.equal (List.range 0 (size_ - 1)),+ fuzz size "filter" <| \size_ ->+ initialize size_ identity+ |> filter (\a -> modBy 2 a == 0)+ |> toList+ |> Expect.equal+ ( List.filter+ (\a -> modBy 2 a == 0)+ (List.range 0 (size_ - 1))+ ),+ fuzz size "map" <| \size_ ->+ initialize size_ identity+ |> map (1 +)+ |> Expect.equal (initialize size_ (1 +)),+ fuzz size "indexedMap" <| \size_ ->+ repeat size_ 5+ |> indexedMap (*)+ |> Expect.equal (initialize size_ (5 *)),+ fuzz size "push appends one element" <| \size_ ->+ initialize size_ identity+ |> push size_+ |> Expect.equal (initialize (size_ + 1) identity),+ fuzz (Fuzz.intRange 1 1050) "append" <| \size_ ->+ initialize size_ (size_ +)+ |> append (initialize size_ identity)+ |> Expect.equal (initialize (size_ * 2) identity),+ fuzz2 size (Fuzz.intRange 1 32) "small appends" <| \s1 s2 ->+ initialize s2 (s1 +)+ |> append (initialize s1 identity)+ |> Expect.equal (initialize (s1 + s2) identity)+ ]++sliceTests :: Test+sliceTests =+ let smallSample = fromList (List.range 1 8)+ in describe+ "Slice"+ [ fuzz2 (Fuzz.intRange (-50) (-1)) (toLimit 100) "both" <| \n size_ ->+ initialize size_ identity+ |> slice (abs n) n+ |> Expect.equal+ ( initialize+ (size_ + n + n)+ (\idx -> idx - n)+ ),+ fuzz2 (Fuzz.intRange (-50) (-1)) (toLimit 100) "left" <| \n size_ ->+ let arr = initialize size_ identity+ in slice (abs n) (length arr) arr+ |> Expect.equal+ ( initialize (size_ + n) (\idx -> idx - n)+ ),+ fuzz2 (Fuzz.intRange (-50) (-1)) (toLimit 100) "right" <| \n size_ ->+ initialize size_ identity+ |> slice 0 n+ |> Expect.equal (initialize (size_ + n) identity),+ fuzz size "slicing all but the last item" <| \size_ ->+ initialize size_ identity+ |> slice (-1) size_+ |> toList+ |> Expect.equal [size_ - 1],+ test "both small" <| \() ->+ slice 2 5 smallSample+ |> toList+ |> Expect.equal (List.range 3 5),+ test "start small" <| \() ->+ slice 2 (length smallSample) smallSample+ |> toList+ |> Expect.equal (List.range 3 8),+ test "negative" <| \() ->+ slice (-5) (-2) smallSample+ |> toList+ |> Expect.equal (List.range 4 6),+ test "impossible" <| \() ->+ slice (-1) (-2) smallSample+ |> toList+ |> Expect.equal [],+ test "crash" <| \() ->+ repeat (33 * 32) 1+ |> slice 0 1+ |> Expect.equal (repeat 1 1 :: Array Int)+ ]
+ tests/BitwiseSpec.hs view
@@ -0,0 +1,108 @@+module BitwiseSpec (tests) where++import Bitwise+import NriPrelude+import qualified Expect+import Test (Test, describe, test)++tests :: Test+tests =+ describe+ "Bitwise"+ [ describe+ "and"+ [ test "and with 32 bit integers" <| \() ->+ Bitwise.and 5 3+ |> Expect.equal 1,+ test "and with 0 as first argument" <| \() ->+ Bitwise.and 0 1450+ |> Expect.equal 0,+ test "and with 0 as second argument" <| \() ->+ Bitwise.and 274 0+ |> Expect.equal 0,+ test "and with -1 as first argument" <| \() ->+ Bitwise.and (-1) 2671+ |> Expect.equal 2671,+ test "and with -1 as second argument" <| \() ->+ Bitwise.and 96 (-1)+ |> Expect.equal 96+ ],+ describe+ "or"+ [ test "or with 32 bit integers" <| \() ->+ Bitwise.or 9 14+ |> Expect.equal 15,+ test "or with 0 as first argument" <| \() ->+ Bitwise.or 0 843+ |> Expect.equal 843,+ test "or with 0 as second argument" <| \() ->+ Bitwise.or 19 0+ |> Expect.equal 19,+ test "or with -1 as first argument" <| \() ->+ Bitwise.or (-1) 2360+ |> Expect.equal (-1),+ test "or with -1 as second argument" <| \() ->+ Bitwise.or 3 (-1)+ |> Expect.equal (-1)+ ],+ describe+ "xor"+ [ test "xor with 32 bit integers" <| \() ->+ Bitwise.xor 580 24+ |> Expect.equal 604,+ test "xor with 0 as first argument" <| \() ->+ Bitwise.xor 0 56+ |> Expect.equal 56,+ test "xor with 0 as second argument" <| \() ->+ Bitwise.xor (-268) 0+ |> Expect.equal (-268),+ test "xor with -1 as first argument" <| \() ->+ Bitwise.xor (-1) 24+ |> Expect.equal (-25),+ test "xor with -1 as second argument" <| \() ->+ Bitwise.xor (-25602) (-1)+ |> Expect.equal 25601+ ],+ describe+ "complement"+ [ test "complement a positive" <| \() ->+ Bitwise.complement 8+ |> Expect.equal (-9),+ test "complement a negative" <| \() ->+ Bitwise.complement (-279)+ |> Expect.equal 278+ ],+ describe+ "shiftLeftBy"+ [ test "8 |> shiftLeftBy 1 == 16" <| \() ->+ 8 |> Bitwise.shiftLeftBy 1+ |> Expect.equal 16,+ test "8 |> shiftLeftby 2 == 32" <| \() ->+ 8 |> Bitwise.shiftLeftBy 2+ |> Expect.equal 32+ ],+ describe+ "shiftRightBy"+ [ test "32 |> shiftRight 1 == 16" <| \() ->+ 32 |> Bitwise.shiftRightBy 1+ |> Expect.equal 16,+ test "32 |> shiftRight 2 == 8" <| \() ->+ 32 |> Bitwise.shiftRightBy 2+ |> Expect.equal 8,+ test "-32 |> shiftRight 1 == -16" <| \() ->+ -32 |> Bitwise.shiftRightBy 1+ |> Expect.equal (-16)+ ],+ describe+ "shiftRightZfBy"+ [ test "32 |> shiftRightZfBy 1 == 16" <| \() ->+ 32 |> Bitwise.shiftRightZfBy 1+ |> Expect.equal 16,+ test "32 |> shiftRightZfBy 2 == 8" <| \() ->+ 32 |> Bitwise.shiftRightZfBy 2+ |> Expect.equal 8,+ test "-32 |> shiftRightZfBy 1 == 9223372036854775792" <| \() ->+ -32 |> Bitwise.shiftRightZfBy 1+ |> Expect.equal 9223372036854775792+ ]+ ]
+ tests/DebugSpec.hs view
@@ -0,0 +1,51 @@+module DebugSpec (tests) where++import NriPrelude+import Control.Exception.Safe (SomeException)+import Control.Exception.Safe as Exception+import qualified Debug+import qualified Expect+import List (head)+import Test (Test, describe, test)+import qualified Text+import Prelude (Either (Left, Right), Show)++tests :: Test+tests =+ describe+ "Debug Tests"+ [ describe "toString" toStringTests,+ describe "log" logTests,+ describe "todo" todoTests+ ]++toStringTests :: List Test+toStringTests =+ [ test "returns the show form of an empty String"+ <| \() -> Expect.equal "\"\"" (Debug.toString ("" :: Text)),+ test "returns the show form of an Int"+ <| \() -> Expect.equal "0" (Debug.toString (0 :: Int))+ ]++logTests :: List Test+logTests =+ [ test "returns passed value"+ <| \() -> Expect.equal 3.14 (Debug.log "Output" (3.14 :: Float))+ ]++todoTests :: List Test+todoTests =+ [ test "that an exception is raised with the given message"+ <| \() ->+ Expect.withIO+ ( \result -> case result of+ Left (exception :: SomeException) -> Expect.equal (Just "Not yet!") (firstLine exception)+ Right _home -> Expect.fail "No exception raised"+ )+ (Exception.try (Debug.todo ("Not yet!" :: Text)))+ ]++-- | Extracts the first line of a given text string if it exists. Otherwise returns Nothing.+firstLine :: Show a => a -> Maybe Text+firstLine =+ Debug.toString >> Text.lines >> head
+ tests/DictSpec.hs view
@@ -0,0 +1,136 @@+module DictSpec (tests) where++import Basics+import qualified Dict+import qualified Expect+import qualified List+import Maybe (Maybe (Just, Nothing))+import Test (Test, describe, test)+import Text (Text)++tests :: Test+tests =+ let buildTests =+ describe+ "build Tests"+ [ test "empty" <| \() -> Expect.equal (Dict.fromList []) (Dict.empty :: Dict.Dict () ()),+ 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 (always 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 (\key _v -> key == "Tom") animals),+ test "partition" <| \() -> Expect.equal (Dict.singleton tom cat, Dict.singleton "Jerry" "mouse") (Dict.partition (\key _v -> key == "Tom") animals)+ ]+ mergeTests =+ let insertBoth key leftVal rightVal =+ Dict.insert key (leftVal ++ rightVal)+ 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.Dict Text [Int])+ (Dict.merge Dict.insert insertBoth Dict.insert Dict.empty Dict.empty Dict.empty),+ test "merge singletons in order" <| \() ->+ Expect.equal+ [(u1, [1 :: Int]), (u2, [2])]+ (Dict.toList (Dict.merge Dict.insert insertBoth Dict.insert s1 s2 Dict.empty)),+ test "merge singletons out of order" <| \() ->+ Expect.equal+ [(u1, [1]), (u2, [2])]+ (Dict.toList (Dict.merge Dict.insert insertBoth Dict.insert s2 s1 Dict.empty)),+ test "merge with duplicate key" <| \() ->+ Expect.equal+ [(u2, [2, 3])]+ (Dict.toList (Dict.merge Dict.insert insertBoth Dict.insert s2 s23 Dict.empty)),+ test "partially overlapping" <| \() ->+ Expect.equal+ bExpected+ (Dict.toList (Dict.merge Dict.insert insertBoth Dict.insert b1 b2 Dict.empty))+ ]+ in describe+ "Dict Tests"+ [ buildTests,+ queryTests,+ combineTests,+ transformTests,+ mergeTests+ ]++-- Most of the names below exist because Haskell can't figure out the string+-- type to use, so we must annotate the type. They're here rather than in the+-- tests above because it gets noisy with all the annotations in-line. The+-- original Elm tests did not have this problem.+--+k :: Text+k = "k"++kk :: Text+kk = "kk"++v :: Text+v = "v"++vv :: Text+vv = "vv"++animals :: Dict.Dict Text Text+animals =+ Dict.fromList [("Tom", "cat"), ("Jerry", "mouse")]++tom :: Text+tom = "Tom"++spike :: Text+spike = "Spike"++jerry :: Text+jerry = "Jerry"++cat :: Text+cat = "cat"++mouse :: Text+mouse = "mouse"++u1 :: Text+u1 = "u1"++u2 :: Text+u2 = "u2"
+ tests/LogSpec.hs view
@@ -0,0 +1,192 @@+module LogSpec (tests) where++import NriPrelude+import qualified Control.Concurrent+import qualified Control.Exception.Safe as Exception+import qualified Data.IORef as IORef+import qualified Debug+import qualified Expect+import qualified GHC.Stack as Stack+import Log+import qualified Platform.Internal as Internal+import qualified Task+import Test (Test, describe, test)+import qualified Text+import qualified Text.Show.Pretty+import qualified Prelude++-- | These tests would likely benefit from golden test support, so we don't+-- need to store these expectation strings inside of the files here and can+-- update them more easily if they change.+tests :: Test+tests =+ describe+ "Log"+ [ test "`info` produces expected debugging info" <| \_ ->+ Expect.withIO identity <| do+ (recordedTracingSpans, handler) <- newHandler+ _ <- info "logging a message!" [context "a number" (12 :: Int)] |> Task.attempt handler+ spans <- recordedTracingSpans+ spans+ |> Debug.toString+ |> Expect.equalToContentsOf "tests/golden-results/log-info"+ |> Prelude.pure,+ test "`userIsAnnoyed` produces expected debugging info" <| \_ ->+ Expect.withIO identity <| do+ (recordedTracingSpans, handler) <- newHandler+ _ <-+ userIsAnnoyed+ "the button didn't work"+ "fix the button"+ [context "button" ("PRESS" :: Text)]+ |> Task.attempt handler+ spans <- recordedTracingSpans+ spans+ |> Debug.toString+ |> Expect.equalToContentsOf "tests/golden-results/log-user-is-annoyed"+ |> Prelude.pure,+ test "`userIsPained` produces expected debugging info" <| \_ ->+ Expect.withIO identity <| do+ (recordedTracingSpans, handler) <- newHandler+ _ <-+ userIsPained+ "user cut themselves on the modal"+ "file modal's sharp edges"+ [context "modal" ("SURPRISE!" :: Text)]+ |> Task.attempt handler+ spans <- recordedTracingSpans+ spans+ |> Debug.toString+ |> Expect.equalToContentsOf "tests/golden-results/log-user-is-pained"+ |> Prelude.pure,+ test "`userIsBlocked` produces expected debugging info" <| \_ ->+ Expect.withIO identity <| do+ (recordedTracingSpans, handler) <- newHandler+ _ <-+ userIsBlocked+ "door is blocked"+ "find key"+ [context "house number" (5 :: Int)]+ |> Task.attempt handler+ spans <- recordedTracingSpans+ spans+ |> Debug.toString+ |> Expect.equalToContentsOf "tests/golden-results/log-user-is-blocked"+ |> Prelude.pure,+ test "nested spans pruduce expected debugging info" <| \_ ->+ Expect.withIO+ identity+ <| do+ (recordedTracingSpans, handler) <- newHandler+ _ <-+ info "log!" []+ |> withContext "inner span" [context "word" ("sabbatical" :: Text)]+ |> withContext "outer span" [context "number" (825 :: Int)]+ |> Task.attempt handler+ spans <- recordedTracingSpans+ spans+ |> Debug.toString+ |> Expect.equalToContentsOf "tests/golden-results/log-nested-spans"+ |> Prelude.pure,+ test "unexpected exceptions produce expected debugging info" <| \_ ->+ Expect.withIO+ identity+ <| do+ (recordedTracingSpans, handler) <- newHandler+ _ <-+ Internal.Task (\_ -> Exception.throwIO TestException)+ |> withContext "inner span" [context "word" ("sabbatical" :: Text)]+ |> withContext "outer span" [context "number" (825 :: Int)]+ |> Task.attempt handler+ |> Exception.handle (\TestException -> Prelude.pure (Ok ()))+ spans <- recordedTracingSpans+ spans+ |> Debug.toString+ |> Expect.equalToContentsOf "tests/golden-results/log-unexpected-exceptions"+ |> Prelude.pure,+ test "async exceptions produce expected debugging info" <| \_ ->+ Expect.withIO+ identity+ <| do+ (recordedTracingSpans, handler) <- newHandler+ threadId <- Control.Concurrent.myThreadId+ _ <-+ Internal.Task+ ( \_ -> do+ Exception.throwTo threadId TestException+ Prelude.pure (Ok ())+ )+ |> withContext "inner span" [context "word" ("sabbatical" :: Text)]+ |> withContext "outer span" [context "number" (825 :: Int)]+ |> Task.attempt handler+ |> Exception.handleAsync (\(Exception.AsyncExceptionWrapper _) -> Prelude.pure (Ok ()))+ spans <- recordedTracingSpans+ spans+ |> Debug.toString+ |> Expect.equalToContentsOf "tests/golden-results/log-async-exceptions"+ |> Prelude.pure,+ test "secrets do not appear in debugging info" <| \_ ->+ Expect.withIO identity <| do+ (recordedTracingSpans, handler) <- newHandler+ _ <-+ info+ "logging a message!"+ [context "secret" (Log.mkSecret ("Mango's are delicious" :: Text))]+ |> Task.attempt handler+ spans <- recordedTracingSpans+ spans+ |> Debug.toString+ |> Text.contains "Mango"+ |> Expect.equal False+ |> Prelude.pure,+ -- Haskell's default @show@ instance prints the shown Haskell value on a+ -- single line. This isn't great when using @show@ to debug larger Haskell+ -- values. That's why our @Debug.toString@ implementation uses the+ -- @pretty-show@ package for rendering a Haskell value as a string, which+ -- provides the alternative @ppShow@ function for printing Haskell values+ -- with newlines. @ppShow@ works for all Haskell types with a @Show@+ -- instance.+ --+ -- @ppShow@ works internally by using regular @show@, parsing the+ -- generated string into some type representing an arbitrary Haskell+ -- value, then printing that again in a nicer way. The library relies on+ -- Haskell's derived @Show@ instances looking a particular way. When we+ -- define a custom @Show@ instance for a type we're not bound to the+ -- conventions Haskell uses for it's automatically generated @Show@+ -- instances, and @ppShow@ might not know how to parse the string we+ -- produce for a value. Should @ppShow@ fail to use its parser it falls+ -- back to using regular @show@ for presenting the value, so without+ -- newlines.+ --+ -- Generally Haskell recommends you do not write your own @Show@+ -- instances. We provide one for @Secret@ to help us accidentally put+ -- sensitive values in our logs. This test checks our custom @Secret@+ -- show instance can be parsed by @ppShow@, ensuring that @Secret@ values+ -- and larger types containing @Secret@ values can be pretty printed by+ -- @Debug.toString@.+ test "`Debug.toString` can pretty-print values containing secrets" <| \_ ->+ Log.mkSecret ()+ |> Text.Show.Pretty.reify+ |> Expect.notEqual Nothing+ ]++data TestException = TestException deriving (Show)++instance Exception.Exception TestException++newHandler :: Stack.HasCallStack => Prelude.IO (Prelude.IO [Internal.TracingSpan], Internal.Handler)+newHandler = do+ recordedTracingSpans <- IORef.newIORef []+ handler <-+ Stack.withFrozenCallStack+ Internal.mkHandler+ ""+ (Internal.Clock (Prelude.pure 0))+ (IORef.writeIORef recordedTracingSpans << Internal.children)+ ""+ Prelude.pure+ ( do+ Internal.finishTracingSpan handler Nothing+ IORef.readIORef recordedTracingSpans,+ handler+ )
+ tests/Main.hs view
@@ -0,0 +1,33 @@+module Main+ ( main,+ )+where++import qualified ArraySpec+import qualified BitwiseSpec+import qualified DebugSpec+import qualified DictSpec+import qualified LogSpec+import qualified PlatformSpec+import qualified SetSpec+import Test (Test, describe)+import qualified Test.Runner.Tasty+import qualified TextSpec+import Prelude (IO)++main :: IO ()+main = Test.Runner.Tasty.main tests++tests :: Test+tests =+ describe+ "NriPrelude"+ [ ArraySpec.tests,+ BitwiseSpec.tests,+ DictSpec.tests,+ SetSpec.tests,+ TextSpec.tests,+ LogSpec.tests,+ PlatformSpec.tests,+ DebugSpec.tests+ ]
+ tests/PlatformSpec.hs view
@@ -0,0 +1,23 @@+module PlatformSpec (tests) where++import NriPrelude+import Data.Aeson as Aeson+import qualified Expect+import qualified Platform+import Test (Test, describe, test)++tests :: Test+tests =+ describe+ "Platform"+ [ test "can recover custom span details from TracingSpanDetails" <| \_ ->+ CustomTracingSpanDetails "Hi!"+ |> Platform.toTracingSpanDetails+ |> Platform.fromTracingSpanDetails+ |> Expect.equal (Just (CustomTracingSpanDetails "Hi!"))+ ]++newtype CustomTracingSpanDetails = CustomTracingSpanDetails Text+ deriving (Aeson.ToJSON, Show, Eq)++instance Platform.TracingSpanDetails CustomTracingSpanDetails
+ tests/SetSpec.hs view
@@ -0,0 +1,187 @@+module SetSpec (tests) where++import NriPrelude+import qualified Expect+import List (List)+import qualified List+import Set (Set)+import qualified Set+import Test (Test, describe, test)++tests :: Test+tests =+ describe+ "Set Tests"+ [ describe "empty" emptyTests,+ describe "singleton" singletonTests,+ describe "insert" insertTests,+ describe "remove" removeTests,+ describe "isEmpty" isEmptyTests,+ describe "member" memberTests,+ describe "size" sizeTests,+ describe "foldl" foldlTests,+ describe "foldr" foldrTests,+ describe "map" mapTests,+ describe "filter" filterTests,+ describe "partition" partitionTests,+ describe "union" unionTests,+ describe "intersect" intersectTests,+ describe "diff" diffTests,+ describe "toList" toListTests,+ describe "fromList" fromListTests+ ]++-- HELPERS+set42 :: Set Int+set42 =+ Set.singleton 42++set1To100 :: Set Int+set1To100 =+ Set.fromList (List.range 1 100)++set1To50 :: Set Int+set1To50 =+ Set.fromList (List.range 1 50)++set51To100 :: Set Int+set51To100 =+ Set.fromList (List.range 51 100)++set51To150 :: Set Int+set51To150 =+ Set.fromList (List.range 51 150)++isLessThan51 :: Int -> Bool+isLessThan51 n =+ n < 51++one :: Int+one = 1++-- TESTS+emptyTests :: List Test+emptyTests =+ [ test "returns an empty set" <| \() -> Expect.equal 0 (Set.size Set.empty)+ ]++singletonTests :: List Test+singletonTests =+ [ test "returns set with one element" <| \() -> Expect.equal 1 (Set.size (Set.singleton one)),+ test "contains given element" <| \() -> Expect.equal True (Set.member 1 (Set.singleton one))+ ]++insertTests :: List Test+insertTests =+ [ test "adds new element to empty set" <| \() -> Expect.equal set42 (Set.insert 42 Set.empty),+ test "adds new element to a set of 100" <| \() -> Expect.equal (Set.fromList (List.range 1 101)) (Set.insert 101 set1To100),+ test "leaves singleton set intact if it contains given element" <| \() -> Expect.equal set42 (Set.insert 42 set42),+ test "leaves set of 100 intact if it contains given element" <| \() -> Expect.equal set1To100 (Set.insert 42 set1To100)+ ]++removeTests :: List Test+removeTests =+ [ test "removes element from singleton set" <| \() -> Expect.equal Set.empty (Set.remove 42 set42),+ test "removes element from set of 100" <| \() -> Expect.equal (Set.fromList (List.range 1 99)) (Set.remove 100 set1To100),+ test "leaves singleton set intact if it doesn't contain given element" <| \() -> Expect.equal set42 (Set.remove (-1) set42),+ test "leaves set of 100 intact if it doesn't contain given element" <| \() -> Expect.equal set1To100 (Set.remove (-1) set1To100)+ ]++isEmptyTests :: List Test+isEmptyTests =+ [ test "returns True for empty set" <| \() -> Expect.equal True (Set.isEmpty Set.empty),+ test "returns False for singleton set" <| \() -> Expect.equal False (Set.isEmpty set42),+ test "returns False for set of 100" <| \() -> Expect.equal False (Set.isEmpty set1To100)+ ]++memberTests :: List Test+memberTests =+ [ test "returns True when given element inside singleton set" <| \() -> Expect.equal True (Set.member 42 set42),+ test "returns True when given element inside set of 100" <| \() -> Expect.equal True (Set.member 42 set1To100),+ test "returns False for element not in singleton" <| \() -> Expect.equal False (Set.member (-1) set42),+ test "returns False for element not in set of 100" <| \() -> Expect.equal False (Set.member (-1) set1To100)+ ]++sizeTests :: List Test+sizeTests =+ [ test "returns 0 for empty set" <| \() -> Expect.equal 0 (Set.size Set.empty),+ test "returns 1 for singleton set" <| \() -> Expect.equal 1 (Set.size set42),+ test "returns 100 for set of 100" <| \() -> Expect.equal 100 (Set.size set1To100)+ ]++foldlTests :: List Test+foldlTests =+ [ test "with insert and empty set acts as identity function" <| \() -> Expect.equal set1To100 (Set.foldl Set.insert Set.empty set1To100),+ test "with counter and zero acts as size function" <| \() -> Expect.equal (100 :: Int) (Set.foldl (\_ count -> count + 1) 0 set1To100),+ test "folds set elements from lowest to highest" <| \() -> Expect.equal [3, 2, 1] (Set.foldl (:) [] (Set.fromList [2, one, 3]))+ ]++foldrTests :: List Test+foldrTests =+ [ test "with insert and empty set acts as identity function" <| \() -> Expect.equal set1To100 (Set.foldr Set.insert Set.empty set1To100),+ test "with counter and zero acts as size function" <| \() -> Expect.equal (100 :: Int) (Set.foldr (\_ count -> count + 1) 0 set1To100),+ test "folds set elements from highest to lowest" <| \() -> Expect.equal [1, 2, 3] (Set.foldr (:) [] (Set.fromList [2, one, 3]))+ ]++mapTests :: List Test+mapTests =+ [ test "applies given function to singleton element" <| \() -> Expect.equal (Set.singleton 43) (Set.map (1 +) set42),+ test "applies given function to each element" <| \() -> Expect.equal (Set.fromList (List.range (-100) (-1))) (Set.map negate set1To100)+ ]++filterTests :: List Test+filterTests =+ [ test "with always True doesn't change anything" <| \() -> Expect.equal set1To100 (Set.filter (always True) set1To100),+ test "with always False returns empty set" <| \() -> Expect.equal Set.empty (Set.filter (always False) set1To100),+ test "simple filter" <| \() -> Expect.equal set1To50 (Set.filter isLessThan51 set1To100)+ ]++partitionTests :: List Test+partitionTests =+ [ test "of empty set returns two empty sets" <| \() -> Expect.equal (Set.empty, Set.empty) (Set.partition isLessThan51 Set.empty),+ test "simple partition" <| \() -> Expect.equal (set1To50, set51To100) (Set.partition isLessThan51 set1To100)+ ]++unionTests :: List Test+unionTests =+ [ test "with empty set doesn't change anything" <| \() -> Expect.equal set42 (Set.union set42 Set.empty),+ test "with itself doesn't change anything" <| \() -> Expect.equal set1To100 (Set.union set1To100 set1To100),+ test "with subset doesn't change anything" <| \() -> Expect.equal set1To100 (Set.union set1To100 set42),+ test "with superset returns superset" <| \() -> Expect.equal set1To100 (Set.union set42 set1To100),+ test "contains elements of both singletons" <| \() -> Expect.equal (Set.insert 1 set42) (Set.union set42 (Set.singleton 1)),+ test "consists of elements from either set" <| \() -> Set.union set1To100 set51To150 |> Expect.equal (Set.fromList (List.range 1 150))+ ]++intersectTests :: List Test+intersectTests =+ [ test "with empty set returns empty set" <| \() -> Expect.equal Set.empty (Set.intersect set42 Set.empty),+ test "with itself doesn't change anything" <| \() -> Expect.equal set1To100 (Set.intersect set1To100 set1To100),+ test "with subset returns subset" <| \() -> Expect.equal set42 (Set.intersect set1To100 set42),+ test "with superset doesn't change anything" <| \() -> Expect.equal set42 (Set.intersect set42 set1To100),+ test "returns empty set given disjunctive sets" <| \() -> Expect.equal Set.empty (Set.intersect set42 (Set.singleton 1)),+ test "consists of common elements only" <| \() -> Set.intersect set1To100 set51To150 |> Expect.equal set51To100+ ]++diffTests :: List Test+diffTests =+ [ test "with empty set doesn't change anything" <| \() -> Expect.equal set42 (Set.diff set42 Set.empty),+ test "with itself returns empty set" <| \() -> Expect.equal Set.empty (Set.diff set1To100 set1To100),+ test "with subset returns set without subset elements" <| \() -> Expect.equal (Set.remove 42 set1To100) (Set.diff set1To100 set42),+ test "with superset returns empty set" <| \() -> Expect.equal Set.empty (Set.diff set42 set1To100),+ test "doesn't change anything given disjunctive sets" <| \() -> Expect.equal set42 (Set.diff set42 (Set.singleton 1)),+ test "only keeps values that don't appear in the second set" <| \() -> Set.diff set1To100 set51To150 |> Expect.equal set1To50+ ]++toListTests :: List Test+toListTests =+ [ test "returns empty list for empty set" <| \() -> Expect.equal ([] :: List ()) (Set.toList Set.empty),+ test "returns singleton list for singleton set" <| \() -> Expect.equal [42] (Set.toList set42),+ test "returns sorted list of set elements" <| \() -> Expect.equal (List.range 1 100) (Set.toList set1To100)+ ]++fromListTests :: List Test+fromListTests =+ [ test "returns empty set for empty list" <| \() -> Expect.equal (Set.empty :: Set ()) (Set.fromList []),+ test "returns singleton set for singleton list" <| \() -> Expect.equal set42 (Set.fromList [42]),+ test "returns set with unique list elements" <| \() -> Expect.equal set1To100 (Set.fromList (1 : List.range 1 100))+ ]
+ tests/TextSpec.hs view
@@ -0,0 +1,145 @@+module TextSpec (tests) where++import NriPrelude+import qualified Expect+import Test (Test, describe, test)+import Text++tests :: Test+tests =+ describe+ "Text"+ [ describe+ "Simple Stuff"+ [ test "is empty" <| \() ->+ Expect.equal True (Text.isEmpty ""),+ test "is not empty" <| \() ->+ Expect.equal True (not (Text.isEmpty "the world")),+ test "length" <| \() ->+ Expect.equal 11 (Text.length "innumerable"),+ test "endsWith" <| \() ->+ Expect.equal True <| Text.endsWith "ship" "spaceship",+ test "reverse" <| \() ->+ Expect.equal "desserts" (Text.reverse "stressed"),+ test "repeat" <| \() ->+ Expect.equal "hahaha" (Text.repeat 3 "ha"),+ test "indexes" <| \() ->+ Expect.equal [0, 2] (Text.indexes "a" "aha"),+ test "empty indexes" <| \() ->+ Expect.equal [] (Text.indexes "" "aha")+ ],+ describe+ "Combining"+ [ test "uncons non-empty" <| \() ->+ Expect.equal (Just ('a', "bc")) (Text.uncons "abc"),+ test "uncons empty" <| \() ->+ Expect.nothing (Text.uncons ""),+ test "append 1" <| \() ->+ Expect.equal "butterfly" (Text.append "butter" "fly"),+ test "append 2" <| \() ->+ Expect.equal "butter" (Text.append "butter" ""),+ test "append 3" <| \() ->+ Expect.equal "butter" (Text.append "" "butter"),+ test "concat" <| \() ->+ Expect.equal "nevertheless" (Text.concat ["never", "the", "less"]),+ test "split commas" <| \() ->+ Expect.equal ["cat", "dog", "cow"] (Text.split "," "cat,dog,cow"),+ test "split slashes" <| \() ->+ Expect.equal ["home", "steve", "Desktop", ""] (Text.split "/" "home/steve/Desktop/"),+ test "join spaces" <| \() ->+ Expect.equal "cat dog cow" (Text.join " " ["cat", "dog", "cow"]),+ test "join slashes" <| \() ->+ Expect.equal "home/steve/Desktop" (Text.join "/" ["home", "steve", "Desktop"]),+ test "slice 1" <| \() ->+ Expect.equal "c" (Text.slice 2 3 "abcd"),+ test "slice 2" <| \() ->+ Expect.equal "abc" (Text.slice 0 3 "abcd"),+ test "slice 3" <| \() ->+ Expect.equal "abc" (Text.slice 0 (-1) "abcd"),+ test "slice 4" <| \() ->+ Expect.equal "cd" (Text.slice (-2) 4 "abcd"),+ test "slice 5" <| \() ->+ Expect.equal "ab" (Text.slice (-6) 2 "abcd"),+ test "slice 6" <| \() ->+ Expect.equal "cd" (Text.slice 2 6 "abcd")+ ],+ describe+ "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"+ ],+ describe+ "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"+ ],+ describe+ "UTF-16 Encoding"+ [ test "reverse 1" <| \() ->+ Expect.equal "𝌆c𝌆b𝌆a𝌆" (Text.reverse "𝌆a𝌆b𝌆c𝌆"),+ test "reverse 2" <| \() ->+ Expect.equal "nàm" (Text.reverse "màn"),+ test "reverse 3" <| \() ->+ Expect.equal "😣ba" (Text.reverse "ab😣"),+ test "filter" <| \() ->+ Expect.equal "mànabc" (Text.filter (/= '😣') "màn😣abc"),+ test "toList" <| \() ->+ Expect.equal ['𝌆', 'a', '𝌆', 'b', '𝌆'] (Text.toList "𝌆a𝌆b𝌆"),+ test "uncons" <| \() ->+ Expect.equal (Just ('😃', "bc")) (Text.uncons "😃bc"),+ test "map 1" <| \() ->+ Expect.equal "aaa" (Text.map (\_ -> 'a') "😃😃😃"),+ test "map 2" <| \() ->+ Expect.equal "😃😃😃" (Text.map (\_ -> '😃') "aaa"),+ test "foldl" <| \() ->+ Expect.equal (3 :: Int) (Text.foldl (\_ c -> c + 1) 0 "😃😃😃"),+ test "foldr" <| \() ->+ Expect.equal (3 :: Int) (Text.foldr (\_ c -> c + 1) 0 "😃😃😃"),+ test "all" <| \() ->+ Expect.equal True (Text.all (== '😃') "😃😃😃"),+ test "any" <| \() ->+ Expect.equal True (Text.any (== '😃') "abc😃123")+ ]+ ]++-- NUMBER HELPERS+goodInt :: Text -> Int -> Test+goodInt str int =+ test (str ++ " is good") <| \() ->+ Expect.equal (Text.toInt str) (Just int)++badInt :: Text -> Test+badInt str =+ test (str ++ " is bad") <| \() ->+ Expect.equal (Text.toInt str) Nothing++goodFloat :: Text -> Float -> Test+goodFloat str float =+ test (str ++ " is good") <| \() ->+ Expect.equal (Text.toFloat str) (Just float)++badFloat :: Text -> Test+badFloat str =+ test (str ++ " is bad") <| \() ->+ Expect.equal (Text.toFloat str) Nothing