diff --git a/src/Expect.elm b/src/Expect.elm index 3d597b43..854a0f91 100644 --- a/src/Expect.elm +++ b/src/Expect.elm @@ -103,6 +103,7 @@ Another example is comparing values that are on either side of zero. `0.0001` is -} import Dict exposing (Dict) +import Fuzz.Internal import Set exposing (Set) import Test.Distribution import Test.Expectation @@ -392,10 +393,12 @@ ok result = pass Err _ -> - { description = "Expect.ok" - , reason = Comparison "Ok _" (Internal.toString result) - } - |> Test.Expectation.fail + Test.Expectation.Fail + { given = Nothing + , distributionReport = Fuzz.Internal.noDistribution + , description = "Expect.ok" + , reason = Comparison "Ok _" (Internal.toString result) + } {-| Passes if the @@ -433,10 +436,12 @@ err : Result a b -> Expectation err result = case result of Ok _ -> - { description = "Expect.err" - , reason = Comparison "Err _" (Internal.toString result) - } - |> Test.Expectation.fail + Test.Expectation.Fail + { given = Nothing + , distributionReport = Fuzz.Internal.noDistribution + , description = "Expect.err" + , reason = Comparison "Err _" (Internal.toString result) + } Err _ -> pass @@ -475,10 +480,12 @@ equalLists expected actual = pass else - { description = "Expect.equalLists" - , reason = ListDiff (List.map Internal.toString expected) (List.map Internal.toString actual) - } - |> Test.Expectation.fail + Test.Expectation.Fail + { given = Nothing + , distributionReport = Fuzz.Internal.noDistribution + , description = "Expect.equalLists" + , reason = ListDiff (List.map Internal.toString expected) (List.map Internal.toString actual) + } {-| Passes if the arguments are equal dicts. @@ -595,7 +602,7 @@ equalSets expected actual = -} pass : Expectation pass = - Test.Expectation.Pass { distributionReport = Test.Distribution.NoDistribution } + Test.Expectation.Pass (Test.Distribution.NoDistribution ()) {-| Fails with the given message. @@ -617,7 +624,12 @@ pass = -} fail : String -> Expectation fail str = - Test.Expectation.fail { description = str, reason = Custom } + Test.Expectation.Fail + { given = Nothing + , distributionReport = Fuzz.Internal.noDistribution + , description = str + , reason = Custom + } {-| If the given expectation fails, replace its failure message with a custom one. @@ -671,8 +683,10 @@ which argument is which: all : List (subject -> Expectation) -> subject -> Expectation all list query = if List.isEmpty list then - Test.Expectation.fail - { reason = Invalid EmptyList + Test.Expectation.Fail + { given = Nothing + , distributionReport = Fuzz.Internal.noDistribution + , reason = Invalid EmptyList , description = "Expect.all was given an empty list. You must make at least one expectation to have a valid test!" } @@ -701,16 +715,18 @@ allHelp list query = reportCollectionFailure : String -> a -> b -> List c -> List d -> Expectation reportCollectionFailure comparison expected actual missingKeys extraKeys = - { description = comparison - , reason = - { expected = Internal.toString expected - , actual = Internal.toString actual - , extra = List.map Internal.toString extraKeys - , missing = List.map Internal.toString missingKeys + Test.Expectation.Fail + { given = Nothing + , distributionReport = Fuzz.Internal.noDistribution + , description = comparison + , reason = + { expected = Internal.toString expected + , actual = Internal.toString actual + , extra = List.map Internal.toString extraKeys + , missing = List.map Internal.toString missingKeys + } + |> CollectionDiff } - |> CollectionDiff - } - |> Test.Expectation.fail {-| String arg is label, e.g. "Expect.equal". @@ -731,16 +747,13 @@ equateWith reason comparison b a = usesFloats = isFloat (Internal.toString a) || isFloat (Internal.toString b) - - floatError = - if String.contains reason "not" then - "Do not use Expect.notEqual with floats. Use Expect.notWithin instead." - - else - "Do not use Expect.equal with floats. Use Expect.within instead." in if usesFloats then - fail floatError + if String.contains reason "not" then + fail "Do not use Expect.notEqual with floats. Use Expect.notWithin instead." + + else + fail "Do not use Expect.equal with floats. Use Expect.within instead." else testWith Equality reason comparison b a @@ -757,10 +770,12 @@ testWith makeReason label runTest expected actual = pass else - { description = label - , reason = makeReason (Internal.toString expected) (Internal.toString actual) - } - |> Test.Expectation.fail + Test.Expectation.Fail + { given = Nothing + , distributionReport = Fuzz.Internal.noDistribution + , description = label + , reason = makeReason (Internal.toString expected) (Internal.toString actual) + } @@ -796,13 +811,28 @@ relative tolerance = nonNegativeToleranceError : FloatingPointTolerance -> String -> Expectation -> Expectation nonNegativeToleranceError tolerance name result = if absolute tolerance < 0 && relative tolerance < 0 then - Test.Expectation.fail { description = "Expect." ++ name ++ " was given negative absolute and relative tolerances", reason = Custom } + Test.Expectation.Fail + { given = Nothing + , distributionReport = Fuzz.Internal.noDistribution + , description = "Expect." ++ name ++ " was given negative absolute and relative tolerances" + , reason = Custom + } else if absolute tolerance < 0 then - Test.Expectation.fail { description = "Expect." ++ name ++ " was given a negative absolute tolerance", reason = Custom } + Test.Expectation.Fail + { given = Nothing + , distributionReport = Fuzz.Internal.noDistribution + , description = "Expect." ++ name ++ " was given a negative absolute tolerance" + , reason = Custom + } else if relative tolerance < 0 then - Test.Expectation.fail { description = "Expect." ++ name ++ " was given a negative relative tolerance", reason = Custom } + Test.Expectation.Fail + { given = Nothing + , distributionReport = Fuzz.Internal.noDistribution + , description = "Expect." ++ name ++ " was given a negative relative tolerance" + , reason = Custom + } else result @@ -810,12 +840,9 @@ nonNegativeToleranceError tolerance name result = withinCompare : FloatingPointTolerance -> Float -> Float -> Bool withinCompare tolerance a b = - let - withinAbsoluteTolerance = - a - absolute tolerance <= b && b <= a + absolute tolerance - - withinRelativeTolerance = - (a - abs (a * relative tolerance) <= b && b <= a + abs (a * relative tolerance)) - || (b - abs (b * relative tolerance) <= a && a <= b + abs (b * relative tolerance)) - in - (a == b) || withinAbsoluteTolerance || withinRelativeTolerance + (a == b) + -- within absolute tolerance + || (a - absolute tolerance <= b && b <= a + absolute tolerance) + -- within relative tolerance + || (a - abs (a * relative tolerance) <= b && b <= a + abs (a * relative tolerance)) + || (b - abs (b * relative tolerance) <= a && a <= b + abs (b * relative tolerance)) diff --git a/src/Fuzz.elm b/src/Fuzz.elm index 4e806527..1e1fdbd7 100644 --- a/src/Fuzz.elm +++ b/src/Fuzz.elm @@ -75,7 +75,6 @@ can usually find the simplest input that reproduces a bug. import Array exposing (Array) import Bitwise -import Char import Dict exposing (Dict) import Fuzz.Float import Fuzz.Internal exposing (Fuzzer(..)) @@ -1145,15 +1144,14 @@ frequencyHelp functionName fuzzers = intFrequency (List.map (Tuple.mapFirst round) nonzeroFuzzers) else - let - weightSum : Float - weightSum = - List.foldl (\( w, _ ) acc -> w + acc) 0 nonzeroFuzzers - in percentage |> andThen (\p -> let + weightSum : Float + weightSum = + List.foldl (\( w, _ ) acc -> w + acc) 0 nonzeroFuzzers + f : Float f = p * weightSum @@ -1204,11 +1202,12 @@ intFrequency fuzzers = rollDice (weightSum - 1) (intFrequencyGenerator n (List.map Tuple.first rest)) |> andThen (\i -> - fuzzers - |> List.drop i - |> List.head - |> Maybe.map Tuple.second - |> Maybe.withDefault (invalid "elm-test bug: intFrequency index out of range") + case List.getAt i fuzzers of + Just ( _, fuzzer ) -> + fuzzer + + Nothing -> + invalid "elm-test bug: intFrequency index out of range" ) [] -> @@ -1621,7 +1620,7 @@ rollDice maxValue diceGenerator = else Generated { value = hardcodedChoice - , prng = Hardcoded { h | unusedPart = restOfChoices } + , prng = Hardcoded { wholeRun = h.wholeRun, unusedPart = restOfChoices } } @@ -1640,7 +1639,7 @@ forcedChoice n = Random r -> Generated { value = n - , prng = Random { r | run = RandomRun.append n r.run } + , prng = Random { run = RandomRun.append n r.run, seed = r.seed } } Hardcoded h -> @@ -1662,7 +1661,7 @@ forcedChoice n = else Generated { value = n - , prng = Hardcoded { h | unusedPart = restOfChoices } + , prng = Hardcoded { wholeRun = h.wholeRun, unusedPart = restOfChoices } } @@ -1670,11 +1669,7 @@ forcedChoice n = -} intToBool : Int -> Bool intToBool n = - if n == 0 then - False - - else - True + n /= 0 weightedBoolGenerator : Float -> Random.Generator Int @@ -1795,46 +1790,49 @@ labelExamples n labels fuzzer = Nothing ) in - if List.isEmpty categories then + if List.isEmpty categories || Dict.member categories acc then acc else - acc - |> Dict.update categories - (\maybeExample -> - case maybeExample of - Nothing -> - Just item - - Just original -> - Just original - ) + Dict.insert categories item acc ) Dict.empty - combinations : List ( List String, a ) + combinations : List ( List String, Maybe a ) combinations = - foundExamples - |> Dict.filter (\k _ -> List.length k > 1) - |> Dict.toList + Dict.foldr + (\label example l -> + if List.hasMultipleItems label then + ( label, Just example ) :: l + + else + l + ) + [] + foundExamples in List.filterMap (\( label, _ ) -> - case Dict.get [ label ] foundExamples of + let + thisLabel : List String + thisLabel = + [ label ] + in + case Dict.get thisLabel foundExamples of Nothing -> if Dict.any (\k _ -> List.member label k) foundExamples then - -- don't show this example: all its occurences were included in combination with some other label + -- don't show this example: all its occurrences were included in combination with some other label Nothing else -- show that we didn't find it (in any combination nor alone) - Just ( [ label ], Nothing ) + Just ( thisLabel, Nothing ) - Just example -> - Just ( [ label ], Just example ) + (Just _) as justExample -> + Just ( thisLabel, justExample ) ) labels - ++ List.map (\( label, example ) -> ( label, Just example )) combinations + ++ combinations Rejected _ -> [] diff --git a/src/Fuzz/Internal.elm b/src/Fuzz/Internal.elm index e605fa54..cb625d72 100644 --- a/src/Fuzz/Internal.elm +++ b/src/Fuzz/Internal.elm @@ -1,4 +1,4 @@ -module Fuzz.Internal exposing (Fuzzer(..), generate) +module Fuzz.Internal exposing (Fuzzer(..), generate, noDistribution) {-| This module is here just to hide the `generate` function from the end users of the library. @@ -6,6 +6,7 @@ of the library. import GenResult exposing (GenResult) import PRNG exposing (PRNG) +import Test.Distribution exposing (DistributionReport) type Fuzzer a @@ -15,3 +16,8 @@ type Fuzzer a generate : PRNG -> Fuzzer a -> GenResult a generate prng (Fuzzer fuzzer) = fuzzer prng + + +noDistribution : DistributionReport +noDistribution = + Test.Distribution.NoDistribution () diff --git a/src/MicroBitwiseExtra.elm b/src/MicroBitwiseExtra.elm index 1b7c4dcf..a8724d11 100644 --- a/src/MicroBitwiseExtra.elm +++ b/src/MicroBitwiseExtra.elm @@ -28,17 +28,16 @@ isBitSet index num = int52FromTuple : ( Int, Int ) -> Int int52FromTuple ( highBits, lowBits ) = - (+) - (highBits - |> keepBits 20 - |> signedToUnsigned - -- Bitwise.shiftLeftBy 32 would be buggy, so we do: - |> (*) 0x0000000100000000 - ) - (lowBits + (highBits + |> keepBits 20 + |> signedToUnsigned + -- Bitwise.shiftLeftBy 32 would be buggy, so we do: + |> (*) 0x0000000100000000 + ) + + (lowBits |> signedToUnsigned |> keepBits 32 - ) + ) int52ToTuple : Int -> ( Int, Int ) @@ -94,9 +93,7 @@ reverseByte b_ = reverseByteTable : Array Int reverseByteTable = -- TODO PERF `Dict Int Int` or `IntDict Int` or `List` instead? Benchmark? - List.range 0 255 - |> List.map reverseByte - |> Array.fromList + Array.initialize (255 + 1) reverseByte memoizedReverseByte : Int -> Int diff --git a/src/MicroListExtra.elm b/src/MicroListExtra.elm index 8c4408d6..c1acb989 100644 --- a/src/MicroListExtra.elm +++ b/src/MicroListExtra.elm @@ -1,8 +1,10 @@ module MicroListExtra exposing ( fastConcat - , fastConcatMap , find + , findMap , getAt + , hasMultipleItems + , isSingleton , setAt , splitWhen , transpose @@ -37,11 +39,6 @@ fastConcat = List.foldr (++) [] -fastConcatMap : (a -> List b) -> List a -> List b -fastConcatMap f = - List.foldr (\e a -> f e ++ a) [] - - find : (a -> Bool) -> List a -> Maybe a find predicate list = case list of @@ -56,6 +53,21 @@ find predicate list = find predicate rest +findMap : (a -> Maybe b) -> List a -> Maybe b +findMap predicate list = + case list of + [] -> + Nothing + + first :: rest -> + case predicate first of + Nothing -> + findMap predicate rest + + justB -> + justB + + splitWhen : (a -> Bool) -> List a -> Maybe ( List a, List a ) splitWhen predicate list = findIndex predicate list @@ -101,6 +113,26 @@ rowsLength listOfLists = List.length x +isSingleton : List a -> Bool +isSingleton list = + case list of + [ _ ] -> + True + + _ -> + False + + +hasMultipleItems : List a -> Bool +hasMultipleItems list = + case list of + _ :: _ :: _ -> + True + + _ -> + False + + unique : List a -> List a unique list = uniqueHelp identity [] list [] diff --git a/src/MicroMaybeExtra.elm b/src/MicroMaybeExtra.elm deleted file mode 100644 index 596d1116..00000000 --- a/src/MicroMaybeExtra.elm +++ /dev/null @@ -1,21 +0,0 @@ -module MicroMaybeExtra exposing (traverse) - - -traverse : (a -> Maybe b) -> List a -> Maybe (List b) -traverse f list = - traverseHelp f list [] - - -traverseHelp : (a -> Maybe b) -> List a -> List b -> Maybe (List b) -traverseHelp f list acc = - case list of - head :: tail -> - case f head of - Just a -> - traverseHelp f tail (a :: acc) - - Nothing -> - Nothing - - [] -> - Just (List.reverse acc) diff --git a/src/Queue.elm b/src/Queue.elm index eb9c92b3..9b855ffc 100644 --- a/src/Queue.elm +++ b/src/Queue.elm @@ -1,8 +1,7 @@ module Queue exposing - ( Queue, empty, singleton - , isEmpty, size, enqueue, dequeue, front + ( Queue, empty + , enqueue, dequeue , fromList, toList - , map, filter, updateFront ) {-| NOTE: Vendored from turboMaCk/queue 1.1.0 @@ -14,12 +13,12 @@ Queue is simple FIFO (first in, first out) datastructure. # Type -@docs Queue, empty, singleton +@docs Queue, empty # Query -@docs isEmpty, size, enqueue, dequeue, front +@docs enqueue, dequeue # Lists @@ -29,8 +28,6 @@ Queue is simple FIFO (first in, first out) datastructure. # Transformations -@docs map, filter, updateFront - -} -- Types @@ -74,44 +71,10 @@ empty = Queue [] [] -{-| Construct Queue containing single value - - Queue.toList (Queue.singleton 1) == [ 1 ] - --} -singleton : a -> Queue a -singleton a = - Queue [ a ] [] - - -- Query -{-| Determine if `Queue` is empty - - Queue.isEmpty Queue.empty == True - - Queue.isEmpty (Queue.fromList [ 1, 2 ]) == False - --} -isEmpty : Queue a -> Bool -isEmpty (Queue fl rl) = - List.isEmpty fl && List.isEmpty rl - - -{-| Get size of `Queue` - - Queue.size Queue.empty == 0 - - Queue.size (Queue.fromList [ 1, 2 ]) == 2 - --} -size : Queue a -> Int -size (Queue fl rl) = - List.length fl + List.length rl - - {-| Add item to `Queue` Queue.size (Queue.enqueue 1 Queue.empty) == 1 @@ -126,59 +89,19 @@ enqueue a (Queue fl rl) = {-| Take item from `Queue` - Queue.dequeue Queue.empty == ( Nothing, Queue.empty ) + Queue.dequeue Queue.empty == Nothing - Queue.dequeue (Queue.fromList [ 1 ]) == ( Just 1, Queue.empty ) + Queue.dequeue (Queue.fromList [ 1 ]) == Just ( 1, Queue.empty ) -} -dequeue : Queue a -> ( Maybe a, Queue a ) +dequeue : Queue a -> Maybe ( a, Queue a ) dequeue (Queue fl rl) = case fl of [] -> - ( Nothing, Queue [] [] ) + Nothing head :: tail -> - ( Just head, queue tail rl ) - - -{-| Ask for front item without removing it from `Queue` - - Queue.front Queue.empty == Nothing - - Queue.front (Queue.fromList [ 1, 2 ]) == Just 1 - --} -front : Queue a -> Maybe a -front (Queue fl _) = - List.head fl - - -{-| Update value at the front of the queue - - Queue.toList (Queue.updateFront (Maybe.map (\x -> x + 1)) (Queue.singleton 3)) == [ 4 ] - - Queue.toList (Queue.updateFront (Maybe.map (\_ -> Just 42)) Queue.empty) == [ 42 ] - - Queue.toList (Queue.updateFront (Maybe.map (\_ -> Nothing)) (Queue.singleton 3)) == [] - --} -updateFront : (Maybe a -> Maybe a) -> Queue a -> Queue a -updateFront f (Queue fl rl) = - let - update_ maybe t = - case f maybe of - Just a -> - a :: t - - Nothing -> - t - in - case fl of - h :: t -> - Queue (update_ (Just h) t) rl - - [] -> - Queue (update_ Nothing []) rl + Just ( head, queue tail rl ) @@ -211,35 +134,3 @@ toList (Queue fl rl) = -- Transform - - -{-| Map function over `Queue` - - Queue.toList (Queue.map identity (Queue.fromList [ 1, 2 ])) == [ 1, 2 ] - - Queue.toList (Queue.map ((+) 1) (Queue.fromList [ 1, 2 ])) == [ 2, 3 ] - --} -map : (a -> b) -> Queue a -> Queue b -map fc (Queue fl rl) = - let - map_ = - List.map fc - in - queue (map_ fl) (map_ rl) - - -{-| Filter items items in `Queue` - - Queue.toList (Queue.filter identity (Queue.fromList [ True, False ])) == [ True ] - - Queue.toList (Queue.filter ((<) 1) (Queue.fromList [ 1, 2 ])) == [ 2 ] - --} -filter : (a -> Bool) -> Queue a -> Queue a -filter fc (Queue fl rl) = - let - f = - List.filter fc - in - queue (f fl) (f rl) diff --git a/src/RandomRun.elm b/src/RandomRun.elm index dca1c4dc..b146481e 100644 --- a/src/RandomRun.elm +++ b/src/RandomRun.elm @@ -53,24 +53,22 @@ isEmpty run = nextChoice : RandomRun -> Maybe ( Int, RandomRun ) nextChoice run = case Queue.dequeue run.data of - ( Nothing, _ ) -> + Nothing -> Nothing - ( Just first, rest ) -> + Just ( first, rest ) -> Just ( first - , { run - | length = run.length - 1 - , data = rest + , { length = run.length - 1 + , data = rest } ) append : Int -> RandomRun -> RandomRun append n run = - { run - | length = run.length + 1 - , data = Queue.enqueue (max 0 n) run.data + { length = run.length + 1 + , data = Queue.enqueue (max 0 n) run.data } @@ -103,18 +101,14 @@ deleteChunk chunk run = let list = Queue.toList run.data - - result = - { run - | length = run.length - chunk.size - , data = - (List.take chunk.startIndex list - ++ List.drop (chunk.startIndex + chunk.size) list - ) - |> Queue.fromList - } in - result + { length = run.length - chunk.size + , data = + (List.take chunk.startIndex list + ++ List.drop (chunk.startIndex + chunk.size) list + ) + |> Queue.fromList + } else run @@ -128,14 +122,14 @@ replaceChunkWithZero chunk run = list = Queue.toList run.data in - { run - | data = - List.fastConcat - [ List.take chunk.startIndex list - , List.repeat chunk.size 0 - , List.drop (chunk.startIndex + chunk.size) list - ] - |> Queue.fromList + { length = run.length + , data = + List.fastConcat + [ List.take chunk.startIndex list + , List.repeat chunk.size 0 + , List.drop (chunk.startIndex + chunk.size) list + ] + |> Queue.fromList } else @@ -190,12 +184,12 @@ swapChunks : -> RandomRun -> Maybe RandomRun swapChunks { leftChunk, rightChunk } run = - let - list = - Queue.toList run.data - in Maybe.map2 (\lefts rights -> + let + list = + Queue.toList run.data + in replaceInList (List.concat [ List.indexedMap (\i n -> ( rightChunk.startIndex + i, n )) lefts @@ -264,25 +258,23 @@ set index value run = run else - { run - | data = - run.data - |> Queue.toList - |> List.setAt index (max 0 value) run.length - |> Queue.fromList + { length = run.length + , data = + run.data + |> Queue.toList + |> List.setAt index (max 0 value) run.length + |> Queue.fromList } -sortKey : RandomRun -> ( Int, List Int ) -sortKey run = - ( run.length - , toList run - ) - - compare : RandomRun -> RandomRun -> Order compare a b = - Basics.compare (sortKey a) (sortKey b) + case Basics.compare a.length b.length of + EQ -> + Basics.compare (toList a) (toList b) + + order -> + order toList : RandomRun -> List Int diff --git a/src/Simplify.elm b/src/Simplify.elm index 6aefc27e..d2a90a8a 100644 --- a/src/Simplify.elm +++ b/src/Simplify.elm @@ -142,15 +142,14 @@ logRun label run = logState : String -> State a -> State a logState label state = - let - runString = - Debug.toString (RandomRun.toList state.randomRun) - in let _ = case Fuzz.Internal.generate (PRNG.hardcoded state.randomRun) state.fuzzer of Generated { value } -> let + runString = + Debug.toString (RandomRun.toList state.randomRun) + _ = Debug.log (label ++ " - " ++ runString ++ " --->") value in @@ -172,34 +171,30 @@ runCmd cmd state = else state.randomRun in - let - result = - case cmd.type_ of - DeleteChunkAndMaybeDecrementPrevious chunk -> - deleteChunkAndMaybeDecrementPrevious chunk state + case cmd.type_ of + DeleteChunkAndMaybeDecrementPrevious chunk -> + deleteChunkAndMaybeDecrementPrevious chunk state - ReplaceChunkWithZero chunk -> - replaceChunkWithZero chunk state + ReplaceChunkWithZero chunk -> + replaceChunkWithZero chunk state - SortChunk chunk -> - sortChunk chunk state + SortChunk chunk -> + sortChunk chunk state - MinimizeFloat options -> - minimizeFloat options state + MinimizeFloat options -> + minimizeFloat options state - MinimizeChoice options -> - minimizeChoice options state + MinimizeChoice options -> + minimizeChoice options state - RedistributeChoicesAndMaybeIncrement options -> - redistributeChoicesAndMaybeIncrement options state + RedistributeChoicesAndMaybeIncrement options -> + redistributeChoicesAndMaybeIncrement options state - DecrementTogether options -> - decrementTogether options state + DecrementTogether options -> + decrementTogether options state - SwapChunkWithNeighbour chunk -> - swapChunkWithNeighbour chunk state - in - result + SwapChunkWithNeighbour chunk -> + swapChunkWithNeighbour chunk state {-| Tries the new RandomRun with the given fuzzer and test fn, and if the run diff --git a/src/Simplify/Cmd.elm b/src/Simplify/Cmd.elm index df8a8977..ca934559 100644 --- a/src/Simplify/Cmd.elm +++ b/src/Simplify/Cmd.elm @@ -86,12 +86,15 @@ cmdsForRun run = let length = RandomRun.length run + + randomRunList = + RandomRun.toList run in List.fastConcat [ deletionCmds length , zeroCmds length - , minimizeChoiceCmds run length - , minimizeFloatCmds run length + , minimizeChoiceCmds randomRunList + , minimizeFloatCmds randomRunList length , sortCmds length , redistributeCmds length , decrementTogetherCmds length @@ -103,33 +106,34 @@ deletionCmds : Int -> List SimplifyCmd deletionCmds length = chunkCmds DeleteChunkAndMaybeDecrementPrevious - { length = length - , allowChunksOfSize1 = True - } + length + True zeroCmds : Int -> List SimplifyCmd zeroCmds length = chunkCmds ReplaceChunkWithZero - { length = length - , allowChunksOfSize1 = False -- already happens in binary search - } + length + False + + + +-- already happens in binary search sortCmds : Int -> List SimplifyCmd sortCmds length = chunkCmds SortChunk - { length = length - , allowChunksOfSize1 = False -- doesn't make sense for sorting - } + length + -- doesn't make sense for sorting + False -minimizeChoiceCmds : RandomRun -> Int -> List SimplifyCmd -minimizeChoiceCmds run length = +minimizeChoiceCmds : List Int -> List SimplifyCmd +minimizeChoiceCmds run = run - |> RandomRun.toList |> List.indexedMap Tuple.pair |> List.filterMap (\( index, value ) -> @@ -145,38 +149,53 @@ minimizeChoiceCmds run length = ) -minimizeFloatCmds : RandomRun -> Int -> List SimplifyCmd +minimizeFloatCmds : List Int -> Int -> List SimplifyCmd minimizeFloatCmds run length = let possibleBoolIndexes : Set Int possibleBoolIndexes = - run - |> RandomRun.toList - |> List.indexedMap Tuple.pair - |> List.filterMap - (\( index, value ) -> - if value > 1 then - Nothing - - else - Just index - ) - |> Set.fromList + computePossibleBoolIndexes 0 run Set.empty in - List.range 0 (length - 3) - |> List.filterMap - (\index -> - if Set.member (index + 2) possibleBoolIndexes then - Just - { type_ = MinimizeFloat { leftIndex = index } - , minLength = index + 3 - } + minimizeFloatCmdsHelp possibleBoolIndexes (length - 3) [] - else - Nothing + +minimizeFloatCmdsHelp : Set Int -> Int -> List SimplifyCmd -> List SimplifyCmd +minimizeFloatCmdsHelp possibleBoolIndexes index list = + if index < 0 then + list + + else + minimizeFloatCmdsHelp possibleBoolIndexes + (index - 1) + (if Set.member (index + 2) possibleBoolIndexes then + { type_ = MinimizeFloat { leftIndex = index } + , minLength = index + 3 + } + :: list + + else + list ) +computePossibleBoolIndexes : Int -> List Int -> Set Int -> Set Int +computePossibleBoolIndexes index run set = + case run of + [] -> + set + + value :: rest -> + computePossibleBoolIndexes + (index + 1) + rest + (if value > 1 then + set + + else + Set.insert index set + ) + + decrementTogetherCmds : Int -> List SimplifyCmd decrementTogetherCmds length = let @@ -187,21 +206,21 @@ decrementTogetherCmds length = else 2 in - List.range 0 (length - 2) - |> List.fastConcatMap - (\index -> + reverseRange (length - 2) 0 [] + |> List.foldl + (\index acc -> let maxOffset = min maxOffsetLimit (length - index - 1) in - List.range 1 maxOffset - |> List.fastConcatMap - (\offset -> - [ 4, 2, 1 ] - |> List.map - (\by -> + reverseRange maxOffset 1 [] + |> List.foldl + (\offset acc1 -> + [ 1, 2, 4 ] + |> List.foldl + (\by acc2 -> let rightIndex = index + offset @@ -214,43 +233,59 @@ decrementTogetherCmds length = } , minLength = rightIndex + 1 } + :: acc2 ) + acc1 ) + acc ) + [] + + +reverseRange : Int -> Int -> List Int -> List Int +reverseRange hi lo list = + if hi >= lo then + reverseRange hi (lo + 1) (lo :: list) + + else + list redistributeCmds : Int -> List SimplifyCmd redistributeCmds length = - let - forOffset : Int -> List SimplifyCmd - forOffset offset = - if offset >= length then - [] - - else - List.range 0 (length - 1 - offset) - |> List.reverse - |> List.map - (\leftIndex -> - { type_ = - RedistributeChoicesAndMaybeIncrement - { leftIndex = leftIndex - , rightIndex = leftIndex + offset - } - , minLength = leftIndex + offset + 1 - } - ) - in - forOffset 3 ++ forOffset 2 ++ forOffset 1 + [] + |> forOffset length 3 0 + |> forOffset length 2 0 + |> forOffset length 1 0 + + +forOffset : Int -> Int -> Int -> List SimplifyCmd -> List SimplifyCmd +forOffset length offset leftIndex cmds = + if leftIndex > (length - 1 - offset) then + cmds + + else + forOffset length + offset + (leftIndex + 1) + ({ type_ = + RedistributeChoicesAndMaybeIncrement + { leftIndex = leftIndex + , rightIndex = leftIndex + offset + } + , minLength = leftIndex + offset + 1 + } + :: cmds + ) swapCmds : Int -> List SimplifyCmd swapCmds length = chunkCmds SwapChunkWithNeighbour - { length = length - , allowChunksOfSize1 = False -- other Cmds are already doing the case with size=1 - } + length + False + -- other Cmds are already doing the case with size=1 |> List.map (\cmd -> case cmd.type_ of @@ -299,9 +334,10 @@ SortChunk { chunkSize = 8, startIndex = 2 } -- [..XXXXXXXX] -} chunkCmds : ({ size : Int, startIndex : Int } -> SimplifyCmdType) - -> { length : Int, allowChunksOfSize1 : Bool } + -> Int + -> Bool -> List SimplifyCmd -chunkCmds toType { length, allowChunksOfSize1 } = +chunkCmds toType length allowChunksOfSize1 = let initChunkSize : Int initChunkSize = diff --git a/src/Test.elm b/src/Test.elm index e8e85038..04c8b3c3 100644 --- a/src/Test.elm +++ b/src/Test.elm @@ -438,12 +438,8 @@ fuzz2 : -> String -> (a -> b -> Expectation) -> Test -fuzz2 fuzzA fuzzB desc = - let - fuzzer = - Fuzz.pair fuzzA fuzzB - in - (\f ( a, b ) -> f a b) >> fuzz fuzzer desc +fuzz2 fuzzA fuzzB desc getExpectation = + fuzz (Fuzz.pair fuzzA fuzzB) desc (\( a, b ) -> getExpectation a b) {-| Run a [fuzz test](#fuzz) using three random inputs. @@ -458,12 +454,8 @@ fuzz3 : -> String -> (a -> b -> c -> Expectation) -> Test -fuzz3 fuzzA fuzzB fuzzC desc = - let - fuzzer = - Fuzz.triple fuzzA fuzzB fuzzC - in - uncurry3 >> fuzz fuzzer desc +fuzz3 fuzzA fuzzB fuzzC desc getExpectation = + fuzz (Fuzz.triple fuzzA fuzzB fuzzC) desc (\( a, b, c ) -> getExpectation a b c) @@ -556,12 +548,3 @@ Currently the statistical test is tuned to allow a false positive/negative in expectDistribution : List ( ExpectedDistribution, String, a -> Bool ) -> Distribution a expectDistribution = Test.Distribution.Internal.ExpectDistribution - - - --- INTERNAL HELPERS -- - - -uncurry3 : (a -> b -> c -> d) -> ( a, b, c ) -> d -uncurry3 fn ( a, b, c ) = - fn a b c diff --git a/src/Test/Distribution.elm b/src/Test/Distribution.elm index e82ed510..b2bc1bba 100644 --- a/src/Test/Distribution.elm +++ b/src/Test/Distribution.elm @@ -69,7 +69,7 @@ Get it from your `Expectation` with `Test.Runner.getDistributionReport`. -} type DistributionReport - = NoDistribution + = NoDistribution () | DistributionToReport { distributionCount : Dict (List String) Int , runsElapsed : Int diff --git a/src/Test/Distribution/Internal.elm b/src/Test/Distribution/Internal.elm index ad8dec98..b6a05d46 100644 --- a/src/Test/Distribution/Internal.elm +++ b/src/Test/Distribution/Internal.elm @@ -5,10 +5,13 @@ module Test.Distribution.Internal exposing , formatPct , getDistributionLabels , getExpectedDistributions + , getExpectedDistributionsAsList , insufficientlyCovered , sufficientlyCovered ) +import Dict exposing (Dict) + type Distribution a = NoDistributionNeeded @@ -48,7 +51,20 @@ getDistributionLabels distribution = Just (List.map (\( _, l, p ) -> ( l, p )) list) -getExpectedDistributions : Distribution a -> Maybe (List ( String, ExpectedDistribution )) +getExpectedDistributionsAsList : Distribution a -> Maybe (List ( ExpectedDistribution, String, a -> Bool )) +getExpectedDistributionsAsList distribution = + case distribution of + NoDistributionNeeded -> + Nothing + + ReportDistribution _ -> + Nothing + + ExpectDistribution list -> + Just list + + +getExpectedDistributions : Distribution a -> Maybe (Dict String ExpectedDistribution) getExpectedDistributions distribution = case distribution of NoDistributionNeeded -> @@ -58,7 +74,7 @@ getExpectedDistributions distribution = Nothing ExpectDistribution list -> - Just (List.map (\( e, l, _ ) -> ( l, e )) list) + Just (List.foldl (\( e, l, _ ) dict -> Dict.insert l e dict) Dict.empty list) formatPct : Float -> String diff --git a/src/Test/Expectation.elm b/src/Test/Expectation.elm index 4b63253f..9ef12062 100644 --- a/src/Test/Expectation.elm +++ b/src/Test/Expectation.elm @@ -1,6 +1,5 @@ module Test.Expectation exposing ( Expectation(..) - , fail , withDistributionReport , withGiven ) @@ -10,7 +9,7 @@ import Test.Runner.Failure exposing (Reason) type Expectation - = Pass { distributionReport : DistributionReport } + = Pass DistributionReport | Fail { given : Maybe String , description : String @@ -19,25 +18,18 @@ type Expectation } -{-| Create a failure without specifying the given. --} -fail : { description : String, reason : Reason } -> Expectation -fail { description, reason } = - Fail - { given = Nothing - , description = description - , reason = reason - , distributionReport = NoDistribution - } - - {-| Set the given (fuzz test input) of an expectation. -} withGiven : String -> Expectation -> Expectation withGiven newGiven expectation = case expectation of Fail failure -> - Fail { failure | given = Just newGiven } + Fail + { given = Just newGiven + , description = failure.description + , reason = failure.reason + , distributionReport = failure.distributionReport + } Pass _ -> expectation @@ -49,7 +41,12 @@ withDistributionReport : DistributionReport -> Expectation -> Expectation withDistributionReport newDistributionReport expectation = case expectation of Fail failure -> - Fail { failure | distributionReport = newDistributionReport } + Fail + { given = failure.given + , description = failure.description + , reason = failure.reason + , distributionReport = newDistributionReport + } - Pass pass -> - Pass { pass | distributionReport = newDistributionReport } + Pass _ -> + Pass newDistributionReport diff --git a/src/Test/Fuzz.elm b/src/Test/Fuzz.elm index 56b121e3..a568b7f2 100644 --- a/src/Test/Fuzz.elm +++ b/src/Test/Fuzz.elm @@ -6,7 +6,6 @@ import Fuzz.Internal exposing (Fuzzer) import GenResult exposing (GenResult(..)) import MicroDictExtra as Dict import MicroListExtra as List -import MicroMaybeExtra as Maybe import PRNG import Random import Simplify @@ -14,7 +13,6 @@ import Test.Distribution exposing (DistributionReport(..)) import Test.Distribution.Internal exposing (Distribution(..), ExpectedDistribution(..)) import Test.Expectation exposing (Expectation(..)) import Test.Internal exposing (Test(..), blankDescriptionFailure) -import Test.Runner.Distribution import Test.Runner.Failure exposing (InvalidReason(..), Reason(..)) @@ -61,15 +59,12 @@ validatedFuzzTest desc fuzzer getExpectation distribution = in case runResult.failure of Nothing -> - Pass { distributionReport = runResult.distributionReport } + Pass runResult.distributionReport Just failure -> - { failure - | expectation = - failure.expectation - |> Test.Expectation.withDistributionReport runResult.distributionReport - } - |> formatExpectation + formatExpectation + failure.given + (Test.Expectation.withDistributionReport runResult.distributionReport failure.expectation) ) @@ -105,9 +100,10 @@ initLoopState initialSeed distribution = Test.Distribution.Internal.getDistributionLabels distribution |> Maybe.map (\labels -> - labels - |> List.map (\( label, _ ) -> ( [ label ], 0 )) - |> Dict.fromList + List.foldl + (\( label, _ ) dict -> Dict.insert [ label ] 0 dict) + Dict.empty + labels ) in { runsElapsed = 0 @@ -154,7 +150,7 @@ fuzzLoop c state = { distributionReport = case state.distributionCount of Nothing -> - NoDistribution + Fuzz.Internal.noDistribution Just distributionCount -> DistributionToReport @@ -176,7 +172,7 @@ fuzzLoop c state = else case c.distribution of NoDistributionNeeded -> - { distributionReport = NoDistribution + { distributionReport = Fuzz.Internal.noDistribution , failure = Nothing } @@ -245,150 +241,146 @@ type alias DistributionFailure = , actualPercentage : Float , expectedDistribution : ExpectedDistribution , runsElapsed : Int - , distributionCount : Dict (List String) Int } allSufficientlyCovered : LoopConstants a -> LoopState -> Maybe (Dict (List String) Int) -> Bool allSufficientlyCovered c state normalizedDistributionCount = - Maybe.map2 Tuple.pair - normalizedDistributionCount - (Test.Distribution.Internal.getExpectedDistributions c.distribution) - |> Maybe.andThen - (\( distributionCount, expectedDistributions ) -> - let - expectedDistributions_ : Dict String ExpectedDistribution - expectedDistributions_ = - Dict.fromList expectedDistributions - in - distributionCount + case normalizedDistributionCount of + Nothing -> + False + + Just distributionCount -> + case Test.Distribution.Internal.getExpectedDistributions c.distribution of + Nothing -> + False + + Just expectedDistributions -> -- Needs normalized distribution count: - |> Dict.toList - |> List.filterMap - (\( labels, count ) -> + Dict.foldr + (\labels count soFar -> case labels of [ onlyLabel ] -> - Just ( onlyLabel, count ) + soFar && isLabelSufficientlyCovered state.runsElapsed expectedDistributions onlyLabel count _ -> - Nothing + soFar ) - |> Maybe.traverse - (\( labels, count ) -> - Dict.get labels expectedDistributions_ - |> Maybe.map (\expectedDistribution -> ( labels, count, expectedDistribution )) - ) - |> Maybe.map - (List.all - (\( _, count, expectedDistribution ) -> - case expectedDistribution of - -- Zero and MoreThanZero will get checked in the Success case - Zero -> - True + True + distributionCount - MoreThanZero -> - True - AtLeast n -> - Test.Distribution.Internal.sufficientlyCovered state.runsElapsed count (n / 100) - ) - ) - ) - -- `Nothing` means something went wrong. We're answering the question "are all labels sufficiently covered?" and so the way to fail here is `False`. - |> Maybe.withDefault False +isLabelSufficientlyCovered : Int -> Dict String ExpectedDistribution -> String -> Int -> Bool +isLabelSufficientlyCovered runsElapsed expectedDistributions labels count = + case Dict.get labels expectedDistributions of + Nothing -> + -- `Nothing` means something went wrong. We're answering the question "are all labels sufficiently covered?" and so the way to fail here is `False`. + False + + Just expectedDistribution -> + case expectedDistribution of + -- Zero and MoreThanZero will get checked in the Success case + Zero -> + True + + MoreThanZero -> + True + + AtLeast n -> + Test.Distribution.Internal.sufficientlyCovered runsElapsed count (n / 100) findBadZeroRelatedCase : LoopConstants a -> LoopState -> Maybe (Dict (List String) Int) -> Maybe DistributionFailure findBadZeroRelatedCase c state normalizedDistributionCount = - Maybe.map2 Tuple.pair - normalizedDistributionCount - (Test.Distribution.Internal.getExpectedDistributions c.distribution) - |> Maybe.andThen - (\( distributionCount, expectedDistributions ) -> - expectedDistributions - |> List.find - (\( label, expectedDistribution ) -> - case expectedDistribution of - Zero -> - -- TODO short-circuit Zero sooner: as soon as we increment its counter, during runNTimes. - Dict.get [ label ] distributionCount - -- TODO it would be better if we returned a bug failure here instead of failing with a dummy value - |> Maybe.withDefault 1 - |> (/=) 0 - - MoreThanZero -> - Dict.get [ label ] distributionCount - -- TODO it would be better if we returned a bug failure here instead of failing with a dummy value - |> Maybe.withDefault 0 - |> (==) 0 - - AtLeast _ -> - False - ) - |> Maybe.andThen - (\( label, expectedDistribution ) -> - Dict.get [ label ] distributionCount - |> Maybe.map - (\count -> - { label = label - , actualPercentage = toFloat count * 100 / toFloat state.runsElapsed - , expectedDistribution = expectedDistribution - , runsElapsed = state.runsElapsed - , distributionCount = distributionCount - } - ) - ) - ) + case normalizedDistributionCount of + Nothing -> + Nothing + Just distributionCount -> + case Test.Distribution.Internal.getExpectedDistributionsAsList c.distribution of + Nothing -> + Nothing -findInsufficientlyCoveredLabel : LoopConstants a -> LoopState -> Maybe (Dict (List String) Int) -> Maybe DistributionFailure -findInsufficientlyCoveredLabel c state normalizedDistributionCount = - Maybe.map2 Tuple.pair - normalizedDistributionCount - (Test.Distribution.Internal.getExpectedDistributions c.distribution) - |> Maybe.andThen - (\( distributionCount, expectedDistributions ) -> - let - expectedDistributions_ : Dict String ExpectedDistribution - expectedDistributions_ = - Dict.fromList expectedDistributions - in - -- TODO loop ExpectedDistributions instead of looping the label combinations? - distributionCount - -- Needs normalized distribution count: - |> Dict.toList - |> List.filterMap - (\( labels, count ) -> - case labels of - [ onlyLabel ] -> - Dict.get onlyLabel expectedDistributions_ - |> Maybe.map (\expectedDistribution -> ( onlyLabel, count, expectedDistribution )) + Just expectedDistributions -> + expectedDistributions + |> List.find + (\( expectedDistribution, label, _ ) -> + case expectedDistribution of + Zero -> + -- TODO short-circuit Zero sooner: as soon as we increment its counter, during runNTimes. + Dict.get [ label ] distributionCount + -- TODO it would be better if we returned a bug failure here instead of failing with a dummy value + |> Maybe.withDefault 1 + |> (/=) 0 - _ -> - Nothing - ) - |> List.find - (\( _, count, expectedDistribution ) -> - case expectedDistribution of - Zero -> - False + MoreThanZero -> + Dict.get [ label ] distributionCount + -- TODO it would be better if we returned a bug failure here instead of failing with a dummy value + |> Maybe.withDefault 0 + |> (==) 0 - MoreThanZero -> - False + AtLeast _ -> + False + ) + |> Maybe.andThen + (\( expectedDistribution, label, _ ) -> + Dict.get [ label ] distributionCount + |> Maybe.map + (\count -> + { label = label + , actualPercentage = toFloat count * 100 / toFloat state.runsElapsed + , expectedDistribution = expectedDistribution + , runsElapsed = state.runsElapsed + } + ) + ) - AtLeast n -> - Test.Distribution.Internal.insufficientlyCovered state.runsElapsed count (n / 100) - ) - |> Maybe.map - (\( label, count, expectedDistribution ) -> - { label = label - , actualPercentage = toFloat count * 100 / toFloat state.runsElapsed - , expectedDistribution = expectedDistribution - , runsElapsed = state.runsElapsed - , distributionCount = distributionCount - } - ) - ) + +findInsufficientlyCoveredLabel : LoopConstants a -> LoopState -> Maybe (Dict (List String) Int) -> Maybe DistributionFailure +findInsufficientlyCoveredLabel c state normalizedDistributionCount = + case normalizedDistributionCount of + Nothing -> + Nothing + + Just distributionCount -> + case Test.Distribution.Internal.getExpectedDistributions c.distribution of + Nothing -> + Nothing + + Just expectedDistributions -> + -- TODO loop ExpectedDistributions instead of looping the label combinations? + distributionCount + -- Needs normalized distribution count: + |> Dict.toList + |> List.findMap + (\( labels, count ) -> + case labels of + [ onlyLabel ] -> + case Dict.get onlyLabel expectedDistributions of + Just Zero -> + Nothing + + Just MoreThanZero -> + Nothing + + Just ((AtLeast n) as expectedDistribution) -> + if Test.Distribution.Internal.insufficientlyCovered state.runsElapsed count (n / 100) then + Just + { label = onlyLabel + , actualPercentage = toFloat count * 100 / toFloat state.runsElapsed + , expectedDistribution = expectedDistribution + , runsElapsed = state.runsElapsed + } + + else + Nothing + + Nothing -> + Nothing + + _ -> + Nothing + ) distributionFailRunResult : Maybe (Dict (List String) Int) -> DistributionFailure -> RunResult @@ -413,13 +405,15 @@ distributionFailRunResult normalizedDistributionCount failedLabel = distributionBugRunResult : RunResult distributionBugRunResult = - { distributionReport = NoDistribution + { distributionReport = Fuzz.Internal.noDistribution , failure = Just { given = Nothing , expectation = - Test.Expectation.fail - { description = "elm-test distribution collection bug" + Test.Expectation.Fail + { given = Nothing + , distributionReport = Fuzz.Internal.noDistribution + , description = "elm-test distribution collection bug" , reason = Invalid DistributionBug } } @@ -430,8 +424,10 @@ distributionInsufficientFailure : DistributionFailure -> Failure distributionInsufficientFailure failure = { given = Nothing , expectation = - Test.Expectation.fail - { description = + Test.Expectation.Fail + { given = Nothing + , distributionReport = Fuzz.Internal.noDistribution + , description = """Distribution of label "{LABEL}" was insufficient: expected: {EXPECTED_PERCENTAGE} got: {ACTUAL_PERCENTAGE}. @@ -490,8 +486,10 @@ runOnce c state = ( Just { given = Nothing , expectation = - Test.Expectation.fail - { description = reason + Test.Expectation.Fail + { given = Nothing + , distributionReport = Fuzz.Internal.noDistribution + , description = reason , reason = Invalid InvalidFuzzer } } @@ -534,11 +532,11 @@ runOnce c state = in ( failure, distributionCounter ) in - { state - | failure = maybeFailure - , distributionCount = newDistributionCounter - , currentSeed = nextSeed - , runsElapsed = state.runsElapsed + 1 + { failure = maybeFailure + , distributionCount = newDistributionCounter + , currentSeed = nextSeed + , runsElapsed = state.runsElapsed + 1 + , nextPowerOfTwo = state.nextPowerOfTwo } @@ -549,14 +547,16 @@ includeCombinationsInBaseCounts distribution = (\labels count -> case labels of [ single ] -> - let - combinations : List Int - combinations = - distribution - |> Dict.filter (\k _ -> List.length k > 1 && List.member single k) - |> Dict.values - in - count + List.sum combinations + Dict.foldr + (\k value sum -> + if List.hasMultipleItems k && List.member single k then + value + sum + + else + sum + ) + count + distribution _ -> count @@ -612,8 +612,8 @@ findSimplestFailure state = } -formatExpectation : Failure -> Expectation -formatExpectation { given, expectation } = +formatExpectation : Maybe String -> Expectation -> Expectation +formatExpectation given expectation = case given of Nothing -> expectation diff --git a/src/Test/Html/Event.elm b/src/Test/Html/Event.elm index 41a73067..03cf768a 100644 --- a/src/Test/Html/Event.elm +++ b/src/Test/Html/Event.elm @@ -140,10 +140,9 @@ when testing that an event handler is _not_ present. toResult : Event msg -> Result String msg toResult event = findHandler event - |> Result.map (Decode.map .message) |> Result.andThen (\handler -> - Decode.decodeValue handler (eventPayload event) + Decode.decodeValue (Decode.map .message handler) (eventPayload event) |> Result.mapError Decode.errorToString ) @@ -434,9 +433,8 @@ checkPreventDefault = checkEffect : (Handling msg -> Bool) -> Event msg -> Result String Bool checkEffect extractor event = findHandler event - |> Result.map (Decode.map extractor) |> Result.andThen (\handler -> - Decode.decodeValue handler (eventPayload event) + Decode.decodeValue (Decode.map extractor handler) (eventPayload event) |> Result.mapError Decode.errorToString ) diff --git a/src/Test/Html/Internal/ElmHtml/InternalTypes.elm b/src/Test/Html/Internal/ElmHtml/InternalTypes.elm index 35c80fe6..44425968 100644 --- a/src/Test/Html/Internal/ElmHtml/InternalTypes.elm +++ b/src/Test/Html/Internal/ElmHtml/InternalTypes.elm @@ -1,22 +1,22 @@ module Test.Html.Internal.ElmHtml.InternalTypes exposing - ( ElmHtml(..), TextTagRecord, NodeRecord, CustomNodeRecord, MarkdownNodeRecord + ( ElmHtml(..), NodeRecord, CustomNodeRecord, MarkdownNodeRecord , Facts, Tagger, EventHandler, ElementKind(..) - , Attribute(..), AttributeRecord, NamespacedAttributeRecord, PropertyRecord, EventRecord + , Attribute(..), AttributeRecord, NamespacedAttributeRecord, PropertyRecord , Validation(..), validationMessage, validationFromMessage - , decodeElmHtml, emptyFacts, toElementKind, decodeAttribute + , decodeElmHtml, toElementKind, decodeAttribute ) {-| Internal types used to represent Elm Html in pure Elm -@docs ElmHtml, TextTagRecord, NodeRecord, CustomNodeRecord, MarkdownNodeRecord +@docs ElmHtml, NodeRecord, CustomNodeRecord, MarkdownNodeRecord @docs Facts, Tagger, EventHandler, ElementKind -@docs Attribute, AttributeRecord, NamespacedAttributeRecord, PropertyRecord, EventRecord +@docs Attribute, AttributeRecord, NamespacedAttributeRecord, PropertyRecord @docs Validation, validationMessage, validationFromMessage -@docs decodeElmHtml, emptyFacts, toElementKind, decodeAttribute +@docs decodeElmHtml, toElementKind, decodeAttribute -} @@ -38,18 +38,12 @@ import VirtualDom -} type ElmHtml msg - = TextTag TextTagRecord + = TextTag String | NodeEntry (NodeRecord msg) | CustomNode (CustomNodeRecord msg) | MarkdownNode (MarkdownNodeRecord msg) -{-| Text tags just contain text --} -type alias TextTagRecord = - { text : String } - - {-| A node contains the `tag` as a string, the children, the facts (e.g attributes) and descendantsCount -} type alias NodeRecord msg = @@ -122,7 +116,6 @@ type ElementKind = VoidElements | RawTextElements | EscapableRawTextElements - | ForeignElements | NormalElements @@ -148,13 +141,12 @@ type Attribute | NamespacedAttribute NamespacedAttributeRecord | Property PropertyRecord | Style { key : String, value : String } - | Event EventRecord {-| Attribute contains a string key and a string value -} type alias AttributeRecord = - { key : String + { name : String , value : String } @@ -176,21 +168,6 @@ type alias PropertyRecord = } -{-| Event contains a string key, a decoder for a msg and event options --} -type alias EventRecord = - { key : String - , decoder : Json.Decode.Value - , options : EventOptions - } - - -type alias EventOptions = - { stopPropagation : Bool - , preventDefault : Bool - } - - {-| decode a json object into ElmHtml, you have to pass a function that decodes events from Html Nodes. If you don't want to decode event msgs, you can ignore it: @@ -211,7 +188,7 @@ contextDecodeElmHtml context = |> Json.Decode.andThen (\nodeType -> if nodeType == kernelConstants.virtualDom.nodeTypeText then - Json.Decode.map TextTag decodeTextTag + decodeTextTag else if nodeType == kernelConstants.virtualDom.nodeTypeKeyedNode then Json.Decode.map NodeEntry (decodeKeyedNode context) @@ -235,10 +212,10 @@ contextDecodeElmHtml context = {-| decode text tag -} -decodeTextTag : Json.Decode.Decoder TextTagRecord +decodeTextTag : Json.Decode.Decoder (ElmHtml msg) decodeTextTag = field kernelConstants.virtualDom.text - (Json.Decode.andThen (\text -> Json.Decode.succeed { text = text }) Json.Decode.string) + (Json.Decode.map TextTag Json.Decode.string) {-| decode a tagger @@ -421,18 +398,6 @@ decodeFacts (HtmlContext taggers eventDecoder) = (decodeOthers Json.Decode.bool Nothing) -{-| Just empty facts --} -emptyFacts : Facts msg -emptyFacts = - { styles = Dict.empty - , events = Dict.empty - , attributeNamespace = Nothing - , stringAttributes = Dict.empty - , boolAttributes = Dict.empty - } - - {-| Decode a JSON object into an Attribute. You have to pass a function that decodes events from event attributes. If you don't want to decode event msgs, you can ignore it: @@ -449,32 +414,52 @@ decodeAttribute = |> Json.Decode.andThen (\tag -> if tag == Constants.attributeKey then - Json.Decode.map2 (\key val -> Attribute (AttributeRecord key val)) - (Json.Decode.field "n" Json.Decode.string) - (Json.Decode.field "o" Json.Decode.string) + attributeDecoder else if tag == Constants.attributeNamespaceKey then - Json.Decode.map3 NamespacedAttributeRecord - (Json.Decode.field "n" Json.Decode.string) - (Json.Decode.at [ "o", "o" ] Json.Decode.string) - (Json.Decode.at [ "o", "f" ] Json.Decode.string) - |> Json.Decode.map NamespacedAttribute + namespacedAttributeDecoder else if tag == Constants.styleKey then - Json.Decode.map2 (\key val -> Style { key = key, value = val }) - (Json.Decode.field "n" Json.Decode.string) - (Json.Decode.field "o" Json.Decode.string) + styleDecoder else if tag == Constants.propKey then - Json.Decode.map2 (\key val -> Property (PropertyRecord key val)) - (Json.Decode.field "n" Json.Decode.string) - (Json.Decode.at [ "o", "a" ] Json.Decode.value) + propertyDecoder else Json.Decode.fail ("Unexpected Html.Attribute tag: " ++ tag) ) +attributeDecoder : Json.Decode.Decoder Attribute +attributeDecoder = + Json.Decode.map2 (\name val -> Attribute (AttributeRecord name val)) + (Json.Decode.field "n" Json.Decode.string) + (Json.Decode.field "o" Json.Decode.string) + + +namespacedAttributeDecoder : Json.Decode.Decoder Attribute +namespacedAttributeDecoder = + Json.Decode.map3 NamespacedAttributeRecord + (Json.Decode.field "n" Json.Decode.string) + (Json.Decode.at [ "o", "o" ] Json.Decode.string) + (Json.Decode.at [ "o", "f" ] Json.Decode.string) + |> Json.Decode.map NamespacedAttribute + + +styleDecoder : Json.Decode.Decoder Attribute +styleDecoder = + Json.Decode.map2 (\key val -> Style { key = key, value = val }) + (Json.Decode.field "n" Json.Decode.string) + (Json.Decode.field "o" Json.Decode.string) + + +propertyDecoder : Json.Decode.Decoder Attribute +propertyDecoder = + Json.Decode.map2 (\key val -> Property (PropertyRecord key val)) + (Json.Decode.field "n" Json.Decode.string) + (Json.Decode.at [ "o", "a" ] Json.Decode.value) + + {-| A list of Void elements as defined by the HTML5 specification. These elements must not have closing tags and most not be written as self closing either diff --git a/src/Test/Html/Internal/ElmHtml/Markdown.elm b/src/Test/Html/Internal/ElmHtml/Markdown.elm index cdbef7af..5dde8563 100644 --- a/src/Test/Html/Internal/ElmHtml/Markdown.elm +++ b/src/Test/Html/Internal/ElmHtml/Markdown.elm @@ -1,11 +1,11 @@ module Test.Html.Internal.ElmHtml.Markdown exposing - ( MarkdownOptions, MarkdownModel, baseMarkdownModel + ( MarkdownOptions, MarkdownModel , decodeMarkdownModel ) {-| Markdown helpers -@docs MarkdownOptions, MarkdownModel, baseMarkdownModel +@docs MarkdownOptions, MarkdownModel @docs decodeMarkdownModel diff --git a/src/Test/Html/Internal/ElmHtml/Query.elm b/src/Test/Html/Internal/ElmHtml/Query.elm index a1d519c4..3fd8877b 100644 --- a/src/Test/Html/Internal/ElmHtml/Query.elm +++ b/src/Test/Html/Internal/ElmHtml/Query.elm @@ -1,21 +1,18 @@ module Test.Html.Internal.ElmHtml.Query exposing ( Selector(..) - , query, queryAll, queryChildren, queryChildrenAll, queryInNode - , queryById, queryByClassName, queryByClassList, queryByStyle, queryByTagName, queryByAttribute, queryByBoolAttribute + , query, queryChildren , getChildren ) {-| Query things using ElmHtml @docs Selector -@docs query, queryAll, queryChildren, queryChildrenAll, queryInNode -@docs queryById, queryByClassName, queryByClassList, queryByStyle, queryByTagName, queryByAttribute, queryByBoolAttribute +@docs query, queryChildren @docs getChildren -} import Dict -import String import Test.Html.Internal.ElmHtml.InternalTypes exposing (..) @@ -27,88 +24,21 @@ import Test.Html.Internal.ElmHtml.InternalTypes exposing (..) -} type Selector - = Id String - | ClassName String - | ClassList (List String) + = ClassList (List String) | Tag String | Attribute String String | BoolAttribute String Bool | Style { key : String, value : String } | ContainsText String | ContainsExactText String - | Multiple (List Selector) - - -{-| Query for a node with a given tag in a Html element --} -queryByTagName : String -> ElmHtml msg -> List (ElmHtml msg) -queryByTagName tagname = - query (Tag tagname) - - -{-| Query for a node with a given id in a Html element --} -queryById : String -> ElmHtml msg -> List (ElmHtml msg) -queryById id = - query (Id id) - - -{-| Query for a node with a given classname in a Html element --} -queryByClassName : String -> ElmHtml msg -> List (ElmHtml msg) -queryByClassName classname = - query (ClassName classname) - - -{-| Query for a node with all the given classnames in a Html element --} -queryByClassList : List String -> ElmHtml msg -> List (ElmHtml msg) -queryByClassList classList = - query (ClassList classList) - - -{-| Query for a node with the given style in a Html element --} -queryByStyle : { key : String, value : String } -> ElmHtml msg -> List (ElmHtml msg) -queryByStyle style = - query (Style style) - - -{-| Query for a node with a given attribute in a Html element --} -queryByAttribute : String -> String -> ElmHtml msg -> List (ElmHtml msg) -queryByAttribute key value = - query (Attribute key value) - - -{-| Query for a node with a given attribute in a Html element --} -queryByBoolAttribute : String -> Bool -> ElmHtml msg -> List (ElmHtml msg) -queryByBoolAttribute key value = - query (BoolAttribute key value) - - -{-| Query an ElmHtml element using a selector, searching all children. --} -query : Selector -> ElmHtml msg -> List (ElmHtml msg) -query selector = - queryInNode selector - - -{-| Query an ElmHtml node using multiple selectors, considering both the node itself -as well as all of its descendants. --} -queryAll : List Selector -> ElmHtml msg -> List (ElmHtml msg) -queryAll selectors = - query (Multiple selectors) {-| Query an ElmHtml node using a selector, considering both the node itself as well as all of its descendants. -} -queryInNode : Selector -> ElmHtml msg -> List (ElmHtml msg) -queryInNode = - queryInNodeHelp Nothing +query : Selector -> ElmHtml msg -> List (ElmHtml msg) +query selector = + queryInNode Nothing selector {-| Query an ElmHtml node using a selector, considering both the node itself @@ -116,7 +46,7 @@ as well as all of its descendants. -} queryChildren : Selector -> ElmHtml msg -> List (ElmHtml msg) queryChildren = - queryInNodeHelp (Just 1) + queryInNode (Just 1) {-| Returns just the immediate children of an ElmHtml node @@ -131,16 +61,8 @@ getChildren elmHtml = [] -{-| Query to ensure an ElmHtml node has all selectors given, without considering -any descendants lower than its immediate children. --} -queryChildrenAll : List Selector -> ElmHtml msg -> List (ElmHtml msg) -queryChildrenAll selectors = - queryInNodeHelp (Just 1) (Multiple selectors) - - -queryInNodeHelp : Maybe Int -> Selector -> ElmHtml msg -> List (ElmHtml msg) -queryInNodeHelp maxDescendantDepth selector node = +queryInNode : Maybe Int -> Selector -> ElmHtml msg -> List (ElmHtml msg) +queryInNode maxDescendantDepth selector node = case node of NodeEntry record -> let @@ -153,7 +75,7 @@ queryInNodeHelp maxDescendantDepth selector node = else childEntries - TextTag { text } -> + TextTag text -> case selector of ContainsText innerText -> if String.contains innerText text then @@ -189,14 +111,14 @@ descendInQuery maxDescendantDepth selector children = Nothing -> -- No maximum, so continue. List.concatMap - (queryInNodeHelp Nothing selector) + (queryInNode Nothing selector) children Just depth -> if depth > 0 then -- Continue with maximum depth reduced by 1. List.concatMap - (queryInNodeHelp (Just (depth - 1)) selector) + (queryInNode (Just (depth - 1)) selector) children else @@ -218,13 +140,6 @@ predicateFromSelector selector html = False -hasAllSelectors : List Selector -> ElmHtml msg -> Bool -hasAllSelectors selectors record = - List.map predicateFromSelector selectors - |> List.map (\selector -> selector record) - |> List.all identity - - hasAttribute : String -> String -> Facts msg -> Bool hasAttribute attribute queryString facts = case Dict.get attribute facts.stringAttributes of @@ -245,11 +160,6 @@ hasBoolAttribute attribute value facts = False -hasClass : String -> Facts msg -> Bool -hasClass queryString facts = - List.member queryString (classnames facts) - - hasClasses : List String -> Facts msg -> Bool hasClasses classList facts = containsAll classList (classnames facts) @@ -302,14 +212,6 @@ containsAll a b = nodeRecordPredicate : Selector -> (NodeRecord msg -> Bool) nodeRecordPredicate selector = case selector of - Id id -> - .facts - >> hasAttribute "id" id - - ClassName classname -> - .facts - >> hasClass classname - ClassList classList -> .facts >> hasClasses classList @@ -336,22 +238,10 @@ nodeRecordPredicate selector = ContainsExactText _ -> always False - Multiple selectors -> - NodeEntry - >> hasAllSelectors selectors - markdownPredicate : Selector -> (MarkdownNodeRecord msg -> Bool) markdownPredicate selector = case selector of - Id id -> - .facts - >> hasAttribute "id" id - - ClassName classname -> - .facts - >> hasClass classname - ClassList classList -> .facts >> hasClasses classList @@ -380,7 +270,3 @@ markdownPredicate selector = .model >> .markdown >> (==) text - - Multiple selectors -> - MarkdownNode - >> hasAllSelectors selectors diff --git a/src/Test/Html/Internal/ElmHtml/ToString.elm b/src/Test/Html/Internal/ElmHtml/ToString.elm index e9b85008..47069b87 100644 --- a/src/Test/Html/Internal/ElmHtml/ToString.elm +++ b/src/Test/Html/Internal/ElmHtml/ToString.elm @@ -1,18 +1,17 @@ module Test.Html.Internal.ElmHtml.ToString exposing - ( nodeRecordToString, nodeToString, nodeToStringWithOptions - , FormatOptions, defaultFormatOptions + ( nodeToStringWithOptions + , FormatOptions ) {-| Convert ElmHtml to string. -@docs nodeRecordToString, nodeToString, nodeToStringWithOptions +@docs nodeToStringWithOptions -@docs FormatOptions, defaultFormatOptions +@docs FormatOptions -} import Dict -import String import Test.Html.Internal.ElmHtml.InternalTypes exposing (..) @@ -24,19 +23,10 @@ type alias FormatOptions = } -{-| default formatting options --} -defaultFormatOptions : FormatOptions -defaultFormatOptions = - { indent = 0 - , newLines = False - } - - nodeToLines : FormatOptions -> ElmHtml msg -> List String nodeToLines options nodeType = case nodeType of - TextTag { text } -> + TextTag text -> [ text ] NodeEntry record -> @@ -49,13 +39,6 @@ nodeToLines options nodeType = [ record.model.markdown ] -{-| Convert a given html node to a string based on the type --} -nodeToString : ElmHtml msg -> String -nodeToString = - nodeToStringWithOptions defaultFormatOptions - - {-| same as nodeToString, but with options -} nodeToStringWithOptions : FormatOptions -> ElmHtml msg -> String @@ -81,9 +64,7 @@ nodeRecordToString options { tag, children, facts } = openTag extras = let trimmedExtras = - List.filterMap (\x -> x) extras - |> List.map String.trim - |> List.filter ((/=) "") + List.filterMap (Maybe.andThen (String.trim >> nothingIfEmpty)) extras filling = case trimmedExtras of @@ -95,56 +76,60 @@ nodeRecordToString options { tag, children, facts } = in "<" ++ tag ++ filling ++ ">" - closeTag = - "" - - childrenStrings = - List.map (nodeToLines options) children - |> List.concat - |> List.map ((++) (String.repeat options.indent " ")) - styles = - case Dict.toList facts.styles of - [] -> - Nothing + if Dict.isEmpty facts.styles then + Nothing - styleValues -> - styleValues - |> List.map (\( key, value ) -> key ++ ":" ++ value ++ ";") - |> String.join "" - |> (\styleString -> "style=\"" ++ styleString ++ "\"") - |> Just + else + let + styleString : String + styleString = + Dict.foldl (\key value str -> str ++ key ++ ":" ++ value ++ ";") "" facts.styles + in + Just ("style=\"" ++ styleString ++ "\"") classes = Dict.get "className" facts.stringAttributes |> Maybe.map (\name -> "class=\"" ++ name ++ "\"") stringAttributes = - Dict.filter (\k _ -> k /= "className") facts.stringAttributes - |> Dict.toList - |> List.map (\( k, v ) -> k ++ "=\"" ++ v ++ "\"") - |> String.join " " + Dict.foldl + (\k v str -> + if k == "className" then + str + + else + str ++ " " ++ k ++ "=\"" ++ v ++ "\"" + ) + "" + facts.stringAttributes + |> String.trimLeft |> Just boolAttributes = - Dict.toList facts.boolAttributes - |> List.filterMap - (\( k, v ) -> - if v then - Just k - - else - Nothing - ) - |> String.join " " + Dict.foldl + (\k v str -> + if v then + str ++ " " ++ k + + else + str + ) + "" + facts.boolAttributes + |> String.trimLeft |> Just + + openTag_ : String + openTag_ = + openTag [ classes, styles, stringAttributes, boolAttributes ] in case toElementKind tag of {- Void elements only have a start tag; end tags must not be specified for void elements. -} VoidElements -> - [ openTag [ classes, styles, stringAttributes, boolAttributes ] ] + [ openTag_ ] {- TODO: implement restrictions for RawTextElements, EscapableRawTextElements. Also handle ForeignElements correctly. @@ -152,6 +137,25 @@ nodeRecordToString options { tag, children, facts } = element kinds. -} _ -> - [ openTag [ classes, styles, stringAttributes, boolAttributes ] ] - ++ childrenStrings - ++ [ closeTag ] + let + closeTag = + "" + + indent : String + indent = + String.repeat options.indent " " + + childrenStrings = + List.concatMap (nodeToLines options) children + |> List.foldr (\x list -> (indent ++ x ++ "") :: list) [ closeTag ] + in + openTag_ :: childrenStrings + + +nothingIfEmpty : String -> Maybe String +nothingIfEmpty str = + if str == "" then + Nothing + + else + Just str diff --git a/src/Test/Html/Query/Internal.elm b/src/Test/Html/Query/Internal.elm index 0cacd3d3..03b95738 100644 --- a/src/Test/Html/Query/Internal.elm +++ b/src/Test/Html/Query/Internal.elm @@ -1,6 +1,7 @@ -module Test.Html.Query.Internal exposing (Multiple(..), Query(..), QueryError(..), SelectorQuery(..), Single(..), addQueryFromHtmlLine, baseIndentation, contains, expectAll, expectAllHelp, failWithQuery, getChildren, getElementAt, getElementAtHelp, getHtmlContext, has, hasNot, isElement, joinAsList, missingDescendants, multipleToExpectation, prefixOutputLine, prependSelector, prettyPrint, printIndented, queryErrorToString, showSelectorOutcome, showSelectorOutcomeInverse, toLines, toLinesHelp, toOutputLine, traverse, traverseSelector, traverseSelectors, verifySingle, withHtmlContext) +module Test.Html.Query.Internal exposing (Multiple(..), Query(..), QueryError, SelectorQuery(..), Single(..), contains, expectAll, failWithQuery, has, hasNot, joinAsList, multipleToExpectation, prependSelector, prettyPrint, queryErrorToString, traverse, verifySingle) import Expect exposing (Expectation) +import MicroListExtra as List import Test.Html.Descendant as Descendant import Test.Html.Internal.ElmHtml.InternalTypes as InternalTypes exposing (ElmHtml(..)) import Test.Html.Internal.ElmHtml.ToString exposing (nodeToStringWithOptions) @@ -105,14 +106,6 @@ toLinesHelp expectationFailure elmHtmlList selectorQueries queryName results = -- sees is Query.find rather than something like -- Query.has, to reflect how we didn't make it that far. String.join "\n\n\n✗ " [ result, expectationFailure ] :: results - - recurse newElmHtmlList rest result = - toLinesHelp - expectationFailure - newElmHtmlList - rest - queryName - (result :: results) in case selectorQueries of [] -> @@ -126,10 +119,17 @@ toLinesHelp expectationFailure elmHtmlList selectorQueries queryName results = elmHtmlList |> List.concatMap getChildren |> InternalSelector.queryAll selectors + + result = + ("Query.findAll " ++ joinAsList selectorToString selectors) + |> withHtmlContext (getHtmlContext elements) in - ("Query.findAll " ++ joinAsList selectorToString selectors) - |> withHtmlContext (getHtmlContext elements) - |> recurse elements rest + toLinesHelp + expectationFailure + elements + rest + queryName + (result :: results) Find selectors -> let @@ -142,8 +142,13 @@ toLinesHelp expectationFailure elmHtmlList selectorQueries queryName results = ("Query.find " ++ joinAsList selectorToString selectors) |> withHtmlContext (getHtmlContext elements) in - if List.length elements == 1 then - recurse elements rest result + if List.isSingleton elements then + toLinesHelp + expectationFailure + elements + rest + queryName + (result :: results) else bailOut result @@ -154,10 +159,17 @@ toLinesHelp expectationFailure elmHtmlList selectorQueries queryName results = elmHtmlList |> List.concatMap getChildren |> InternalSelector.queryAllChildren selectors + + result = + ("Query.children " ++ joinAsList selectorToString selectors) + |> withHtmlContext (getHtmlContext elements) in - ("Query.children " ++ joinAsList selectorToString selectors) - |> withHtmlContext (getHtmlContext elements) - |> recurse elements rest + toLinesHelp + expectationFailure + elements + rest + queryName + (result :: results) First -> let @@ -172,7 +184,12 @@ toLinesHelp expectationFailure elmHtmlList selectorQueries queryName results = |> withHtmlContext (getHtmlContext elements) in if List.length elements == 1 then - recurse elements rest result + toLinesHelp + expectationFailure + elements + rest + queryName + (result :: results) else bailOut result @@ -188,7 +205,12 @@ toLinesHelp expectationFailure elmHtmlList selectorQueries queryName results = |> withHtmlContext (getHtmlContext elements) in if List.length elements == 1 then - recurse elements rest result + toLinesHelp + expectationFailure + elements + rest + queryName + (result :: results) else bailOut result @@ -196,7 +218,7 @@ toLinesHelp expectationFailure elmHtmlList selectorQueries queryName results = withHtmlContext : String -> String -> String withHtmlContext htmlStr str = - String.join "\n\n" [ str, htmlStr ] + str ++ "\n\n" ++ htmlStr getHtmlContext : List (ElmHtml msg) -> String @@ -219,29 +241,30 @@ getHtmlContext elmHtmlList = joinAsList : (a -> String) -> List a -> String joinAsList toStr list = - if List.isEmpty list then - "[]" + case list of + [] -> + "[]" - else - "[ " ++ String.join ", " (List.map toStr list) ++ " ]" + first :: tail -> + List.foldl (\x str -> str ++ ", " ++ toStr x) ("[ " ++ toStr first) tail ++ " ]" printIndented : Int -> Int -> ElmHtml msg -> String printIndented maxDigits index elmHtml = - let - caption = - (String.fromInt (index + 1) ++ ")") - |> String.padRight (maxDigits + 3) ' ' - |> String.append baseIndentation - - indentation = - String.repeat (String.length caption) " " - in case String.split "\n" (prettyPrint elmHtml) of [] -> "" first :: rest -> + let + caption = + (String.fromInt (index + 1) ++ ")") + |> String.padRight (maxDigits + 3) ' ' + |> String.append baseIndentation + + indentation = + String.repeat (String.length caption) " " + in rest |> List.map (String.append indentation) |> (::) (caption ++ first) @@ -317,7 +340,7 @@ traverse : Query msg -> Result QueryError (List (ElmHtml msg)) traverse query = case query of Query node selectorQueries -> - traverseSelectors selectorQueries [ Inert.toElmHtml node ] + traverseSelectors (List.reverse selectorQueries) [ Inert.toElmHtml node ] InternalError message -> Err (OtherInternalError message) @@ -328,10 +351,17 @@ traverse query = traverseSelectors : List SelectorQuery -> List (ElmHtml msg) -> Result QueryError (List (ElmHtml msg)) traverseSelectors selectorQueries elmHtmlList = - List.foldr - (traverseSelector >> Result.andThen) - (Ok elmHtmlList) - selectorQueries + case selectorQueries of + [] -> + Ok elmHtmlList + + selectorQuery :: rest -> + case traverseSelector selectorQuery elmHtmlList of + Ok newElmHtmlList -> + traverseSelectors rest newElmHtmlList + + (Err _) as error -> + error traverseSelector : SelectorQuery -> List (ElmHtml msg) -> Result QueryError (List (ElmHtml msg)) @@ -357,10 +387,12 @@ traverseSelector selectorQuery elmHtmlList = |> Ok First -> - elmHtmlList - |> List.head - |> Maybe.map (\elem -> Ok [ elem ]) - |> Maybe.withDefault (Err (NoResultsForSingle "Query.first")) + case elmHtmlList of + elem :: _ -> + Ok [ elem ] + + [] -> + Err (NoResultsForSingle "Query.first") Index index -> let @@ -385,16 +417,6 @@ getChildren elmHtml = [] -isElement : ElmHtml msg -> Bool -isElement elmHtml = - case elmHtml of - NodeEntry _ -> - True - - _ -> - False - - verifySingle : String -> List a -> Result QueryError a verifySingle queryName list = case list of @@ -504,7 +526,7 @@ contains expectedDescendants query = else Expect.fail - (String.join "" + (String.concat [ "\t✗ /" , String.fromInt <| List.length missing , "\\ missing descendants: \n\n" @@ -626,11 +648,11 @@ addQueryFromHtmlLine query = [ prefixOutputLine "Query.fromHtml" , toOutputLine query |> String.split "\n" - |> List.map ((++) baseIndentation) + |> List.map (\str -> baseIndentation ++ str ++ "") |> String.join "\n" ] prefixOutputLine : String -> String -prefixOutputLine = - (++) "▼ " +prefixOutputLine line = + "▼ " ++ line diff --git a/src/Test/Html/Selector.elm b/src/Test/Html/Selector.elm index 4d22d522..3529afb8 100644 --- a/src/Test/Html/Selector.elm +++ b/src/Test/Html/Selector.elm @@ -177,8 +177,8 @@ id = -} tag : String -> Selector -tag name = - Tag name +tag = + Tag {-| Matches elements that have the given attribute in a way that makes sense @@ -187,40 +187,44 @@ given their semantics in `Html`. attribute : Attribute Never -> Selector attribute attr = case Inert.parseAttribute attr of - Ok (InternalTypes.Attribute { key, value }) -> - if String.toLower key == "class" then - value + Ok (InternalTypes.Attribute record) -> + if String.toLower record.name == "class" then + record.value |> String.split " " |> Classes else - namedAttr key value + Internal.Attribute record Ok (InternalTypes.Property { key, value }) -> if key == "className" then - value - |> Json.Decode.decodeValue Json.Decode.string - |> Result.map (String.split " ") - |> Result.withDefault [] - |> Classes + case Json.Decode.decodeValue Json.Decode.string value of + Ok classesStr -> + Classes (String.split " " classesStr) + + Err _ -> + Classes [] else value |> Json.Decode.decodeValue Json.Decode.string - |> Result.map (namedAttr key) + |> Result.map (\v -> namedAttr key v) |> orElseLazy (\() -> value |> Json.Decode.decodeValue Json.Decode.bool - |> Result.map (namedBoolAttr key) + |> Result.map (\b -> namedBoolAttr key b) ) - |> Result.withDefault Invalid + |> Result.withDefault Internal.invalid + + Ok (InternalTypes.Style record) -> + Style record - Ok (InternalTypes.Style { key, value }) -> - Style { key = key, value = value } + Ok (InternalTypes.NamespacedAttribute _) -> + Internal.invalid - _ -> - Invalid + Err _ -> + Internal.invalid {-| Matches elements that have the given style properties (and possibly others as well). diff --git a/src/Test/Html/Selector/Internal.elm b/src/Test/Html/Selector/Internal.elm index 3664c098..08457275 100644 --- a/src/Test/Html/Selector/Internal.elm +++ b/src/Test/Html/Selector/Internal.elm @@ -1,4 +1,4 @@ -module Test.Html.Selector.Internal exposing (Selector(..), hasAll, namedAttr, namedBoolAttr, query, queryAll, queryAllChildren, selectorToString, styleToString) +module Test.Html.Selector.Internal exposing (Selector(..), hasAll, invalid, namedAttr, namedBoolAttr, queryAll, queryAllChildren, selectorToString) import Test.Html.Internal.ElmHtml.InternalTypes exposing (ElmHtml) import Test.Html.Internal.ElmHtml.Query as ElmHtmlQuery @@ -15,23 +15,16 @@ type Selector | Text String | ExactText String | Containing (List Selector) - | Invalid + | Invalid () + + +invalid : Selector +invalid = + Invalid () selectorToString : Selector -> String selectorToString criteria = - let - quoteString s = - "\"" ++ s ++ "\"" - - boolToString b = - case b of - True -> - "True" - - False -> - "False" - in case criteria of All list -> list @@ -77,10 +70,24 @@ selectorToString criteria = in "containing [ " ++ selectors ++ " ] " - Invalid -> + Invalid () -> "invalid" +quoteString : String -> String +quoteString s = + "\"" ++ s ++ "\"" + + +boolToString : Bool -> String +boolToString b = + if b then + "True" + + else + "False" + + styleToString : { key : String, value : String } -> String styleToString { key, value } = key ++ ":" ++ value @@ -107,8 +114,8 @@ queryAll selectors list = list selector :: rest -> - query ElmHtmlQuery.query queryAll selector list - |> queryAll rest + queryAll rest + (query ElmHtmlQuery.query queryAll selector list) queryAllChildren : List Selector -> List (ElmHtml msg) -> List (ElmHtml msg) @@ -118,8 +125,8 @@ queryAllChildren selectors list = list selector :: rest -> - query ElmHtmlQuery.queryChildren queryAllChildren selector list - |> queryAllChildren rest + queryAllChildren rest + (query ElmHtmlQuery.queryChildren queryAllChildren selector list) query : @@ -184,7 +191,7 @@ query fn fnAll selector list = in List.filter anyDescendantsMatch elems - Invalid -> + Invalid () -> [] diff --git a/src/Test/Internal.elm b/src/Test/Internal.elm index 270bc272..7e0444b4 100644 --- a/src/Test/Internal.elm +++ b/src/Test/Internal.elm @@ -1,5 +1,6 @@ module Test.Internal exposing (Test(..), blankDescriptionFailure, duplicatedName, failNow, toString) +import Fuzz.Internal import Random import Set exposing (Set) import Test.Expectation exposing (Expectation) @@ -25,9 +26,16 @@ type Test {-| Create a test that always fails for the given reason and description. -} failNow : { description : String, reason : Reason } -> Test -failNow record = +failNow { description, reason } = ElmTestVariant__UnitTest - (\() -> Test.Expectation.fail record) + (\() -> + Test.Expectation.Fail + { given = Nothing + , distributionReport = Fuzz.Internal.noDistribution + , description = description + , reason = reason + } + ) blankDescriptionFailure : Test diff --git a/src/Test/Runner.elm b/src/Test/Runner.elm index 5170de4a..2f7446c0 100644 --- a/src/Test/Runner.elm +++ b/src/Test/Runner.elm @@ -41,7 +41,6 @@ These functions give you the ability to run fuzzers separate of running fuzz tes -} import Bitwise -import Char import Elm.Kernel.Test import Expect exposing (Expectation) import Fuzz exposing (Fuzzer) @@ -51,7 +50,6 @@ import PRNG import Random import RandomRun exposing (RandomRun) import Simplify -import String import Test exposing (Test) import Test.Distribution exposing (DistributionReport) import Test.Expectation @@ -412,7 +410,7 @@ getFailureReason expectation = getDistributionReport : Expectation -> DistributionReport getDistributionReport expectation = case expectation of - Test.Expectation.Pass { distributionReport } -> + Test.Expectation.Pass distributionReport -> distributionReport Test.Expectation.Fail { distributionReport } -> diff --git a/src/Test/Runner/Distribution.elm b/src/Test/Runner/Distribution.elm index 9938e3cf..0d4cff22 100644 --- a/src/Test/Runner/Distribution.elm +++ b/src/Test/Runner/Distribution.elm @@ -33,7 +33,7 @@ formatTable { runsElapsed, distributionCount } = |> List.filter (\( labels, count ) -> not - ((List.length labels == 1) + (List.isSingleton labels && (count == 0) && isStrictSubset distributionList labels ) @@ -54,7 +54,7 @@ formatTable { runsElapsed, distributionCount } = ( baseRows, combinationsRows ) = distribution |> List.sortBy (\( _, count, _ ) -> negate count) - |> List.partition (\( labels, _, _ ) -> List.length labels <= 1) + |> List.partition (\( labels, _, _ ) -> not (List.hasMultipleItems labels)) reorderedTable = baseRows ++ combinationsRows @@ -71,7 +71,7 @@ formatTable { runsElapsed, distributionCount } = ( labels, _, _ ) = item in - List.length labels > 1 + List.hasMultipleItems labels ) |> Maybe.withDefault ( rawTable, [] ) diff --git a/tests/src/FuzzerTests.elm b/tests/src/FuzzerTests.elm index d2a9ace0..c5a8919a 100644 --- a/tests/src/FuzzerTests.elm +++ b/tests/src/FuzzerTests.elm @@ -4,7 +4,7 @@ import Array import Expect exposing (Expectation) import Fuzz exposing (..) import Helpers exposing (..) -import Random exposing (Generator) +import Random import Test exposing (..) import Test.Distribution import Test.Runner exposing (Simplifiable) @@ -167,7 +167,7 @@ fuzzerSpecificationTests = (\v -> v == 999) , passes "Returns what you give it - Bool" (Fuzz.constant True) - (\v -> v == True) + (\v -> v) , simplifiesTowards "42" 42 (Fuzz.constant 42) fullySimplify ] , describe "maybe" @@ -525,7 +525,7 @@ fuzzerSpecificationTests = (Fuzz.list Fuzz.unit) (not << List.isEmpty) , simplifiesTowards "simplest" [] (Fuzz.list Fuzz.int) fullySimplify - , simplifiesTowardsWith { runs = 2000 } "next simplest" [ 0 ] (Fuzz.list Fuzz.int) (\x -> x == []) + , simplifiesTowardsWith { runs = 2000 } "next simplest" [ 0 ] (Fuzz.list Fuzz.int) List.isEmpty , simplifiesTowardsMany "All lists are sorted" [ [ 0, -1 ] , [ 1, 0 ] @@ -889,7 +889,7 @@ fuzzerSpecificationTests = (Fuzz.constant ((+) 1) |> Fuzz.andMap (Fuzz.constant n) ) - (Fuzz.constant ((+) 1 n)) + (Fuzz.constant (1 + n)) ) ) (\( left, right ) -> left == right) @@ -996,16 +996,16 @@ fuzzerSpecificationTests = , canGenerate True (Fuzz.weightedBool 0.5) , passes "0 = always False" (Fuzz.weightedBool 0) - (\bool -> bool == False) + (\bool -> not bool) , passes "1 = always True" (Fuzz.weightedBool 1) - (\bool -> bool == True) + (\bool -> bool) , passes "<0 clamps to 0" (Fuzz.weightedBool -0.5) - (\bool -> bool == False) + (\bool -> not bool) , passes ">1 clamps to 1" (Fuzz.weightedBool 1.5) - (\bool -> bool == True) + (\bool -> bool) , simplifiesTowards "simplest" False (Fuzz.weightedBool 0.5) fullySimplify , simplifiesTowards "non-False" True (Fuzz.weightedBool 0.5) (\x -> x == False) ] @@ -1182,7 +1182,7 @@ distributionTests = } (Fuzz.intRange 1 20) "Int range boundaries" - (\n -> Expect.pass) + (\_ -> Expect.pass) , Test.fuzzWith { runs = 10000 , distribution = @@ -1193,7 +1193,7 @@ distributionTests = } (Fuzz.intRange 1 20) "Fizz buzz" - (\n -> Expect.pass) + (\_ -> Expect.pass) , Test.fuzzWith { runs = 10000 , distribution = @@ -1206,7 +1206,7 @@ distributionTests = } (Fuzz.intRange 1 20) "Fizz buzz even odd" - (\n -> Expect.pass) + (\_ -> Expect.pass) , Test.fuzzWith { runs = 10000 , distribution = @@ -1220,7 +1220,7 @@ distributionTests = } (Fuzz.intRange 1 20) "Int range boundaries - mandatory" - (\n -> Expect.pass) + (\_ -> Expect.pass) ] diff --git a/tests/src/Main.elm b/tests/src/Main.elm index 1cc3d9d4..7898d0e8 100644 --- a/tests/src/Main.elm +++ b/tests/src/Main.elm @@ -8,7 +8,6 @@ Note that this always uses an initial seed of 902101337, since it can't do effec -} -import Platform import Runner.Log import Runner.String exposing (Summary) import SeedTests diff --git a/tests/src/Runner/Log.elm b/tests/src/Runner/Log.elm index 2aa005e7..cfe3338b 100644 --- a/tests/src/Runner/Log.elm +++ b/tests/src/Runner/Log.elm @@ -23,7 +23,6 @@ if the tests all passed, and 1 if any failed. import Random import Runner.String exposing (Summary) -import String import Test exposing (Test) diff --git a/tests/src/Runner/String.elm b/tests/src/Runner/String.elm index 1cd4920a..c93eac80 100644 --- a/tests/src/Runner/String.elm +++ b/tests/src/Runner/String.elm @@ -11,7 +11,6 @@ Note that this always uses an initial seed of 902101337, since it can't do effec -} -import Dict exposing (Dict) import Expect exposing (Expectation) import Random import Runner.String.Distribution @@ -76,24 +75,22 @@ fromExpectation labels expectation summary = |> Test.Runner.getDistributionReport |> Runner.String.Distribution.report labels - summaryWithDistribution : Summary - summaryWithDistribution = + output : String + output = case distributionReport of Nothing -> - summary + summary.output Just distribution -> - { summary - | output = - summary.output - ++ "\n\n" - ++ distribution - ++ "\n" - } + summary.output ++ "\n\n" ++ distribution ++ "\n" in case Test.Runner.getFailureReason expectation of Nothing -> - { summaryWithDistribution | passed = summaryWithDistribution.passed + 1 } + { output = output + , failed = summary.failed + , passed = summary.passed + 1 + , autoFail = summary.autoFail + } Just { given, description, reason } -> let @@ -109,16 +106,18 @@ fromExpectation labels expectation summary = "Given " ++ g ++ "\n\n" newOutput = - "\n\n" + output + ++ "\n\n" ++ outputLabels labels ++ "\n" - ++ (prefix ++ indentLines message) + ++ prefix + ++ indentLines message ++ "\n" in - { summaryWithDistribution - | output = summaryWithDistribution.output ++ newOutput - , failed = summaryWithDistribution.failed + 1 - , passed = summaryWithDistribution.passed + { output = newOutput + , failed = summary.failed + 1 + , passed = summary.passed + , autoFail = summary.autoFail } @@ -139,11 +138,6 @@ defaultRuns = 100 -wrap : String -> String -> String -wrap delimiter string = - delimiter ++ string ++ delimiter - - indentLines : String -> String indentLines str = str diff --git a/tests/src/Runner/String/Distribution.elm b/tests/src/Runner/String/Distribution.elm index e6fa466b..9176145b 100644 --- a/tests/src/Runner/String/Distribution.elm +++ b/tests/src/Runner/String/Distribution.elm @@ -1,16 +1,12 @@ module Runner.String.Distribution exposing (report) -import Dict exposing (Dict) -import Expect exposing (Expectation) -import Set exposing (Set) import Test.Distribution exposing (DistributionReport(..)) -import Test.Runner report : List String -> DistributionReport -> Maybe String report testBreadcrumbs distributionReport = case distributionReport of - NoDistribution -> + NoDistribution () -> Nothing DistributionToReport r -> diff --git a/tests/src/Runner/String/Format.elm b/tests/src/Runner/String/Format.elm index 447ef53f..faf25ee9 100644 --- a/tests/src/Runner/String/Format.elm +++ b/tests/src/Runner/String/Format.elm @@ -57,7 +57,7 @@ format description reason = "\nThese keys are missing: " ++ (missing |> String.join ", " |> (\d -> "[ " ++ d ++ " ]")) in - String.join "" + String.concat [ verticalBar description expected actual , "\n" , extraStr @@ -141,7 +141,7 @@ escapeUnicodeChars s = else "\\u{" ++ hexInt c ++ "}" ) - |> String.join "" + |> String.concat listDiffToString : @@ -161,7 +161,7 @@ listDiffToString index description { expected, actual } originals = , "\n" , Debug.toString originals.originalActual ] - |> String.join "" + |> String.concat ( _ :: _, [] ) -> verticalBar (description ++ " was shorter than") @@ -185,7 +185,7 @@ listDiffToString index description { expected, actual } originals = else -- We found elements that differ; fail! - String.join "" + String.concat [ verticalBar description (Debug.toString originals.originalExpected) (Debug.toString originals.originalActual) @@ -211,12 +211,12 @@ equalityToString { operation, expected, actual } = combine things = things - |> List.map (String.join "") + |> List.map String.concat |> String.join "\n" in verticalBar operation - (if String.join "" valueBelow /= String.join "" unicodeValueBelow then + (if valueBelow /= unicodeValueBelow then -- we need to show the escaped string as well combine [ valueBelow @@ -231,7 +231,7 @@ equalityToString { operation, expected, actual } = , diffArrowsBelow ] ) - (if String.join "" valueAbove /= String.join "" unicodeValueAbove then + (if valueAbove /= unicodeValueAbove then -- we need to show the escaped string as well combine [ unicodeDiffArrowsAbove diff --git a/tests/src/ShrinkingChallengeTests.elm b/tests/src/ShrinkingChallengeTests.elm index 813f58d0..26ac47b6 100644 --- a/tests/src/ShrinkingChallengeTests.elm +++ b/tests/src/ShrinkingChallengeTests.elm @@ -2,7 +2,6 @@ module ShrinkingChallengeTests exposing (shrinkingChallenges) import Fuzz exposing (..) import Helpers exposing (..) -import Random import Set import Test exposing (..) diff --git a/tests/src/Test/Html/ExampleApp.elm b/tests/src/Test/Html/ExampleApp.elm index 2e7a3eca..2fc356a8 100644 --- a/tests/src/Test/Html/ExampleApp.elm +++ b/tests/src/Test/Html/ExampleApp.elm @@ -1,4 +1,4 @@ -module Test.Html.ExampleApp exposing (exampleModel, view) +module Test.Html.ExampleApp exposing (view) import Html exposing (..) import Html.Attributes exposing (..) @@ -7,22 +7,13 @@ import Html.Keyed as Keyed import Html.Lazy as Lazy -type alias Model = - () - - -exampleModel : Model -exampleModel = - () - - type Msg = GoToHome | GoToExamples -view : Model -> Html Msg -view _ = +view : Html Msg +view = div [ class "container" ] [ header [ class "funky themed", id "heading" ] [ a [ href "http://elm-lang.org", onClick GoToHome ] [ text "home" ] diff --git a/tests/src/Test/Html/ExampleAppTests.elm b/tests/src/Test/Html/ExampleAppTests.elm index 1e781081..919572ab 100644 --- a/tests/src/Test/Html/ExampleAppTests.elm +++ b/tests/src/Test/Html/ExampleAppTests.elm @@ -3,7 +3,7 @@ module Test.Html.ExampleAppTests exposing (all) import Expect import Html.Attributes exposing (href) import Test exposing (..) -import Test.Html.ExampleApp exposing (exampleModel, view) +import Test.Html.ExampleApp exposing (view) import Test.Html.Query as Query import Test.Html.Selector exposing (..) @@ -12,7 +12,7 @@ all : Test all = let output = - view exampleModel + view |> Query.fromHtml in describe "view exampleModel"